{-|
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 :: 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 (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
""