{-# 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
    , month
    , quarter
    , localTime
    , utcTime
    , timeOfDay
    , zonedTime
    , ascii2
    , ascii4
    , ascii5
    ) where

import Prelude.Compat

import Data.Aeson.Internal.Time
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 as B
import Data.ByteString.Builder.Prim as BP
import Data.ByteString.Builder.Scientific (scientificBuilder)
import Data.Char (chr, ord)
import Data.Scientific (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
import Data.Word (Word8)
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_ = BoundedPrim () -> () -> Builder
forall a. BoundedPrim a -> a -> Builder
BP.primBounded ((Char, (Char, (Char, Char))) -> BoundedPrim ()
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 = 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 (Char
't',(Char
'r',(Char
'u',Char
'e'))))
                                   ((Char, (Char, (Char, (Char, Char)))) -> BoundedPrim Bool
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
  | Array -> Bool
forall a. Vector a -> Bool
V.null Array
v  = Builder
emptyArray_
  | Bool
otherwise = Char -> Builder
B.char8 Char
'[' 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 Char
']') (Array -> Array
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
',' 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 :: KM.KeyMap Value -> Builder
object :: Object -> Builder
object Object
m = case Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
m of
    ((Key, Value)
x:[(Key, Value)]
xs) -> Char -> Builder
B.char8 Char
'{' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Key, Value) -> Builder
one (Key, Value)
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Key, Value) -> Builder -> Builder)
-> Builder -> [(Key, Value)] -> Builder
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
',' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Key, Value) -> Builder
one (Key, Value)
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
z
    one :: (Key, Value) -> Builder
one (Key
k,Value
v)     = Key -> Builder
key Key
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char8 Char
':' Builder -> Builder -> Builder
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 (Text -> Builder) -> (Key -> Text) -> Key -> Builder
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
'"' 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 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
'"' 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 Char
'"'

-- | Encode a JSON string.
string :: String -> Builder
string :: String -> Builder
string String
t = Char -> Builder
B.char8 Char
'"' 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 Char
'"'
  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
> Char
'\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, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'\\')) (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, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'"' )) (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 Char
'\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 Char
'\n'  ) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'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 Char
'\r'  ) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'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 Char
'\t'  ) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'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 = (\Word8
c -> (Char
'\\', (Char
'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 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 Scientific
s
    | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
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 (Char
'[',Char
']')) ()

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 (Char
'{',Char
'}')) ()

ascii2 :: (Char, Char) -> BP.BoundedPrim a
ascii2 :: (Char, Char) -> BoundedPrim a
ascii2 (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 #-}

ascii3 :: (Char, (Char, Char)) -> BP.BoundedPrim a
ascii3 :: (Char, (Char, Char)) -> BoundedPrim a
ascii3 (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)) -> a -> (Char, (Char, Char))
forall a b. a -> b -> a
const (Char, (Char, Char))
cs (a -> (Char, (Char, Char)))
-> FixedPrim (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) -> 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 ascii3 #-}

ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a
ascii4 :: (Char, (Char, (Char, Char))) -> BoundedPrim a
ascii4 (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 (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 (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 (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 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
'-',(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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
           BoundedPrim () -> () -> Builder
forall a. BoundedPrim a -> a -> Builder
BP.primBounded ((Char, (Char, Char)) -> BoundedPrim ()
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
             BoundedPrim () -> () -> Builder
forall a. BoundedPrim a -> a -> Builder
BP.primBounded ((Char, (Char, Char)) -> BoundedPrim ()
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1000 = Integer -> Builder
B.integerDec Integer
y
    | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
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
>= -Integer
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 (Char
'-',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
  where
    padYear :: a -> (Char, (Char, (Char, Char)))
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)
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 (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 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
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
':',(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 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
real)
    (Int64
real,Int64
frac) = Int64
s Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
pico
    showFrac :: BoundedPrim Int64
showFrac = (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
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 (\(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) (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 (\(Int
_,Int
y) -> Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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` Int
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` Int
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
== Int
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` Int
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
== Int
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` Int
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
== Int
0) BoundedPrim Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Char -> Builder
B.char7 Char
'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
':',(Char
mh,Char
ml)))))) ()
  where !s :: Char
s         = if Int
off Int -> Int -> Bool
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)      = 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
{-# INLINE timeZone #-}

dayTime :: Day -> TimeOfDay64 -> Builder
dayTime :: Day -> TimeOfDay64 -> Builder
dayTime Day
d TimeOfDay64
t = Day -> Builder
day Day
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
'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 Day
d 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 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 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 Int
a     = Char -> Char -> T
T (Int -> Char
digit Int
hi) (Int -> Char
digit Int
lo)
  where (Int
hi,Int
lo) = Int
a Int -> Int -> (Int, Int)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48)