Time.hs

{-|
Module:      Z.Data.Parser.Time
Description : Parsers for types from time.
Copyright:   (c) 2015-2016 Bryan O'Sullivan
             (c) 2020 Dong Han
License:     BSD3
Maintainer:  Dong <winterland1989@gmail.com>
Stability:   experimental
Portability: portable

Parsers for parsing dates and times.
-}

module Z.Data.Parser.Time
    ( day
    , localTime
    , timeOfDay
    , timeZone
    , utcTime
    , zonedTime
    ) where

import Control.Applicative ((<|>))
import Z.Data.Parser.Base       (Parser)
import qualified Z.Data.Parser.Base       as P
import qualified Z.Data.Parser.Numeric    as P
import Z.Data.ASCII
import Data.Fixed (Pico, Fixed(..))
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (Day, fromGregorianValid)
import Data.Time.Clock (UTCTime(..))
import qualified Z.Data.Vector  as V
import Data.Time.LocalTime      hiding (utc)

-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
day :: Parser Day
day = "date must be of form [+,-]YYYY-MM-DD" P.<?> do
    absOrNeg <- negate <$ P.word8 MINUS <|> id <$ P.word8 PLUS <|> pure id
    y <- (P.integer <* P.word8 HYPHEN)
    m <- (twoDigits <* P.word8 HYPHEN)
    d <- twoDigits
    maybe (P.fail' "invalid date") return (fromGregorianValid (absOrNeg y) m d)

-- | Parse a two-digit integer (e.g. day of month, hour).
twoDigits :: Parser Int
twoDigits = do
    a <- P.digit
    b <- P.digit
    return $! a * 10 + b

-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
timeOfDay :: Parser TimeOfDay
timeOfDay = do
    h <- twoDigits
    m <- P.char8 ':' *> twoDigits
    s <- (P.char8 ':' *> seconds) <|> pure 0
    if h < 24 && m < 60 && s < 61
    then return (TimeOfDay h m s)
    else P.fail' "invalid time"


-- | Parse a count of seconds, with the integer part being two digits -- long.
seconds :: Parser Pico
seconds = do
    real <- twoDigits
    mw <- P.peekMaybe
    case mw of
        Just DOT -> do
            t <- P.skipWord8 *> P.takeWhile1 isDigit
            return $! parsePicos real t
        _ -> return $! fromIntegral real
 where
    parsePicos a0 t =
        let V.IPair n t'  = V.foldl' step (V.IPair 12 (fromIntegral a0 :: Int64)) t
            step ma@(V.IPair m !a) w
                | m <= 0    = ma
                | otherwise = V.IPair (m-1) (10 * a + P.w2iDec w)
        in MkFixed (fromIntegral (t' * 10^n))

-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
-- zero. (This makes some speedups possible.)
timeZone :: Parser (Maybe TimeZone)
timeZone = do
    P.skipWhile (== SPACE)
    w <- P.satisfy $ \ w -> w == LETTER_Z || w == PLUS || w == MINUS
    if w == LETTER_Z
    then return Nothing
    else do
        h <- twoDigits
        mm <- P.peekMaybe
        m <- case mm of
               Just COLON         -> P.skipWord8 *> twoDigits
               Just d | isDigit d -> twoDigits
               _                  -> return 0
        let off | w == MINUS = negate off0
                | otherwise  = off0
            off0 = h * 60 + m
        case () of
          _   | off == 0 ->
                return Nothing
              | off < -720 || off > 840 || m > 59 ->
                fail "invalid time zone offset"
              | otherwise ->
                    let !tz = minutesToTimeZone off
                    in return (Just tz)

-- | 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 :: Parser LocalTime
localTime = LocalTime <$> day <* daySep <*> timeOfDay
  where daySep = P.satisfy (\ w -> w == LETTER_T || w == SPACE)

-- | Behaves as 'zonedTime', but converts any time zone offset into a -- UTC time.
utcTime :: Parser UTCTime
utcTime = do
    lt@(LocalTime d t) <- localTime
    mtz <- timeZone
    case mtz of
        Nothing -> let !tt = timeOfDayToTime t
                   in return (UTCTime d tt)
        Just tz -> return $! localTimeToUTC tz lt

-- | 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 :: Parser ZonedTime
zonedTime = ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)

utc :: TimeZone
utc = TimeZone 0 False ""