-- | ISO 8601 Compatibility

module Data.Hermes.Decoder.Time
  ( day
  , localTime
  , month
  , quarter
  , timeOfDay
  , timeZone
  , utcTime
  , zonedTime
  ) where

import qualified Data.Attoparsec.Text as AT
import qualified Data.Attoparsec.Time as ATime
import           Data.Text (Text)
import qualified Data.Time as Time
import qualified Data.Time.Calendar.Month.Compat as Time
import qualified Data.Time.Calendar.Quarter.Compat as Time
import qualified Data.Time.LocalTime as Local

import           Data.Hermes.Decoder.Types (Decoder)
import           Data.Hermes.Decoder.Value (withText)
import           Data.Hermes.SIMDJSON

-- | Run an attoparsec text parser as a hermes decoder.
runAttoDate :: AT.Parser a -> Text -> Decoder a
runAttoDate :: Parser a -> Text -> Decoder a
runAttoDate Parser a
p Text
t =
  case Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser a
p Parser a -> Parser Text () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AT.endOfInput) Text
t of
    Left String
err -> String -> Decoder a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder a) -> String -> Decoder a
forall a b. (a -> b) -> a -> b
$ String
"Could not parse date: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
    Right a
r  -> a -> Decoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
{-# INLINE runAttoDate #-}

-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
day :: Value -> Decoder Time.Day
day :: Value -> Decoder Day
day = (Text -> Decoder Day) -> Value -> Decoder Day
forall a. (Text -> Decoder a) -> Value -> Decoder a
withText ((Text -> Decoder Day) -> Value -> Decoder Day)
-> (Text -> Decoder Day) -> Value -> Decoder Day
forall a b. (a -> b) -> a -> b
$ Parser Day -> Text -> Decoder Day
forall a. Parser a -> Text -> Decoder a
runAttoDate Parser Day
ATime.day

-- | Parse a date of the form @[+,-]YYYY-MM@.
month :: Value -> Decoder Time.Month
month :: Value -> Decoder Month
month = (Text -> Decoder Month) -> Value -> Decoder Month
forall a. (Text -> Decoder a) -> Value -> Decoder a
withText ((Text -> Decoder Month) -> Value -> Decoder Month)
-> (Text -> Decoder Month) -> Value -> Decoder Month
forall a b. (a -> b) -> a -> b
$ Parser Month -> Text -> Decoder Month
forall a. Parser a -> Text -> Decoder a
runAttoDate Parser Month
ATime.month

-- | Parse a date of the form @[+,-]YYYY-QN@.
quarter :: Value -> Decoder Time.Quarter
quarter :: Value -> Decoder Quarter
quarter = (Text -> Decoder Quarter) -> Value -> Decoder Quarter
forall a. (Text -> Decoder a) -> Value -> Decoder a
withText ((Text -> Decoder Quarter) -> Value -> Decoder Quarter)
-> (Text -> Decoder Quarter) -> Value -> Decoder Quarter
forall a b. (a -> b) -> a -> b
$ Parser Quarter -> Text -> Decoder Quarter
forall a. Parser a -> Text -> Decoder a
runAttoDate Parser Quarter
ATime.quarter

-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
timeOfDay :: Value -> Decoder Local.TimeOfDay
timeOfDay :: Value -> Decoder TimeOfDay
timeOfDay = (Text -> Decoder TimeOfDay) -> Value -> Decoder TimeOfDay
forall a. (Text -> Decoder a) -> Value -> Decoder a
withText ((Text -> Decoder TimeOfDay) -> Value -> Decoder TimeOfDay)
-> (Text -> Decoder TimeOfDay) -> Value -> Decoder TimeOfDay
forall a b. (a -> b) -> a -> b
$ Parser TimeOfDay -> Text -> Decoder TimeOfDay
forall a. Parser a -> Text -> Decoder a
runAttoDate Parser TimeOfDay
ATime.timeOfDay

-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
-- zero. (This makes some speedups possible.)
timeZone :: Value -> Decoder (Maybe Local.TimeZone)
timeZone :: Value -> Decoder (Maybe TimeZone)
timeZone = (Text -> Decoder (Maybe TimeZone))
-> Value -> Decoder (Maybe TimeZone)
forall a. (Text -> Decoder a) -> Value -> Decoder a
withText ((Text -> Decoder (Maybe TimeZone))
 -> Value -> Decoder (Maybe TimeZone))
-> (Text -> Decoder (Maybe TimeZone))
-> Value
-> Decoder (Maybe TimeZone)
forall a b. (a -> b) -> a -> b
$ Parser (Maybe TimeZone) -> Text -> Decoder (Maybe TimeZone)
forall a. Parser a -> Text -> Decoder a
runAttoDate Parser (Maybe TimeZone)
ATime.timeZone

-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@.
-- The space may be replaced with a @T@. The number of seconds is optional
-- and may be followed by a fractional component.
localTime :: Value -> Decoder Local.LocalTime
localTime :: Value -> Decoder LocalTime
localTime = (Text -> Decoder LocalTime) -> Value -> Decoder LocalTime
forall a. (Text -> Decoder a) -> Value -> Decoder a
withText ((Text -> Decoder LocalTime) -> Value -> Decoder LocalTime)
-> (Text -> Decoder LocalTime) -> Value -> Decoder LocalTime
forall a b. (a -> b) -> a -> b
$ Parser LocalTime -> Text -> Decoder LocalTime
forall a. Parser a -> Text -> Decoder a
runAttoDate Parser LocalTime
ATime.localTime

-- | Behaves as 'zonedTime', but converts any time zone offset into a UTC time.
utcTime :: Value -> Decoder Time.UTCTime
utcTime :: Value -> Decoder UTCTime
utcTime = (Text -> Decoder UTCTime) -> Value -> Decoder UTCTime
forall a. (Text -> Decoder a) -> Value -> Decoder a
withText ((Text -> Decoder UTCTime) -> Value -> Decoder UTCTime)
-> (Text -> Decoder UTCTime) -> Value -> Decoder UTCTime
forall a b. (a -> b) -> a -> b
$ Parser UTCTime -> Text -> Decoder UTCTime
forall a. Parser a -> Text -> Decoder a
runAttoDate Parser UTCTime
ATime.utcTime

-- | Parse a date with time zone info. Acceptable formats:
--
-- @YYYY-MM-DD HH:MM Z@
-- @YYYY-MM-DD HH:MM:SS Z@
-- @YYYY-MM-DD HH:MM:SS.SSS Z@
--
-- The first space may instead be a @T@, and the second space is
-- optional.  The @Z@ represents UTC.  The @Z@ may be replaced with a
-- time zone offset of the form @+0000@ or @-08:00@, where the first
-- two digits are hours, the @:@ is optional and the second two digits
-- (also optional) are minutes.
zonedTime :: Value -> Decoder Local.ZonedTime
zonedTime :: Value -> Decoder ZonedTime
zonedTime = (Text -> Decoder ZonedTime) -> Value -> Decoder ZonedTime
forall a. (Text -> Decoder a) -> Value -> Decoder a
withText ((Text -> Decoder ZonedTime) -> Value -> Decoder ZonedTime)
-> (Text -> Decoder ZonedTime) -> Value -> Decoder ZonedTime
forall a b. (a -> b) -> a -> b
$ Parser ZonedTime -> Text -> Decoder ZonedTime
forall a. Parser a -> Text -> Decoder a
runAttoDate Parser ZonedTime
ATime.zonedTime