@@ -1,27 +1,29 @@
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 #-}
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
1620
1721#include "overlapping-compat.h"
18−#include "incoherent-compat.h"
1922
2023-- TODO: Drop this when we remove support for Data.Attoparsec.Number
2124{-# OPTIONS_GHC -fno-warn-deprecations #-}
2225
23−module Data.Aeson.Types.ToJSON
24− (
26+module Data.Aeson.Types.ToJSON (
2527 -- * Core JSON classes
2628 ToJSON(..)
2729 -- * Liftings to unary and binary type constructors
@@ -33,7 +35,7 @@ module Data.Aeson.Types.ToJSON
3335 , toEncoding2
3436 -- * Generic JSON classes
3537 , GToJSON(..)
36− , ToArgs(..)
38+ , GToEncoding(..)
3739 , genericToJSON
3840 , genericToEncoding
3941 , genericLiftToJSON
@@ -41,104 +43,76 @@ module Data.Aeson.Types.ToJSON
4143 -- * Classes and types for map keys
4244 , ToJSONKey(..)
4345 , ToJSONKeyFunction(..)
44− , toJSONKeyText
4546 , contramapToJSONKeyFunction
46−
47− , GToJSONKey()
48− , genericToJSONKey
49−
5047 -- * Object key-value pairs
5148 , KeyValue(..)
52− , KeyValuePair(..)
53− , FromPairs(..)
5449 -- * Functions needed for documentation
5550 -- * Encoding functions
5651 , listEncoding
5752 , listValue
5853 ) where
5954
55+import Prelude ()
6056import Prelude.Compat
6157
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 ((>*<))
58+import Data.Aeson.Encoding.Internal (Encoding, Encoding', Series, dict,
59+ emptyArray_, tuple, (>*<), (><))
6660import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
67−import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
61+import Data.Aeson.Types.Generic
6862import Data.Aeson.Types.Internal
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 (..))
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)
9992import GHC.Generics
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
93+import Numeric.Natural (Natural)
94+
95+import qualified Data.ByteString.Lazy as L
96+import qualified Data.DList as DList
97+import qualified Data.HashMap.Strict as H
98+import qualified Data.HashSet as HashSet
99+import qualified Data.IntMap as IntMap
100+import qualified Data.IntSet as IntSet
101+import qualified Data.List.NonEmpty as NE
102+import qualified Data.Map as M
103+import qualified Data.Scientific as Scientific
104+import qualified Data.Sequence as Seq
105+import qualified Data.Set as Set
106+import qualified Data.Text as T
107+import qualified Data.Text.Encoding as T
108+import qualified Data.Text.Lazy as LT
109+import qualified Data.Tree as Tree
110+import qualified Data.Vector as V
111+import qualified Data.Vector.Generic as VG
112+import qualified Data.Vector.Mutable as VM
113+import qualified Data.Vector.Primitive as VP
114+import qualified Data.Vector.Storable as VS
115+import qualified Data.Vector.Unboxed as VU
142116
143117toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
144118toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
@@ -156,53 +130,51 @@ realFloatToJSON d
156130
157131-- | Class of generic representation types that can be converted to
158132-- JSON.
159−class GToJSON enc arity f where
133+class GToJSON arity f where
160134 -- | This method (applied to 'defaultOptions') is used as the
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
135+ -- default generic implementation of 'toJSON' (if the @arity@ is 'Zero')
136+ -- or 'liftToJSON' (if the @arity@ is 'One').
137+ gToJSON :: Options -> Proxy arity
138+ -> (a -> Value) -> ([a] -> Value) -> f a -> Value
139+
140+-- | Class of generic representation types that can be converted to
141+-- a JSON 'Encoding'.
142+class GToEncoding arity f where
143+ -- | This method (applied to 'defaultOptions') can be used as the
144+ -- default generic implementation of 'toEncoding' (if the @arity@ is 'Zero')
145+ -- or 'liftToEncoding' (if the @arity@ is 'One').
146+ gToEncoding :: Options -> Proxy arity
147+ -> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
176148
177149-- | A configurable generic JSON creator. This function applied to
178150-- 'defaultOptions' is used as the default for 'toJSON' when the type
179151-- is an instance of 'Generic'.
180−genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
152+genericToJSON :: (Generic a, GToJSON Zero (Rep a))
181153 => Options -> a -> Value
182−genericToJSON opts = gToJSON opts NoToArgs . from
154+genericToJSON opts = gToJSON opts proxyZero undefined undefined . from
183155
184156-- | A configurable generic JSON creator. This function applied to
185157-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
186158-- is an instance of 'Generic1'.
187−genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
159+genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
188160 => Options -> (a -> Value) -> ([a] -> Value)
189161 -> f a -> Value
190−genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
162+genericLiftToJSON opts tj tjl = gToJSON opts proxyOne tj tjl . from1
191163
192164-- | A configurable generic JSON encoder. This function applied to
193165-- 'defaultOptions' is used as the default for 'toEncoding' when the type
194166-- is an instance of 'Generic'.
195−genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
167+genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))
196168 => Options -> a -> Encoding
197−genericToEncoding opts = gToJSON opts NoToArgs . from
169+genericToEncoding opts = gToEncoding opts proxyZero undefined undefined . from
198170
199171-- | A configurable generic JSON encoder. This function applied to
200172-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
201173-- is an instance of 'Generic1'.
202−genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
174+genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
203175 => Options -> (a -> Encoding) -> ([a] -> Encoding)
204176 -> f a -> Encoding
205−genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
177+genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
206178
207179-------------------------------------------------------------------------------
208180-- Class
@@ -210,9 +182,6 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
210182
211183-- | A type that can be converted to JSON.
212184--
213−-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214−-- to) specify 'toEncoding'.
215−--
216185-- An example type and instance:
217186--
218187-- @
@@ -221,10 +190,10 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
221190--
222191-- data Coord = Coord { x :: Double, y :: Double }
223192--
224−-- instance 'ToJSON' Coord where
225−-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
193+-- instance ToJSON Coord where
194+-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
226195--
227−-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
196+-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
228197-- @
229198--
230199-- Instead of manually writing your 'ToJSON' instance, there are two options
@@ -232,15 +201,17 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
232201--
233202-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
234203-- instance at compile time. The generated instance is optimized for your type
235−-- so it will probably be more efficient than the following option.
204+-- so will probably be more efficient than the following two options:
236205--
237206-- * The compiler can provide a default generic implementation for
238207-- 'toJSON'.
239208--
240209-- To use the second, simply add a @deriving 'Generic'@ clause to your
241−-- datatype and declare a 'ToJSON' instance. If you require nothing other than
242−-- 'defaultOptions', it is sufficient to write (and this is the only
243−-- alternative where the default 'toJSON' implementation is sufficient):
210+-- datatype and declare a 'ToJSON' instance for your datatype without giving
211+-- definitions for 'toJSON' or 'toEncoding'.
212+--
213+-- For example, the previous example can be simplified to a more
214+-- minimal instance:
244215--
245216-- @
246217-- {-\# LANGUAGE DeriveGeneric \#-}
@@ -249,46 +220,35 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
249220--
250221-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
251222--
252−-- instance 'ToJSON' Coord where
253−-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
223+-- instance ToJSON Coord where
224+-- toEncoding = 'genericToEncoding' 'defaultOptions'
254225-- @
255226--
256−-- If on the other hand you wish to customize the generic decoding, you have
257−-- to implement both methods:
227+-- Why do we provide an implementation for 'toEncoding' here? The
228+-- 'toEncoding' function is a relatively new addition to this class.
229+-- To allow users of older versions of this library to upgrade without
230+-- having to edit all of their instances or encounter surprising
231+-- incompatibilities, the default implementation of 'toEncoding' uses
232+-- 'toJSON'. This produces correct results, but since it performs an
233+-- intermediate conversion to a 'Value', it will be less efficient
234+-- than directly emitting an 'Encoding'. Our one-liner definition of
235+-- 'toEncoding' above bypasses the intermediate 'Value'.
236+--
237+-- If @DefaultSignatures@ doesn't give exactly the results you want,
238+-- you can customize the generic encoding with only a tiny amount of
239+-- effort, using 'genericToJSON' and 'genericToEncoding' with your
240+-- preferred 'Options':
258241--
259242-- @
260−-- customOptions = 'defaultOptions'
261−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
262−-- }
263−--
264−-- instance 'ToJSON' Coord where
265−-- 'toJSON' = 'genericToJSON' customOptions
266−-- 'toEncoding' = 'genericToEncoding' customOptions
243+-- instance ToJSON Coord where
244+-- toJSON = 'genericToJSON' 'defaultOptions'
245+-- toEncoding = 'genericToEncoding' 'defaultOptions'
267246-- @
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.)
287247class ToJSON a where
288248 -- | Convert a Haskell value to a JSON-friendly intermediate type.
289249 toJSON :: a -> Value
290250
291− default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
251+ default toJSON :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
292252 toJSON = genericToJSON defaultOptions
293253
294254 -- | Encode a Haskell value as JSON.
@@ -305,8 +265,8 @@ class ToJSON a where
305265 -- extension, and then have GHC generate a method body as follows.
306266 --
307267 -- @
308− -- instance 'ToJSON' Coord where
309− -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
268+ -- instance ToJSON Coord where
269+ -- toEncoding = 'genericToEncoding' 'defaultOptions'
310270 -- @
311271
312272 toEncoding :: a -> Encoding
@@ -338,20 +298,13 @@ instance KeyValue Pair where
338298 name .= value = (name, toJSON value)
339299 {-# INLINE (.=) #-}
340300
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−
348301-------------------------------------------------------------------------------
349302-- Classes and types for map keys
350303-------------------------------------------------------------------------------
351304
352305-- | Typeclass for types that can be used as the key of a map-like container
353306-- (like 'Map' or 'HashMap'). For example, since 'Text' has a 'ToJSONKey'
354−-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
307+-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
355308-- type 'Map' 'Text' 'Char':
356309--
357310-- >>> LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
@@ -397,16 +350,16 @@ instance KeyValue Object where
397350-- >>> let m = Map.fromList [(Foo 4 "bar",'a'),(Foo 6 "arg",'b')]
398351-- >>> LBC8.putStrLn $ encode m
399352-- [[{"fooName":"bar","fooAge":4},"a"],[{"fooName":"arg","fooAge":6},"b"]]
400−--
353+--
401354-- The next case to consider is if we have a type that is a
402355-- newtype wrapper around 'Text'. The recommended approach is to use
403356-- generalized newtype deriving:
404357--
405−-- > newtype RecordId = RecordId { getRecordId :: Text }
358+-- > newtype RecordId = RecordId { getRecordId :: Text}
406359-- > deriving (Eq,Ord,ToJSONKey)
407−--
360+--
408361-- Then we may write:
409−--
362+--
410363-- >>> LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
411364-- {"abc":"a"}
412365--
@@ -417,24 +370,14 @@ instance KeyValue Object where
417370--
418371-- It is possible to get the 'ToJSONKey' instance for free as we did
419372-- with 'Foo'. However, in this case, we have a natural way to go to
420−-- and from 'Text' that does not require any escape sequences. So
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−--
373+-- and from 'Text' that does not require any escape sequences. So, in
374+-- this example, 'ToJSONKeyText' will be used instead of 'ToJSONKeyValue'.
432375-- The 'Show' instance can be used to help write 'ToJSONKey':
433376--
434377-- > instance ToJSONKey Color where
435378-- > toJSONKey = ToJSONKeyText f g
436379-- > where f = Text.pack . show
437−-- > g = text . Text.pack . show
380+-- > g = text . Text.pack . show
438381-- > -- text function is from Data.Aeson.Encoding
439382--
440383-- The situation of needing to turning function @a -> Text@ into
@@ -443,7 +386,7 @@ instance KeyValue Object where
443386--
444387-- > instance ToJSONKey Color where
445388-- > toJSONKey = toJSONKeyText (Text.pack . show)
446−--
389+--
447390-- The performance of the above instance can be improved by
448391-- not using 'String' as an intermediate step when converting to
449392-- 'Text'. One option for improving performance would be to use
@@ -452,7 +395,7 @@ instance KeyValue Object where
452395-- builder) is generated by encoding the 'Text' to a 'ByteString',
453396-- an intermediate step that could be avoided. The fastest possible
454397-- implementation would be:
455−--
398+--
456399-- > -- Assuming that OverloadedStrings is enabled
457400-- > instance ToJSONKey Color where
458401-- > toJSONKey = ToJSONKeyText f g
@@ -466,78 +409,26 @@ instance KeyValue Object where
466409-- maximize performance.
467410
468411class ToJSONKey a where
469− -- | Strategy for rendering the key for a map-like container.
412+ -- | Provides a way to use a data type as the key for a map-like
413+ -- container.
470414 toJSONKey :: ToJSONKeyFunction a
471415 default toJSONKey :: ToJSON a => ToJSONKeyFunction a
472− toJSONKey = ToJSONKeyValue toJSON toEncoding
473−
416+ toJSONKey = ToJSONKeyValue (toJSON, toEncoding)
474417 -- | This is similar in spirit to the 'showsList' method of 'Show'.
475418 -- It makes it possible to give 'String' keys special treatment
476− -- without using @OverlappingInstances@. End users should always
477− -- be able to use the default implementation of this method.
419+ -- without using @OverlappingInstances@.
478420 toJSONKeyList :: ToJSONKeyFunction [a]
479421 default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
480− toJSONKeyList = ToJSONKeyValue toJSON toEncoding
422+ toJSONKeyList = ToJSONKeyValue (toJSON, toEncoding)
481423
482424data ToJSONKeyFunction a
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
425+ = ToJSONKeyText (a -> Text, a -> Encoding' Text) -- ^ key is encoded to string, produces object
426+ | ToJSONKeyValue (a -> Value, a -> Encoding) -- ^ key is encoded to value, produces array
509427
510−instance Contravariant ToJSONKeyFunction where
511− contramap = contramapToJSONKeyFunction
512−
513−-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
514428contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
515429contramapToJSONKeyFunction h x = case x of
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
430+ ToJSONKeyText (f,g) -> ToJSONKeyText (f . h, g . h)
431+ ToJSONKeyValue (f,g) -> ToJSONKeyValue (f . h, g . h)
541432
542433-------------------------------------------------------------------------------
543434-- Lifings of FromJSON and ToJSON to unary and binary type constructors
@@ -551,7 +442,7 @@ instance GetConName f => GToJSONKey f
551442--
552443-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
553444-- instance at compile time. The generated instance is optimized for your type
554−-- so it will probably be more efficient than the following option.
445+-- so will probably be more efficient than the following two options:
555446--
556447-- * The compiler can provide a default generic implementation for
557448-- 'toJSON1'.
@@ -569,29 +460,23 @@ instance GetConName f => GToJSONKey f
569460--
570461-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
571462--
572−-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
463+-- instance ToJSON a => ToJSON1 (Pair a)
573464-- @
574465--
575−-- If the default implementation doesn't give exactly the results you want,
466+-- If @DefaultSignatures@ doesn't give exactly the results you want,
576467-- you can customize the generic encoding with only a tiny amount of
577468-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
578469-- your preferred 'Options':
579470--
580471-- @
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
472+-- instance ToJSON a => ToJSON1 (Pair a) where
473+-- liftToJSON = 'genericLiftToJSON' 'defaultOptions'
474+-- liftToEncoding = 'genericLiftToEncoding' 'defaultOptions'
588475-- @
589−--
590−-- See also 'ToJSON'.
591476class ToJSON1 f where
592477 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
593478
594− default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
479+ default liftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
595480 => (a -> Value) -> ([a] -> Value) -> f a -> Value
596481 liftToJSON = genericLiftToJSON defaultOptions
597482
@@ -600,7 +485,7 @@ class ToJSON1 f where
600485
601486 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
602487
603− default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
488+ default liftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
604489 => (a -> Encoding) -> ([a] -> Encoding)
605490 -> f a -> Encoding
606491 liftToEncoding = genericLiftToEncoding defaultOptions
@@ -648,25 +533,9 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
648533-- Encoding functions
649534-------------------------------------------------------------------------------
650535
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−-- @
665536listEncoding :: (a -> Encoding) -> [a] -> Encoding
666537listEncoding = E.list
667−{-# INLINE listEncoding #-}
668538
669−-- | Helper function to use with 'liftToJSON', see 'listEncoding'.
670539listValue :: (a -> Value) -> [a] -> Value
671540listValue f = Array . V.fromList . map f
672541{-# INLINE listValue #-}
@@ -685,11 +554,6 @@ instance ToJSON1 [] where
685554 {-# INLINE liftToEncoding #-}
686555
687556instance (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−
693557 toJSON = toJSON1
694558 {-# INLINE toJSON #-}
695559
@@ -700,260 +564,282 @@ instance (ToJSON a) => ToJSON [a] where
700564-- Generic toJSON / toEncoding
701565-------------------------------------------------------------------------------
702566
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−
744567--------------------------------------------------------------------------------
745568-- Generic toJSON
746569
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.
750−
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 #-}
570+instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where
571+ -- Meta-information, which is not handled elsewhere, is ignored:
572+ gToJSON opts pa tj tjl = gToJSON opts pa tj tjl . unM1
756573
757−instance ToJSON a => GToJSON Value arity (K1 i a) where
574+instance (ToJSON a) => GToJSON arity (K1 i a) where
758575 -- Constant values are encoded using their ToJSON instance:
759− gToJSON _opts _ = toJSON . unK1
760− {-# INLINE gToJSON #-}
576+ gToJSON _opts _ _ _ = toJSON . unK1
761577
762−instance ToJSON1 f => GToJSON Value One (Rec1 f) where
578+instance GToJSON One Par1 where
579+ -- Direct occurrences of the last type parameter are encoded with the
580+ -- function passed in as an argument:
581+ gToJSON _opts _ tj _ = tj . unPar1
582+
583+instance (ToJSON1 f) => GToJSON One (Rec1 f) where
763584 -- Recursive occurrences of the last type parameter are encoded using their
764585 -- ToJSON1 instance:
765− gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766− {-# INLINE gToJSON #-}
586+ gToJSON _opts _ tj tjl = liftToJSON tj tjl . unRec1
767587
768−instance GToJSON Value arity U1 where
588+instance GToJSON arity U1 where
769589 -- Empty constructors are encoded to an empty array:
770− gToJSON _opts _ _ = emptyArray
771− {-# INLINE gToJSON #-}
590+ gToJSON _opts _ _ _ _ = emptyArray
591+
592+instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where
593+ -- Constructors need to be encoded differently depending on whether they're
594+ -- a record or not. This distinction is made by 'consToJSON':
595+ gToJSON opts pa tj tjl = consToJSON opts pa tj tjl . unM1
772596
773597instance ( WriteProduct arity a, WriteProduct arity b
774598 , ProductSize a, ProductSize b
775− ) => GToJSON Value arity (a :*: b)
776− where
599+ ) => GToJSON arity (a :*: b) where
777600 -- Products are encoded to an array. Here we allocate a mutable vector of
778601 -- the same size as the product and write the product's elements to it using
779602 -- 'writeProduct':
780− gToJSON opts targs p =
603+ gToJSON opts pa tj tjl p =
781604 Array $ V.create $ do
782605 mv <- VM.unsafeNew lenProduct
783− writeProduct opts targs mv 0 lenProduct p
606+ writeProduct opts pa mv 0 lenProduct tj tjl p
784607 return mv
785608 where
786609 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
787610 productSize
788− {-# INLINE gToJSON #-}
789611
790−instance ( ToJSON1 f
791− , GToJSON Value One g
792− ) => GToJSON Value One (f :.: g)
793− where
612+instance ( AllNullary (a :+: b) allNullary
613+ , SumToJSON arity (a :+: b) allNullary
614+ ) => GToJSON arity (a :+: b) where
615+ -- If all constructors of a sum datatype are nullary and the
616+ -- 'allNullaryToStringTag' option is set they are encoded to
617+ -- strings. This distinction is made by 'sumToJSON':
618+ gToJSON opts pa tj tjl = (unTagged :: Tagged allNullary Value -> Value)
619+ . sumToJSON opts pa tj tjl
620+
621+instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where
794622 -- If an occurrence of the last type parameter is nested inside two
795623 -- composed types, it is encoded by using the outermost type's ToJSON1
796624 -- instance to generically encode the innermost type:
797− gToJSON opts targs =
798− let gtj = gToJSON opts targs in
625+ gToJSON opts pa tj tjl =
626+ let gtj = gToJSON opts pa tj tjl in
799627 liftToJSON gtj (listValue gtj) . unComp1
800− {-# INLINE gToJSON #-}
801628
802629--------------------------------------------------------------------------------
803630-- Generic toEncoding
804631
805−instance ToJSON a => GToJSON Encoding arity (K1 i a) where
632+instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where
633+ -- Meta-information, which is not handled elsewhere, is ignored:
634+ gToEncoding opts pa te tel = gToEncoding opts pa te tel . unM1
635+
636+instance (ToJSON a) => GToEncoding arity (K1 i a) where
806637 -- Constant values are encoded using their ToJSON instance:
807− gToJSON _opts _ = toEncoding . unK1
808− {-# INLINE gToJSON #-}
638+ gToEncoding _opts _ _ _ = toEncoding . unK1
809639
810−instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
640+instance GToEncoding One Par1 where
641+ -- Direct occurrences of the last type parameter are encoded with the
642+ -- function passed in as an argument:
643+ gToEncoding _opts _ te _ = te . unPar1
644+
645+instance (ToJSON1 f) => GToEncoding One (Rec1 f) where
811646 -- Recursive occurrences of the last type parameter are encoded using their
812647 -- ToEncoding1 instance:
813− gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814− {-# INLINE gToJSON #-}
648+ gToEncoding _opts _ te tel = liftToEncoding te tel . unRec1
815649
816−instance GToJSON Encoding arity U1 where
650+instance GToEncoding arity U1 where
817651 -- Empty constructors are encoded to an empty array:
818− gToJSON _opts _ _ = E.emptyArray_
819− {-# INLINE gToJSON #-}
652+ gToEncoding _opts _ _ _ _ = E.emptyArray_
653+
654+instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where
655+ -- Constructors need to be encoded differently depending on whether they're
656+ -- a record or not. This distinction is made by 'consToEncoding':
657+ gToEncoding opts pa te tel = consToEncoding opts pa te tel . unM1
820658
821659instance ( EncodeProduct arity a
822660 , EncodeProduct arity b
823− ) => GToJSON Encoding arity (a :*: b)
824− where
661+ ) => GToEncoding arity (a :*: b) where
825662 -- Products are encoded to an array. Here we allocate a mutable vector of
826663 -- the same size as the product and write the product's elements to it using
827664 -- 'encodeProduct':
828− gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
829− {-# INLINE gToJSON #-}
665+ gToEncoding opts pa te tel p = E.tuple $ encodeProduct opts pa te tel p
666+
667+instance ( AllNullary (a :+: b) allNullary
668+ , SumToEncoding arity (a :+: b) allNullary
669+ ) => GToEncoding arity (a :+: b) where
670+ -- If all constructors of a sum datatype are nullary and the
671+ -- 'allNullaryToStringTag' option is set they are encoded to
672+ -- strings. This distinction is made by 'sumToEncoding':
673+ gToEncoding opts pa te tel
674+ = (unTagged :: Tagged allNullary (Encoding) -> Encoding)
675+ . sumToEncoding opts pa te tel
830676
831−instance ( ToJSON1 f
832− , GToJSON Encoding One g
833− ) => GToJSON Encoding One (f :.: g)
834− where
677+instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where
835678 -- If an occurrence of the last type parameter is nested inside two
836679 -- composed types, it is encoded by using the outermost type's ToJSON1
837680 -- instance to generically encode the innermost type:
838− gToJSON opts targs =
839− let gte = gToJSON opts targs in
681+ gToEncoding opts pa te tel =
682+ let gte = gToEncoding opts pa te tel in
840683 liftToEncoding gte (listEncoding gte) . unComp1
841− {-# INLINE gToJSON #-}
842684
843685--------------------------------------------------------------------------------
844686
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
687+class SumToJSON arity f allNullary where
688+ sumToJSON :: Options -> Proxy arity
689+ -> (a -> Value) -> ([a] -> Value)
690+ -> f a -> Tagged allNullary Value
691+
692+instance ( GetConName f
693+ , TaggedObjectPairs arity f
694+ , ObjectWithSingleFieldObj arity f
695+ , TwoElemArrayObj arity f
696+ ) => SumToJSON arity f True where
697+ sumToJSON opts pa tj tjl
698+ | allNullaryToStringTag opts = Tagged . String . pack
859699 . constructorTagModifier opts . getConName
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 =
700+ | otherwise = Tagged . nonAllNullarySumToJSON opts pa tj tjl
701+
702+instance ( TwoElemArrayObj arity f
703+ , TaggedObjectPairs arity f
704+ , ObjectWithSingleFieldObj arity f
705+ ) => SumToJSON arity f False where
706+ sumToJSON opts pa tj tjl = Tagged . nonAllNullarySumToJSON opts pa tj tjl
707+
708+nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f
709+ , TaggedObjectPairs arity f
710+ , ObjectWithSingleFieldObj arity f
711+ ) => Options -> Proxy arity
712+ -> (a -> Value) -> ([a] -> Value)
713+ -> f a -> Value
714+nonAllNullarySumToJSON opts pa tj tjl =
877715 case sumEncoding opts of
878−
879716 TaggedObject{..} ->
880− taggedObject opts targs tagFieldName contentsFieldName
881−
882− ObjectWithSingleField ->
883− (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884− . sumToJSON' opts targs
717+ object . taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl
718+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts pa tj tjl
719+ TwoElemArray -> Array . twoElemArrayObj opts pa tj tjl
885720
886− TwoElemArray ->
887− (unTagged :: Tagged TwoElemArray enc -> enc)
888− . sumToJSON' opts targs
721+--------------------------------------------------------------------------------
889722
890− UntaggedValue ->
891− (unTagged :: Tagged UntaggedValue enc -> enc)
892− . sumToJSON' opts targs
723+class SumToEncoding arity f allNullary where
724+ sumToEncoding :: Options -> Proxy arity
725+ -> (a -> Encoding) -> ([a] -> Encoding)
726+ -> f a -> Tagged allNullary (Encoding)
727+
728+instance ( GetConName f
729+ , TaggedObjectEnc arity f
730+ , ObjectWithSingleFieldEnc arity f
731+ , TwoElemArrayEnc arity f
732+ ) => SumToEncoding arity f True where
733+ sumToEncoding opts pa te tel
734+ | allNullaryToStringTag opts = Tagged . toEncoding .
735+ constructorTagModifier opts . getConName
736+ | otherwise = Tagged . nonAllNullarySumToEncoding opts pa te tel
737+
738+instance ( TwoElemArrayEnc arity f
739+ , TaggedObjectEnc arity f
740+ , ObjectWithSingleFieldEnc arity f
741+ ) => SumToEncoding arity f False where
742+ sumToEncoding opts pa te tel = Tagged . nonAllNullarySumToEncoding opts pa te tel
743+
744+nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f
745+ , TaggedObjectEnc arity f
746+ , ObjectWithSingleFieldEnc arity f
747+ ) => Options -> Proxy arity
748+ -> (a -> Encoding) -> ([a] -> Encoding)
749+ -> f a -> Encoding
750+nonAllNullarySumToEncoding opts pa te tel =
751+ case sumEncoding opts of
752+ TaggedObject{..} ->
753+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel
754+ ObjectWithSingleField -> objectWithSingleFieldEnc opts pa te tel
755+ TwoElemArray -> twoElemArrayEnc opts pa te tel
893756
894757--------------------------------------------------------------------------------
895758
896−class FromString enc where
897− fromString :: String -> enc
759+class TaggedObjectPairs arity f where
760+ taggedObjectPairs :: Options -> Proxy arity
761+ -> String -> String
762+ -> (a -> Value) -> ([a] -> Value)
763+ -> f a -> [Pair]
764+
765+instance ( TaggedObjectPairs arity a
766+ , TaggedObjectPairs arity b
767+ ) => TaggedObjectPairs arity (a :+: b) where
768+ taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (L1 x) =
769+ taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x
770+ taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (R1 x) =
771+ taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x
772+
773+instance ( IsRecord a isRecord
774+ , TaggedObjectPairs' arity a isRecord
775+ , Constructor c
776+ ) => TaggedObjectPairs arity (C1 c a) where
777+ taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl =
778+ (pack tagFieldName .= constructorTagModifier opts
779+ (conName (undefined :: t c a p)) :) .
780+ (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
781+ taggedObjectPairs' opts pa contentsFieldName tj tjl . unM1
782+
783+class TaggedObjectPairs' arity f isRecord where
784+ taggedObjectPairs' :: Options -> Proxy arity
785+ -> String -> (a -> Value) -> ([a] -> Value)
786+ -> f a -> Tagged isRecord [Pair]
787+
788+instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where
789+ taggedObjectPairs' _ _ _ _ _ _ = Tagged []
898790
899−instance FromString Encoding where
900− fromString = toEncoding
791+instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where
792+ taggedObjectPairs' opts pa _ tj tjl =
793+ Tagged . toList . recordToPairs opts pa tj tjl
901794
902−instance FromString Value where
903− fromString = String . pack
795+instance (GToJSON arity f) => TaggedObjectPairs' arity f False where
796+ taggedObjectPairs' opts pa contentsFieldName tj tjl =
797+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts pa tj tjl
904798
905799--------------------------------------------------------------------------------
906800
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
801+class TaggedObjectEnc arity f where
802+ taggedObjectEnc :: Options -> Proxy arity
803+ -> String -> String
804+ -> (a -> Encoding) -> ([a] -> Encoding)
805+ -> f a -> Encoding
806+
807+instance ( TaggedObjectEnc arity a
808+ , TaggedObjectEnc arity b
809+ ) => TaggedObjectEnc arity (a :+: b) where
810+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (L1 x) =
811+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x
812+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (R1 x) =
813+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x
814+
815+instance ( IsRecord a isRecord
816+ , TaggedObjectEnc' arity a isRecord
926817 , Constructor c
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
818+ ) => TaggedObjectEnc arity (C1 c a) where
819+ taggedObjectEnc opts pa tagFieldName contentsFieldName te tel v =
820+ E.wrapObject $
821+ (E.string tagFieldName ><
822+ E.colon ><
823+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) ><
824+ ((unTagged :: Tagged isRecord (Encoding) -> Encoding) .
825+ taggedObjectEnc' opts pa contentsFieldName te tel . unM1 $ v)
826+
827+class TaggedObjectEnc' arity f isRecord where
828+ taggedObjectEnc' :: Options -> Proxy arity
829+ -> String -> (a -> Encoding) -> ([a] -> Encoding)
830+ -> f a -> Tagged isRecord (Encoding)
831+
832+instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where
833+ taggedObjectEnc' _ _ _ _ _ _ = Tagged E.empty
834+
835+instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where
836+ taggedObjectEnc' opts pa _ te tel = Tagged . (E.comma ><) . fst
837+ . recordToEncoding opts pa te tel
838+
839+instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where
840+ taggedObjectEnc' opts pa contentsFieldName te tel =
841+ Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .
842+ gToEncoding opts pa te tel
957843
958844--------------------------------------------------------------------------------
959845
@@ -968,242 +854,283 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where
968854instance (Constructor c) => GetConName (C1 c a) where
969855 getConName = conName
970856
971−-- For genericToJSONKey
972−instance GetConName a => GetConName (D1 d a) where
973− getConName (M1 x) = getConName x
974−
975857--------------------------------------------------------------------------------
976858
977−-- Reflection of SumEncoding variants
859+class TwoElemArrayObj arity f where
860+ twoElemArrayObj :: Options -> Proxy arity
861+ -> (a -> Value) -> ([a] -> Value)
862+ -> f a -> V.Vector Value
978863
979−data ObjectWithSingleField
980−data TwoElemArray
981−data UntaggedValue
864+instance ( TwoElemArrayObj arity a
865+ , TwoElemArrayObj arity b
866+ ) => TwoElemArrayObj arity (a :+: b) where
867+ twoElemArrayObj opts pa tj tjl (L1 x) = twoElemArrayObj opts pa tj tjl x
868+ twoElemArrayObj opts pa tj tjl (R1 x) = twoElemArrayObj opts pa tj tjl x
982869
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
870+instance ( GToJSON arity a
871+ , ConsToJSON arity a
1000872 , Constructor c
1001− ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
1002− sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
873+ ) => TwoElemArrayObj arity (C1 c a) where
874+ twoElemArrayObj opts pa tj tjl x = V.create $ do
1003875 mv <- VM.unsafeNew 2
1004876 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
1005877 $ conName (undefined :: t c a p)
1006− VM.unsafeWrite mv 1 $ gToJSON opts targs x
878+ VM.unsafeWrite mv 1 $ gToJSON opts pa tj tjl x
1007879 return mv
1008880
1009881--------------------------------------------------------------------------------
1010882
1011−instance ( GToJSON Encoding arity a
1012− , ConsToJSON Encoding arity a
883+class TwoElemArrayEnc arity f where
884+ twoElemArrayEnc :: Options -> Proxy arity
885+ -> (a -> Encoding) -> ([a] -> Encoding)
886+ -> f a -> Encoding
887+
888+instance ( TwoElemArrayEnc arity a
889+ , TwoElemArrayEnc arity b
890+ ) => TwoElemArrayEnc arity (a :+: b) where
891+ twoElemArrayEnc opts pa te tel (L1 x) = twoElemArrayEnc opts pa te tel x
892+ twoElemArrayEnc opts pa te tel (R1 x) = twoElemArrayEnc opts pa te tel x
893+
894+instance ( GToEncoding arity a
895+ , ConsToEncoding arity a
1013896 , Constructor c
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− ]
897+ ) => TwoElemArrayEnc arity (C1 c a) where
898+ twoElemArrayEnc opts pa te tel x = E.tuple $
899+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
900+ gToEncoding opts pa te tel x
901+
902+--------------------------------------------------------------------------------
903+
904+class ConsToJSON arity f where
905+ consToJSON :: Options -> Proxy arity
906+ -> (a -> Value) -> ([a] -> Value)
907+ -> f a -> Value
908+
909+class ConsToJSON' arity f isRecord where
910+ consToJSON' :: Options -> Proxy arity
911+ -> Bool -- ^ Are we a record with one field?
912+ -> (a -> Value) -> ([a] -> Value)
913+ -> f a -> Tagged isRecord Value
914+
915+instance ( IsRecord f isRecord
916+ , ConsToJSON' arity f isRecord
917+ ) => ConsToJSON arity f where
918+ consToJSON opts pa tj tjl =
919+ (unTagged :: Tagged isRecord Value -> Value)
920+ . consToJSON' opts pa (isUnary (undefined :: f a)) tj tjl
921+
922+instance (RecordToPairs arity f) => ConsToJSON' arity f True where
923+ consToJSON' opts pa isUn tj tjl f = let
924+ vals = toList $ recordToPairs opts pa tj tjl f
925+ in case (unwrapUnaryRecords opts,isUn,vals) of
926+ (True,True,[(_,val)]) -> Tagged val
927+ _ -> Tagged $ object vals
928+
929+instance GToJSON arity f => ConsToJSON' arity f False where
930+ consToJSON' opts pa _ tj tjl = Tagged . gToJSON opts pa tj tjl
1020931
1021932--------------------------------------------------------------------------------
1022933
1023−class ConsToJSON enc arity f where
1024− consToJSON :: Options -> ToArgs enc arity a
1025− -> f a -> enc
934+class ConsToEncoding arity f where
935+ consToEncoding :: Options -> Proxy arity
936+ -> (a -> Encoding) -> ([a] -> Encoding)
937+ -> f a -> Encoding
1026938
1027−class ConsToJSON' enc arity f isRecord where
1028− consToJSON' :: Options -> ToArgs enc arity a
1029− -> f a -> Tagged isRecord enc
939+class ConsToEncoding' arity f isRecord where
940+ consToEncoding' :: Options -> Proxy arity
941+ -> Bool -- ^ Are we a record with one field?
942+ -> (a -> Encoding) -> ([a] -> Encoding)
943+ -> f a -> Tagged isRecord (Encoding)
1030944
1031945instance ( IsRecord f isRecord
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' #-}
946+ , ConsToEncoding' arity f isRecord
947+ ) => ConsToEncoding arity f where
948+ consToEncoding opts pa te tel =
949+ (unTagged :: Tagged isRecord (Encoding) -> (Encoding))
950+ . consToEncoding' opts pa (isUnary (undefined :: f a)) te tel
951+
952+instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where
953+ consToEncoding' opts pa isUn te tel x =
954+ let (enc, mbVal) = recordToEncoding opts pa te tel x
955+ in case (unwrapUnaryRecords opts, isUn, mbVal) of
956+ (True, True, Just val) -> Tagged val
957+ _ -> Tagged $ E.wrapObject enc
958+
959+instance GToEncoding arity f => ConsToEncoding' arity f False where
960+ consToEncoding' opts pa _ te tel = Tagged . gToEncoding opts pa te tel
961+
962+--------------------------------------------------------------------------------
963+
964+class RecordToPairs arity f where
965+ recordToPairs :: Options -> Proxy arity
966+ -> (a -> Value) -> ([a] -> Value)
967+ -> f a -> DList Pair
968+
969+instance ( RecordToPairs arity a
970+ , RecordToPairs arity b
971+ ) => RecordToPairs arity (a :*: b) where
972+ recordToPairs opts pa tj tjl (a :*: b) = recordToPairs opts pa tj tjl a <>
973+ recordToPairs opts pa tj tjl b
974+
975+instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where
976+ recordToPairs = fieldToPair
977+
978+instance OVERLAPPING_ (Selector s, ToJSON a) =>
979+ RecordToPairs arity (S1 s (K1 i (Maybe a))) where
980+ recordToPairs opts _ _ _ (M1 k1) | omitNothingFields opts
981+ , K1 Nothing <- k1 = DList.empty
982+ recordToPairs opts pa tj tjl m1 = fieldToPair opts pa tj tjl m1
983+
984+fieldToPair :: (Selector s, GToJSON arity a)
985+ => Options -> Proxy arity
986+ -> (p -> Value) -> ([p] -> Value)
987+ -> S1 s a p -> DList Pair
988+fieldToPair opts pa tj tjl m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
989+ , gToJSON opts pa tj tjl (unM1 m1)
990+ )
1061991
1062992--------------------------------------------------------------------------------
1063993
1064−class RecordToPairs enc pairs arity f where
994+class RecordToEncoding arity f where
1065995 -- 1st element: whole thing
1066996 -- 2nd element: in case the record has only 1 field, just the value
1067997 -- of the field (without the key); 'Nothing' otherwise
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 #-}
998+ recordToEncoding :: Options -> Proxy arity
999+ -> (a -> Encoding) -> ([a] -> Encoding)
1000+ -> f a -> (Encoding, Maybe (Encoding))
1001+
1002+instance ( RecordToEncoding arity a
1003+ , RecordToEncoding arity b
1004+ ) => RecordToEncoding arity (a :*: b) where
1005+ recordToEncoding opts pa te tel (a :*: b) | omitNothingFields opts =
1006+ (E.econcat $ intersperse E.comma $
1007+ filter (not . E.nullEncoding)
1008+ [ fst (recordToEncoding opts pa te tel a)
1009+ , fst (recordToEncoding opts pa te tel b) ]
1010+ , Nothing)
1011+ recordToEncoding opts pa te tel (a :*: b) =
1012+ (fst (recordToEncoding opts pa te tel a) >< E.comma ><
1013+ fst (recordToEncoding opts pa te tel b),
1014+ Nothing)
1015+
1016+
1017+instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) where
1018+ recordToEncoding = fieldToEncoding
1019+
1020+instance OVERLAPPING_ (Selector s, ToJSON a) =>
1021+ RecordToEncoding arity (S1 s (K1 i (Maybe a))) where
1022+ recordToEncoding opts _ _ _ (M1 k1) | omitNothingFields opts
1023+ , K1 Nothing <- k1 = (E.empty, Nothing)
1024+ recordToEncoding opts pa te tel m1 = fieldToEncoding opts pa te tel m1
1025+
1026+fieldToEncoding :: (Selector s, GToEncoding arity a)
1027+ => Options -> Proxy arity
1028+ -> (p -> Encoding) -> ([p] -> Encoding)
1029+ -> S1 s a p -> (Encoding, Maybe (Encoding))
1030+fieldToEncoding opts pa te tel m1 =
1031+ let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
1032+ valueBuilder = gToEncoding opts pa te tel (unM1 m1)
1033+ in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)
11261034
11271035--------------------------------------------------------------------------------
11281036
11291037class WriteProduct arity f where
11301038 writeProduct :: Options
1131− -> ToArgs Value arity a
1039+ -> Proxy arity
11321040 -> VM.MVector s Value
11331041 -> Int -- ^ index
11341042 -> Int -- ^ length
1043+ -> (a -> Value)
1044+ -> ([a] -> Value)
11351045 -> f a
11361046 -> ST s ()
11371047
11381048instance ( WriteProduct arity a
11391049 , WriteProduct arity b
11401050 ) => WriteProduct arity (a :*: b) where
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
1051+ writeProduct opts pa mv ix len tj tjl (a :*: b) = do
1052+ writeProduct opts pa mv ix lenL tj tjl a
1053+ writeProduct opts pa mv ixR lenR tj tjl b
11441054 where
11451055 lenL = len `unsafeShiftR` 1
11461056 lenR = len - lenL
11471057 ixR = ix + lenL
1148− {-# INLINE writeProduct #-}
11491058
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 #-}
1059+instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
1060+ writeProduct opts pa mv ix _ tj tjl =
1061+ VM.unsafeWrite mv ix . gToJSON opts pa tj tjl
11541062
11551063--------------------------------------------------------------------------------
11561064
11571065class EncodeProduct arity f where
1158− encodeProduct :: Options -> ToArgs Encoding arity a
1066+ encodeProduct :: Options -> Proxy arity
1067+ -> (a -> Encoding) -> ([a] -> Encoding)
11591068 -> f a -> Encoding' E.InArray
11601069
11611070instance ( EncodeProduct arity a
11621071 , EncodeProduct arity b
11631072 ) => EncodeProduct arity (a :*: b) where
1164− encodeProduct opts targs (a :*: b) | omitNothingFields opts =
1073+ encodeProduct opts pa te tel (a :*: b) | omitNothingFields opts =
11651074 E.econcat $ intersperse E.comma $
11661075 filter (not . E.nullEncoding)
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 #-}
1076+ [encodeProduct opts pa te tel a, encodeProduct opts pa te tel b]
1077+ encodeProduct opts pa te tel (a :*: b) = encodeProduct opts pa te tel a >*<
1078+ encodeProduct opts pa te tel b
11721079
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 #-}
1080+instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1081+ encodeProduct opts pa te tel a = E.retagEncoding $ gToEncoding opts pa te tel a
11761082
11771083--------------------------------------------------------------------------------
11781084
1179−instance ( GToJSON enc arity a
1180− , ConsToJSON enc arity a
1181− , FromPairs enc pairs
1182− , KeyValuePair enc pairs
1085+class ObjectWithSingleFieldObj arity f where
1086+ objectWithSingleFieldObj :: Options -> Proxy arity
1087+ -> (a -> Value) -> ([a] -> Value)
1088+ -> f a -> Object
1089+
1090+instance ( ObjectWithSingleFieldObj arity a
1091+ , ObjectWithSingleFieldObj arity b
1092+ ) => ObjectWithSingleFieldObj arity (a :+: b) where
1093+ objectWithSingleFieldObj opts pa tj tjl (L1 x) =
1094+ objectWithSingleFieldObj opts pa tj tjl x
1095+ objectWithSingleFieldObj opts pa tj tjl (R1 x) =
1096+ objectWithSingleFieldObj opts pa tj tjl x
1097+
1098+instance ( GToJSON arity a
1099+ , ConsToJSON arity a
11831100 , Constructor c
1184− ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1185− where
1186− sumToJSON' opts targs =
1187− Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
1101+ ) => ObjectWithSingleFieldObj arity (C1 c a) where
1102+ objectWithSingleFieldObj opts pa tj tjl = H.singleton typ . gToJSON opts pa tj tjl
11881103 where
1189− typ = constructorTagModifier opts $
1104+ typ = pack $ constructorTagModifier opts $
11901105 conName (undefined :: t c a p)
11911106
11921107--------------------------------------------------------------------------------
11931108
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)
1109+class ObjectWithSingleFieldEnc arity f where
1110+ objectWithSingleFieldEnc :: Options -> Proxy arity
1111+ -> (a -> Encoding) -> ([a] -> Encoding)
1112+ -> f a -> Encoding
1113+
1114+instance ( ObjectWithSingleFieldEnc arity a
1115+ , ObjectWithSingleFieldEnc arity b
1116+ ) => ObjectWithSingleFieldEnc arity (a :+: b) where
1117+ objectWithSingleFieldEnc opts pa te tel (L1 x) =
1118+ objectWithSingleFieldEnc opts pa te tel x
1119+ objectWithSingleFieldEnc opts pa te tel (R1 x) =
1120+ objectWithSingleFieldEnc opts pa te tel x
1121+
1122+instance ( GToEncoding arity a
1123+ , ConsToEncoding arity a
1124+ , Constructor c
1125+ ) => ObjectWithSingleFieldEnc arity (C1 c a) where
1126+ objectWithSingleFieldEnc opts pa te tel v =
1127+ E.openCurly ><
1128+ toEncoding
1129+ (constructorTagModifier opts
1130+ (conName (undefined :: t c a p))) ><
1131+ E.colon ><
1132+ gToEncoding opts pa te tel v ><
1133+ E.closeCurly
12071134
12081135-------------------------------------------------------------------------------
12091136-- Instances
@@ -1213,6 +1140,21 @@ instance OVERLAPPING_
12131140-- base
12141141-------------------------------------------------------------------------------
12151142
1143+instance ToJSON1 Identity where
1144+ liftToJSON t _ (Identity a) = t a
1145+ {-# INLINE liftToJSON #-}
1146+
1147+ liftToEncoding t _ (Identity a) = t a
1148+ {-# INLINE liftToEncoding #-}
1149+
1150+instance (ToJSON a) => ToJSON (Identity a) where
1151+ toJSON = toJSON1
1152+ {-# INLINE toJSON #-}
1153+
1154+ toEncoding = toEncoding1
1155+ {-# INLINE toEncoding #-}
1156+
1157+
12161158instance ToJSON2 Const where
12171159 liftToJSON2 t _ _ _ (Const x) = t x
12181160 {-# INLINE liftToJSON2 #-}
@@ -1253,8 +1195,8 @@ instance (ToJSON a) => ToJSON (Maybe a) where
12531195
12541196
12551197instance ToJSON2 Either where
1256− liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton "Left" (toA a)
1257− liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton "Right" (toB b)
1198+ liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton left (toA a)
1199+ liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton right (toB b)
12581200 {-# INLINE liftToJSON2 #-}
12591201
12601202 liftToEncoding2 toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a
@@ -1276,12 +1218,9 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
12761218 toEncoding = toEncoding2
12771219 {-# INLINE toEncoding #-}
12781220
1279−instance ToJSON Void where
1280− toJSON = absurd
1281− {-# INLINE toJSON #-}
1282−
1283− toEncoding = absurd
1284− {-# INLINE toEncoding #-}
1221+left, right :: Text
1222+left = "Left"
1223+right = "Right"
12851224
12861225
12871226instance ToJSON Bool where
@@ -1292,7 +1231,10 @@ instance ToJSON Bool where
12921231 {-# INLINE toEncoding #-}
12931232
12941233instance ToJSONKey Bool where
1295− toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"
1234+ toJSONKey = ToJSONKeyText
1235+ ( (\x -> if x then "true" else "false")
1236+ , (\x -> E.text $ if x then "true"else "false")
1237+ )
12961238
12971239
12981240instance ToJSON Ordering where
@@ -1468,6 +1410,7 @@ instance ToJSONKey Int64 where
14681410 toJSONKey = toJSONKeyTextEnc E.int64Text
14691411 {-# INLINE toJSONKey #-}
14701412
1413+
14711414instance ToJSON Word where
14721415 toJSON = Number . fromIntegral
14731416 {-# INLINE toJSON #-}
@@ -1527,12 +1470,6 @@ instance ToJSONKey Word64 where
15271470 toJSONKey = toJSONKeyTextEnc E.word64Text
15281471 {-# INLINE toJSONKey #-}
15291472
1530−instance ToJSON CTime where
1531− toJSON (CTime i) = toJSON i
1532− {-# INLINE toJSON #-}
1533−
1534− toEncoding (CTime i) = toEncoding i
1535− {-# INLINE toEncoding #-}
15361473
15371474instance ToJSON Text where
15381475 toJSON = String
@@ -1542,10 +1479,9 @@ instance ToJSON Text where
15421479 {-# INLINE toEncoding #-}
15431480
15441481instance ToJSONKey Text where
1545− toJSONKey = toJSONKeyText id
1482+ toJSONKey = ToJSONKeyText (id, E.text)
15461483 {-# INLINE toJSONKey #-}
15471484
1548−
15491485instance ToJSON LT.Text where
15501486 toJSON = String . LT.toStrict
15511487 {-# INLINE toJSON #-}
@@ -1553,10 +1489,6 @@ instance ToJSON LT.Text where
15531489 toEncoding = E.lazyText
15541490 {-# INLINE toEncoding #-}
15551491
1556−instance ToJSONKey LT.Text where
1557− toJSONKey = toJSONKeyText LT.toStrict
1558−
1559−
15601492instance ToJSON Version where
15611493 toJSON = toJSON . showVersion
15621494 {-# INLINE toJSON #-}
@@ -1564,9 +1496,6 @@ instance ToJSON Version where
15641496 toEncoding = toEncoding . showVersion
15651497 {-# INLINE toEncoding #-}
15661498
1567−instance ToJSONKey Version where
1568− toJSONKey = toJSONKeyText (T.pack . showVersion)
1569−
15701499-------------------------------------------------------------------------------
15711500-- semigroups NonEmpty
15721501-------------------------------------------------------------------------------
@@ -1617,116 +1546,6 @@ instance (ToJSON a) => ToJSON (DList.DList a) where
16171546 toEncoding = toEncoding1
16181547 {-# INLINE toEncoding #-}
16191548
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−
17301549-------------------------------------------------------------------------------
17311550-- containers
17321551-------------------------------------------------------------------------------
@@ -1792,15 +1611,17 @@ instance ToJSON a => ToJSON (IntMap.IntMap a) where
17921611
17931612instance ToJSONKey k => ToJSON1 (M.Map k) where
17941613 liftToJSON g _ = case toJSONKey of
1795− ToJSONKeyText f _ -> Object . mapHashKeyVal f g
1796− ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1614+ ToJSONKeyText (f,_) -> Object . mapHashKeyVal f g
1615+ ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . M.toList
17971616 {-# INLINE liftToJSON #-}
17981617
1618+ -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
17991619 liftToEncoding g _ = case toJSONKey of
1800− ToJSONKeyText _ f -> dict f g M.foldrWithKey
1801− ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1620+ ToJSONKeyText (_,f) -> dict f g M.foldrWithKey
1621+ ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . M.toList
18021622 where
1803− pairEncoding f (a, b) = E.list id [f a, g b]
1623+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1624+ pairEncoding f (a, b) = tuple $ f a >*< g b
18041625 {-# INLINE liftToEncoding #-}
18051626
18061627
@@ -1838,17 +1659,6 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
18381659 toEncoding = toEncoding1
18391660 {-# INLINE toEncoding #-}
18401661
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
18521662
18531663-------------------------------------------------------------------------------
18541664-- vector
@@ -1862,12 +1672,10 @@ instance ToJSON1 Vector where
18621672 {-# INLINE liftToEncoding #-}
18631673
18641674instance (ToJSON a) => ToJSON (Vector a) where
1865− {-# SPECIALIZE instance ToJSON Array #-}
1866−
1867− toJSON = toJSON1
1675+ toJSON = Array . V.map toJSON
18681676 {-# INLINE toJSON #-}
18691677
1870− toEncoding = toEncoding1
1678+ toEncoding = encodeVector
18711679 {-# INLINE toEncoding #-}
18721680
18731681encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
@@ -1922,21 +1730,20 @@ instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
19221730
19231731instance ToJSONKey k => ToJSON1 (H.HashMap k) where
19241732 liftToJSON g _ = case toJSONKey of
1925− ToJSONKeyText f _ -> Object . mapKeyVal f g
1926− ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList
1733+ ToJSONKeyText (f,_) -> Object . mapKeyVal f g
1734+ ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . H.toList
19271735 {-# INLINE liftToJSON #-}
19281736
19291737 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
19301738 liftToEncoding g _ = case toJSONKey of
1931− ToJSONKeyText _ f -> dict f g H.foldrWithKey
1932− ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1739+ ToJSONKeyText (_,f) -> dict f g H.foldrWithKey
1740+ ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . H.toList
19331741 where
1934− pairEncoding f (a, b) = E.list id [f a, g b]
1742+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1743+ pairEncoding f (a, b) = tuple $ f a >*< g b
19351744 {-# INLINE liftToEncoding #-}
19361745
19371746instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938− {-# SPECIALIZE instance ToJSON Object #-}
1939−
19401747 toJSON = toJSON1
19411748 {-# INLINE toJSON #-}
19421749
@@ -1966,32 +1773,6 @@ dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
19661773formatMillis :: (FormatTime t) => t -> String
19671774formatMillis = take 3 . formatTime defaultTimeLocale "%q"
19681775
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−
19951776-------------------------------------------------------------------------------
19961777-- time
19971778-------------------------------------------------------------------------------
@@ -2044,7 +1825,6 @@ stringEncoding = String
20441825 . E.encodingToLazyByteString
20451826{-# INLINE stringEncoding #-}
20461827
2047−
20481828instance ToJSON NominalDiffTime where
20491829 toJSON = Number . realToFrac
20501830 {-# INLINE toJSON #-}
@@ -2052,85 +1832,18 @@ instance ToJSON NominalDiffTime where
20521832 toEncoding = E.scientific . realToFrac
20531833 {-# INLINE toEncoding #-}
20541834
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−
21071835-------------------------------------------------------------------------------
21081836-- base Monoid/Semigroup
21091837-------------------------------------------------------------------------------
21101838
2111−instance ToJSON1 Monoid.Dual where
2112− liftToJSON t _ = t . Monoid.getDual
2113− {-# INLINE liftToJSON #-}
2114−
2115− liftToEncoding t _ = t . Monoid.getDual
2116− {-# INLINE liftToEncoding #-}
2117−
2118−instance ToJSON a => ToJSON (Monoid.Dual a) where
2119− toJSON = toJSON1
2120− {-# INLINE toJSON #-}
2121−
2122− toEncoding = toEncoding1
2123− {-# INLINE toEncoding #-}
2124−
2125−
2126−instance ToJSON1 Monoid.First where
2127− liftToJSON t to' = liftToJSON t to' . Monoid.getFirst
1839+instance ToJSON1 Dual where
1840+ liftToJSON t _ = t . getDual
21281841 {-# INLINE liftToJSON #-}
21291842
2130− liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
1843+ liftToEncoding t _ = t . getDual
21311844 {-# INLINE liftToEncoding #-}
21321845
2133−instance ToJSON a => ToJSON (Monoid.First a) where
1846+instance ToJSON a => ToJSON (Dual a) where
21341847 toJSON = toJSON1
21351848 {-# INLINE toJSON #-}
21361849
@@ -2138,14 +1851,14 @@ instance ToJSON a => ToJSON (Monoid.First a) where
21381851 {-# INLINE toEncoding #-}
21391852
21401853
2141−instance ToJSON1 Monoid.Last where
2142− liftToJSON t to' = liftToJSON t to' . Monoid.getLast
1854+instance ToJSON1 First where
1855+ liftToJSON t to' = liftToJSON t to' . getFirst
21431856 {-# INLINE liftToJSON #-}
21441857
2145− liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
1858+ liftToEncoding t to' = liftToEncoding t to' . getFirst
21461859 {-# INLINE liftToEncoding #-}
21471860
2148−instance ToJSON a => ToJSON (Monoid.Last a) where
1861+instance ToJSON a => ToJSON (First a) where
21491862 toJSON = toJSON1
21501863 {-# INLINE toJSON #-}
21511864
@@ -2153,88 +1866,14 @@ instance ToJSON a => ToJSON (Monoid.Last a) where
21531866 {-# INLINE toEncoding #-}
21541867
21551868
2156−instance ToJSON1 Semigroup.Min where
2157− liftToJSON t _ (Semigroup.Min x) = t x
1869+instance ToJSON1 Last where
1870+ liftToJSON t to' = liftToJSON t to' . getLast
21581871 {-# INLINE liftToJSON #-}
21591872
2160− liftToEncoding t _ (Semigroup.Min x) = t x
1873+ liftToEncoding t to' = liftToEncoding t to' . getLast
21611874 {-# INLINE liftToEncoding #-}
21621875
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
1876+instance ToJSON a => ToJSON (Last a) where
22381877 toJSON = toJSON1
22391878 {-# INLINE toJSON #-}
22401879
@@ -2245,13 +1884,6 @@ instance ToJSON a => ToJSON (Semigroup.Option a) where
22451884-- tagged
22461885-------------------------------------------------------------------------------
22471886
2248−instance ToJSON1 Proxy where
2249− liftToJSON _ _ _ = Null
2250− {-# INLINE liftToJSON #-}
2251−
2252− liftToEncoding _ _ _ = E.null_
2253− {-# INLINE liftToEncoding #-}
2254−
22551887instance ToJSON (Proxy a) where
22561888 toJSON _ = Null
22571889 {-# INLINE toJSON #-}
@@ -2260,13 +1892,6 @@ instance ToJSON (Proxy a) where
22601892 {-# INLINE toEncoding #-}
22611893
22621894
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−
22701895instance ToJSON1 (Tagged a) where
22711896 liftToJSON t _ (Tagged x) = t x
22721897 {-# INLINE liftToJSON #-}
@@ -2281,6 +1906,7 @@ instance ToJSON b => ToJSON (Tagged a b) where
22811906 toEncoding = toEncoding1
22821907 {-# INLINE toEncoding #-}
22831908
1909+
22841910instance ToJSONKey b => ToJSONKey (Tagged a b) where
22851911 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
22861912 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
@@ -2289,22 +1915,34 @@ instance ToJSONKey b => ToJSONKey (Tagged a b) where
22891915-- Instances for converting t map keys
22901916-------------------------------------------------------------------------------
22911917
1918+-- | TODO: Move ToJSONKEyFunction to .Types(.Internal),
1919+-- export and document this function from there
1920+toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a
1921+toJSONKeyTextEnc e = ToJSONKeyText
1922+ -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
1923+ ( T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . E.encodingToLazyByteString . e
1924+ , e
1925+ )
1926+
22921927instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
22931928instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
22941929instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
22951930
22961931instance ToJSONKey Char where
2297− toJSONKey = ToJSONKeyText T.singleton (E.string . (:[]))
2298− toJSONKeyList = toJSONKeyText T.pack
1932+ toJSONKey = ToJSONKeyText (T.singleton, E.string . (:[]))
1933+ toJSONKeyList = ToJSONKeyText (T.pack, E.text . T.pack)
22991934
23001935instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
23011936 toJSONKey = toJSONKeyList
23021937
1938+instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1939+ toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1940+
23031941-------------------------------------------------------------------------------
2304−-- Tuple instances
1942+-- Tuple instances, see tuple-instances-to.hs
23051943-------------------------------------------------------------------------------
23061944
2307−instance ToJSON2 (,) where
1945+instance ToJSON2 ((,) ) where
23081946 liftToJSON2 toA _ toB _ (a, b) = Array $ V.create $ do
23091947 mv <- VM.unsafeNew 2
23101948 VM.unsafeWrite mv 0 (toA a)
@@ -2312,7 +1950,9 @@ instance ToJSON2 (,) where
23121950 return mv
23131951 {-# INLINE liftToJSON2 #-}
23141952
2315− liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
1953+ liftToEncoding2 toA _ toB _ (a, b) = tuple $
1954+ toA a >*<
1955+ toB b
23161956 {-# INLINE liftToEncoding2 #-}
23171957
23181958instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -2336,11 +1976,10 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
23361976 return mv
23371977 {-# INLINE liftToJSON2 #-}
23381978
2339− liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2340− [ toEncoding a
2341− , toB b
2342− , toC c
2343− ]
1979+ liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
1980+ toEncoding a >*<
1981+ toB b >*<
1982+ toC c
23441983 {-# INLINE liftToEncoding2 #-}
23451984
23461985instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -2365,12 +2004,11 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
23652004 return mv
23662005 {-# INLINE liftToJSON2 #-}
23672006
2368− liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2369− [ toEncoding a
2370− , toEncoding b
2371− , toC c
2372− , toD d
2373− ]
2007+ liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
2008+ toEncoding a >*<
2009+ toEncoding b >*<
2010+ toC c >*<
2011+ toD d
23742012 {-# INLINE liftToEncoding2 #-}
23752013
23762014instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -2396,13 +2034,12 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
23962034 return mv
23972035 {-# INLINE liftToJSON2 #-}
23982036
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− ]
2037+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
2038+ toEncoding a >*<
2039+ toEncoding b >*<
2040+ toEncoding c >*<
2041+ toD d >*<
2042+ toE e
24062043 {-# INLINE liftToEncoding2 #-}
24072044
24082045instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
@@ -2429,14 +2066,13 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
24292066 return mv
24302067 {-# INLINE liftToJSON2 #-}
24312068
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− ]
2069+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
2070+ toEncoding a >*<
2071+ toEncoding b >*<
2072+ toEncoding c >*<
2073+ toEncoding d >*<
2074+ toE e >*<
2075+ toF f
24402076 {-# INLINE liftToEncoding2 #-}
24412077
24422078instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
@@ -2464,15 +2100,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
24642100 return mv
24652101 {-# INLINE liftToJSON2 #-}
24662102
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− ]
2103+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
2104+ toEncoding a >*<
2105+ toEncoding b >*<
2106+ toEncoding c >*<
2107+ toEncoding d >*<
2108+ toEncoding e >*<
2109+ toF f >*<
2110+ toG g
24762111 {-# INLINE liftToEncoding2 #-}
24772112
24782113instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
@@ -2501,16 +2136,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
25012136 return mv
25022137 {-# INLINE liftToJSON2 #-}
25032138
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− ]
2139+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
2140+ toEncoding a >*<
2141+ toEncoding b >*<
2142+ toEncoding c >*<
2143+ toEncoding d >*<
2144+ toEncoding e >*<
2145+ toEncoding f >*<
2146+ toG g >*<
2147+ toH h
25142148 {-# INLINE liftToEncoding2 #-}
25152149
25162150instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
@@ -2540,17 +2174,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
25402174 return mv
25412175 {-# INLINE liftToJSON2 #-}
25422176
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− ]
2177+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
2178+ toEncoding a >*<
2179+ toEncoding b >*<
2180+ toEncoding c >*<
2181+ toEncoding d >*<
2182+ toEncoding e >*<
2183+ toEncoding f >*<
2184+ toEncoding g >*<
2185+ toH h >*<
2186+ toI i
25542187 {-# INLINE liftToEncoding2 #-}
25552188
25562189instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) where
@@ -2581,18 +2214,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
25812214 return mv
25822215 {-# INLINE liftToJSON2 #-}
25832216
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− ]
2217+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
2218+ toEncoding a >*<
2219+ toEncoding b >*<
2220+ toEncoding c >*<
2221+ toEncoding d >*<
2222+ toEncoding e >*<
2223+ toEncoding f >*<
2224+ toEncoding g >*<
2225+ toEncoding h >*<
2226+ toI i >*<
2227+ toJ j
25962228 {-# INLINE liftToEncoding2 #-}
25972229
25982230instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) where
@@ -2624,19 +2256,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
26242256 return mv
26252257 {-# INLINE liftToJSON2 #-}
26262258
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− ]
2259+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
2260+ toEncoding a >*<
2261+ toEncoding b >*<
2262+ toEncoding c >*<
2263+ toEncoding d >*<
2264+ toEncoding e >*<
2265+ toEncoding f >*<
2266+ toEncoding g >*<
2267+ toEncoding h >*<
2268+ toEncoding i >*<
2269+ toJ j >*<
2270+ toK k
26402271 {-# INLINE liftToEncoding2 #-}
26412272
26422273instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
@@ -2669,20 +2300,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
26692300 return mv
26702301 {-# INLINE liftToJSON2 #-}
26712302
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− ]
2303+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
2304+ toEncoding a >*<
2305+ toEncoding b >*<
2306+ toEncoding c >*<
2307+ toEncoding d >*<
2308+ toEncoding e >*<
2309+ toEncoding f >*<
2310+ toEncoding g >*<
2311+ toEncoding h >*<
2312+ toEncoding i >*<
2313+ toEncoding j >*<
2314+ toK k >*<
2315+ toL l
26862316 {-# INLINE liftToEncoding2 #-}
26872317
26882318instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
@@ -2716,21 +2346,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
27162346 return mv
27172347 {-# INLINE liftToJSON2 #-}
27182348
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− ]
2349+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
2350+ toEncoding a >*<
2351+ toEncoding b >*<
2352+ toEncoding c >*<
2353+ toEncoding d >*<
2354+ toEncoding e >*<
2355+ toEncoding f >*<
2356+ toEncoding g >*<
2357+ toEncoding h >*<
2358+ toEncoding i >*<
2359+ toEncoding j >*<
2360+ toEncoding k >*<
2361+ toL l >*<
2362+ toM m
27342363 {-# INLINE liftToEncoding2 #-}
27352364
27362365instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
@@ -2765,22 +2394,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
27652394 return mv
27662395 {-# INLINE liftToJSON2 #-}
27672396
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− ]
2397+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
2398+ toEncoding a >*<
2399+ toEncoding b >*<
2400+ toEncoding c >*<
2401+ toEncoding d >*<
2402+ toEncoding e >*<
2403+ toEncoding f >*<
2404+ toEncoding g >*<
2405+ toEncoding h >*<
2406+ toEncoding i >*<
2407+ toEncoding j >*<
2408+ toEncoding k >*<
2409+ toEncoding l >*<
2410+ toM m >*<
2411+ toN n
27842412 {-# INLINE liftToEncoding2 #-}
27852413
27862414instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
@@ -2816,23 +2444,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
28162444 return mv
28172445 {-# INLINE liftToJSON2 #-}
28182446
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− ]
2447+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
2448+ toEncoding a >*<
2449+ toEncoding b >*<
2450+ toEncoding c >*<
2451+ toEncoding d >*<
2452+ toEncoding e >*<
2453+ toEncoding f >*<
2454+ toEncoding g >*<
2455+ toEncoding h >*<
2456+ toEncoding i >*<
2457+ toEncoding j >*<
2458+ toEncoding k >*<
2459+ toEncoding l >*<
2460+ toEncoding m >*<
2461+ toN n >*<
2462+ toO o
28362463 {-# INLINE liftToEncoding2 #-}
28372464
28382465instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
@@ -2846,27 +2473,3 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
28462473 {-# INLINE toJSON #-}
28472474 toEncoding = toEncoding2
28482475 {-# 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