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

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

-- | 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 } |
  Waiting { Status -> UTCTime
wait :: UTCTime } |
  Recurring {
    Status -> Text
recur :: Text,
    Status -> Mask
mask :: Mask}
  deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
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
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
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]
(Int -> ReadS Status)
-> ReadS [Status]
-> ReadPrec Status
-> ReadPrec [Status]
-> Read 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
Eq Status
-> (Status -> Status -> Ordering)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Status)
-> (Status -> Status -> Status)
-> Ord 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
$cp1Ord :: Eq Status
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 Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"status") Parser Text -> (Text -> Parser Status) -> Parser Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Text
"pending"   -> Status -> Parser Status
forall (f :: * -> *) a. Applicative f => a -> f a
pure Status
Pending
  Text
"deleted"   -> UTCTime -> Status
Deleted (UTCTime -> Status) -> Parser UTCTime -> Parser Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"end" 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
"completed" -> UTCTime -> Status
Completed (UTCTime -> Status) -> Parser UTCTime -> Parser Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"end" 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
"waiting"   -> UTCTime -> Status
Waiting (UTCTime -> Status) -> Parser UTCTime -> Parser Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"wait" 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
"recurring" -> Text -> Mask -> Status
Recurring (Text -> Mask -> Status) -> Parser Text -> Parser (Mask -> Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"recur" Parser (Mask -> Status) -> Parser Mask -> Parser Status
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Mask
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mask"
  Text
str         -> String -> Value -> Parser Status
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", Text
"end" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UTCTime -> Value
Time.toValue UTCTime
end]
  Completed {UTCTime
end :: UTCTime
end :: Status -> UTCTime
..} -> [Text -> Pair
statusLabel Text
"completed", Text
"end" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UTCTime -> Value
Time.toValue UTCTime
end]
  Waiting {UTCTime
wait :: UTCTime
wait :: Status -> UTCTime
..}   -> [Text -> Pair
statusLabel Text
"waiting", Text
"wait" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UTCTime -> Value
Time.toValue UTCTime
wait]
  Recurring {Text
Mask
mask :: Mask
recur :: Text
mask :: Status -> Mask
recur :: Status -> Text
..} -> [Text -> Pair
statusLabel Text
"recurring", Text
"recur" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
recur, Text
"mask" Text -> Mask -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Mask
mask]
 where
  statusLabel :: Text -> Pair
  statusLabel :: Text -> Pair
statusLabel = (Text
"status" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=)

instance FromJSON Status where
  parseJSON :: Value -> Parser Status
parseJSON = String -> (Object -> Parser Status) -> Value -> Parser Status
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 ([Pair] -> Value) -> (Status -> [Pair]) -> Status -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> [Pair]
toPairs
  toEncoding :: Status -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding) -> (Status -> Series) -> Status -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> (Status -> [Series]) -> Status -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Series) -> [Pair] -> [Series]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Value -> Series) -> Pair -> Series
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
(.=)) ([Pair] -> [Series]) -> (Status -> [Pair]) -> Status -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> [Pair]
toPairs