{- | This Module provides the RecurringChild type with
 FromJSON and ToJSON instances.
-}
module Taskwarrior.RecurringChild (
  RecurringChild (..),
  parseFromObjectMay,
  toPairs,
) where

import Control.Applicative (optional)
import Data.Aeson (
  FromJSON,
  Object,
  ToJSON,
  object,
  pairs,
  withObject,
  (.:),
  (.=),
 )
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (
  Pair,
  Parser,
 )
import Data.Text (Text)
import Data.UUID (UUID)

{- | The 'RecurringChild' type saves information about how a 'Taskwarrior.Task.Task'
 is child of another 'Taskwarrior.Task.Task' wich is recurring.
-}
data RecurringChild = RecurringChild
  { RecurringChild -> Text
recur :: Text
  , RecurringChild -> Integer
imask :: Integer
  , RecurringChild -> UUID
parent :: UUID
  }
  deriving (RecurringChild -> RecurringChild -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecurringChild -> RecurringChild -> Bool
$c/= :: RecurringChild -> RecurringChild -> Bool
== :: RecurringChild -> RecurringChild -> Bool
$c== :: RecurringChild -> RecurringChild -> Bool
Eq, Int -> RecurringChild -> ShowS
[RecurringChild] -> ShowS
RecurringChild -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecurringChild] -> ShowS
$cshowList :: [RecurringChild] -> ShowS
show :: RecurringChild -> String
$cshow :: RecurringChild -> String
showsPrec :: Int -> RecurringChild -> ShowS
$cshowsPrec :: Int -> RecurringChild -> ShowS
Show, ReadPrec [RecurringChild]
ReadPrec RecurringChild
Int -> ReadS RecurringChild
ReadS [RecurringChild]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecurringChild]
$creadListPrec :: ReadPrec [RecurringChild]
readPrec :: ReadPrec RecurringChild
$creadPrec :: ReadPrec RecurringChild
readList :: ReadS [RecurringChild]
$creadList :: ReadS [RecurringChild]
readsPrec :: Int -> ReadS RecurringChild
$creadsPrec :: Int -> ReadS RecurringChild
Read, Eq RecurringChild
RecurringChild -> RecurringChild -> Bool
RecurringChild -> RecurringChild -> Ordering
RecurringChild -> RecurringChild -> RecurringChild
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 :: RecurringChild -> RecurringChild -> RecurringChild
$cmin :: RecurringChild -> RecurringChild -> RecurringChild
max :: RecurringChild -> RecurringChild -> RecurringChild
$cmax :: RecurringChild -> RecurringChild -> RecurringChild
>= :: RecurringChild -> RecurringChild -> Bool
$c>= :: RecurringChild -> RecurringChild -> Bool
> :: RecurringChild -> RecurringChild -> Bool
$c> :: RecurringChild -> RecurringChild -> Bool
<= :: RecurringChild -> RecurringChild -> Bool
$c<= :: RecurringChild -> RecurringChild -> Bool
< :: RecurringChild -> RecurringChild -> Bool
$c< :: RecurringChild -> RecurringChild -> Bool
compare :: RecurringChild -> RecurringChild -> Ordering
$ccompare :: RecurringChild -> RecurringChild -> Ordering
Ord)

-- | Gathers all fields for a 'RecurringChild' status.
parseFromObjectMay :: Object -> Parser (Maybe RecurringChild)
parseFromObjectMay :: Object -> Parser (Maybe RecurringChild)
parseFromObjectMay = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Parser RecurringChild
parseFromObject

parseFromObject :: Object -> Parser RecurringChild
parseFromObject :: Object -> Parser RecurringChild
parseFromObject Object
o =
  Text -> Integer -> UUID -> RecurringChild
RecurringChild forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"recur" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"imask" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"parent"

-- | Can be used to serialize 'RecurringChild' to JSON.
toPairs :: RecurringChild -> [Pair]
toPairs :: RecurringChild -> [Pair]
toPairs RecurringChild{Integer
Text
UUID
parent :: UUID
imask :: Integer
recur :: Text
parent :: RecurringChild -> UUID
imask :: RecurringChild -> Integer
recur :: RecurringChild -> Text
..} =
  [Key
"recur" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
recur, Key
"imask" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
imask, Key
"parent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UUID
parent]

instance FromJSON RecurringChild where
  parseJSON :: Value -> Parser RecurringChild
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RecurringChild" Object -> Parser RecurringChild
parseFromObject

instance ToJSON RecurringChild where
  toJSON :: RecurringChild -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecurringChild -> [Pair]
toPairs
  toEncoding :: RecurringChild -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
(.=)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecurringChild -> [Pair]
toPairs