{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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
    , localTime
    , utcTime
    , timeOfDay
    , zonedTime
    , ascii2
    , ascii4
    , ascii5
    ) where

import Prelude.Compat

import Data.Aeson.Internal.Time
import Data.Aeson.Types.Internal (Value (..))
import Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim as BP
import Data.ByteString.Builder.Scientific (scientificBuilder)
import Data.Char (chr, ord)
import Data.Semigroup ((<>))
import Data.Scientific (Scientific, base10Exponent, coefficient)
import Data.Text.Encoding (encodeUtf8BuilderEscaped)
import Data.Time (UTCTime(..))
import Data.Time.Calendar (Day(..), toGregorian)
import Data.Time.LocalTime
import Data.Word (Word8)
import qualified Data.HashMap.Strict as HMS
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 Null       = Builder
null_
encodeToBuilder (Bool b :: Bool
b)   = Bool -> Builder
bool Bool
b
encodeToBuilder (Number n :: Scientific
n) = Scientific -> Builder
scientific Scientific
n
encodeToBuilder (String s :: Text
s) = Text -> Builder
text Text
s
encodeToBuilder (Array v :: Array
v)  = Array -> Builder
array Array
v
encodeToBuilder (Object m :: Object
m) = Object -> Builder
object Object
m

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

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

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

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

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

-- | 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 b :: Builder
b = Char -> Builder
B.char8 '"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char8 '"'

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

escapeAscii :: BP.BoundedPrim Word8
escapeAscii :: BoundedPrim Word8
escapeAscii =
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w '\\'  ) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 ('\\','\\')) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w '\"'  ) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 ('\\','"' )) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w '\x20') (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded FixedPrim Word8
BP.word8) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w '\n'  ) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 ('\\','n' )) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w '\r'  ) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 ('\\','r' )) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w '\t'  ) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 ('\\','t' )) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
    FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded FixedPrim Word8
hexEscape -- fallback for chars < 0x20
  where
    hexEscape :: BP.FixedPrim Word8
    hexEscape :: FixedPrim Word8
hexEscape = (\c :: Word8
c -> ('\\', ('u', Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c))) (Word8 -> (Char, (Char, Word16)))
-> FixedPrim (Char, (Char, Word16)) -> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BP.>$<
        FixedPrim Char
BP.char8 FixedPrim Char
-> FixedPrim (Char, Word16) -> FixedPrim (Char, (Char, Word16))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char8 FixedPrim Char -> FixedPrim Word16 -> FixedPrim (Char, Word16)
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 c :: Char
c = Int -> Word8
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 s :: Scientific
s
    | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1024 = Scientific -> Builder
scientificBuilder Scientific
s
    | Bool
otherwise = Integer -> Builder
B.integerDec (Scientific -> Integer
coefficient Scientific
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10 Integer -> Int -> Integer
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_ = BoundedPrim () -> () -> Builder
forall a. BoundedPrim a -> a -> Builder
BP.primBounded ((Char, Char) -> BoundedPrim ()
forall a. (Char, Char) -> BoundedPrim a
ascii2 ('[',']')) ()

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

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

ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a
ascii4 :: (Char, (Char, (Char, Char))) -> BoundedPrim a
ascii4 cs :: (Char, (Char, (Char, Char)))
cs = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Char, (Char, (Char, Char))) -> a -> (Char, (Char, (Char, Char)))
forall a b. a -> b -> a
const (Char, (Char, (Char, Char)))
cs (a -> (Char, (Char, (Char, Char))))
-> FixedPrim (Char, (Char, (Char, Char))) -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
    FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, Char))
-> FixedPrim (Char, (Char, (Char, Char)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, Char) -> FixedPrim (Char, (Char, Char))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
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 :: (Char, (Char, (Char, (Char, Char)))) -> BoundedPrim a
ascii5 cs :: (Char, (Char, (Char, (Char, Char))))
cs = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Char, (Char, (Char, (Char, Char))))
-> a -> (Char, (Char, (Char, (Char, Char))))
forall a b. a -> b -> a
const (Char, (Char, (Char, (Char, Char))))
cs (a -> (Char, (Char, (Char, (Char, Char)))))
-> FixedPrim (Char, (Char, (Char, (Char, Char)))) -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
    FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, Char)))
-> FixedPrim (Char, (Char, (Char, (Char, Char))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, Char))
-> FixedPrim (Char, (Char, (Char, Char)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, Char) -> FixedPrim (Char, (Char, Char))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
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 :: (Char, (Char, (Char, (Char, (Char, Char))))) -> BoundedPrim a
ascii6 cs :: (Char, (Char, (Char, (Char, (Char, Char)))))
cs = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Char, (Char, (Char, (Char, (Char, Char)))))
-> a -> (Char, (Char, (Char, (Char, (Char, Char)))))
forall a b. a -> b -> a
const (Char, (Char, (Char, (Char, (Char, Char)))))
cs (a -> (Char, (Char, (Char, (Char, (Char, Char))))))
-> FixedPrim (Char, (Char, (Char, (Char, (Char, Char)))))
-> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
    FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, (Char, Char))))
-> FixedPrim (Char, (Char, (Char, (Char, (Char, Char)))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, Char)))
-> FixedPrim (Char, (Char, (Char, (Char, Char))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, Char))
-> FixedPrim (Char, (Char, (Char, Char)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, Char) -> FixedPrim (Char, (Char, Char))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
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 :: (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
-> BoundedPrim a
ascii8 cs :: (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
cs = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
-> a
-> (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
forall a b. a -> b -> a
const (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
cs (a -> (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char))))))))
-> FixedPrim
     (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
-> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
    FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, (Char, (Char, (Char, Char))))))
-> FixedPrim
     (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, (Char, (Char, Char)))))
-> FixedPrim (Char, (Char, (Char, (Char, (Char, (Char, Char))))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, (Char, Char))))
-> FixedPrim (Char, (Char, (Char, (Char, (Char, Char)))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, Char)))
-> FixedPrim (Char, (Char, (Char, (Char, Char))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*<
    FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, Char))
-> FixedPrim (Char, (Char, (Char, Char)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, Char) -> FixedPrim (Char, (Char, Char))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
BP.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
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 dd :: Day
dd = Integer -> Builder
encodeYear Integer
yr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
         BoundedPrim () -> () -> Builder
forall a. BoundedPrim a -> a -> Builder
BP.primBounded ((Char, (Char, (Char, (Char, (Char, Char))))) -> BoundedPrim ()
forall a.
(Char, (Char, (Char, (Char, (Char, Char))))) -> BoundedPrim a
ascii6 ('-',(Char
mh,(Char
ml,('-',(Char
dh,Char
dl)))))) ()
  where (yr :: Integer
yr,m :: Int
m,d :: Int
d)    = Day -> (Integer, Int, Int)
toGregorian Day
dd
        !(T mh :: Char
mh ml :: Char
ml)  = Int -> T
twoDigits Int
m
        !(T dh :: Char
dh dl :: Char
dl)  = Int -> T
twoDigits Int
d
        encodeYear :: Integer -> Builder
encodeYear y :: Integer
y
            | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 1000 = Integer -> Builder
B.integerDec Integer
y
            | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0    = BoundedPrim () -> () -> Builder
forall a. BoundedPrim a -> a -> Builder
BP.primBounded ((Char, (Char, (Char, Char))) -> BoundedPrim ()
forall a. (Char, (Char, (Char, Char))) -> BoundedPrim a
ascii4 (Integer -> (Char, (Char, (Char, Char)))
forall a. Integral a => a -> (Char, (Char, (Char, Char)))
padYear Integer
y)) ()
            | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= -999 = BoundedPrim () -> () -> Builder
forall a. BoundedPrim a -> a -> Builder
BP.primBounded ((Char, (Char, (Char, (Char, Char)))) -> BoundedPrim ()
forall a. (Char, (Char, (Char, (Char, Char)))) -> BoundedPrim a
ascii5 ('-',Integer -> (Char, (Char, (Char, Char)))
forall a. Integral a => a -> (Char, (Char, (Char, Char)))
padYear (- Integer
y))) ()
            | Bool
otherwise = Integer -> Builder
B.integerDec Integer
y
        padYear :: a -> (Char, (Char, (Char, Char)))
padYear y :: a
y =
            let (ab :: Int
ab,c :: Int
c) = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10
                (a :: Int
a,b :: Int
b)  = Int
ab Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10
            in ('0',(Int -> Char
digit Int
a,(Int -> Char
digit Int
b,Int -> Char
digit Int
c)))
{-# INLINE day #-}

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

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

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

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

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

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

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

zonedTime :: ZonedTime -> Builder
zonedTime :: ZonedTime -> Builder
zonedTime (ZonedTime t :: LocalTime
t z :: TimeZone
z) = LocalTime -> Builder
localTime LocalTime
t Builder -> Builder -> Builder
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 a :: Int
a     = Char -> Char -> T
T (Int -> Char
digit Int
hi) (Int -> Char
digit Int
lo)
  where (hi :: Int
hi,lo :: Int
lo) = Int
a Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10

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