git.iko.soy/typeable/aeson
on 1.3.1.1 help sign in
typeable/aeson/Data/Aeson/Encoding/Internal.hs
370 lines 11 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE EmptyDataDecls #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE RankNTypes #-}
5module Data.Aeson.Encoding.Internal
6 (
7 -- * Encoding
8 Encoding' (..)
9 , Encoding
10 , encodingToLazyByteString
11 , unsafeToEncoding
12 , retagEncoding
13 , Series (..)
14 , pairs
15 , pair
16 , pairStr
17 , pair'
18 -- * Predicates
19 , nullEncoding
20 -- * Encoding constructors
21 , emptyArray_
22 , emptyObject_
23 , wrapObject
24 , wrapArray
25 , null_
26 , bool
27 , text
28 , lazyText
29 , string
30 , list
31 , dict
32 , tuple
33 , (>*<)
34 , InArray
35 , empty
36 , (><)
37 , econcat
38 -- ** Decimal numbers
39 , int8, int16, int32, int64, int
40 , word8, word16, word32, word64, word
41 , integer, float, double, scientific
42 -- ** Decimal numbers as Text
43 , int8Text, int16Text, int32Text, int64Text, intText
44 , word8Text, word16Text, word32Text, word64Text, wordText
45 , integerText, floatText, doubleText, scientificText
46 -- ** Time
47 , day
48 , localTime
49 , utcTime
50 , timeOfDay
51 , zonedTime
52 -- ** value
53 , value
54 -- ** JSON tokens
55 , comma, colon, openBracket, closeBracket, openCurly, closeCurly
56 ) where
58import Prelude ()
59import Prelude.Compat
61import Data.Aeson.Types.Internal (Value)
62import Data.ByteString.Builder (Builder, char7, toLazyByteString)
63import Data.Int
64import Data.Scientific (Scientific)
65import Data.Semigroup (Semigroup ((<>)))
66import Data.Text (Text)
67import Data.Time (Day, LocalTime, TimeOfDay, UTCTime, ZonedTime)
68import Data.Typeable (Typeable)
69import Data.Word
70import qualified Data.Aeson.Encoding.Builder as EB
71import qualified Data.ByteString.Builder as B
72import qualified Data.ByteString.Lazy as BSL
73import qualified Data.Text.Lazy as LT
75-- | An encoding of a JSON value.
76--
77-- @tag@ represents which kind of JSON the Encoding is encoding to,
78-- we reuse 'Text' and 'Value' as tags here.
79newtype Encoding' tag = Encoding {
80 fromEncoding :: Builder
81 -- ^ Acquire the underlying bytestring builder.
82 } deriving (Typeable)
84-- | Often used synonym for 'Encoding''.
85type Encoding = Encoding' Value
87-- | Make Encoding from Builder.
88--
89-- Use with care! You have to make sure that the passed Builder
90-- is a valid JSON Encoding!
91unsafeToEncoding :: Builder -> Encoding' a
92unsafeToEncoding = Encoding
94encodingToLazyByteString :: Encoding' a -> BSL.ByteString
95encodingToLazyByteString = toLazyByteString . fromEncoding
96{-# INLINE encodingToLazyByteString #-}
98retagEncoding :: Encoding' a -> Encoding' b
99retagEncoding = Encoding . fromEncoding
101-------------------------------------------------------------------------------
102-- Encoding instances
103-------------------------------------------------------------------------------
105instance Show (Encoding' a) where
106 show (Encoding e) = show (toLazyByteString e)
108instance Eq (Encoding' a) where
109 Encoding a == Encoding b = toLazyByteString a == toLazyByteString b
111instance Ord (Encoding' a) where
112 compare (Encoding a) (Encoding b) =
113 compare (toLazyByteString a) (toLazyByteString b)
115-- | A series of values that, when encoded, should be separated by
116-- commas. Since 0.11.0.0, the '.=' operator is overloaded to create
117-- either @(Text, Value)@ or 'Series'. You can use Series when
118-- encoding directly to a bytestring builder as in the following
119-- example:
120--
121-- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)
122data Series = Empty
123 | Value (Encoding' Series)
124 deriving (Typeable)
126pair :: Text -> Encoding -> Series
127pair name val = pair' (text name) val
128{-# INLINE pair #-}
130pairStr :: String -> Encoding -> Series
131pairStr name val = pair' (string name) val
132{-# INLINE pairStr #-}
134pair' :: Encoding' Text -> Encoding -> Series
135pair' name val = Value $ retagEncoding $ retagEncoding name >< colon >< val
137instance Semigroup Series where
138 Empty <> a = a
139 a <> Empty = a
140 Value a <> Value b = Value (a >< comma >< b)
142instance Monoid Series where
143 mempty = Empty
144 mappend = (<>)
146nullEncoding :: Encoding' a -> Bool
147nullEncoding = BSL.null . toLazyByteString . fromEncoding
149emptyArray_ :: Encoding
150emptyArray_ = Encoding EB.emptyArray_
152emptyObject_ :: Encoding
153emptyObject_ = Encoding EB.emptyObject_
155wrapArray :: Encoding' a -> Encoding
156wrapArray e = retagEncoding $ openBracket >< e >< closeBracket
158wrapObject :: Encoding' a -> Encoding
159wrapObject e = retagEncoding $ openCurly >< e >< closeCurly
161null_ :: Encoding
162null_ = Encoding EB.null_
164bool :: Bool -> Encoding
165bool True = Encoding "true"
166bool False = Encoding "false"
168-- | Encode a series of key/value pairs, separated by commas.
169pairs :: Series -> Encoding
170pairs (Value v) = openCurly >< retagEncoding v >< closeCurly
171pairs Empty = emptyObject_
172{-# INLINE pairs #-}
174list :: (a -> Encoding) -> [a] -> Encoding
175list _ [] = emptyArray_
176list to' (x:xs) = openBracket >< to' x >< commas xs >< closeBracket
177 where
178 commas = foldr (\v vs -> comma >< to' v >< vs) empty
179{-# INLINE list #-}
181-- | Encode as JSON object
182dict
183 :: (k -> Encoding' Text) -- ^ key encoding
184 -> (v -> Encoding) -- ^ value encoding
185 -> (forall a. (k -> v -> a -> a) -> a -> m -> a) -- ^ @foldrWithKey@ - indexed fold
186 -> m -- ^ container
187 -> Encoding
188dict encodeKey encodeVal foldrWithKey = pairs . foldrWithKey go mempty
189 where
190 go k v c = Value (encodeKV k v) <> c
191 encodeKV k v = retagEncoding (encodeKey k) >< colon >< retagEncoding (encodeVal v)
192{-# INLINE dict #-}
194-- | Type tag for tuples contents, see 'tuple'.
195data InArray
197infixr 6 >*<
198-- | See 'tuple'.
199(>*<) :: Encoding' a -> Encoding' b -> Encoding' InArray
200a >*< b = retagEncoding a >< comma >< retagEncoding b
201{-# INLINE (>*<) #-}
203empty :: Encoding' a
204empty = Encoding mempty
206econcat :: [Encoding' a] -> Encoding' a
207econcat = foldr (><) empty
209infixr 6 ><
210(><) :: Encoding' a -> Encoding' a -> Encoding' a
211Encoding a >< Encoding b = Encoding (a <> b)
212{-# INLINE (><) #-}
214-- | Encode as a tuple.
215--
216-- @
217-- toEncoding (X a b c) = tuple $
218-- toEncoding a >*<
219-- toEncoding b >*<
220-- toEncoding c
221tuple :: Encoding' InArray -> Encoding
222tuple b = retagEncoding $ openBracket >< b >< closeBracket
223{-# INLINE tuple #-}
225text :: Text -> Encoding' a
226text = Encoding . EB.text
228lazyText :: LT.Text -> Encoding' a
229lazyText t = Encoding $
230 B.char7 '"' <>
231 LT.foldrChunks (\x xs -> EB.unquoted x <> xs) (B.char7 '"') t
233string :: String -> Encoding' a
234string = Encoding . EB.string
236-------------------------------------------------------------------------------
237-- chars
238-------------------------------------------------------------------------------
240comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding' a
241comma = Encoding $ char7 ','
242colon = Encoding $ char7 ':'
243openBracket = Encoding $ char7 '['
244closeBracket = Encoding $ char7 ']'
245openCurly = Encoding $ char7 '{'
246closeCurly = Encoding $ char7 '}'
248-------------------------------------------------------------------------------
249-- Decimal numbers
250-------------------------------------------------------------------------------
252int8 :: Int8 -> Encoding
253int8 = Encoding . B.int8Dec
255int16 :: Int16 -> Encoding
256int16 = Encoding . B.int16Dec
258int32 :: Int32 -> Encoding
259int32 = Encoding . B.int32Dec
261int64 :: Int64 -> Encoding
262int64 = Encoding . B.int64Dec
264int :: Int -> Encoding
265int = Encoding . B.intDec
267word8 :: Word8 -> Encoding
268word8 = Encoding . B.word8Dec
270word16 :: Word16 -> Encoding
271word16 = Encoding . B.word16Dec
273word32 :: Word32 -> Encoding
274word32 = Encoding . B.word32Dec
276word64 :: Word64 -> Encoding
277word64 = Encoding . B.word64Dec
279word :: Word -> Encoding
280word = Encoding . B.wordDec
282integer :: Integer -> Encoding
283integer = Encoding . B.integerDec
285float :: Float -> Encoding
286float = realFloatToEncoding $ Encoding . B.floatDec
288double :: Double -> Encoding
289double = realFloatToEncoding $ Encoding . B.doubleDec
291scientific :: Scientific -> Encoding
292scientific = Encoding . EB.scientific
294realFloatToEncoding :: RealFloat a => (a -> Encoding) -> a -> Encoding
295realFloatToEncoding e d
296 | isNaN d || isInfinite d = null_
297 | otherwise = e d
298{-# INLINE realFloatToEncoding #-}
300-------------------------------------------------------------------------------
301-- Decimal numbers as Text
302-------------------------------------------------------------------------------
304int8Text :: Int8 -> Encoding' a
305int8Text = Encoding . EB.quote . B.int8Dec
307int16Text :: Int16 -> Encoding' a
308int16Text = Encoding . EB.quote . B.int16Dec
310int32Text :: Int32 -> Encoding' a
311int32Text = Encoding . EB.quote . B.int32Dec
313int64Text :: Int64 -> Encoding' a
314int64Text = Encoding . EB.quote . B.int64Dec
316intText :: Int -> Encoding' a
317intText = Encoding . EB.quote . B.intDec
319word8Text :: Word8 -> Encoding' a
320word8Text = Encoding . EB.quote . B.word8Dec
322word16Text :: Word16 -> Encoding' a
323word16Text = Encoding . EB.quote . B.word16Dec
325word32Text :: Word32 -> Encoding' a
326word32Text = Encoding . EB.quote . B.word32Dec
328word64Text :: Word64 -> Encoding' a
329word64Text = Encoding . EB.quote . B.word64Dec
331wordText :: Word -> Encoding' a
332wordText = Encoding . EB.quote . B.wordDec
334integerText :: Integer -> Encoding' a
335integerText = Encoding . EB.quote . B.integerDec
337floatText :: Float -> Encoding' a
338floatText = Encoding . EB.quote . B.floatDec
340doubleText :: Double -> Encoding' a
341doubleText = Encoding . EB.quote . B.doubleDec
343scientificText :: Scientific -> Encoding' a
344scientificText = Encoding . EB.quote . EB.scientific
346-------------------------------------------------------------------------------
347-- time
348-------------------------------------------------------------------------------
350day :: Day -> Encoding' a
351day = Encoding . EB.quote . EB.day
353localTime :: LocalTime -> Encoding' a
354localTime = Encoding . EB.quote . EB.localTime
356utcTime :: UTCTime -> Encoding' a
357utcTime = Encoding . EB.quote . EB.utcTime
359timeOfDay :: TimeOfDay -> Encoding' a
360timeOfDay = Encoding . EB.quote . EB.timeOfDay
362zonedTime :: ZonedTime -> Encoding' a
363zonedTime = Encoding . EB.quote . EB.zonedTime
365-------------------------------------------------------------------------------
366-- Value
367-------------------------------------------------------------------------------
369value :: Value -> Encoding
370value = Encoding . EB.encodeToBuilder