-- | This module provides no own time type for taskwarrior rather it only gives deserialisation and serialisation support.
module Taskwarrior.Time
  ( parse
  , toValue
  )
where
import           Data.Aeson                     ( withText )
import qualified Data.Aeson                    as Aeson
import           Data.Aeson.Types               ( Parser
                                                , typeMismatch
                                                )
import           Data.Time                      ( UTCTime
                                                , parseTimeM
                                                , defaultTimeLocale
                                                )
import qualified Data.Time.Format              as Time.Format
import qualified Data.Text                     as Text

-- | Converts a time to the taskwarrior time format.
toValue :: UTCTime -> Aeson.Value
toValue :: UTCTime -> Value
toValue UTCTime
time = Text -> Value
Aeson.String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.Format.formatTime
  TimeLocale
defaultTimeLocale
  String
"%Y%m%dT%H%M%SZ"
  UTCTime
time

-- | Parses a JSON string from the taskwarrior time format.
parse :: Aeson.Value -> Parser UTCTime
parse :: Value -> Parser UTCTime
parse Value
value = String -> (Text -> Parser UTCTime) -> Value -> Parser UTCTime
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText
  String
"Date"
  ( Parser UTCTime
-> (UTCTime -> Parser UTCTime) -> Maybe UTCTime -> Parser UTCTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Value -> Parser UTCTime
forall a. String -> Value -> Parser a
typeMismatch String
"Date" Value
value) UTCTime -> Parser UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (Maybe UTCTime -> Parser UTCTime)
-> (Text -> Maybe UTCTime) -> Text -> Parser UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
"%Y%m%dT%H%M%SZ"
  (String -> Maybe UTCTime)
-> (Text -> String) -> Text -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
  )
  Value
value