{-# LANGUAGE CPP, BangPatterns, OverloadedStrings #-}
module Data.Aeson.Encode
( encode
#if MIN_VERSION_bytestring(0,10,4)
, encodeToByteStringBuilder
, encodeToTextBuilder
#else
, encodeToTextBuilder
#endif
, fromValue
) where
import Data.Aeson.Types (Value(..))
import Data.Monoid (mappend)
import Data.Scientific (Scientific, coefficient, base10Exponent)
import Data.Text.Lazy.Builder
import Data.Text.Lazy.Builder.Int (decimal)
import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
import Numeric (showHex)
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import qualified Data.Vector as V
#if MIN_VERSION_bytestring(0,10,4)
import Data.Aeson.Encode.ByteString (encode, encodeToByteStringBuilder)
#else
import Data.Aeson.Types (ToJSON(toJSON))
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Lazy.Encoding as TLE
encode :: ToJSON a => a -> BL.ByteString
encode = TLE.encodeUtf8 . TLB.toLazyText . encodeToTextBuilder . toJSON
#endif
encodeToTextBuilder :: Value -> Builder
encodeToTextBuilder =
go
where
go Null = {-# SCC "go/Null" #-} "null"
go (Bool b) = {-# SCC "go/Bool" #-} if b then "true" else "false"
go (Number s) = {-# SCC "go/Number" #-} fromScientific s
go (String s) = {-# SCC "go/String" #-} string s
go (Array v)
| V.null v = {-# SCC "go/Array" #-} "[]"
| otherwise = {-# SCC "go/Array" #-}
singleton '[' <>
go (V.unsafeHead v) <>
V.foldr f (singleton ']') (V.unsafeTail v)
where f a z = singleton ',' <> go a <> z
go (Object m) = {-# SCC "go/Object" #-}
case H.toList m of
(x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs
_ -> "{}"
where f a z = singleton ',' <> one a <> z
one (k,v) = string k <> singleton ':' <> go v
{-# DEPRECATED fromValue "Use 'encodeToTextBuilder' instead" #-}
fromValue :: Value -> Builder
fromValue = encodeToTextBuilder
string :: T.Text -> Builder
string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'
where
quote q = case T.uncons t of
Nothing -> fromText h
Just (!c,t') -> fromText h <> escape c <> quote t'
where (h,t) = {-# SCC "break" #-} T.break isEscape q
isEscape c = c == '\"' ||
c == '\\' ||
c == '<' ||
c == '>' ||
c < '\x20'
escape '\"' = "\\\""
escape '\\' = "\\\\"
escape '\n' = "\\n"
escape '\r' = "\\r"
escape '\t' = "\\t"
escape '<' = "\\u003c"
escape '>' = "\\u003e"
escape c
| c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h
| otherwise = singleton c
where h = showHex (fromEnum c) ""
fromScientific :: Scientific -> Builder
fromScientific s
| e < 0 = scientificBuilder s
| otherwise = decimal (coefficient s * 10 ^ e)
where
e = base10Exponent s
(<>) :: Builder -> Builder -> Builder
(<>) = mappend
{-# INLINE (<>) #-}
infixr 6 <>