module Z.Data.Parser.Time
( day
, localTime
, timeOfDay
, timeZone
, utcTime
, zonedTime
, 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
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]
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
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)
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 ]
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
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"
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))
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)
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)
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
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
""