    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE OverloadedStrings #-}
    -- |
    -- Module:      Data.Aeson.Text
    -- Copyright:   (c) 2012-2016 Bryan O'Sullivan
    --              (c) 2011 MailRank, Inc.
    -- License:     BSD3
    -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
    -- Stability:   experimental
    -- Portability: portable
    --
    -- Most frequently, you'll probably want to encode straight to UTF-8
    -- (the standard JSON encoding) using 'encode'.
    --
    -- You can use the conversions to 'Builder's when embedding JSON messages as
    -- parts of a protocol.

    module Data.Aeson.Text
        (
          encodeToLazyText
        , encodeToTextBuilder
        ) where

    import Prelude.Compat

    import Data.Aeson.Types (Value(..), ToJSON(..))
    import Data.Aeson.Encoding (encodingToLazyByteString)
    import qualified Data.Aeson.KeyMap as KM
    import Data.Scientific (FPFormat(..), Scientific, 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

    -- | Encode a JSON 'Value' to a "Data.Text.Lazy"
    --
    -- /Note:/ uses 'toEncoding'
    encodeToLazyText :: ToJSON a => a -> LT.Text
    encodeToLazyText :: forall a. ToJSON a => a -> Text
    encodeToLazyText = ByteString -> Text
    LT.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Encoding' Value -> ByteString
    forall a. Encoding' a -> ByteString
    encodingToLazyByteString (Encoding' Value -> ByteString)
    -> (a -> Encoding' Value) -> a -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Encoding' Value
    forall a. ToJSON a => a -> Encoding' Value
    toEncoding

    -- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be
    -- embedded efficiently in a text-based protocol.
    --
    -- If you are going to immediately encode straight to a
    -- 'L.ByteString', it is more efficient to use 'encode' (lazy ByteString)
    -- or @'fromEncoding' . 'toEncoding'@ (ByteString.Builder) instead.
    --
    -- /Note:/ Uses 'toJSON'
    encodeToTextBuilder :: ToJSON a => a -> Builder
    encodeToTextBuilder :: forall a. ToJSON a => a -> Builder
    encodeToTextBuilder =
        Value -> Builder
    go (Value -> Builder) -> (a -> Value) -> a -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Value
    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)
            | Array -> Bool
    forall a. Vector a -> Bool
    V.null Array
    v = Builder
    "[]"
            | Bool
    otherwise =
                          Char -> Builder
    TB.singleton Char
    '[' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
                          Value -> Builder
    go (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
    f (Char -> Builder
    TB.singleton Char
    ']') (Array -> Array
    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
    ',' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Value -> Builder
    go Value
    a Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    z
        go (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
    TB.singleton 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 a b. (a -> b -> b) -> b -> [a] -> b
    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
    ',' 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) = Text -> Builder
    string (Key -> Text
    Key.toText Key
    k) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    TB.singleton Char
    ':' Builder -> Builder -> Builder
    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
    '"' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    quote Text
    s Builder -> Builder -> Builder
    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 Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    escape Char
    c Builder -> Builder -> Builder
    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 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\"' Bool -> Bool -> Bool
    ||
                     Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\\' Bool -> Bool -> Bool
    ||
                     Char
    c Char -> Char -> Bool
    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 Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    < Char
    '\x20' = [Char] -> Builder
    TB.fromString ([Char] -> Builder) -> [Char] -> Builder
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "\\u" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> [Char]
    forall a. Int -> a -> [a]
    replicate (Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    h) Char
    '0' [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    h
            | Bool
    otherwise  = Char -> Builder
    TB.singleton Char
    c
            where h :: [Char]
    h = Int -> [Char] -> [Char]
    forall a. Integral a => a -> [Char] -> [Char]
    showHex (Char -> Int
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = (FPFormat
    Generic, Maybe Int
    forall a. Maybe a
    Nothing)
          | Bool
    otherwise            = (FPFormat
    Fixed,   Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    0)