module Taskwarrior.Task (
Task (..),
Tag,
makeTask,
) where
import Prelude hiding (id)
import Control.Applicative ((<|>))
import Control.Monad (join)
import Data.Aeson (
FromJSON,
ToJSON,
Value,
parseJSON,
withArray,
withObject,
withText,
(.:),
(.:?),
(.=),
)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Aeson.Types as Aeson.Types
import Data.Foldable (toList)
import qualified Data.Foldable as Foldable
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import qualified Data.Maybe as Maybe
import qualified Data.Semigroup as Semigroup
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time (UTCTime)
import Data.UUID (UUID)
import qualified Data.UUID as UUID
import Foreign.Marshal.Utils (fromBool)
import Taskwarrior.Annotation (Annotation)
import Taskwarrior.Priority (Priority)
import qualified Taskwarrior.Priority as Priority
import Taskwarrior.RecurringChild (RecurringChild)
import qualified Taskwarrior.RecurringChild as RecurringChild
import Taskwarrior.Status (Status)
import qualified Taskwarrior.Status as Status
import qualified Taskwarrior.Time as Time
import Taskwarrior.UDA (UDA)
data Task = Task
{ Task -> Status
status :: Status
, Task -> Maybe RecurringChild
recurringChild :: Maybe RecurringChild
, Task -> UUID
uuid :: UUID
, Task -> Maybe Integer
id :: Maybe Integer
, Task -> UTCTime
entry :: UTCTime
, Task -> Tag
description :: Text
, Task -> Maybe UTCTime
start :: Maybe UTCTime
, Task -> Maybe UTCTime
modified :: Maybe UTCTime
, Task -> Maybe UTCTime
wait :: Maybe UTCTime
, Task -> Maybe UTCTime
due :: Maybe UTCTime
, Task -> Maybe UTCTime
until :: Maybe UTCTime
, Task -> Set Annotation
annotations :: Set Annotation
, Task -> Maybe UTCTime
scheduled :: Maybe UTCTime
, Task -> Maybe Tag
project :: Maybe Text
, Task -> Maybe Priority
priority :: Maybe Priority
, Task -> Set UUID
depends :: Set UUID
, Task -> Set Tag
tags :: Set Tag
, Task -> Double
urgency :: Double
, Task -> UDA
uda :: UDA
}
deriving (Task -> Task -> Bool
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, Int -> Task -> ShowS
[Task] -> ShowS
Task -> String
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, ReadPrec [Task]
ReadPrec Task
Int -> ReadS Task
ReadS [Task]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Task]
$creadListPrec :: ReadPrec [Task]
readPrec :: ReadPrec Task
$creadPrec :: ReadPrec Task
readList :: ReadS [Task]
$creadList :: ReadS [Task]
readsPrec :: Int -> ReadS Task
$creadsPrec :: Int -> ReadS Task
Read)
type Tag = Text
reservedKeys :: [Text]
reservedKeys :: [Tag]
reservedKeys =
[ Tag
"status"
, Tag
"uuid"
, Tag
"id"
, Tag
"description"
, Tag
"entry"
, Tag
"modified"
, Tag
"due"
, Tag
"until"
, Tag
"scheduled"
, Tag
"annotations"
, Tag
"start"
, Tag
"project"
, Tag
"priority"
, Tag
"depends"
, Tag
"tags"
, Tag
"wait"
, Tag
"end"
, Tag
"mask"
, Tag
"imask"
, Tag
"parent"
, Tag
"recur"
, Tag
"urgency"
]
instance FromJSON Task where
parseJSON :: Value -> Parser Task
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Task" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
let parseTimeFromFieldMay :: Tag -> Parser (Maybe UTCTime)
parseTimeFromFieldMay = forall a. (Value -> Parser a) -> Object -> Tag -> Parser (Maybe a)
parseFromFieldWithMay Value -> Parser UTCTime
Time.parse Object
object
uda :: UDA
uda = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Tag
k Value
_ -> Tag
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Tag]
reservedKeys) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Key -> Tag
Key.toText forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> Map Key v
KeyMap.toMap Object
object
Status
status <- Object -> Parser Status
Status.parseFromObject Object
object
Maybe RecurringChild
recurringChild <- Object -> Parser (Maybe RecurringChild)
RecurringChild.parseFromObjectMay Object
object
UUID
uuid <- Object
object forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uuid"
Maybe Integer
idRaw <- Object
object forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
let id :: Maybe Integer
id = if Maybe Integer
idRaw forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Integer
0 then forall a. Maybe a
Nothing else Maybe Integer
idRaw
UTCTime
entry <- Object
object forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"entry" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser UTCTime
Time.parse
Tag
description <- Object
object forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
Maybe UTCTime
start <- Tag -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Tag
"start"
Maybe UTCTime
wait <- Tag -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Tag
"wait"
Maybe UTCTime
modified <- Tag -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Tag
"modified"
Maybe UTCTime
due <- Tag -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Tag
"due"
Maybe UTCTime
until_ <- Tag -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Tag
"until"
Maybe UTCTime
scheduled <- Tag -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Tag
"scheduled"
Set Annotation
annotations <- forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
object forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annotations"
Maybe Tag
project <- Object
object forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project"
Maybe Priority
priority <-
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Value -> Parser a) -> Object -> Tag -> Parser (Maybe a)
parseFromFieldWithMay Value -> Parser (Maybe Priority)
Priority.parseMay Object
object Tag
"priority"
Set UUID
depends <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)
Value -> Parser (Set UUID)
parseUuidList
(forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Tag -> Key
Key.fromText Tag
"depends") Object
object)
Set Tag
tags <- forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
object forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tags"
Double
urgency <- forall a. a -> Maybe a -> a
fromMaybe Double
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
object forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"urgency"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Task{until :: Maybe UTCTime
until = Maybe UTCTime
until_, Double
Maybe Integer
Maybe UTCTime
Maybe Tag
Maybe Priority
Maybe RecurringChild
UTCTime
Tag
UDA
Set Tag
Set UUID
Set Annotation
UUID
Status
urgency :: Double
tags :: Set Tag
depends :: Set UUID
priority :: Maybe Priority
project :: Maybe Tag
annotations :: Set Annotation
scheduled :: Maybe UTCTime
due :: Maybe UTCTime
modified :: Maybe UTCTime
wait :: Maybe UTCTime
start :: Maybe UTCTime
description :: Tag
entry :: UTCTime
id :: Maybe Integer
uuid :: UUID
recurringChild :: Maybe RecurringChild
status :: Status
uda :: UDA
uda :: UDA
urgency :: Double
tags :: Set Tag
depends :: Set UUID
priority :: Maybe Priority
project :: Maybe Tag
scheduled :: Maybe UTCTime
annotations :: Set Annotation
due :: Maybe UTCTime
wait :: Maybe UTCTime
modified :: Maybe UTCTime
start :: Maybe UTCTime
description :: Tag
entry :: UTCTime
id :: Maybe Integer
uuid :: UUID
recurringChild :: Maybe RecurringChild
status :: Status
..}
parseFromFieldWithMay ::
(Value -> Aeson.Types.Parser a) ->
Aeson.Object ->
Text ->
Aeson.Types.Parser (Maybe a)
parseFromFieldWithMay :: forall a. (Value -> Parser a) -> Object -> Tag -> Parser (Maybe a)
parseFromFieldWithMay Value -> Parser a
parser Object
object Tag
name =
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser a
parser (forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Tag -> Key
Key.fromText Tag
name) Object
object)
parseUuidList :: Aeson.Value -> Aeson.Types.Parser (Set UUID)
parseUuidList :: Value -> Parser (Set UUID)
parseUuidList Value
val =
(forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Array of uuid strings" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSON a => Value -> Parser a
parseJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) Value
val
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( forall a. String -> (Tag -> Parser a) -> Value -> Parser a
withText String
"Comma separated list of uuids" forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Ord a => [a] -> Set a
Set.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. FromJSON a => Value -> Parser a
parseJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Value
Aeson.String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Tag -> [Tag]
Text.splitOn Tag
","
)
Value
val
instance ToJSON Task where
toJSON :: Task -> Value
toJSON Task{until :: Task -> Maybe UTCTime
until = Maybe UTCTime
until_, Double
Maybe Integer
Maybe UTCTime
Maybe Tag
Maybe Priority
Maybe RecurringChild
UTCTime
Tag
UDA
Set Tag
Set UUID
Set Annotation
UUID
Status
uda :: UDA
urgency :: Double
tags :: Set Tag
depends :: Set UUID
priority :: Maybe Priority
project :: Maybe Tag
scheduled :: Maybe UTCTime
annotations :: Set Annotation
due :: Maybe UTCTime
wait :: Maybe UTCTime
modified :: Maybe UTCTime
start :: Maybe UTCTime
description :: Tag
entry :: UTCTime
id :: Maybe Integer
uuid :: UUID
recurringChild :: Maybe RecurringChild
status :: Status
uda :: Task -> UDA
urgency :: Task -> Double
tags :: Task -> Set Tag
depends :: Task -> Set UUID
priority :: Task -> Maybe Priority
project :: Task -> Maybe Tag
scheduled :: Task -> Maybe UTCTime
annotations :: Task -> Set Annotation
due :: Task -> Maybe UTCTime
wait :: Task -> Maybe UTCTime
modified :: Task -> Maybe UTCTime
start :: Task -> Maybe UTCTime
description :: Task -> Tag
entry :: Task -> UTCTime
id :: Task -> Maybe Integer
uuid :: Task -> UUID
recurringChild :: Task -> Maybe RecurringChild
status :: Task -> Status
..} =
[Pair] -> Value
Aeson.object forall a b. (a -> b) -> a -> b
$
Status -> [Pair]
Status.toPairs Status
status
forall a. Semigroup a => a -> a -> a
<> [ Key
"uuid" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UUID
uuid
, Key
"entry" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime -> Value
Time.toValue UTCTime
entry
, Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Tag
description
]
forall a. Semigroup a => a -> a -> a
<> [Key
"urgency" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
urgency | Double
urgency forall a. Eq a => a -> a -> Bool
/= Double
0]
forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] RecurringChild -> [Pair]
RecurringChild.toPairs Maybe RecurringChild
recurringChild
forall a. Semigroup a => a -> a -> a
<> forall b a. Ord b => Set b -> (Set b -> a) -> [a]
ifNotNullSet Set Annotation
annotations (Key
"annotations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
(\(Key
name, Maybe UTCTime
value) -> (Key
name forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Value
Time.toValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
value)
[ (Key
"start", Maybe UTCTime
start)
, (Key
"modified", Maybe UTCTime
modified)
, (Key
"wait", Maybe UTCTime
wait)
, (Key
"due", Maybe UTCTime
due)
, (Key
"scheduled", Maybe UTCTime
scheduled)
, (Key
"until", Maybe UTCTime
until_)
]
forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
Maybe.catMaybes
[ (Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
id
, (Key
"project" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Tag
project
, (Key
"priority" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Priority
priority
]
forall a. Semigroup a => a -> a -> a
<> forall b a. Ord b => Set b -> (Set b -> a) -> [a]
ifNotNullSet
Set UUID
depends
( (Key
"depends" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> [Tag] -> Tag
Text.intercalate Tag
","
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> Tag
UUID.toText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList
)
forall a. Semigroup a => a -> a -> a
<> forall b a. Ord b => Set b -> (Set b -> a) -> [a]
ifNotNullSet Set Tag
tags (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
forall a. Semigroup a => a -> a -> a
<> forall k a. Map k a -> [(k, a)]
Map.toList (forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Tag -> Key
Key.fromText UDA
uda)
ifNotNullSet :: (Ord b) => Set b -> (Set b -> a) -> [a]
ifNotNullSet :: forall b a. Ord b => Set b -> (Set b -> a) -> [a]
ifNotNullSet Set b
set Set b -> a
f =
( forall b a. (Integral b, Monoid a) => b -> a -> a
Semigroup.stimesMonoid forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => Bool -> a
fromBool :: Bool -> Integer) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Bool
Set.null forall a b. (a -> b) -> a -> b
$ Set b
set
)
[Set b -> a
f Set b
set]
makeTask :: UUID -> UTCTime -> Text -> Task
makeTask :: UUID -> UTCTime -> Tag -> Task
makeTask UUID
uuid UTCTime
entry Tag
description =
Task
{ UUID
uuid :: UUID
uuid :: UUID
uuid
, Tag
description :: Tag
description :: Tag
description
, UTCTime
entry :: UTCTime
entry :: UTCTime
entry
, id :: Maybe Integer
id = forall a. Maybe a
Nothing
, modified :: Maybe UTCTime
modified = forall a. a -> Maybe a
Just UTCTime
entry
, status :: Status
status = Status
Status.Pending
, recurringChild :: Maybe RecurringChild
recurringChild = forall a. Maybe a
Nothing
, due :: Maybe UTCTime
due = forall a. Maybe a
Nothing
, priority :: Maybe Priority
priority = forall a. Maybe a
Nothing
, project :: Maybe Tag
project = forall a. Maybe a
Nothing
, start :: Maybe UTCTime
start = forall a. Maybe a
Nothing
, scheduled :: Maybe UTCTime
scheduled = forall a. Maybe a
Nothing
, until :: Maybe UTCTime
until = forall a. Maybe a
Nothing
, wait :: Maybe UTCTime
wait = forall a. Maybe a
Nothing
, annotations :: Set Annotation
annotations = forall a. Monoid a => a
mempty
, depends :: Set UUID
depends = forall a. Monoid a => a
mempty
, tags :: Set Tag
tags = forall a. Monoid a => a
mempty
, urgency :: Double
urgency = Double
0
, uda :: UDA
uda = forall k a. Map k a
Map.empty
}