{- | 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 -> Text
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 Text
project :: Maybe Text
  , Task -> Maybe Priority
priority :: Maybe Priority
  , Task -> Set UUID
depends :: Set UUID
  , Task -> Set Text
tags :: Set 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 =
  [ Text
"status"
  , Text
"uuid"
  , Text
"id"
  , Text
"description"
  , Text
"entry"
  , Text
"modified"
  , Text
"due"
  , Text
"until"
  , Text
"scheduled"
  , Text
"annotations"
  , Text
"start"
  , Text
"project"
  , Text
"priority"
  , Text
"depends"
  , Text
"tags"
  , Text
"wait"
  , Text
"end"
  , Text
"mask"
  , Text
"imask"
  , Text
"parent"
  , Text
"recur"
  , Text
"urgency"
  ]

instance FromJSON Task where
  parseJSON :: Value -> Parser Task
parseJSON = String -> (Object -> Parser Task) -> Value -> Parser Task
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Task" ((Object -> Parser Task) -> Value -> Parser Task)
-> (Object -> Parser Task) -> Value -> Parser Task
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    let parseTimeFromFieldMay :: Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay = (Value -> Parser UTCTime)
-> Object -> Text -> Parser (Maybe UTCTime)
forall a. (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
parseFromFieldWithMay Value -> Parser UTCTime
Time.parse Object
object
        uda :: UDA
uda = (Text -> Value -> Bool) -> UDA -> UDA
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Text
k Value
_ -> Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
reservedKeys) (UDA -> UDA) -> (Map Key Value -> UDA) -> Map Key Value -> UDA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> Text) -> Map Key Value -> UDA
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Key -> Text
Key.toText (Map Key Value -> UDA) -> Map Key Value -> UDA
forall a b. (a -> b) -> a -> b
$ Object -> Map Key Value
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 Object -> Key -> Parser UUID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uuid"
    Maybe Integer
idRaw <- Object
object Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
    let id :: Maybe Integer
id = if Maybe Integer
idRaw Maybe Integer -> Maybe Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0 then Maybe Integer
forall a. Maybe a
Nothing else Maybe Integer
idRaw
    UTCTime
entry <- Object
object Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 <- Object
object Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    Maybe UTCTime
start <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Text
"start"
    Maybe UTCTime
wait <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Text
"wait"
    Maybe UTCTime
modified <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Text
"modified"
    Maybe UTCTime
due <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Text
"due"
    Maybe UTCTime
until_ <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Text
"until"
    Maybe UTCTime
scheduled <- Text -> Parser (Maybe UTCTime)
parseTimeFromFieldMay Text
"scheduled"
    Set Annotation
annotations <- Maybe (Set Annotation) -> Set Annotation
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold (Maybe (Set Annotation) -> Set Annotation)
-> Parser (Maybe (Set Annotation)) -> Parser (Set Annotation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
object Object -> Key -> Parser (Maybe (Set Annotation))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annotations"
    Maybe Text
project <- Object
object Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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))
-> Object -> Text -> Parser (Maybe (Maybe Priority))
forall a. (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
parseFromFieldWithMay Value -> Parser (Maybe Priority)
Priority.parseMay Object
object Text
"priority"
    Set UUID
depends <-
      Parser (Set UUID)
-> (Value -> Parser (Set UUID)) -> Maybe Value -> Parser (Set UUID)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Set UUID -> Parser (Set UUID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set UUID
forall a. Monoid a => a
mempty)
        Value -> Parser (Set UUID)
parseUuidList
        (Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
"depends") Object
object)
    Set Text
tags <- Maybe (Set Text) -> Set Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold (Maybe (Set Text) -> Set Text)
-> Parser (Maybe (Set Text)) -> Parser (Set Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
object Object -> Key -> Parser (Maybe (Set Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tags"
    Double
urgency <- Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Maybe Double -> Double) -> Parser (Maybe Double) -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
object Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"urgency"
    Task -> Parser Task
forall (f :: * -> *) a. Applicative f => a -> f a
pure Task :: Status
-> Maybe RecurringChild
-> UUID
-> Maybe Integer
-> UTCTime
-> Text
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Set Annotation
-> Maybe UTCTime
-> Maybe Text
-> Maybe Priority
-> Set UUID
-> Set Text
-> Double
-> UDA
-> Task
Task{until :: Maybe UTCTime
until = Maybe UTCTime
until_, Double
Maybe Integer
Maybe Text
Maybe UTCTime
Maybe Priority
Maybe RecurringChild
UDA
Set Text
Set UUID
Set Annotation
Text
UTCTime
UUID
Status
urgency :: Double
tags :: Set Text
depends :: Set UUID
priority :: Maybe Priority
project :: Maybe Text
annotations :: Set Annotation
scheduled :: Maybe UTCTime
due :: Maybe UTCTime
modified :: Maybe UTCTime
wait :: Maybe UTCTime
start :: Maybe UTCTime
description :: Text
entry :: UTCTime
id :: Maybe Integer
uuid :: UUID
recurringChild :: Maybe RecurringChild
status :: Status
uda :: UDA
uda :: UDA
urgency :: Double
tags :: Set Text
depends :: Set UUID
priority :: Maybe Priority
project :: Maybe Text
scheduled :: Maybe UTCTime
annotations :: Set Annotation
due :: Maybe UTCTime
wait :: Maybe UTCTime
modified :: Maybe UTCTime
start :: Maybe UTCTime
description :: Text
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 :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
parseFromFieldWithMay Value -> Parser a
parser Object
object 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 (Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
name) Object
object)

parseUuidList :: Aeson.Value -> Aeson.Types.Parser (Set UUID)
parseUuidList :: Value -> Parser (Set UUID)
parseUuidList Value
val =
  (String
-> (Array -> Parser (Set UUID)) -> Value -> Parser (Set UUID)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Array of uuid strings" ((Array -> Parser (Set UUID)) -> Value -> Parser (Set UUID))
-> (Array -> Parser (Set UUID)) -> Value -> Parser (Set UUID)
forall a b. (a -> b) -> a -> b
$ ([UUID] -> Set UUID) -> Parser [UUID] -> Parser (Set UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [UUID] -> Set UUID
forall a. Ord a => [a] -> Set a
Set.fromList (Parser [UUID] -> Parser (Set UUID))
-> (Array -> Parser [UUID]) -> Array -> Parser (Set UUID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser UUID) -> [Value] -> 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])
-> (Array -> [Value]) -> Array -> Parser [UUID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) Value
val
    Parser (Set UUID) -> Parser (Set UUID) -> Parser (Set UUID)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( String -> (Text -> Parser (Set UUID)) -> Value -> Parser (Set UUID)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Comma separated list of uuids" ((Text -> Parser (Set UUID)) -> Value -> Parser (Set UUID))
-> (Text -> Parser (Set UUID)) -> Value -> Parser (Set UUID)
forall a b. (a -> b) -> a -> b
$
            ([UUID] -> Set UUID) -> Parser [UUID] -> Parser (Set UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [UUID] -> Set UUID
forall a. Ord a => [a] -> Set a
Set.fromList
              (Parser [UUID] -> Parser (Set UUID))
-> (Text -> Parser [UUID]) -> Text -> Parser (Set UUID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 Text
","
        )
      Value
val

instance ToJSON Task where
  toJSON :: Task -> Value
toJSON Task{until :: Task -> Maybe UTCTime
until = Maybe UTCTime
until_, Double
Maybe Integer
Maybe Text
Maybe UTCTime
Maybe Priority
Maybe RecurringChild
UDA
Set Text
Set UUID
Set Annotation
Text
UTCTime
UUID
Status
uda :: UDA
urgency :: Double
tags :: Set Text
depends :: Set UUID
priority :: Maybe Priority
project :: Maybe Text
scheduled :: Maybe UTCTime
annotations :: Set Annotation
due :: Maybe UTCTime
wait :: Maybe UTCTime
modified :: Maybe UTCTime
start :: Maybe UTCTime
description :: Text
entry :: UTCTime
id :: Maybe Integer
uuid :: UUID
recurringChild :: Maybe RecurringChild
status :: Status
uda :: Task -> UDA
urgency :: Task -> Double
tags :: Task -> Set Text
depends :: Task -> Set UUID
priority :: Task -> Maybe Priority
project :: Task -> Maybe Text
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 -> Text
entry :: Task -> UTCTime
id :: Task -> Maybe Integer
uuid :: Task -> UUID
recurringChild :: Task -> Maybe RecurringChild
status :: Task -> Status
..} =
    [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
<> [ Key
"uuid" Key -> UUID -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UUID
uuid
           , Key
"entry" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime -> Value
Time.toValue UTCTime
entry
           , Key
"description" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
description
           ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Key
"urgency" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
urgency | Double
urgency Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0]
        [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
<> Set Annotation -> (Set Annotation -> Pair) -> [Pair]
forall b a. Ord b => Set b -> (Set b -> a) -> [a]
ifNotNullSet Set Annotation
annotations (Key
"annotations" Key -> Set Annotation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> ((Key, Maybe UTCTime) -> Maybe Pair)
-> [(Key, Maybe UTCTime)] -> [Pair]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
          (\(Key
name, Maybe UTCTime
value) -> (Key
name Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
          [ (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_)
          ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
          [ (Key
"id" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Integer -> Pair) -> Maybe Integer -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
id
          , (Key
"project" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
project
          , (Key
"priority" Key -> Priority -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
<> Set UUID -> (Set UUID -> Pair) -> [Pair]
forall b a. Ord b => Set b -> (Set b -> a) -> [a]
ifNotNullSet
          Set UUID
depends
          ( (Key
"depends" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
              (Text -> Pair) -> (Set UUID -> Text) -> Set UUID -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
","
              ([Text] -> Text) -> (Set UUID -> [Text]) -> Set 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
              ([UUID] -> [Text]) -> (Set UUID -> [UUID]) -> Set UUID -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set UUID -> [UUID]
forall a. Set a -> [a]
Set.toList
          )
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Set Text -> (Set Text -> Pair) -> [Pair]
forall b a. Ord b => Set b -> (Set b -> a) -> [a]
ifNotNullSet Set Text
tags (Key
"tags" Key -> Set Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Map Key Value -> [Pair]
forall k a. Map k a -> [(k, a)]
Map.toList ((Text -> Key) -> UDA -> Map Key Value
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Text -> Key
Key.fromText UDA
uda)

ifNotNullSet :: (Ord b) => Set b -> (Set b -> a) -> [a]
ifNotNullSet :: Set b -> (Set b -> a) -> [a]
ifNotNullSet Set b
set Set b -> a
f =
  ( Integer -> [a] -> [a]
forall b a. (Integral b, Monoid a) => b -> a -> a
Semigroup.stimesMonoid (Integer -> [a] -> [a])
-> (Set b -> Integer) -> Set 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) -> (Set b -> Bool) -> Set b -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (Set b -> Bool) -> Set b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set b -> Bool
forall a. Set a -> Bool
Set.null (Set b -> [a] -> [a]) -> Set b -> [a] -> [a]
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 -> Text -> Task
makeTask UUID
uuid UTCTime
entry Text
description =
  Task :: Status
-> Maybe RecurringChild
-> UUID
-> Maybe Integer
-> UTCTime
-> Text
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Set Annotation
-> Maybe UTCTime
-> Maybe Text
-> Maybe Priority
-> Set UUID
-> Set 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
    , wait :: Maybe UTCTime
wait = Maybe UTCTime
forall a. Maybe a
Nothing
    , annotations :: Set Annotation
annotations = Set Annotation
forall a. Monoid a => a
mempty
    , depends :: Set UUID
depends = Set UUID
forall a. Monoid a => a
mempty
    , tags :: Set Text
tags = Set Text
forall a. Monoid a => a
mempty
    , urgency :: Double
urgency = Double
0
    , uda :: UDA
uda = UDA
forall k a. Map k a
Map.empty
    }