@@ -1,25 +1,21 @@
1−{-# LANGUAGE BangPatterns #-}
21{-# LANGUAGE CPP #-}
3−{-# LANGUAGE DataKinds #-}
42{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE EmptyDataDecls #-}
54{-# LANGUAGE FlexibleContexts #-}
65{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE FunctionalDependencies #-}
77{-# LANGUAGE GADTs #-}
8−{-# LANGUAGE MultiParamTypeClasses #-}
9−{-# LANGUAGE NamedFieldPuns #-}
8+{-# LANGUAGE NoImplicitPrelude #-}
109{-# LANGUAGE OverloadedStrings #-}
1110{-# LANGUAGE PatternGuards #-}
11+{-# LANGUAGE PolyKinds #-}
1212{-# LANGUAGE RecordWildCards #-}
1313{-# LANGUAGE ScopedTypeVariables #-}
1414{-# LANGUAGE TypeOperators #-}
15−{-# LANGUAGE TypeSynonymInstances #-}
1615{-# LANGUAGE UndecidableInstances #-}
1716
18−#if __GLASGOW_HASKELL__ >= 706
19−{-# LANGUAGE PolyKinds #-}
20−#endif
21−
2217#include "overlapping-compat.h"
18+#include "incoherent-compat.h"
2319
2420-- TODO: Drop this when we remove support for Data.Attoparsec.Number
2521{-# OPTIONS_GHC -fno-warn-deprecations #-}
@@ -37,7 +33,6 @@ module Data.Aeson.Types.ToJSON
3733 , toEncoding2
3834 -- * Generic JSON classes
3935 , GToJSON(..)
40− , GToEncoding(..)
4136 , ToArgs(..)
4237 , genericToJSON
4338 , genericToEncoding
@@ -48,55 +43,63 @@ module Data.Aeson.Types.ToJSON
4843 , ToJSONKeyFunction(..)
4944 , toJSONKeyText
5045 , contramapToJSONKeyFunction
46+
47+ , GToJSONKey()
48+ , genericToJSONKey
49+
5150 -- * Object key-value pairs
5251 , KeyValue(..)
52+ , KeyValuePair(..)
53+ , FromPairs(..)
5354 -- * Functions needed for documentation
5455 -- * Encoding functions
5556 , listEncoding
5657 , listValue
5758 ) where
5859
59−import Prelude ()
6060import Prelude.Compat
6161
6262import Control.Applicative (Const(..))
6363import Control.Monad.ST (ST)
6464import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
65−import Data.Aeson.Encoding.Internal ((>*<), (><), tuple)
65+import Data.Aeson.Encoding.Internal ((>*<))
6666import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
67−import Data.Aeson.Types.Generic (AllNullary, False, IsRecord(..), One, ProductSize, Tagged2(..), True, Zero, productSize)
67+import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
6868import Data.Aeson.Types.Internal
6969import Data.Attoparsec.Number (Number(..))
7070import Data.Bits (unsafeShiftR)
7171import Data.DList (DList)
72−import Data.Fixed (Fixed, HasResolution)
72+import Data.Fixed (Fixed, HasResolution, Nano)
7373import Data.Foldable (toList)
7474import Data.Functor.Compose (Compose(..))
75+import Data.Functor.Contravariant (Contravariant (..))
7576import Data.Functor.Identity (Identity(..))
7677import Data.Functor.Product (Product(..))
7778import Data.Functor.Sum (Sum(..))
7879import Data.Int (Int16, Int32, Int64, Int8)
7980import Data.List (intersperse)
8081import Data.List.NonEmpty (NonEmpty(..))
81−import Data.Monoid ((<>), Dual(..), First(..), Last(..))
82+import Data.Semigroup ((<>))
8283import Data.Proxy (Proxy(..))
8384import Data.Ratio (Ratio, denominator, numerator)
8485import Data.Scientific (Scientific)
8586import Data.Tagged (Tagged(..))
8687import Data.Text (Text, pack)
87−import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
88−import Data.Time.Format (FormatTime, formatTime)
89−import Data.Time.Locale.Compat (defaultTimeLocale)
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)
9093import Data.Vector (Vector)
9194import Data.Version (Version, showVersion)
95+import Data.Void (Void, absurd)
9296import Data.Word (Word16, Word32, Word64, Word8)
9397import Foreign.Storable (Storable)
98+import Foreign.C.Types (CTime (..))
9499import GHC.Generics
95100import Numeric.Natural (Natural)
96101import qualified Data.Aeson.Encoding as E
97−-- We need internal here for generic deriving
98−import qualified Data.Aeson.Encoding.Internal as E (InArray, closeCurly, colon, comma, econcat, empty, openCurly, retagEncoding, tuple, wrapObject)
99−import qualified Data.ByteString as S
102+import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
100103import qualified Data.ByteString.Lazy as L
101104import qualified Data.DList as DList
102105import qualified Data.HashMap.Strict as H
@@ -105,13 +108,16 @@ import qualified Data.IntMap as IntMap
105108import qualified Data.IntSet as IntSet
106109import qualified Data.List.NonEmpty as NE
107110import qualified Data.Map as M
111+import qualified Data.Monoid as Monoid
108112import qualified Data.Scientific as Scientific
113+import qualified Data.Semigroup as Semigroup
109114import qualified Data.Sequence as Seq
110115import qualified Data.Set as Set
111116import qualified Data.Text as T
112117import qualified Data.Text.Encoding as T
113118import qualified Data.Text.Lazy as LT
114119import qualified Data.Tree as Tree
120+import qualified Data.UUID.Types as UUID
115121import qualified Data.Vector as V
116122import qualified Data.Vector.Generic as VG
117123import qualified Data.Vector.Mutable as VM
@@ -119,12 +125,19 @@ import qualified Data.Vector.Primitive as VP
119125import qualified Data.Vector.Storable as VS
120126import qualified Data.Vector.Unboxed as VU
121127
122−#if !(MIN_VERSION_bytestring(0,10,0))
123−import Foreign.ForeignPtr (withForeignPtr)
124−import Foreign.Marshal.Utils (copyBytes)
125−import Foreign.Ptr (plusPtr)
126−import qualified Data.ByteString.Internal as S
127−import qualified Data.ByteString.Lazy.Internal as L
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
128141#endif
129142
130143toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
@@ -143,19 +156,16 @@ realFloatToJSON d
143156
144157-- | Class of generic representation types that can be converted to
145158-- JSON.
146−class GToJSON arity f where
159+class GToJSON enc arity f where
147160 -- | This method (applied to 'defaultOptions') is used as the
148− -- default generic implementation of 'toJSON' (if the @arity@ is 'Zero')
149− -- or 'liftToJSON' (if the @arity@ is 'One').
150− gToJSON :: Options -> ToArgs Value arity a -> f a -> Value
151−
152−-- | Class of generic representation types that can be converted to
153−-- a JSON 'Encoding'.
154−class GToEncoding arity f where
155− -- | This method (applied to 'defaultOptions') can be used as the
156− -- default generic implementation of 'toEncoding' (if the @arity@ is 'Zero')
157− -- or 'liftToEncoding' (if the @arity@ is 'One').
158− gToEncoding :: Options -> ToArgs Encoding arity a -> f a -> Encoding
161+ -- default generic implementation of 'toJSON'
162+ -- (with @enc ~ 'Value'@ and @arity ~ 'Zero'@)
163+ -- and 'liftToJSON' (if the @arity@ is 'One').
164+ --
165+ -- It also provides a generic implementation of 'toEncoding'
166+ -- (with @enc ~ 'Encoding'@ and @arity ~ 'Zero'@)
167+ -- and 'liftToEncoding' (if the @arity@ is 'One').
168+ gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
159169
160170-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
161171-- function arguments that encode occurrences of the type parameter (for
@@ -167,14 +177,14 @@ data ToArgs res arity a where
167177-- | A configurable generic JSON creator. This function applied to
168178-- 'defaultOptions' is used as the default for 'toJSON' when the type
169179-- is an instance of 'Generic'.
170−genericToJSON :: (Generic a, GToJSON Zero (Rep a))
180+genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
171181 => Options -> a -> Value
172182genericToJSON opts = gToJSON opts NoToArgs . from
173183
174184-- | A configurable generic JSON creator. This function applied to
175185-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
176186-- is an instance of 'Generic1'.
177−genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
187+genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
178188 => Options -> (a -> Value) -> ([a] -> Value)
179189 -> f a -> Value
180190genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
@@ -182,17 +192,17 @@ genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
182192-- | A configurable generic JSON encoder. This function applied to
183193-- 'defaultOptions' is used as the default for 'toEncoding' when the type
184194-- is an instance of 'Generic'.
185−genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))
195+genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
186196 => Options -> a -> Encoding
187−genericToEncoding opts = gToEncoding opts NoToArgs . from
197+genericToEncoding opts = gToJSON opts NoToArgs . from
188198
189199-- | A configurable generic JSON encoder. This function applied to
190200-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
191201-- is an instance of 'Generic1'.
192−genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
202+genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
193203 => Options -> (a -> Encoding) -> ([a] -> Encoding)
194204 -> f a -> Encoding
195−genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
205+genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
196206
197207-------------------------------------------------------------------------------
198208-- Class
@@ -200,6 +210,9 @@ genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
200210
201211-- | A type that can be converted to JSON.
202212--
213+-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214+-- to) specify 'toEncoding'.
215+--
203216-- An example type and instance:
204217--
205218-- @
@@ -208,10 +221,10 @@ genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
208221--
209222-- data Coord = Coord { x :: Double, y :: Double }
210223--
211−-- instance ToJSON Coord where
212−-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
224+-- instance 'ToJSON' Coord where
225+-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
213226--
214−-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
227+-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
215228-- @
216229--
217230-- Instead of manually writing your 'ToJSON' instance, there are two options
@@ -219,17 +232,15 @@ genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
219232--
220233-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
221234-- instance at compile time. The generated instance is optimized for your type
222−-- so will probably be more efficient than the following two options:
235+-- so it will probably be more efficient than the following option.
223236--
224237-- * The compiler can provide a default generic implementation for
225238-- 'toJSON'.
226239--
227240-- To use the second, simply add a @deriving 'Generic'@ clause to your
228−-- datatype and declare a 'ToJSON' instance for your datatype without giving
229−-- definitions for 'toJSON' or 'toEncoding'.
230−--
231−-- For example, the previous example can be simplified to a more
232−-- minimal instance:
241+-- datatype and declare a 'ToJSON' instance. If you require nothing other than
242+-- 'defaultOptions', it is sufficient to write (and this is the only
243+-- alternative where the default 'toJSON' implementation is sufficient):
233244--
234245-- @
235246-- {-\# LANGUAGE DeriveGeneric \#-}
@@ -238,35 +249,46 @@ genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
238249--
239250-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
240251--
241−-- instance ToJSON Coord where
242−-- toEncoding = 'genericToEncoding' 'defaultOptions'
252+-- instance 'ToJSON' Coord where
253+-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
243254-- @
244255--
245−-- Why do we provide an implementation for 'toEncoding' here? The
246−-- 'toEncoding' function is a relatively new addition to this class.
247−-- To allow users of older versions of this library to upgrade without
248−-- having to edit all of their instances or encounter surprising
249−-- incompatibilities, the default implementation of 'toEncoding' uses
250−-- 'toJSON'. This produces correct results, but since it performs an
251−-- intermediate conversion to a 'Value', it will be less efficient
252−-- than directly emitting an 'Encoding'. Our one-liner definition of
253−-- 'toEncoding' above bypasses the intermediate 'Value'.
254−--
255−-- If @DefaultSignatures@ doesn't give exactly the results you want,
256−-- you can customize the generic encoding with only a tiny amount of
257−-- effort, using 'genericToJSON' and 'genericToEncoding' with your
258−-- preferred 'Options':
256+-- If on the other hand you wish to customize the generic decoding, you have
257+-- to implement both methods:
259258--
260259-- @
261−-- instance ToJSON Coord where
262−-- toJSON = 'genericToJSON' 'defaultOptions'
263−-- toEncoding = 'genericToEncoding' 'defaultOptions'
260+-- customOptions = 'defaultOptions'
261+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
262+-- }
263+--
264+-- instance 'ToJSON' Coord where
265+-- 'toJSON' = 'genericToJSON' customOptions
266+-- 'toEncoding' = 'genericToEncoding' customOptions
264267-- @
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.)
265287class ToJSON a where
266288 -- | Convert a Haskell value to a JSON-friendly intermediate type.
267289 toJSON :: a -> Value
268290
269− default toJSON :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
291+ default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
270292 toJSON = genericToJSON defaultOptions
271293
272294 -- | Encode a Haskell value as JSON.
@@ -283,8 +305,8 @@ class ToJSON a where
283305 -- extension, and then have GHC generate a method body as follows.
284306 --
285307 -- @
286− -- instance ToJSON Coord where
287− -- toEncoding = 'genericToEncoding' 'defaultOptions'
308+ -- instance 'ToJSON' Coord where
309+ -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
288310 -- @
289311
290312 toEncoding :: a -> Encoding
@@ -316,6 +338,13 @@ instance KeyValue Pair where
316338 name .= value = (name, toJSON value)
317339 {-# INLINE (.=) #-}
318340
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+
319348-------------------------------------------------------------------------------
320349-- Classes and types for map keys
321350-------------------------------------------------------------------------------
@@ -373,7 +402,7 @@ instance KeyValue Pair where
373402-- newtype wrapper around 'Text'. The recommended approach is to use
374403-- generalized newtype deriving:
375404--
376−-- > newtype RecordId = RecordId { getRecordId :: Text}
405+-- > newtype RecordId = RecordId { getRecordId :: Text }
377406-- > deriving (Eq,Ord,ToJSONKey)
378407--
379408-- Then we may write:
@@ -388,8 +417,18 @@ instance KeyValue Pair where
388417--
389418-- It is possible to get the 'ToJSONKey' instance for free as we did
390419-- with 'Foo'. However, in this case, we have a natural way to go to
391−-- and from 'Text' that does not require any escape sequences. So, in
392−-- this example, 'ToJSONKeyText' will be used instead of 'ToJSONKeyValue'.
420+-- and from 'Text' that does not require any escape sequences. So
421+-- 'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps
422+-- as objects instead of arrays of pairs. This instance may be
423+-- implemented using generics as follows:
424+--
425+-- @
426+-- instance 'ToJSONKey' Color where
427+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
428+-- @
429+--
430+-- === __Low-level implementations__
431+--
393432-- The 'Show' instance can be used to help write 'ToJSONKey':
394433--
395434-- > instance ToJSONKey Color where
@@ -464,16 +503,42 @@ toJSONKeyTextEnc e = ToJSONKeyText tot e
464503 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
465504 tot = T.dropAround (== '"')
466505 . T.decodeLatin1
467− . lazyToStrictByteString
506+ . L.toStrict
468507 . E.encodingToLazyByteString
469508 . e
470509
510+instance Contravariant ToJSONKeyFunction where
511+ contramap = contramapToJSONKeyFunction
512+
471513-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
472514contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
473515contramapToJSONKeyFunction h x = case x of
474516 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
475517 ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
476518
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
541+
477542-------------------------------------------------------------------------------
478543-- Lifings of FromJSON and ToJSON to unary and binary type constructors
479544-------------------------------------------------------------------------------
@@ -486,7 +551,7 @@ contramapToJSONKeyFunction h x = case x of
486551--
487552-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
488553-- instance at compile time. The generated instance is optimized for your type
489−-- so will probably be more efficient than the following two options:
554+-- so it will probably be more efficient than the following option.
490555--
491556-- * The compiler can provide a default generic implementation for
492557-- 'toJSON1'.
@@ -504,23 +569,29 @@ contramapToJSONKeyFunction h x = case x of
504569--
505570-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
506571--
507−-- instance ToJSON a => ToJSON1 (Pair a)
572+-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
508573-- @
509574--
510−-- If @DefaultSignatures@ doesn't give exactly the results you want,
575+-- If the default implementation doesn't give exactly the results you want,
511576-- you can customize the generic encoding with only a tiny amount of
512577-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
513578-- your preferred 'Options':
514579--
515580-- @
516−-- instance ToJSON a => ToJSON1 (Pair a) where
517−-- liftToJSON = 'genericLiftToJSON' 'defaultOptions'
518−-- liftToEncoding = 'genericLiftToEncoding' 'defaultOptions'
581+-- customOptions = 'defaultOptions'
582+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
583+-- }
584+--
585+-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
586+-- 'liftToJSON' = 'genericLiftToJSON' customOptions
587+-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions
519588-- @
589+--
590+-- See also 'ToJSON'.
520591class ToJSON1 f where
521592 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
522593
523− default liftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
594+ default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
524595 => (a -> Value) -> ([a] -> Value) -> f a -> Value
525596 liftToJSON = genericLiftToJSON defaultOptions
526597
@@ -529,7 +600,7 @@ class ToJSON1 f where
529600
530601 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
531602
532− default liftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
603+ default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
533604 => (a -> Encoding) -> ([a] -> Encoding)
534605 -> f a -> Encoding
535606 liftToEncoding = genericLiftToEncoding defaultOptions
@@ -583,7 +654,7 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
583654-- @
584655-- newtype F a = F [a]
585656--
586−-- -- This instance encodes String as an array of chars
657+-- -- This instance encodes 'String' as an array of chars
587658-- instance 'ToJSON1' F where
588659-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
589660-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
@@ -614,6 +685,11 @@ instance ToJSON1 [] where
614685 {-# INLINE liftToEncoding #-}
615686
616687instance (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+
617693 toJSON = toJSON1
618694 {-# INLINE toJSON #-}
619695
@@ -624,39 +700,80 @@ instance (ToJSON a) => ToJSON [a] where
624700-- Generic toJSON / toEncoding
625701-------------------------------------------------------------------------------
626702
627−--------------------------------------------------------------------------------
628−-- Generic toJSON
629−
630−instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where
703+instance OVERLAPPABLE_ (GToJSON enc arity a) => GToJSON enc arity (M1 i c a) where
631704 -- Meta-information, which is not handled elsewhere, is ignored:
632705 gToJSON opts targs = gToJSON opts targs . unM1
706+ {-# INLINE gToJSON #-}
633707
634−instance (ToJSON a) => GToJSON arity (K1 i a) where
635− -- Constant values are encoded using their ToJSON instance:
636− gToJSON _opts _ = toJSON . unK1
637−
638−instance GToJSON One Par1 where
708+instance GToJSON enc One Par1 where
639709 -- Direct occurrences of the last type parameter are encoded with the
640710 -- function passed in as an argument:
641711 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 #-}
642732
643−instance (ToJSON1 f) => GToJSON One (Rec1 f) where
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+
744+--------------------------------------------------------------------------------
745+-- Generic toJSON
746+
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 #-}
756+
757+instance ToJSON a => GToJSON Value arity (K1 i a) where
758+ -- Constant values are encoded using their ToJSON instance:
759+ gToJSON _opts _ = toJSON . unK1
760+ {-# INLINE gToJSON #-}
761+
762+instance ToJSON1 f => GToJSON Value One (Rec1 f) where
644763 -- Recursive occurrences of the last type parameter are encoded using their
645764 -- ToJSON1 instance:
646765 gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766+ {-# INLINE gToJSON #-}
647767
648−instance GToJSON arity U1 where
768+instance GToJSON Value arity U1 where
649769 -- Empty constructors are encoded to an empty array:
650770 gToJSON _opts _ _ = emptyArray
651−
652−instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where
653− -- Constructors need to be encoded differently depending on whether they're
654− -- a record or not. This distinction is made by 'consToJSON':
655− gToJSON opts targs = consToJSON opts targs . unM1
771+ {-# INLINE gToJSON #-}
656772
657773instance ( WriteProduct arity a, WriteProduct arity b
658774 , ProductSize a, ProductSize b
659− ) => GToJSON arity (a :*: b) where
775+ ) => GToJSON Value arity (a :*: b)
776+ where
660777 -- Products are encoded to an array. Here we allocate a mutable vector of
661778 -- the same size as the product and write the product's elements to it using
662779 -- 'writeProduct':
@@ -668,238 +785,175 @@ instance ( WriteProduct arity a, WriteProduct arity b
668785 where
669786 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
670787 productSize
788+ {-# INLINE gToJSON #-}
671789
672−instance ( AllNullary (a :+: b) allNullary
673− , SumToJSON arity (a :+: b) allNullary
674− ) => GToJSON arity (a :+: b) where
675− -- If all constructors of a sum datatype are nullary and the
676− -- 'allNullaryToStringTag' option is set they are encoded to
677− -- strings. This distinction is made by 'sumToJSON':
678− gToJSON opts targs = (unTagged :: Tagged allNullary Value -> Value)
679− . sumToJSON opts targs
680−
681−instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where
790+instance ( ToJSON1 f
791+ , GToJSON Value One g
792+ ) => GToJSON Value One (f :.: g)
793+ where
682794 -- If an occurrence of the last type parameter is nested inside two
683795 -- composed types, it is encoded by using the outermost type's ToJSON1
684796 -- instance to generically encode the innermost type:
685797 gToJSON opts targs =
686798 let gtj = gToJSON opts targs in
687799 liftToJSON gtj (listValue gtj) . unComp1
800+ {-# INLINE gToJSON #-}
688801
689802--------------------------------------------------------------------------------
690803-- Generic toEncoding
691804
692−instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where
693− -- Meta-information, which is not handled elsewhere, is ignored:
694− gToEncoding opts targs = gToEncoding opts targs . unM1
695−
696−instance (ToJSON a) => GToEncoding arity (K1 i a) where
805+instance ToJSON a => GToJSON Encoding arity (K1 i a) where
697806 -- Constant values are encoded using their ToJSON instance:
698− gToEncoding _opts _ = toEncoding . unK1
699−
700−instance GToEncoding One Par1 where
701− -- Direct occurrences of the last type parameter are encoded with the
702− -- function passed in as an argument:
703− gToEncoding _opts (To1Args te _) = te . unPar1
807+ gToJSON _opts _ = toEncoding . unK1
808+ {-# INLINE gToJSON #-}
704809
705−instance (ToJSON1 f) => GToEncoding One (Rec1 f) where
810+instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
706811 -- Recursive occurrences of the last type parameter are encoded using their
707812 -- ToEncoding1 instance:
708− gToEncoding _opts (To1Args te tel) = liftToEncoding te tel . unRec1
813+ gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814+ {-# INLINE gToJSON #-}
709815
710−instance GToEncoding arity U1 where
816+instance GToJSON Encoding arity U1 where
711817 -- Empty constructors are encoded to an empty array:
712− gToEncoding _opts _ _ = E.emptyArray_
713−
714−instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where
715− -- Constructors need to be encoded differently depending on whether they're
716− -- a record or not. This distinction is made by 'consToEncoding':
717− gToEncoding opts targs = consToEncoding opts targs . unM1
818+ gToJSON _opts _ _ = E.emptyArray_
819+ {-# INLINE gToJSON #-}
718820
719821instance ( EncodeProduct arity a
720822 , EncodeProduct arity b
721− ) => GToEncoding arity (a :*: b) where
823+ ) => GToJSON Encoding arity (a :*: b)
824+ where
722825 -- Products are encoded to an array. Here we allocate a mutable vector of
723826 -- the same size as the product and write the product's elements to it using
724827 -- 'encodeProduct':
725− gToEncoding opts targs p = E.tuple $ encodeProduct opts targs p
828+ gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
829+ {-# INLINE gToJSON #-}
726830
727−instance ( AllNullary (a :+: b) allNullary
728− , SumToEncoding arity (a :+: b) allNullary
729− ) => GToEncoding arity (a :+: b) where
730− -- If all constructors of a sum datatype are nullary and the
731− -- 'allNullaryToStringTag' option is set they are encoded to
732− -- strings. This distinction is made by 'sumToEncoding':
733− gToEncoding opts targs
734− = (unTagged :: Tagged allNullary Encoding -> Encoding)
735− . sumToEncoding opts targs
736−
737−instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where
831+instance ( ToJSON1 f
832+ , GToJSON Encoding One g
833+ ) => GToJSON Encoding One (f :.: g)
834+ where
738835 -- If an occurrence of the last type parameter is nested inside two
739836 -- composed types, it is encoded by using the outermost type's ToJSON1
740837 -- instance to generically encode the innermost type:
741− gToEncoding opts targs =
742− let gte = gToEncoding opts targs in
838+ gToJSON opts targs =
839+ let gte = gToJSON opts targs in
743840 liftToEncoding gte (listEncoding gte) . unComp1
841+ {-# INLINE gToJSON #-}
744842
745843--------------------------------------------------------------------------------
746844
747−class SumToJSON arity f allNullary where
748− sumToJSON :: Options -> ToArgs Value arity a
749− -> f a -> Tagged allNullary Value
750−
751−instance ( GetConName f
752− , TaggedObjectPairs arity f
753− , ObjectWithSingleFieldObj arity f
754− , TwoElemArrayObj arity f
755− , UntaggedValueObj arity f
756− ) => SumToJSON arity f True where
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
757857 sumToJSON opts targs
758− | allNullaryToStringTag opts = Tagged . String . pack
858+ | allNullaryToStringTag opts = Tagged . fromString
759859 . constructorTagModifier opts . getConName
760860 | otherwise = Tagged . nonAllNullarySumToJSON opts targs
761861
762−instance ( TwoElemArrayObj arity f
763− , TaggedObjectPairs arity f
764− , ObjectWithSingleFieldObj arity f
765− , UntaggedValueObj arity f
766− ) => SumToJSON arity f False where
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
767868 sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
768869
769−nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f
770− , TaggedObjectPairs arity f
771− , ObjectWithSingleFieldObj arity f
772− , UntaggedValueObj arity f
773− ) => Options -> ToArgs Value arity a
774− -> f a -> Value
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
775876nonAllNullarySumToJSON opts targs =
776877 case sumEncoding opts of
777− TaggedObject{..} ->
778− object . taggedObjectPairs opts targs tagFieldName contentsFieldName
779− ObjectWithSingleField -> Object . objectWithSingleFieldObj opts targs
780− TwoElemArray -> Array . twoElemArrayObj opts targs
781− UntaggedValue -> untaggedValueObj opts targs
782−
783−--------------------------------------------------------------------------------
784878
785−class SumToEncoding arity f allNullary where
786− sumToEncoding :: Options -> ToArgs Encoding arity a
787− -> f a -> Tagged allNullary Encoding
788−
789−instance ( GetConName f
790− , TaggedObjectEnc arity f
791− , ObjectWithSingleFieldEnc arity f
792− , TwoElemArrayEnc arity f
793− , UntaggedValueEnc arity f
794− ) => SumToEncoding arity f True where
795− sumToEncoding opts targs
796− | allNullaryToStringTag opts = Tagged . toEncoding .
797− constructorTagModifier opts . getConName
798− | otherwise = Tagged . nonAllNullarySumToEncoding opts targs
799−
800−instance ( TwoElemArrayEnc arity f
801− , TaggedObjectEnc arity f
802− , ObjectWithSingleFieldEnc arity f
803− , UntaggedValueEnc arity f
804− ) => SumToEncoding arity f False where
805− sumToEncoding opts targs = Tagged . nonAllNullarySumToEncoding opts targs
806−
807−nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f
808− , TaggedObjectEnc arity f
809− , ObjectWithSingleFieldEnc arity f
810− , UntaggedValueEnc arity f
811− ) => Options -> ToArgs Encoding arity a
812− -> f a -> Encoding
813−nonAllNullarySumToEncoding opts targs =
814− case sumEncoding opts of
815879 TaggedObject{..} ->
816− taggedObjectEnc opts targs tagFieldName contentsFieldName
817− ObjectWithSingleField -> objectWithSingleFieldEnc opts targs
818− TwoElemArray -> twoElemArrayEnc opts targs
819− UntaggedValue -> untaggedValueEnc opts targs
880+ taggedObject opts targs tagFieldName contentsFieldName
820881
821−--------------------------------------------------------------------------------
882+ ObjectWithSingleField ->
883+ (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884+ . sumToJSON' opts targs
822885
823−class TaggedObjectPairs arity f where
824− taggedObjectPairs :: Options -> ToArgs Value arity a
825− -> String -> String
826− -> f a -> [Pair]
827−
828−instance ( TaggedObjectPairs arity a
829− , TaggedObjectPairs arity b
830− ) => TaggedObjectPairs arity (a :+: b) where
831− taggedObjectPairs opts targs tagFieldName contentsFieldName (L1 x) =
832− taggedObjectPairs opts targs tagFieldName contentsFieldName x
833− taggedObjectPairs opts targs tagFieldName contentsFieldName (R1 x) =
834− taggedObjectPairs opts targs tagFieldName contentsFieldName x
835−
836−instance ( IsRecord a isRecord
837− , TaggedObjectPairs' arity a isRecord
838− , Constructor c
839− ) => TaggedObjectPairs arity (C1 c a) where
840− taggedObjectPairs opts targs tagFieldName contentsFieldName =
841− (pack tagFieldName .= constructorTagModifier opts
842− (conName (undefined :: t c a p)) :) .
843− (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
844− taggedObjectPairs' opts targs contentsFieldName . unM1
886+ TwoElemArray ->
887+ (unTagged :: Tagged TwoElemArray enc -> enc)
888+ . sumToJSON' opts targs
845889
846−class TaggedObjectPairs' arity f isRecord where
847− taggedObjectPairs' :: Options -> ToArgs Value arity a
848− -> String -> f a -> Tagged isRecord [Pair]
890+ UntaggedValue ->
891+ (unTagged :: Tagged UntaggedValue enc -> enc)
892+ . sumToJSON' opts targs
849893
850−instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where
851− taggedObjectPairs' _ _ _ _ = Tagged []
894+--------------------------------------------------------------------------------
852895
853−instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where
854− taggedObjectPairs' opts targs _ =
855− Tagged . toList . recordToPairs opts targs
896+class FromString enc where
897+ fromString :: String -> enc
856898
857−instance (GToJSON arity f) => TaggedObjectPairs' arity f False where
858− taggedObjectPairs' opts targs contentsFieldName =
859− Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts targs
899+instance FromString Encoding where
900+ fromString = toEncoding
901+
902+instance FromString Value where
903+ fromString = String . pack
860904
861905--------------------------------------------------------------------------------
862906
863−class TaggedObjectEnc arity f where
864− taggedObjectEnc :: Options -> ToArgs Encoding arity a
865− -> String -> String
866− -> f a -> Encoding
867−
868−instance ( TaggedObjectEnc arity a
869− , TaggedObjectEnc arity b
870− ) => TaggedObjectEnc arity (a :+: b) where
871− taggedObjectEnc opts targs tagFieldName contentsFieldName (L1 x) =
872− taggedObjectEnc opts targs tagFieldName contentsFieldName x
873− taggedObjectEnc opts targs tagFieldName contentsFieldName (R1 x) =
874− taggedObjectEnc opts targs tagFieldName contentsFieldName x
875−
876−instance ( IsRecord a isRecord
877− , TaggedObjectEnc' arity a isRecord
907+class TaggedObject enc arity f where
908+ taggedObject :: Options -> ToArgs enc arity a
909+ -> String -> String
910+ -> f a -> enc
911+
912+instance ( TaggedObject enc arity a
913+ , TaggedObject enc arity b
914+ ) => TaggedObject enc arity (a :+: b)
915+ where
916+ taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
917+ taggedObject opts targs tagFieldName contentsFieldName x
918+ taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
919+ taggedObject opts targs tagFieldName contentsFieldName x
920+
921+instance ( IsRecord a isRecord
922+ , TaggedObject' enc pairs arity a isRecord
923+ , FromPairs enc pairs
924+ , FromString enc
925+ , KeyValuePair enc pairs
878926 , Constructor c
879− ) => TaggedObjectEnc arity (C1 c a) where
880− taggedObjectEnc opts targs tagFieldName contentsFieldName v =
881− E.wrapObject $
882− (E.string tagFieldName ><
883− E.colon ><
884− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) ><
885− ((unTagged :: Tagged isRecord Encoding -> Encoding) .
886− taggedObjectEnc' opts targs contentsFieldName . unM1 $ v)
887−
888−class TaggedObjectEnc' arity f isRecord where
889− taggedObjectEnc' :: Options -> ToArgs Encoding arity a
890− -> String -> f a -> Tagged isRecord Encoding
891−
892−instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where
893− taggedObjectEnc' _ _ _ _ = Tagged E.empty
894−
895−instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where
896− taggedObjectEnc' opts targs _ = Tagged . (E.comma ><) . fst
897− . recordToEncoding opts targs
898−
899−instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where
900− taggedObjectEnc' opts targs contentsFieldName =
901− Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .
902− gToEncoding opts targs
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
903957
904958--------------------------------------------------------------------------------
905959
@@ -914,23 +968,38 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where
914968instance (Constructor c) => GetConName (C1 c a) where
915969 getConName = conName
916970
971+-- For genericToJSONKey
972+instance GetConName a => GetConName (D1 d a) where
973+ getConName (M1 x) = getConName x
974+
917975--------------------------------------------------------------------------------
918976
919−class TwoElemArrayObj arity f where
920− twoElemArrayObj :: Options -> ToArgs Value arity a
921− -> f a -> V.Vector Value
977+-- Reflection of SumEncoding variants
978+
979+data ObjectWithSingleField
980+data TwoElemArray
981+data UntaggedValue
982+
983+--------------------------------------------------------------------------------
922984
923−instance ( TwoElemArrayObj arity a
924− , TwoElemArrayObj arity b
925− ) => TwoElemArrayObj arity (a :+: b) where
926− twoElemArrayObj opts targs (L1 x) = twoElemArrayObj opts targs x
927− twoElemArrayObj opts targs (R1 x) = twoElemArrayObj opts targs x
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+--------------------------------------------------------------------------------
928997
929−instance ( GToJSON arity a
930− , ConsToJSON arity a
998+instance ( GToJSON Value arity a
999+ , ConsToJSON Value arity a
9311000 , Constructor c
932− ) => TwoElemArrayObj arity (C1 c a) where
933− twoElemArrayObj opts targs x = V.create $ do
1001+ ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
1002+ sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
9341003 mv <- VM.unsafeNew 2
9351004 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
9361005 $ conName (undefined :: t c a p)
@@ -939,148 +1008,121 @@ instance ( GToJSON arity a
9391008
9401009--------------------------------------------------------------------------------
9411010
942−class TwoElemArrayEnc arity f where
943− twoElemArrayEnc :: Options -> ToArgs Encoding arity a
944− -> f a -> Encoding
945−
946−instance ( TwoElemArrayEnc arity a
947− , TwoElemArrayEnc arity b
948− ) => TwoElemArrayEnc arity (a :+: b) where
949− twoElemArrayEnc opts targs (L1 x) = twoElemArrayEnc opts targs x
950− twoElemArrayEnc opts targs (R1 x) = twoElemArrayEnc opts targs x
951−
952−instance ( GToEncoding arity a
953− , ConsToEncoding arity a
1011+instance ( GToJSON Encoding arity a
1012+ , ConsToJSON Encoding arity a
9541013 , Constructor c
955− ) => TwoElemArrayEnc arity (C1 c a) where
956− twoElemArrayEnc opts targs x = E.tuple $
957− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
958− gToEncoding opts targs x
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+ ]
9591020
9601021--------------------------------------------------------------------------------
9611022
962−class ConsToJSON arity f where
963− consToJSON :: Options -> ToArgs Value arity a
964− -> f a -> Value
1023+class ConsToJSON enc arity f where
1024+ consToJSON :: Options -> ToArgs enc arity a
1025+ -> f a -> enc
9651026
966−class ConsToJSON' arity f isRecord where
967− consToJSON' :: Options -> ToArgs Value arity a
968− -> Bool -- ^ Are we a record with one field?
969− -> f a -> Tagged isRecord Value
1027+class ConsToJSON' enc arity f isRecord where
1028+ consToJSON' :: Options -> ToArgs enc arity a
1029+ -> f a -> Tagged isRecord enc
9701030
971−instance ( IsRecord f isRecord
972− , ConsToJSON' arity f isRecord
973− ) => ConsToJSON arity f where
1031+instance ( IsRecord f isRecord
1032+ , ConsToJSON' enc arity f isRecord
1033+ ) => ConsToJSON enc arity f
1034+ where
9741035 consToJSON opts targs =
975− (unTagged :: Tagged isRecord Value -> Value)
976− . consToJSON' opts targs (isUnary (undefined :: f a))
977−
978−instance (RecordToPairs arity f) => ConsToJSON' arity f True where
979− consToJSON' opts targs isUn f = let
980− vals = toList $ recordToPairs opts targs f
981− in case (unwrapUnaryRecords opts,isUn,vals) of
982− (True,True,[(_,val)]) -> Tagged val
983− _ -> Tagged $ object vals
984−
985−instance GToJSON arity f => ConsToJSON' arity f False where
986− consToJSON' opts targs _ = Tagged . gToJSON opts targs
987−
988−--------------------------------------------------------------------------------
1036+ (unTagged :: Tagged isRecord enc -> enc)
1037+ . consToJSON' opts targs
1038+ {-# INLINE consToJSON #-}
9891039
990−class ConsToEncoding arity f where
991− consToEncoding :: Options -> ToArgs Encoding arity a
992− -> f a -> Encoding
993−
994−class ConsToEncoding' arity f isRecord where
995− consToEncoding' :: Options -> ToArgs Encoding arity a
996− -> Bool -- ^ Are we a record with one field?
997− -> f a -> Tagged isRecord Encoding
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' #-}
9981057
999−instance ( IsRecord f isRecord
1000− , ConsToEncoding' arity f isRecord
1001− ) => ConsToEncoding arity f where
1002− consToEncoding opts targs =
1003− (unTagged :: Tagged isRecord Encoding -> Encoding)
1004− . consToEncoding' opts targs (isUnary (undefined :: f a))
1005−
1006−instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where
1007− consToEncoding' opts targs isUn x =
1008− let (enc, mbVal) = recordToEncoding opts targs x
1009− in case (unwrapUnaryRecords opts, isUn, mbVal) of
1010− (True, True, Just val) -> Tagged val
1011− _ -> Tagged $ E.wrapObject enc
1012−
1013−instance GToEncoding arity f => ConsToEncoding' arity f False where
1014− consToEncoding' opts targs _ = Tagged . gToEncoding opts targs
1058+instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1059+ consToJSON' opts targs = Tagged . gToJSON opts targs
1060+ {-# INLINE consToJSON' #-}
10151061
10161062--------------------------------------------------------------------------------
10171063
1018−class RecordToPairs arity f where
1019− recordToPairs :: Options -> ToArgs Value arity a
1020− -> f a -> DList Pair
1021−
1022−instance ( RecordToPairs arity a
1023− , RecordToPairs arity b
1024− ) => RecordToPairs arity (a :*: b) where
1025− recordToPairs opts targs (a :*: b) = recordToPairs opts targs a <>
1026− recordToPairs opts targs b
1064+class RecordToPairs enc pairs arity f where
1065+ -- 1st element: whole thing
1066+ -- 2nd element: in case the record has only 1 field, just the value
1067+ -- of the field (without the key); 'Nothing' otherwise
1068+ recordToPairs :: Options -> ToArgs enc arity a
1069+ -> f a -> pairs
10271070
1028−instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where
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
10291088 recordToPairs = fieldToPair
1030−
1031−instance OVERLAPPING_ (Selector s, ToJSON a) =>
1032− RecordToPairs arity (S1 s (K1 i (Maybe a))) where
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
10331098 recordToPairs opts _ (M1 k1) | omitNothingFields opts
1034− , K1 Nothing <- k1 = DList.empty
1099+ , K1 Nothing <- k1 = mempty
10351100 recordToPairs opts targs m1 = fieldToPair opts targs m1
1036−
1037−fieldToPair :: (Selector s, GToJSON arity a)
1038− => Options -> ToArgs Value arity p
1039− -> S1 s a p -> DList Pair
1040−fieldToPair opts targs m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
1041− , gToJSON opts targs (unM1 m1)
1042− )
1043−
1044−--------------------------------------------------------------------------------
1045−
1046−class RecordToEncoding arity f where
1047− -- 1st element: whole thing
1048− -- 2nd element: in case the record has only 1 field, just the value
1049− -- of the field (without the key); 'Nothing' otherwise
1050− recordToEncoding :: Options -> ToArgs Encoding arity a
1051− -> f a -> (Encoding, Maybe Encoding)
1052−
1053−instance ( RecordToEncoding arity a
1054− , RecordToEncoding arity b
1055− ) => RecordToEncoding arity (a :*: b) where
1056− recordToEncoding opts targs (a :*: b) | omitNothingFields opts =
1057− (E.econcat $ intersperse E.comma $
1058− filter (not . E.nullEncoding)
1059− [ fst (recordToEncoding opts targs a)
1060− , fst (recordToEncoding opts targs b) ]
1061− , Nothing)
1062− recordToEncoding opts targs (a :*: b) =
1063− (fst (recordToEncoding opts targs a) >< E.comma ><
1064− fst (recordToEncoding opts targs b),
1065− Nothing)
1066−
1067−
1068−instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) where
1069− recordToEncoding = fieldToEncoding
1070−
1071−instance OVERLAPPING_ (Selector s, ToJSON a) =>
1072− RecordToEncoding arity (S1 s (K1 i (Maybe a))) where
1073− recordToEncoding opts _ (M1 k1) | omitNothingFields opts
1074− , K1 Nothing <- k1 = (E.empty, Nothing)
1075− recordToEncoding opts targs m1 = fieldToEncoding opts targs m1
1076−
1077−fieldToEncoding :: (Selector s, GToEncoding arity a)
1078− => Options -> ToArgs Encoding arity p
1079− -> S1 s a p -> (Encoding, Maybe Encoding)
1080−fieldToEncoding opts targs m1 =
1081− let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
1082− valueBuilder = gToEncoding opts targs (unM1 m1)
1083− in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)
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 #-}
10841126
10851127--------------------------------------------------------------------------------
10861128
@@ -1103,10 +1145,12 @@ instance ( WriteProduct arity a
11031145 lenL = len `unsafeShiftR` 1
11041146 lenR = len - lenL
11051147 ixR = ix + lenL
1148+ {-# INLINE writeProduct #-}
11061149
1107−instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
1150+instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
11081151 writeProduct opts targs mv ix _ =
11091152 VM.unsafeWrite mv ix . gToJSON opts targs
1153+ {-# INLINE writeProduct #-}
11101154
11111155--------------------------------------------------------------------------------
11121156
@@ -1121,114 +1165,44 @@ instance ( EncodeProduct arity a
11211165 E.econcat $ intersperse E.comma $
11221166 filter (not . E.nullEncoding)
11231167 [encodeProduct opts targs a, encodeProduct opts targs b]
1124− encodeProduct opts targs (a :*: b) = encodeProduct opts targs a >*<
1125− encodeProduct opts targs b
1168+ encodeProduct opts targs (a :*: b) =
1169+ encodeProduct opts targs a >*<
1170+ encodeProduct opts targs b
1171+ {-# INLINE encodeProduct #-}
11261172
1127−instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1128− encodeProduct opts targs a = E.retagEncoding $ gToEncoding opts targs a
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 #-}
11291176
11301177--------------------------------------------------------------------------------
11311178
1132−class ObjectWithSingleFieldObj arity f where
1133− objectWithSingleFieldObj :: Options -> ToArgs Value arity a
1134− -> f a -> Object
1135−
1136−instance ( ObjectWithSingleFieldObj arity a
1137− , ObjectWithSingleFieldObj arity b
1138− ) => ObjectWithSingleFieldObj arity (a :+: b) where
1139− objectWithSingleFieldObj opts targs (L1 x) =
1140− objectWithSingleFieldObj opts targs x
1141− objectWithSingleFieldObj opts targs (R1 x) =
1142− objectWithSingleFieldObj opts targs x
1143−
1144−instance ( GToJSON arity a
1145− , ConsToJSON arity a
1179+instance ( GToJSON enc arity a
1180+ , ConsToJSON enc arity a
1181+ , FromPairs enc pairs
1182+ , KeyValuePair enc pairs
11461183 , Constructor c
1147− ) => ObjectWithSingleFieldObj arity (C1 c a) where
1148− objectWithSingleFieldObj opts targs = H.singleton typ . gToJSON opts targs
1184+ ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1185+ where
1186+ sumToJSON' opts targs =
1187+ Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
11491188 where
1150− typ = pack $ constructorTagModifier opts $
1189+ typ = constructorTagModifier opts $
11511190 conName (undefined :: t c a p)
11521191
11531192--------------------------------------------------------------------------------
11541193
1155−class ObjectWithSingleFieldEnc arity f where
1156− objectWithSingleFieldEnc :: Options -> ToArgs Encoding arity a
1157− -> f a -> Encoding
1158−
1159−instance ( ObjectWithSingleFieldEnc arity a
1160− , ObjectWithSingleFieldEnc arity b
1161− ) => ObjectWithSingleFieldEnc arity (a :+: b) where
1162− objectWithSingleFieldEnc opts targs (L1 x) =
1163− objectWithSingleFieldEnc opts targs x
1164− objectWithSingleFieldEnc opts targs (R1 x) =
1165− objectWithSingleFieldEnc opts targs x
1166−
1167−instance ( GToEncoding arity a
1168− , ConsToEncoding arity a
1169− , Constructor c
1170− ) => ObjectWithSingleFieldEnc arity (C1 c a) where
1171− objectWithSingleFieldEnc opts targs v =
1172− E.openCurly ><
1173− toEncoding
1174− (constructorTagModifier opts
1175− (conName (undefined :: t c a p))) ><
1176− E.colon ><
1177− gToEncoding opts targs v ><
1178− E.closeCurly
1179−
1180−--------------------------------------------------------------------------------
1181−
1182−class UntaggedValueObj arity f where
1183− untaggedValueObj :: Options -> ToArgs Value arity a
1184− -> f a -> Value
1185−
1186−instance
1187− ( UntaggedValueObj arity a
1188− , UntaggedValueObj arity b
1189− ) => UntaggedValueObj arity (a :+: b)
1190− where
1191− untaggedValueObj opts targs (L1 x) = untaggedValueObj opts targs x
1192− untaggedValueObj opts targs (R1 x) = untaggedValueObj opts targs x
1193−
11941194instance OVERLAPPABLE_
1195− ( GToJSON arity a
1196− , ConsToJSON arity a
1197− ) => UntaggedValueObj arity (C1 c a) where
1198− untaggedValueObj = gToJSON
1199−
1200−instance OVERLAPPING_
1201− ( Constructor c )
1202− => UntaggedValueObj arity (C1 c U1)
1195+ ( ConsToJSON enc arity a
1196+ ) => SumToJSON' UntaggedValue enc arity (C1 c a)
12031197 where
1204− untaggedValueObj opts _ _ = toJSON $
1205− constructorTagModifier opts $ conName (undefined :: t c U1 p)
1206−
1207−--------------------------------------------------------------------------------
1208−
1209−class UntaggedValueEnc arity f where
1210− untaggedValueEnc :: Options -> ToArgs Encoding arity a
1211− -> f a -> Encoding
1212−instance
1213− ( UntaggedValueEnc arity a
1214− , UntaggedValueEnc arity b
1215− ) => UntaggedValueEnc arity (a :+: b)
1216− where
1217− untaggedValueEnc opts targs (L1 x) = untaggedValueEnc opts targs x
1218− untaggedValueEnc opts targs (R1 x) = untaggedValueEnc opts targs x
1219−
1220−instance OVERLAPPABLE_
1221− ( GToEncoding arity a
1222− , ConsToEncoding arity a
1223− ) => UntaggedValueEnc arity (C1 c a)
1224− where
1225− untaggedValueEnc = gToEncoding
1198+ sumToJSON' opts targs = Tagged . gToJSON opts targs
12261199
12271200instance OVERLAPPING_
1228− ( Constructor c )
1229− => UntaggedValueEnc arity (C1 c U1)
1201+ ( Constructor c
1202+ , FromString enc
1203+ ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
12301204 where
1231− untaggedValueEnc opts _ _ = toEncoding $
1205+ sumToJSON' opts _ _ = Tagged . fromString $
12321206 constructorTagModifier opts $ conName (undefined :: t c U1 p)
12331207
12341208-------------------------------------------------------------------------------
@@ -1302,6 +1276,13 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
13021276 toEncoding = toEncoding2
13031277 {-# INLINE toEncoding #-}
13041278
1279+instance ToJSON Void where
1280+ toJSON = absurd
1281+ {-# INLINE toJSON #-}
1282+
1283+ toEncoding = absurd
1284+ {-# INLINE toEncoding #-}
1285+
13051286
13061287instance ToJSON Bool where
13071288 toJSON = Bool
@@ -1487,7 +1468,6 @@ instance ToJSONKey Int64 where
14871468 toJSONKey = toJSONKeyTextEnc E.int64Text
14881469 {-# INLINE toJSONKey #-}
14891470
1490−
14911471instance ToJSON Word where
14921472 toJSON = Number . fromIntegral
14931473 {-# INLINE toJSON #-}
@@ -1547,6 +1527,12 @@ instance ToJSONKey Word64 where
15471527 toJSONKey = toJSONKeyTextEnc E.word64Text
15481528 {-# INLINE toJSONKey #-}
15491529
1530+instance ToJSON CTime where
1531+ toJSON (CTime i) = toJSON i
1532+ {-# INLINE toJSON #-}
1533+
1534+ toEncoding (CTime i) = toEncoding i
1535+ {-# INLINE toEncoding #-}
15501536
15511537instance ToJSON Text where
15521538 toJSON = String
@@ -1661,7 +1647,7 @@ instance (ToJSON a) => ToJSON (Identity a) where
16611647 toEncodingList = liftToEncodingList toEncoding toEncodingList
16621648 {-# INLINE toEncodingList #-}
16631649
1664−instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1650+instance (ToJSONKey a) => ToJSONKey (Identity a) where
16651651 toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
16661652 toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
16671653
@@ -1810,13 +1796,11 @@ instance ToJSONKey k => ToJSON1 (M.Map k) where
18101796 ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
18111797 {-# INLINE liftToJSON #-}
18121798
1813− -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
18141799 liftToEncoding g _ = case toJSONKey of
18151800 ToJSONKeyText _ f -> dict f g M.foldrWithKey
18161801 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
18171802 where
1818− -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1819− pairEncoding f (a, b) = tuple $ f a >*< g b
1803+ pairEncoding f (a, b) = E.list id [f a, g b]
18201804 {-# INLINE liftToEncoding #-}
18211805
18221806
@@ -1854,6 +1838,17 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
18541838 toEncoding = toEncoding1
18551839 {-# INLINE toEncoding #-}
18561840
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
18571852
18581853-------------------------------------------------------------------------------
18591854-- vector
@@ -1867,6 +1862,8 @@ instance ToJSON1 Vector where
18671862 {-# INLINE liftToEncoding #-}
18681863
18691864instance (ToJSON a) => ToJSON (Vector a) where
1865+ {-# SPECIALIZE instance ToJSON Array #-}
1866+
18701867 toJSON = toJSON1
18711868 {-# INLINE toJSON #-}
18721869
@@ -1934,11 +1931,12 @@ instance ToJSONKey k => ToJSON1 (H.HashMap k) where
19341931 ToJSONKeyText _ f -> dict f g H.foldrWithKey
19351932 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
19361933 where
1937− -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1938− pairEncoding f (a, b) = tuple $ f a >*< g b
1934+ pairEncoding f (a, b) = E.list id [f a, g b]
19391935 {-# INLINE liftToEncoding #-}
19401936
19411937instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938+ {-# SPECIALIZE instance ToJSON Object #-}
1939+
19421940 toJSON = toJSON1
19431941 {-# INLINE toJSON #-}
19441942
@@ -1968,6 +1966,32 @@ dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
19681966formatMillis :: (FormatTime t) => t -> String
19691967formatMillis = take 3 . formatTime defaultTimeLocale "%q"
19701968
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+
19711995-------------------------------------------------------------------------------
19721996-- time
19731997-------------------------------------------------------------------------------
@@ -2016,10 +2040,11 @@ stringEncoding :: Encoding' Text -> Value
20162040stringEncoding = String
20172041 . T.dropAround (== '"')
20182042 . T.decodeLatin1
2019− . lazyToStrictByteString
2043+ . L.toStrict
20202044 . E.encodingToLazyByteString
20212045{-# INLINE stringEncoding #-}
20222046
2047+
20232048instance ToJSON NominalDiffTime where
20242049 toJSON = Number . realToFrac
20252050 {-# INLINE toJSON #-}
@@ -2027,18 +2052,159 @@ instance ToJSON NominalDiffTime where
20272052 toEncoding = E.scientific . realToFrac
20282053 {-# INLINE toEncoding #-}
20292054
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+
20302107-------------------------------------------------------------------------------
20312108-- base Monoid/Semigroup
20322109-------------------------------------------------------------------------------
20332110
2034−instance ToJSON1 Dual where
2035− liftToJSON t _ = t . getDual
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
2128+ {-# INLINE liftToJSON #-}
2129+
2130+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
2131+ {-# INLINE liftToEncoding #-}
2132+
2133+instance ToJSON a => ToJSON (Monoid.First a) where
2134+ toJSON = toJSON1
2135+ {-# INLINE toJSON #-}
2136+
2137+ toEncoding = toEncoding1
2138+ {-# INLINE toEncoding #-}
2139+
2140+
2141+instance ToJSON1 Monoid.Last where
2142+ liftToJSON t to' = liftToJSON t to' . Monoid.getLast
2143+ {-# INLINE liftToJSON #-}
2144+
2145+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
2146+ {-# INLINE liftToEncoding #-}
2147+
2148+instance ToJSON a => ToJSON (Monoid.Last a) where
2149+ toJSON = toJSON1
2150+ {-# INLINE toJSON #-}
2151+
2152+ toEncoding = toEncoding1
2153+ {-# INLINE toEncoding #-}
2154+
2155+
2156+instance ToJSON1 Semigroup.Min where
2157+ liftToJSON t _ (Semigroup.Min x) = t x
2158+ {-# INLINE liftToJSON #-}
2159+
2160+ liftToEncoding t _ (Semigroup.Min x) = t x
2161+ {-# INLINE liftToEncoding #-}
2162+
2163+instance ToJSON a => ToJSON (Semigroup.Min a) where
2164+ toJSON = toJSON1
2165+ {-# INLINE toJSON #-}
2166+
2167+ toEncoding = toEncoding1
2168+ {-# INLINE toEncoding #-}
2169+
2170+
2171+instance ToJSON1 Semigroup.Max where
2172+ liftToJSON t _ (Semigroup.Max x) = t x
2173+ {-# INLINE liftToJSON #-}
2174+
2175+ liftToEncoding t _ (Semigroup.Max x) = t x
2176+ {-# INLINE liftToEncoding #-}
2177+
2178+instance ToJSON a => ToJSON (Semigroup.Max a) where
2179+ toJSON = toJSON1
2180+ {-# INLINE toJSON #-}
2181+
2182+ toEncoding = toEncoding1
2183+ {-# INLINE toEncoding #-}
2184+
2185+instance ToJSON1 Semigroup.First where
2186+ liftToJSON t _ (Semigroup.First x) = t x
2187+ {-# INLINE liftToJSON #-}
2188+
2189+ liftToEncoding t _ (Semigroup.First x) = t x
2190+ {-# INLINE liftToEncoding #-}
2191+
2192+instance ToJSON a => ToJSON (Semigroup.First a) where
2193+ toJSON = toJSON1
2194+ {-# INLINE toJSON #-}
2195+
2196+ toEncoding = toEncoding1
2197+ {-# INLINE toEncoding #-}
2198+
2199+
2200+instance ToJSON1 Semigroup.Last where
2201+ liftToJSON t _ (Semigroup.Last x) = t x
20362202 {-# INLINE liftToJSON #-}
20372203
2038− liftToEncoding t _ = t . getDual
2204+ liftToEncoding t _ (Semigroup.Last x) = t x
20392205 {-# INLINE liftToEncoding #-}
20402206
2041−instance ToJSON a => ToJSON (Dual a) where
2207+instance ToJSON a => ToJSON (Semigroup.Last a) where
20422208 toJSON = toJSON1
20432209 {-# INLINE toJSON #-}
20442210
@@ -2046,14 +2212,14 @@ instance ToJSON a => ToJSON (Dual a) where
20462212 {-# INLINE toEncoding #-}
20472213
20482214
2049−instance ToJSON1 First where
2050− liftToJSON t to' = liftToJSON t to' . getFirst
2215+instance ToJSON1 Semigroup.WrappedMonoid where
2216+ liftToJSON t _ (Semigroup.WrapMonoid x) = t x
20512217 {-# INLINE liftToJSON #-}
20522218
2053− liftToEncoding t to' = liftToEncoding t to' . getFirst
2219+ liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
20542220 {-# INLINE liftToEncoding #-}
20552221
2056−instance ToJSON a => ToJSON (First a) where
2222+instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
20572223 toJSON = toJSON1
20582224 {-# INLINE toJSON #-}
20592225
@@ -2061,14 +2227,14 @@ instance ToJSON a => ToJSON (First a) where
20612227 {-# INLINE toEncoding #-}
20622228
20632229
2064−instance ToJSON1 Last where
2065− liftToJSON t to' = liftToJSON t to' . getLast
2230+instance ToJSON1 Semigroup.Option where
2231+ liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
20662232 {-# INLINE liftToJSON #-}
20672233
2068− liftToEncoding t to' = liftToEncoding t to' . getLast
2234+ liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
20692235 {-# INLINE liftToEncoding #-}
20702236
2071−instance ToJSON a => ToJSON (Last a) where
2237+instance ToJSON a => ToJSON (Semigroup.Option a) where
20722238 toJSON = toJSON1
20732239 {-# INLINE toJSON #-}
20742240
@@ -2079,6 +2245,13 @@ instance ToJSON a => ToJSON (Last a) where
20792245-- tagged
20802246-------------------------------------------------------------------------------
20812247
2248+instance ToJSON1 Proxy where
2249+ liftToJSON _ _ _ = Null
2250+ {-# INLINE liftToJSON #-}
2251+
2252+ liftToEncoding _ _ _ = E.null_
2253+ {-# INLINE liftToEncoding #-}
2254+
20822255instance ToJSON (Proxy a) where
20832256 toJSON _ = Null
20842257 {-# INLINE toJSON #-}
@@ -2087,6 +2260,13 @@ instance ToJSON (Proxy a) where
20872260 {-# INLINE toEncoding #-}
20882261
20892262
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+
20902270instance ToJSON1 (Tagged a) where
20912271 liftToJSON t _ (Tagged x) = t x
20922272 {-# INLINE liftToJSON #-}
@@ -2101,7 +2281,6 @@ instance ToJSON b => ToJSON (Tagged a b) where
21012281 toEncoding = toEncoding1
21022282 {-# INLINE toEncoding #-}
21032283
2104−
21052284instance ToJSONKey b => ToJSONKey (Tagged a b) where
21062285 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
21072286 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
@@ -2122,7 +2301,7 @@ instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
21222301 toJSONKey = toJSONKeyList
21232302
21242303-------------------------------------------------------------------------------
2125−-- Tuple instances, see tuple-instances-to.hs
2304+-- Tuple instances
21262305-------------------------------------------------------------------------------
21272306
21282307instance ToJSON2 (,) where
@@ -2133,9 +2312,7 @@ instance ToJSON2 (,) where
21332312 return mv
21342313 {-# INLINE liftToJSON2 #-}
21352314
2136− liftToEncoding2 toA _ toB _ (a, b) = tuple $
2137− toA a >*<
2138− toB b
2315+ liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
21392316 {-# INLINE liftToEncoding2 #-}
21402317
21412318instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -2159,10 +2336,11 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
21592336 return mv
21602337 {-# INLINE liftToJSON2 #-}
21612338
2162− liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
2163− toEncoding a >*<
2164− toB b >*<
2165− toC c
2339+ liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2340+ [ toEncoding a
2341+ , toB b
2342+ , toC c
2343+ ]
21662344 {-# INLINE liftToEncoding2 #-}
21672345
21682346instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -2187,11 +2365,12 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
21872365 return mv
21882366 {-# INLINE liftToJSON2 #-}
21892367
2190− liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
2191− toEncoding a >*<
2192− toEncoding b >*<
2193− toC c >*<
2194− toD d
2368+ liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2369+ [ toEncoding a
2370+ , toEncoding b
2371+ , toC c
2372+ , toD d
2373+ ]
21952374 {-# INLINE liftToEncoding2 #-}
21962375
21972376instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -2217,12 +2396,13 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
22172396 return mv
22182397 {-# INLINE liftToJSON2 #-}
22192398
2220− liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
2221− toEncoding a >*<
2222− toEncoding b >*<
2223− toEncoding c >*<
2224− toD d >*<
2225− toE e
2399+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
2400+ [ toEncoding a
2401+ , toEncoding b
2402+ , toEncoding c
2403+ , toD d
2404+ , toE e
2405+ ]
22262406 {-# INLINE liftToEncoding2 #-}
22272407
22282408instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
@@ -2249,13 +2429,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
22492429 return mv
22502430 {-# INLINE liftToJSON2 #-}
22512431
2252− liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
2253− toEncoding a >*<
2254− toEncoding b >*<
2255− toEncoding c >*<
2256− toEncoding d >*<
2257− toE e >*<
2258− toF f
2432+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
2433+ [ toEncoding a
2434+ , toEncoding b
2435+ , toEncoding c
2436+ , toEncoding d
2437+ , toE e
2438+ , toF f
2439+ ]
22592440 {-# INLINE liftToEncoding2 #-}
22602441
22612442instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
@@ -2283,14 +2464,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
22832464 return mv
22842465 {-# INLINE liftToJSON2 #-}
22852466
2286− liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
2287− toEncoding a >*<
2288− toEncoding b >*<
2289− toEncoding c >*<
2290− toEncoding d >*<
2291− toEncoding e >*<
2292− toF f >*<
2293− toG g
2467+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id
2468+ [ toEncoding a
2469+ , toEncoding b
2470+ , toEncoding c
2471+ , toEncoding d
2472+ , toEncoding e
2473+ , toF f
2474+ , toG g
2475+ ]
22942476 {-# INLINE liftToEncoding2 #-}
22952477
22962478instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
@@ -2319,15 +2501,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
23192501 return mv
23202502 {-# INLINE liftToJSON2 #-}
23212503
2322− liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
2323− toEncoding a >*<
2324− toEncoding b >*<
2325− toEncoding c >*<
2326− toEncoding d >*<
2327− toEncoding e >*<
2328− toEncoding f >*<
2329− toG g >*<
2330− toH h
2504+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id
2505+ [ toEncoding a
2506+ , toEncoding b
2507+ , toEncoding c
2508+ , toEncoding d
2509+ , toEncoding e
2510+ , toEncoding f
2511+ , toG g
2512+ , toH h
2513+ ]
23312514 {-# INLINE liftToEncoding2 #-}
23322515
23332516instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
@@ -2357,16 +2540,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
23572540 return mv
23582541 {-# INLINE liftToJSON2 #-}
23592542
2360− liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
2361− toEncoding a >*<
2362− toEncoding b >*<
2363− toEncoding c >*<
2364− toEncoding d >*<
2365− toEncoding e >*<
2366− toEncoding f >*<
2367− toEncoding g >*<
2368− toH h >*<
2369− toI i
2543+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id
2544+ [ toEncoding a
2545+ , toEncoding b
2546+ , toEncoding c
2547+ , toEncoding d
2548+ , toEncoding e
2549+ , toEncoding f
2550+ , toEncoding g
2551+ , toH h
2552+ , toI i
2553+ ]
23702554 {-# INLINE liftToEncoding2 #-}
23712555
23722556instance (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
@@ -2397,17 +2581,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
23972581 return mv
23982582 {-# INLINE liftToJSON2 #-}
23992583
2400− liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
2401− toEncoding a >*<
2402− toEncoding b >*<
2403− toEncoding c >*<
2404− toEncoding d >*<
2405− toEncoding e >*<
2406− toEncoding f >*<
2407− toEncoding g >*<
2408− toEncoding h >*<
2409− toI i >*<
2410− toJ j
2584+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id
2585+ [ toEncoding a
2586+ , toEncoding b
2587+ , toEncoding c
2588+ , toEncoding d
2589+ , toEncoding e
2590+ , toEncoding f
2591+ , toEncoding g
2592+ , toEncoding h
2593+ , toI i
2594+ , toJ j
2595+ ]
24112596 {-# INLINE liftToEncoding2 #-}
24122597
24132598instance (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
@@ -2439,18 +2624,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
24392624 return mv
24402625 {-# INLINE liftToJSON2 #-}
24412626
2442− liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
2443− toEncoding a >*<
2444− toEncoding b >*<
2445− toEncoding c >*<
2446− toEncoding d >*<
2447− toEncoding e >*<
2448− toEncoding f >*<
2449− toEncoding g >*<
2450− toEncoding h >*<
2451− toEncoding i >*<
2452− toJ j >*<
2453− toK k
2627+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id
2628+ [ toEncoding a
2629+ , toEncoding b
2630+ , toEncoding c
2631+ , toEncoding d
2632+ , toEncoding e
2633+ , toEncoding f
2634+ , toEncoding g
2635+ , toEncoding h
2636+ , toEncoding i
2637+ , toJ j
2638+ , toK k
2639+ ]
24542640 {-# INLINE liftToEncoding2 #-}
24552641
24562642instance (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
@@ -2483,19 +2669,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
24832669 return mv
24842670 {-# INLINE liftToJSON2 #-}
24852671
2486− liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
2487− toEncoding a >*<
2488− toEncoding b >*<
2489− toEncoding c >*<
2490− toEncoding d >*<
2491− toEncoding e >*<
2492− toEncoding f >*<
2493− toEncoding g >*<
2494− toEncoding h >*<
2495− toEncoding i >*<
2496− toEncoding j >*<
2497− toK k >*<
2498− toL l
2672+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id
2673+ [ toEncoding a
2674+ , toEncoding b
2675+ , toEncoding c
2676+ , toEncoding d
2677+ , toEncoding e
2678+ , toEncoding f
2679+ , toEncoding g
2680+ , toEncoding h
2681+ , toEncoding i
2682+ , toEncoding j
2683+ , toK k
2684+ , toL l
2685+ ]
24992686 {-# INLINE liftToEncoding2 #-}
25002687
25012688instance (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
@@ -2529,20 +2716,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
25292716 return mv
25302717 {-# INLINE liftToJSON2 #-}
25312718
2532− liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
2533− toEncoding a >*<
2534− toEncoding b >*<
2535− toEncoding c >*<
2536− toEncoding d >*<
2537− toEncoding e >*<
2538− toEncoding f >*<
2539− toEncoding g >*<
2540− toEncoding h >*<
2541− toEncoding i >*<
2542− toEncoding j >*<
2543− toEncoding k >*<
2544− toL l >*<
2545− toM m
2719+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id
2720+ [ toEncoding a
2721+ , toEncoding b
2722+ , toEncoding c
2723+ , toEncoding d
2724+ , toEncoding e
2725+ , toEncoding f
2726+ , toEncoding g
2727+ , toEncoding h
2728+ , toEncoding i
2729+ , toEncoding j
2730+ , toEncoding k
2731+ , toL l
2732+ , toM m
2733+ ]
25462734 {-# INLINE liftToEncoding2 #-}
25472735
25482736instance (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
@@ -2577,21 +2765,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
25772765 return mv
25782766 {-# INLINE liftToJSON2 #-}
25792767
2580− liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
2581− toEncoding a >*<
2582− toEncoding b >*<
2583− toEncoding c >*<
2584− toEncoding d >*<
2585− toEncoding e >*<
2586− toEncoding f >*<
2587− toEncoding g >*<
2588− toEncoding h >*<
2589− toEncoding i >*<
2590− toEncoding j >*<
2591− toEncoding k >*<
2592− toEncoding l >*<
2593− toM m >*<
2594− toN n
2768+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id
2769+ [ toEncoding a
2770+ , toEncoding b
2771+ , toEncoding c
2772+ , toEncoding d
2773+ , toEncoding e
2774+ , toEncoding f
2775+ , toEncoding g
2776+ , toEncoding h
2777+ , toEncoding i
2778+ , toEncoding j
2779+ , toEncoding k
2780+ , toEncoding l
2781+ , toM m
2782+ , toN n
2783+ ]
25952784 {-# INLINE liftToEncoding2 #-}
25962785
25972786instance (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
@@ -2627,22 +2816,23 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
26272816 return mv
26282817 {-# INLINE liftToJSON2 #-}
26292818
2630− liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
2631− toEncoding a >*<
2632− toEncoding b >*<
2633− toEncoding c >*<
2634− toEncoding d >*<
2635− toEncoding e >*<
2636− toEncoding f >*<
2637− toEncoding g >*<
2638− toEncoding h >*<
2639− toEncoding i >*<
2640− toEncoding j >*<
2641− toEncoding k >*<
2642− toEncoding l >*<
2643− toEncoding m >*<
2644− toN n >*<
2645− toO o
2819+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id
2820+ [ toEncoding a
2821+ , toEncoding b
2822+ , toEncoding c
2823+ , toEncoding d
2824+ , toEncoding e
2825+ , toEncoding f
2826+ , toEncoding g
2827+ , toEncoding h
2828+ , toEncoding i
2829+ , toEncoding j
2830+ , toEncoding k
2831+ , toEncoding l
2832+ , toEncoding m
2833+ , toN n
2834+ , toO o
2835+ ]
26462836 {-# INLINE liftToEncoding2 #-}
26472837
26482838instance (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
@@ -2657,27 +2847,26 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
26572847 toEncoding = toEncoding2
26582848 {-# INLINE toEncoding #-}
26592849
2660−-------------------------------------------------------------------------------
2661−-- pre-bytestring-0.10 compatibility
2662−-------------------------------------------------------------------------------
2850+--------------------------------------------------------------------------------
26632851
2664−{-# INLINE lazyToStrictByteString #-}
2665−lazyToStrictByteString :: L.ByteString -> S.ByteString
2666−#if MIN_VERSION_bytestring(0,10,0)
2667−lazyToStrictByteString = L.toStrict
2668−#else
2669−lazyToStrictByteString = packChunks
2852+-- | Wrap a list of pairs as an object.
2853+class Monoid pairs => FromPairs enc pairs | enc -> pairs where
2854+ fromPairs :: pairs -> enc
26702855
2671−-- packChunks is taken from the blaze-builder package.
2856+instance (a ~ Value) => FromPairs (Encoding' a) Series where
2857+ fromPairs = E.pairs
26722858
2673−-- | Pack the chunks of a lazy bytestring into a single strict bytestring.
2674−packChunks :: L.ByteString -> S.ByteString
2675−packChunks lbs = do
2676− S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
2677− where
2678− copyChunks !L.Empty !_pf = return ()
2679− copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do
2680− withForeignPtr fpbuf $ \pbuf ->
2681− copyBytes pf (pbuf `plusPtr` o) l
2682− copyChunks lbs' (pf `plusPtr` l)
2683−#endif
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