@@ -1,29 +1,27 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DefaultSignatures #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE GADTs #-}
7−{-# LANGUAGE MultiParamTypeClasses #-}
8−{-# LANGUAGE NamedFieldPuns #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PatternGuards #-}
11−{-# LANGUAGE RecordWildCards #-}
12−{-# LANGUAGE ScopedTypeVariables #-}
13−{-# LANGUAGE TypeOperators #-}
14−{-# LANGUAGE TypeSynonymInstances #-}
15−{-# LANGUAGE UndecidableInstances #-}
16−
17−#if __GLASGOW_HASKELL__ >= 706
18−{-# LANGUAGE PolyKinds #-}
19−#endif
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE EmptyDataDecls #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE FunctionalDependencies #-}
7+{-# LANGUAGE GADTs #-}
8+{-# LANGUAGE NoImplicitPrelude #-}
9+{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE PatternGuards #-}
11+{-# LANGUAGE PolyKinds #-}
12+{-# LANGUAGE RecordWildCards #-}
13+{-# LANGUAGE ScopedTypeVariables #-}
14+{-# LANGUAGE TypeOperators #-}
15+{-# LANGUAGE UndecidableInstances #-}
2016
2117#include "overlapping-compat.h"
18+#include "incoherent-compat.h"
2219
2320-- TODO: Drop this when we remove support for Data.Attoparsec.Number
2421{-# OPTIONS_GHC -fno-warn-deprecations #-}
2522
26−module Data.Aeson.Types.ToJSON (
23+module Data.Aeson.Types.ToJSON
24+ (
2725 -- * Core JSON classes
2826 ToJSON(..)
2927 -- * Liftings to unary and binary type constructors
@@ -35,7 +33,7 @@ module Data.Aeson.Types.ToJSON (
3533 , toEncoding2
3634 -- * Generic JSON classes
3735 , GToJSON(..)
38− , GToEncoding(..)
36+ , ToArgs(..)
3937 , genericToJSON
4038 , genericToEncoding
4139 , genericLiftToJSON
@@ -43,84 +41,107 @@ module Data.Aeson.Types.ToJSON (
4341 -- * Classes and types for map keys
4442 , ToJSONKey(..)
4543 , ToJSONKeyFunction(..)
44+ , toJSONKeyText
4645 , contramapToJSONKeyFunction
46+
47+ , GToJSONKey()
48+ , genericToJSONKey
49+
4750 -- * Object key-value pairs
4851 , KeyValue(..)
52+ , KeyValuePair(..)
53+ , FromPairs(..)
4954 -- * Functions needed for documentation
5055 -- * Encoding functions
5156 , listEncoding
5257 , listValue
5358 ) where
5459
55−import Prelude ()
5660import Prelude.Compat
5761
58−import Data.Aeson.Encoding.Internal (Encoding (..), Series, dict, emptyArray_,
59− tuple, (>*<))
60−import Data.Aeson.Functions (mapHashKeyVal, mapKeyVal)
61−import Data.Aeson.Types.Generic
62+import Control.Applicative (Const(..))
63+import Control.Monad.ST (ST)
64+import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
65+import Data.Aeson.Encoding.Internal ((>*<))
66+import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
67+import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
6268import Data.Aeson.Types.Internal
63−
64−-- We need internal here for generic deriving
65−import qualified Data.Aeson.Encoding.Internal as E
66−
67−import Control.Applicative (Const (..))
68−import Control.Monad.ST (ST)
69−import Data.Attoparsec.Number (Number (..))
70−import Data.Bits (unsafeShiftR)
71−import Data.DList (DList)
72−import Data.Fixed (Fixed, HasResolution)
73−import Data.Foldable (toList)
74−import Data.Functor.Identity (Identity (..))
75−import Data.Int (Int16, Int32, Int64, Int8)
76−import Data.List (intersperse)
77−import Data.List.NonEmpty (NonEmpty (..))
78−import Data.Monoid (Dual (..), First (..), Last (..), (<>))
79−import Data.Proxy (Proxy (..))
80−import Data.Ratio (Ratio, denominator, numerator)
81−import Data.Scientific (Scientific)
82−import Data.Tagged (Tagged (..))
83−import Data.Text (Text, pack)
84−import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay,
85− UTCTime, ZonedTime)
86−import Data.Time.Format (FormatTime, formatTime)
87−import Data.Time.Locale.Compat (defaultTimeLocale)
88−import Data.Vector (Vector)
89−import Data.Version (Version, showVersion)
90−import Data.Word (Word16, Word32, Word64, Word8)
91−import Foreign.Storable (Storable)
69+import Data.Attoparsec.Number (Number(..))
70+import Data.Bits (unsafeShiftR)
71+import Data.DList (DList)
72+import Data.Fixed (Fixed, HasResolution, Nano)
73+import Data.Foldable (toList)
74+import Data.Functor.Compose (Compose(..))
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)
80+import Data.List (intersperse)
81+import Data.List.NonEmpty (NonEmpty(..))
82+import Data.Semigroup ((<>))
83+import Data.Proxy (Proxy(..))
84+import Data.Ratio (Ratio, denominator, numerator)
85+import Data.Scientific (Scientific)
86+import Data.Tagged (Tagged(..))
87+import Data.Text (Text, pack)
88+import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
89+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
90+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
91+import Data.Time.Clock.System.Compat (SystemTime (..))
92+import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale)
93+import Data.Vector (Vector)
94+import Data.Version (Version, showVersion)
95+import Data.Void (Void, absurd)
96+import Data.Word (Word16, Word32, Word64, Word8)
97+import Foreign.Storable (Storable)
98+import Foreign.C.Types (CTime (..))
9299import GHC.Generics
93−import Numeric.Natural (Natural)
94−
95−import qualified Data.ByteString.Builder as B (toLazyByteString)
96−import qualified Data.ByteString.Lazy as L
97−import qualified Data.DList as DList
98−import qualified Data.HashMap.Strict as H
99−import qualified Data.HashSet as HashSet
100−import qualified Data.IntMap as IntMap
101−import qualified Data.IntSet as IntSet
102−import qualified Data.List.NonEmpty as NE
103−import qualified Data.Map as M
104−import qualified Data.Scientific as Scientific
105−import qualified Data.Sequence as Seq
106−import qualified Data.Set as Set
107−import qualified Data.Text as T
108−import qualified Data.Text.Encoding as T
109−import qualified Data.Text.Lazy as LT
110−import qualified Data.Tree as Tree
111−import qualified Data.Vector as V
112−import qualified Data.Vector.Generic as VG
113−import qualified Data.Vector.Mutable as VM
114−import qualified Data.Vector.Primitive as VP
115−import qualified Data.Vector.Storable as VS
116−import qualified Data.Vector.Unboxed as VU
100+import Numeric.Natural (Natural)
101+import qualified Data.Aeson.Encoding as E
102+import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
103+import qualified Data.ByteString.Lazy as L
104+import qualified Data.DList as DList
105+import qualified Data.HashMap.Strict as H
106+import qualified Data.HashSet as HashSet
107+import qualified Data.IntMap as IntMap
108+import qualified Data.IntSet as IntSet
109+import qualified Data.List.NonEmpty as NE
110+import qualified Data.Map as M
111+import qualified Data.Monoid as Monoid
112+import qualified Data.Scientific as Scientific
113+import qualified Data.Semigroup as Semigroup
114+import qualified Data.Sequence as Seq
115+import qualified Data.Set as Set
116+import qualified Data.Text as T
117+import qualified Data.Text.Encoding as T
118+import qualified Data.Text.Lazy as LT
119+import qualified Data.Tree as Tree
120+import qualified Data.UUID.Types as UUID
121+import qualified Data.Vector as V
122+import qualified Data.Vector.Generic as VG
123+import qualified Data.Vector.Mutable as VM
124+import qualified Data.Vector.Primitive as VP
125+import qualified Data.Vector.Storable as VS
126+import qualified Data.Vector.Unboxed as VU
127+
128+import qualified Data.Aeson.Encoding.Builder as EB
129+import qualified Data.ByteString.Builder as B
130+
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
135+
136+#if MIN_VERSION_primitive(0,6,4)
137+#if !MIN_VERSION_primitive(0,7,0)
138+import qualified Data.Primitive.UnliftedArray as PM
139+#endif
140+import qualified Data.Primitive.PrimArray as PM
141+#endif
117142
118143toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
119−toJSONPair keySerialiser valSerializer (a, b) = Array $ V.create $ do
120− mv <- VM.unsafeNew 2
121− VM.unsafeWrite mv 0 (keySerialiser a)
122− VM.unsafeWrite mv 1 (valSerializer b)
123− return mv
144+toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
124145{-# INLINE toJSONPair #-}
125146
126147realFloatToJSON :: RealFloat a => a -> Value
@@ -135,51 +156,53 @@ realFloatToJSON d
135156
136157-- | Class of generic representation types that can be converted to
137158-- JSON.
138−class GToJSON arity f where
159+class GToJSON enc arity f where
139160 -- | This method (applied to 'defaultOptions') is used as the
140− -- default generic implementation of 'toJSON' (if the @arity@ is 'Zero')
141− -- or 'liftToJSON' (if the @arity@ is 'One').
142− gToJSON :: Options -> Proxy arity
143− -> (a -> Value) -> ([a] -> Value) -> f a -> Value
144−
145−-- | Class of generic representation types that can be converted to
146−-- a JSON 'Encoding'.
147−class GToEncoding arity f where
148− -- | This method (applied to 'defaultOptions') can be used as the
149− -- default generic implementation of 'toEncoding' (if the @arity@ is 'Zero')
150− -- or 'liftToEncoding' (if the @arity@ is 'One').
151− gToEncoding :: Options -> Proxy arity
152− -> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
161+ -- default generic implementation of 'toJSON'
162+ -- (with @enc ~ 'Value'@ and @arity ~ 'Zero'@)
163+ -- and 'liftToJSON' (if the @arity@ is 'One').
164+ --
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
169+
170+-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
171+-- function arguments that encode occurrences of the type parameter (for
172+-- 'ToJSON1').
173+data ToArgs res arity a where
174+ NoToArgs :: ToArgs res Zero a
175+ To1Args :: (a -> res) -> ([a] -> res) -> ToArgs res One a
153176
154177-- | A configurable generic JSON creator. This function applied to
155178-- 'defaultOptions' is used as the default for 'toJSON' when the type
156179-- is an instance of 'Generic'.
157−genericToJSON :: (Generic a, GToJSON Zero (Rep a))
180+genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
158181 => Options -> a -> Value
159−genericToJSON opts = gToJSON opts proxyZero undefined undefined . from
182+genericToJSON opts = gToJSON opts NoToArgs . from
160183
161184-- | A configurable generic JSON creator. This function applied to
162185-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
163186-- is an instance of 'Generic1'.
164−genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
187+genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
165188 => Options -> (a -> Value) -> ([a] -> Value)
166189 -> f a -> Value
167−genericLiftToJSON opts tj tjl = gToJSON opts proxyOne tj tjl . from1
190+genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
168191
169192-- | A configurable generic JSON encoder. This function applied to
170193-- 'defaultOptions' is used as the default for 'toEncoding' when the type
171194-- is an instance of 'Generic'.
172−genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))
195+genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
173196 => Options -> a -> Encoding
174−genericToEncoding opts = gToEncoding opts proxyZero undefined undefined . from
197+genericToEncoding opts = gToJSON opts NoToArgs . from
175198
176199-- | A configurable generic JSON encoder. This function applied to
177200-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
178201-- is an instance of 'Generic1'.
179−genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
202+genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
180203 => Options -> (a -> Encoding) -> ([a] -> Encoding)
181204 -> f a -> Encoding
182−genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
205+genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
183206
184207-------------------------------------------------------------------------------
185208-- Class
@@ -187,6 +210,9 @@ genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
187210
188211-- | A type that can be converted to JSON.
189212--
213+-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214+-- to) specify 'toEncoding'.
215+--
190216-- An example type and instance:
191217--
192218-- @
@@ -195,10 +221,10 @@ genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
195221--
196222-- data Coord = Coord { x :: Double, y :: Double }
197223--
198−-- instance ToJSON Coord where
199−-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
224+-- instance 'ToJSON' Coord where
225+-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
200226--
201−-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
227+-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
202228-- @
203229--
204230-- Instead of manually writing your 'ToJSON' instance, there are two options
@@ -206,17 +232,15 @@ genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
206232--
207233-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
208234-- instance at compile time. The generated instance is optimized for your type
209−-- so will probably be more efficient than the following two options:
235+-- so it will probably be more efficient than the following option.
210236--
211237-- * The compiler can provide a default generic implementation for
212238-- 'toJSON'.
213239--
214240-- To use the second, simply add a @deriving 'Generic'@ clause to your
215−-- datatype and declare a 'ToJSON' instance for your datatype without giving
216−-- definitions for 'toJSON' or 'toEncoding'.
217−--
218−-- For example, the previous example can be simplified to a more
219−-- minimal instance:
241+-- datatype and declare a 'ToJSON' instance. If you require nothing other than
242+-- 'defaultOptions', it is sufficient to write (and this is the only
243+-- alternative where the default 'toJSON' implementation is sufficient):
220244--
221245-- @
222246-- {-\# LANGUAGE DeriveGeneric \#-}
@@ -225,35 +249,46 @@ genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
225249--
226250-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
227251--
228−-- instance ToJSON Coord where
229−-- toEncoding = 'genericToEncoding' 'defaultOptions'
252+-- instance 'ToJSON' Coord where
253+-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
230254-- @
231255--
232−-- Why do we provide an implementation for 'toEncoding' here? The
233−-- 'toEncoding' function is a relatively new addition to this class.
234−-- To allow users of older versions of this library to upgrade without
235−-- having to edit all of their instances or encounter surprising
236−-- incompatibilities, the default implementation of 'toEncoding' uses
237−-- 'toJSON'. This produces correct results, but since it performs an
238−-- intermediate conversion to a 'Value', it will be less efficient
239−-- than directly emitting an 'Encoding'. Our one-liner definition of
240−-- 'toEncoding' above bypasses the intermediate 'Value'.
241−--
242−-- If @DefaultSignatures@ doesn't give exactly the results you want,
243−-- you can customize the generic encoding with only a tiny amount of
244−-- effort, using 'genericToJSON' and 'genericToEncoding' with your
245−-- preferred 'Options':
256+-- If on the other hand you wish to customize the generic decoding, you have
257+-- to implement both methods:
246258--
247259-- @
248−-- instance ToJSON Coord where
249−-- toJSON = 'genericToJSON' 'defaultOptions'
250−-- toEncoding = 'genericToEncoding' 'defaultOptions'
260+-- customOptions = 'defaultOptions'
261+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
262+-- }
263+--
264+-- instance 'ToJSON' Coord where
265+-- 'toJSON' = 'genericToJSON' customOptions
266+-- 'toEncoding' = 'genericToEncoding' customOptions
251267-- @
268+--
269+-- Previous versions of this library only had the 'toJSON' method. Adding
270+-- 'toEncoding' had two reasons:
271+--
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
275+-- non-optimal.
276+--
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.)
252287class ToJSON a where
253288 -- | Convert a Haskell value to a JSON-friendly intermediate type.
254289 toJSON :: a -> Value
255290
256− default toJSON :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
291+ default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
257292 toJSON = genericToJSON defaultOptions
258293
259294 -- | Encode a Haskell value as JSON.
@@ -270,8 +305,8 @@ class ToJSON a where
270305 -- extension, and then have GHC generate a method body as follows.
271306 --
272307 -- @
273− -- instance ToJSON Coord where
274− -- toEncoding = 'genericToEncoding' 'defaultOptions'
308+ -- instance 'ToJSON' Coord where
309+ -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
275310 -- @
276311
277312 toEncoding :: a -> Encoding
@@ -303,13 +338,20 @@ instance KeyValue Pair where
303338 name .= value = (name, toJSON value)
304339 {-# INLINE (.=) #-}
305340
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)
346+ {-# INLINE (.=) #-}
347+
306348-------------------------------------------------------------------------------
307349-- Classes and types for map keys
308350-------------------------------------------------------------------------------
309351
310352-- | Typeclass for types that can be used as the key of a map-like container
311353-- (like 'Map' or 'HashMap'). For example, since 'Text' has a 'ToJSONKey'
312−-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
354+-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
313355-- type 'Map' 'Text' 'Char':
314356--
315357-- >>> LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
@@ -355,16 +397,16 @@ instance KeyValue Pair where
355397-- >>> let m = Map.fromList [(Foo 4 "bar",'a'),(Foo 6 "arg",'b')]
356398-- >>> LBC8.putStrLn $ encode m
357399-- [[{"fooName":"bar","fooAge":4},"a"],[{"fooName":"arg","fooAge":6},"b"]]
358−--
400+--
359401-- The next case to consider is if we have a type that is a
360402-- newtype wrapper around 'Text'. The recommended approach is to use
361403-- generalized newtype deriving:
362404--
363−-- > newtype RecordId = RecordId { getRecordId :: Text}
405+-- > newtype RecordId = RecordId { getRecordId :: Text }
364406-- > deriving (Eq,Ord,ToJSONKey)
365−--
407+--
366408-- Then we may write:
367−--
409+--
368410-- >>> LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
369411-- {"abc":"a"}
370412--
@@ -375,14 +417,24 @@ instance KeyValue Pair where
375417--
376418-- It is possible to get the 'ToJSONKey' instance for free as we did
377419-- with 'Foo'. However, in this case, we have a natural way to go to
378−-- and from 'Text' that does not require any escape sequences. So, in
379−-- this example, 'ToJSONKeyText' will be used instead of 'ToJSONKeyValue'.
420+-- and from 'Text' that does not require any escape sequences. So
421+-- 'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps
422+-- as objects instead of arrays of pairs. This instance may be
423+-- implemented using generics as follows:
424+--
425+-- @
426+-- instance 'ToJSONKey' Color where
427+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
428+-- @
429+--
430+-- === __Low-level implementations__
431+--
380432-- The 'Show' instance can be used to help write 'ToJSONKey':
381433--
382434-- > instance ToJSONKey Color where
383435-- > toJSONKey = ToJSONKeyText f g
384436-- > where f = Text.pack . show
385−-- > g = text . Text.pack . show
437+-- > g = text . Text.pack . show
386438-- > -- text function is from Data.Aeson.Encoding
387439--
388440-- The situation of needing to turning function @a -> Text@ into
@@ -391,7 +443,7 @@ instance KeyValue Pair where
391443--
392444-- > instance ToJSONKey Color where
393445-- > toJSONKey = toJSONKeyText (Text.pack . show)
394−--
446+--
395447-- The performance of the above instance can be improved by
396448-- not using 'String' as an intermediate step when converting to
397449-- 'Text'. One option for improving performance would be to use
@@ -400,7 +452,7 @@ instance KeyValue Pair where
400452-- builder) is generated by encoding the 'Text' to a 'ByteString',
401453-- an intermediate step that could be avoided. The fastest possible
402454-- implementation would be:
403−--
455+--
404456-- > -- Assuming that OverloadedStrings is enabled
405457-- > instance ToJSONKey Color where
406458-- > toJSONKey = ToJSONKeyText f g
@@ -414,26 +466,78 @@ instance KeyValue Pair where
414466-- maximize performance.
415467
416468class ToJSONKey a where
417− -- | Provides a way to use a data type as the key for a map-like
418− -- container.
469+ -- | Strategy for rendering the key for a map-like container.
419470 toJSONKey :: ToJSONKeyFunction a
420471 default toJSONKey :: ToJSON a => ToJSONKeyFunction a
421− toJSONKey = ToJSONKeyValue (toJSON, toEncoding)
472+ toJSONKey = ToJSONKeyValue toJSON toEncoding
473+
422474 -- | This is similar in spirit to the 'showsList' method of 'Show'.
423475 -- It makes it possible to give 'String' keys special treatment
424− -- without using @OverlappingInstances@.
476+ -- without using @OverlappingInstances@. End users should always
477+ -- be able to use the default implementation of this method.
425478 toJSONKeyList :: ToJSONKeyFunction [a]
426479 default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
427− toJSONKeyList = ToJSONKeyValue (toJSON, toEncoding)
480+ toJSONKeyList = ToJSONKeyValue toJSON toEncoding
428481
429482data ToJSONKeyFunction a
430− = ToJSONKeyText (a -> Text, a -> Encoding) -- ^ key is encoded to string, produces object
431− | ToJSONKeyValue (a -> Value, a -> Encoding) -- ^ key is encoded to value, produces array
483+ = ToJSONKeyText !(a -> Text) !(a -> Encoding' Text)
484+ -- ^ key is encoded to string, produces object
485+ | ToJSONKeyValue !(a -> Value) !(a -> Encoding)
486+ -- ^ key is encoded to value, produces array
487+
488+-- | Helper for creating textual keys.
489+--
490+-- @
491+-- instance 'ToJSONKey' MyKey where
492+-- 'toJSONKey' = 'toJSONKeyText' myKeyToText
493+-- where
494+-- myKeyToText = Text.pack . show -- or showt from text-show
495+-- @
496+toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a
497+toJSONKeyText f = ToJSONKeyText f (E.text . f)
498+
499+-- | TODO: should this be exported?
500+toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a
501+toJSONKeyTextEnc e = ToJSONKeyText tot e
502+ where
503+ -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
504+ tot = T.dropAround (== '"')
505+ . T.decodeLatin1
506+ . L.toStrict
507+ . E.encodingToLazyByteString
508+ . e
509+
510+instance Contravariant ToJSONKeyFunction where
511+ contramap = contramapToJSONKeyFunction
432512
513+-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
433514contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
434515contramapToJSONKeyFunction h x = case x of
435− ToJSONKeyText (f,g) -> ToJSONKeyText (f . h, g . h)
436− ToJSONKeyValue (f,g) -> ToJSONKeyValue (f . h, g . h)
516+ ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
517+ ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
518+
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
522+-- objects.
523+--
524+-- See also 'genericFromJSONKey'.
525+--
526+-- === __Example__
527+--
528+-- @
529+-- data Color = Red | Green | Blue
530+-- deriving 'Generic'
531+--
532+-- instance 'ToJSONKey' Color where
533+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
534+-- @
535+genericToJSONKey :: (Generic a, GToJSONKey (Rep a))
536+ => JSONKeyOptions -> ToJSONKeyFunction a
537+genericToJSONKey opts = toJSONKeyText (pack . keyModifier opts . getConName . from)
538+
539+class GetConName f => GToJSONKey f
540+instance GetConName f => GToJSONKey f
437541
438542-------------------------------------------------------------------------------
439543-- Lifings of FromJSON and ToJSON to unary and binary type constructors
@@ -447,7 +551,7 @@ contramapToJSONKeyFunction h x = case x of
447551--
448552-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
449553-- instance at compile time. The generated instance is optimized for your type
450−-- so will probably be more efficient than the following two options:
554+-- so it will probably be more efficient than the following option.
451555--
452556-- * The compiler can provide a default generic implementation for
453557-- 'toJSON1'.
@@ -465,23 +569,29 @@ contramapToJSONKeyFunction h x = case x of
465569--
466570-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
467571--
468−-- instance ToJSON a => ToJSON1 (Pair a)
572+-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
469573-- @
470574--
471−-- If @DefaultSignatures@ doesn't give exactly the results you want,
575+-- If the default implementation doesn't give exactly the results you want,
472576-- you can customize the generic encoding with only a tiny amount of
473577-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
474578-- your preferred 'Options':
475579--
476580-- @
477−-- instance ToJSON a => ToJSON1 (Pair a) where
478−-- liftToJSON = 'genericLiftToJSON' 'defaultOptions'
479−-- liftToEncoding = 'genericLiftToEncoding' 'defaultOptions'
581+-- customOptions = 'defaultOptions'
582+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
583+-- }
584+--
585+-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
586+-- 'liftToJSON' = 'genericLiftToJSON' customOptions
587+-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions
480588-- @
589+--
590+-- See also 'ToJSON'.
481591class ToJSON1 f where
482592 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
483593
484− default liftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
594+ default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
485595 => (a -> Value) -> ([a] -> Value) -> f a -> Value
486596 liftToJSON = genericLiftToJSON defaultOptions
487597
@@ -490,7 +600,7 @@ class ToJSON1 f where
490600
491601 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
492602
493− default liftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
603+ default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
494604 => (a -> Encoding) -> ([a] -> Encoding)
495605 -> f a -> Encoding
496606 liftToEncoding = genericLiftToEncoding defaultOptions
@@ -538,9 +648,25 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
538648-- Encoding functions
539649-------------------------------------------------------------------------------
540650
651+-- | Helper function to use with 'liftToEncoding'.
652+-- Useful when writing own 'ToJSON1' instances.
653+--
654+-- @
655+-- newtype F a = F [a]
656+--
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
661+--
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
664+-- @
541665listEncoding :: (a -> Encoding) -> [a] -> Encoding
542666listEncoding = E.list
667+{-# INLINE listEncoding #-}
543668
669+-- | Helper function to use with 'liftToJSON', see 'listEncoding'.
544670listValue :: (a -> Value) -> [a] -> Value
545671listValue f = Array . V.fromList . map f
546672{-# INLINE listValue #-}
@@ -559,6 +685,11 @@ instance ToJSON1 [] where
559685 {-# INLINE liftToEncoding #-}
560686
561687instance (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] #-}
692+
562693 toJSON = toJSON1
563694 {-# INLINE toJSON #-}
564695
@@ -569,283 +700,260 @@ instance (ToJSON a) => ToJSON [a] where
569700-- Generic toJSON / toEncoding
570701-------------------------------------------------------------------------------
571702
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 #-}
707+
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 #-}
713+
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.
720+ gToJSON opts targs
721+ | tagSingleConstructors opts = (unTagged :: Tagged allNullary enc -> enc)
722+ . sumToJSON opts targs
723+ . unM1
724+ | otherwise = consToJSON opts targs . unM1 . unM1
725+ {-# INLINE gToJSON #-}
726+
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 #-}
732+
733+instance ( AllNullary (a :+: b) allNullary
734+ , SumToJSON enc arity (a :+: b) allNullary
735+ ) => GToJSON enc arity (a :+: b)
736+ where
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 #-}
743+
572744--------------------------------------------------------------------------------
573745-- Generic toJSON
574746
575−instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where
576− -- Meta-information, which is not handled elsewhere, is ignored:
577− gToJSON opts pa tj tjl = gToJSON opts pa tj tjl . unM1
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
749+-- instances.
578750
579−instance (ToJSON a) => GToJSON arity (K1 i a) where
580− -- Constant values are encoded using their ToJSON instance:
581− gToJSON _opts _ _ _ = toJSON . unK1
751+instance GToJSON Value arity V1 where
752+ -- Empty values do not exist, which makes the job of formatting them
753+ -- rather easy:
754+ gToJSON _ _ x = x `seq` error "case: V1"
755+ {-# INLINE gToJSON #-}
582756
583−instance GToJSON One Par1 where
584− -- Direct occurrences of the last type parameter are encoded with the
585− -- function passed in as an argument:
586− gToJSON _opts _ tj _ = tj . unPar1
757+instance ToJSON a => GToJSON Value arity (K1 i a) where
758+ -- Constant values are encoded using their ToJSON instance:
759+ gToJSON _opts _ = toJSON . unK1
760+ {-# INLINE gToJSON #-}
587761
588−instance (ToJSON1 f) => GToJSON One (Rec1 f) where
762+instance ToJSON1 f => GToJSON Value One (Rec1 f) where
589763 -- Recursive occurrences of the last type parameter are encoded using their
590764 -- ToJSON1 instance:
591− gToJSON _opts _ tj tjl = liftToJSON tj tjl . unRec1
765+ gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766+ {-# INLINE gToJSON #-}
592767
593−instance GToJSON arity U1 where
768+instance GToJSON Value arity U1 where
594769 -- Empty constructors are encoded to an empty array:
595− gToJSON _opts _ _ _ _ = emptyArray
596−
597−instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where
598− -- Constructors need to be encoded differently depending on whether they're
599− -- a record or not. This distinction is made by 'consToJSON':
600− gToJSON opts pa tj tjl = consToJSON opts pa tj tjl . unM1
770+ gToJSON _opts _ _ = emptyArray
771+ {-# INLINE gToJSON #-}
601772
602773instance ( WriteProduct arity a, WriteProduct arity b
603774 , ProductSize a, ProductSize b
604− ) => GToJSON arity (a :*: b) where
775+ ) => GToJSON Value arity (a :*: b)
776+ where
605777 -- Products are encoded to an array. Here we allocate a mutable vector of
606778 -- the same size as the product and write the product's elements to it using
607779 -- 'writeProduct':
608− gToJSON opts pa tj tjl p =
780+ gToJSON opts targs p =
609781 Array $ V.create $ do
610782 mv <- VM.unsafeNew lenProduct
611− writeProduct opts pa mv 0 lenProduct tj tjl p
783+ writeProduct opts targs mv 0 lenProduct p
612784 return mv
613785 where
614786 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
615787 productSize
788+ {-# INLINE gToJSON #-}
616789
617−instance ( AllNullary (a :+: b) allNullary
618− , SumToJSON arity (a :+: b) allNullary
619− ) => GToJSON arity (a :+: b) where
620− -- If all constructors of a sum datatype are nullary and the
621− -- 'allNullaryToStringTag' option is set they are encoded to
622− -- strings. This distinction is made by 'sumToJSON':
623− gToJSON opts pa tj tjl = (unTagged :: Tagged allNullary Value -> Value)
624− . sumToJSON opts pa tj tjl
625−
626−instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where
790+instance ( ToJSON1 f
791+ , GToJSON Value One g
792+ ) => GToJSON Value One (f :.: g)
793+ where
627794 -- If an occurrence of the last type parameter is nested inside two
628795 -- composed types, it is encoded by using the outermost type's ToJSON1
629796 -- instance to generically encode the innermost type:
630− gToJSON opts pa tj tjl =
631− let gtj = gToJSON opts pa tj tjl in
797+ gToJSON opts targs =
798+ let gtj = gToJSON opts targs in
632799 liftToJSON gtj (listValue gtj) . unComp1
800+ {-# INLINE gToJSON #-}
633801
634802--------------------------------------------------------------------------------
635803-- Generic toEncoding
636804
637−instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where
638− -- Meta-information, which is not handled elsewhere, is ignored:
639− gToEncoding opts pa te tel = gToEncoding opts pa te tel . unM1
640−
641−instance (ToJSON a) => GToEncoding arity (K1 i a) where
805+instance ToJSON a => GToJSON Encoding arity (K1 i a) where
642806 -- Constant values are encoded using their ToJSON instance:
643− gToEncoding _opts _ _ _ = toEncoding . unK1
644−
645−instance GToEncoding One Par1 where
646− -- Direct occurrences of the last type parameter are encoded with the
647− -- function passed in as an argument:
648− gToEncoding _opts _ te _ = te . unPar1
807+ gToJSON _opts _ = toEncoding . unK1
808+ {-# INLINE gToJSON #-}
649809
650−instance (ToJSON1 f) => GToEncoding One (Rec1 f) where
810+instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
651811 -- Recursive occurrences of the last type parameter are encoded using their
652812 -- ToEncoding1 instance:
653− gToEncoding _opts _ te tel = liftToEncoding te tel . unRec1
813+ gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814+ {-# INLINE gToJSON #-}
654815
655−instance GToEncoding arity U1 where
816+instance GToJSON Encoding arity U1 where
656817 -- Empty constructors are encoded to an empty array:
657− gToEncoding _opts _ _ _ _ = E.emptyArray_
658−
659−instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where
660− -- Constructors need to be encoded differently depending on whether they're
661− -- a record or not. This distinction is made by 'consToEncoding':
662− gToEncoding opts pa te tel = consToEncoding opts pa te tel . unM1
818+ gToJSON _opts _ _ = E.emptyArray_
819+ {-# INLINE gToJSON #-}
663820
664821instance ( EncodeProduct arity a
665822 , EncodeProduct arity b
666− ) => GToEncoding arity (a :*: b) where
823+ ) => GToJSON Encoding arity (a :*: b)
824+ where
667825 -- Products are encoded to an array. Here we allocate a mutable vector of
668826 -- the same size as the product and write the product's elements to it using
669827 -- 'encodeProduct':
670− gToEncoding opts pa te tel p = E.tuple $ encodeProduct opts pa te tel p
671−
672−instance ( AllNullary (a :+: b) allNullary
673− , SumToEncoding arity (a :+: b) allNullary
674− ) => GToEncoding arity (a :+: b) where
675− -- If all constructors of a sum datatype are nullary and the
676− -- 'allNullaryToStringTag' option is set they are encoded to
677− -- strings. This distinction is made by 'sumToEncoding':
678− gToEncoding opts pa te tel
679− = (unTagged :: Tagged allNullary Encoding -> Encoding)
680− . sumToEncoding opts pa te tel
828+ gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
829+ {-# INLINE gToJSON #-}
681830
682−instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where
831+instance ( ToJSON1 f
832+ , GToJSON Encoding One g
833+ ) => GToJSON Encoding One (f :.: g)
834+ where
683835 -- If an occurrence of the last type parameter is nested inside two
684836 -- composed types, it is encoded by using the outermost type's ToJSON1
685837 -- instance to generically encode the innermost type:
686− gToEncoding opts pa te tel =
687− let gte = gToEncoding opts pa te tel in
838+ gToJSON opts targs =
839+ let gte = gToJSON opts targs in
688840 liftToEncoding gte (listEncoding gte) . unComp1
841+ {-# INLINE gToJSON #-}
689842
690843--------------------------------------------------------------------------------
691844
692−class SumToJSON arity f allNullary where
693− sumToJSON :: Options -> Proxy arity
694− -> (a -> Value) -> ([a] -> Value)
695− -> f a -> Tagged allNullary Value
696−
697−instance ( GetConName f
698− , TaggedObjectPairs arity f
699− , ObjectWithSingleFieldObj arity f
700− , TwoElemArrayObj arity f
701− ) => SumToJSON arity f True where
702− sumToJSON opts pa tj tjl
703− | allNullaryToStringTag opts = Tagged . String . pack
845+class SumToJSON enc arity f allNullary where
846+ sumToJSON :: Options -> ToArgs enc arity a
847+ -> f a -> Tagged allNullary enc
848+
849+instance ( GetConName f
850+ , FromString enc
851+ , TaggedObject enc arity f
852+ , SumToJSON' ObjectWithSingleField enc arity f
853+ , SumToJSON' TwoElemArray enc arity f
854+ , SumToJSON' UntaggedValue enc arity f
855+ ) => SumToJSON enc arity f True
856+ where
857+ sumToJSON opts targs
858+ | allNullaryToStringTag opts = Tagged . fromString
704859 . constructorTagModifier opts . getConName
705− | otherwise = Tagged . nonAllNullarySumToJSON opts pa tj tjl
706−
707−instance ( TwoElemArrayObj arity f
708− , TaggedObjectPairs arity f
709− , ObjectWithSingleFieldObj arity f
710− ) => SumToJSON arity f False where
711− sumToJSON opts pa tj tjl = Tagged . nonAllNullarySumToJSON opts pa tj tjl
712−
713−nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f
714− , TaggedObjectPairs arity f
715− , ObjectWithSingleFieldObj arity f
716− ) => Options -> Proxy arity
717− -> (a -> Value) -> ([a] -> Value)
718− -> f a -> Value
719−nonAllNullarySumToJSON opts pa tj tjl =
860+ | otherwise = Tagged . nonAllNullarySumToJSON opts targs
861+
862+instance ( TaggedObject enc arity f
863+ , SumToJSON' ObjectWithSingleField enc arity f
864+ , SumToJSON' TwoElemArray enc arity f
865+ , SumToJSON' UntaggedValue enc arity f
866+ ) => SumToJSON enc arity f False
867+ where
868+ sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
869+
870+nonAllNullarySumToJSON :: ( TaggedObject enc arity f
871+ , SumToJSON' ObjectWithSingleField enc arity f
872+ , SumToJSON' TwoElemArray enc arity f
873+ , SumToJSON' UntaggedValue enc arity f
874+ ) => Options -> ToArgs enc arity a
875+ -> f a -> enc
876+nonAllNullarySumToJSON opts targs =
720877 case sumEncoding opts of
721− TaggedObject{..} ->
722− object . taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl
723− ObjectWithSingleField -> Object . objectWithSingleFieldObj opts pa tj tjl
724− TwoElemArray -> Array . twoElemArrayObj opts pa tj tjl
725−
726−--------------------------------------------------------------------------------
727878
728−class SumToEncoding arity f allNullary where
729− sumToEncoding :: Options -> Proxy arity
730− -> (a -> Encoding) -> ([a] -> Encoding)
731− -> f a -> Tagged allNullary Encoding
732−
733−instance ( GetConName f
734− , TaggedObjectEnc arity f
735− , ObjectWithSingleFieldEnc arity f
736− , TwoElemArrayEnc arity f
737− ) => SumToEncoding arity f True where
738− sumToEncoding opts pa te tel
739− | allNullaryToStringTag opts = Tagged . toEncoding .
740− constructorTagModifier opts . getConName
741− | otherwise = Tagged . nonAllNullarySumToEncoding opts pa te tel
742−
743−instance ( TwoElemArrayEnc arity f
744− , TaggedObjectEnc arity f
745− , ObjectWithSingleFieldEnc arity f
746− ) => SumToEncoding arity f False where
747− sumToEncoding opts pa te tel = Tagged . nonAllNullarySumToEncoding opts pa te tel
748−
749−nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f
750− , TaggedObjectEnc arity f
751− , ObjectWithSingleFieldEnc arity f
752− ) => Options -> Proxy arity
753− -> (a -> Encoding) -> ([a] -> Encoding)
754− -> f a -> Encoding
755−nonAllNullarySumToEncoding opts pa te tel =
756− case sumEncoding opts of
757879 TaggedObject{..} ->
758− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel
759− ObjectWithSingleField -> objectWithSingleFieldEnc opts pa te tel
760− TwoElemArray -> twoElemArrayEnc opts pa te tel
880+ taggedObject opts targs tagFieldName contentsFieldName
761881
762−--------------------------------------------------------------------------------
882+ ObjectWithSingleField ->
883+ (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884+ . sumToJSON' opts targs
763885
764−class TaggedObjectPairs arity f where
765− taggedObjectPairs :: Options -> Proxy arity
766− -> String -> String
767− -> (a -> Value) -> ([a] -> Value)
768− -> f a -> [Pair]
769−
770−instance ( TaggedObjectPairs arity a
771− , TaggedObjectPairs arity b
772− ) => TaggedObjectPairs arity (a :+: b) where
773− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (L1 x) =
774− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x
775− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (R1 x) =
776− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x
777−
778−instance ( IsRecord a isRecord
779− , TaggedObjectPairs' arity a isRecord
780− , Constructor c
781− ) => TaggedObjectPairs arity (C1 c a) where
782− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl =
783− (pack tagFieldName .= constructorTagModifier opts
784− (conName (undefined :: t c a p)) :) .
785− (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
786− taggedObjectPairs' opts pa contentsFieldName tj tjl . unM1
886+ TwoElemArray ->
887+ (unTagged :: Tagged TwoElemArray enc -> enc)
888+ . sumToJSON' opts targs
889+
890+ UntaggedValue ->
891+ (unTagged :: Tagged UntaggedValue enc -> enc)
892+ . sumToJSON' opts targs
787893
788−class TaggedObjectPairs' arity f isRecord where
789− taggedObjectPairs' :: Options -> Proxy arity
790− -> String -> (a -> Value) -> ([a] -> Value)
791− -> f a -> Tagged isRecord [Pair]
894+--------------------------------------------------------------------------------
792895
793−instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where
794− taggedObjectPairs' _ _ _ _ _ _ = Tagged []
896+class FromString enc where
897+ fromString :: String -> enc
795898
796−instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where
797− taggedObjectPairs' opts pa _ tj tjl =
798− Tagged . toList . recordToPairs opts pa tj tjl
899+instance FromString Encoding where
900+ fromString = toEncoding
799901
800−instance (GToJSON arity f) => TaggedObjectPairs' arity f False where
801− taggedObjectPairs' opts pa contentsFieldName tj tjl =
802− Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts pa tj tjl
902+instance FromString Value where
903+ fromString = String . pack
803904
804905--------------------------------------------------------------------------------
805906
806−class TaggedObjectEnc arity f where
807− taggedObjectEnc :: Options -> Proxy arity
808− -> String -> String
809− -> (a -> Encoding) -> ([a] -> Encoding)
810− -> f a -> Encoding
811−
812−instance ( TaggedObjectEnc arity a
813− , TaggedObjectEnc arity b
814− ) => TaggedObjectEnc arity (a :+: b) where
815− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (L1 x) =
816− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x
817− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (R1 x) =
818− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x
819−
820−instance ( IsRecord a isRecord
821− , TaggedObjectEnc' arity a isRecord
907+class TaggedObject enc arity f where
908+ taggedObject :: Options -> ToArgs enc arity a
909+ -> String -> String
910+ -> f a -> enc
911+
912+instance ( TaggedObject enc arity a
913+ , TaggedObject enc arity b
914+ ) => TaggedObject enc arity (a :+: b)
915+ where
916+ taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
917+ taggedObject opts targs tagFieldName contentsFieldName x
918+ taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
919+ taggedObject opts targs tagFieldName contentsFieldName x
920+
921+instance ( IsRecord a isRecord
922+ , TaggedObject' enc pairs arity a isRecord
923+ , FromPairs enc pairs
924+ , FromString enc
925+ , KeyValuePair enc pairs
822926 , Constructor c
823− ) => TaggedObjectEnc arity (C1 c a) where
824− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel v =
825− E.openCurly <>
826− (toEncoding tagFieldName <>
827− E.colon <>
828− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
829− ((unTagged :: Tagged isRecord Encoding -> Encoding) .
830− taggedObjectEnc' opts pa contentsFieldName te tel . unM1 $ v) <>
831− E.closeCurly
832−
833−class TaggedObjectEnc' arity f isRecord where
834− taggedObjectEnc' :: Options -> Proxy arity
835− -> String -> (a -> Encoding) -> ([a] -> Encoding)
836− -> f a -> Tagged isRecord Encoding
837−
838−instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where
839− taggedObjectEnc' _ _ _ _ _ _ = Tagged mempty
840−
841−instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where
842− taggedObjectEnc' opts pa _ te tel = Tagged . (E.comma <>) . fst
843− . recordToEncoding opts pa te tel
844−
845−instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where
846− taggedObjectEnc' opts pa contentsFieldName te tel =
847− Tagged . (\z -> E.comma <> toEncoding contentsFieldName <> E.colon <> z) .
848− gToEncoding opts pa te tel
927+ ) => TaggedObject enc arity (C1 c a)
928+ where
929+ taggedObject opts targs tagFieldName contentsFieldName =
930+ fromPairs . mappend tag . contents
931+ where
932+ tag = tagFieldName `pair`
933+ (fromString (constructorTagModifier opts (conName (undefined :: t c a p)))
934+ :: enc)
935+ contents =
936+ (unTagged :: Tagged isRecord pairs -> pairs) .
937+ taggedObject' opts targs contentsFieldName . unM1
938+
939+class TaggedObject' enc pairs arity f isRecord where
940+ taggedObject' :: Options -> ToArgs enc arity a
941+ -> String -> f a -> Tagged isRecord pairs
942+
943+instance ( GToJSON enc arity f
944+ , KeyValuePair enc pairs
945+ ) => TaggedObject' enc pairs arity f False
946+ where
947+ taggedObject' opts targs contentsFieldName =
948+ Tagged . (contentsFieldName `pair`) . gToJSON opts targs
949+
950+instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where
951+ taggedObject' _ _ _ _ = Tagged mempty
952+
953+instance ( RecordToPairs enc pairs arity f
954+ ) => TaggedObject' enc pairs arity f True
955+ where
956+ taggedObject' opts targs _ = Tagged . recordToPairs opts targs
849957
850958--------------------------------------------------------------------------------
851959
@@ -860,283 +968,242 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where
860968instance (Constructor c) => GetConName (C1 c a) where
861969 getConName = conName
862970
971+-- For genericToJSONKey
972+instance GetConName a => GetConName (D1 d a) where
973+ getConName (M1 x) = getConName x
974+
863975--------------------------------------------------------------------------------
864976
865−class TwoElemArrayObj arity f where
866− twoElemArrayObj :: Options -> Proxy arity
867− -> (a -> Value) -> ([a] -> Value)
868− -> f a -> V.Vector Value
977+-- Reflection of SumEncoding variants
869978
870−instance ( TwoElemArrayObj arity a
871− , TwoElemArrayObj arity b
872− ) => TwoElemArrayObj arity (a :+: b) where
873− twoElemArrayObj opts pa tj tjl (L1 x) = twoElemArrayObj opts pa tj tjl x
874− twoElemArrayObj opts pa tj tjl (R1 x) = twoElemArrayObj opts pa tj tjl x
979+data ObjectWithSingleField
980+data TwoElemArray
981+data UntaggedValue
875982
876−instance ( GToJSON arity a
877− , ConsToJSON arity a
983+--------------------------------------------------------------------------------
984+
985+class SumToJSON' s enc arity f where
986+ sumToJSON' :: Options -> ToArgs enc arity a
987+ -> f a -> Tagged s enc
988+
989+instance ( SumToJSON' s enc arity a
990+ , SumToJSON' s enc arity b
991+ ) => SumToJSON' s enc arity (a :+: b)
992+ where
993+ sumToJSON' opts targs (L1 x) = sumToJSON' opts targs x
994+ sumToJSON' opts targs (R1 x) = sumToJSON' opts targs x
995+
996+--------------------------------------------------------------------------------
997+
998+instance ( GToJSON Value arity a
999+ , ConsToJSON Value arity a
8781000 , Constructor c
879− ) => TwoElemArrayObj arity (C1 c a) where
880− twoElemArrayObj opts pa tj tjl x = V.create $ do
1001+ ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
1002+ sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
8811003 mv <- VM.unsafeNew 2
8821004 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
8831005 $ conName (undefined :: t c a p)
884− VM.unsafeWrite mv 1 $ gToJSON opts pa tj tjl x
1006+ VM.unsafeWrite mv 1 $ gToJSON opts targs x
8851007 return mv
8861008
8871009--------------------------------------------------------------------------------
8881010
889−class TwoElemArrayEnc arity f where
890− twoElemArrayEnc :: Options -> Proxy arity
891− -> (a -> Encoding) -> ([a] -> Encoding)
892− -> f a -> Encoding
893−
894−instance ( TwoElemArrayEnc arity a
895− , TwoElemArrayEnc arity b
896− ) => TwoElemArrayEnc arity (a :+: b) where
897− twoElemArrayEnc opts pa te tel (L1 x) = twoElemArrayEnc opts pa te tel x
898− twoElemArrayEnc opts pa te tel (R1 x) = twoElemArrayEnc opts pa te tel x
899−
900−instance ( GToEncoding arity a
901− , ConsToEncoding arity a
1011+instance ( GToJSON Encoding arity a
1012+ , ConsToJSON Encoding arity a
9021013 , Constructor c
903− ) => TwoElemArrayEnc arity (C1 c a) where
904− twoElemArrayEnc opts pa te tel x = E.tuple $
905− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
906− gToEncoding opts pa te tel x
907−
908−--------------------------------------------------------------------------------
909−
910−class ConsToJSON arity f where
911− consToJSON :: Options -> Proxy arity
912− -> (a -> Value) -> ([a] -> Value)
913− -> f a -> Value
914−
915−class ConsToJSON' arity f isRecord where
916− consToJSON' :: Options -> Proxy arity
917− -> Bool -- ^ Are we a record with one field?
918− -> (a -> Value) -> ([a] -> Value)
919− -> f a -> Tagged isRecord Value
920−
921−instance ( IsRecord f isRecord
922− , ConsToJSON' arity f isRecord
923− ) => ConsToJSON arity f where
924− consToJSON opts pa tj tjl =
925− (unTagged :: Tagged isRecord Value -> Value)
926− . consToJSON' opts pa (isUnary (undefined :: f a)) tj tjl
927−
928−instance (RecordToPairs arity f) => ConsToJSON' arity f True where
929− consToJSON' opts pa isUn tj tjl f = let
930− vals = toList $ recordToPairs opts pa tj tjl f
931− in case (unwrapUnaryRecords opts,isUn,vals) of
932− (True,True,[(_,val)]) -> Tagged val
933− _ -> Tagged $ object vals
934−
935−instance GToJSON arity f => ConsToJSON' arity f False where
936− consToJSON' opts pa _ tj tjl = Tagged . gToJSON opts pa tj tjl
1014+ ) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
1015+ where
1016+ sumToJSON' opts targs x = Tagged $ E.list id
1017+ [ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))
1018+ , gToJSON opts targs x
1019+ ]
9371020
9381021--------------------------------------------------------------------------------
9391022
940−class ConsToEncoding arity f where
941− consToEncoding :: Options -> Proxy arity
942− -> (a -> Encoding) -> ([a] -> Encoding)
943− -> f a -> Encoding
1023+class ConsToJSON enc arity f where
1024+ consToJSON :: Options -> ToArgs enc arity a
1025+ -> f a -> enc
9441026
945−class ConsToEncoding' arity f isRecord where
946− consToEncoding' :: Options -> Proxy arity
947− -> Bool -- ^ Are we a record with one field?
948− -> (a -> Encoding) -> ([a] -> Encoding)
949− -> f a -> Tagged isRecord Encoding
1027+class ConsToJSON' enc arity f isRecord where
1028+ consToJSON' :: Options -> ToArgs enc arity a
1029+ -> f a -> Tagged isRecord enc
9501030
9511031instance ( IsRecord f isRecord
952− , ConsToEncoding' arity f isRecord
953− ) => ConsToEncoding arity f where
954− consToEncoding opts pa te tel =
955− (unTagged :: Tagged isRecord Encoding -> Encoding)
956− . consToEncoding' opts pa (isUnary (undefined :: f a)) te tel
957−
958−instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where
959− consToEncoding' opts pa isUn te tel x =
960− let (enc, mbVal) = recordToEncoding opts pa te tel x
961− in case (unwrapUnaryRecords opts, isUn, mbVal) of
962− (True, True, Just val) -> Tagged val
963− _ -> Tagged $ E.wrapObject enc
964−
965−instance GToEncoding arity f => ConsToEncoding' arity f False where
966− consToEncoding' opts pa _ te tel = Tagged . gToEncoding opts pa te tel
967−
968−--------------------------------------------------------------------------------
969−
970−class RecordToPairs arity f where
971− recordToPairs :: Options -> Proxy arity
972− -> (a -> Value) -> ([a] -> Value)
973− -> f a -> DList Pair
974−
975−instance ( RecordToPairs arity a
976− , RecordToPairs arity b
977− ) => RecordToPairs arity (a :*: b) where
978− recordToPairs opts pa tj tjl (a :*: b) = recordToPairs opts pa tj tjl a <>
979− recordToPairs opts pa tj tjl b
980−
981−instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where
982− recordToPairs = fieldToPair
983−
984−instance OVERLAPPING_ (Selector s, ToJSON a) =>
985− RecordToPairs arity (S1 s (K1 i (Maybe a))) where
986− recordToPairs opts _ _ _ (M1 k1) | omitNothingFields opts
987− , K1 Nothing <- k1 = DList.empty
988− recordToPairs opts pa tj tjl m1 = fieldToPair opts pa tj tjl m1
989−
990−fieldToPair :: (Selector s, GToJSON arity a)
991− => Options -> Proxy arity
992− -> (p -> Value) -> ([p] -> Value)
993− -> S1 s a p -> DList Pair
994−fieldToPair opts pa tj tjl m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
995− , gToJSON opts pa tj tjl (unM1 m1)
996− )
1032+ , ConsToJSON' enc arity f isRecord
1033+ ) => ConsToJSON enc arity f
1034+ where
1035+ consToJSON opts targs =
1036+ (unTagged :: Tagged isRecord enc -> enc)
1037+ . consToJSON' opts targs
1038+ {-# INLINE consToJSON #-}
1039+
1040+instance OVERLAPPING_
1041+ ( RecordToPairs enc pairs arity (S1 s f)
1042+ , FromPairs enc pairs
1043+ , GToJSON enc arity f
1044+ ) => ConsToJSON' enc arity (S1 s f) True
1045+ where
1046+ consToJSON' opts targs
1047+ | unwrapUnaryRecords opts = Tagged . gToJSON opts targs
1048+ | otherwise = Tagged . fromPairs . recordToPairs opts targs
1049+ {-# INLINE consToJSON' #-}
1050+
1051+instance ( RecordToPairs enc pairs arity f
1052+ , FromPairs enc pairs
1053+ ) => ConsToJSON' enc arity f True
1054+ where
1055+ consToJSON' opts targs = Tagged . fromPairs . recordToPairs opts targs
1056+ {-# INLINE consToJSON' #-}
1057+
1058+instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1059+ consToJSON' opts targs = Tagged . gToJSON opts targs
1060+ {-# INLINE consToJSON' #-}
9971061
9981062--------------------------------------------------------------------------------
9991063
1000−class RecordToEncoding arity f where
1064+class RecordToPairs enc pairs arity f where
10011065 -- 1st element: whole thing
10021066 -- 2nd element: in case the record has only 1 field, just the value
10031067 -- of the field (without the key); 'Nothing' otherwise
1004− recordToEncoding :: Options -> Proxy arity
1005− -> (a -> Encoding) -> ([a] -> Encoding)
1006− -> f a -> (Encoding, Maybe Encoding)
1007−
1008−instance ( RecordToEncoding arity a
1009− , RecordToEncoding arity b
1010− ) => RecordToEncoding arity (a :*: b) where
1011− recordToEncoding opts pa te tel (a :*: b) | omitNothingFields opts =
1012− (mconcat $ intersperse E.comma $
1013− filter (not . E.nullEncoding)
1014− [ fst (recordToEncoding opts pa te tel a)
1015− , fst (recordToEncoding opts pa te tel b) ]
1016− , Nothing)
1017− recordToEncoding opts pa te tel (a :*: b) =
1018− (fst (recordToEncoding opts pa te tel a) <> E.comma <>
1019− fst (recordToEncoding opts pa te tel b),
1020− Nothing)
1021−
1022−instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) where
1023− recordToEncoding = fieldToEncoding
1024−
1025−instance OVERLAPPING_ (Selector s, ToJSON a) =>
1026− RecordToEncoding arity (S1 s (K1 i (Maybe a))) where
1027− recordToEncoding opts _ _ _ (M1 k1) | omitNothingFields opts
1028− , K1 Nothing <- k1 = (mempty, Nothing)
1029− recordToEncoding opts pa te tel m1 = fieldToEncoding opts pa te tel m1
1030−
1031−fieldToEncoding :: (Selector s, GToEncoding arity a)
1032− => Options -> Proxy arity
1033− -> (p -> Encoding) -> ([p] -> Encoding)
1034− -> S1 s a p -> (Encoding, Maybe Encoding)
1035−fieldToEncoding opts pa te tel m1 =
1036− let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
1037− valueBuilder = gToEncoding opts pa te tel (unM1 m1)
1038− in (keyBuilder <> E.colon <> valueBuilder, Just valueBuilder)
1068+ recordToPairs :: Options -> ToArgs enc arity a
1069+ -> f a -> pairs
1070+
1071+instance ( Monoid pairs
1072+ , RecordToPairs enc pairs arity a
1073+ , RecordToPairs enc pairs arity b
1074+ ) => RecordToPairs enc pairs arity (a :*: b)
1075+ where
1076+ recordToPairs opts (targs :: ToArgs enc arity p) (a :*: b) =
1077+ pairsOf a `mappend` pairsOf b
1078+ where
1079+ pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
1080+ pairsOf = recordToPairs opts targs
1081+ {-# INLINE recordToPairs #-}
1082+
1083+instance ( Selector s
1084+ , GToJSON enc arity a
1085+ , KeyValuePair enc pairs
1086+ ) => RecordToPairs enc pairs arity (S1 s a)
1087+ where
1088+ recordToPairs = fieldToPair
1089+ {-# INLINE recordToPairs #-}
1090+
1091+instance INCOHERENT_
1092+ ( Selector s
1093+ , GToJSON enc arity (K1 i (Maybe a))
1094+ , KeyValuePair enc pairs
1095+ , Monoid pairs
1096+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Maybe a)))
1097+ where
1098+ recordToPairs opts _ (M1 k1) | omitNothingFields opts
1099+ , K1 Nothing <- k1 = mempty
1100+ recordToPairs opts targs m1 = fieldToPair opts targs m1
1101+ {-# INLINE recordToPairs #-}
1102+
1103+instance INCOHERENT_
1104+ ( Selector s
1105+ , GToJSON enc arity (K1 i (Maybe a))
1106+ , KeyValuePair enc pairs
1107+ , Monoid pairs
1108+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Semigroup.Option a)))
1109+ where
1110+ recordToPairs opts targs = recordToPairs opts targs . unwrap
1111+ where
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 #-}
1115+
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 #-}
10391126
10401127--------------------------------------------------------------------------------
10411128
10421129class WriteProduct arity f where
10431130 writeProduct :: Options
1044− -> Proxy arity
1131+ -> ToArgs Value arity a
10451132 -> VM.MVector s Value
10461133 -> Int -- ^ index
10471134 -> Int -- ^ length
1048− -> (a -> Value)
1049− -> ([a] -> Value)
10501135 -> f a
10511136 -> ST s ()
10521137
10531138instance ( WriteProduct arity a
10541139 , WriteProduct arity b
10551140 ) => WriteProduct arity (a :*: b) where
1056− writeProduct opts pa mv ix len tj tjl (a :*: b) = do
1057− writeProduct opts pa mv ix lenL tj tjl a
1058− writeProduct opts pa mv ixR lenR tj tjl b
1141+ writeProduct opts targs mv ix len (a :*: b) = do
1142+ writeProduct opts targs mv ix lenL a
1143+ writeProduct opts targs mv ixR lenR b
10591144 where
10601145 lenL = len `unsafeShiftR` 1
10611146 lenR = len - lenL
10621147 ixR = ix + lenL
1148+ {-# INLINE writeProduct #-}
10631149
1064−instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
1065− writeProduct opts pa mv ix _ tj tjl =
1066− VM.unsafeWrite mv ix . gToJSON opts pa tj tjl
1150+instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
1151+ writeProduct opts targs mv ix _ =
1152+ VM.unsafeWrite mv ix . gToJSON opts targs
1153+ {-# INLINE writeProduct #-}
10671154
10681155--------------------------------------------------------------------------------
10691156
10701157class EncodeProduct arity f where
1071− encodeProduct :: Options -> Proxy arity
1072− -> (a -> Encoding) -> ([a] -> Encoding)
1073− -> f a -> Encoding
1158+ encodeProduct :: Options -> ToArgs Encoding arity a
1159+ -> f a -> Encoding' E.InArray
10741160
10751161instance ( EncodeProduct arity a
10761162 , EncodeProduct arity b
10771163 ) => EncodeProduct arity (a :*: b) where
1078− encodeProduct opts pa te tel (a :*: b) | omitNothingFields opts =
1079− mconcat $ intersperse E.comma $
1164+ encodeProduct opts targs (a :*: b) | omitNothingFields opts =
1165+ E.econcat $ intersperse E.comma $
10801166 filter (not . E.nullEncoding)
1081− [encodeProduct opts pa te tel a, encodeProduct opts pa te tel b]
1082− encodeProduct opts pa te tel (a :*: b) = encodeProduct opts pa te tel a <>
1083− E.comma <>
1084− encodeProduct opts pa te tel b
1167+ [encodeProduct opts targs a, encodeProduct opts targs b]
1168+ encodeProduct opts targs (a :*: b) =
1169+ encodeProduct opts targs a >*<
1170+ encodeProduct opts targs b
1171+ {-# INLINE encodeProduct #-}
10851172
1086−instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1087− encodeProduct opts = gToEncoding opts
1173+instance OVERLAPPABLE_ (GToJSON Encoding arity a) => EncodeProduct arity a where
1174+ encodeProduct opts targs a = E.retagEncoding $ gToJSON opts targs a
1175+ {-# INLINE encodeProduct #-}
10881176
10891177--------------------------------------------------------------------------------
10901178
1091−class ObjectWithSingleFieldObj arity f where
1092− objectWithSingleFieldObj :: Options -> Proxy arity
1093− -> (a -> Value) -> ([a] -> Value)
1094− -> f a -> Object
1095−
1096−instance ( ObjectWithSingleFieldObj arity a
1097− , ObjectWithSingleFieldObj arity b
1098− ) => ObjectWithSingleFieldObj arity (a :+: b) where
1099− objectWithSingleFieldObj opts pa tj tjl (L1 x) =
1100− objectWithSingleFieldObj opts pa tj tjl x
1101− objectWithSingleFieldObj opts pa tj tjl (R1 x) =
1102− objectWithSingleFieldObj opts pa tj tjl x
1103−
1104−instance ( GToJSON arity a
1105− , ConsToJSON arity a
1179+instance ( GToJSON enc arity a
1180+ , ConsToJSON enc arity a
1181+ , FromPairs enc pairs
1182+ , KeyValuePair enc pairs
11061183 , Constructor c
1107− ) => ObjectWithSingleFieldObj arity (C1 c a) where
1108− objectWithSingleFieldObj opts pa tj tjl = H.singleton typ . gToJSON opts pa tj tjl
1184+ ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1185+ where
1186+ sumToJSON' opts targs =
1187+ Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
11091188 where
1110− typ = pack $ constructorTagModifier opts $
1189+ typ = constructorTagModifier opts $
11111190 conName (undefined :: t c a p)
11121191
11131192--------------------------------------------------------------------------------
11141193
1115−class ObjectWithSingleFieldEnc arity f where
1116− objectWithSingleFieldEnc :: Options -> Proxy arity
1117− -> (a -> Encoding) -> ([a] -> Encoding)
1118− -> f a -> Encoding
1119−
1120−instance ( ObjectWithSingleFieldEnc arity a
1121− , ObjectWithSingleFieldEnc arity b
1122− ) => ObjectWithSingleFieldEnc arity (a :+: b) where
1123− objectWithSingleFieldEnc opts pa te tel (L1 x) =
1124− objectWithSingleFieldEnc opts pa te tel x
1125− objectWithSingleFieldEnc opts pa te tel (R1 x) =
1126− objectWithSingleFieldEnc opts pa te tel x
1127−
1128−instance ( GToEncoding arity a
1129− , ConsToEncoding arity a
1130− , Constructor c
1131− ) => ObjectWithSingleFieldEnc arity (C1 c a) where
1132− objectWithSingleFieldEnc opts pa te tel v =
1133− E.openCurly <>
1134− toEncoding
1135− (constructorTagModifier opts
1136− (conName (undefined :: t c a p))) <>
1137− E.colon <>
1138− gToEncoding opts pa te tel v <>
1139− E.closeCurly
1194+instance OVERLAPPABLE_
1195+ ( ConsToJSON enc arity a
1196+ ) => SumToJSON' UntaggedValue enc arity (C1 c a)
1197+ where
1198+ sumToJSON' opts targs = Tagged . gToJSON opts targs
1199+
1200+instance OVERLAPPING_
1201+ ( Constructor c
1202+ , FromString enc
1203+ ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
1204+ where
1205+ sumToJSON' opts _ _ = Tagged . fromString $
1206+ constructorTagModifier opts $ conName (undefined :: t c U1 p)
11401207
11411208-------------------------------------------------------------------------------
11421209-- Instances
@@ -1146,21 +1213,6 @@ instance ( GToEncoding arity a
11461213-- base
11471214-------------------------------------------------------------------------------
11481215
1149−instance ToJSON1 Identity where
1150− liftToJSON t _ (Identity a) = t a
1151− {-# INLINE liftToJSON #-}
1152−
1153− liftToEncoding t _ (Identity a) = t a
1154− {-# INLINE liftToEncoding #-}
1155−
1156−instance (ToJSON a) => ToJSON (Identity a) where
1157− toJSON = toJSON1
1158− {-# INLINE toJSON #-}
1159−
1160− toEncoding = toEncoding1
1161− {-# INLINE toEncoding #-}
1162−
1163−
11641216instance ToJSON2 Const where
11651217 liftToJSON2 t _ _ _ (Const x) = t x
11661218 {-# INLINE liftToJSON2 #-}
@@ -1201,8 +1253,8 @@ instance (ToJSON a) => ToJSON (Maybe a) where
12011253
12021254
12031255instance ToJSON2 Either where
1204− liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton left (toA a)
1205− liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton right (toB b)
1256+ liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton "Left" (toA a)
1257+ liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton "Right" (toB b)
12061258 {-# INLINE liftToJSON2 #-}
12071259
12081260 liftToEncoding2 toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a
@@ -1224,9 +1276,12 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
12241276 toEncoding = toEncoding2
12251277 {-# INLINE toEncoding #-}
12261278
1227−left, right :: Text
1228−left = "Left"
1229−right = "Right"
1279+instance ToJSON Void where
1280+ toJSON = absurd
1281+ {-# INLINE toJSON #-}
1282+
1283+ toEncoding = absurd
1284+ {-# INLINE toEncoding #-}
12301285
12311286
12321287instance ToJSON Bool where
@@ -1237,10 +1292,7 @@ instance ToJSON Bool where
12371292 {-# INLINE toEncoding #-}
12381293
12391294instance ToJSONKey Bool where
1240− toJSONKey = ToJSONKeyText
1241− ( (\x -> if x then "true" else "false")
1242− , (\x -> toEncoding $ if x then ("true" :: Text) else "false")
1243− )
1295+ toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"
12441296
12451297
12461298instance ToJSON Ordering where
@@ -1416,7 +1468,6 @@ instance ToJSONKey Int64 where
14161468 toJSONKey = toJSONKeyTextEnc E.int64Text
14171469 {-# INLINE toJSONKey #-}
14181470
1419−
14201471instance ToJSON Word where
14211472 toJSON = Number . fromIntegral
14221473 {-# INLINE toJSON #-}
@@ -1476,6 +1527,12 @@ instance ToJSONKey Word64 where
14761527 toJSONKey = toJSONKeyTextEnc E.word64Text
14771528 {-# INLINE toJSONKey #-}
14781529
1530+instance ToJSON CTime where
1531+ toJSON (CTime i) = toJSON i
1532+ {-# INLINE toJSON #-}
1533+
1534+ toEncoding (CTime i) = toEncoding i
1535+ {-# INLINE toEncoding #-}
14791536
14801537instance ToJSON Text where
14811538 toJSON = String
@@ -1485,9 +1542,10 @@ instance ToJSON Text where
14851542 {-# INLINE toEncoding #-}
14861543
14871544instance ToJSONKey Text where
1488− toJSONKey = ToJSONKeyText (id, toEncoding)
1545+ toJSONKey = toJSONKeyText id
14891546 {-# INLINE toJSONKey #-}
14901547
1548+
14911549instance ToJSON LT.Text where
14921550 toJSON = String . LT.toStrict
14931551 {-# INLINE toJSON #-}
@@ -1495,6 +1553,10 @@ instance ToJSON LT.Text where
14951553 toEncoding = E.lazyText
14961554 {-# INLINE toEncoding #-}
14971555
1556+instance ToJSONKey LT.Text where
1557+ toJSONKey = toJSONKeyText LT.toStrict
1558+
1559+
14981560instance ToJSON Version where
14991561 toJSON = toJSON . showVersion
15001562 {-# INLINE toJSON #-}
@@ -1502,6 +1564,9 @@ instance ToJSON Version where
15021564 toEncoding = toEncoding . showVersion
15031565 {-# INLINE toEncoding #-}
15041566
1567+instance ToJSONKey Version where
1568+ toJSONKey = toJSONKeyText (T.pack . showVersion)
1569+
15051570-------------------------------------------------------------------------------
15061571-- semigroups NonEmpty
15071572-------------------------------------------------------------------------------
@@ -1552,6 +1617,116 @@ instance (ToJSON a) => ToJSON (DList.DList a) where
15521617 toEncoding = toEncoding1
15531618 {-# INLINE toEncoding #-}
15541619
1620+-------------------------------------------------------------------------------
1621+-- transformers - Functors
1622+-------------------------------------------------------------------------------
1623+
1624+instance ToJSON1 Identity where
1625+ liftToJSON t _ (Identity a) = t a
1626+ {-# INLINE liftToJSON #-}
1627+
1628+ liftToJSONList _ tl xs = tl (map runIdentity xs)
1629+ {-# INLINE liftToJSONList #-}
1630+
1631+ liftToEncoding t _ (Identity a) = t a
1632+ {-# INLINE liftToEncoding #-}
1633+
1634+ liftToEncodingList _ tl xs = tl (map runIdentity xs)
1635+ {-# INLINE liftToEncodingList #-}
1636+
1637+instance (ToJSON a) => ToJSON (Identity a) where
1638+ toJSON = toJSON1
1639+ {-# INLINE toJSON #-}
1640+
1641+ toJSONList = liftToJSONList toJSON toJSONList
1642+ {-# INLINE toJSONList #-}
1643+
1644+ toEncoding = toEncoding1
1645+ {-# INLINE toEncoding #-}
1646+
1647+ toEncodingList = liftToEncodingList toEncoding toEncodingList
1648+ {-# INLINE toEncodingList #-}
1649+
1650+instance (ToJSONKey a) => ToJSONKey (Identity a) where
1651+ toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1652+ toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
1653+
1654+
1655+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) where
1656+ liftToJSON tv tvl (Compose x) = liftToJSON g gl x
1657+ where
1658+ g = liftToJSON tv tvl
1659+ gl = liftToJSONList tv tvl
1660+ {-# INLINE liftToJSON #-}
1661+
1662+ liftToJSONList te tel xs = liftToJSONList g gl (map getCompose xs)
1663+ where
1664+ g = liftToJSON te tel
1665+ gl = liftToJSONList te tel
1666+ {-# INLINE liftToJSONList #-}
1667+
1668+ liftToEncoding te tel (Compose x) = liftToEncoding g gl x
1669+ where
1670+ g = liftToEncoding te tel
1671+ gl = liftToEncodingList te tel
1672+ {-# INLINE liftToEncoding #-}
1673+
1674+ liftToEncodingList te tel xs = liftToEncodingList g gl (map getCompose xs)
1675+ where
1676+ g = liftToEncoding te tel
1677+ gl = liftToEncodingList te tel
1678+ {-# INLINE liftToEncodingList #-}
1679+
1680+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where
1681+ toJSON = toJSON1
1682+ {-# INLINE toJSON #-}
1683+
1684+ toJSONList = liftToJSONList toJSON toJSONList
1685+ {-# INLINE toJSONList #-}
1686+
1687+ toEncoding = toEncoding1
1688+ {-# INLINE toEncoding #-}
1689+
1690+ toEncodingList = liftToEncodingList toEncoding toEncodingList
1691+ {-# INLINE toEncodingList #-}
1692+
1693+
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)
1696+ where
1697+ tx = liftToJSON tv tvl
1698+ txl = liftToJSONList tv tvl
1699+ ty = liftToJSON tv tvl
1700+ tyl = liftToJSONList tv tvl
1701+
1702+ liftToEncoding te tel (Pair x y) = liftToEncoding2 tx txl ty tyl (x, y)
1703+ where
1704+ tx = liftToEncoding te tel
1705+ txl = liftToEncodingList te tel
1706+ ty = liftToEncoding te tel
1707+ tyl = liftToEncodingList te tel
1708+
1709+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) where
1710+ toJSON = toJSON1
1711+ {-# INLINE toJSON #-}
1712+
1713+ toEncoding = toEncoding1
1714+ {-# INLINE toEncoding #-}
1715+
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)
1719+
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
1722+
1723+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) where
1724+ toJSON = toJSON1
1725+ {-# INLINE toJSON #-}
1726+
1727+ toEncoding = toEncoding1
1728+ {-# INLINE toEncoding #-}
1729+
15551730-------------------------------------------------------------------------------
15561731-- containers
15571732-------------------------------------------------------------------------------
@@ -1617,17 +1792,15 @@ instance ToJSON a => ToJSON (IntMap.IntMap a) where
16171792
16181793instance ToJSONKey k => ToJSON1 (M.Map k) where
16191794 liftToJSON g _ = case toJSONKey of
1620− ToJSONKeyText (f,_) -> Object . mapHashKeyVal f g
1621− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . M.toList
1795+ ToJSONKeyText f _ -> Object . mapHashKeyVal f g
1796+ ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
16221797 {-# INLINE liftToJSON #-}
16231798
1624− -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
16251799 liftToEncoding g _ = case toJSONKey of
1626− ToJSONKeyText (_,f) -> dict f g M.foldrWithKey
1627− ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . M.toList
1800+ ToJSONKeyText _ f -> dict f g M.foldrWithKey
1801+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
16281802 where
1629− -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1630− pairEncoding f (a, b) = tuple $ f a >*< g b
1803+ pairEncoding f (a, b) = E.list id [f a, g b]
16311804 {-# INLINE liftToEncoding #-}
16321805
16331806
@@ -1665,6 +1838,17 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
16651838 toEncoding = toEncoding1
16661839 {-# INLINE toEncoding #-}
16671840
1841+-------------------------------------------------------------------------------
1842+-- uuid
1843+-------------------------------------------------------------------------------
1844+
1845+instance ToJSON UUID.UUID where
1846+ toJSON = toJSON . UUID.toText
1847+ toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1848+
1849+instance ToJSONKey UUID.UUID where
1850+ toJSONKey = ToJSONKeyText UUID.toText $
1851+ E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
16681852
16691853-------------------------------------------------------------------------------
16701854-- vector
@@ -1678,10 +1862,12 @@ instance ToJSON1 Vector where
16781862 {-# INLINE liftToEncoding #-}
16791863
16801864instance (ToJSON a) => ToJSON (Vector a) where
1681− toJSON = Array . V.map toJSON
1865+ {-# SPECIALIZE instance ToJSON Array #-}
1866+
1867+ toJSON = toJSON1
16821868 {-# INLINE toJSON #-}
16831869
1684− toEncoding = encodeVector
1870+ toEncoding = toEncoding1
16851871 {-# INLINE toEncoding #-}
16861872
16871873encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
@@ -1736,20 +1922,21 @@ instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
17361922
17371923instance ToJSONKey k => ToJSON1 (H.HashMap k) where
17381924 liftToJSON g _ = case toJSONKey of
1739− ToJSONKeyText (f,_) -> Object . mapKeyVal f g
1740− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . H.toList
1925+ ToJSONKeyText f _ -> Object . mapKeyVal f g
1926+ ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList
17411927 {-# INLINE liftToJSON #-}
17421928
17431929 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
17441930 liftToEncoding g _ = case toJSONKey of
1745− ToJSONKeyText (_,f) -> dict f g H.foldrWithKey
1746− ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . H.toList
1931+ ToJSONKeyText _ f -> dict f g H.foldrWithKey
1932+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
17471933 where
1748− -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1749− pairEncoding f (a, b) = tuple $ f a >*< g b
1934+ pairEncoding f (a, b) = E.list id [f a, g b]
17501935 {-# INLINE liftToEncoding #-}
17511936
17521937instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938+ {-# SPECIALIZE instance ToJSON Object #-}
1939+
17531940 toJSON = toJSON1
17541941 {-# INLINE toJSON #-}
17551942
@@ -1779,6 +1966,32 @@ dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
17791966formatMillis :: (FormatTime t) => t -> String
17801967formatMillis = take 3 . formatTime defaultTimeLocale "%q"
17811968
1969+-------------------------------------------------------------------------------
1970+-- primitive
1971+-------------------------------------------------------------------------------
1972+
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
1978+
1979+instance ToJSON a => ToJSON (PM.SmallArray a) where
1980+ toJSON = toJSON . Exts.toList
1981+ toEncoding = toEncoding . Exts.toList
1982+
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
1987+
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
1992+#endif
1993+#endif
1994+
17821995-------------------------------------------------------------------------------
17831996-- time
17841997-------------------------------------------------------------------------------
@@ -1823,15 +2036,15 @@ instance ToJSONKey UTCTime where
18232036 toJSONKey = toJSONKeyTextEnc E.utcTime
18242037
18252038-- | Encode something t a JSON string.
1826−stringEncoding :: Encoding -> Value
2039+stringEncoding :: Encoding' Text -> Value
18272040stringEncoding = String
18282041 . T.dropAround (== '"')
18292042 . T.decodeLatin1
18302043 . L.toStrict
1831− . B.toLazyByteString
1832− . fromEncoding
2044+ . E.encodingToLazyByteString
18332045{-# INLINE stringEncoding #-}
18342046
2047+
18352048instance ToJSON NominalDiffTime where
18362049 toJSON = Number . realToFrac
18372050 {-# INLINE toJSON #-}
@@ -1839,18 +2052,70 @@ instance ToJSON NominalDiffTime where
18392052 toEncoding = E.scientific . realToFrac
18402053 {-# INLINE toEncoding #-}
18412054
2055+
2056+instance ToJSON DiffTime where
2057+ toJSON = Number . realToFrac
2058+ {-# INLINE toJSON #-}
2059+
2060+ toEncoding = E.scientific . realToFrac
2061+ {-# INLINE toEncoding #-}
2062+
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)
2069+
2070+instance ToJSON CalendarDiffTime where
2071+ toJSON (CalendarDiffTime m nt) = object
2072+ [ "months" .= m
2073+ , "time" .= nt
2074+ ]
2075+ toEncoding (CalendarDiffTime m nt) = E.pairs
2076+ ("months" .= m <> "time" .= nt)
2077+
2078+instance ToJSON CalendarDiffDays where
2079+ toJSON (CalendarDiffDays m d) = object
2080+ [ "months" .= m
2081+ , "days" .= d
2082+ ]
2083+ toEncoding (CalendarDiffDays m d) = E.pairs
2084+ ("months" .= m <> "days" .= d)
2085+
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"
2094+
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\""
2103+
2104+instance ToJSONKey DayOfWeek where
2105+ toJSONKey = toJSONKeyTextEnc toEncodingDayOfWeek
2106+
18422107-------------------------------------------------------------------------------
18432108-- base Monoid/Semigroup
18442109-------------------------------------------------------------------------------
18452110
1846−instance ToJSON1 Dual where
1847− liftToJSON t _ = t . getDual
2111+instance ToJSON1 Monoid.Dual where
2112+ liftToJSON t _ = t . Monoid.getDual
18482113 {-# INLINE liftToJSON #-}
18492114
1850− liftToEncoding t _ = t . getDual
2115+ liftToEncoding t _ = t . Monoid.getDual
18512116 {-# INLINE liftToEncoding #-}
18522117
1853−instance ToJSON a => ToJSON (Dual a) where
2118+instance ToJSON a => ToJSON (Monoid.Dual a) where
18542119 toJSON = toJSON1
18552120 {-# INLINE toJSON #-}
18562121
@@ -1858,14 +2123,14 @@ instance ToJSON a => ToJSON (Dual a) where
18582123 {-# INLINE toEncoding #-}
18592124
18602125
1861−instance ToJSON1 First where
1862− liftToJSON t to' = liftToJSON t to' . getFirst
2126+instance ToJSON1 Monoid.First where
2127+ liftToJSON t to' = liftToJSON t to' . Monoid.getFirst
18632128 {-# INLINE liftToJSON #-}
18642129
1865− liftToEncoding t to' = liftToEncoding t to' . getFirst
2130+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
18662131 {-# INLINE liftToEncoding #-}
18672132
1868−instance ToJSON a => ToJSON (First a) where
2133+instance ToJSON a => ToJSON (Monoid.First a) where
18692134 toJSON = toJSON1
18702135 {-# INLINE toJSON #-}
18712136
@@ -1873,14 +2138,103 @@ instance ToJSON a => ToJSON (First a) where
18732138 {-# INLINE toEncoding #-}
18742139
18752140
1876−instance ToJSON1 Last where
1877− liftToJSON t to' = liftToJSON t to' . getLast
2141+instance ToJSON1 Monoid.Last where
2142+ liftToJSON t to' = liftToJSON t to' . Monoid.getLast
18782143 {-# INLINE liftToJSON #-}
18792144
1880− liftToEncoding t to' = liftToEncoding t to' . getLast
2145+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
18812146 {-# INLINE liftToEncoding #-}
18822147
1883−instance ToJSON a => ToJSON (Last a) where
2148+instance ToJSON a => ToJSON (Monoid.Last a) where
2149+ toJSON = toJSON1
2150+ {-# INLINE toJSON #-}
2151+
2152+ toEncoding = toEncoding1
2153+ {-# INLINE toEncoding #-}
2154+
2155+
2156+instance ToJSON1 Semigroup.Min where
2157+ liftToJSON t _ (Semigroup.Min x) = t x
2158+ {-# INLINE liftToJSON #-}
2159+
2160+ liftToEncoding t _ (Semigroup.Min x) = t x
2161+ {-# INLINE liftToEncoding #-}
2162+
2163+instance ToJSON a => ToJSON (Semigroup.Min a) where
2164+ toJSON = toJSON1
2165+ {-# INLINE toJSON #-}
2166+
2167+ toEncoding = toEncoding1
2168+ {-# INLINE toEncoding #-}
2169+
2170+
2171+instance ToJSON1 Semigroup.Max where
2172+ liftToJSON t _ (Semigroup.Max x) = t x
2173+ {-# INLINE liftToJSON #-}
2174+
2175+ liftToEncoding t _ (Semigroup.Max x) = t x
2176+ {-# INLINE liftToEncoding #-}
2177+
2178+instance ToJSON a => ToJSON (Semigroup.Max a) where
2179+ toJSON = toJSON1
2180+ {-# INLINE toJSON #-}
2181+
2182+ toEncoding = toEncoding1
2183+ {-# INLINE toEncoding #-}
2184+
2185+instance ToJSON1 Semigroup.First where
2186+ liftToJSON t _ (Semigroup.First x) = t x
2187+ {-# INLINE liftToJSON #-}
2188+
2189+ liftToEncoding t _ (Semigroup.First x) = t x
2190+ {-# INLINE liftToEncoding #-}
2191+
2192+instance ToJSON a => ToJSON (Semigroup.First a) where
2193+ toJSON = toJSON1
2194+ {-# INLINE toJSON #-}
2195+
2196+ toEncoding = toEncoding1
2197+ {-# INLINE toEncoding #-}
2198+
2199+
2200+instance ToJSON1 Semigroup.Last where
2201+ liftToJSON t _ (Semigroup.Last x) = t x
2202+ {-# INLINE liftToJSON #-}
2203+
2204+ liftToEncoding t _ (Semigroup.Last x) = t x
2205+ {-# INLINE liftToEncoding #-}
2206+
2207+instance ToJSON a => ToJSON (Semigroup.Last a) where
2208+ toJSON = toJSON1
2209+ {-# INLINE toJSON #-}
2210+
2211+ toEncoding = toEncoding1
2212+ {-# INLINE toEncoding #-}
2213+
2214+
2215+instance ToJSON1 Semigroup.WrappedMonoid where
2216+ liftToJSON t _ (Semigroup.WrapMonoid x) = t x
2217+ {-# INLINE liftToJSON #-}
2218+
2219+ liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
2220+ {-# INLINE liftToEncoding #-}
2221+
2222+instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2223+ toJSON = toJSON1
2224+ {-# INLINE toJSON #-}
2225+
2226+ toEncoding = toEncoding1
2227+ {-# INLINE toEncoding #-}
2228+
2229+
2230+instance ToJSON1 Semigroup.Option where
2231+ liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
2232+ {-# INLINE liftToJSON #-}
2233+
2234+ liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
2235+ {-# INLINE liftToEncoding #-}
2236+
2237+instance ToJSON a => ToJSON (Semigroup.Option a) where
18842238 toJSON = toJSON1
18852239 {-# INLINE toJSON #-}
18862240
@@ -1891,6 +2245,13 @@ instance ToJSON a => ToJSON (Last a) where
18912245-- tagged
18922246-------------------------------------------------------------------------------
18932247
2248+instance ToJSON1 Proxy where
2249+ liftToJSON _ _ _ = Null
2250+ {-# INLINE liftToJSON #-}
2251+
2252+ liftToEncoding _ _ _ = E.null_
2253+ {-# INLINE liftToEncoding #-}
2254+
18942255instance ToJSON (Proxy a) where
18952256 toJSON _ = Null
18962257 {-# INLINE toJSON #-}
@@ -1899,6 +2260,13 @@ instance ToJSON (Proxy a) where
18992260 {-# INLINE toEncoding #-}
19002261
19012262
2263+instance ToJSON2 Tagged where
2264+ liftToJSON2 _ _ t _ (Tagged x) = t x
2265+ {-# INLINE liftToJSON2 #-}
2266+
2267+ liftToEncoding2 _ _ t _ (Tagged x) = t x
2268+ {-# INLINE liftToEncoding2 #-}
2269+
19022270instance ToJSON1 (Tagged a) where
19032271 liftToJSON t _ (Tagged x) = t x
19042272 {-# INLINE liftToJSON #-}
@@ -1913,7 +2281,6 @@ instance ToJSON b => ToJSON (Tagged a b) where
19132281 toEncoding = toEncoding1
19142282 {-# INLINE toEncoding #-}
19152283
1916−
19172284instance ToJSONKey b => ToJSONKey (Tagged a b) where
19182285 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
19192286 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
@@ -1922,34 +2289,22 @@ instance ToJSONKey b => ToJSONKey (Tagged a b) where
19222289-- Instances for converting t map keys
19232290-------------------------------------------------------------------------------
19242291
1925−-- | TODO: Move ToJSONKEyFunction to .Types(.Internal),
1926−-- export and document this function from there
1927−toJSONKeyTextEnc :: (a -> Encoding) -> ToJSONKeyFunction a
1928−toJSONKeyTextEnc e = ToJSONKeyText
1929− -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
1930− ( T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . B.toLazyByteString . fromEncoding . e
1931− , e
1932− )
1933−
19342292instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
19352293instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
19362294instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
19372295
19382296instance ToJSONKey Char where
1939− toJSONKey = ToJSONKeyText (T.singleton, toEncoding)
1940− toJSONKeyList = ToJSONKeyText (T.pack, toEncoding . T.pack)
2297+ toJSONKey = ToJSONKeyText T.singleton (E.string . (:[]))
2298+ toJSONKeyList = toJSONKeyText T.pack
19412299
19422300instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
19432301 toJSONKey = toJSONKeyList
19442302
1945−instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1946− toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1947−
19482303-------------------------------------------------------------------------------
1949−-- Tuple instances, see tuple-instances-to.hs
2304+-- Tuple instances
19502305-------------------------------------------------------------------------------
19512306
1952−instance ToJSON2 ((,) ) where
2307+instance ToJSON2 (,) where
19532308 liftToJSON2 toA _ toB _ (a, b) = Array $ V.create $ do
19542309 mv <- VM.unsafeNew 2
19552310 VM.unsafeWrite mv 0 (toA a)
@@ -1957,9 +2312,7 @@ instance ToJSON2 ((,) ) where
19572312 return mv
19582313 {-# INLINE liftToJSON2 #-}
19592314
1960− liftToEncoding2 toA _ toB _ (a, b) = tuple $
1961− toA a >*<
1962− toB b
2315+ liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
19632316 {-# INLINE liftToEncoding2 #-}
19642317
19652318instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -1983,10 +2336,11 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
19832336 return mv
19842337 {-# INLINE liftToJSON2 #-}
19852338
1986− liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
1987− toEncoding a >*<
1988− toB b >*<
1989− toC c
2339+ liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2340+ [ toEncoding a
2341+ , toB b
2342+ , toC c
2343+ ]
19902344 {-# INLINE liftToEncoding2 #-}
19912345
19922346instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -2011,11 +2365,12 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
20112365 return mv
20122366 {-# INLINE liftToJSON2 #-}
20132367
2014− liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
2015− toEncoding a >*<
2016− toEncoding b >*<
2017− toC c >*<
2018− toD d
2368+ liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2369+ [ toEncoding a
2370+ , toEncoding b
2371+ , toC c
2372+ , toD d
2373+ ]
20192374 {-# INLINE liftToEncoding2 #-}
20202375
20212376instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -2041,12 +2396,13 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
20412396 return mv
20422397 {-# INLINE liftToJSON2 #-}
20432398
2044− liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
2045− toEncoding a >*<
2046− toEncoding b >*<
2047− toEncoding c >*<
2048− toD d >*<
2049− toE e
2399+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
2400+ [ toEncoding a
2401+ , toEncoding b
2402+ , toEncoding c
2403+ , toD d
2404+ , toE e
2405+ ]
20502406 {-# INLINE liftToEncoding2 #-}
20512407
20522408instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
@@ -2073,13 +2429,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
20732429 return mv
20742430 {-# INLINE liftToJSON2 #-}
20752431
2076− liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
2077− toEncoding a >*<
2078− toEncoding b >*<
2079− toEncoding c >*<
2080− toEncoding d >*<
2081− toE e >*<
2082− toF f
2432+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
2433+ [ toEncoding a
2434+ , toEncoding b
2435+ , toEncoding c
2436+ , toEncoding d
2437+ , toE e
2438+ , toF f
2439+ ]
20832440 {-# INLINE liftToEncoding2 #-}
20842441
20852442instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
@@ -2107,14 +2464,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
21072464 return mv
21082465 {-# INLINE liftToJSON2 #-}
21092466
2110− liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
2111− toEncoding a >*<
2112− toEncoding b >*<
2113− toEncoding c >*<
2114− toEncoding d >*<
2115− toEncoding e >*<
2116− toF f >*<
2117− toG g
2467+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id
2468+ [ toEncoding a
2469+ , toEncoding b
2470+ , toEncoding c
2471+ , toEncoding d
2472+ , toEncoding e
2473+ , toF f
2474+ , toG g
2475+ ]
21182476 {-# INLINE liftToEncoding2 #-}
21192477
21202478instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
@@ -2143,15 +2501,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
21432501 return mv
21442502 {-# INLINE liftToJSON2 #-}
21452503
2146− liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
2147− toEncoding a >*<
2148− toEncoding b >*<
2149− toEncoding c >*<
2150− toEncoding d >*<
2151− toEncoding e >*<
2152− toEncoding f >*<
2153− toG g >*<
2154− toH h
2504+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id
2505+ [ toEncoding a
2506+ , toEncoding b
2507+ , toEncoding c
2508+ , toEncoding d
2509+ , toEncoding e
2510+ , toEncoding f
2511+ , toG g
2512+ , toH h
2513+ ]
21552514 {-# INLINE liftToEncoding2 #-}
21562515
21572516instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
@@ -2181,16 +2540,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
21812540 return mv
21822541 {-# INLINE liftToJSON2 #-}
21832542
2184− liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
2185− toEncoding a >*<
2186− toEncoding b >*<
2187− toEncoding c >*<
2188− toEncoding d >*<
2189− toEncoding e >*<
2190− toEncoding f >*<
2191− toEncoding g >*<
2192− toH h >*<
2193− toI i
2543+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id
2544+ [ toEncoding a
2545+ , toEncoding b
2546+ , toEncoding c
2547+ , toEncoding d
2548+ , toEncoding e
2549+ , toEncoding f
2550+ , toEncoding g
2551+ , toH h
2552+ , toI i
2553+ ]
21942554 {-# INLINE liftToEncoding2 #-}
21952555
21962556instance (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
@@ -2221,17 +2581,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
22212581 return mv
22222582 {-# INLINE liftToJSON2 #-}
22232583
2224− liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
2225− toEncoding a >*<
2226− toEncoding b >*<
2227− toEncoding c >*<
2228− toEncoding d >*<
2229− toEncoding e >*<
2230− toEncoding f >*<
2231− toEncoding g >*<
2232− toEncoding h >*<
2233− toI i >*<
2234− toJ j
2584+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id
2585+ [ toEncoding a
2586+ , toEncoding b
2587+ , toEncoding c
2588+ , toEncoding d
2589+ , toEncoding e
2590+ , toEncoding f
2591+ , toEncoding g
2592+ , toEncoding h
2593+ , toI i
2594+ , toJ j
2595+ ]
22352596 {-# INLINE liftToEncoding2 #-}
22362597
22372598instance (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
@@ -2263,18 +2624,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
22632624 return mv
22642625 {-# INLINE liftToJSON2 #-}
22652626
2266− liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
2267− toEncoding a >*<
2268− toEncoding b >*<
2269− toEncoding c >*<
2270− toEncoding d >*<
2271− toEncoding e >*<
2272− toEncoding f >*<
2273− toEncoding g >*<
2274− toEncoding h >*<
2275− toEncoding i >*<
2276− toJ j >*<
2277− toK k
2627+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id
2628+ [ toEncoding a
2629+ , toEncoding b
2630+ , toEncoding c
2631+ , toEncoding d
2632+ , toEncoding e
2633+ , toEncoding f
2634+ , toEncoding g
2635+ , toEncoding h
2636+ , toEncoding i
2637+ , toJ j
2638+ , toK k
2639+ ]
22782640 {-# INLINE liftToEncoding2 #-}
22792641
22802642instance (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
@@ -2307,19 +2669,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
23072669 return mv
23082670 {-# INLINE liftToJSON2 #-}
23092671
2310− liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
2311− toEncoding a >*<
2312− toEncoding b >*<
2313− toEncoding c >*<
2314− toEncoding d >*<
2315− toEncoding e >*<
2316− toEncoding f >*<
2317− toEncoding g >*<
2318− toEncoding h >*<
2319− toEncoding i >*<
2320− toEncoding j >*<
2321− toK k >*<
2322− toL l
2672+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id
2673+ [ toEncoding a
2674+ , toEncoding b
2675+ , toEncoding c
2676+ , toEncoding d
2677+ , toEncoding e
2678+ , toEncoding f
2679+ , toEncoding g
2680+ , toEncoding h
2681+ , toEncoding i
2682+ , toEncoding j
2683+ , toK k
2684+ , toL l
2685+ ]
23232686 {-# INLINE liftToEncoding2 #-}
23242687
23252688instance (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
@@ -2353,20 +2716,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
23532716 return mv
23542717 {-# INLINE liftToJSON2 #-}
23552718
2356− liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
2357− toEncoding a >*<
2358− toEncoding b >*<
2359− toEncoding c >*<
2360− toEncoding d >*<
2361− toEncoding e >*<
2362− toEncoding f >*<
2363− toEncoding g >*<
2364− toEncoding h >*<
2365− toEncoding i >*<
2366− toEncoding j >*<
2367− toEncoding k >*<
2368− toL l >*<
2369− toM m
2719+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id
2720+ [ toEncoding a
2721+ , toEncoding b
2722+ , toEncoding c
2723+ , toEncoding d
2724+ , toEncoding e
2725+ , toEncoding f
2726+ , toEncoding g
2727+ , toEncoding h
2728+ , toEncoding i
2729+ , toEncoding j
2730+ , toEncoding k
2731+ , toL l
2732+ , toM m
2733+ ]
23702734 {-# INLINE liftToEncoding2 #-}
23712735
23722736instance (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
@@ -2401,21 +2765,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
24012765 return mv
24022766 {-# INLINE liftToJSON2 #-}
24032767
2404− liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
2405− toEncoding a >*<
2406− toEncoding b >*<
2407− toEncoding c >*<
2408− toEncoding d >*<
2409− toEncoding e >*<
2410− toEncoding f >*<
2411− toEncoding g >*<
2412− toEncoding h >*<
2413− toEncoding i >*<
2414− toEncoding j >*<
2415− toEncoding k >*<
2416− toEncoding l >*<
2417− toM m >*<
2418− toN n
2768+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id
2769+ [ toEncoding a
2770+ , toEncoding b
2771+ , toEncoding c
2772+ , toEncoding d
2773+ , toEncoding e
2774+ , toEncoding f
2775+ , toEncoding g
2776+ , toEncoding h
2777+ , toEncoding i
2778+ , toEncoding j
2779+ , toEncoding k
2780+ , toEncoding l
2781+ , toM m
2782+ , toN n
2783+ ]
24192784 {-# INLINE liftToEncoding2 #-}
24202785
24212786instance (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
@@ -2451,22 +2816,23 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
24512816 return mv
24522817 {-# INLINE liftToJSON2 #-}
24532818
2454− liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
2455− toEncoding a >*<
2456− toEncoding b >*<
2457− toEncoding c >*<
2458− toEncoding d >*<
2459− toEncoding e >*<
2460− toEncoding f >*<
2461− toEncoding g >*<
2462− toEncoding h >*<
2463− toEncoding i >*<
2464− toEncoding j >*<
2465− toEncoding k >*<
2466− toEncoding l >*<
2467− toEncoding m >*<
2468− toN n >*<
2469− toO o
2819+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id
2820+ [ toEncoding a
2821+ , toEncoding b
2822+ , toEncoding c
2823+ , toEncoding d
2824+ , toEncoding e
2825+ , toEncoding f
2826+ , toEncoding g
2827+ , toEncoding h
2828+ , toEncoding i
2829+ , toEncoding j
2830+ , toEncoding k
2831+ , toEncoding l
2832+ , toEncoding m
2833+ , toN n
2834+ , toO o
2835+ ]
24702836 {-# INLINE liftToEncoding2 #-}
24712837
24722838instance (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
@@ -2480,3 +2846,27 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
24802846 {-# INLINE toJSON #-}
24812847 toEncoding = toEncoding2
24822848 {-# INLINE toEncoding #-}
2849+
2850+--------------------------------------------------------------------------------
2851+
2852+-- | Wrap a list of pairs as an object.
2853+class Monoid pairs => FromPairs enc pairs | enc -> pairs where
2854+ fromPairs :: pairs -> enc
2855+
2856+instance (a ~ Value) => FromPairs (Encoding' a) Series where
2857+ fromPairs = E.pairs
2858+
2859+instance FromPairs Value (DList Pair) where
2860+ fromPairs = object . toList
2861+
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
2867+
2868+instance (v ~ Value) => KeyValuePair v (DList Pair) where
2869+ pair k v = DList.singleton (pack k .= v)
2870+
2871+instance (e ~ Encoding) => KeyValuePair e Series where
2872+ pair = E.pairStr