1{-# LANGUAGE BangPatterns #-} 2{-# LANGUAGE NoImplicitPrelude #-} 3{-# LANGUAGE OverloadedStrings #-} 4-- | 5-- Module: Data.Aeson.Text 6-- Copyright: (c) 2012-2016 Bryan O'Sullivan 7-- (c) 2011 MailRank, Inc. 8-- License: BSD3 9-- Maintainer: Bryan O'Sullivan <bos@serpentine.com> 10-- Stability: experimental 11-- Portability: portable 12-- 13-- Most frequently, you'll probably want to encode straight to UTF-8 14-- (the standard JSON encoding) using 'encode'. 15-- 16-- You can use the conversions to 'Builder's when embedding JSON messages as 17-- parts of a protocol. 18 19module Data.Aeson.Text 20 ( 21 encodeToLazyText 22 , encodeToTextBuilder 23 ) where 24 25import Prelude.Compat 26 27import Data.Aeson.Types (Value(..), ToJSON(..)) 28import Data.Aeson.Encoding (encodingToLazyByteString) 29import Data.Scientific (FPFormat(..), Scientific, base10Exponent) 30import Data.Text.Lazy.Builder 31import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder) 32import Numeric (showHex) 33import qualified Data.HashMap.Strict as H 34import qualified Data.Text as T 35import qualified Data.Text.Lazy as LT 36import qualified Data.Text.Lazy.Encoding as LT 37import qualified Data.Vector as V 38 39-- | Encode a JSON 'Value' to a "Data.Text.Lazy" 40-- 41-- /Note:/ uses 'toEncoding' 42encodeToLazyText :: ToJSON a => a -> LT.Text 43encodeToLazyText = LT.decodeUtf8 . encodingToLazyByteString . toEncoding 44 45-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be 46-- embedded efficiently in a text-based protocol. 47-- 48-- If you are going to immediately encode straight to a 49-- 'L.ByteString', it is more efficient to use 'encode' (lazy ByteString) 50-- or @'fromEncoding' . 'toEncoding'@ (ByteString.Builder) instead. 51-- 52-- /Note:/ Uses 'toJSON' 53encodeToTextBuilder :: ToJSON a => a -> Builder 54encodeToTextBuilder = 55 go . toJSON 56 where 57 go Null = {-# SCC "go/Null" #-} "null" 58 go (Bool b) = {-# SCC "go/Bool" #-} if b then "true" else "false" 59 go (Number s) = {-# SCC "go/Number" #-} fromScientific s 60 go (String s) = {-# SCC "go/String" #-} string s 61 go (Array v) 62 | V.null v = {-# SCC "go/Array" #-} "[]" 63 | otherwise = {-# SCC "go/Array" #-} 64 singleton '[' <> 65 go (V.unsafeHead v) <> 66 V.foldr f (singleton ']') (V.unsafeTail v) 67 where f a z = singleton ',' <> go a <> z 68 go (Object m) = {-# SCC "go/Object" #-} 69 case H.toList m of 70 (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs 71 _ -> "{}" 72 where f a z = singleton ',' <> one a <> z 73 one (k,v) = string k <> singleton ':' <> go v 74 75string :: T.Text -> Builder 76string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"' 77 where 78 quote q = case T.uncons t of 79 Nothing -> fromText h 80 Just (!c,t') -> fromText h <> escape c <> quote t' 81 where (h,t) = {-# SCC "break" #-} T.break isEscape q 82 isEscape c = c == '\"' || 83 c == '\\' || 84 c < '\x20' 85 escape '\"' = "\\\"" 86 escape '\\' = "\\\\" 87 escape '\n' = "\\n" 88 escape '\r' = "\\r" 89 escape '\t' = "\\t" 90 91 escape c 92 | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h 93 | otherwise = singleton c 94 where h = showHex (fromEnum c) "" 95 96fromScientific :: Scientific -> Builder 97fromScientific s = formatScientificBuilder format prec s 98 where 99 (format, prec) 100 | base10Exponent s < 0 = (Generic, Nothing) 101 | otherwise = (Fixed, Just 0) 102