{-|
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
    -- * internal
    , fromGregorianValid'
    , fromGregorianValidInt64
    ) 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 qualified Z.Data.Array          as A
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
import qualified Z.Data.Text           as T

-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
--
-- Invalid date(leap year rule violation, etc.) will be rejected.
day :: Parser Day
{-# INLINE day #-}
day :: Parser Day
day = Text
"Date must be of form [+,-]YYYY-MM-DD" forall a. Text -> Parser a -> Parser a
P.<?> do
    Integer
y <- (Parser Integer
P.integer forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser ()
P.word8 Word8
HYPHEN)
    Int
m <- (Parser Int
twoDigits forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser ()
P.word8 Word8
HYPHEN)
    Int
d <- Parser Int
twoDigits
    case Integer -> Int -> Int -> Maybe Day
fromGregorianValid' Integer
y Int
m Int
d of
        Just Day
d' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
d'
        Maybe Day
_ -> forall a. Text -> Parser a
P.fail' forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"Z.Data.Parser.Time.day: invalid date: ", forall a. Print a => a -> Text
T.toText Integer
y, Text
"-", forall a. Print a => a -> Text
T.toText Int
m, Text
"-", forall a. Print a => a -> Text
T.toText Int
d]

-- | Faster 'fromGregorianValid' with 'fromGregorianValidInt64' as the common case path.
--
fromGregorianValid' :: Integer -> Int -> Int -> Maybe Day
{-# INLINE fromGregorianValid' #-}
fromGregorianValid' :: Integer -> Int -> Int -> Maybe Day
fromGregorianValid' Integer
y Int
m Int
d
    | -Integer
18000000000000000 forall a. Ord a => a -> a -> Bool
< Integer
y  Bool -> Bool -> Bool
&& Integer
y forall a. Ord a => a -> a -> Bool
< Integer
18000000000000000 = Int64 -> Int -> Int -> Maybe Day
fromGregorianValidInt64 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y) Int
m Int
d
    | Bool
otherwise = Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
y Int
m Int
d

-- | Faster common case for small years(around -18000000000000000 ~ 18000000000000000).
--
fromGregorianValidInt64 :: Int64 -> Int -> Int -> Maybe Day
{-# INLINABLE fromGregorianValidInt64 #-}
fromGregorianValidInt64 :: Int64 -> Int -> Int -> Maybe Day
fromGregorianValidInt64 Int64
year Int
month Int
day_ =
    if (Int
1 forall a. Ord a => a -> a -> Bool
<= Int
month Bool -> Bool -> Bool
&& Int
month forall a. Ord a => a -> a -> Bool
<= Int
12) Bool -> Bool -> Bool
&& (Int
1 forall a. Ord a => a -> a -> Bool
<= Int
day_ Bool -> Bool -> Bool
&& Int
day_ forall a. Ord a => a -> a -> Bool
<= Int
monthLength)
    -- intentionally not to force with outer 'Just' here, we have done the grammar check, and calculating mjd is expensive,
    -- retained references are year, month and day, which are already in NF
    then forall a. a -> Maybe a
Just (Integer -> Day
ModifiedJulianDay forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
mjd)
    else forall a. Maybe a
Nothing
  where
    isLeap :: Bool
isLeap = (forall a. Integral a => a -> a -> a
rem Int64
year Int64
4 forall a. Eq a => a -> a -> Bool
== Int64
0) Bool -> Bool -> Bool
&& ((forall a. Integral a => a -> a -> a
rem Int64
year Int64
400 forall a. Eq a => a -> a -> Bool
== Int64
0) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Integral a => a -> a -> a
rem Int64
year Int64
100 forall a. Eq a => a -> a -> Bool
== Int64
0))
    dayOfYear :: Int
dayOfYear =
        let k :: Int
k = if Int
month forall a. Ord a => a -> a -> Bool
<= Int
2 then Int
0 else if Bool
isLeap then -Int
1 else -Int
2
        in ((Int
367 forall a. Num a => a -> a -> a
* Int
month forall a. Num a => a -> a -> a
- Int
362) forall a. Integral a => a -> a -> a
`div` Int
12) forall a. Num a => a -> a -> a
+ Int
k forall a. Num a => a -> a -> a
+ Int
day_
    mjd :: Int64
mjd =
        let y :: Int64
y = Int64
year forall a. Num a => a -> a -> a
- Int64
1
        in (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dayOfYear) forall a. Num a => a -> a -> a
+ (Int64
365 forall a. Num a => a -> a -> a
* Int64
y) forall a. Num a => a -> a -> a
+ (forall a. Integral a => a -> a -> a
div Int64
y Int64
4) forall a. Num a => a -> a -> a
- (forall a. Integral a => a -> a -> a
div Int64
y Int64
100) forall a. Num a => a -> a -> a
+ (forall a. Integral a => a -> a -> a
div Int64
y Int64
400) forall a. Num a => a -> a -> a
- Int64
678576
    monthLength :: Int
monthLength = forall (arr :: * -> *) a.
(Arr arr a, HasCallStack) =>
arr a -> Int -> a
A.indexArr (if Bool
isLeap then PrimArray Int
monthListLeap else PrimArray Int
monthList) (Int
monthforall a. Num a => a -> a -> a
-Int
1)

monthList :: A.PrimArray Int
{-# NOINLINE monthList #-}
monthList :: PrimArray Int
monthList = forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
V.packN Int
12 [ Int
31 , Int
28 , Int
31 , Int
30 , Int
31 , Int
30 , Int
31 , Int
31 , Int
30 , Int
31 , Int
30 , Int
31 ]

monthListLeap :: A.PrimArray Int
{-# NOINLINE monthListLeap #-}
monthListLeap :: PrimArray Int
monthListLeap = forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
V.packN Int
12 [ Int
31 , Int
29 , Int
31 , Int
30 , Int
31 , Int
30 , Int
31 , Int
31 , Int
30 , Int
31 , Int
30 , Int
31 ]

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

-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
timeOfDay :: Parser TimeOfDay
{-# INLINE timeOfDay #-}
timeOfDay :: Parser TimeOfDay
timeOfDay = do
    Int
h <- Parser Int
twoDigits
    Int
m <- Char -> Parser ()
P.char8 Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
twoDigits
    Pico
s <- (Char -> Parser ()
P.char8 Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Pico
seconds) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Pico
0
    if Int
h forall a. Ord a => a -> a -> Bool
< Int
24 Bool -> Bool -> Bool
&& Int
m forall a. Ord a => a -> a -> Bool
< Int
60 Bool -> Bool -> Bool
&& Pico
s forall a. Ord a => a -> a -> Bool
< Pico
61
    then forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s)
    else 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
{-# INLINE seconds #-}
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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {v :: * -> *} {a} {a :: k}.
(Vec v Word8, Integral a) =>
a -> v Word8 -> Fixed a
parsePicos Int
real Bytes
t
        Maybe Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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'  = forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
V.foldl' forall {a}. Integral a => IPair a -> Word8 -> IPair a
step (forall a. Int -> a -> IPair a
V.IPair Int
12 (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 forall a. Ord a => a -> a -> Bool
<= Int
0    = IPair a
ma
                | Bool
otherwise = forall a. Int -> a -> IPair a
V.IPair (Int
mforall a. Num a => a -> a -> a
-Int
1) (a
10 forall a. Num a => a -> a -> a
* a
a forall a. Num a => a -> a -> a
+ forall a. Integral a => Word8 -> a
P.w2iDec Word8
w)
        in forall k (a :: k). Integer -> Fixed a
MkFixed (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
t' forall a. Num a => a -> a -> a
* Int64
10forall 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)
{-# INLINE timeZone #-}
timeZone :: Parser (Maybe TimeZone)
timeZone = do
    (Word8 -> Bool) -> Parser ()
P.skipWhile (forall a. Eq a => a -> a -> Bool
== Word8
SPACE)
    Word8
w <- (Word8 -> Bool) -> Parser Word8
P.satisfy forall a b. (a -> b) -> a -> b
$ \ Word8
w -> Word8
w forall a. Eq a => a -> a -> Bool
== Word8
LETTER_Z Bool -> Bool -> Bool
|| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
PLUS Bool -> Bool -> Bool
|| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
MINUS
    if Word8
w forall a. Eq a => a -> a -> Bool
== Word8
LETTER_Z
    then forall (m :: * -> *) a. Monad m => a -> m a
return 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 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
_                  -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
        let off :: Int
off | Word8
w forall a. Eq a => a -> a -> Bool
== Word8
MINUS = forall a. Num a => a -> a
negate Int
off0
                | Bool
otherwise  = Int
off0
            off0 :: Int
off0 = Int
h forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
m
        case () of
          ()
_   | Int
off forall a. Eq a => a -> a -> Bool
== Int
0 ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
              | Int
off forall a. Ord a => a -> a -> Bool
< -Int
720 Bool -> Bool -> Bool
|| Int
off forall a. Ord a => a -> a -> Bool
> Int
840 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
59 ->
                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 forall (m :: * -> *) a. Monad m => a -> m a
return (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
{-# INLINE localTime #-}
localTime :: Parser LocalTime
localTime = Day -> TimeOfDay -> LocalTime
LocalTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Day
day forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Word8
daySep 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 forall a. Eq a => a -> a -> Bool
== Word8
LETTER_T Bool -> Bool -> Bool
|| Word8
w 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
{-# INLINE 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 forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> DiffTime -> UTCTime
UTCTime Day
d DiffTime
tt)
        Just TimeZone
tz -> forall (m :: * -> *) a. Monad m => a -> m a
return 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
{-# INLINE zonedTime #-}
zonedTime :: Parser ZonedTime
zonedTime = LocalTime -> TimeZone -> ZonedTime
ZonedTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LocalTime
localTime forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Maybe a -> a
fromMaybe TimeZone
utc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe TimeZone)
timeZone)

utc :: TimeZone
{-# INLINE utc #-}
utc :: TimeZone
utc = Int -> Bool -> String -> TimeZone
TimeZone Int
0 Bool
False String
""