{-# LANGUAGE BangPatterns #-}

{-# 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 ()

import Prelude.Compat

import Data.Aeson.Types (Value(..), ToJSON(..))

import Data.Aeson.Encoding (encodingToLazyByteString)

import Data.Monoid ((<>))

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 = LT.decodeUtf8 . encodingToLazyByteString . 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 'encodeToBuilder'

-- instead.

--

-- /Note:/ Uses 'toJSON'

encodeToTextBuilder :: ToJSON a => a -> Builder

encodeToTextBuilder =

    go . toJSON

  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

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 < '\x20'

    escape '\"' = "\\\""

    escape '\\' = "\\\\"

    escape '\n' = "\\n"

    escape '\r' = "\\r"

    escape '\t' = "\\t"

    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 = formatScientificBuilder format prec s

  where

    (format, prec)

      | base10Exponent s < 0 = (Generic, Nothing)

      | otherwise            = (Fixed,   Just 0)