-- | This module deals with information of a task which is dependent on the status.
module Taskwarrior.Status (
  Status (..),
  parseFromObject,
  toPairs,
) where

import Data.Aeson (
  FromJSON,
  Object,
  ToJSON,
  object,
  pairs,
  withObject,
  (.:),
  (.=),
 )
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (
  Pair,
  Parser,
  typeMismatch,
 )
import Data.Text (Text)
import Data.Time (UTCTime)
import Taskwarrior.Mask (Mask)
import qualified Taskwarrior.Time as Time

{- | A task can be pending, deleted, completed, waiting or recurring.
 It is recommended to access the fields only by pattern matching since the getters are partial.
-}
data Status
  = Pending
  | Deleted {Status -> UTCTime
end :: UTCTime}
  | Completed {end :: UTCTime}
  | Recurring
      { Status -> Text
recur :: Text
      , Status -> Mask
mask :: Mask
      }
  deriving (Status -> Status -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show, ReadPrec [Status]
ReadPrec Status
Int -> ReadS Status
ReadS [Status]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Status]
$creadListPrec :: ReadPrec [Status]
readPrec :: ReadPrec Status
$creadPrec :: ReadPrec Status
readList :: ReadS [Status]
$creadList :: ReadS [Status]
readsPrec :: Int -> ReadS Status
$creadsPrec :: Int -> ReadS Status
Read, Eq Status
Status -> Status -> Bool
Status -> Status -> Ordering
Status -> Status -> Status
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 :: Status -> Status -> Status
$cmin :: Status -> Status -> Status
max :: Status -> Status -> Status
$cmax :: Status -> Status -> Status
>= :: Status -> Status -> Bool
$c>= :: Status -> Status -> Bool
> :: Status -> Status -> Bool
$c> :: Status -> Status -> Bool
<= :: Status -> Status -> Bool
$c<= :: Status -> Status -> Bool
< :: Status -> Status -> Bool
$c< :: Status -> Status -> Bool
compare :: Status -> Status -> Ordering
$ccompare :: Status -> Status -> Ordering
Ord)

-- | Takes all information that is dependent on the status from a JSON object.
parseFromObject :: Object -> Parser Status
parseFromObject :: Object -> Parser Status
parseFromObject Object
o =
  (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"pending" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Status
Pending
    Text
"deleted" -> UTCTime -> Status
Deleted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"end" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser UTCTime
Time.parse)
    Text
"completed" -> UTCTime -> Status
Completed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"end" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser UTCTime
Time.parse)
    Text
"recurring" -> Text -> Mask -> Status
Recurring 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
"mask"
    Text
str -> forall a. String -> Value -> Parser a
typeMismatch String
"status" (Text -> Value
Aeson.String Text
str)

-- | A list of Pairs can be used to construct a JSON object later. The result of 'toPairs' is supposed to be combined with the rest of the fields of a task.
toPairs :: Status -> [Pair]
toPairs :: Status -> [Pair]
toPairs = \case
  Status
Pending -> [Text -> Pair
statusLabel Text
"pending"]
  Deleted{UTCTime
end :: UTCTime
end :: Status -> UTCTime
..} -> [Text -> Pair
statusLabel Text
"deleted", Key
"end" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime -> Value
Time.toValue UTCTime
end]
  Completed{UTCTime
end :: UTCTime
end :: Status -> UTCTime
..} -> [Text -> Pair
statusLabel Text
"completed", Key
"end" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime -> Value
Time.toValue UTCTime
end]
  Recurring{Text
Mask
mask :: Mask
recur :: Text
mask :: Status -> Mask
recur :: Status -> Text
..} -> [Text -> Pair
statusLabel Text
"recurring", Key
"recur" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
recur, Key
"mask" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Mask
mask]
 where
  statusLabel :: Text -> Pair
  statusLabel :: Text -> Pair
statusLabel = (Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)

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

instance ToJSON Status where
  toJSON :: Status -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> [Pair]
toPairs
  toEncoding :: Status -> 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
. Status -> [Pair]
toPairs