{-# LANGUAGE BangPatterns, ViewPatterns #-}

------------------------------------------------------------------------------
-- Module:      Database.PostgreSQL.Simple.Time.Internal.Printer
-- Copyright:   (c) 2012-2015 Leon P Smith
-- License:     BSD3
-- Maintainer:  Leon P Smith <leon@melding-monads.com>
-- Stability:   experimental
------------------------------------------------------------------------------

module Database.PostgreSQL.Simple.Time.Internal.Printer
    (
      day
    , timeOfDay
    , timeZone
    , utcTime
    , localTime
    , zonedTime
    , nominalDiffTime
    , calendarDiffTime
    ) where

import Control.Arrow ((>>>))
import Data.ByteString.Builder (Builder, byteString, integerDec)
import Data.ByteString.Builder.Prim
    ( liftFixedToBounded, (>$<), (>*<)
    , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)
import Data.Char ( chr )
import Data.Int ( Int32, Int64 )
import Data.String (fromString)
import Data.Time.Compat
    ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime
    , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay
    , TimeZone, timeZoneMinutes )
import Data.Time.Format.ISO8601.Compat (iso8601Show)
import Data.Time.LocalTime.Compat (CalendarDiffTime)
import Database.PostgreSQL.Simple.Compat ((<>), fromPico)
import Unsafe.Coerce (unsafeCoerce)

liftB :: FixedPrim a -> BoundedPrim a
liftB :: FixedPrim a -> BoundedPrim a
liftB = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded

digit   :: FixedPrim Int
digit :: FixedPrim Int
digit   = (\Int
x -> Int -> Char
chr (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48)) (Int -> Char) -> FixedPrim Char -> FixedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Char
char8

digits2 :: FixedPrim Int
digits2 :: FixedPrim Int
digits2 = (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) (Int -> (Int, Int)) -> FixedPrim (Int, Int) -> FixedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Int
digit FixedPrim Int -> FixedPrim Int -> FixedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Int
digit)

digits3 :: FixedPrim Int
digits3 :: FixedPrim Int
digits3 = (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) (Int -> (Int, Int)) -> FixedPrim (Int, Int) -> FixedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Int
digits2 FixedPrim Int -> FixedPrim Int -> FixedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Int
digit)

digits4 :: FixedPrim Int
digits4 :: FixedPrim Int
digits4 = (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) (Int -> (Int, Int)) -> FixedPrim (Int, Int) -> FixedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Int
digits3 FixedPrim Int -> FixedPrim Int -> FixedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Int
digit)

frac :: BoundedPrim Int64
frac :: BoundedPrim Int64
frac = (Int64 -> Bool)
-> BoundedPrim Int64 -> BoundedPrim Int64 -> BoundedPrim Int64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0) BoundedPrim Int64
forall a. BoundedPrim a
emptyB ((,) Char
'.' (Int64 -> (Char, Int64))
-> BoundedPrim (Char, Int64) -> BoundedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
liftB FixedPrim Char
char8 BoundedPrim Char -> BoundedPrim Int64 -> BoundedPrim (Char, Int64)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int64
trunc12))
  where
    trunc12 :: BoundedPrim Int64
    trunc12 :: BoundedPrim Int64
trunc12 = (Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
1000000) (Int64 -> (Int64, Int64))
-> BoundedPrim (Int64, Int64) -> BoundedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
              ((Int64, Int64) -> Bool)
-> BoundedPrim (Int64, Int64)
-> BoundedPrim (Int64, Int64)
-> BoundedPrim (Int64, Int64)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (\(Int64
_,Int64
y) -> Int64
y Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0)
                    ((Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst ((Int64, Int64) -> Int64)
-> BoundedPrim Int64 -> BoundedPrim (Int64, Int64)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Int64
trunc6)
                    (FixedPrim Int64 -> BoundedPrim Int64
forall a. FixedPrim a -> BoundedPrim a
liftB FixedPrim Int64
digits6 BoundedPrim Int64
-> BoundedPrim Int64 -> BoundedPrim (Int64, Int64)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int64
trunc6)

    digitB :: BoundedPrim Int
digitB  = FixedPrim Int -> BoundedPrim Int
forall a. FixedPrim a -> BoundedPrim a
liftB FixedPrim Int
digit

    digits6 :: FixedPrim Int64
digits6 = (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Int -> (Int, Int)) -> Int64 -> (Int, Int)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10)) (Int64 -> (Int, Int)) -> FixedPrim (Int, Int) -> FixedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Int
digits5 FixedPrim Int -> FixedPrim Int -> FixedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Int
digit)
    digits5 :: FixedPrim Int
digits5 =                   (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10)  (Int -> (Int, Int)) -> FixedPrim (Int, Int) -> FixedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Int
digits4 FixedPrim Int -> FixedPrim Int -> FixedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Int
digit)

    trunc6 :: BoundedPrim Int64
trunc6 =    (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Int -> (Int, Int)) -> Int64 -> (Int, Int)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
100000)) (Int64 -> (Int, Int))
-> BoundedPrim (Int, Int) -> BoundedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int
digitB BoundedPrim Int -> BoundedPrim Int -> BoundedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
trunc5)
    trunc5 :: BoundedPrim Int
trunc5 = (Int -> Bool)
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) BoundedPrim Int
forall a. BoundedPrim a
emptyB ((Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem`  Int
10000)  (Int -> (Int, Int)) -> BoundedPrim (Int, Int) -> BoundedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int
digitB BoundedPrim Int -> BoundedPrim Int -> BoundedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
trunc4))
    trunc4 :: BoundedPrim Int
trunc4 = (Int -> Bool)
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) BoundedPrim Int
forall a. BoundedPrim a
emptyB ((Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem`   Int
1000)  (Int -> (Int, Int)) -> BoundedPrim (Int, Int) -> BoundedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int
digitB BoundedPrim Int -> BoundedPrim Int -> BoundedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
trunc3))
    trunc3 :: BoundedPrim Int
trunc3 = (Int -> Bool)
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) BoundedPrim Int
forall a. BoundedPrim a
emptyB ((Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem`    Int
100)  (Int -> (Int, Int)) -> BoundedPrim (Int, Int) -> BoundedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int
digitB BoundedPrim Int -> BoundedPrim Int -> BoundedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
trunc2))
    trunc2 :: BoundedPrim Int
trunc2 = (Int -> Bool)
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) BoundedPrim Int
forall a. BoundedPrim a
emptyB ((Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem`     Int
10)  (Int -> (Int, Int)) -> BoundedPrim (Int, Int) -> BoundedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int
digitB BoundedPrim Int -> BoundedPrim Int -> BoundedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
trunc1))
    trunc1 :: BoundedPrim Int
trunc1 = (Int -> Bool)
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) BoundedPrim Int
forall a. BoundedPrim a
emptyB BoundedPrim Int
digitB


year  :: BoundedPrim Int32
year :: BoundedPrim Int32
year = (Int32 -> Bool)
-> BoundedPrim Int32 -> BoundedPrim Int32 -> BoundedPrim Int32
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
10000) BoundedPrim Int32
int32Dec (Int32 -> Int
checkBCE (Int32 -> Int) -> BoundedPrim Int -> BoundedPrim Int32
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Int -> BoundedPrim Int
forall a. FixedPrim a -> BoundedPrim a
liftB FixedPrim Int
digits4)
  where
    checkBCE :: Int32 -> Int
    checkBCE :: Int32 -> Int
checkBCE Int32
y
        | Int32
y Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0     = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
y
        | Bool
otherwise = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
msg

    msg :: [Char]
msg = [Char]
"Database.PostgreSQL.Simple.Time.Printer.year:  years BCE not supported"

day :: BoundedPrim Day
day :: BoundedPrim Day
day = Day -> (Int32, (Char, (Int, (Char, Int))))
forall a. Num a => Day -> (a, (Char, (Int, (Char, Int))))
toYMD (Day -> (Int32, (Char, (Int, (Char, Int)))))
-> BoundedPrim (Int32, (Char, (Int, (Char, Int))))
-> BoundedPrim Day
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int32
year BoundedPrim Int32
-> BoundedPrim (Char, (Int, (Char, Int)))
-> BoundedPrim (Int32, (Char, (Int, (Char, Int))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim (Char, (Int, (Char, Int)))
-> BoundedPrim (Char, (Int, (Char, Int)))
forall a. FixedPrim a -> BoundedPrim a
liftB (FixedPrim Char
char8 FixedPrim Char
-> FixedPrim (Int, (Char, Int))
-> FixedPrim (Char, (Int, (Char, Int)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Int
digits2 FixedPrim Int
-> FixedPrim (Char, Int) -> FixedPrim (Int, (Char, Int))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
char8 FixedPrim Char -> FixedPrim Int -> FixedPrim (Char, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Int
digits2))
  where
    toYMD :: Day -> (a, (Char, (Int, (Char, Int))))
toYMD (Day -> (Integer, Int, Int)
toGregorian -> (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> !a
y, !Int
m,!Int
d)) = (a
y,(Char
'-',(Int
m,(Char
'-',Int
d))))

timeOfDay :: BoundedPrim TimeOfDay
timeOfDay :: BoundedPrim TimeOfDay
timeOfDay = TimeOfDay -> ((Int, (Char, (Int, Char))), Pico)
f (TimeOfDay -> ((Int, (Char, (Int, Char))), Pico))
-> BoundedPrim ((Int, (Char, (Int, Char))), Pico)
-> BoundedPrim TimeOfDay
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim (Int, (Char, (Int, Char)))
hh_mm_ BoundedPrim (Int, (Char, (Int, Char)))
-> BoundedPrim Pico
-> BoundedPrim ((Int, (Char, (Int, Char))), Pico)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Pico
ss)
  where
    f :: TimeOfDay -> ((Int, (Char, (Int, Char))), Pico)
f (TimeOfDay Int
h Int
m Pico
s)  =  ((Int
h,(Char
':',(Int
m,Char
':'))),Pico
s)

    hh_mm_ :: BoundedPrim (Int, (Char, (Int, Char)))
hh_mm_ = FixedPrim (Int, (Char, (Int, Char)))
-> BoundedPrim (Int, (Char, (Int, Char)))
forall a. FixedPrim a -> BoundedPrim a
liftB (FixedPrim Int
digits2 FixedPrim Int
-> FixedPrim (Char, (Int, Char))
-> FixedPrim (Int, (Char, (Int, Char)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
char8 FixedPrim Char
-> FixedPrim (Int, Char) -> FixedPrim (Char, (Int, Char))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Int
digits2 FixedPrim Int -> FixedPrim Char -> FixedPrim (Int, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
char8)

    ss :: BoundedPrim Pico
ss = (\Pico
s -> Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pico -> Integer
fromPico Pico
s) Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
1000000000000) (Pico -> (Int64, Int64))
-> BoundedPrim (Int64, Int64) -> BoundedPrim Pico
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
         (FixedPrim Int64 -> BoundedPrim Int64
forall a. FixedPrim a -> BoundedPrim a
liftB (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> FixedPrim Int -> FixedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Int
digits2) BoundedPrim Int64
-> BoundedPrim Int64 -> BoundedPrim (Int64, Int64)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int64
frac)

timeZone :: BoundedPrim TimeZone
timeZone :: BoundedPrim TimeZone
timeZone = TimeZone -> Int
timeZoneMinutes (TimeZone -> Int) -> BoundedPrim Int -> BoundedPrim TimeZone
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Int
tz
  where
    tz :: BoundedPrim Int
tz  = (Int -> Bool)
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) ((,) Char
'+' (Int -> (Char, Int)) -> BoundedPrim (Char, Int) -> BoundedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim (Char, Int)
tzh) ((,) Char
'-' (Int -> (Char, Int)) -> (Int -> Int) -> Int -> (Char, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate (Int -> (Char, Int)) -> BoundedPrim (Char, Int) -> BoundedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim (Char, Int)
tzh)

    tzh :: BoundedPrim (Char, Int)
tzh = FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
liftB FixedPrim Char
char8 BoundedPrim Char -> BoundedPrim Int -> BoundedPrim (Char, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< ((Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
60) (Int -> (Int, Int)) -> BoundedPrim (Int, Int) -> BoundedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Int -> BoundedPrim Int
forall a. FixedPrim a -> BoundedPrim a
liftB FixedPrim Int
digits2 BoundedPrim Int -> BoundedPrim Int -> BoundedPrim (Int, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
tzm))

    tzm :: BoundedPrim Int
tzm = (Int -> Bool)
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) BoundedPrim Int
forall a. BoundedPrim a
emptyB ((,) Char
':' (Int -> (Char, Int)) -> BoundedPrim (Char, Int) -> BoundedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim (Char, Int) -> BoundedPrim (Char, Int)
forall a. FixedPrim a -> BoundedPrim a
liftB (FixedPrim Char
char8 FixedPrim Char -> FixedPrim Int -> FixedPrim (Char, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Int
digits2))

utcTime :: BoundedPrim UTCTime
utcTime :: BoundedPrim UTCTime
utcTime = UTCTime -> (Day, (Char, (TimeOfDay, Char)))
f (UTCTime -> (Day, (Char, (TimeOfDay, Char))))
-> BoundedPrim (Day, (Char, (TimeOfDay, Char)))
-> BoundedPrim UTCTime
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Day
day BoundedPrim Day
-> BoundedPrim (Char, (TimeOfDay, Char))
-> BoundedPrim (Day, (Char, (TimeOfDay, Char)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
liftB FixedPrim Char
char8 BoundedPrim Char
-> BoundedPrim (TimeOfDay, Char)
-> BoundedPrim (Char, (TimeOfDay, Char))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim TimeOfDay
timeOfDay BoundedPrim TimeOfDay
-> BoundedPrim Char -> BoundedPrim (TimeOfDay, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
liftB FixedPrim Char
char8)
  where f :: UTCTime -> (Day, (Char, (TimeOfDay, Char)))
f (UTCTime Day
d (DiffTime -> TimeOfDay
timeToTimeOfDay -> TimeOfDay
tod)) = (Day
d,(Char
' ',(TimeOfDay
tod,Char
'Z')))

localTime :: BoundedPrim LocalTime
localTime :: BoundedPrim LocalTime
localTime = LocalTime -> (Day, (Char, TimeOfDay))
f (LocalTime -> (Day, (Char, TimeOfDay)))
-> BoundedPrim (Day, (Char, TimeOfDay)) -> BoundedPrim LocalTime
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Day
day BoundedPrim Day
-> BoundedPrim (Char, TimeOfDay)
-> BoundedPrim (Day, (Char, TimeOfDay))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
liftB FixedPrim Char
char8 BoundedPrim Char
-> BoundedPrim TimeOfDay -> BoundedPrim (Char, TimeOfDay)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim TimeOfDay
timeOfDay)
  where f :: LocalTime -> (Day, (Char, TimeOfDay))
f (LocalTime Day
d TimeOfDay
tod) = (Day
d, (Char
' ', TimeOfDay
tod))

zonedTime :: BoundedPrim ZonedTime
zonedTime :: BoundedPrim ZonedTime
zonedTime = ZonedTime -> (LocalTime, TimeZone)
f (ZonedTime -> (LocalTime, TimeZone))
-> BoundedPrim (LocalTime, TimeZone) -> BoundedPrim ZonedTime
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim LocalTime
localTime BoundedPrim LocalTime
-> BoundedPrim TimeZone -> BoundedPrim (LocalTime, TimeZone)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim TimeZone
timeZone)
  where f :: ZonedTime -> (LocalTime, TimeZone)
f (ZonedTime LocalTime
lt TimeZone
tz) = (LocalTime
lt, TimeZone
tz)


nominalDiffTime :: NominalDiffTime -> Builder
nominalDiffTime :: NominalDiffTime -> Builder
nominalDiffTime NominalDiffTime
xy = Integer -> Builder
integerDec Integer
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BoundedPrim Int64 -> Int64 -> Builder
forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim Int64
frac (Int64 -> Int64
forall a. Num a => a -> a
abs (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y))
  where
    (Integer
x,Integer
y) = Pico -> Integer
fromPico (NominalDiffTime -> Pico
forall a b. a -> b
unsafeCoerce NominalDiffTime
xy) Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000000000000

calendarDiffTime :: CalendarDiffTime -> Builder
calendarDiffTime :: CalendarDiffTime -> Builder
calendarDiffTime = ByteString -> Builder
byteString
  (ByteString -> Builder)
-> (CalendarDiffTime -> ByteString) -> CalendarDiffTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString
    -- from the docs: "Beware: fromString truncates multi-byte characters to octets".
    -- However, I think this is a safe usage, because ISO8601-encoding seems restricted
    -- to ASCII output.
  ([Char] -> ByteString)
-> (CalendarDiffTime -> [Char]) -> CalendarDiffTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarDiffTime -> [Char]
forall t. ISO8601 t => t -> [Char]
iso8601Show