{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TupleSections #-}
-- |
-- Module:      Data.Aeson.Encoding.Builder
-- Copyright:   (c) 2011 MailRank, Inc.
--              (c) 2013 Simon Meier <iridcode@gmail.com>
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   experimental
-- Portability: portable
--
-- Efficiently serialize a JSON value using the UTF-8 encoding.

module Data.Aeson.Encoding.Builder
    (
      encodeToBuilder
    , null_
    , bool
    , array
    , emptyArray_
    , emptyObject_
    , object
    , text
    , string
    , unquoted
    , quote
    , scientific
    , day
    , month
    , quarter
    , localTime
    , utcTime
    , timeOfDay
    , zonedTime
    , ascii2
    , ascii4
    , ascii5
    ) where

import Data.Aeson.Internal.Prelude

import Data.Aeson.Types.Internal (Value (..), Key)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim ((>$<), (>*<))
import qualified Data.ByteString.Builder.Prim as BP
import Data.ByteString.Builder.Scientific (scientificBuilder)
import Data.Char (chr, ord)
import Data.Fixed (Fixed (..))
import Data.Scientific (base10Exponent, coefficient)
import Data.Text.Encoding (encodeUtf8BuilderEscaped)
import Data.Time (UTCTime(..))
import Data.Time.Calendar (Day(..), toGregorian)
import Data.Time.Calendar.Month.Compat (Month, toYearMonth)
import Data.Time.Calendar.Quarter.Compat (Quarter, toYearQuarter, QuarterOfYear (..))
import Data.Time.LocalTime (LocalTime (..), TimeZone (..), ZonedTime (..), TimeOfDay (..))
import Data.Time.Clock.Compat (DiffTime, diffTimeToPicoseconds)
import qualified Data.Text as T
import qualified Data.Vector as V

-- | Encode a JSON value to a "Data.ByteString" 'B.Builder'.
--
-- Use this function if you are encoding over the wire, or need to
-- prepend or append further bytes to the encoded JSON value.
encodeToBuilder :: Value -> Builder
encodeToBuilder :: Value -> Builder
encodeToBuilder Value
Null       = Builder
null_
encodeToBuilder (Bool Bool
b)   = Bool -> Builder
bool Bool
b
encodeToBuilder (Number Scientific
n) = Scientific -> Builder
scientific Scientific
n
encodeToBuilder (String Text
s) = Text -> Builder
text Text
s
encodeToBuilder (Array Array
v)  = Array -> Builder
array Array
v
encodeToBuilder (Object Object
m) = Object -> Builder
object Object
m

-- | Encode a JSON null.
null_ :: Builder
null_ :: Builder
null_ = forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a. (Char, (Char, (Char, Char))) -> BoundedPrim a
ascii4 (Char
'n',(Char
'u',(Char
'l',Char
'l')))) ()

-- | Encode a JSON boolean.
bool :: Bool -> Builder
bool :: Bool -> Builder
bool = forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB forall a. a -> a
id (forall a. (Char, (Char, (Char, Char))) -> BoundedPrim a
ascii4 (Char
't',(Char
'r',(Char
'u',Char
'e'))))
                                   (forall a. (Char, (Char, (Char, (Char, Char)))) -> BoundedPrim a
ascii5 (Char
'f',(Char
'a',(Char
'l',(Char
's',Char
'e'))))))

-- | Encode a JSON array.
array :: V.Vector Value -> Builder
array :: Array -> Builder
array Array
v
  | forall a. Vector a -> Bool
V.null Array
v  = Builder
emptyArray_
  | Bool
otherwise = Char -> Builder
B.char8 Char
'[' forall a. Semigroup a => a -> a -> a
<>
                Value -> Builder
encodeToBuilder (forall a. Vector a -> a
V.unsafeHead Array
v) forall a. Semigroup a => a -> a -> a
<>
                forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr Value -> Builder -> Builder
withComma (Char -> Builder
B.char8 Char
']') (forall a. Vector a -> Vector a
V.unsafeTail Array
v)
  where
    withComma :: Value -> Builder -> Builder
withComma Value
a Builder
z = Char -> Builder
B.char8 Char
',' forall a. Semigroup a => a -> a -> a
<> Value -> Builder
encodeToBuilder Value
a forall a. Semigroup a => a -> a -> a
<> Builder
z

-- Encode a JSON object.
object :: KM.KeyMap Value -> Builder
object :: Object -> Builder
object Object
m = case forall v. KeyMap v -> [(Key, v)]
KM.toList Object
m of
    ((Key, Value)
x:[(Key, Value)]
xs) -> Char -> Builder
B.char8 Char
'{' forall a. Semigroup a => a -> a -> a
<> (Key, Value) -> Builder
one (Key, Value)
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Key, Value) -> Builder -> Builder
withComma (Char -> Builder
B.char8 Char
'}') [(Key, Value)]
xs
    [(Key, Value)]
_      -> Builder
emptyObject_
  where
    withComma :: (Key, Value) -> Builder -> Builder
withComma (Key, Value)
a Builder
z = Char -> Builder
B.char8 Char
',' forall a. Semigroup a => a -> a -> a
<> (Key, Value) -> Builder
one (Key, Value)
a forall a. Semigroup a => a -> a -> a
<> Builder
z
    one :: (Key, Value) -> Builder
one (Key
k,Value
v)     = Key -> Builder
key Key
k forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char8 Char
':' forall a. Semigroup a => a -> a -> a
<> Value -> Builder
encodeToBuilder Value
v

-- | Encode a JSON key.
key :: Key -> Builder
key :: Key -> Builder
key = Text -> Builder
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
Key.toText

-- | Encode a JSON string.
text :: T.Text -> Builder
text :: Text -> Builder
text Text
t = Char -> Builder
B.char8 Char
'"' forall a. Semigroup a => a -> a -> a
<> Text -> Builder
unquoted Text
t forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char8 Char
'"'

-- | Encode a JSON string, without enclosing quotes.
unquoted :: T.Text -> Builder
unquoted :: Text -> Builder
unquoted = BoundedPrim Word8 -> Text -> Builder
encodeUtf8BuilderEscaped BoundedPrim Word8
escapeAscii

-- | Add quotes surrounding a builder
quote :: Builder -> Builder
quote :: Builder -> Builder
quote Builder
b = Char -> Builder
B.char8 Char
'"' forall a. Semigroup a => a -> a -> a
<> Builder
b forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char8 Char
'"'

-- | Encode a JSON string.
string :: String -> Builder
string :: String -> Builder
string String
t = Char -> Builder
B.char8 Char
'"' forall a. Semigroup a => a -> a -> a
<> forall a. BoundedPrim a -> [a] -> Builder
BP.primMapListBounded BoundedPrim Char
go String
t forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char8 Char
'"'
  where go :: BoundedPrim Char
go = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (forall a. Ord a => a -> a -> Bool
> Char
'\x7f') BoundedPrim Char
BP.charUtf8 (Char -> Word8
c2w forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
escapeAscii)

escapeAscii :: BP.BoundedPrim Word8
escapeAscii :: BoundedPrim Word8
escapeAscii =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\\'  ) (forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'\\')) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\"'  ) (forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'"' )) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'\x20') (forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded FixedPrim Word8
BP.word8) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\n'  ) (forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'n' )) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\r'  ) (forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'r' )) forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\t'  ) (forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
't' )) forall a b. (a -> b) -> a -> b
$
    forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded FixedPrim Word8
hexEscape -- fallback for chars < 0x20
  where
    hexEscape :: BP.FixedPrim Word8
    hexEscape :: FixedPrim Word8
hexEscape = (\Word8
c -> (Char
'\\', (Char
'u', forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c))) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BP.>$<
        FixedPrim Char
BP.char8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word16
BP.word16HexFixed
{-# INLINE escapeAscii #-}

c2w :: Char -> Word8
c2w :: Char -> Word8
c2w Char
c = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c)

-- | Encode a JSON number.
scientific :: Scientific -> Builder
scientific :: Scientific -> Builder
scientific Scientific
s
    | Int
e forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e forall a. Ord a => a -> a -> Bool
> Int
1024 = Scientific -> Builder
scientificBuilder Scientific
s
    | Bool
otherwise = Integer -> Builder
B.integerDec (Scientific -> Integer
coefficient Scientific
s forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e)
  where
    e :: Int
e = Scientific -> Int
base10Exponent Scientific
s

emptyArray_ :: Builder
emptyArray_ :: Builder
emptyArray_ = forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'[',Char
']')) ()

emptyObject_ :: Builder
emptyObject_ :: Builder
emptyObject_ = forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'{',Char
'}')) ()

ascii2 :: (Char, Char) -> BP.BoundedPrim a
ascii2 :: forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char, Char)
cs = forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (Char, Char)
cs forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BP.>$< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7
{-# INLINE ascii2 #-}

ascii3 :: (Char, (Char, Char)) -> BP.BoundedPrim a
ascii3 :: forall a. (Char, (Char, Char)) -> BoundedPrim a
ascii3 (Char, (Char, Char))
cs = forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (Char, (Char, Char))
cs forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
    FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7
{-# INLINE ascii3 #-}

ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a
ascii4 :: forall a. (Char, (Char, (Char, Char))) -> BoundedPrim a
ascii4 (Char, (Char, (Char, Char)))
cs = forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (Char, (Char, (Char, Char)))
cs forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
    FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7
{-# INLINE ascii4 #-}

ascii5 :: (Char, (Char, (Char, (Char, Char)))) -> BP.BoundedPrim a
ascii5 :: forall a. (Char, (Char, (Char, (Char, Char)))) -> BoundedPrim a
ascii5 (Char, (Char, (Char, (Char, Char))))
cs = forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (Char, (Char, (Char, (Char, Char))))
cs forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
    FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7
{-# INLINE ascii5 #-}

ascii6 :: (Char, (Char, (Char, (Char, (Char, Char))))) -> BP.BoundedPrim a
ascii6 :: forall a.
(Char, (Char, (Char, (Char, (Char, Char))))) -> BoundedPrim a
ascii6 (Char, (Char, (Char, (Char, (Char, Char)))))
cs = forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (Char, (Char, (Char, (Char, (Char, Char)))))
cs forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
    FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7
{-# INLINE ascii6 #-}

ascii8 :: (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
       -> BP.BoundedPrim a
ascii8 :: forall a.
(Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
-> BoundedPrim a
ascii8 (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
cs = forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
cs forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
    FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*<
    FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7
{-# INLINE ascii8 #-}

day :: Day -> Builder
day :: Day -> Builder
day Day
dd = Integer -> Builder
encodeYear Integer
yr forall a. Semigroup a => a -> a -> a
<>
         forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a.
(Char, (Char, (Char, (Char, (Char, Char))))) -> BoundedPrim a
ascii6 (Char
'-',(Char
mh,(Char
ml,(Char
'-',(Char
dh,Char
dl)))))) ()
  where (Integer
yr,Int
m,Int
d)    = Day -> (Integer, Int, Int)
toGregorian Day
dd
        !(T Char
mh Char
ml)  = Int -> T
twoDigits Int
m
        !(T Char
dh Char
dl)  = Int -> T
twoDigits Int
d
{-# INLINE day #-}

month :: Month -> Builder
month :: Month -> Builder
month Month
mm = Integer -> Builder
encodeYear Integer
yr forall a. Semigroup a => a -> a -> a
<>
           forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a. (Char, (Char, Char)) -> BoundedPrim a
ascii3 (Char
'-',(Char
mh,Char
ml))) ()
  where (Integer
yr,Int
m) = Month -> (Integer, Int)
toYearMonth Month
mm
        !(T Char
mh Char
ml) = Int -> T
twoDigits Int
m
{-# INLINE month #-}

quarter :: Quarter -> Builder
quarter :: Quarter -> Builder
quarter Quarter
qq = Integer -> Builder
encodeYear Integer
yr forall a. Semigroup a => a -> a -> a
<>
             forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a. (Char, (Char, Char)) -> BoundedPrim a
ascii3 (Char
'-',(Char
'q',Char
qd))) ()
  where (Integer
yr,QuarterOfYear
q) = Quarter -> (Integer, QuarterOfYear)
toYearQuarter Quarter
qq
        qd :: Char
qd = case QuarterOfYear
q of
            QuarterOfYear
Q1 -> Char
'1'
            QuarterOfYear
Q2 -> Char
'2'
            QuarterOfYear
Q3 -> Char
'3'
            QuarterOfYear
Q4 -> Char
'4'
{-# INLINE quarter #-}

-- | Used in encoding day, month, quarter
encodeYear :: Integer -> Builder
encodeYear :: Integer -> Builder
encodeYear Integer
y
    | Integer
y forall a. Ord a => a -> a -> Bool
>= Integer
1000 = Integer -> Builder
B.integerDec Integer
y
    | Integer
y forall a. Ord a => a -> a -> Bool
>= Integer
0    = forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a. (Char, (Char, (Char, Char))) -> BoundedPrim a
ascii4 (forall {p}. Integral p => p -> (Char, (Char, (Char, Char)))
padYear Integer
y)) ()
    | Integer
y forall a. Ord a => a -> a -> Bool
>= -Integer
999 = forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a. (Char, (Char, (Char, (Char, Char)))) -> BoundedPrim a
ascii5 (Char
'-',forall {p}. Integral p => p -> (Char, (Char, (Char, Char)))
padYear (- Integer
y))) ()
    | Bool
otherwise = Integer -> Builder
B.integerDec Integer
y
  where
    padYear :: p -> (Char, (Char, (Char, Char)))
padYear p
y' =
        let (Int
ab,Int
c) = forall a b. (Integral a, Num b) => a -> b
fromIntegral p
y' forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
            (Int
a,Int
b)  = Int
ab forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
        in (Char
'0',(Int -> Char
digit Int
a,(Int -> Char
digit Int
b,Int -> Char
digit Int
c)))
{-# INLINE encodeYear #-}

timeOfDay :: TimeOfDay -> Builder
timeOfDay :: TimeOfDay -> Builder
timeOfDay TimeOfDay
t = TimeOfDay64 -> Builder
timeOfDay64 (TimeOfDay -> TimeOfDay64
toTimeOfDay64 TimeOfDay
t)
{-# INLINE timeOfDay #-}

timeOfDay64 :: TimeOfDay64 -> Builder
timeOfDay64 :: TimeOfDay64 -> Builder
timeOfDay64 (TOD Int
h Int
m Int64
s)
  | Int64
frac forall a. Eq a => a -> a -> Bool
== Int64
0 = Builder
hhmmss -- omit subseconds if 0
  | Bool
otherwise = Builder
hhmmss forall a. Semigroup a => a -> a -> a
<> forall a. BoundedPrim a -> a -> Builder
BP.primBounded BoundedPrim Int64
showFrac Int64
frac
  where
    hhmmss :: Builder
hhmmss  = forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a.
(Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
-> BoundedPrim a
ascii8 (Char
hh,(Char
hl,(Char
':',(Char
mh,(Char
ml,(Char
':',(Char
sh,Char
sl)))))))) ()
    !(T Char
hh Char
hl)  = Int -> T
twoDigits Int
h
    !(T Char
mh Char
ml)  = Int -> T
twoDigits Int
m
    !(T Char
sh Char
sl)  = Int -> T
twoDigits (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
real)
    (Int64
real,Int64
frac) = Int64
s forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
pico
    showFrac :: BoundedPrim Int64
showFrac = (Char
'.',) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded FixedPrim Char
BP.char7 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int64
trunc12)
    trunc12 :: BoundedPrim Int64
trunc12 = (forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
micro) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
              forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (\(Int64
_,Int64
y) -> Int64
y forall a. Eq a => a -> a -> Bool
== Int64
0) (forall a b. (a, b) -> a
fst forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Int64
trunc6) (BoundedPrim Int64
digits6 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int64
trunc6)
    digits6 :: BoundedPrim Int64
digits6 = ((forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
milli) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int
digits3 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
digits3)
    trunc6 :: BoundedPrim Int64
trunc6  = ((forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
milli) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
              forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (\(Int
_,Int
y) -> Int
y forall a. Eq a => a -> a -> Bool
== Int
0) (forall a b. (a, b) -> a
fst forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Int
trunc3) (BoundedPrim Int
digits3 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
trunc3)
    digits3 :: BoundedPrim Int
digits3 = (forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int
digits2 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
digits1)
    digits2 :: BoundedPrim Int
digits2 = (forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int
digits1 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
digits1)
    digits1 :: BoundedPrim Int
digits1 = forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded (Int -> Char
digit forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Char
BP.char7)
    trunc3 :: BoundedPrim Int
trunc3  = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (forall a. Eq a => a -> a -> Bool
== Int
0) forall a. BoundedPrim a
BP.emptyB forall a b. (a -> b) -> a -> b
$
              (forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
100) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int
digits1 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
trunc2)
    trunc2 :: BoundedPrim Int
trunc2  = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (forall a. Eq a => a -> a -> Bool
== Int
0) forall a. BoundedPrim a
BP.emptyB forall a b. (a -> b) -> a -> b
$
              (forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10)  forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Int
digits1 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int
trunc1)
    trunc1 :: BoundedPrim Int
trunc1  = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (forall a. Eq a => a -> a -> Bool
== Int
0) forall a. BoundedPrim a
BP.emptyB BoundedPrim Int
digits1

    pico :: Int64
pico       = Int64
1000000000000 -- number of picoseconds  in 1 second
    micro :: Int64
micro      =       Int64
1000000 -- number of microseconds in 1 second
    milli :: Int
milli      =          Int
1000 -- number of milliseconds in 1 second

timeZone :: TimeZone -> Builder
timeZone :: TimeZone -> Builder
timeZone (TimeZone Int
off Bool
_ String
_)
  | Int
off forall a. Eq a => a -> a -> Bool
== Int
0  = Char -> Builder
B.char7 Char
'Z'
  | Bool
otherwise = forall a. BoundedPrim a -> a -> Builder
BP.primBounded (forall a.
(Char, (Char, (Char, (Char, (Char, Char))))) -> BoundedPrim a
ascii6 (Char
s,(Char
hh,(Char
hl,(Char
':',(Char
mh,Char
ml)))))) ()
  where !s :: Char
s         = if Int
off forall a. Ord a => a -> a -> Bool
< Int
0 then Char
'-' else Char
'+'
        !(T Char
hh Char
hl) = Int -> T
twoDigits Int
h
        !(T Char
mh Char
ml) = Int -> T
twoDigits Int
m
        (Int
h,Int
m)      = forall a. Num a => a -> a
abs Int
off forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
60
{-# INLINE timeZone #-}

dayTime :: Day -> TimeOfDay64 -> Builder
dayTime :: Day -> TimeOfDay64 -> Builder
dayTime Day
d TimeOfDay64
t = Day -> Builder
day Day
d forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
'T' forall a. Semigroup a => a -> a -> a
<> TimeOfDay64 -> Builder
timeOfDay64 TimeOfDay64
t
{-# INLINE dayTime #-}

utcTime :: UTCTime -> B.Builder
utcTime :: UTCTime -> Builder
utcTime (UTCTime Day
d DiffTime
s) = Day -> TimeOfDay64 -> Builder
dayTime Day
d (DiffTime -> TimeOfDay64
diffTimeOfDay64 DiffTime
s) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
'Z'
{-# INLINE utcTime #-}

localTime :: LocalTime -> Builder
localTime :: LocalTime -> Builder
localTime (LocalTime Day
d TimeOfDay
t) = Day -> TimeOfDay64 -> Builder
dayTime Day
d (TimeOfDay -> TimeOfDay64
toTimeOfDay64 TimeOfDay
t)
{-# INLINE localTime #-}

zonedTime :: ZonedTime -> Builder
zonedTime :: ZonedTime -> Builder
zonedTime (ZonedTime LocalTime
t TimeZone
z) = LocalTime -> Builder
localTime LocalTime
t forall a. Semigroup a => a -> a -> a
<> TimeZone -> Builder
timeZone TimeZone
z
{-# INLINE zonedTime #-}

data T = T {-# UNPACK #-} !Char {-# UNPACK #-} !Char

twoDigits :: Int -> T
twoDigits :: Int -> T
twoDigits Int
a     = Char -> Char -> T
T (Int -> Char
digit Int
hi) (Int -> Char
digit Int
lo)
  where (Int
hi,Int
lo) = Int
a forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10

digit :: Int -> Char
digit :: Int -> Char
digit Int
x = Int -> Char
chr (Int
x forall a. Num a => a -> a -> a
+ Int
48)

-------------------------------------------------------------------------------
-- TimeOfDay64
-------------------------------------------------------------------------------

-- | Like TimeOfDay, but using a fixed-width integer for seconds.
data TimeOfDay64 = TOD {-# UNPACK #-} !Int
                       {-# UNPACK #-} !Int
                       {-# UNPACK #-} !Int64

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

posixDayLength :: DiffTime
posixDayLength :: DiffTime
posixDayLength = DiffTime
86400

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