{-# LANGUAGE TemplateHaskell #-}

module Taskell.Data.Task where

import ClassyPrelude

import Control.Lens (ix, makeLenses, (%~), (&), (.~), (?~), (^.), (^?))

import           Data.Sequence        as S (adjust', deleteAt, (|>))
import           Data.Text            (strip)
import           Data.Time.Zones      (TZ)
import           Taskell.Data.Date    (Due (..), inputToTime)
import qualified Taskell.Data.Subtask as ST (Subtask, Update, complete, duplicate, name)

data Task = Task
    { Task -> Text
_name        :: Text
    , Task -> Maybe Text
_description :: Maybe Text
    , Task -> Seq Subtask
_subtasks    :: Seq ST.Subtask
    , Task -> Maybe Due
_due         :: Maybe Due
    } deriving (Int -> Task -> ShowS
[Task] -> ShowS
Task -> String
(Int -> Task -> ShowS)
-> (Task -> String) -> ([Task] -> ShowS) -> Show Task
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Task] -> ShowS
$cshowList :: [Task] -> ShowS
show :: Task -> String
$cshow :: Task -> String
showsPrec :: Int -> Task -> ShowS
$cshowsPrec :: Int -> Task -> ShowS
Show, Task -> Task -> Bool
(Task -> Task -> Bool) -> (Task -> Task -> Bool) -> Eq Task
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Task -> Task -> Bool
$c/= :: Task -> Task -> Bool
== :: Task -> Task -> Bool
$c== :: Task -> Task -> Bool
Eq)

type Update = Task -> Task

-- create lenses
$(makeLenses ''Task)

-- operations
create :: Text -> Maybe Due -> Maybe Text -> Seq ST.Subtask -> Task
create :: Text -> Maybe Due -> Maybe Text -> Seq Subtask -> Task
create Text
name' Maybe Due
due' Maybe Text
description' Seq Subtask
subtasks' = Text -> Maybe Text -> Seq Subtask -> Maybe Due -> Task
Task Text
name' Maybe Text
description' Seq Subtask
subtasks' Maybe Due
due'

blank :: Task
blank :: Task
blank = Text -> Maybe Text -> Seq Subtask -> Maybe Due -> Task
Task Text
"" Maybe Text
forall a. Maybe a
Nothing Seq Subtask
forall (f :: * -> *) a. Alternative f => f a
empty Maybe Due
forall a. Maybe a
Nothing

new :: Text -> Task
new :: Text -> Task
new Text
text = Task
blank Task -> (Task -> Task) -> Task
forall a b. a -> (a -> b) -> b
& ((Text -> Identity Text) -> Task -> Identity Task
Lens' Task Text
name ((Text -> Identity Text) -> Task -> Identity Task)
-> Text -> Task -> Task
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
text)

setDescription :: Text -> Update
setDescription :: Text -> Task -> Task
setDescription Text
text =
    (Maybe Text -> Identity (Maybe Text)) -> Task -> Identity Task
Lens' Task (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text)) -> Task -> Identity Task)
-> Maybe Text -> Task -> Task
forall s t a b. ASetter s t a b -> b -> s -> t
.~
    if Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null (Text -> Text
strip Text
text)
        then Maybe Text
forall a. Maybe a
Nothing
        else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
text

maybeAppend :: Text -> Maybe Text -> Maybe Text
maybeAppend :: Text -> Maybe Text -> Maybe Text
maybeAppend Text
text (Just Text
current) = Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat [Text
current, Text
"\n", Text
text])
maybeAppend Text
text Maybe Text
Nothing        = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
text

appendDescription :: Text -> Update
appendDescription :: Text -> Task -> Task
appendDescription Text
text =
    if Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null (Text -> Text
strip Text
text)
        then Task -> Task
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
        else (Maybe Text -> Identity (Maybe Text)) -> Task -> Identity Task
Lens' Task (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text)) -> Task -> Identity Task)
-> (Maybe Text -> Maybe Text) -> Task -> Task
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> Maybe Text -> Maybe Text
maybeAppend Text
text

setDue :: TZ -> UTCTime -> Text -> Task -> Maybe Task
setDue :: TZ -> UTCTime -> Text -> Task -> Maybe Task
setDue TZ
tz UTCTime
now Text
date Task
task =
    if Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
date
        then Task -> Maybe Task
forall a. a -> Maybe a
Just (Task
task Task -> (Task -> Task) -> Task
forall a b. a -> (a -> b) -> b
& (Maybe Due -> Identity (Maybe Due)) -> Task -> Identity Task
Lens' Task (Maybe Due)
due ((Maybe Due -> Identity (Maybe Due)) -> Task -> Identity Task)
-> Maybe Due -> Task -> Task
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Due
forall a. Maybe a
Nothing)
        else (\Due
d -> Task
task Task -> (Task -> Task) -> Task
forall a b. a -> (a -> b) -> b
& (Maybe Due -> Identity (Maybe Due)) -> Task -> Identity Task
Lens' Task (Maybe Due)
due ((Maybe Due -> Identity (Maybe Due)) -> Task -> Identity Task)
-> Due -> Task -> Task
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Due
d) (Due -> Task) -> Maybe Due -> Maybe Task
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TZ -> UTCTime -> Text -> Maybe Due
inputToTime TZ
tz UTCTime
now (Text -> Text
strip Text
date)

clearDue :: Update
clearDue :: Task -> Task
clearDue Task
task = Task
task Task -> (Task -> Task) -> Task
forall a b. a -> (a -> b) -> b
& (Maybe Due -> Identity (Maybe Due)) -> Task -> Identity Task
Lens' Task (Maybe Due)
due ((Maybe Due -> Identity (Maybe Due)) -> Task -> Identity Task)
-> Maybe Due -> Task -> Task
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Due
forall a. Maybe a
Nothing

getSubtask :: Int -> Task -> Maybe ST.Subtask
getSubtask :: Int -> Task -> Maybe Subtask
getSubtask Int
idx = (Task -> Getting (First Subtask) Task Subtask -> Maybe Subtask
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Seq Subtask -> Const (First Subtask) (Seq Subtask))
-> Task -> Const (First Subtask) Task
Lens' Task (Seq Subtask)
subtasks ((Seq Subtask -> Const (First Subtask) (Seq Subtask))
 -> Task -> Const (First Subtask) Task)
-> ((Subtask -> Const (First Subtask) Subtask)
    -> Seq Subtask -> Const (First Subtask) (Seq Subtask))
-> Getting (First Subtask) Task Subtask
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index (Seq Subtask)
-> Traversal' (Seq Subtask) (IxValue (Seq Subtask))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq Subtask)
idx)

addSubtask :: ST.Subtask -> Update
addSubtask :: Subtask -> Task -> Task
addSubtask Subtask
subtask = (Seq Subtask -> Identity (Seq Subtask)) -> Task -> Identity Task
Lens' Task (Seq Subtask)
subtasks ((Seq Subtask -> Identity (Seq Subtask)) -> Task -> Identity Task)
-> (Seq Subtask -> Seq Subtask) -> Task -> Task
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq Subtask -> Subtask -> Seq Subtask
forall a. Seq a -> a -> Seq a
|> Subtask
subtask)

hasSubtasks :: Task -> Bool
hasSubtasks :: Task -> Bool
hasSubtasks = Bool -> Bool
not (Bool -> Bool) -> (Task -> Bool) -> Task -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Seq Subtask -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null (Seq Subtask -> Bool) -> (Task -> Seq Subtask) -> Task -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Task -> Getting (Seq Subtask) Task (Seq Subtask) -> Seq Subtask
forall s a. s -> Getting a s a -> a
^. Getting (Seq Subtask) Task (Seq Subtask)
Lens' Task (Seq Subtask)
subtasks)

updateSubtask :: Int -> ST.Update -> Update
updateSubtask :: Int -> Update -> Task -> Task
updateSubtask Int
idx Update
fn = (Seq Subtask -> Identity (Seq Subtask)) -> Task -> Identity Task
Lens' Task (Seq Subtask)
subtasks ((Seq Subtask -> Identity (Seq Subtask)) -> Task -> Identity Task)
-> (Seq Subtask -> Seq Subtask) -> Task -> Task
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Update -> Int -> Seq Subtask -> Seq Subtask
forall a. (a -> a) -> Int -> Seq a -> Seq a
adjust' Update
fn Int
idx

removeSubtask :: Int -> Update
removeSubtask :: Int -> Task -> Task
removeSubtask Int
idx = (Seq Subtask -> Identity (Seq Subtask)) -> Task -> Identity Task
Lens' Task (Seq Subtask)
subtasks ((Seq Subtask -> Identity (Seq Subtask)) -> Task -> Identity Task)
-> (Seq Subtask -> Seq Subtask) -> Task -> Task
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Seq Subtask -> Seq Subtask
forall a. Int -> Seq a -> Seq a
S.deleteAt Int
idx

countSubtasks :: Task -> Int
countSubtasks :: Task -> Int
countSubtasks = Seq Subtask -> Int
forall mono. MonoFoldable mono => mono -> Int
length (Seq Subtask -> Int) -> (Task -> Seq Subtask) -> Task -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Task -> Getting (Seq Subtask) Task (Seq Subtask) -> Seq Subtask
forall s a. s -> Getting a s a -> a
^. Getting (Seq Subtask) Task (Seq Subtask)
Lens' Task (Seq Subtask)
subtasks)

countCompleteSubtasks :: Task -> Int
countCompleteSubtasks :: Task -> Int
countCompleteSubtasks = Seq Subtask -> Int
forall mono. MonoFoldable mono => mono -> Int
length (Seq Subtask -> Int) -> (Task -> Seq Subtask) -> Task -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element (Seq Subtask) -> Bool) -> Seq Subtask -> Seq Subtask
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (Subtask -> Getting Bool Subtask Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Subtask Bool
Lens' Subtask Bool
ST.complete) (Seq Subtask -> Seq Subtask)
-> (Task -> Seq Subtask) -> Task -> Seq Subtask
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Task -> Getting (Seq Subtask) Task (Seq Subtask) -> Seq Subtask
forall s a. s -> Getting a s a -> a
^. Getting (Seq Subtask) Task (Seq Subtask)
Lens' Task (Seq Subtask)
subtasks)

contains :: Text -> Task -> Bool
contains :: Text -> Task -> Bool
contains Text
text Task
task =
    Text -> Bool
check (Task
task Task -> Getting Text Task Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Task Text
Lens' Task Text
name) Bool -> Bool -> Bool
|| Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
check (Task
task Task -> Getting (Maybe Text) Task (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Task (Maybe Text)
Lens' Task (Maybe Text)
description) Bool -> Bool -> Bool
|| Bool -> Bool
not (Seq Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Seq Text
sts)
  where
    check :: Text -> Bool
check = Text -> Text -> Bool
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
isInfixOf (Text -> Text
forall t. Textual t => t -> t
toLower Text
text) (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
forall t. Textual t => t -> t
toLower
    sts :: Seq Text
sts = (Element (Seq Text) -> Bool) -> Seq Text -> Seq Text
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter Text -> Bool
Element (Seq Text) -> Bool
check (Seq Text -> Seq Text) -> Seq Text -> Seq Text
forall a b. (a -> b) -> a -> b
$ (Subtask -> Getting Text Subtask Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Subtask Text
Lens' Subtask Text
ST.name) (Subtask -> Text) -> Seq Subtask -> Seq Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Task
task Task -> Getting (Seq Subtask) Task (Seq Subtask) -> Seq Subtask
forall s a. s -> Getting a s a -> a
^. Getting (Seq Subtask) Task (Seq Subtask)
Lens' Task (Seq Subtask)
subtasks)

isBlank :: Task -> Bool
isBlank :: Task -> Bool
isBlank Task
task =
    Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null (Task
task Task -> Getting Text Task Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Task Text
Lens' Task Text
name) Bool -> Bool -> Bool
&&
    Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Task
task Task -> Getting (Maybe Text) Task (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Task (Maybe Text)
Lens' Task (Maybe Text)
description) Bool -> Bool -> Bool
&& Seq Subtask -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null (Task
task Task -> Getting (Seq Subtask) Task (Seq Subtask) -> Seq Subtask
forall s a. s -> Getting a s a -> a
^. Getting (Seq Subtask) Task (Seq Subtask)
Lens' Task (Seq Subtask)
subtasks) Bool -> Bool -> Bool
&& Maybe Due -> Bool
forall a. Maybe a -> Bool
isNothing (Task
task Task -> Getting (Maybe Due) Task (Maybe Due) -> Maybe Due
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Due) Task (Maybe Due)
Lens' Task (Maybe Due)
due)

duplicate :: Task -> Task
duplicate :: Task -> Task
duplicate (Task Text
n Maybe Text
d Seq Subtask
st Maybe Due
du) = Text -> Maybe Text -> Seq Subtask -> Maybe Due -> Task
Task Text
n Maybe Text
d (Update
ST.duplicate Update -> Seq Subtask -> Seq Subtask
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Subtask
st) Maybe Due
du