{- | This Module exports the main datatype of this library: Task.
 It is provided with FromJSON and ToJSON instances.
-}
module Taskwarrior.Task (
  Task (..),
  Tag,
  makeTask,
  {-
   | == Adherence to specification
   This library uses the [taskwarrior specification for the JSON serialisation format](https://taskwarrior.org/docs/design/task.html).
   But it deviates in a small number of ways to be more pragmatic.

   * 'Task' has the fields 'id' and 'urgency' although they are technically UDAs.
   * There are two invalid states which are not prevented via the Haskell type system by the chosen modeling:

     1. A 'Task' with a 'Just' value for 'recurringChild' should not have the 'Status' 'Taskwarrior.Status.Recurring'.
     2. The 'due' field needs to be a 'Just' value on a 'Task' with 'Status' 'Taskwarrior.Status.Recurring'.
  -}
) 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)

{- | A 'Task' represents a task from taskwarrior.
 The specification demands, that the existence of some fields is dependent on the status of the task.
 Those fields are therefore bundled in 'Status' as a sum-type.

 All fields in an imported task which are not part of the specification will be put in the 'UDA' (user defined attributes) 'Data.Map.Strict.Map Data.Text.Text'.

 Since the json can have multiple semantically equivalent representations of a task first serializing and then deserializing is not identity.
 But deserializing and then serializing should be. (Thus making serializing and deserializing idempotent.)
-}
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)

-- | A Tag can be basically any string. But beware: Special symbols work but might clash with @task@ cli syntax. As an example you can use a space in a @'Tag'@. But then you cannot use @task +my tag@ on the command line.
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]

-- | Makes a fresh Task with the given mandatory fields uuid, entry time and description. See createTask for a non-pure version which needs less parameters.
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
    }