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

-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
day :: Parser Day
day :: Parser Day
day = Text
"date must be of form [+,-]YYYY-MM-DD" Text -> Parser Day -> Parser Day
forall a. Text -> Parser a -> Parser a
P.<?> do
    Integer -> Integer
absOrNeg <- Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Parser () -> Parser (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser ()
P.word8 Word8
MINUS Parser (Integer -> Integer)
-> Parser (Integer -> Integer) -> Parser (Integer -> Integer)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Integer
forall a. a -> a
id (Integer -> Integer) -> Parser () -> Parser (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser ()
P.word8 Word8
PLUS Parser (Integer -> Integer)
-> Parser (Integer -> Integer) -> Parser (Integer -> Integer)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Integer -> Integer) -> Parser (Integer -> Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer -> Integer
forall a. a -> a
id
    Integer
y <- (Parser Integer
P.integer Parser Integer -> Parser () -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser ()
P.word8 Word8
HYPHEN)
    Int
m <- (Parser Int
twoDigits Parser Int -> Parser () -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser ()
P.word8 Word8
HYPHEN)
    Int
d <- Parser Int
twoDigits
    Parser Day -> (Day -> Parser Day) -> Maybe Day -> Parser Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Parser Day
forall a. Text -> Parser a
P.fail' Text
"invalid date") Day -> Parser Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Day -> Parser Day) -> Maybe Day -> Parser Day
forall a b. (a -> b) -> a -> b
$! Integer -> Int -> Int -> Maybe Day
fromGregorianValid (Integer -> Integer
absOrNeg Integer
y) Int
m Int
d

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

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


-- | Parse a count of seconds, with the integer part being two digits -- long.
seconds :: Parser Pico
seconds :: Parser Pico
seconds = do
    Int
real <- Parser Int
twoDigits
    Maybe Word8
mw <- Parser (Maybe Word8)
P.peekMaybe
    case Maybe Word8
mw of
        Just Word8
DOT -> do
            Bytes
t <- Parser ()
P.skipWord8 Parser () -> Parser Bytes -> Parser Bytes
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit
            Pico -> Parser Pico
forall (m :: * -> *) a. Monad m => a -> m a
return (Pico -> Parser Pico) -> Pico -> Parser Pico
forall a b. (a -> b) -> a -> b
$! Int -> Bytes -> Pico
forall k (v :: * -> *) a (a :: k).
(Vec v Word8, Integral a) =>
a -> v Word8 -> Fixed a
parsePicos Int
real Bytes
t
        Maybe Word8
_ -> Pico -> Parser Pico
forall (m :: * -> *) a. Monad m => a -> m a
return (Pico -> Parser Pico) -> Pico -> Parser Pico
forall a b. (a -> b) -> a -> b
$! Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
real
 where
    parsePicos :: a -> v Word8 -> Fixed a
parsePicos a
a0 v Word8
t =
        let V.IPair Int
n Int64
t'  = (IPair Int64 -> Word8 -> IPair Int64)
-> IPair Int64 -> v Word8 -> IPair Int64
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
V.foldl' IPair Int64 -> Word8 -> IPair Int64
forall a. Integral a => IPair a -> Word8 -> IPair a
step (Int -> Int64 -> IPair Int64
forall a. Int -> a -> IPair a
V.IPair Int
12 (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a0 :: Int64)) v Word8
t
            step :: IPair a -> Word8 -> IPair a
step ma :: IPair a
ma@(V.IPair Int
m !a
a) Word8
w
                | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = IPair a
ma
                | Bool
otherwise = Int -> a -> IPair a
forall a. Int -> a -> IPair a
V.IPair (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (a
10 a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
+ Word8 -> a
forall a. Integral a => Word8 -> a
P.w2iDec Word8
w)
        in Integer -> Fixed a
forall k (a :: k). Integer -> Fixed a
MkFixed (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
t' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^Int
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 :: Parser (Maybe TimeZone)
timeZone = do
    (Word8 -> Bool) -> Parser ()
P.skipWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
SPACE)
    Word8
w <- (Word8 -> Bool) -> Parser Word8
P.satisfy ((Word8 -> Bool) -> Parser Word8)
-> (Word8 -> Bool) -> Parser Word8
forall a b. (a -> b) -> a -> b
$ \ Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
LETTER_Z Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
PLUS Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
MINUS
    if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
LETTER_Z
    then Maybe TimeZone -> Parser (Maybe TimeZone)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TimeZone
forall a. Maybe a
Nothing
    else do
        Int
h <- Parser Int
twoDigits
        Maybe Word8
mm <- Parser (Maybe Word8)
P.peekMaybe
        Int
m <- case Maybe Word8
mm of
               Just Word8
COLON         -> Parser ()
P.skipWord8 Parser () -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
twoDigits
               Just Word8
d | Word8 -> Bool
isDigit Word8
d -> Parser Int
twoDigits
               Maybe Word8
_                  -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
        let off :: Int
off | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
MINUS = Int -> Int
forall a. Num a => a -> a
negate Int
off0
                | Bool
otherwise  = Int
off0
            off0 :: Int
off0 = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
        case () of
          ()
_   | Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
                Maybe TimeZone -> Parser (Maybe TimeZone)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TimeZone
forall a. Maybe a
Nothing
              | Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
720 Bool -> Bool -> Bool
|| Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
840 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
59 ->
                String -> Parser (Maybe TimeZone)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid time zone offset"
              | Bool
otherwise ->
                    let !tz :: TimeZone
tz = Int -> TimeZone
minutesToTimeZone Int
off
                    in Maybe TimeZone -> Parser (Maybe TimeZone)
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
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 :: Parser LocalTime
localTime = Day -> TimeOfDay -> LocalTime
LocalTime (Day -> TimeOfDay -> LocalTime)
-> Parser Day -> Parser (TimeOfDay -> LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Day
day Parser (TimeOfDay -> LocalTime)
-> Parser Word8 -> Parser (TimeOfDay -> LocalTime)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Word8
daySep Parser (TimeOfDay -> LocalTime)
-> Parser TimeOfDay -> Parser LocalTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
timeOfDay
  where daySep :: Parser Word8
daySep = (Word8 -> Bool) -> Parser Word8
P.satisfy (\ Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
LETTER_T Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
SPACE)

-- | Behaves as 'zonedTime', but converts any time zone offset into a -- UTC time.
utcTime :: Parser UTCTime
utcTime :: Parser UTCTime
utcTime = do
    lt :: LocalTime
lt@(LocalTime Day
d TimeOfDay
t) <- Parser LocalTime
localTime
    Maybe TimeZone
mtz <- Parser (Maybe TimeZone)
timeZone
    case Maybe TimeZone
mtz of
        Maybe TimeZone
Nothing -> let !tt :: DiffTime
tt = TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
t
                   in UTCTime -> Parser UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> DiffTime -> UTCTime
UTCTime Day
d DiffTime
tt)
        Just TimeZone
tz -> UTCTime -> Parser UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Parser UTCTime) -> UTCTime -> Parser UTCTime
forall a b. (a -> b) -> a -> b
$! TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
tz LocalTime
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 :: Parser ZonedTime
zonedTime = LocalTime -> TimeZone -> ZonedTime
ZonedTime (LocalTime -> TimeZone -> ZonedTime)
-> Parser LocalTime -> Parser (TimeZone -> ZonedTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LocalTime
localTime Parser (TimeZone -> ZonedTime)
-> Parser TimeZone -> Parser ZonedTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TimeZone -> Maybe TimeZone -> TimeZone
forall a. a -> Maybe a -> a
fromMaybe TimeZone
utc (Maybe TimeZone -> TimeZone)
-> Parser (Maybe TimeZone) -> Parser TimeZone
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe TimeZone)
timeZone)

utc :: TimeZone
utc :: TimeZone
utc = Int -> Bool -> String -> TimeZone
TimeZone Int
0 Bool
False String
""