{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Aeson.Text
(
encodeToLazyText
, encodeToTextBuilder
) where
import Data.Aeson.Internal.Prelude
import Data.Aeson.Types (Value(..), ToJSON(..))
import Data.Aeson.Encoding (encodingToLazyByteString)
import qualified Data.Aeson.KeyMap as KM
import Data.Scientific (FPFormat(..), base10Exponent)
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as TB
import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)
import Numeric (showHex)
import qualified Data.Aeson.Key as Key
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import qualified Data.Vector as V
encodeToLazyText :: ToJSON a => a -> LT.Text
encodeToLazyText :: forall a. ToJSON a => a -> Text
encodeToLazyText = ByteString -> Text
LT.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoding' a -> ByteString
encodingToLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Encoding
toEncoding
encodeToTextBuilder :: ToJSON a => a -> Builder
encodeToTextBuilder :: forall a. ToJSON a => a -> Builder
encodeToTextBuilder =
Value -> Builder
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON
where
go :: Value -> Builder
go Value
Null = Builder
"null"
go (Bool Bool
b) = if Bool
b then Builder
"true" else Builder
"false"
go (Number Scientific
s) = Scientific -> Builder
fromScientific Scientific
s
go (String Text
s) = Text -> Builder
string Text
s
go (Array Array
v)
| forall a. Vector a -> Bool
V.null Array
v = Builder
"[]"
| Bool
otherwise =
Char -> Builder
TB.singleton Char
'[' forall a. Semigroup a => a -> a -> a
<>
Value -> Builder
go (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
f (Char -> Builder
TB.singleton Char
']') (forall a. Vector a -> Vector a
V.unsafeTail Array
v)
where f :: Value -> Builder -> Builder
f Value
a Builder
z = Char -> Builder
TB.singleton Char
',' forall a. Semigroup a => a -> a -> a
<> Value -> Builder
go Value
a forall a. Semigroup a => a -> a -> a
<> Builder
z
go (Object Object
m) =
case forall v. KeyMap v -> [(Key, v)]
KM.toList Object
m of
((Key, Value)
x:[(Key, Value)]
xs) -> Char -> Builder
TB.singleton 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
f (Char -> Builder
TB.singleton Char
'}') [(Key, Value)]
xs
[(Key, Value)]
_ -> Builder
"{}"
where f :: (Key, Value) -> Builder -> Builder
f (Key, Value)
a Builder
z = Char -> Builder
TB.singleton 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) = Text -> Builder
string (Key -> Text
Key.toText Key
k) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
':' forall a. Semigroup a => a -> a -> a
<> Value -> Builder
go Value
v
string :: T.Text -> Builder
string :: Text -> Builder
string Text
s = Char -> Builder
TB.singleton Char
'"' forall a. Semigroup a => a -> a -> a
<> Text -> Builder
quote Text
s forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'"'
where
quote :: Text -> Builder
quote Text
q = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Maybe (Char, Text)
Nothing -> Text -> Builder
TB.fromText Text
h
Just (!Char
c,Text
t') -> Text -> Builder
TB.fromText Text
h forall a. Semigroup a => a -> a -> a
<> Char -> Builder
escape Char
c forall a. Semigroup a => a -> a -> a
<> Text -> Builder
quote Text
t'
where (Text
h,Text
t) = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isEscape Text
q
isEscape :: Char -> Bool
isEscape Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'\"' Bool -> Bool -> Bool
||
Char
c forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
||
Char
c forall a. Ord a => a -> a -> Bool
< Char
'\x20'
escape :: Char -> Builder
escape Char
'\"' = Builder
"\\\""
escape Char
'\\' = Builder
"\\\\"
escape Char
'\n' = Builder
"\\n"
escape Char
'\r' = Builder
"\\r"
escape Char
'\t' = Builder
"\\t"
escape Char
c
| Char
c forall a. Ord a => a -> a -> Bool
< Char
'\x20' = [Char] -> Builder
TB.fromString forall a b. (a -> b) -> a -> b
$ [Char]
"\\u" forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
4 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
h) Char
'0' forall a. [a] -> [a] -> [a]
++ [Char]
h
| Bool
otherwise = Char -> Builder
TB.singleton Char
c
where h :: [Char]
h = forall a. (Integral a, Show a) => a -> ShowS
showHex (forall a. Enum a => a -> Int
fromEnum Char
c) [Char]
""
fromScientific :: Scientific -> Builder
fromScientific :: Scientific -> Builder
fromScientific Scientific
s = FPFormat -> Maybe Int -> Scientific -> Builder
formatScientificBuilder FPFormat
format Maybe Int
prec Scientific
s
where
(FPFormat
format, Maybe Int
prec)
| Scientific -> Int
base10Exponent Scientific
s forall a. Ord a => a -> a -> Bool
< Int
0 = (FPFormat
Generic, forall a. Maybe a
Nothing)
| Bool
otherwise = (FPFormat
Fixed, forall a. a -> Maybe a
Just Int
0)