{-|
Module:      Z.Data.Parser.Time
Description : Builders 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

Builders for dates and times.
-}

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

import Control.Monad
import Data.Time
import Data.Word
import Data.Fixed
import Data.Int
import           Z.Data.Builder.Base        (Builder)
import qualified Z.Data.Builder.Base        as B
import qualified Z.Data.Builder.Numeric     as B
import Z.Data.Builder.Numeric   (i2wDec)
import Z.Data.ASCII

-- | @YYYY-mm-dd@.
day :: Day -> Builder ()
{-# INLINE day #-}
day :: Day -> Builder ()
day Day
dd = Integer -> Builder ()
encodeYear Integer
yr Builder () -> Builder () -> Builder ()
forall a. Semigroup a => a -> a -> a
<>
         (Word8, Word8, Word8, Word8, Word8, Word8) -> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim (Word8
HYPHEN, Word8
mh, Word8
ml, Word8
HYPHEN, Word8
dh, Word8
dl)
  where (Integer
yr, Int
m, Int
d)    = Day -> (Integer, Int, Int)
toGregorian Day
dd
        (Word8
mh, Word8
ml)  = Int -> (Word8, Word8)
twoDigits Int
m
        (Word8
dh, Word8
dl)  = Int -> (Word8, Word8)
twoDigits Int
d
        encodeYear :: Integer -> Builder ()
encodeYear Integer
y
            | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1000 = Integer -> Builder ()
B.integer Integer
y
            | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0    = (Word8, Word8, Word8, Word8) -> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim (Integer -> (Word8, Word8, Word8, Word8)
forall a. Integral a => a -> (Word8, Word8, Word8, Word8)
padYear Integer
y)
            | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= -Integer
999 = (Word8, (Word8, Word8, Word8, Word8)) -> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim (Word8
MINUS, Integer -> (Word8, Word8, Word8, Word8)
forall a. Integral a => a -> (Word8, Word8, Word8, Word8)
padYear Integer
y)
            | Bool
otherwise = Integer -> Builder ()
B.integer Integer
y
        padYear :: a -> (Word8, Word8, Word8, Word8)
padYear a
y =
            let (Int
ab,Int
c) = (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y :: Int) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
                (Int
a, Int
b)  = Int
ab Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
            in (Word8
DIGIT_0, Int -> Word8
forall a. Integral a => a -> Word8
i2wDec Int
a, Int -> Word8
forall a. Integral a => a -> Word8
i2wDec Int
b, Int -> Word8
forall a. Integral a => a -> Word8
i2wDec Int
c)

-- | @HH-MM-SS@.
timeOfDay :: TimeOfDay -> Builder ()
{-# INLINE timeOfDay #-}
timeOfDay :: TimeOfDay -> Builder ()
timeOfDay TimeOfDay
t = TimeOfDay64 -> Builder ()
timeOfDay64 (TimeOfDay -> TimeOfDay64
toTimeOfDay64 TimeOfDay
t)

-- | Timezone format in @+HH:MM@, with single letter @Z@ for @+00:00@.
timeZone :: TimeZone -> Builder ()
{-# INLINE timeZone #-}
timeZone :: TimeZone -> Builder ()
timeZone (TimeZone Int
off Bool
_ String
_)
  | Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Word8 -> Builder ()
B.word8 Word8
LETTER_Z
  | Bool
otherwise = (Word8, Word8, Word8, Word8, Word8, Word8) -> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim (Word8
s, Word8
hh, Word8
hl, Word8
COLON, Word8
mh, Word8
ml)
  where !s :: Word8
s         = if Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Word8
MINUS else Word8
PLUS
        (Word8
hh, Word8
hl)   = Int -> (Word8, Word8)
twoDigits Int
h
        (Word8
mh, Word8
ml)   = Int -> (Word8, Word8)
twoDigits Int
m
        (Int
h,Int
m)      = Int -> Int
forall a. Num a => a -> a
abs Int
off Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
60

-- | Write 'UTCTime' in ISO8061 @YYYY-MM-DDTHH:MM:SS.SSSZ@(time zone will always be @Z@).
utcTime :: UTCTime -> Builder ()
{-# INLINE utcTime #-}
utcTime :: UTCTime -> Builder ()
utcTime (UTCTime Day
d DiffTime
s) = Day -> TimeOfDay64 -> Builder ()
dayTime Day
d (DiffTime -> TimeOfDay64
diffTimeOfDay64 DiffTime
s) Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Builder ()
B.word8 Word8
LETTER_Z

-- | Write 'LocalTime' in ISO8061 @YYYY-MM-DDTHH:MM:SS.SSS@.
localTime :: LocalTime -> Builder ()
{-# INLINE localTime #-}
localTime :: LocalTime -> Builder ()
localTime (LocalTime Day
d TimeOfDay
t) = Day -> TimeOfDay64 -> Builder ()
dayTime Day
d (TimeOfDay -> TimeOfDay64
toTimeOfDay64 TimeOfDay
t)

-- | Write 'ZonedTime' in ISO8061 @YYYY-MM-DD HH:MM:SS.SSSZ@.
zonedTime :: ZonedTime -> Builder ()
{-# INLINE zonedTime #-}
zonedTime :: ZonedTime -> Builder ()
zonedTime (ZonedTime LocalTime
t TimeZone
z) = LocalTime -> Builder ()
localTime LocalTime
t Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeZone -> Builder ()
timeZone TimeZone
z

--------------------------------------------------------------------------------

-- | Like TimeOfDay, but using a fixed-width integer for seconds.
type TimeOfDay64 = (Int, Int, Int64)

diffTimeOfDay64 :: DiffTime -> TimeOfDay64
{-# INLINE diffTimeOfDay64 #-}
diffTimeOfDay64 :: DiffTime -> TimeOfDay64
diffTimeOfDay64 DiffTime
t
  | DiffTime
t DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
86400 = (Int
23, Int
59, Int64
60000000000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ DiffTime -> Int64
pico (DiffTime
t DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
- DiffTime
86400))
  | Bool
otherwise = (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
h, Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m, Int64
s)
    where (Int64
h,Int64
mp) = DiffTime -> Int64
pico DiffTime
t Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
3600000000000000
          (Int64
m,Int64
s)  = Int64
mp Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
60000000000000
          pico :: DiffTime -> Int64
pico   = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> (DiffTime -> Integer) -> DiffTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToPicoseconds

toTimeOfDay64 :: TimeOfDay -> TimeOfDay64
{-# INLINE toTimeOfDay64 #-}
toTimeOfDay64 :: TimeOfDay -> TimeOfDay64
toTimeOfDay64 (TimeOfDay Int
h Int
m (MkFixed Integer
s)) = (Int
h, Int
m, Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s)

dayTime :: Day -> TimeOfDay64 -> Builder ()
{-# INLINE dayTime #-}
dayTime :: Day -> TimeOfDay64 -> Builder ()
dayTime Day
d TimeOfDay64
t = Day -> Builder ()
day Day
d Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Builder ()
B.word8 Word8
LETTER_T Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeOfDay64 -> Builder ()
timeOfDay64 TimeOfDay64
t

timeOfDay64 :: TimeOfDay64 -> Builder ()
{-# INLINE timeOfDay64 #-}
timeOfDay64 :: TimeOfDay64 -> Builder ()
timeOfDay64 (!Int
h, !Int
m, !Int64
s) = do
    (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
-> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim (Word8
hh, Word8
hl, Word8
COLON, Word8
mh, Word8
ml, Word8
COLON, Word8
sh, Word8
sl)
    Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
frac Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
0) (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim Word8
DOT
        Int -> Builder () -> Builder ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n1) (Word8 -> Builder ()
B.word8 Word8
DIGIT_0)
        [Int64] -> (Int64 -> Builder ()) -> Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int64]
ds (Word8 -> Builder ()
B.word8 (Word8 -> Builder ()) -> (Int64 -> Word8) -> Int64 -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word8
forall a. Integral a => a -> Word8
B.i2wDec)
  where
    (Int64
real, Int64
frac) = Int64
s Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
1000000000000 -- number of picoseconds  in 1 second

    (Word8
hh, Word8
hl)     = Int -> (Word8, Word8)
twoDigits Int
h
    (Word8
mh, Word8
ml)     = Int -> (Word8, Word8)
twoDigits Int
m
    (Word8
sh, Word8
sl)     = Int -> (Word8, Word8)
twoDigits (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
real)

    (Int64
frac', Int
n0) = Int64 -> Int -> (Int64, Int)
ctz Int64
frac Int
0
    ([Int64]
ds, Int
n1) = Int64 -> [Int64] -> Int -> ([Int64], Int)
toDigits Int64
frac' [] Int
n0

    ctz :: Int64 -> Int -> (Int64, Int)
    ctz :: Int64 -> Int -> (Int64, Int)
ctz !Int64
x !Int
n =
        let (Int64
x', Int64
r) = Int64
x Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
10
        in if Int64
r Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
            then Int64 -> Int -> (Int64, Int)
ctz Int64
x' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            else (Int64
x, Int
n)

    toDigits :: Int64 -> [Int64] -> Int -> ([Int64], Int)
    toDigits :: Int64 -> [Int64] -> Int -> ([Int64], Int)
toDigits !Int64
x ![Int64]
acc !Int
n =
        let (Int64
x', Int64
r) = Int64
x Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
10
        in if Int64
x' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
            then ((Int64
rInt64 -> [Int64] -> [Int64]
forall a. a -> [a] -> [a]
:[Int64]
acc), Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            else Int64 -> [Int64] -> Int -> ([Int64], Int)
toDigits Int64
x' (Int64
rInt64 -> [Int64] -> [Int64]
forall a. a -> [a] -> [a]
:[Int64]
acc) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

twoDigits :: Int -> (Word8, Word8)
{-# INLINE twoDigits #-}
twoDigits :: Int -> (Word8, Word8)
twoDigits Int
a = (Int -> Word8
forall a. Integral a => a -> Word8
i2wDec Int
hi, Int -> Word8
forall a. Integral a => a -> Word8
i2wDec Int
lo)
  where (Int
hi,Int
lo) = Int
a Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10