@@ -1,165 +1,19 @@
1−{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, DeriveDataTypeable, RankNTypes #-}
21module Data.Aeson.Encoding
32 (
43 -- * Encoding
5− Encoding (..) -- TODO: export fromEncoding for now
4+ Encoding
65 , fromEncoding
76 , unsafeToEncoding
8− , Series (..) -- TODO: don't export constructor
7+ , Series
98 , pairs
109 -- * Predicates
1110 , nullEncoding
1211 -- * Encoding constructors
1312 , emptyArray_
1413 , emptyObject_
15− , wrapArray
16− , wrapObject
1714 , text
1815 , list
1916 , dict
20− , tuple
21− , (>*<)
22− -- ** chars
23− , comma, colon, openBracket, closeBracket, openCurly, closeCurly
2417 ) where
2518
26−#if !MIN_VERSION_base(4,8,0)
27−import Data.Monoid (Monoid(..))
28−#endif
29−
30−import Data.Text (Text)
31−import Data.ByteString.Builder (Builder, char7, toLazyByteString)
32−import Data.Semigroup (Semigroup((<>)))
33−import Data.ByteString.Builder.Prim (primBounded)
34−import Data.Typeable (Typeable)
35−
36−import qualified Data.ByteString.Lazy as BSL
37−import qualified Data.Aeson.Encode.Builder as B
38−
39−-- | An encoding of a JSON value.
40−newtype Encoding = Encoding {
41− fromEncoding :: Builder
42− -- ^ Acquire the underlying bytestring builder.
43− } deriving (Semigroup,Monoid,Typeable)
44−
45−-- | Make Encoding from Builder.
46−--
47−-- Use with care! You have to make sure that the passed Builder
48−-- is a valid JSON Encoding!
49−unsafeToEncoding :: Builder -> Encoding
50−unsafeToEncoding = Encoding
51−
52−-------------------------------------------------------------------------------
53−-- Encoding instances
54−-------------------------------------------------------------------------------
55−
56−instance Show Encoding where
57− show (Encoding e) = show (toLazyByteString e)
58−
59−instance Eq Encoding where
60− Encoding a == Encoding b = toLazyByteString a == toLazyByteString b
61−
62−instance Ord Encoding where
63− compare (Encoding a) (Encoding b) =
64− compare (toLazyByteString a) (toLazyByteString b)
65−
66−-- | A series of values that, when encoded, should be separated by
67−-- commas. Since 0.11.0.0, the '.=' operator is overloaded to create
68−-- either @(Text, Value)@ or 'Series'. You can use Series when
69−-- encoding directly to a bytestring builder as in the following
70−-- example:
71−--
72−-- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)
73−data Series = Empty
74− | Value Encoding
75− deriving (Typeable)
76−
77−instance Semigroup Series where
78− Empty <> a = a
79− Value a <> b =
80− Value $
81− a <> case b of
82− Empty -> mempty
83− Value c -> Encoding (char7 ',') <> c
84−
85−instance Monoid Series where
86− mempty = Empty
87− mappend = (<>)
88−
89−nullEncoding :: Encoding -> Bool
90−nullEncoding = BSL.null . toLazyByteString . fromEncoding
91−
92−emptyArray_ :: Encoding
93−emptyArray_ = Encoding B.emptyArray_
94−
95−emptyObject_ :: Encoding
96−emptyObject_ = Encoding B.emptyObject_
97−
98−wrapArray :: Encoding -> Encoding
99−wrapArray e = openBracket <> e <> closeBracket
100−
101−wrapObject :: Encoding -> Encoding
102−wrapObject e = openCurly <> e <> closeCurly
103−
104−-- | Encode a series of key/value pairs, separated by commas.
105−pairs :: Series -> Encoding
106−pairs = brackets '{' '}'
107−{-# INLINE pairs #-}
108−
109−brackets :: Char -> Char -> Series -> Encoding
110−brackets begin end (Value v) = Encoding $
111− char7 begin <> fromEncoding v <> char7 end
112−brackets begin end Empty = Encoding (primBounded (B.ascii2 (begin,end)) ())
113−
114−list :: (a -> Encoding) -> [a] -> Encoding
115−list _ [] = emptyArray_
116−list to' (x:xs) = Encoding $
117− char7 '[' <> fromEncoding (to' x) <> commas xs <> char7 ']'
118− where
119− commas = foldr (\v vs -> char7 ',' <> fromEncoding (to' v) <> vs) mempty
120−{-# INLINE list #-}
121−
122−-- | Encode as JSON object
123−dict
124− :: (k -> Encoding) -- ^ key encoding
125− -> (v -> Encoding) -- ^ value encoding
126− -> (forall a. (k -> v -> a -> a) -> a -> m -> a) -- ^ @foldrWithKey@ - indexed fold
127− -> m -- ^ container
128− -> Encoding
129−dict encodeKey encodeVal foldrWithKey = brackets '{' '}' . foldrWithKey go mempty
130− where
131− go k v c = Value (encodeKV k v) <> c
132− encodeKV k v = encodeKey k <> Encoding (char7 ':') <> encodeVal v
133−{-# INLINE dict #-}
134−
135−infixr 6 >*<
136−-- | See 'tuple'.
137−(>*<) :: Encoding -> Encoding -> Encoding
138−Encoding a >*< Encoding b = Encoding $ a <> char7 ',' <> b
139−{-# INLINE (>*<) #-}
140−
141−-- | Encode as a tuple.
142−--
143−-- @
144−-- toEncoding (X a b c) = tuple $
145−-- toEncoding a >*<
146−-- toEncoding b >*<
147−-- toEncoding c
148−tuple :: Encoding -> Encoding
149−tuple b = Encoding (char7 '[' <> fromEncoding b <> char7 ']')
150−{-# INLINE tuple #-}
151−
152−text :: Text -> Encoding
153−text = Encoding . B.text
154−
155−-------------------------------------------------------------------------------
156−-- chars
157−-------------------------------------------------------------------------------
158−
159−comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding
160−comma = Encoding $ char7 ','
161−colon = Encoding $ char7 ':'
162−openBracket = Encoding $ char7 '['
163−closeBracket = Encoding $ char7 ']'
164−openCurly = Encoding $ char7 '{'
165−closeCurly = Encoding $ char7 '}'
19+import Data.Aeson.Encoding.Internal