-- | Provides the 'Annotation' type with 'Data.Aeson.ToJSON' and 'Data.Aeson.FromJSON' instances.
module Taskwarrior.Annotation (
  Annotation (..),
) where

import Data.Aeson (
  (.:),
  (.=),
 )
import qualified Data.Aeson as Aeson
import Data.Text (Text)
import Data.Time (UTCTime)
import qualified Taskwarrior.Time as Time

-- | A taskwarrior 'Taskwarrior.Task.Task' can have multiple annotations. They contain a timestamp 'entry' and a 'description'.
data Annotation = Annotation {Annotation -> UTCTime
entry :: UTCTime, Annotation -> Text
description :: Text} deriving (Annotation -> Annotation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Eq, Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Show, ReadPrec [Annotation]
ReadPrec Annotation
Int -> ReadS Annotation
ReadS [Annotation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Annotation]
$creadListPrec :: ReadPrec [Annotation]
readPrec :: ReadPrec Annotation
$creadPrec :: ReadPrec Annotation
readList :: ReadS [Annotation]
$creadList :: ReadS [Annotation]
readsPrec :: Int -> ReadS Annotation
$creadsPrec :: Int -> ReadS Annotation
Read, Eq Annotation
Annotation -> Annotation -> Bool
Annotation -> Annotation -> Ordering
Annotation -> Annotation -> Annotation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Annotation -> Annotation -> Annotation
$cmin :: Annotation -> Annotation -> Annotation
max :: Annotation -> Annotation -> Annotation
$cmax :: Annotation -> Annotation -> Annotation
>= :: Annotation -> Annotation -> Bool
$c>= :: Annotation -> Annotation -> Bool
> :: Annotation -> Annotation -> Bool
$c> :: Annotation -> Annotation -> Bool
<= :: Annotation -> Annotation -> Bool
$c<= :: Annotation -> Annotation -> Bool
< :: Annotation -> Annotation -> Bool
$c< :: Annotation -> Annotation -> Bool
compare :: Annotation -> Annotation -> Ordering
$ccompare :: Annotation -> Annotation -> Ordering
Ord)

instance Aeson.FromJSON Annotation where
  parseJSON :: Value -> Parser Annotation
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Annotation" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
description <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    UTCTime
entry <- Object
o 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
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Annotation{UTCTime
Text
entry :: UTCTime
description :: Text
description :: Text
entry :: UTCTime
..}

instance Aeson.ToJSON Annotation where
  toJSON :: Annotation -> Value
toJSON Annotation{UTCTime
Text
description :: Text
entry :: UTCTime
description :: Annotation -> Text
entry :: Annotation -> UTCTime
..} =
    [Pair] -> Value
Aeson.object [Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
description, Key
"entry" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime -> Value
Time.toValue UTCTime
entry]