    {-# 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 Data.Scientific (FPFormat(..), Scientific, base10Exponent)
    import Data.Text.Lazy.Builder
    import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)
    import Numeric (showHex)
    import qualified Data.HashMap.Strict as H
    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 :: 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 :: 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 Null       = {-# SCC "go/Null" #-} "null"
        go (Bool b :: Bool
    b)   = {-# SCC "go/Bool" #-} if Bool
    b then "true" else "false"
        go (Number s :: Scientific
    s) = {-# SCC "go/Number" #-} Scientific -> Builder
    fromScientific Scientific
    s
        go (String s :: Text
    s) = {-# SCC "go/String" #-} Text -> Builder
    string Text
    s
        go (Array v :: Array
    v)
            | Array -> Bool
    forall a. Vector a -> Bool
    V.null Array
    v = {-# SCC "go/Array" #-} "[]"
            | Bool
    otherwise = {-# SCC "go/Array" #-}
                          Char -> Builder
    singleton '[' 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
    singleton ']') (Array -> Array
    forall a. Vector a -> Vector a
    V.unsafeTail Array
    v)
          where f :: Value -> Builder -> Builder
    f a :: Value
    a z :: Builder
    z = Char -> Builder
    singleton ',' 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 m :: Object
    m) = {-# SCC "go/Object" #-}
            case Object -> [(Text, Value)]
    forall k v. HashMap k v -> [(k, v)]
    H.toList Object
    m of
              (x :: (Text, Value)
    x:xs :: [(Text, Value)]
    xs) -> Char -> Builder
    singleton '{' 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
    f (Char -> Builder
    singleton '}') [(Text, Value)]
    xs
              _      -> "{}"
          where f :: (Text, Value) -> Builder -> Builder
    f a :: (Text, Value)
    a z :: Builder
    z     = Char -> Builder
    singleton ',' 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
    string Text
    k Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton ':' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Value -> Builder
    go Value
    v

    string :: T.Text -> Builder
    string :: Text -> Builder
    string s :: Text
    s = {-# SCC "string" #-} Char -> Builder
    singleton '"' 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
    singleton '"'
      where
        quote :: Text -> Builder
    quote q :: Text
    q = case Text -> Maybe (Char, Text)
    T.uncons Text
    t of
                    Nothing      -> Text -> Builder
    fromText Text
    h
                    Just (!Char
    c,t' :: Text
    t') -> Text -> Builder
    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 (h :: Text
    h,t :: Text
    t) = {-# SCC "break" #-} (Char -> Bool) -> Text -> (Text, Text)
    T.break Char -> Bool
    isEscape Text
    q
        isEscape :: Char -> Bool
    isEscape c :: Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\"' Bool -> Bool -> Bool
    ||
                     Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\\' Bool -> Bool -> Bool
    ||
                     Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    < '\x20'
        escape :: Char -> Builder
    escape '\"' = "\\\""
        escape '\\' = "\\\\"
        escape '\n' = "\\n"
        escape '\r' = "\\r"
        escape '\t' = "\\t"

        escape c :: Char
    c
            | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    < '\x20' = String -> Builder
    fromString (String -> Builder) -> String -> Builder
    forall a b. (a -> b) -> a -> b
    $ "\\u" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    h) '0' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    h
            | Bool
    otherwise  = Char -> Builder
    singleton Char
    c
            where h :: String
    h = Int -> String -> String
    forall a. (Integral a, Show a) => a -> String -> String
    showHex (Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    c) ""

    fromScientific :: Scientific -> Builder
    fromScientific :: Scientific -> Builder
    fromScientific s :: Scientific
    s = FPFormat -> Maybe Int -> Scientific -> Builder
    formatScientificBuilder FPFormat
    format Maybe Int
    prec Scientific
    s
      where
        (format :: FPFormat
    format, prec :: Maybe Int
    prec)
          | Scientific -> Int
    base10Exponent Scientific
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0 = (FPFormat
    Generic, Maybe Int
    forall a. Maybe a
    Nothing)
          | Bool
    otherwise            = (FPFormat
    Fixed,   Int -> Maybe Int
    forall a. a -> Maybe a
    Just 0)