git.iko.soy/typeable/aeson
on 1.1.x help sign in
typeable/aeson/Data/Aeson/Text.hs
101 lines 3.5 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE OverloadedStrings #-}
3-- |
4-- Module: Data.Aeson.Text
5-- Copyright: (c) 2012-2016 Bryan O'Sullivan
6-- (c) 2011 MailRank, Inc.
7-- License: BSD3
8-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
9-- Stability: experimental
10-- Portability: portable
11--
12-- Most frequently, you'll probably want to encode straight to UTF-8
13-- (the standard JSON encoding) using 'encode'.
14--
15-- You can use the conversions to 'Builder's when embedding JSON messages as
16-- parts of a protocol.
17module Data.Aeson.Text
18 (
19 encodeToLazyText
20 , encodeToTextBuilder
21 ) where
23import Prelude ()
24import Prelude.Compat
26import Data.Aeson.Types (Value(..), ToJSON(..))
27import Data.Aeson.Encoding (encodingToLazyByteString)
28import Data.Monoid ((<>))
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
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
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 'encodeToBuilder'
50-- 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
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"
91 escape c
92 | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h
93 | otherwise = singleton c
94 where h = showHex (fromEnum c) ""
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)