@@ -1,27 +1,29 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE EmptyDataDecls #-}
4−{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE FunctionalDependencies #-}
7−{-# LANGUAGE GADTs #-}
6+{-# LANGUAGE GADTs #-}
8−{-# LANGUAGE NoImplicitPrelude #-}
7+{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE NamedFieldPuns #-}
9−{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PatternGuards #-}
10+{-# LANGUAGE PatternGuards #-}
11−{-# LANGUAGE PolyKinds #-}
12−{-# LANGUAGE RecordWildCards #-}
11+{-# LANGUAGE RecordWildCards #-}
13−{-# LANGUAGE ScopedTypeVariables #-}
12+{-# LANGUAGE ScopedTypeVariables #-}
14−{-# LANGUAGE TypeOperators #-}
13+{-# LANGUAGE TypeOperators #-}
14+{-# LANGUAGE TypeSynonymInstances #-}
15−{-# LANGUAGE UndecidableInstances #-}
15+{-# LANGUAGE UndecidableInstances #-}
17+#if __GLASGOW_HASKELL__ >= 706
18+{-# LANGUAGE PolyKinds #-}
17#include "overlapping-compat.h"
21#include "overlapping-compat.h"
18−#include "incoherent-compat.h"
20-- TODO: Drop this when we remove support for Data.Attoparsec.Number
23-- TODO: Drop this when we remove support for Data.Attoparsec.Number
21{-# OPTIONS_GHC -fno-warn-deprecations #-}
24{-# OPTIONS_GHC -fno-warn-deprecations #-}
23−module Data.Aeson.Types.ToJSON
26+module Data.Aeson.Types.ToJSON (
25 -- * Core JSON classes
27 -- * Core JSON classes
26 ToJSON(..)
28 ToJSON(..)
27 -- * Liftings to unary and binary type constructors
29 -- * Liftings to unary and binary type constructors
@@ -33,7 +35,7 @@ module Data.Aeson.Types.ToJSON
33 , toEncoding2
35 , toEncoding2
34 -- * Generic JSON classes
36 -- * Generic JSON classes
35 , GToJSON(..)
37 , GToJSON(..)
36− , ToArgs(..)
38+ , GToEncoding(..)
37 , genericToJSON
39 , genericToJSON
38 , genericToEncoding
40 , genericToEncoding
39 , genericLiftToJSON
41 , genericLiftToJSON
@@ -41,107 +43,89 @@ module Data.Aeson.Types.ToJSON
41 -- * Classes and types for map keys
43 -- * Classes and types for map keys
42 , ToJSONKey(..)
44 , ToJSONKey(..)
43 , ToJSONKeyFunction(..)
45 , ToJSONKeyFunction(..)
45 , contramapToJSONKeyFunction
46 , contramapToJSONKeyFunction
50 -- * Object key-value pairs
47 -- * Object key-value pairs
51 , KeyValue(..)
48 , KeyValue(..)
54 -- * Functions needed for documentation
49 -- * Functions needed for documentation
55 -- * Encoding functions
50 -- * Encoding functions
56 , listEncoding
51 , listEncoding
57 , listValue
52 , listValue
60import Prelude.Compat
56import Prelude.Compat
62−import Control.Applicative (Const(..))
63−import Control.Monad.ST (ST)
64−import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
58+import Data.Aeson.Encoding.Internal (Encoding (..), Series, dict, emptyArray_,
65−import Data.Aeson.Encoding.Internal ((>*<))
59+ tuple, (>*<))
66−import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
60+import Data.Aeson.Functions (mapHashKeyVal, mapKeyVal)
67−import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
61+import Data.Aeson.Types.Generic
68import Data.Aeson.Types.Internal
62import Data.Aeson.Types.Internal
64+import qualified Data.Aeson.Encode.Builder as EB
65+import qualified Data.Aeson.Encoding.Internal as E
67+import Control.Applicative (Const (..))
68+import Control.Monad.ST (ST)
69−import Data.Attoparsec.Number (Number(..))
69+import Data.Attoparsec.Number (Number (..))
70−import Data.Bits (unsafeShiftR)
70+import Data.Bits (unsafeShiftR)
71−import Data.DList (DList)
71+import Data.DList (DList)
72−import Data.Fixed (Fixed, HasResolution, Nano)
72+import Data.Fixed (Fixed, HasResolution)
73−import Data.Foldable (toList)
73+import Data.Foldable (toList)
74−import Data.Functor.Compose (Compose(..))
74+import Data.Functor.Identity (Identity (..))
75−import Data.Functor.Contravariant (Contravariant (..))
76−import Data.Functor.Identity (Identity(..))
77−import Data.Functor.Product (Product(..))
78−import Data.Functor.Sum (Sum(..))
79−import Data.Int (Int16, Int32, Int64, Int8)
75+import Data.Int (Int16, Int32, Int64, Int8)
80−import Data.List (intersperse)
76+import Data.List (intersperse)
81−import Data.List.NonEmpty (NonEmpty(..))
77+import Data.List.NonEmpty (NonEmpty (..))
82−import Data.Semigroup ((<>))
78+import Data.Monoid (Dual (..), First (..), Last (..), (<>))
83−import Data.Proxy (Proxy(..))
79+import Data.Proxy (Proxy (..))
84−import Data.Ratio (Ratio, denominator, numerator)
80+import Data.Ratio (Ratio, denominator, numerator)
85−import Data.Scientific (Scientific)
81+import Data.Scientific (Scientific)
86−import Data.Tagged (Tagged(..))
82+import Data.Tagged (Tagged (..))
87−import Data.Text (Text, pack)
83+import Data.Text (Text, pack)
88−import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
84+import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay,
89−import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
85+ UTCTime, ZonedTime)
90−import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
91−import Data.Time.Clock.System.Compat (SystemTime (..))
92−import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale)
86+import Data.Time.Format (FormatTime, formatTime)
87+import Data.Time.Locale.Compat (defaultTimeLocale)
93−import Data.Vector (Vector)
88+import Data.Vector (Vector)
94−import Data.Version (Version, showVersion)
89+import Data.Version (Version, showVersion)
95−import Data.Void (Void, absurd)
96−import Data.Word (Word16, Word32, Word64, Word8)
90+import Data.Word (Word16, Word32, Word64, Word8)
97−import Foreign.Storable (Storable)
91+import Foreign.Storable (Storable)
98−import Foreign.C.Types (CTime (..))
99import GHC.Generics
92import GHC.Generics
100−import Numeric.Natural (Natural)
93+import Numeric.Natural (Natural)
101−import qualified Data.Aeson.Encoding as E
94+
102−import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
95+import qualified Data.ByteString.Builder as B
103−import qualified Data.ByteString.Lazy as L
96+import qualified Data.ByteString.Lazy as L
104−import qualified Data.DList as DList
97+import qualified Data.DList as DList
105−import qualified Data.HashMap.Strict as H
98+import qualified Data.HashMap.Strict as H
106−import qualified Data.HashSet as HashSet
99+import qualified Data.HashSet as HashSet
107−import qualified Data.IntMap as IntMap
100+import qualified Data.IntMap as IntMap
108−import qualified Data.IntSet as IntSet
101+import qualified Data.IntSet as IntSet
109−import qualified Data.List.NonEmpty as NE
102+import qualified Data.List.NonEmpty as NE
110−import qualified Data.Map as M
103+import qualified Data.Map as M
111−import qualified Data.Monoid as Monoid
112−import qualified Data.Scientific as Scientific
104+import qualified Data.Scientific as Scientific
113−import qualified Data.Semigroup as Semigroup
114−import qualified Data.Sequence as Seq
105+import qualified Data.Sequence as Seq
115−import qualified Data.Set as Set
106+import qualified Data.Set as Set
116−import qualified Data.Text as T
107+import qualified Data.Text as T
117−import qualified Data.Text.Encoding as T
108+import qualified Data.Text.Encoding as T
118−import qualified Data.Text.Lazy as LT
109+import qualified Data.Text.Lazy as LT
119−import qualified Data.Tree as Tree
110+import qualified Data.Text.Lazy.Builder as LTB
120−import qualified Data.UUID.Types as UUID
111+import qualified Data.Text.Lazy.Builder.Int as LTBI
121−import qualified Data.Vector as V
112+import qualified Data.Tree as Tree
113+import qualified Data.Vector as V
122−import qualified Data.Vector.Generic as VG
114+import qualified Data.Vector.Generic as VG
123−import qualified Data.Vector.Mutable as VM
115+import qualified Data.Vector.Mutable as VM
124−import qualified Data.Vector.Primitive as VP
116+import qualified Data.Vector.Primitive as VP
125−import qualified Data.Vector.Storable as VS
117+import qualified Data.Vector.Storable as VS
126−import qualified Data.Vector.Unboxed as VU
118+import qualified Data.Vector.Unboxed as VU
128−import qualified Data.Aeson.Encoding.Builder as EB
120+builder :: ToJSON a => a -> B.Builder
129−import qualified Data.ByteString.Builder as B
121+builder = fromEncoding . toEncoding
131−import qualified GHC.Exts as Exts
132−import qualified Data.Primitive.Array as PM
133−import qualified Data.Primitive.SmallArray as PM
134−import qualified Data.Primitive.Types as PM
136−#if MIN_VERSION_primitive(0,6,4)
137−#if !MIN_VERSION_primitive(0,7,0)
138−import qualified Data.Primitive.UnliftedArray as PM
140−import qualified Data.Primitive.PrimArray as PM
143toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
123toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
144−toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
124+toJSONPair keySerialiser valSerializer (a, b) = Array $ V.create $ do
125+ mv <- VM.unsafeNew 2
126+ VM.unsafeWrite mv 0 (keySerialiser a)
127+ VM.unsafeWrite mv 1 (valSerializer b)
145{-# INLINE toJSONPair #-}
129{-# INLINE toJSONPair #-}
147realFloatToJSON :: RealFloat a => a -> Value
131realFloatToJSON :: RealFloat a => a -> Value
@@ -150,59 +134,63 @@ realFloatToJSON d
150 | otherwise = Number $ Scientific.fromFloatDigits d
134 | otherwise = Number $ Scientific.fromFloatDigits d
151{-# INLINE realFloatToJSON #-}
135{-# INLINE realFloatToJSON #-}
137+realFloatToEncoding :: RealFloat a => a -> Encoding
138+realFloatToEncoding d
139+ | isNaN d || isInfinite d = Encoding EB.null_
140+ | otherwise = toEncoding (Scientific.fromFloatDigits d)
141+{-# INLINE realFloatToEncoding #-}
153-------------------------------------------------------------------------------
143-------------------------------------------------------------------------------
154-- Generics
144-- Generics
155-------------------------------------------------------------------------------
145-------------------------------------------------------------------------------
157-- | Class of generic representation types that can be converted to
147-- | Class of generic representation types that can be converted to
159−class GToJSON enc arity f where
149+class GToJSON arity f where
160 -- | This method (applied to 'defaultOptions') is used as the
150 -- | This method (applied to 'defaultOptions') is used as the
161− -- default generic implementation of 'toJSON'
151+ -- default generic implementation of 'toJSON' (if the @arity@ is 'Zero')
162− -- (with @enc ~ 'Value'@ and @arity ~ 'Zero'@)
163− -- and 'liftToJSON' (if the @arity@ is 'One').
152+ -- or 'liftToJSON' (if the @arity@ is 'One').
165− -- It also provides a generic implementation of 'toEncoding'
166− -- (with @enc ~ 'Encoding'@ and @arity ~ 'Zero'@)
167− -- and 'liftToEncoding' (if the @arity@ is 'One').
168− gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
153+ gToJSON :: Options -> Proxy arity
169−
154+ -> (a -> Value) -> ([a] -> Value) -> f a -> Value
170−-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
155+
171−-- function arguments that encode occurrences of the type parameter (for
156+-- | Class of generic representation types that can be converted to
172−-- 'ToJSON1').
157+-- a JSON 'Encoding'.
173−data ToArgs res arity a where
158+class GToEncoding arity f where
174− NoToArgs :: ToArgs res Zero a
159+ -- | This method (applied to 'defaultOptions') can be used as the
175− To1Args :: (a -> res) -> ([a] -> res) -> ToArgs res One a
160+ -- default generic implementation of 'toEncoding' (if the @arity@ is 'Zero')
161+ -- or 'liftToEncoding' (if the @arity@ is 'One').
162+ gToEncoding :: Options -> Proxy arity
163+ -> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
177-- | A configurable generic JSON creator. This function applied to
165-- | A configurable generic JSON creator. This function applied to
178-- 'defaultOptions' is used as the default for 'toJSON' when the type
166-- 'defaultOptions' is used as the default for 'toJSON' when the type
179-- is an instance of 'Generic'.
167-- is an instance of 'Generic'.
180−genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
168+genericToJSON :: (Generic a, GToJSON Zero (Rep a))
181 => Options -> a -> Value
169 => Options -> a -> Value
182−genericToJSON opts = gToJSON opts NoToArgs . from
170+genericToJSON opts = gToJSON opts proxyZero undefined undefined . from
184-- | A configurable generic JSON creator. This function applied to
172-- | A configurable generic JSON creator. This function applied to
185-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
173-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
186-- is an instance of 'Generic1'.
174-- is an instance of 'Generic1'.
187−genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
175+genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
188 => Options -> (a -> Value) -> ([a] -> Value)
176 => Options -> (a -> Value) -> ([a] -> Value)
189 -> f a -> Value
177 -> f a -> Value
190−genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
178+genericLiftToJSON opts tj tjl = gToJSON opts proxyOne tj tjl . from1
192-- | A configurable generic JSON encoder. This function applied to
180-- | A configurable generic JSON encoder. This function applied to
193-- 'defaultOptions' is used as the default for 'toEncoding' when the type
181-- 'defaultOptions' is used as the default for 'toEncoding' when the type
194-- is an instance of 'Generic'.
182-- is an instance of 'Generic'.
195−genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
183+genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))
196 => Options -> a -> Encoding
184 => Options -> a -> Encoding
197−genericToEncoding opts = gToJSON opts NoToArgs . from
185+genericToEncoding opts = gToEncoding opts proxyZero undefined undefined . from
199-- | A configurable generic JSON encoder. This function applied to
187-- | A configurable generic JSON encoder. This function applied to
200-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
188-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
201-- is an instance of 'Generic1'.
189-- is an instance of 'Generic1'.
202−genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
190+genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
203 => Options -> (a -> Encoding) -> ([a] -> Encoding)
191 => Options -> (a -> Encoding) -> ([a] -> Encoding)
204 -> f a -> Encoding
192 -> f a -> Encoding
205−genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
193+genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
207-------------------------------------------------------------------------------
195-------------------------------------------------------------------------------
@@ -210,9 +198,6 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
211-- | A type that can be converted to JSON.
199-- | A type that can be converted to JSON.
213−-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214−-- to) specify 'toEncoding'.
216-- An example type and instance:
201-- An example type and instance:
@@ -221,10 +206,10 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
222-- data Coord = Coord { x :: Double, y :: Double }
207-- data Coord = Coord { x :: Double, y :: Double }
224−-- instance 'ToJSON' Coord where
209+-- instance ToJSON Coord where
225−-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
210+-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
227−-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
212+-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
230-- Instead of manually writing your 'ToJSON' instance, there are two options
215-- Instead of manually writing your 'ToJSON' instance, there are two options
@@ -232,15 +217,17 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
233-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
218-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
234-- instance at compile time. The generated instance is optimized for your type
219-- instance at compile time. The generated instance is optimized for your type
235−-- so it will probably be more efficient than the following option.
220+-- so will probably be more efficient than the following two options:
237-- * The compiler can provide a default generic implementation for
222-- * The compiler can provide a default generic implementation for
238-- 'toJSON'.
223-- 'toJSON'.
240-- To use the second, simply add a @deriving 'Generic'@ clause to your
225-- To use the second, simply add a @deriving 'Generic'@ clause to your
241−-- datatype and declare a 'ToJSON' instance. If you require nothing other than
226+-- datatype and declare a 'ToJSON' instance for your datatype without giving
242−-- 'defaultOptions', it is sufficient to write (and this is the only
227+-- definitions for 'toJSON' or 'toEncoding'.
243−-- alternative where the default 'toJSON' implementation is sufficient):
228+--
229+-- For example, the previous example can be simplified to a more
246-- {-\# LANGUAGE DeriveGeneric \#-}
233-- {-\# LANGUAGE DeriveGeneric \#-}
@@ -249,46 +236,35 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
250-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
237-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
252−-- instance 'ToJSON' Coord where
239+-- instance ToJSON Coord where
253−-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
240+-- toEncoding = 'genericToEncoding' 'defaultOptions'
256−-- If on the other hand you wish to customize the generic decoding, you have
243+-- Why do we provide an implementation for 'toEncoding' here? The
257−-- to implement both methods:
244+-- 'toEncoding' function is a relatively new addition to this class.
245+-- To allow users of older versions of this library to upgrade without
246+-- having to edit all of their instances or encounter surprising
247+-- incompatibilities, the default implementation of 'toEncoding' uses
248+-- 'toJSON'. This produces correct results, but since it performs an
249+-- intermediate conversion to a 'Value', it will be less efficient
250+-- than directly emitting an 'Encoding'. Our one-liner definition of
251+-- 'toEncoding' above bypasses the intermediate 'Value'.
253+-- If @DefaultSignatures@ doesn't give exactly the results you want,
254+-- you can customize the generic encoding with only a tiny amount of
255+-- effort, using 'genericToJSON' and 'genericToEncoding' with your
256+-- preferred 'Options':
260−-- customOptions = 'defaultOptions'
261−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
264−-- instance 'ToJSON' Coord where
259+-- instance ToJSON Coord where
265−-- 'toJSON' = 'genericToJSON' customOptions
260+-- toJSON = 'genericToJSON' 'defaultOptions'
266−-- 'toEncoding' = 'genericToEncoding' customOptions
261+-- toEncoding = 'genericToEncoding' 'defaultOptions'
269−-- Previous versions of this library only had the 'toJSON' method. Adding
270−-- 'toEncoding' had two reasons:
272−-- 1. toEncoding is more efficient for the common case that the output of
273−-- 'toJSON' is directly serialized to a @ByteString@.
274−-- Further, expressing either method in terms of the other would be
277−-- 2. The choice of defaults allows a smooth transition for existing users:
278−-- Existing instances that do not define 'toEncoding' still
279−-- compile and have the correct semantics. This is ensured by making
280−-- the default implementation of 'toEncoding' use 'toJSON'. This produces
281−-- correct results, but since it performs an intermediate conversion to a
282−-- 'Value', it will be less efficient than directly emitting an 'Encoding'.
283−-- (this also means that specifying nothing more than
284−-- @instance ToJSON Coord@ would be sufficient as a generically decoding
285−-- instance, but there probably exists no good reason to not specify
286−-- 'toEncoding' in new instances.)
287class ToJSON a where
263class ToJSON a where
288 -- | Convert a Haskell value to a JSON-friendly intermediate type.
264 -- | Convert a Haskell value to a JSON-friendly intermediate type.
289 toJSON :: a -> Value
265 toJSON :: a -> Value
291− default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
267+ default toJSON :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
292 toJSON = genericToJSON defaultOptions
268 toJSON = genericToJSON defaultOptions
294 -- | Encode a Haskell value as JSON.
270 -- | Encode a Haskell value as JSON.
@@ -305,12 +281,12 @@ class ToJSON a where
305 -- extension, and then have GHC generate a method body as follows.
281 -- extension, and then have GHC generate a method body as follows.
308− -- instance 'ToJSON' Coord where
284+ -- instance ToJSON Coord where
309− -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
285+ -- toEncoding = 'genericToEncoding' 'defaultOptions'
312 toEncoding :: a -> Encoding
288 toEncoding :: a -> Encoding
313− toEncoding = E.value . toJSON
289+ toEncoding = E.Encoding . EB.encodeToBuilder . toJSON
314 {-# INLINE toEncoding #-}
290 {-# INLINE toEncoding #-}
316 toJSONList :: [a] -> Value
292 toJSONList :: [a] -> Value
@@ -331,27 +307,20 @@ class KeyValue kv where
331 infixr 8 .=
307 infixr 8 .=
333instance KeyValue Series where
309instance KeyValue Series where
334− name .= value = E.pair name (toEncoding value)
310+ name .= value = E.Value $ E.text name <> E.colon <> toEncoding value
335 {-# INLINE (.=) #-}
311 {-# INLINE (.=) #-}
337instance KeyValue Pair where
313instance KeyValue Pair where
338 name .= value = (name, toJSON value)
314 name .= value = (name, toJSON value)
339 {-# INLINE (.=) #-}
315 {-# INLINE (.=) #-}
341−-- | Constructs a singleton 'H.HashMap'. For calling functions that
342−-- demand an 'Object' for constructing objects. To be used in
343−-- conjunction with 'mconcat'. Prefer to use 'object' where possible.
344−instance KeyValue Object where
345− name .= value = H.singleton name (toJSON value)
348-------------------------------------------------------------------------------
317-------------------------------------------------------------------------------
349-- Classes and types for map keys
318-- Classes and types for map keys
350-------------------------------------------------------------------------------
319-------------------------------------------------------------------------------
352-- | Typeclass for types that can be used as the key of a map-like container
321-- | Typeclass for types that can be used as the key of a map-like container
353-- (like 'Map' or 'HashMap'). For example, since 'Text' has a 'ToJSONKey'
322-- (like 'Map' or 'HashMap'). For example, since 'Text' has a 'ToJSONKey'
354−-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
323+-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
355-- type 'Map' 'Text' 'Char':
324-- type 'Map' 'Text' 'Char':
357-- >>> LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
326-- >>> LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
@@ -397,147 +366,59 @@ instance KeyValue Object where
397-- >>> let m = Map.fromList [(Foo 4 "bar",'a'),(Foo 6 "arg",'b')]
366-- >>> let m = Map.fromList [(Foo 4 "bar",'a'),(Foo 6 "arg",'b')]
398-- >>> LBC8.putStrLn $ encode m
367-- >>> LBC8.putStrLn $ encode m
399-- [[{"fooName":"bar","fooAge":4},"a"],[{"fooName":"arg","fooAge":6},"b"]]
368-- [[{"fooName":"bar","fooAge":4},"a"],[{"fooName":"arg","fooAge":6},"b"]]
401-- The next case to consider is if we have a type that is a
370-- The next case to consider is if we have a type that is a
402-- newtype wrapper around 'Text'. The recommended approach is to use
371-- newtype wrapper around 'Text'. The recommended approach is to use
403-- generalized newtype deriving:
372-- generalized newtype deriving:
405−-- > newtype RecordId = RecordId { getRecordId :: Text }
374+-- > newtype RecordId = RecordId { getRecordId :: Text}
406-- > deriving (Eq,Ord,ToJSONKey)
375-- > deriving (Eq,Ord,ToJSONKey)
408-- Then we may write:
377-- Then we may write:
410-- >>> LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
379-- >>> LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
411-- {"abc":"a"}
380-- {"abc":"a"}
413-- Simple sum types are a final case worth considering. Suppose we have:
382-- Simple sum types are a final case worth considering. Suppose we have:
415−-- > data Color = Red | Green | Blue
384+-- > data Color = Red | Green | Blue | Black
416-- > deriving (Show,Read,Eq,Ord)
385-- > deriving (Show,Read,Eq,Ord)
418-- It is possible to get the 'ToJSONKey' instance for free as we did
387-- It is possible to get the 'ToJSONKey' instance for free as we did
419-- with 'Foo'. However, in this case, we have a natural way to go to
388-- with 'Foo'. However, in this case, we have a natural way to go to
420−-- and from 'Text' that does not require any escape sequences. So
389+-- and from 'Text' that does not require any escape sequences. So, in
421−-- 'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps
390+-- this example, 'ToJSONKeyText' will be used instead of 'ToJSONKeyValue'.
422−-- as objects instead of arrays of pairs. This instance may be
391+-- At the moment, there are no conveniences for this situation. The
423−-- implemented using generics as follows:
426−-- instance 'ToJSONKey' Color where
427−-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
430−-- === __Low-level implementations__
432−-- The 'Show' instance can be used to help write 'ToJSONKey':
392+-- 'Show' instance can be used to help write 'ToJSONKey', but this will
393+-- be inefficient since it uses 'String' as an intermediate step:
434-- > instance ToJSONKey Color where
395-- > instance ToJSONKey Color where
435-- > toJSONKey = ToJSONKeyText f g
396-- > toJSONKey = ToJSONKeyText f g
436-- > where f = Text.pack . show
397-- > where f = Text.pack . show
437−-- > g = text . Text.pack . show
398+-- > g = text . Text.pack . show
438−-- > -- text function is from Data.Aeson.Encoding
440−-- The situation of needing to turning function @a -> Text@ into
441−-- a 'ToJSONKeyFunction' is common enough that a special combinator
442−-- is provided for it. The above instance can be rewritten as:
444−-- > instance ToJSONKey Color where
445−-- > toJSONKey = toJSONKeyText (Text.pack . show)
447−-- The performance of the above instance can be improved by
448−-- not using 'String' as an intermediate step when converting to
449−-- 'Text'. One option for improving performance would be to use
450−-- template haskell machinery from the @text-show@ package. However,
451−-- even with the approach, the 'Encoding' (a wrapper around a bytestring
452−-- builder) is generated by encoding the 'Text' to a 'ByteString',
453−-- an intermediate step that could be avoided. The fastest possible
454−-- implementation would be:
456−-- > -- Assuming that OverloadedStrings is enabled
457−-- > instance ToJSONKey Color where
458−-- > toJSONKey = ToJSONKeyText f g
459−-- > where f x = case x of {Red -> "Red";Green ->"Green";Blue -> "Blue"}
460−-- > g x = case x of {Red -> text "Red";Green -> text "Green";Blue -> text "Blue"}
461-- > -- text function is from Data.Aeson.Encoding
399-- > -- text function is from Data.Aeson.Encoding
463−-- This works because GHC can lift the encoded values out of the case
464−-- statements, which means that they are only evaluated once. This
465−-- approach should only be used when there is a serious need to
466−-- maximize performance.
468class ToJSONKey a where
401class ToJSONKey a where
469− -- | Strategy for rendering the key for a map-like container.
402+ -- | Provides a way to use a data type as the key for a map-like
470 toJSONKey :: ToJSONKeyFunction a
404 toJSONKey :: ToJSONKeyFunction a
471 default toJSONKey :: ToJSON a => ToJSONKeyFunction a
405 default toJSONKey :: ToJSON a => ToJSONKeyFunction a
472− toJSONKey = ToJSONKeyValue toJSON toEncoding
406+ toJSONKey = ToJSONKeyValue (toJSON, toEncoding)
474 -- | This is similar in spirit to the 'showsList' method of 'Show'.
407 -- | This is similar in spirit to the 'showsList' method of 'Show'.
475 -- It makes it possible to give 'String' keys special treatment
408 -- It makes it possible to give 'String' keys special treatment
476− -- without using @OverlappingInstances@. End users should always
409+ -- without using @OverlappingInstances@.
477− -- be able to use the default implementation of this method.
478 toJSONKeyList :: ToJSONKeyFunction [a]
410 toJSONKeyList :: ToJSONKeyFunction [a]
479 default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
411 default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
480− toJSONKeyList = ToJSONKeyValue toJSON toEncoding
412+ toJSONKeyList = ToJSONKeyValue (toJSON, toEncoding)
482data ToJSONKeyFunction a
414data ToJSONKeyFunction a
483− = ToJSONKeyText !(a -> Text) !(a -> Encoding' Text)
484− -- ^ key is encoded to string, produces object
415+ = ToJSONKeyText (a -> Text, a -> Encoding) -- ^ key is encoded to string, produces object
485− | ToJSONKeyValue !(a -> Value) !(a -> Encoding)
486− -- ^ key is encoded to value, produces array
416+ | ToJSONKeyValue (a -> Value, a -> Encoding) -- ^ key is encoded to value, produces array
488−-- | Helper for creating textual keys.
491−-- instance 'ToJSONKey' MyKey where
492−-- 'toJSONKey' = 'toJSONKeyText' myKeyToText
494−-- myKeyToText = Text.pack . show -- or showt from text-show
496−toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a
497−toJSONKeyText f = ToJSONKeyText f (E.text . f)
499−-- | TODO: should this be exported?
500−toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a
501−toJSONKeyTextEnc e = ToJSONKeyText tot e
503− -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
504− tot = T.dropAround (== '"')
507− . E.encodingToLazyByteString
510−instance Contravariant ToJSONKeyFunction where
511− contramap = contramapToJSONKeyFunction
513−-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
514contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
418contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
515contramapToJSONKeyFunction h x = case x of
419contramapToJSONKeyFunction h x = case x of
516− ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
420+ ToJSONKeyText (f,g) -> ToJSONKeyText (f . h, g . h)
517− ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
421+ ToJSONKeyValue (f,g) -> ToJSONKeyValue (f . h, g . h)
519−-- 'toJSONKey' for 'Generic' types.
520−-- Deriving is supported for enumeration types, i.e. the sums of nullary
521−-- constructors. The names of constructors will be used as keys for JSON
524−-- See also 'genericFromJSONKey'.
529−-- data Color = Red | Green | Blue
530−-- deriving 'Generic'
532−-- instance 'ToJSONKey' Color where
533−-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
535−genericToJSONKey :: (Generic a, GToJSONKey (Rep a))
536− => JSONKeyOptions -> ToJSONKeyFunction a
537−genericToJSONKey opts = toJSONKeyText (pack . keyModifier opts . getConName . from)
539−class GetConName f => GToJSONKey f
540−instance GetConName f => GToJSONKey f
542-------------------------------------------------------------------------------
423-------------------------------------------------------------------------------
543-- Lifings of FromJSON and ToJSON to unary and binary type constructors
424-- Lifings of FromJSON and ToJSON to unary and binary type constructors
@@ -551,7 +432,7 @@ instance GetConName f => GToJSONKey f
552-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
433-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
553-- instance at compile time. The generated instance is optimized for your type
434-- instance at compile time. The generated instance is optimized for your type
554−-- so it will probably be more efficient than the following option.
435+-- so will probably be more efficient than the following two options:
556-- * The compiler can provide a default generic implementation for
437-- * The compiler can provide a default generic implementation for
557-- 'toJSON1'.
438-- 'toJSON1'.
@@ -569,29 +450,23 @@ instance GetConName f => GToJSONKey f
570-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
451-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
572−-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
453+-- instance ToJSON a => ToJSON1 (Pair a)
575−-- If the default implementation doesn't give exactly the results you want,
456+-- If @DefaultSignatures@ doesn't give exactly the results you want,
576-- you can customize the generic encoding with only a tiny amount of
457-- you can customize the generic encoding with only a tiny amount of
577-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
458-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
578-- your preferred 'Options':
459-- your preferred 'Options':
581−-- customOptions = 'defaultOptions'
582−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
585−-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
462+-- instance ToJSON a => ToJSON1 (Pair a) where
586−-- 'liftToJSON' = 'genericLiftToJSON' customOptions
463+-- liftToJSON = 'genericLiftToJSON' 'defaultOptions'
587−-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions
464+-- liftToEncoding = 'genericLiftToEncoding' 'defaultOptions'
590−-- See also 'ToJSON'.
591class ToJSON1 f where
466class ToJSON1 f where
592 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
467 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
594− default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
469+ default liftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
595 => (a -> Value) -> ([a] -> Value) -> f a -> Value
470 => (a -> Value) -> ([a] -> Value) -> f a -> Value
596 liftToJSON = genericLiftToJSON defaultOptions
471 liftToJSON = genericLiftToJSON defaultOptions
@@ -600,7 +475,7 @@ class ToJSON1 f where
601 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
476 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
603− default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
478+ default liftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
604 => (a -> Encoding) -> ([a] -> Encoding)
479 => (a -> Encoding) -> ([a] -> Encoding)
605 -> f a -> Encoding
480 -> f a -> Encoding
606 liftToEncoding = genericLiftToEncoding defaultOptions
481 liftToEncoding = genericLiftToEncoding defaultOptions
@@ -648,25 +523,9 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
648-- Encoding functions
523-- Encoding functions
649-------------------------------------------------------------------------------
524-------------------------------------------------------------------------------
651−-- | Helper function to use with 'liftToEncoding'.
652−-- Useful when writing own 'ToJSON1' instances.
655−-- newtype F a = F [a]
657−-- -- This instance encodes 'String' as an array of chars
658−-- instance 'ToJSON1' F where
659−-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
660−-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
662−-- instance 'Data.Aeson.FromJSON.FromJSON1' F where
663−-- 'Data.Aeson.FromJSON.liftParseJSON' p _ v = F \<$\> 'Data.Aeson.FromJSON.liftParseJSON' p ('Data.Aeson.FromJSON.listParser' p) v
665listEncoding :: (a -> Encoding) -> [a] -> Encoding
526listEncoding :: (a -> Encoding) -> [a] -> Encoding
666listEncoding = E.list
527listEncoding = E.list
667−{-# INLINE listEncoding #-}
669−-- | Helper function to use with 'liftToJSON', see 'listEncoding'.
670listValue :: (a -> Value) -> [a] -> Value
529listValue :: (a -> Value) -> [a] -> Value
671listValue f = Array . V.fromList . map f
530listValue f = Array . V.fromList . map f
672{-# INLINE listValue #-}
531{-# INLINE listValue #-}
@@ -685,11 +544,6 @@ instance ToJSON1 [] where
685 {-# INLINE liftToEncoding #-}
544 {-# INLINE liftToEncoding #-}
687instance (ToJSON a) => ToJSON [a] where
546instance (ToJSON a) => ToJSON [a] where
688− {-# SPECIALIZE instance ToJSON String #-}
689− {-# SPECIALIZE instance ToJSON [String] #-}
690− {-# SPECIALIZE instance ToJSON [Array] #-}
691− {-# SPECIALIZE instance ToJSON [Object] #-}
693 toJSON = toJSON1
547 toJSON = toJSON1
694 {-# INLINE toJSON #-}
548 {-# INLINE toJSON #-}
@@ -700,260 +554,283 @@ instance (ToJSON a) => ToJSON [a] where
700-- Generic toJSON / toEncoding
554-- Generic toJSON / toEncoding
701-------------------------------------------------------------------------------
555-------------------------------------------------------------------------------
703−instance OVERLAPPABLE_ (GToJSON enc arity a) => GToJSON enc arity (M1 i c a) where
704− -- Meta-information, which is not handled elsewhere, is ignored:
705− gToJSON opts targs = gToJSON opts targs . unM1
706− {-# INLINE gToJSON #-}
708−instance GToJSON enc One Par1 where
709− -- Direct occurrences of the last type parameter are encoded with the
710− -- function passed in as an argument:
711− gToJSON _opts (To1Args tj _) = tj . unPar1
712− {-# INLINE gToJSON #-}
714−instance ( ConsToJSON enc arity a
715− , AllNullary (C1 c a) allNullary
716− , SumToJSON enc arity (C1 c a) allNullary
717− ) => GToJSON enc arity (D1 d (C1 c a)) where
718− -- The option 'tagSingleConstructors' determines whether to wrap
719− -- a single-constructor type.
721− | tagSingleConstructors opts = (unTagged :: Tagged allNullary enc -> enc)
722− . sumToJSON opts targs
724− | otherwise = consToJSON opts targs . unM1 . unM1
725− {-# INLINE gToJSON #-}
727−instance (ConsToJSON enc arity a) => GToJSON enc arity (C1 c a) where
728− -- Constructors need to be encoded differently depending on whether they're
729− -- a record or not. This distinction is made by 'consToJSON':
730− gToJSON opts targs = consToJSON opts targs . unM1
731− {-# INLINE gToJSON #-}
733−instance ( AllNullary (a :+: b) allNullary
734− , SumToJSON enc arity (a :+: b) allNullary
735− ) => GToJSON enc arity (a :+: b)
737− -- If all constructors of a sum datatype are nullary and the
738− -- 'allNullaryToStringTag' option is set they are encoded to
739− -- strings. This distinction is made by 'sumToJSON':
740− gToJSON opts targs = (unTagged :: Tagged allNullary enc -> enc)
741− . sumToJSON opts targs
742− {-# INLINE gToJSON #-}
744--------------------------------------------------------------------------------
557--------------------------------------------------------------------------------
745-- Generic toJSON
558-- Generic toJSON
747−-- Note: Refactoring 'ToJSON a' to 'ToJSON enc a' (and 'ToJSON1' similarly) is
748−-- possible but makes error messages a bit harder to understand for missing
751−instance GToJSON Value arity V1 where
560+instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where
752− -- Empty values do not exist, which makes the job of formatting them
561+ -- Meta-information, which is not handled elsewhere, is ignored:
753− -- rather easy:
562+ gToJSON opts pa tj tjl = gToJSON opts pa tj tjl . unM1
754− gToJSON _ _ x = x `seq` error "case: V1"
755− {-# INLINE gToJSON #-}
757−instance ToJSON a => GToJSON Value arity (K1 i a) where
564+instance (ToJSON a) => GToJSON arity (K1 i a) where
758 -- Constant values are encoded using their ToJSON instance:
565 -- Constant values are encoded using their ToJSON instance:
759− gToJSON _opts _ = toJSON . unK1
566+ gToJSON _opts _ _ _ = toJSON . unK1
760− {-# INLINE gToJSON #-}
568+instance GToJSON One Par1 where
569+ -- Direct occurrences of the last type parameter are encoded with the
570+ -- function passed in as an argument:
571+ gToJSON _opts _ tj _ = tj . unPar1
762−instance ToJSON1 f => GToJSON Value One (Rec1 f) where
573+instance (ToJSON1 f) => GToJSON One (Rec1 f) where
763 -- Recursive occurrences of the last type parameter are encoded using their
574 -- Recursive occurrences of the last type parameter are encoded using their
764 -- ToJSON1 instance:
575 -- ToJSON1 instance:
765− gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
576+ gToJSON _opts _ tj tjl = liftToJSON tj tjl . unRec1
766− {-# INLINE gToJSON #-}
768−instance GToJSON Value arity U1 where
578+instance GToJSON arity U1 where
769 -- Empty constructors are encoded to an empty array:
579 -- Empty constructors are encoded to an empty array:
770− gToJSON _opts _ _ = emptyArray
580+ gToJSON _opts _ _ _ _ = emptyArray
771− {-# INLINE gToJSON #-}
581+
582+instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where
583+ -- Constructors need to be encoded differently depending on whether they're
584+ -- a record or not. This distinction is made by 'consToJSON':
585+ gToJSON opts pa tj tjl = consToJSON opts pa tj tjl . unM1
773instance ( WriteProduct arity a, WriteProduct arity b
587instance ( WriteProduct arity a, WriteProduct arity b
774 , ProductSize a, ProductSize b
588 , ProductSize a, ProductSize b
775− ) => GToJSON Value arity (a :*: b)
589+ ) => GToJSON arity (a :*: b) where
777 -- Products are encoded to an array. Here we allocate a mutable vector of
590 -- Products are encoded to an array. Here we allocate a mutable vector of
778 -- the same size as the product and write the product's elements to it using
591 -- the same size as the product and write the product's elements to it using
779 -- 'writeProduct':
592 -- 'writeProduct':
780− gToJSON opts targs p =
593+ gToJSON opts pa tj tjl p =
781 Array $ V.create $ do
594 Array $ V.create $ do
782 mv <- VM.unsafeNew lenProduct
595 mv <- VM.unsafeNew lenProduct
783− writeProduct opts targs mv 0 lenProduct p
596+ writeProduct opts pa mv 0 lenProduct tj tjl p
784 return mv
597 return mv
786 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
599 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
787 productSize
600 productSize
788− {-# INLINE gToJSON #-}
790−instance ( ToJSON1 f
602+instance ( AllNullary (a :+: b) allNullary
791− , GToJSON Value One g
603+ , SumToJSON arity (a :+: b) allNullary
792− ) => GToJSON Value One (f :.: g)
604+ ) => GToJSON arity (a :+: b) where
793− where
605+ -- If all constructors of a sum datatype are nullary and the
606+ -- 'allNullaryToStringTag' option is set they are encoded to
607+ -- strings. This distinction is made by 'sumToJSON':
608+ gToJSON opts pa tj tjl = (unTagged :: Tagged allNullary Value -> Value)
609+ . sumToJSON opts pa tj tjl
611+instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where
794 -- If an occurrence of the last type parameter is nested inside two
612 -- If an occurrence of the last type parameter is nested inside two
795 -- composed types, it is encoded by using the outermost type's ToJSON1
613 -- composed types, it is encoded by using the outermost type's ToJSON1
796 -- instance to generically encode the innermost type:
614 -- instance to generically encode the innermost type:
797− gToJSON opts targs =
615+ gToJSON opts pa tj tjl =
798− let gtj = gToJSON opts targs in
616+ let gtj = gToJSON opts pa tj tjl in
799 liftToJSON gtj (listValue gtj) . unComp1
617 liftToJSON gtj (listValue gtj) . unComp1
800− {-# INLINE gToJSON #-}
802--------------------------------------------------------------------------------
619--------------------------------------------------------------------------------
803-- Generic toEncoding
620-- Generic toEncoding
622+instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where
623+ -- Meta-information, which is not handled elsewhere, is ignored:
624+ gToEncoding opts pa te tel = gToEncoding opts pa te tel . unM1
805−instance ToJSON a => GToJSON Encoding arity (K1 i a) where
626+instance (ToJSON a) => GToEncoding arity (K1 i a) where
806 -- Constant values are encoded using their ToJSON instance:
627 -- Constant values are encoded using their ToJSON instance:
807− gToJSON _opts _ = toEncoding . unK1
628+ gToEncoding _opts _ _ _ = toEncoding . unK1
808− {-# INLINE gToJSON #-}
630+instance GToEncoding One Par1 where
631+ -- Direct occurrences of the last type parameter are encoded with the
632+ -- function passed in as an argument:
633+ gToEncoding _opts _ te _ = te . unPar1
810−instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
635+instance (ToJSON1 f) => GToEncoding One (Rec1 f) where
811 -- Recursive occurrences of the last type parameter are encoded using their
636 -- Recursive occurrences of the last type parameter are encoded using their
812 -- ToEncoding1 instance:
637 -- ToEncoding1 instance:
813− gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
638+ gToEncoding _opts _ te tel = liftToEncoding te tel . unRec1
814− {-# INLINE gToJSON #-}
816−instance GToJSON Encoding arity U1 where
640+instance GToEncoding arity U1 where
817 -- Empty constructors are encoded to an empty array:
641 -- Empty constructors are encoded to an empty array:
818− gToJSON _opts _ _ = E.emptyArray_
642+ gToEncoding _opts _ _ _ _ = E.emptyArray_
819− {-# INLINE gToJSON #-}
643+
644+instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where
645+ -- Constructors need to be encoded differently depending on whether they're
646+ -- a record or not. This distinction is made by 'consToEncoding':
647+ gToEncoding opts pa te tel = consToEncoding opts pa te tel . unM1
821instance ( EncodeProduct arity a
649instance ( EncodeProduct arity a
822 , EncodeProduct arity b
650 , EncodeProduct arity b
823− ) => GToJSON Encoding arity (a :*: b)
651+ ) => GToEncoding arity (a :*: b) where
825 -- Products are encoded to an array. Here we allocate a mutable vector of
652 -- Products are encoded to an array. Here we allocate a mutable vector of
826 -- the same size as the product and write the product's elements to it using
653 -- the same size as the product and write the product's elements to it using
827 -- 'encodeProduct':
654 -- 'encodeProduct':
828− gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
655+ gToEncoding opts pa te tel p = E.tuple $ encodeProduct opts pa te tel p
829− {-# INLINE gToJSON #-}
831−instance ( ToJSON1 f
657+instance ( AllNullary (a :+: b) allNullary
832− , GToJSON Encoding One g
658+ , SumToEncoding arity (a :+: b) allNullary
833− ) => GToJSON Encoding One (f :.: g)
659+ ) => GToEncoding arity (a :+: b) where
834− where
660+ -- If all constructors of a sum datatype are nullary and the
661+ -- 'allNullaryToStringTag' option is set they are encoded to
662+ -- strings. This distinction is made by 'sumToEncoding':
663+ gToEncoding opts pa te tel
664+ = (unTagged :: Tagged allNullary Encoding -> Encoding)
665+ . sumToEncoding opts pa te tel
667+instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where
835 -- If an occurrence of the last type parameter is nested inside two
668 -- If an occurrence of the last type parameter is nested inside two
836 -- composed types, it is encoded by using the outermost type's ToJSON1
669 -- composed types, it is encoded by using the outermost type's ToJSON1
837 -- instance to generically encode the innermost type:
670 -- instance to generically encode the innermost type:
838− gToJSON opts targs =
671+ gToEncoding opts pa te tel =
839− let gte = gToJSON opts targs in
672+ let gte = gToEncoding opts pa te tel in
840 liftToEncoding gte (listEncoding gte) . unComp1
673 liftToEncoding gte (listEncoding gte) . unComp1
841− {-# INLINE gToJSON #-}
843--------------------------------------------------------------------------------
675--------------------------------------------------------------------------------
845−class SumToJSON enc arity f allNullary where
677+class SumToJSON arity f allNullary where
846− sumToJSON :: Options -> ToArgs enc arity a
678+ sumToJSON :: Options -> Proxy arity
679+ -> (a -> Value) -> ([a] -> Value)
847− -> f a -> Tagged allNullary enc
680+ -> f a -> Tagged allNullary Value
849−instance ( GetConName f
682+instance ( GetConName f
850− , FromString enc
683+ , TaggedObjectPairs arity f
851− , TaggedObject enc arity f
684+ , ObjectWithSingleFieldObj arity f
852− , SumToJSON' ObjectWithSingleField enc arity f
685+ , TwoElemArrayObj arity f
853− , SumToJSON' TwoElemArray enc arity f
854− , SumToJSON' UntaggedValue enc arity f
855− ) => SumToJSON enc arity f True
686+ ) => SumToJSON arity f True where
857− sumToJSON opts targs
687+ sumToJSON opts pa tj tjl
858− | allNullaryToStringTag opts = Tagged . fromString
688+ | allNullaryToStringTag opts = Tagged . String . pack
859 . constructorTagModifier opts . getConName
689 . constructorTagModifier opts . getConName
860− | otherwise = Tagged . nonAllNullarySumToJSON opts targs
690+ | otherwise = Tagged . nonAllNullarySumToJSON opts pa tj tjl
862−instance ( TaggedObject enc arity f
692+instance ( TwoElemArrayObj arity f
863− , SumToJSON' ObjectWithSingleField enc arity f
693+ , TaggedObjectPairs arity f
864− , SumToJSON' TwoElemArray enc arity f
694+ , ObjectWithSingleFieldObj arity f
865− , SumToJSON' UntaggedValue enc arity f
866− ) => SumToJSON enc arity f False
695+ ) => SumToJSON arity f False where
868− sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
696+ sumToJSON opts pa tj tjl = Tagged . nonAllNullarySumToJSON opts pa tj tjl
870−nonAllNullarySumToJSON :: ( TaggedObject enc arity f
698+nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f
871− , SumToJSON' ObjectWithSingleField enc arity f
699+ , TaggedObjectPairs arity f
872− , SumToJSON' TwoElemArray enc arity f
700+ , ObjectWithSingleFieldObj arity f
873− , SumToJSON' UntaggedValue enc arity f
874− ) => Options -> ToArgs enc arity a
701+ ) => Options -> Proxy arity
875− -> f a -> enc
702+ -> (a -> Value) -> ([a] -> Value)
876−nonAllNullarySumToJSON opts targs =
704+nonAllNullarySumToJSON opts pa tj tjl =
877 case sumEncoding opts of
705 case sumEncoding opts of
879 TaggedObject{..} ->
706 TaggedObject{..} ->
880− taggedObject opts targs tagFieldName contentsFieldName
707+ object . taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl
708+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts pa tj tjl
709+ TwoElemArray -> Array . twoElemArrayObj opts pa tj tjl
882− ObjectWithSingleField ->
711+--------------------------------------------------------------------------------
883− (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884− . sumToJSON' opts targs
887− (unTagged :: Tagged TwoElemArray enc -> enc)
888− . sumToJSON' opts targs
890− UntaggedValue ->
713+class SumToEncoding arity f allNullary where
891− (unTagged :: Tagged UntaggedValue enc -> enc)
714+ sumToEncoding :: Options -> Proxy arity
892− . sumToJSON' opts targs
715+ -> (a -> Encoding) -> ([a] -> Encoding)
716+ -> f a -> Tagged allNullary Encoding
718+instance ( GetConName f
719+ , TaggedObjectEnc arity f
720+ , ObjectWithSingleFieldEnc arity f
721+ , TwoElemArrayEnc arity f
722+ ) => SumToEncoding arity f True where
723+ sumToEncoding opts pa te tel
724+ | allNullaryToStringTag opts = Tagged . toEncoding .
725+ constructorTagModifier opts . getConName
726+ | otherwise = Tagged . nonAllNullarySumToEncoding opts pa te tel
728+instance ( TwoElemArrayEnc arity f
729+ , TaggedObjectEnc arity f
730+ , ObjectWithSingleFieldEnc arity f
731+ ) => SumToEncoding arity f False where
732+ sumToEncoding opts pa te tel = Tagged . nonAllNullarySumToEncoding opts pa te tel
734+nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f
735+ , TaggedObjectEnc arity f
736+ , ObjectWithSingleFieldEnc arity f
737+ ) => Options -> Proxy arity
738+ -> (a -> Encoding) -> ([a] -> Encoding)
740+nonAllNullarySumToEncoding opts pa te tel =
741+ case sumEncoding opts of
743+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel
744+ ObjectWithSingleField -> objectWithSingleFieldEnc opts pa te tel
745+ TwoElemArray -> twoElemArrayEnc opts pa te tel
894--------------------------------------------------------------------------------
747--------------------------------------------------------------------------------
896−class FromString enc where
749+class TaggedObjectPairs arity f where
897− fromString :: String -> enc
750+ taggedObjectPairs :: Options -> Proxy arity
752+ -> (a -> Value) -> ([a] -> Value)
755+instance ( TaggedObjectPairs arity a
756+ , TaggedObjectPairs arity b
757+ ) => TaggedObjectPairs arity (a :+: b) where
758+ taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (L1 x) =
759+ taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x
760+ taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (R1 x) =
761+ taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x
763+instance ( IsRecord a isRecord
764+ , TaggedObjectPairs' arity a isRecord
766+ ) => TaggedObjectPairs arity (C1 c a) where
767+ taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl =
768+ (pack tagFieldName .= constructorTagModifier opts
769+ (conName (undefined :: t c a p)) :) .
770+ (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
771+ taggedObjectPairs' opts pa contentsFieldName tj tjl . unM1
773+class TaggedObjectPairs' arity f isRecord where
774+ taggedObjectPairs' :: Options -> Proxy arity
775+ -> String -> (a -> Value) -> ([a] -> Value)
776+ -> f a -> Tagged isRecord [Pair]
778+instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where
779+ taggedObjectPairs' _ _ _ _ _ _ = Tagged []
899−instance FromString Encoding where
781+instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where
900− fromString = toEncoding
782+ taggedObjectPairs' opts pa _ tj tjl =
783+ Tagged . toList . recordToPairs opts pa tj tjl
902−instance FromString Value where
785+instance (GToJSON arity f) => TaggedObjectPairs' arity f False where
903− fromString = String . pack
786+ taggedObjectPairs' opts pa contentsFieldName tj tjl =
787+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts pa tj tjl
905--------------------------------------------------------------------------------
789--------------------------------------------------------------------------------
907−class TaggedObject enc arity f where
791+class TaggedObjectEnc arity f where
908− taggedObject :: Options -> ToArgs enc arity a
792+ taggedObjectEnc :: Options -> Proxy arity
909− -> String -> String
793+ -> String -> String
910− -> f a -> enc
794+ -> (a -> Encoding) -> ([a] -> Encoding)
911−
795+ -> f a -> Encoding
912−instance ( TaggedObject enc arity a
797+instance ( TaggedObjectEnc arity a
913− , TaggedObject enc arity b
798+ , TaggedObjectEnc arity b
914− ) => TaggedObject enc arity (a :+: b)
799+ ) => TaggedObjectEnc arity (a :+: b) where
916− taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
800+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (L1 x) =
917− taggedObject opts targs tagFieldName contentsFieldName x
801+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x
918− taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
802+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (R1 x) =
919− taggedObject opts targs tagFieldName contentsFieldName x
803+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x
921−instance ( IsRecord a isRecord
805+instance ( IsRecord a isRecord
922− , TaggedObject' enc pairs arity a isRecord
806+ , TaggedObjectEnc' arity a isRecord
923− , FromPairs enc pairs
925− , KeyValuePair enc pairs
926 , Constructor c
807 , Constructor c
927− ) => TaggedObject enc arity (C1 c a)
808+ ) => TaggedObjectEnc arity (C1 c a) where
929− taggedObject opts targs tagFieldName contentsFieldName =
809+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel v =
930− fromPairs . mappend tag . contents
810+ E.openCurly <>
931− where
811+ (toEncoding tagFieldName <>
932− tag = tagFieldName `pair`
812+ E.colon <>
933− (fromString (constructorTagModifier opts (conName (undefined :: t c a p)))
813+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
936− (unTagged :: Tagged isRecord pairs -> pairs) .
814+ ((unTagged :: Tagged isRecord Encoding -> Encoding) .
937− taggedObject' opts targs contentsFieldName . unM1
815+ taggedObjectEnc' opts pa contentsFieldName te tel . unM1 $ v) <>
939−class TaggedObject' enc pairs arity f isRecord where
818+class TaggedObjectEnc' arity f isRecord where
940− taggedObject' :: Options -> ToArgs enc arity a
819+ taggedObjectEnc' :: Options -> Proxy arity
941− -> String -> f a -> Tagged isRecord pairs
820+ -> String -> (a -> Encoding) -> ([a] -> Encoding)
942−
821+ -> f a -> Tagged isRecord Encoding
943−instance ( GToJSON enc arity f
822+
944− , KeyValuePair enc pairs
945− ) => TaggedObject' enc pairs arity f False
947− taggedObject' opts targs contentsFieldName =
948− Tagged . (contentsFieldName `pair`) . gToJSON opts targs
950−instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where
823+instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where
951− taggedObject' _ _ _ _ = Tagged mempty
824+ taggedObjectEnc' _ _ _ _ _ _ = Tagged mempty
953−instance ( RecordToPairs enc pairs arity f
826+instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where
954− ) => TaggedObject' enc pairs arity f True
827+ taggedObjectEnc' opts pa _ te tel = Tagged . (E.comma <>) . fst
955− where
828+ . recordToEncoding opts pa te tel
956− taggedObject' opts targs _ = Tagged . recordToPairs opts targs
829+
830+instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where
831+ taggedObjectEnc' opts pa contentsFieldName te tel =
832+ Tagged . (\z -> E.comma <> toEncoding contentsFieldName <> E.colon <> z) .
833+ gToEncoding opts pa te tel
958--------------------------------------------------------------------------------
835--------------------------------------------------------------------------------
@@ -968,242 +845,283 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where
968instance (Constructor c) => GetConName (C1 c a) where
845instance (Constructor c) => GetConName (C1 c a) where
969 getConName = conName
846 getConName = conName
971−-- For genericToJSONKey
972−instance GetConName a => GetConName (D1 d a) where
973− getConName (M1 x) = getConName x
975−--------------------------------------------------------------------------------
977−-- Reflection of SumEncoding variants
979−data ObjectWithSingleField
983--------------------------------------------------------------------------------
848--------------------------------------------------------------------------------
985−class SumToJSON' s enc arity f where
850+class TwoElemArrayObj arity f where
986− sumToJSON' :: Options -> ToArgs enc arity a
851+ twoElemArrayObj :: Options -> Proxy arity
987− -> f a -> Tagged s enc
852+ -> (a -> Value) -> ([a] -> Value)
988−
853+ -> f a -> V.Vector Value
989−instance ( SumToJSON' s enc arity a
990− , SumToJSON' s enc arity b
991− ) => SumToJSON' s enc arity (a :+: b)
993− sumToJSON' opts targs (L1 x) = sumToJSON' opts targs x
994− sumToJSON' opts targs (R1 x) = sumToJSON' opts targs x
996−--------------------------------------------------------------------------------
855+instance ( TwoElemArrayObj arity a
856+ , TwoElemArrayObj arity b
857+ ) => TwoElemArrayObj arity (a :+: b) where
858+ twoElemArrayObj opts pa tj tjl (L1 x) = twoElemArrayObj opts pa tj tjl x
859+ twoElemArrayObj opts pa tj tjl (R1 x) = twoElemArrayObj opts pa tj tjl x
998−instance ( GToJSON Value arity a
861+instance ( GToJSON arity a
999− , ConsToJSON Value arity a
862+ , ConsToJSON arity a
1000 , Constructor c
863 , Constructor c
1001− ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
864+ ) => TwoElemArrayObj arity (C1 c a) where
1002− sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
865+ twoElemArrayObj opts pa tj tjl x = V.create $ do
1003 mv <- VM.unsafeNew 2
866 mv <- VM.unsafeNew 2
1004 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
867 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
1005 $ conName (undefined :: t c a p)
868 $ conName (undefined :: t c a p)
1006− VM.unsafeWrite mv 1 $ gToJSON opts targs x
869+ VM.unsafeWrite mv 1 $ gToJSON opts pa tj tjl x
1007 return mv
870 return mv
1009--------------------------------------------------------------------------------
872--------------------------------------------------------------------------------
1011−instance ( GToJSON Encoding arity a
874+class TwoElemArrayEnc arity f where
1012− , ConsToJSON Encoding arity a
875+ twoElemArrayEnc :: Options -> Proxy arity
876+ -> (a -> Encoding) -> ([a] -> Encoding)
879+instance ( TwoElemArrayEnc arity a
880+ , TwoElemArrayEnc arity b
881+ ) => TwoElemArrayEnc arity (a :+: b) where
882+ twoElemArrayEnc opts pa te tel (L1 x) = twoElemArrayEnc opts pa te tel x
883+ twoElemArrayEnc opts pa te tel (R1 x) = twoElemArrayEnc opts pa te tel x
885+instance ( GToEncoding arity a
886+ , ConsToEncoding arity a
1013 , Constructor c
887 , Constructor c
1014− ) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
888+ ) => TwoElemArrayEnc arity (C1 c a) where
1015− where
889+ twoElemArrayEnc opts pa te tel x = E.tuple $
1016− sumToJSON' opts targs x = Tagged $ E.list id
1017− [ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))
890+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
1018− , gToJSON opts targs x
891+ gToEncoding opts pa te tel x
893+--------------------------------------------------------------------------------
895+class ConsToJSON arity f where
896+ consToJSON :: Options -> Proxy arity
897+ -> (a -> Value) -> ([a] -> Value)
900+class ConsToJSON' arity f isRecord where
901+ consToJSON' :: Options -> Proxy arity
902+ -> Bool -- ^ Are we a record with one field?
903+ -> (a -> Value) -> ([a] -> Value)
904+ -> f a -> Tagged isRecord Value
906+instance ( IsRecord f isRecord
907+ , ConsToJSON' arity f isRecord
908+ ) => ConsToJSON arity f where
909+ consToJSON opts pa tj tjl =
910+ (unTagged :: Tagged isRecord Value -> Value)
911+ . consToJSON' opts pa (isUnary (undefined :: f a)) tj tjl
913+instance (RecordToPairs arity f) => ConsToJSON' arity f True where
914+ consToJSON' opts pa isUn tj tjl f = let
915+ vals = toList $ recordToPairs opts pa tj tjl f
916+ in case (unwrapUnaryRecords opts,isUn,vals) of
917+ (True,True,[(_,val)]) -> Tagged val
918+ _ -> Tagged $ object vals
920+instance GToJSON arity f => ConsToJSON' arity f False where
921+ consToJSON' opts pa _ tj tjl = Tagged . gToJSON opts pa tj tjl
1021--------------------------------------------------------------------------------
923--------------------------------------------------------------------------------
1023−class ConsToJSON enc arity f where
925+class ConsToEncoding arity f where
1024− consToJSON :: Options -> ToArgs enc arity a
926+ consToEncoding :: Options -> Proxy arity
1025− -> f a -> enc
927+ -> (a -> Encoding) -> ([a] -> Encoding)
1027−class ConsToJSON' enc arity f isRecord where
930+class ConsToEncoding' arity f isRecord where
1028− consToJSON' :: Options -> ToArgs enc arity a
931+ consToEncoding' :: Options -> Proxy arity
932+ -> Bool -- ^ Are we a record with one field?
933+ -> (a -> Encoding) -> ([a] -> Encoding)
1029− -> f a -> Tagged isRecord enc
934+ -> f a -> Tagged isRecord Encoding
1031instance ( IsRecord f isRecord
936instance ( IsRecord f isRecord
1032− , ConsToJSON' enc arity f isRecord
937+ , ConsToEncoding' arity f isRecord
1033− ) => ConsToJSON enc arity f
938+ ) => ConsToEncoding arity f where
1034− where
939+ consToEncoding opts pa te tel =
1035− consToJSON opts targs =
940+ (unTagged :: Tagged isRecord Encoding -> Encoding)
1036− (unTagged :: Tagged isRecord enc -> enc)
941+ . consToEncoding' opts pa (isUnary (undefined :: f a)) te tel
1037− . consToJSON' opts targs
942+
1038− {-# INLINE consToJSON #-}
943+instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where
1039−
944+ consToEncoding' opts pa isUn te tel x =
1040−instance OVERLAPPING_
945+ let (enc, mbVal) = recordToEncoding opts pa te tel x
1041− ( RecordToPairs enc pairs arity (S1 s f)
946+ in case (unwrapUnaryRecords opts, isUn, mbVal) of
1042− , FromPairs enc pairs
947+ (True, True, Just val) -> Tagged val
1043− , GToJSON enc arity f
948+ _ -> Tagged $ E.wrapObject enc
1044− ) => ConsToJSON' enc arity (S1 s f) True
949+
1045− where
950+instance GToEncoding arity f => ConsToEncoding' arity f False where
1046− consToJSON' opts targs
951+ consToEncoding' opts pa _ te tel = Tagged . gToEncoding opts pa te tel
1047− | unwrapUnaryRecords opts = Tagged . gToJSON opts targs
1048− | otherwise = Tagged . fromPairs . recordToPairs opts targs
1049− {-# INLINE consToJSON' #-}
1051−instance ( RecordToPairs enc pairs arity f
1052− , FromPairs enc pairs
1053− ) => ConsToJSON' enc arity f True
1055− consToJSON' opts targs = Tagged . fromPairs . recordToPairs opts targs
1056− {-# INLINE consToJSON' #-}
1058−instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1059− consToJSON' opts targs = Tagged . gToJSON opts targs
1060− {-# INLINE consToJSON' #-}
1062--------------------------------------------------------------------------------
953--------------------------------------------------------------------------------
1064−class RecordToPairs enc pairs arity f where
955+class RecordToPairs arity f where
956+ recordToPairs :: Options -> Proxy arity
957+ -> (a -> Value) -> ([a] -> Value)
958+ -> f a -> DList Pair
960+instance ( RecordToPairs arity a
961+ , RecordToPairs arity b
962+ ) => RecordToPairs arity (a :*: b) where
963+ recordToPairs opts pa tj tjl (a :*: b) = recordToPairs opts pa tj tjl a <>
964+ recordToPairs opts pa tj tjl b
966+instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where
967+ recordToPairs = fieldToPair
969+instance OVERLAPPING_ (Selector s, ToJSON a) =>
970+ RecordToPairs arity (S1 s (K1 i (Maybe a))) where
971+ recordToPairs opts _ _ _ (M1 k1) | omitNothingFields opts
972+ , K1 Nothing <- k1 = DList.empty
973+ recordToPairs opts pa tj tjl m1 = fieldToPair opts pa tj tjl m1
975+fieldToPair :: (Selector s, GToJSON arity a)
976+ => Options -> Proxy arity
977+ -> (p -> Value) -> ([p] -> Value)
978+ -> S1 s a p -> DList Pair
979+fieldToPair opts pa tj tjl m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
980+ , gToJSON opts pa tj tjl (unM1 m1)
983+--------------------------------------------------------------------------------
985+class RecordToEncoding arity f where
1065 -- 1st element: whole thing
986 -- 1st element: whole thing
1066 -- 2nd element: in case the record has only 1 field, just the value
987 -- 2nd element: in case the record has only 1 field, just the value
1067 -- of the field (without the key); 'Nothing' otherwise
988 -- of the field (without the key); 'Nothing' otherwise
1068− recordToPairs :: Options -> ToArgs enc arity a
989+ recordToEncoding :: Options -> Proxy arity
1069− -> f a -> pairs
990+ -> (a -> Encoding) -> ([a] -> Encoding)
1070−
991+ -> f a -> (Encoding, Maybe Encoding)
1071−instance ( Monoid pairs
992+
1072− , RecordToPairs enc pairs arity a
993+instance ( RecordToEncoding arity a
1073− , RecordToPairs enc pairs arity b
994+ , RecordToEncoding arity b
1074− ) => RecordToPairs enc pairs arity (a :*: b)
995+ ) => RecordToEncoding arity (a :*: b) where
1075− where
996+ recordToEncoding opts pa te tel (a :*: b) | omitNothingFields opts =
1076− recordToPairs opts (targs :: ToArgs enc arity p) (a :*: b) =
997+ (mconcat $ intersperse E.comma $
1077− pairsOf a `mappend` pairsOf b
998+ filter (not . E.nullEncoding)
1078− where
999+ [ fst (recordToEncoding opts pa te tel a)
1079− pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
1000+ , fst (recordToEncoding opts pa te tel b) ]
1080− pairsOf = recordToPairs opts targs
1001+ , Nothing)
1081− {-# INLINE recordToPairs #-}
1002+ recordToEncoding opts pa te tel (a :*: b) =
1082−
1003+ (fst (recordToEncoding opts pa te tel a) <> E.comma <>
1083−instance ( Selector s
1004+ fst (recordToEncoding opts pa te tel b),
1084− , GToJSON enc arity a
1005+ Nothing)
1085− , KeyValuePair enc pairs
1006+
1086− ) => RecordToPairs enc pairs arity (S1 s a)
1007+instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) where
1087− where
1008+ recordToEncoding = fieldToEncoding
1088− recordToPairs = fieldToPair
1009+
1089− {-# INLINE recordToPairs #-}
1010+instance OVERLAPPING_ (Selector s, ToJSON a) =>
1090−
1011+ RecordToEncoding arity (S1 s (K1 i (Maybe a))) where
1091−instance INCOHERENT_
1012+ recordToEncoding opts _ _ _ (M1 k1) | omitNothingFields opts
1092− ( Selector s
1013+ , K1 Nothing <- k1 = (mempty, Nothing)
1093− , GToJSON enc arity (K1 i (Maybe a))
1014+ recordToEncoding opts pa te tel m1 = fieldToEncoding opts pa te tel m1
1094− , KeyValuePair enc pairs
1015+
1095− , Monoid pairs
1016+fieldToEncoding :: (Selector s, GToEncoding arity a)
1096− ) => RecordToPairs enc pairs arity (S1 s (K1 i (Maybe a)))
1017+ => Options -> Proxy arity
1097− where
1018+ -> (p -> Encoding) -> ([p] -> Encoding)
1098− recordToPairs opts _ (M1 k1) | omitNothingFields opts
1019+ -> S1 s a p -> (Encoding, Maybe Encoding)
1099− , K1 Nothing <- k1 = mempty
1020+fieldToEncoding opts pa te tel m1 =
1100− recordToPairs opts targs m1 = fieldToPair opts targs m1
1021+ let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
1101− {-# INLINE recordToPairs #-}
1022+ valueBuilder = gToEncoding opts pa te tel (unM1 m1)
1102−
1023+ in (keyBuilder <> E.colon <> valueBuilder, Just valueBuilder)
1103−instance INCOHERENT_
1105− , GToJSON enc arity (K1 i (Maybe a))
1106− , KeyValuePair enc pairs
1108− ) => RecordToPairs enc pairs arity (S1 s (K1 i (Semigroup.Option a)))
1110− recordToPairs opts targs = recordToPairs opts targs . unwrap
1112− unwrap :: S1 s (K1 i (Semigroup.Option a)) p -> S1 s (K1 i (Maybe a)) p
1113− unwrap (M1 (K1 (Semigroup.Option a))) = M1 (K1 a)
1114− {-# INLINE recordToPairs #-}
1116−fieldToPair :: (Selector s
1117− , GToJSON enc arity a
1118− , KeyValuePair enc pairs)
1119− => Options -> ToArgs enc arity p
1120− -> S1 s a p -> pairs
1121−fieldToPair opts targs m1 =
1122− let key = fieldLabelModifier opts (selName m1)
1123− value = gToJSON opts targs (unM1 m1)
1124− in key `pair` value
1125−{-# INLINE fieldToPair #-}
1127--------------------------------------------------------------------------------
1025--------------------------------------------------------------------------------
1129class WriteProduct arity f where
1027class WriteProduct arity f where
1130 writeProduct :: Options
1028 writeProduct :: Options
1131− -> ToArgs Value arity a
1029+ -> Proxy arity
1132 -> VM.MVector s Value
1030 -> VM.MVector s Value
1133 -> Int -- ^ index
1031 -> Int -- ^ index
1134 -> Int -- ^ length
1032 -> Int -- ^ length
1136 -> ST s ()
1036 -> ST s ()
1138instance ( WriteProduct arity a
1038instance ( WriteProduct arity a
1139 , WriteProduct arity b
1039 , WriteProduct arity b
1140 ) => WriteProduct arity (a :*: b) where
1040 ) => WriteProduct arity (a :*: b) where
1141− writeProduct opts targs mv ix len (a :*: b) = do
1041+ writeProduct opts pa mv ix len tj tjl (a :*: b) = do
1142− writeProduct opts targs mv ix lenL a
1042+ writeProduct opts pa mv ix lenL tj tjl a
1143− writeProduct opts targs mv ixR lenR b
1043+ writeProduct opts pa mv ixR lenR tj tjl b
1145 lenL = len `unsafeShiftR` 1
1045 lenL = len `unsafeShiftR` 1
1146 lenR = len - lenL
1046 lenR = len - lenL
1147 ixR = ix + lenL
1047 ixR = ix + lenL
1148− {-# INLINE writeProduct #-}
1150−instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
1049+instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
1151− writeProduct opts targs mv ix _ =
1050+ writeProduct opts pa mv ix _ tj tjl =
1152− VM.unsafeWrite mv ix . gToJSON opts targs
1051+ VM.unsafeWrite mv ix . gToJSON opts pa tj tjl
1153− {-# INLINE writeProduct #-}
1155--------------------------------------------------------------------------------
1053--------------------------------------------------------------------------------
1157class EncodeProduct arity f where
1055class EncodeProduct arity f where
1158− encodeProduct :: Options -> ToArgs Encoding arity a
1056+ encodeProduct :: Options -> Proxy arity
1159− -> f a -> Encoding' E.InArray
1057+ -> (a -> Encoding) -> ([a] -> Encoding)
1161instance ( EncodeProduct arity a
1060instance ( EncodeProduct arity a
1162 , EncodeProduct arity b
1061 , EncodeProduct arity b
1163 ) => EncodeProduct arity (a :*: b) where
1062 ) => EncodeProduct arity (a :*: b) where
1164− encodeProduct opts targs (a :*: b) | omitNothingFields opts =
1063+ encodeProduct opts pa te tel (a :*: b) | omitNothingFields opts =
1165− E.econcat $ intersperse E.comma $
1064+ mconcat $ intersperse E.comma $
1166 filter (not . E.nullEncoding)
1065 filter (not . E.nullEncoding)
1167− [encodeProduct opts targs a, encodeProduct opts targs b]
1066+ [encodeProduct opts pa te tel a, encodeProduct opts pa te tel b]
1168− encodeProduct opts targs (a :*: b) =
1067+ encodeProduct opts pa te tel (a :*: b) = encodeProduct opts pa te tel a <>
1169− encodeProduct opts targs a >*<
1068+ E.comma <>
1170− encodeProduct opts targs b
1069+ encodeProduct opts pa te tel b
1171− {-# INLINE encodeProduct #-}
1173−instance OVERLAPPABLE_ (GToJSON Encoding arity a) => EncodeProduct arity a where
1071+instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1174− encodeProduct opts targs a = E.retagEncoding $ gToJSON opts targs a
1072+ encodeProduct opts = gToEncoding opts
1175− {-# INLINE encodeProduct #-}
1177--------------------------------------------------------------------------------
1074--------------------------------------------------------------------------------
1179−instance ( GToJSON enc arity a
1076+class ObjectWithSingleFieldObj arity f where
1180− , ConsToJSON enc arity a
1077+ objectWithSingleFieldObj :: Options -> Proxy arity
1181− , FromPairs enc pairs
1078+ -> (a -> Value) -> ([a] -> Value)
1182− , KeyValuePair enc pairs
1079+ -> f a -> Object
1081+instance ( ObjectWithSingleFieldObj arity a
1082+ , ObjectWithSingleFieldObj arity b
1083+ ) => ObjectWithSingleFieldObj arity (a :+: b) where
1084+ objectWithSingleFieldObj opts pa tj tjl (L1 x) =
1085+ objectWithSingleFieldObj opts pa tj tjl x
1086+ objectWithSingleFieldObj opts pa tj tjl (R1 x) =
1087+ objectWithSingleFieldObj opts pa tj tjl x
1089+instance ( GToJSON arity a
1090+ , ConsToJSON arity a
1183 , Constructor c
1091 , Constructor c
1184− ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1092+ ) => ObjectWithSingleFieldObj arity (C1 c a) where
1185− where
1093+ objectWithSingleFieldObj opts pa tj tjl = H.singleton typ . gToJSON opts pa tj tjl
1186− sumToJSON' opts targs =
1187− Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
1189− typ = constructorTagModifier opts $
1095+ typ = pack $ constructorTagModifier opts $
1190 conName (undefined :: t c a p)
1096 conName (undefined :: t c a p)
1192--------------------------------------------------------------------------------
1098--------------------------------------------------------------------------------
1194−instance OVERLAPPABLE_
1100+class ObjectWithSingleFieldEnc arity f where
1195− ( ConsToJSON enc arity a
1101+ objectWithSingleFieldEnc :: Options -> Proxy arity
1196− ) => SumToJSON' UntaggedValue enc arity (C1 c a)
1102+ -> (a -> Encoding) -> ([a] -> Encoding)
1197− where
1103+ -> f a -> Encoding
1198− sumToJSON' opts targs = Tagged . gToJSON opts targs
1104+
1199−
1105+instance ( ObjectWithSingleFieldEnc arity a
1200−instance OVERLAPPING_
1106+ , ObjectWithSingleFieldEnc arity b
1201− ( Constructor c
1107+ ) => ObjectWithSingleFieldEnc arity (a :+: b) where
1202− , FromString enc
1108+ objectWithSingleFieldEnc opts pa te tel (L1 x) =
1203− ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
1109+ objectWithSingleFieldEnc opts pa te tel x
1204− where
1110+ objectWithSingleFieldEnc opts pa te tel (R1 x) =
1205− sumToJSON' opts _ _ = Tagged . fromString $
1111+ objectWithSingleFieldEnc opts pa te tel x
1206− constructorTagModifier opts $ conName (undefined :: t c U1 p)
1112+
1113+instance ( GToEncoding arity a
1114+ , ConsToEncoding arity a
1116+ ) => ObjectWithSingleFieldEnc arity (C1 c a) where
1117+ objectWithSingleFieldEnc opts pa te tel v =
1120+ (constructorTagModifier opts
1121+ (conName (undefined :: t c a p))) <>
1123+ gToEncoding opts pa te tel v <>
1208-------------------------------------------------------------------------------
1126-------------------------------------------------------------------------------
1209-- Instances
1127-- Instances
@@ -1213,6 +1131,21 @@ instance OVERLAPPING_
1214-------------------------------------------------------------------------------
1132-------------------------------------------------------------------------------
1134+instance ToJSON1 Identity where
1135+ liftToJSON t _ (Identity a) = t a
1136+ {-# INLINE liftToJSON #-}
1138+ liftToEncoding t _ (Identity a) = t a
1139+ {-# INLINE liftToEncoding #-}
1141+instance (ToJSON a) => ToJSON (Identity a) where
1143+ {-# INLINE toJSON #-}
1145+ toEncoding = toEncoding1
1146+ {-# INLINE toEncoding #-}
1216instance ToJSON2 Const where
1149instance ToJSON2 Const where
1217 liftToJSON2 t _ _ _ (Const x) = t x
1150 liftToJSON2 t _ _ _ (Const x) = t x
1218 {-# INLINE liftToJSON2 #-}
1151 {-# INLINE liftToJSON2 #-}
@@ -1241,7 +1174,7 @@ instance ToJSON1 Maybe where
1241 {-# INLINE liftToJSON #-}
1174 {-# INLINE liftToJSON #-}
1243 liftToEncoding t _ (Just a) = t a
1176 liftToEncoding t _ (Just a) = t a
1244− liftToEncoding _ _ Nothing = E.null_
1177+ liftToEncoding _ _ Nothing = Encoding EB.null_
1245 {-# INLINE liftToEncoding #-}
1178 {-# INLINE liftToEncoding #-}
1247instance (ToJSON a) => ToJSON (Maybe a) where
1180instance (ToJSON a) => ToJSON (Maybe a) where
@@ -1253,13 +1186,19 @@ instance (ToJSON a) => ToJSON (Maybe a) where
1255instance ToJSON2 Either where
1188instance ToJSON2 Either where
1256− liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton "Left" (toA a)
1189+ liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton left (toA a)
1257− liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton "Right" (toB b)
1190+ liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton right (toB b)
1258 {-# INLINE liftToJSON2 #-}
1191 {-# INLINE liftToJSON2 #-}
1260− liftToEncoding2 toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a
1193+ liftToEncoding2 toA _ _toB _ (Left a) =
1194+ Encoding (B.shortByteString "{\"Left\":")
1196+ <> Encoding (B.char7 '}')
1262− liftToEncoding2 _toA _ toB _ (Right b) = E.pairs $ E.pair "Right" $ toB b
1198+ liftToEncoding2 _toA _ toB _ (Right b) =
1199+ Encoding (B.shortByteString "{\"Right\":")
1201+ <> Encoding (B.char7 '}')
1263 {-# INLINE liftToEncoding2 #-}
1202 {-# INLINE liftToEncoding2 #-}
1265instance (ToJSON a) => ToJSON1 (Either a) where
1204instance (ToJSON a) => ToJSON1 (Either a) where
@@ -1276,24 +1215,18 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
1276 toEncoding = toEncoding2
1215 toEncoding = toEncoding2
1277 {-# INLINE toEncoding #-}
1216 {-# INLINE toEncoding #-}
1279−instance ToJSON Void where
1218+left, right :: Text
1280− toJSON = absurd
1219+left = "Left"
1281− {-# INLINE toJSON #-}
1220+right = "Right"
1283− toEncoding = absurd
1284− {-# INLINE toEncoding #-}
1287instance ToJSON Bool where
1223instance ToJSON Bool where
1288 toJSON = Bool
1224 toJSON = Bool
1289 {-# INLINE toJSON #-}
1225 {-# INLINE toJSON #-}
1291− toEncoding = E.bool
1227+ toEncoding = Encoding . EB.bool
1292 {-# INLINE toEncoding #-}
1228 {-# INLINE toEncoding #-}
1294−instance ToJSONKey Bool where
1295− toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"
1298instance ToJSON Ordering where
1231instance ToJSON Ordering where
1299 toJSON = toJSON . orderingToText
1232 toJSON = toJSON . orderingToText
@@ -1320,10 +1253,10 @@ instance ToJSON Char where
1320 toJSONList = String . T.pack
1253 toJSONList = String . T.pack
1321 {-# INLINE toJSONList #-}
1254 {-# INLINE toJSONList #-}
1323− toEncoding = E.string . (:[])
1256+ toEncoding = Encoding . EB.string . (:[])
1324 {-# INLINE toEncoding #-}
1257 {-# INLINE toEncoding #-}
1326− toEncodingList = E.string
1259+ toEncodingList = Encoding . EB.string
1327 {-# INLINE toEncodingList #-}
1260 {-# INLINE toEncodingList #-}
@@ -1331,13 +1264,9 @@ instance ToJSON Double where
1331 toJSON = realFloatToJSON
1264 toJSON = realFloatToJSON
1332 {-# INLINE toJSON #-}
1265 {-# INLINE toJSON #-}
1334− toEncoding = E.double
1267+ toEncoding = realFloatToEncoding
1335 {-# INLINE toEncoding #-}
1268 {-# INLINE toEncoding #-}
1337−instance ToJSONKey Double where
1338− toJSONKey = toJSONKeyTextEnc E.doubleText
1339− {-# INLINE toJSONKey #-}
1342instance ToJSON Number where
1271instance ToJSON Number where
1343 toJSON (D d) = toJSON d
1272 toJSON (D d) = toJSON d
@@ -1353,23 +1282,20 @@ instance ToJSON Float where
1353 toJSON = realFloatToJSON
1282 toJSON = realFloatToJSON
1354 {-# INLINE toJSON #-}
1283 {-# INLINE toJSON #-}
1356− toEncoding = E.float
1285+ toEncoding = realFloatToEncoding
1357 {-# INLINE toEncoding #-}
1286 {-# INLINE toEncoding #-}
1359−instance ToJSONKey Float where
1360− toJSONKey = toJSONKeyTextEnc E.floatText
1361− {-# INLINE toJSONKey #-}
1363−
1289+instance ToJSON (Ratio Integer) where
1364−instance (ToJSON a, Integral a) => ToJSON (Ratio a) where
1365 toJSON r = object [ "numerator" .= numerator r
1290 toJSON r = object [ "numerator" .= numerator r
1366 , "denominator" .= denominator r
1291 , "denominator" .= denominator r
1368 {-# INLINE toJSON #-}
1293 {-# INLINE toJSON #-}
1370− toEncoding r = E.pairs $
1295+ toEncoding r = Encoding $
1371− "numerator" .= numerator r <>
1296+ B.shortByteString "{\"numerator\":" <> builder (numerator r) <>
1372− "denominator" .= denominator r
1297+ B.shortByteString ",\"denominator\":" <> builder (denominator r) <>
1373 {-# INLINE toEncoding #-}
1299 {-# INLINE toEncoding #-}
@@ -1377,37 +1303,24 @@ instance HasResolution a => ToJSON (Fixed a) where
1377 toJSON = Number . realToFrac
1303 toJSON = Number . realToFrac
1378 {-# INLINE toJSON #-}
1304 {-# INLINE toJSON #-}
1380− toEncoding = E.scientific . realToFrac
1306+ toEncoding = Encoding . EB.number . realToFrac
1381 {-# INLINE toEncoding #-}
1307 {-# INLINE toEncoding #-}
1383−instance HasResolution a => ToJSONKey (Fixed a) where
1384− toJSONKey = toJSONKeyTextEnc (E.scientificText . realToFrac)
1385− {-# INLINE toJSONKey #-}
1388instance ToJSON Int where
1310instance ToJSON Int where
1389 toJSON = Number . fromIntegral
1311 toJSON = Number . fromIntegral
1390 {-# INLINE toJSON #-}
1312 {-# INLINE toJSON #-}
1392− toEncoding = E.int
1314+ toEncoding = Encoding . B.intDec
1393 {-# INLINE toEncoding #-}
1315 {-# INLINE toEncoding #-}
1395−instance ToJSONKey Int where
1396− toJSONKey = toJSONKeyTextEnc E.intText
1397− {-# INLINE toJSONKey #-}
1400instance ToJSON Integer where
1317instance ToJSON Integer where
1401 toJSON = Number . fromInteger
1318 toJSON = Number . fromInteger
1402 {-# INLINE toJSON #-}
1319 {-# INLINE toJSON #-}
1404− toEncoding = E.integer
1321+ toEncoding = Encoding . B.integerDec
1405 {-# INLINE toEncoding #-}
1322 {-# INLINE toEncoding #-}
1407−instance ToJSONKey Integer where
1408− toJSONKey = toJSONKeyTextEnc E.integerText
1409− {-# INLINE toJSONKey #-}
1412instance ToJSON Natural where
1325instance ToJSON Natural where
1413 toJSON = toJSON . toInteger
1326 toJSON = toJSON . toInteger
@@ -1416,147 +1329,93 @@ instance ToJSON Natural where
1416 toEncoding = toEncoding . toInteger
1329 toEncoding = toEncoding . toInteger
1417 {-# INLINE toEncoding #-}
1330 {-# INLINE toEncoding #-}
1419−instance ToJSONKey Natural where
1420− toJSONKey = toJSONKeyTextEnc (E.integerText . toInteger)
1421− {-# INLINE toJSONKey #-}
1424instance ToJSON Int8 where
1333instance ToJSON Int8 where
1425 toJSON = Number . fromIntegral
1334 toJSON = Number . fromIntegral
1426 {-# INLINE toJSON #-}
1335 {-# INLINE toJSON #-}
1428− toEncoding = E.int8
1337+ toEncoding = Encoding . B.int8Dec
1429 {-# INLINE toEncoding #-}
1338 {-# INLINE toEncoding #-}
1431−instance ToJSONKey Int8 where
1432− toJSONKey = toJSONKeyTextEnc E.int8Text
1433− {-# INLINE toJSONKey #-}
1436instance ToJSON Int16 where
1341instance ToJSON Int16 where
1437 toJSON = Number . fromIntegral
1342 toJSON = Number . fromIntegral
1438 {-# INLINE toJSON #-}
1343 {-# INLINE toJSON #-}
1440− toEncoding = E.int16
1345+ toEncoding = Encoding . B.int16Dec
1441 {-# INLINE toEncoding #-}
1346 {-# INLINE toEncoding #-}
1443−instance ToJSONKey Int16 where
1444− toJSONKey = toJSONKeyTextEnc E.int16Text
1445− {-# INLINE toJSONKey #-}
1448instance ToJSON Int32 where
1349instance ToJSON Int32 where
1449 toJSON = Number . fromIntegral
1350 toJSON = Number . fromIntegral
1450 {-# INLINE toJSON #-}
1351 {-# INLINE toJSON #-}
1452− toEncoding = E.int32
1353+ toEncoding = Encoding . B.int32Dec
1453 {-# INLINE toEncoding #-}
1354 {-# INLINE toEncoding #-}
1455−instance ToJSONKey Int32 where
1456− toJSONKey = toJSONKeyTextEnc E.int32Text
1457− {-# INLINE toJSONKey #-}
1460instance ToJSON Int64 where
1357instance ToJSON Int64 where
1461 toJSON = Number . fromIntegral
1358 toJSON = Number . fromIntegral
1462 {-# INLINE toJSON #-}
1359 {-# INLINE toJSON #-}
1464− toEncoding = E.int64
1361+ toEncoding = Encoding . B.int64Dec
1465 {-# INLINE toEncoding #-}
1362 {-# INLINE toEncoding #-}
1467−instance ToJSONKey Int64 where
1468− toJSONKey = toJSONKeyTextEnc E.int64Text
1469− {-# INLINE toJSONKey #-}
1471instance ToJSON Word where
1365instance ToJSON Word where
1472 toJSON = Number . fromIntegral
1366 toJSON = Number . fromIntegral
1473 {-# INLINE toJSON #-}
1367 {-# INLINE toJSON #-}
1475− toEncoding = E.word
1369+ toEncoding = Encoding . B.wordDec
1476 {-# INLINE toEncoding #-}
1370 {-# INLINE toEncoding #-}
1478−instance ToJSONKey Word where
1479− toJSONKey = toJSONKeyTextEnc E.wordText
1480− {-# INLINE toJSONKey #-}
1483instance ToJSON Word8 where
1373instance ToJSON Word8 where
1484 toJSON = Number . fromIntegral
1374 toJSON = Number . fromIntegral
1485 {-# INLINE toJSON #-}
1375 {-# INLINE toJSON #-}
1487− toEncoding = E.word8
1377+ toEncoding = Encoding . B.word8Dec
1488 {-# INLINE toEncoding #-}
1378 {-# INLINE toEncoding #-}
1490−instance ToJSONKey Word8 where
1491− toJSONKey = toJSONKeyTextEnc E.word8Text
1492− {-# INLINE toJSONKey #-}
1495instance ToJSON Word16 where
1381instance ToJSON Word16 where
1496 toJSON = Number . fromIntegral
1382 toJSON = Number . fromIntegral
1497 {-# INLINE toJSON #-}
1383 {-# INLINE toJSON #-}
1499− toEncoding = E.word16
1385+ toEncoding = Encoding . B.word16Dec
1500 {-# INLINE toEncoding #-}
1386 {-# INLINE toEncoding #-}
1502−instance ToJSONKey Word16 where
1503− toJSONKey = toJSONKeyTextEnc E.word16Text
1504− {-# INLINE toJSONKey #-}
1507instance ToJSON Word32 where
1389instance ToJSON Word32 where
1508 toJSON = Number . fromIntegral
1390 toJSON = Number . fromIntegral
1509 {-# INLINE toJSON #-}
1391 {-# INLINE toJSON #-}
1511− toEncoding = E.word32
1393+ toEncoding = Encoding . B.word32Dec
1512 {-# INLINE toEncoding #-}
1394 {-# INLINE toEncoding #-}
1514−instance ToJSONKey Word32 where
1515− toJSONKey = toJSONKeyTextEnc E.word32Text
1516− {-# INLINE toJSONKey #-}
1519instance ToJSON Word64 where
1396instance ToJSON Word64 where
1520 toJSON = Number . fromIntegral
1397 toJSON = Number . fromIntegral
1521 {-# INLINE toJSON #-}
1398 {-# INLINE toJSON #-}
1523− toEncoding = E.word64
1400+ toEncoding = Encoding . B.word64Dec
1524− {-# INLINE toEncoding #-}
1526−instance ToJSONKey Word64 where
1527− toJSONKey = toJSONKeyTextEnc E.word64Text
1528− {-# INLINE toJSONKey #-}
1530−instance ToJSON CTime where
1531− toJSON (CTime i) = toJSON i
1532− {-# INLINE toJSON #-}
1534− toEncoding (CTime i) = toEncoding i
1535 {-# INLINE toEncoding #-}
1401 {-# INLINE toEncoding #-}
1537instance ToJSON Text where
1403instance ToJSON Text where
1538 toJSON = String
1404 toJSON = String
1539 {-# INLINE toJSON #-}
1405 {-# INLINE toJSON #-}
1541− toEncoding = E.text
1407+ toEncoding = Encoding . EB.text
1542 {-# INLINE toEncoding #-}
1408 {-# INLINE toEncoding #-}
1544−instance ToJSONKey Text where
1545− toJSONKey = toJSONKeyText id
1546− {-# INLINE toJSONKey #-}
1549instance ToJSON LT.Text where
1410instance ToJSON LT.Text where
1550 toJSON = String . LT.toStrict
1411 toJSON = String . LT.toStrict
1551 {-# INLINE toJSON #-}
1412 {-# INLINE toJSON #-}
1553− toEncoding = E.lazyText
1414+ toEncoding t = Encoding $
1416+ LT.foldrChunks (\x xs -> EB.unquoted x <> xs) (B.char7 '"') t
1554 {-# INLINE toEncoding #-}
1417 {-# INLINE toEncoding #-}
1556−instance ToJSONKey LT.Text where
1557− toJSONKey = toJSONKeyText LT.toStrict
1560instance ToJSON Version where
1419instance ToJSON Version where
1561 toJSON = toJSON . showVersion
1420 toJSON = toJSON . showVersion
1562 {-# INLINE toJSON #-}
1421 {-# INLINE toJSON #-}
@@ -1564,8 +1423,6 @@ instance ToJSON Version where
1564 toEncoding = toEncoding . showVersion
1423 toEncoding = toEncoding . showVersion
1565 {-# INLINE toEncoding #-}
1424 {-# INLINE toEncoding #-}
1567−instance ToJSONKey Version where
1568− toJSONKey = toJSONKeyText (T.pack . showVersion)
1570-------------------------------------------------------------------------------
1427-------------------------------------------------------------------------------
1571-- semigroups NonEmpty
1428-- semigroups NonEmpty
@@ -1593,138 +1450,7 @@ instance ToJSON Scientific where
1593 toJSON = Number
1450 toJSON = Number
1594 {-# INLINE toJSON #-}
1451 {-# INLINE toJSON #-}
1596− toEncoding = E.scientific
1453+ toEncoding = Encoding . EB.number
1597− {-# INLINE toEncoding #-}
1599−instance ToJSONKey Scientific where
1600− toJSONKey = toJSONKeyTextEnc E.scientificText
1602−-------------------------------------------------------------------------------
1604−-------------------------------------------------------------------------------
1606−instance ToJSON1 DList.DList where
1607− liftToJSON t _ = listValue t . toList
1608− {-# INLINE liftToJSON #-}
1610− liftToEncoding t _ = listEncoding t . toList
1611− {-# INLINE liftToEncoding #-}
1613−instance (ToJSON a) => ToJSON (DList.DList a) where
1615− {-# INLINE toJSON #-}
1617− toEncoding = toEncoding1
1618− {-# INLINE toEncoding #-}
1620−-------------------------------------------------------------------------------
1621−-- transformers - Functors
1622−-------------------------------------------------------------------------------
1624−instance ToJSON1 Identity where
1625− liftToJSON t _ (Identity a) = t a
1626− {-# INLINE liftToJSON #-}
1628− liftToJSONList _ tl xs = tl (map runIdentity xs)
1629− {-# INLINE liftToJSONList #-}
1631− liftToEncoding t _ (Identity a) = t a
1632− {-# INLINE liftToEncoding #-}
1634− liftToEncodingList _ tl xs = tl (map runIdentity xs)
1635− {-# INLINE liftToEncodingList #-}
1637−instance (ToJSON a) => ToJSON (Identity a) where
1639− {-# INLINE toJSON #-}
1641− toJSONList = liftToJSONList toJSON toJSONList
1642− {-# INLINE toJSONList #-}
1644− toEncoding = toEncoding1
1645− {-# INLINE toEncoding #-}
1647− toEncodingList = liftToEncodingList toEncoding toEncodingList
1648− {-# INLINE toEncodingList #-}
1650−instance (ToJSONKey a) => ToJSONKey (Identity a) where
1651− toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1652− toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
1655−instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) where
1656− liftToJSON tv tvl (Compose x) = liftToJSON g gl x
1658− g = liftToJSON tv tvl
1659− gl = liftToJSONList tv tvl
1660− {-# INLINE liftToJSON #-}
1662− liftToJSONList te tel xs = liftToJSONList g gl (map getCompose xs)
1664− g = liftToJSON te tel
1665− gl = liftToJSONList te tel
1666− {-# INLINE liftToJSONList #-}
1668− liftToEncoding te tel (Compose x) = liftToEncoding g gl x
1670− g = liftToEncoding te tel
1671− gl = liftToEncodingList te tel
1672− {-# INLINE liftToEncoding #-}
1674− liftToEncodingList te tel xs = liftToEncodingList g gl (map getCompose xs)
1676− g = liftToEncoding te tel
1677− gl = liftToEncodingList te tel
1678− {-# INLINE liftToEncodingList #-}
1680−instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where
1682− {-# INLINE toJSON #-}
1684− toJSONList = liftToJSONList toJSON toJSONList
1685− {-# INLINE toJSONList #-}
1687− toEncoding = toEncoding1
1688− {-# INLINE toEncoding #-}
1690− toEncodingList = liftToEncodingList toEncoding toEncodingList
1691− {-# INLINE toEncodingList #-}
1694−instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Product f g) where
1695− liftToJSON tv tvl (Pair x y) = liftToJSON2 tx txl ty tyl (x, y)
1697− tx = liftToJSON tv tvl
1698− txl = liftToJSONList tv tvl
1699− ty = liftToJSON tv tvl
1700− tyl = liftToJSONList tv tvl
1702− liftToEncoding te tel (Pair x y) = liftToEncoding2 tx txl ty tyl (x, y)
1704− tx = liftToEncoding te tel
1705− txl = liftToEncodingList te tel
1706− ty = liftToEncoding te tel
1707− tyl = liftToEncodingList te tel
1709−instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) where
1711− {-# INLINE toJSON #-}
1713− toEncoding = toEncoding1
1714− {-# INLINE toEncoding #-}
1716−instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Sum f g) where
1717− liftToJSON tv tvl (InL x) = Object $ H.singleton "InL" (liftToJSON tv tvl x)
1718− liftToJSON tv tvl (InR y) = Object $ H.singleton "InR" (liftToJSON tv tvl y)
1720− liftToEncoding te tel (InL x) = E.pairs $ E.pair "InL" $ liftToEncoding te tel x
1721− liftToEncoding te tel (InR y) = E.pairs $ E.pair "InR" $ liftToEncoding te tel y
1723−instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) where
1725− {-# INLINE toJSON #-}
1727− toEncoding = toEncoding1
1728 {-# INLINE toEncoding #-}
1454 {-# INLINE toEncoding #-}
1730-------------------------------------------------------------------------------
1456-------------------------------------------------------------------------------
@@ -1792,15 +1518,17 @@ instance ToJSON a => ToJSON (IntMap.IntMap a) where
1793instance ToJSONKey k => ToJSON1 (M.Map k) where
1519instance ToJSONKey k => ToJSON1 (M.Map k) where
1794 liftToJSON g _ = case toJSONKey of
1520 liftToJSON g _ = case toJSONKey of
1795− ToJSONKeyText f _ -> Object . mapHashKeyVal f g
1521+ ToJSONKeyText (f,_) -> Object . mapHashKeyVal f g
1796− ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1522+ ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . M.toList
1797 {-# INLINE liftToJSON #-}
1523 {-# INLINE liftToJSON #-}
1525+ -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
1799 liftToEncoding g _ = case toJSONKey of
1526 liftToEncoding g _ = case toJSONKey of
1800− ToJSONKeyText _ f -> dict f g M.foldrWithKey
1527+ ToJSONKeyText (_,f) -> dict f g M.foldrWithKey
1801− ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1528+ ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . M.toList
1803− pairEncoding f (a, b) = E.list id [f a, g b]
1530+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1531+ pairEncoding f (a, b) = tuple $ f a >*< g b
1804 {-# INLINE liftToEncoding #-}
1532 {-# INLINE liftToEncoding #-}
@@ -1838,17 +1566,6 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
1838 toEncoding = toEncoding1
1566 toEncoding = toEncoding1
1839 {-# INLINE toEncoding #-}
1567 {-# INLINE toEncoding #-}
1841−-------------------------------------------------------------------------------
1843−-------------------------------------------------------------------------------
1845−instance ToJSON UUID.UUID where
1846− toJSON = toJSON . UUID.toText
1847− toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1849−instance ToJSONKey UUID.UUID where
1850− toJSONKey = ToJSONKeyText UUID.toText $
1851− E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1853-------------------------------------------------------------------------------
1570-------------------------------------------------------------------------------
1854-- vector
1571-- vector
@@ -1858,20 +1575,29 @@ instance ToJSON1 Vector where
1858 liftToJSON t _ = Array . V.map t
1575 liftToJSON t _ = Array . V.map t
1859 {-# INLINE liftToJSON #-}
1576 {-# INLINE liftToJSON #-}
1861− liftToEncoding t _ = listEncoding t . V.toList
1578+ liftToEncoding t _ xs
1579+ | V.null xs = emptyArray_
1580+ | otherwise = Encoding $
1581+ B.char7 '[' <> fromEncoding (t (V.unsafeHead xs)) <>
1582+ V.foldr go (B.char7 ']') (V.unsafeTail xs)
1584+ go v b = B.char7 ',' <> fromEncoding (t v) <> b
1862 {-# INLINE liftToEncoding #-}
1585 {-# INLINE liftToEncoding #-}
1864instance (ToJSON a) => ToJSON (Vector a) where
1587instance (ToJSON a) => ToJSON (Vector a) where
1865− {-# SPECIALIZE instance ToJSON Array #-}
1588+ toJSON = Array . V.map toJSON
1868 {-# INLINE toJSON #-}
1589 {-# INLINE toJSON #-}
1870− toEncoding = toEncoding1
1591+ toEncoding = encodeVector
1871 {-# INLINE toEncoding #-}
1592 {-# INLINE toEncoding #-}
1873encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
1594encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
1874−encodeVector = listEncoding toEncoding . VG.toList
1595+encodeVector xs
1596+ | VG.null xs = emptyArray_
1597+ | otherwise = Encoding $
1598+ B.char7 '[' <> builder (VG.unsafeHead xs) <>
1599+ VG.foldr go (B.char7 ']') (VG.unsafeTail xs)
1600+ where go v b = B.char7 ',' <> builder v <> b
1875{-# INLINE encodeVector #-}
1601{-# INLINE encodeVector #-}
1877vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
1603vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
@@ -1922,21 +1648,20 @@ instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
1923instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1649instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1924 liftToJSON g _ = case toJSONKey of
1650 liftToJSON g _ = case toJSONKey of
1925− ToJSONKeyText f _ -> Object . mapKeyVal f g
1651+ ToJSONKeyText (f,_) -> Object . mapKeyVal f g
1926− ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList
1652+ ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . H.toList
1927 {-# INLINE liftToJSON #-}
1653 {-# INLINE liftToJSON #-}
1929 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
1655 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
1930 liftToEncoding g _ = case toJSONKey of
1656 liftToEncoding g _ = case toJSONKey of
1931− ToJSONKeyText _ f -> dict f g H.foldrWithKey
1657+ ToJSONKeyText (_,f) -> dict f g H.foldrWithKey
1932− ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1658+ ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . H.toList
1934− pairEncoding f (a, b) = E.list id [f a, g b]
1660+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1661+ pairEncoding f (a, b) = tuple $ f a >*< g b
1935 {-# INLINE liftToEncoding #-}
1662 {-# INLINE liftToEncoding #-}
1937instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1664instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938− {-# SPECIALIZE instance ToJSON Object #-}
1940 toJSON = toJSON1
1665 toJSON = toJSON1
1941 {-# INLINE toJSON #-}
1666 {-# INLINE toJSON #-}
@@ -1951,7 +1676,7 @@ instance ToJSON Value where
1951 toJSON a = a
1676 toJSON a = a
1952 {-# INLINE toJSON #-}
1677 {-# INLINE toJSON #-}
1954− toEncoding = E.value
1679+ toEncoding = Encoding . EB.encodeToBuilder
1955 {-# INLINE toEncoding #-}
1680 {-# INLINE toEncoding #-}
1957instance ToJSON DotNetTime where
1682instance ToJSON DotNetTime where
@@ -1963,189 +1688,69 @@ dotNetTime :: DotNetTime -> String
1963dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1688dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1964 where secs = formatTime defaultTimeLocale "/Date(%s" t
1689 where secs = formatTime defaultTimeLocale "/Date(%s" t
1966−formatMillis :: (FormatTime t) => t -> String
1967−formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1969−-------------------------------------------------------------------------------
1971−-------------------------------------------------------------------------------
1973−instance ToJSON a => ToJSON (PM.Array a) where
1974− -- note: we could do better than this if vector exposed the data
1975− -- constructor in Data.Vector.
1976− toJSON = toJSON . Exts.toList
1977− toEncoding = toEncoding . Exts.toList
1979−instance ToJSON a => ToJSON (PM.SmallArray a) where
1980− toJSON = toJSON . Exts.toList
1981− toEncoding = toEncoding . Exts.toList
1983−#if (MIN_VERSION_primitive(0,6,4))
1984−instance (PM.Prim a,ToJSON a) => ToJSON (PM.PrimArray a) where
1985− toJSON = toJSON . Exts.toList
1986− toEncoding = toEncoding . Exts.toList
1988−#if !MIN_VERSION_primitive(0,7,0)
1989−instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where
1990− toJSON = toJSON . Exts.toList
1991− toEncoding = toEncoding . Exts.toList
1995-------------------------------------------------------------------------------
1691-------------------------------------------------------------------------------
1997-------------------------------------------------------------------------------
1693-------------------------------------------------------------------------------
1999instance ToJSON Day where
1695instance ToJSON Day where
2000− toJSON = stringEncoding . E.day
1696+ toJSON = stringEncoding
2001− toEncoding = E.day
1697+ toEncoding z = Encoding (EB.quote $ EB.day z)
2003−instance ToJSONKey Day where
2004− toJSONKey = toJSONKeyTextEnc E.day
2007instance ToJSON TimeOfDay where
1700instance ToJSON TimeOfDay where
2008− toJSON = stringEncoding . E.timeOfDay
1701+ toJSON = stringEncoding
2009− toEncoding = E.timeOfDay
1702+ toEncoding z = Encoding (EB.quote $ EB.timeOfDay z)
2011−instance ToJSONKey TimeOfDay where
2012− toJSONKey = toJSONKeyTextEnc E.timeOfDay
2015instance ToJSON LocalTime where
1705instance ToJSON LocalTime where
2016− toJSON = stringEncoding . E.localTime
1706+ toJSON = stringEncoding
2017− toEncoding = E.localTime
1707+ toEncoding z = Encoding (EB.quote $ EB.localTime z)
2019−instance ToJSONKey LocalTime where
2020− toJSONKey = toJSONKeyTextEnc E.localTime
2023instance ToJSON ZonedTime where
1709instance ToJSON ZonedTime where
2024− toJSON = stringEncoding . E.zonedTime
1710+ toJSON = stringEncoding
2025− toEncoding = E.zonedTime
2027−instance ToJSONKey ZonedTime where
1712+ toEncoding z = Encoding (EB.quote $ EB.zonedTime z)
2028− toJSONKey = toJSONKeyTextEnc E.zonedTime
1714+formatMillis :: (FormatTime t) => t -> String
1715+formatMillis = take 3 . formatTime defaultTimeLocale "%q"
2031instance ToJSON UTCTime where
1717instance ToJSON UTCTime where
2032− toJSON = stringEncoding . E.utcTime
1718+ toJSON = stringEncoding
2033− toEncoding = E.utcTime
2035−instance ToJSONKey UTCTime where
1720+ toEncoding t = Encoding (EB.quote $ EB.utcTime t)
2036− toJSONKey = toJSONKeyTextEnc E.utcTime
2038-- | Encode something t a JSON string.
1722-- | Encode something t a JSON string.
2039−stringEncoding :: Encoding' Text -> Value
1723+--
1724+-- TODO: remove me, this is a hack
1725+stringEncoding :: (ToJSON a) => a -> Value
2040stringEncoding = String
1726stringEncoding = String
2041 . T.dropAround (== '"')
1727 . T.dropAround (== '"')
2042 . T.decodeLatin1
1728 . T.decodeLatin1
2043 . L.toStrict
1729 . L.toStrict
2044− . E.encodingToLazyByteString
1730+ . B.toLazyByteString
2045{-# INLINE stringEncoding #-}
1733{-# INLINE stringEncoding #-}
2048instance ToJSON NominalDiffTime where
1735instance ToJSON NominalDiffTime where
2049 toJSON = Number . realToFrac
1736 toJSON = Number . realToFrac
2050 {-# INLINE toJSON #-}
1737 {-# INLINE toJSON #-}
2052− toEncoding = E.scientific . realToFrac
1739+ toEncoding = Encoding . EB.number . realToFrac
2053 {-# INLINE toEncoding #-}
1740 {-# INLINE toEncoding #-}
2056−instance ToJSON DiffTime where
2057− toJSON = Number . realToFrac
2058− {-# INLINE toJSON #-}
2060− toEncoding = E.scientific . realToFrac
2061− {-# INLINE toEncoding #-}
2063−-- | Encoded as number
2064−instance ToJSON SystemTime where
2065− toJSON (MkSystemTime secs nsecs) =
2066− toJSON (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)
2067− toEncoding (MkSystemTime secs nsecs) =
2068− toEncoding (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)
2070−instance ToJSON CalendarDiffTime where
2071− toJSON (CalendarDiffTime m nt) = object
2075− toEncoding (CalendarDiffTime m nt) = E.pairs
2076− ("months" .= m <> "time" .= nt)
2078−instance ToJSON CalendarDiffDays where
2079− toJSON (CalendarDiffDays m d) = object
2083− toEncoding (CalendarDiffDays m d) = E.pairs
2084− ("months" .= m <> "days" .= d)
2086−instance ToJSON DayOfWeek where
2087− toJSON Monday = "monday"
2088− toJSON Tuesday = "tuesday"
2089− toJSON Wednesday = "wednesday"
2090− toJSON Thursday = "thursday"
2091− toJSON Friday = "friday"
2092− toJSON Saturday = "saturday"
2093− toJSON Sunday = "sunday"
2095−toEncodingDayOfWeek :: DayOfWeek -> E.Encoding' Text
2096−toEncodingDayOfWeek Monday = E.unsafeToEncoding "\"monday\""
2097−toEncodingDayOfWeek Tuesday = E.unsafeToEncoding "\"tuesday\""
2098−toEncodingDayOfWeek Wednesday = E.unsafeToEncoding "\"wednesday\""
2099−toEncodingDayOfWeek Thursday = E.unsafeToEncoding "\"thursday\""
2100−toEncodingDayOfWeek Friday = E.unsafeToEncoding "\"friday\""
2101−toEncodingDayOfWeek Saturday = E.unsafeToEncoding "\"saturday\""
2102−toEncodingDayOfWeek Sunday = E.unsafeToEncoding "\"sunday\""
2104−instance ToJSONKey DayOfWeek where
2105− toJSONKey = toJSONKeyTextEnc toEncodingDayOfWeek
2107-------------------------------------------------------------------------------
1742-------------------------------------------------------------------------------
2108-- base Monoid/Semigroup
1743-- base Monoid/Semigroup
2109-------------------------------------------------------------------------------
1744-------------------------------------------------------------------------------
2111−instance ToJSON1 Monoid.Dual where
1746+instance ToJSON1 Dual where
2112− liftToJSON t _ = t . Monoid.getDual
1747+ liftToJSON t _ = t . getDual
2113− {-# INLINE liftToJSON #-}
2115− liftToEncoding t _ = t . Monoid.getDual
2116− {-# INLINE liftToEncoding #-}
2118−instance ToJSON a => ToJSON (Monoid.Dual a) where
2120− {-# INLINE toJSON #-}
2122− toEncoding = toEncoding1
2123− {-# INLINE toEncoding #-}
2126−instance ToJSON1 Monoid.First where
2127− liftToJSON t to' = liftToJSON t to' . Monoid.getFirst
2128− {-# INLINE liftToJSON #-}
2130− liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
2131− {-# INLINE liftToEncoding #-}
2133−instance ToJSON a => ToJSON (Monoid.First a) where
2135− {-# INLINE toJSON #-}
2137− toEncoding = toEncoding1
2138− {-# INLINE toEncoding #-}
2141−instance ToJSON1 Monoid.Last where
2142− liftToJSON t to' = liftToJSON t to' . Monoid.getLast
2143 {-# INLINE liftToJSON #-}
1748 {-# INLINE liftToJSON #-}
2145− liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
1750+ liftToEncoding t _ = t . getDual
2146 {-# INLINE liftToEncoding #-}
1751 {-# INLINE liftToEncoding #-}
2148−instance ToJSON a => ToJSON (Monoid.Last a) where
1753+instance ToJSON a => ToJSON (Dual a) where
2149 toJSON = toJSON1
1754 toJSON = toJSON1
2150 {-# INLINE toJSON #-}
1755 {-# INLINE toJSON #-}
@@ -2153,14 +1758,14 @@ instance ToJSON a => ToJSON (Monoid.Last a) where
2153 {-# INLINE toEncoding #-}
1758 {-# INLINE toEncoding #-}
2156−instance ToJSON1 Semigroup.Min where
1761+instance ToJSON1 First where
2157− liftToJSON t _ (Semigroup.Min x) = t x
1762+ liftToJSON t to' = liftToJSON t to' . getFirst
2158 {-# INLINE liftToJSON #-}
1763 {-# INLINE liftToJSON #-}
2160− liftToEncoding t _ (Semigroup.Min x) = t x
1765+ liftToEncoding t to' = liftToEncoding t to' . getFirst
2161 {-# INLINE liftToEncoding #-}
1766 {-# INLINE liftToEncoding #-}
2163−instance ToJSON a => ToJSON (Semigroup.Min a) where
1768+instance ToJSON a => ToJSON (First a) where
2164 toJSON = toJSON1
1769 toJSON = toJSON1
2165 {-# INLINE toJSON #-}
1770 {-# INLINE toJSON #-}
@@ -2168,73 +1773,14 @@ instance ToJSON a => ToJSON (Semigroup.Min a) where
2168 {-# INLINE toEncoding #-}
1773 {-# INLINE toEncoding #-}
2171−instance ToJSON1 Semigroup.Max where
1776+instance ToJSON1 Last where
2172− liftToJSON t _ (Semigroup.Max x) = t x
1777+ liftToJSON t to' = liftToJSON t to' . getLast
2173 {-# INLINE liftToJSON #-}
1778 {-# INLINE liftToJSON #-}
2175− liftToEncoding t _ (Semigroup.Max x) = t x
1780+ liftToEncoding t to' = liftToEncoding t to' . getLast
2176 {-# INLINE liftToEncoding #-}
1781 {-# INLINE liftToEncoding #-}
2178−instance ToJSON a => ToJSON (Semigroup.Max a) where
1783+instance ToJSON a => ToJSON (Last a) where
2180− {-# INLINE toJSON #-}
2182− toEncoding = toEncoding1
2183− {-# INLINE toEncoding #-}
2185−instance ToJSON1 Semigroup.First where
2186− liftToJSON t _ (Semigroup.First x) = t x
2187− {-# INLINE liftToJSON #-}
2189− liftToEncoding t _ (Semigroup.First x) = t x
2190− {-# INLINE liftToEncoding #-}
2192−instance ToJSON a => ToJSON (Semigroup.First a) where
2194− {-# INLINE toJSON #-}
2196− toEncoding = toEncoding1
2197− {-# INLINE toEncoding #-}
2200−instance ToJSON1 Semigroup.Last where
2201− liftToJSON t _ (Semigroup.Last x) = t x
2202− {-# INLINE liftToJSON #-}
2204− liftToEncoding t _ (Semigroup.Last x) = t x
2205− {-# INLINE liftToEncoding #-}
2207−instance ToJSON a => ToJSON (Semigroup.Last a) where
2209− {-# INLINE toJSON #-}
2211− toEncoding = toEncoding1
2212− {-# INLINE toEncoding #-}
2215−instance ToJSON1 Semigroup.WrappedMonoid where
2216− liftToJSON t _ (Semigroup.WrapMonoid x) = t x
2217− {-# INLINE liftToJSON #-}
2219− liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
2220− {-# INLINE liftToEncoding #-}
2222−instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2224− {-# INLINE toJSON #-}
2226− toEncoding = toEncoding1
2227− {-# INLINE toEncoding #-}
2230−instance ToJSON1 Semigroup.Option where
2231− liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
2232− {-# INLINE liftToJSON #-}
2234− liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
2235− {-# INLINE liftToEncoding #-}
2237−instance ToJSON a => ToJSON (Semigroup.Option a) where
2238 toJSON = toJSON1
1784 toJSON = toJSON1
2239 {-# INLINE toJSON #-}
1785 {-# INLINE toJSON #-}
@@ -2245,28 +1791,14 @@ instance ToJSON a => ToJSON (Semigroup.Option a) where
2245-- tagged
1791-- tagged
2246-------------------------------------------------------------------------------
1792-------------------------------------------------------------------------------
2248−instance ToJSON1 Proxy where
2249− liftToJSON _ _ _ = Null
2250− {-# INLINE liftToJSON #-}
2252− liftToEncoding _ _ _ = E.null_
2253− {-# INLINE liftToEncoding #-}
2255instance ToJSON (Proxy a) where
1794instance ToJSON (Proxy a) where
2256 toJSON _ = Null
1795 toJSON _ = Null
2257 {-# INLINE toJSON #-}
1796 {-# INLINE toJSON #-}
2259− toEncoding _ = E.null_
1798+ toEncoding _ = Encoding EB.null_
2260 {-# INLINE toEncoding #-}
1799 {-# INLINE toEncoding #-}
2263−instance ToJSON2 Tagged where
2264− liftToJSON2 _ _ t _ (Tagged x) = t x
2265− {-# INLINE liftToJSON2 #-}
2267− liftToEncoding2 _ _ t _ (Tagged x) = t x
2268− {-# INLINE liftToEncoding2 #-}
2270instance ToJSON1 (Tagged a) where
1802instance ToJSON1 (Tagged a) where
2271 liftToJSON t _ (Tagged x) = t x
1803 liftToJSON t _ (Tagged x) = t x
2272 {-# INLINE liftToJSON #-}
1804 {-# INLINE liftToJSON #-}
@@ -2281,6 +1813,7 @@ instance ToJSON b => ToJSON (Tagged a b) where
2281 toEncoding = toEncoding1
1813 toEncoding = toEncoding1
2282 {-# INLINE toEncoding #-}
1814 {-# INLINE toEncoding #-}
2284instance ToJSONKey b => ToJSONKey (Tagged a b) where
1817instance ToJSONKey b => ToJSONKey (Tagged a b) where
2285 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
1818 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2286 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
1819 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
@@ -2289,22 +1822,41 @@ instance ToJSONKey b => ToJSONKey (Tagged a b) where
2289-- Instances for converting t map keys
1822-- Instances for converting t map keys
2290-------------------------------------------------------------------------------
1823-------------------------------------------------------------------------------
1825+instance ToJSONKey Text where
1826+ toJSONKey = ToJSONKeyText (id,toEncoding)
1829+instance ToJSONKey Bool where
1830+ toJSONKey = ToJSONKeyText
1831+ ( (\x -> if x then "true" else "false")
1832+ , (\x -> Encoding $ if x then "\"true\"" else "\"false\"")
1835+instance ToJSONKey Int where
1836+ toJSONKey = ToJSONKeyText
1837+ ( LT.toStrict . LTB.toLazyText . LTBI.decimal
1838+ , \x -> Encoding $ B.char7 '"' <> fromEncoding (toEncoding x) <> B.char7 '"'
2292instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
1841instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
2293instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
1842instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
2294instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
1843instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
2296instance ToJSONKey Char where
1845instance ToJSONKey Char where
2297− toJSONKey = ToJSONKeyText T.singleton (E.string . (:[]))
1846+ toJSONKey = ToJSONKeyText (T.singleton, toEncoding)
2298− toJSONKeyList = toJSONKeyText T.pack
1847+ toJSONKeyList = ToJSONKeyText (T.pack, toEncoding . T.pack)
2300instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
1849instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
2301 toJSONKey = toJSONKeyList
1850 toJSONKey = toJSONKeyList
1852+instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1853+ toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
2303-------------------------------------------------------------------------------
1855-------------------------------------------------------------------------------
2304−-- Tuple instances
1856+-- Tuple instances, see tuple-instances-to.hs
2305-------------------------------------------------------------------------------
1857-------------------------------------------------------------------------------
2307−instance ToJSON2 (,) where
1859+instance ToJSON2 ((,) ) where
2308 liftToJSON2 toA _ toB _ (a, b) = Array $ V.create $ do
1860 liftToJSON2 toA _ toB _ (a, b) = Array $ V.create $ do
2309 mv <- VM.unsafeNew 2
1861 mv <- VM.unsafeNew 2
2310 VM.unsafeWrite mv 0 (toA a)
1862 VM.unsafeWrite mv 0 (toA a)
@@ -2312,7 +1864,9 @@ instance ToJSON2 (,) where
2312 return mv
1864 return mv
2313 {-# INLINE liftToJSON2 #-}
1865 {-# INLINE liftToJSON2 #-}
2315− liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
1867+ liftToEncoding2 toA _ toB _ (a, b) = tuple $
2316 {-# INLINE liftToEncoding2 #-}
1870 {-# INLINE liftToEncoding2 #-}
2318instance (ToJSON a) => ToJSON1 ((,) a) where
1872instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -2336,11 +1890,10 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
2336 return mv
1890 return mv
2337 {-# INLINE liftToJSON2 #-}
1891 {-# INLINE liftToJSON2 #-}
2339− liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
1893+ liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
2340− [ toEncoding a
1894+ toEncoding a >*<
2341− , toB b
1895+ toB b >*<
2344 {-# INLINE liftToEncoding2 #-}
1897 {-# INLINE liftToEncoding2 #-}
2346instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
1899instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -2365,12 +1918,11 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
2365 return mv
1918 return mv
2366 {-# INLINE liftToJSON2 #-}
1919 {-# INLINE liftToJSON2 #-}
2368− liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
1921+ liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
2369− [ toEncoding a
1922+ toEncoding a >*<
2370− , toEncoding b
1923+ toEncoding b >*<
2371− , toC c
1924+ toC c >*<
2374 {-# INLINE liftToEncoding2 #-}
1926 {-# INLINE liftToEncoding2 #-}
2376instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
1928instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -2396,13 +1948,12 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
2396 return mv
1948 return mv
2397 {-# INLINE liftToJSON2 #-}
1949 {-# INLINE liftToJSON2 #-}
2399− liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
1951+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
2400− [ toEncoding a
1952+ toEncoding a >*<
2401− , toEncoding b
1953+ toEncoding b >*<
2402− , toEncoding c
1954+ toEncoding c >*<
2403− , toD d
1955+ toD d >*<
2406 {-# INLINE liftToEncoding2 #-}
1957 {-# INLINE liftToEncoding2 #-}
2408instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
1959instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
@@ -2429,14 +1980,13 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
2429 return mv
1980 return mv
2430 {-# INLINE liftToJSON2 #-}
1981 {-# INLINE liftToJSON2 #-}
2432− liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
1983+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
2433− [ toEncoding a
1984+ toEncoding a >*<
2434− , toEncoding b
1985+ toEncoding b >*<
2435− , toEncoding c
1986+ toEncoding c >*<
2436− , toEncoding d
1987+ toEncoding d >*<
2437− , toE e
1988+ toE e >*<
2440 {-# INLINE liftToEncoding2 #-}
1990 {-# INLINE liftToEncoding2 #-}
2442instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
1992instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
@@ -2464,15 +2014,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
2464 return mv
2014 return mv
2465 {-# INLINE liftToJSON2 #-}
2015 {-# INLINE liftToJSON2 #-}
2467− liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id
2017+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
2468− [ toEncoding a
2018+ toEncoding a >*<
2469− , toEncoding b
2019+ toEncoding b >*<
2470− , toEncoding c
2020+ toEncoding c >*<
2471− , toEncoding d
2021+ toEncoding d >*<
2472− , toEncoding e
2022+ toEncoding e >*<
2473− , toF f
2023+ toF f >*<
2476 {-# INLINE liftToEncoding2 #-}
2025 {-# INLINE liftToEncoding2 #-}
2478instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
2027instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
@@ -2501,16 +2050,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
2501 return mv
2050 return mv
2502 {-# INLINE liftToJSON2 #-}
2051 {-# INLINE liftToJSON2 #-}
2504− liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id
2053+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
2505− [ toEncoding a
2054+ toEncoding a >*<
2506− , toEncoding b
2055+ toEncoding b >*<
2507− , toEncoding c
2056+ toEncoding c >*<
2508− , toEncoding d
2057+ toEncoding d >*<
2509− , toEncoding e
2058+ toEncoding e >*<
2510− , toEncoding f
2059+ toEncoding f >*<
2511− , toG g
2060+ toG g >*<
2514 {-# INLINE liftToEncoding2 #-}
2062 {-# INLINE liftToEncoding2 #-}
2516instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
2064instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
@@ -2540,17 +2088,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
2540 return mv
2088 return mv
2541 {-# INLINE liftToJSON2 #-}
2089 {-# INLINE liftToJSON2 #-}
2543− liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id
2091+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
2544− [ toEncoding a
2092+ toEncoding a >*<
2545− , toEncoding b
2093+ toEncoding b >*<
2546− , toEncoding c
2094+ toEncoding c >*<
2547− , toEncoding d
2095+ toEncoding d >*<
2548− , toEncoding e
2096+ toEncoding e >*<
2549− , toEncoding f
2097+ toEncoding f >*<
2550− , toEncoding g
2098+ toEncoding g >*<
2551− , toH h
2099+ toH h >*<
2554 {-# INLINE liftToEncoding2 #-}
2101 {-# INLINE liftToEncoding2 #-}
2556instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) where
2103instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) where
@@ -2581,18 +2128,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2581 return mv
2128 return mv
2582 {-# INLINE liftToJSON2 #-}
2129 {-# INLINE liftToJSON2 #-}
2584− liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id
2131+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
2585− [ toEncoding a
2132+ toEncoding a >*<
2586− , toEncoding b
2133+ toEncoding b >*<
2587− , toEncoding c
2134+ toEncoding c >*<
2588− , toEncoding d
2135+ toEncoding d >*<
2589− , toEncoding e
2136+ toEncoding e >*<
2590− , toEncoding f
2137+ toEncoding f >*<
2591− , toEncoding g
2138+ toEncoding g >*<
2592− , toEncoding h
2139+ toEncoding h >*<
2593− , toI i
2140+ toI i >*<
2596 {-# INLINE liftToEncoding2 #-}
2142 {-# INLINE liftToEncoding2 #-}
2598instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) where
2144instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) where
@@ -2624,19 +2170,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2624 return mv
2170 return mv
2625 {-# INLINE liftToJSON2 #-}
2171 {-# INLINE liftToJSON2 #-}
2627− liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id
2173+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
2628− [ toEncoding a
2174+ toEncoding a >*<
2629− , toEncoding b
2175+ toEncoding b >*<
2630− , toEncoding c
2176+ toEncoding c >*<
2631− , toEncoding d
2177+ toEncoding d >*<
2632− , toEncoding e
2178+ toEncoding e >*<
2633− , toEncoding f
2179+ toEncoding f >*<
2634− , toEncoding g
2180+ toEncoding g >*<
2635− , toEncoding h
2181+ toEncoding h >*<
2636− , toEncoding i
2182+ toEncoding i >*<
2637− , toJ j
2183+ toJ j >*<
2640 {-# INLINE liftToEncoding2 #-}
2185 {-# INLINE liftToEncoding2 #-}
2642instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
2187instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
@@ -2669,20 +2214,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2669 return mv
2214 return mv
2670 {-# INLINE liftToJSON2 #-}
2215 {-# INLINE liftToJSON2 #-}
2672− liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id
2217+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
2673− [ toEncoding a
2218+ toEncoding a >*<
2674− , toEncoding b
2219+ toEncoding b >*<
2675− , toEncoding c
2220+ toEncoding c >*<
2676− , toEncoding d
2221+ toEncoding d >*<
2677− , toEncoding e
2222+ toEncoding e >*<
2678− , toEncoding f
2223+ toEncoding f >*<
2679− , toEncoding g
2224+ toEncoding g >*<
2680− , toEncoding h
2225+ toEncoding h >*<
2681− , toEncoding i
2226+ toEncoding i >*<
2682− , toEncoding j
2227+ toEncoding j >*<
2683− , toK k
2228+ toK k >*<
2686 {-# INLINE liftToEncoding2 #-}
2230 {-# INLINE liftToEncoding2 #-}
2688instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
2232instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
@@ -2716,21 +2260,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2716 return mv
2260 return mv
2717 {-# INLINE liftToJSON2 #-}
2261 {-# INLINE liftToJSON2 #-}
2719− liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id
2263+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
2720− [ toEncoding a
2264+ toEncoding a >*<
2721− , toEncoding b
2265+ toEncoding b >*<
2722− , toEncoding c
2266+ toEncoding c >*<
2723− , toEncoding d
2267+ toEncoding d >*<
2724− , toEncoding e
2268+ toEncoding e >*<
2725− , toEncoding f
2269+ toEncoding f >*<
2726− , toEncoding g
2270+ toEncoding g >*<
2727− , toEncoding h
2271+ toEncoding h >*<
2728− , toEncoding i
2272+ toEncoding i >*<
2729− , toEncoding j
2273+ toEncoding j >*<
2730− , toEncoding k
2274+ toEncoding k >*<
2731− , toL l
2275+ toL l >*<
2734 {-# INLINE liftToEncoding2 #-}
2277 {-# INLINE liftToEncoding2 #-}
2736instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
2279instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
@@ -2765,22 +2308,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2765 return mv
2308 return mv
2766 {-# INLINE liftToJSON2 #-}
2309 {-# INLINE liftToJSON2 #-}
2768− liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id
2311+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
2769− [ toEncoding a
2312+ toEncoding a >*<
2770− , toEncoding b
2313+ toEncoding b >*<
2771− , toEncoding c
2314+ toEncoding c >*<
2772− , toEncoding d
2315+ toEncoding d >*<
2773− , toEncoding e
2316+ toEncoding e >*<
2774− , toEncoding f
2317+ toEncoding f >*<
2775− , toEncoding g
2318+ toEncoding g >*<
2776− , toEncoding h
2319+ toEncoding h >*<
2777− , toEncoding i
2320+ toEncoding i >*<
2778− , toEncoding j
2321+ toEncoding j >*<
2779− , toEncoding k
2322+ toEncoding k >*<
2780− , toEncoding l
2323+ toEncoding l >*<
2781− , toM m
2324+ toM m >*<
2784 {-# INLINE liftToEncoding2 #-}
2326 {-# INLINE liftToEncoding2 #-}
2786instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
2328instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
@@ -2816,23 +2358,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2816 return mv
2358 return mv
2817 {-# INLINE liftToJSON2 #-}
2359 {-# INLINE liftToJSON2 #-}
2819− liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id
2361+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
2820− [ toEncoding a
2362+ toEncoding a >*<
2821− , toEncoding b
2363+ toEncoding b >*<
2822− , toEncoding c
2364+ toEncoding c >*<
2823− , toEncoding d
2365+ toEncoding d >*<
2824− , toEncoding e
2366+ toEncoding e >*<
2825− , toEncoding f
2367+ toEncoding f >*<
2826− , toEncoding g
2368+ toEncoding g >*<
2827− , toEncoding h
2369+ toEncoding h >*<
2828− , toEncoding i
2370+ toEncoding i >*<
2829− , toEncoding j
2371+ toEncoding j >*<
2830− , toEncoding k
2372+ toEncoding k >*<
2831− , toEncoding l
2373+ toEncoding l >*<
2832− , toEncoding m
2374+ toEncoding m >*<
2833− , toN n
2375+ toN n >*<
2836 {-# INLINE liftToEncoding2 #-}
2377 {-# INLINE liftToEncoding2 #-}
2838instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
2379instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
@@ -2846,27 +2387,3 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2846 {-# INLINE toJSON #-}
2387 {-# INLINE toJSON #-}
2847 toEncoding = toEncoding2
2388 toEncoding = toEncoding2
2848 {-# INLINE toEncoding #-}
2389 {-# INLINE toEncoding #-}
2850−--------------------------------------------------------------------------------
2852−-- | Wrap a list of pairs as an object.
2853−class Monoid pairs => FromPairs enc pairs | enc -> pairs where
2854− fromPairs :: pairs -> enc
2856−instance (a ~ Value) => FromPairs (Encoding' a) Series where
2857− fromPairs = E.pairs
2859−instance FromPairs Value (DList Pair) where
2860− fromPairs = object . toList
2862−-- | Like 'KeyValue' but the value is already converted to JSON
2863−-- ('Value' or 'Encoding'), and the result actually represents lists of pairs
2864−-- so it can be readily concatenated.
2865−class Monoid kv => KeyValuePair v kv where
2866− pair :: String -> v -> kv
2868−instance (v ~ Value) => KeyValuePair v (DList Pair) where
2869− pair k v = DList.singleton (pack k .= v)
2871−instance (e ~ Encoding) => KeyValuePair e Series where