-- | 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 qualified Data.Text                     as Text
import           Data.Text                      ( Text )
import           Data.Time                      ( UTCTime )
import qualified Data.UUID                     as UUID
import           Data.UUID                      ( UUID )
import qualified Data.Aeson                    as Aeson
import qualified Data.Aeson.Types              as Aeson.Types
import           Data.Aeson                     ( withObject
                                                , withText
                                                , FromJSON
                                                , ToJSON
                                                , parseJSON
                                                , (.:)
                                                , (.=)
                                                , (.:?)
                                                , Value
                                                )
import qualified Data.Semigroup                as Semigroup
import           Data.Maybe                     ( fromMaybe )
import qualified Data.Maybe                    as Maybe
import           Control.Monad                  ( join )
import qualified Data.Foldable                 as Foldable
import           Taskwarrior.Status             ( Status )
import qualified Taskwarrior.Status            as Status
import           Taskwarrior.RecurringChild     ( RecurringChild )
import qualified Taskwarrior.RecurringChild    as RecurringChild
import           Taskwarrior.Priority           ( Priority )
import qualified Taskwarrior.Priority          as Priority
import           Taskwarrior.UDA                ( UDA )
import           Taskwarrior.Annotation         ( Annotation )
import qualified Taskwarrior.Time              as Time
import qualified Data.HashMap.Strict           as HashMap
import           Foreign.Marshal.Utils          ( fromBool )

-- | 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.HashMap.Strict.HashMap'.
--
-- 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 -> Text
description    :: Text,
        Task -> Maybe UTCTime
start          :: Maybe UTCTime,
        Task -> Maybe UTCTime
modified       :: Maybe UTCTime,
        Task -> Maybe UTCTime
due            :: Maybe UTCTime,
        Task -> Maybe UTCTime
until          :: Maybe UTCTime,
        Task -> [Annotation]
annotations    :: [Annotation],
        Task -> Maybe UTCTime
scheduled      :: Maybe UTCTime,
        Task -> Maybe Text
project        :: Maybe Text,
        Task -> Maybe Priority
priority       :: Maybe Priority,
        Task -> [UUID]
depends        :: [UUID],
        Task -> [Text]
tags           :: [Tag],
        Task -> Double
urgency        :: Double,
        Task -> UDA
uda            :: UDA
} deriving (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, 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, ReadPrec [Task]
ReadPrec Task
Int -> ReadS Task
ReadS [Task]
(Int -> ReadS Task)
-> ReadS [Task] -> ReadPrec Task -> ReadPrec [Task] -> Read 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 :: [Text]
reservedKeys =
  [ "status"
  , "uuid"
  , "id"
  , "description"
  , "entry"
  , "modified"
  , "due"
  , "until"
  , "scheduled"
  , "annotations"
  , "start"
  , "project"
  , "priority"
  , "depends"
  , "tags"
  , "wait"
  , "end"
  , "mask"
  , "imask"
  , "parent"
  , "recur"
  , "urgency"
  ]

instance FromJSON Task where
  parseJSON :: Value -> Parser Task
parseJSON = String -> (UDA -> Parser Task) -> Value -> Parser Task
forall a. String -> (UDA -> Parser a) -> Value -> Parser a
withObject "Task" ((UDA -> Parser Task) -> Value -> Parser Task)
-> (UDA -> Parser Task) -> Value -> Parser Task
forall a b. (a -> b) -> a -> b
$ \object :: UDA
object -> do
    let parseTimeFromFieldMay :: Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay = (Value -> Parser UTCTime) -> UDA -> Text -> Parser (Maybe UTCTime)
forall a. (Value -> Parser a) -> UDA -> Text -> Parser (Maybe a)
parseFromFieldWithMay Value -> Parser UTCTime
Time.parse UDA
object
        uda :: UDA
uda = (Text -> Value -> Bool) -> UDA -> UDA
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey (\k :: Text
k _ -> Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
reservedKeys) UDA
object
    Status
status         <- UDA -> Parser Status
Status.parseFromObject UDA
object
    Maybe RecurringChild
recurringChild <- UDA -> Parser (Maybe RecurringChild)
RecurringChild.parseFromObjectMay UDA
object
    UUID
uuid           <- UDA
object UDA -> Text -> Parser UUID
forall a. FromJSON a => UDA -> Text -> Parser a
.: "uuid"
    Integer
idRaw          <- UDA
object UDA -> Text -> Parser Integer
forall a. FromJSON a => UDA -> Text -> Parser a
.: "id"
    let id :: Maybe Integer
id = if Integer
idRaw Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Maybe Integer
forall a. Maybe a
Nothing else Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
idRaw
    UTCTime
entry       <- UDA
object UDA -> Text -> Parser Value
forall a. FromJSON a => UDA -> Text -> Parser a
.: "entry" Parser Value -> (Value -> Parser UTCTime) -> Parser UTCTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser UTCTime
Time.parse
    Text
description <- UDA
object UDA -> Text -> Parser Text
forall a. FromJSON a => UDA -> Text -> Parser a
.: "description"
    Maybe UTCTime
start       <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay "start"
    Maybe UTCTime
modified    <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay "modified"
    Maybe UTCTime
due         <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay "due"
    Maybe UTCTime
until_      <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay "until"
    Maybe UTCTime
scheduled   <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay "scheduled"
    [Annotation]
annotations <- Maybe [Annotation] -> [Annotation]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold (Maybe [Annotation] -> [Annotation])
-> Parser (Maybe [Annotation]) -> Parser [Annotation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UDA
object UDA -> Text -> Parser (Maybe [Annotation])
forall a. FromJSON a => UDA -> Text -> Parser (Maybe a)
.:? "annotations"
    Maybe Text
project     <- UDA
object UDA -> Text -> Parser (Maybe Text)
forall a. FromJSON a => UDA -> Text -> Parser (Maybe a)
.:? "project"
    Maybe Priority
priority    <- Maybe (Maybe Priority) -> Maybe Priority
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
      (Maybe (Maybe Priority) -> Maybe Priority)
-> Parser (Maybe (Maybe Priority)) -> Parser (Maybe Priority)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (Maybe Priority))
-> UDA -> Text -> Parser (Maybe (Maybe Priority))
forall a. (Value -> Parser a) -> UDA -> Text -> Parser (Maybe a)
parseFromFieldWithMay Value -> Parser (Maybe Priority)
Priority.parseMay UDA
object "priority"
    [UUID]
depends <- Parser [UUID]
-> (Value -> Parser [UUID]) -> Maybe Value -> Parser [UUID]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([UUID] -> Parser [UUID]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Value -> Parser [UUID]
parseUuidList (Text -> UDA -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup "depends" UDA
object)
    [Text]
tags    <- Maybe [Text] -> [Text]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold (Maybe [Text] -> [Text]) -> Parser (Maybe [Text]) -> Parser [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UDA
object UDA -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => UDA -> Text -> Parser (Maybe a)
.:? "tags"
    Double
urgency <- UDA
object UDA -> Text -> Parser Double
forall a. FromJSON a => UDA -> Text -> Parser a
.: "urgency"
    Task -> Parser Task
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WTask :: Status
-> Maybe RecurringChild
-> UUID
-> Maybe Integer
-> UTCTime
-> Text
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> [Annotation]
-> Maybe UTCTime
-> Maybe Text
-> Maybe Priority
-> [UUID]
-> [Text]
-> Double
-> UDA
-> Task
Task { until :: Maybe UTCTime
until = Maybe UTCTime
until_, .. }

parseFromFieldWithMay
  :: (Value -> Aeson.Types.Parser a)
  -> Aeson.Object
  -> Text
  -> Aeson.Types.Parser (Maybe a)
parseFromFieldWithMay :: (Value -> Parser a) -> UDA -> Text -> Parser (Maybe a)
parseFromFieldWithMay parser :: Value -> Parser a
parser object :: UDA
object name :: Text
name =
  (Value -> Parser a) -> Maybe Value -> Parser (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser a
parser (Text -> UDA -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
name UDA
object)

parseUuidList :: Aeson.Value -> Aeson.Types.Parser [UUID]
parseUuidList :: Value -> Parser [UUID]
parseUuidList =
  String -> (Text -> Parser [UUID]) -> Value -> Parser [UUID]
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Text" ((Text -> Parser [UUID]) -> Value -> Parser [UUID])
-> (Text -> Parser [UUID]) -> Value -> Parser [UUID]
forall a b. (a -> b) -> a -> b
$ (Text -> Parser UUID) -> [Text] -> Parser [UUID]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Value -> Parser UUID
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser UUID) -> (Text -> Value) -> Text -> Parser UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
Aeson.String) ([Text] -> Parser [UUID])
-> (Text -> [Text]) -> Text -> Parser [UUID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn ","

instance ToJSON Task where
  toJSON :: Task -> Value
toJSON Task { until :: Task -> Maybe UTCTime
until = Maybe UTCTime
until_, ..} =
    [Pair] -> Value
Aeson.object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$  Status -> [Pair]
Status.toPairs Status
status
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ "uuid" Text -> UUID -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UUID
uuid
         , "id" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe Integer
id
         , "entry" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UTCTime -> Value
Time.toValue UTCTime
entry
         , "description" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
description
         , "urgency" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
urgency
         ]
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
-> (RecurringChild -> [Pair]) -> Maybe RecurringChild -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] RecurringChild -> [Pair]
RecurringChild.toPairs Maybe RecurringChild
recurringChild
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Annotation] -> ([Annotation] -> Pair) -> [Pair]
forall b a. [b] -> ([b] -> a) -> [a]
ifNotNullList [Annotation]
annotations ("annotations" Text -> [Annotation] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=)
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> ((Text, Maybe UTCTime) -> Maybe Pair)
-> [(Text, Maybe UTCTime)] -> [Pair]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
           (\(name :: Text
name, value :: Maybe UTCTime
value) -> (Text
name Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Value -> Pair) -> (UTCTime -> Value) -> UTCTime -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Value
Time.toValue (UTCTime -> Pair) -> Maybe UTCTime -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
value)
           [ ("start"    , Maybe UTCTime
start)
           , ("modified" , Maybe UTCTime
modified)
           , ("due"      , Maybe UTCTime
due)
           , ("scheduled", Maybe UTCTime
scheduled)
           , ("until"    , Maybe UTCTime
until_)
           ]
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
           [("project" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
project, ("priority" Text -> Priority -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Priority -> Pair) -> Maybe Priority -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Priority
priority]
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [UUID] -> ([UUID] -> Pair) -> [Pair]
forall b a. [b] -> ([b] -> a) -> [a]
ifNotNullList
           [UUID]
depends
           (("depends" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Text -> Pair) -> ([UUID] -> Text) -> [UUID] -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate "," ([Text] -> Text) -> ([UUID] -> [Text]) -> [UUID] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UUID -> Text) -> [UUID] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> Text
UUID.toText)
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Text] -> ([Text] -> Pair) -> [Pair]
forall b a. [b] -> ([b] -> a) -> [a]
ifNotNullList [Text]
tags ("tags" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=)
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> UDA -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList UDA
uda

ifNotNullList :: [b] -> ([b] -> a) -> [a]
ifNotNullList :: [b] -> ([b] -> a) -> [a]
ifNotNullList list :: [b]
list f :: [b] -> a
f =
  (Integer -> [a] -> [a]
forall b a. (Integral b, Monoid a) => b -> a -> a
Semigroup.stimesMonoid (Integer -> [a] -> [a]) -> ([b] -> Integer) -> [b] -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Integer
forall a. Num a => Bool -> a
fromBool :: Bool -> Integer) (Bool -> Integer) -> ([b] -> Bool) -> [b] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> ([b] -> Bool) -> [b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([b] -> [a] -> [a]) -> [b] -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [b]
list)
    [[b] -> a
f [b]
list]

-- | Makes a 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 -> Text -> Task
makeTask uuid :: UUID
uuid entry :: UTCTime
entry description :: Text
description = $WTask :: Status
-> Maybe RecurringChild
-> UUID
-> Maybe Integer
-> UTCTime
-> Text
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> [Annotation]
-> Maybe UTCTime
-> Maybe Text
-> Maybe Priority
-> [UUID]
-> [Text]
-> Double
-> UDA
-> Task
Task { UUID
uuid :: UUID
uuid :: UUID
uuid
                                       , Text
description :: Text
description :: Text
description
                                       , UTCTime
entry :: UTCTime
entry :: UTCTime
entry
                                       , id :: Maybe Integer
id             = Maybe Integer
forall a. Maybe a
Nothing
                                       , modified :: Maybe UTCTime
modified       = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
entry
                                       , status :: Status
status         = Status
Status.Pending
                                       , recurringChild :: Maybe RecurringChild
recurringChild = Maybe RecurringChild
forall a. Maybe a
Nothing
                                       , due :: Maybe UTCTime
due            = Maybe UTCTime
forall a. Maybe a
Nothing
                                       , priority :: Maybe Priority
priority       = Maybe Priority
forall a. Maybe a
Nothing
                                       , project :: Maybe Text
project        = Maybe Text
forall a. Maybe a
Nothing
                                       , start :: Maybe UTCTime
start          = Maybe UTCTime
forall a. Maybe a
Nothing
                                       , scheduled :: Maybe UTCTime
scheduled      = Maybe UTCTime
forall a. Maybe a
Nothing
                                       , until :: Maybe UTCTime
until          = Maybe UTCTime
forall a. Maybe a
Nothing
                                       , annotations :: [Annotation]
annotations    = []
                                       , depends :: [UUID]
depends        = []
                                       , tags :: [Text]
tags           = []
                                       , urgency :: Double
urgency        = 0
                                       , uda :: UDA
uda            = UDA
forall k v. HashMap k v
HashMap.empty
                                       }