-- | ISO 8601 Compatibility

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

import qualified Data.Time.FromText as Time
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.Internal (Decoder(..))
import           Data.Hermes.Decoder.Value (withText)

-- | Run a Text parser as a Decoder.
runParser :: (Text -> Either String a) -> Text -> Decoder a
runParser :: forall a. (Text -> Either String a) -> Text -> Decoder a
runParser Text -> Either String a
p Text
t =
  case Text -> Either String a
p Text
t of
    Left String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Could not parse date: " forall a. Semigroup a => a -> a -> a
<> String
err
    Right a
r  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
{-# INLINE runParser #-}

-- | Parse a date of the form [+-]YYYY-MM-DD.
-- The year must contain at least 4 digits, to avoid the Y2K problem: a
-- two-digit year YY may mean YY, 19YY, or 20YY, and we make it an error to
-- prevent the ambiguity. Years from 0000 to 0999 must thus be zero-padded. The
-- year may have more than 4 digits.
day :: Decoder Time.Day
day :: Decoder Day
day = forall a. (Text -> Decoder a) -> Decoder a
withText forall a b. (a -> b) -> a -> b
$ forall a. (Text -> Either String a) -> Text -> Decoder a
runParser Text -> Either String Day
Time.parseDay

-- | Parse a date of the form @[+,-]YYYY-MM@.
month :: Decoder Time.Month
month :: Decoder Month
month = forall a. (Text -> Decoder a) -> Decoder a
withText forall a b. (a -> b) -> a -> b
$ forall a. (Text -> Either String a) -> Text -> Decoder a
runParser Text -> Either String Month
Time.parseMonth

-- | Parse a date of the form @[+,-]YYYY-QN@.
quarter :: Decoder Time.Quarter
quarter :: Decoder Quarter
quarter = forall a. (Text -> Decoder a) -> Decoder a
withText forall a b. (a -> b) -> a -> b
$ forall a. (Text -> Either String a) -> Text -> Decoder a
runParser Text -> Either String Quarter
Time.parseQuarter

-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
timeOfDay :: Decoder Local.TimeOfDay
timeOfDay :: Decoder TimeOfDay
timeOfDay = forall a. (Text -> Decoder a) -> Decoder a
withText forall a b. (a -> b) -> a -> b
$ forall a. (Text -> Either String a) -> Text -> Decoder a
runParser Text -> Either String TimeOfDay
Time.parseTimeOfDay

-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
-- zero. (This makes some speedups possible.)
timeZone :: Decoder Local.TimeZone
timeZone :: Decoder TimeZone
timeZone = forall a. (Text -> Decoder a) -> Decoder a
withText forall a b. (a -> b) -> a -> b
$ forall a. (Text -> Either String a) -> Text -> Decoder a
runParser Text -> Either String TimeZone
Time.parseTimeZone

-- | 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 :: Decoder Local.LocalTime
localTime :: Decoder LocalTime
localTime = forall a. (Text -> Decoder a) -> Decoder a
withText forall a b. (a -> b) -> a -> b
$ forall a. (Text -> Either String a) -> Text -> Decoder a
runParser Text -> Either String LocalTime
Time.parseLocalTime

-- | Behaves as 'zonedTime', but converts any time zone offset into a UTC time.
utcTime :: Decoder Time.UTCTime
utcTime :: Decoder UTCTime
utcTime = forall a. (Text -> Decoder a) -> Decoder a
withText forall a b. (a -> b) -> a -> b
$ forall a. (Text -> Either String a) -> Text -> Decoder a
runParser Text -> Either String UTCTime
Time.parseUTCTime

-- | 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 :: Decoder Local.ZonedTime
zonedTime :: Decoder ZonedTime
zonedTime = forall a. (Text -> Decoder a) -> Decoder a
withText forall a b. (a -> b) -> a -> b
$ forall a. (Text -> Either String a) -> Text -> Decoder a
runParser Text -> Either String ZonedTime
Time.parseZonedTime