@@ -1,21 +1,25 @@
1+{-# LANGUAGE BangPatterns #-}
12{-# LANGUAGE CPP #-}
3+{-# LANGUAGE DataKinds #-}
24{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE EmptyDataDecls #-}
45{-# LANGUAGE FlexibleContexts #-}
56{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE FunctionalDependencies #-}
77{-# LANGUAGE GADTs #-}
8−{-# LANGUAGE NoImplicitPrelude #-}
8+{-# LANGUAGE MultiParamTypeClasses #-}
9+{-# LANGUAGE NamedFieldPuns #-}
910{-# LANGUAGE OverloadedStrings #-}
1011{-# LANGUAGE PatternGuards #-}
11−{-# LANGUAGE PolyKinds #-}
1212{-# LANGUAGE RecordWildCards #-}
1313{-# LANGUAGE ScopedTypeVariables #-}
1414{-# LANGUAGE TypeOperators #-}
15+{-# LANGUAGE TypeSynonymInstances #-}
1516{-# LANGUAGE UndecidableInstances #-}
1617
18+#if __GLASGOW_HASKELL__ >= 706
19+{-# LANGUAGE PolyKinds #-}
20+#endif
21+
1722#include "overlapping-compat.h"
18−#include "incoherent-compat.h"
1923
2024-- TODO: Drop this when we remove support for Data.Attoparsec.Number
2125{-# OPTIONS_GHC -fno-warn-deprecations #-}
@@ -33,6 +37,7 @@ module Data.Aeson.Types.ToJSON
3337 , toEncoding2
3438 -- * Generic JSON classes
3539 , GToJSON(..)
40+ , GToEncoding(..)
3641 , ToArgs(..)
3742 , genericToJSON
3843 , genericToEncoding
@@ -43,63 +48,53 @@ module Data.Aeson.Types.ToJSON
4348 , ToJSONKeyFunction(..)
4449 , toJSONKeyText
4550 , contramapToJSONKeyFunction
46−
47− , GToJSONKey()
48− , genericToJSONKey
49−
5051 -- * Object key-value pairs
5152 , KeyValue(..)
52− , KeyValuePair(..)
53− , FromPairs(..)
5453 -- * Functions needed for documentation
5554 -- * Encoding functions
5655 , listEncoding
5756 , listValue
5857 ) where
5958
59+import Prelude ()
6060import Prelude.Compat
6161
6262import Control.Applicative (Const(..))
6363import Control.Monad.ST (ST)
64−import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
65−import Data.Aeson.Encoding.Internal ((>*<))
64+import Data.Aeson.Encoding.Internal ((>*<), (><), Encoding, Encoding', Series, dict, emptyArray_, tuple)
6665import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
67−import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
66+import Data.Aeson.Types.Generic
6867import Data.Aeson.Types.Internal
6968import Data.Attoparsec.Number (Number(..))
7069import Data.Bits (unsafeShiftR)
7170import Data.DList (DList)
72−import Data.Fixed (Fixed, HasResolution, Nano)
71+import Data.Fixed (Fixed, HasResolution)
7372import Data.Foldable (toList)
7473import Data.Functor.Compose (Compose(..))
75−import Data.Functor.Contravariant (Contravariant (..))
7674import Data.Functor.Identity (Identity(..))
7775import Data.Functor.Product (Product(..))
7876import Data.Functor.Sum (Sum(..))
7977import Data.Int (Int16, Int32, Int64, Int8)
8078import Data.List (intersperse)
8179import Data.List.NonEmpty (NonEmpty(..))
82−import Data.Semigroup ((<>))
80+import Data.Monoid ((<>), Dual(..), First(..), Last(..))
8381import Data.Proxy (Proxy(..))
8482import Data.Ratio (Ratio, denominator, numerator)
8583import Data.Scientific (Scientific)
8684import Data.Tagged (Tagged(..))
8785import 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)
86+import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
87+import Data.Time.Format (FormatTime, formatTime)
88+import Data.Time.Locale.Compat (defaultTimeLocale)
9389import Data.Vector (Vector)
9490import Data.Version (Version, showVersion)
95−import Data.Void (Void, absurd)
9691import Data.Word (Word16, Word32, Word64, Word8)
9792import Foreign.Storable (Storable)
98−import Foreign.C.Types (CTime (..))
9993import GHC.Generics
10094import Numeric.Natural (Natural)
101−import qualified Data.Aeson.Encoding as E
102−import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
95+-- We need internal here for generic deriving
96+import qualified Data.Aeson.Encoding.Internal as E
97+import qualified Data.ByteString as S
10398import qualified Data.ByteString.Lazy as L
10499import qualified Data.DList as DList
105100import qualified Data.HashMap.Strict as H
@@ -108,16 +103,13 @@ import qualified Data.IntMap as IntMap
108103import qualified Data.IntSet as IntSet
109104import qualified Data.List.NonEmpty as NE
110105import qualified Data.Map as M
111−import qualified Data.Monoid as Monoid
112106import qualified Data.Scientific as Scientific
113−import qualified Data.Semigroup as Semigroup
114107import qualified Data.Sequence as Seq
115108import qualified Data.Set as Set
116109import qualified Data.Text as T
117110import qualified Data.Text.Encoding as T
118111import qualified Data.Text.Lazy as LT
119112import qualified Data.Tree as Tree
120−import qualified Data.UUID.Types as UUID
121113import qualified Data.Vector as V
122114import qualified Data.Vector.Generic as VG
123115import qualified Data.Vector.Mutable as VM
@@ -125,19 +117,12 @@ import qualified Data.Vector.Primitive as VP
125117import qualified Data.Vector.Storable as VS
126118import qualified Data.Vector.Unboxed as VU
127119
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
120+#if !(MIN_VERSION_bytestring(0,10,0))
121+import Foreign.ForeignPtr (withForeignPtr)
122+import Foreign.Marshal.Utils (copyBytes)
123+import Foreign.Ptr (plusPtr)
124+import qualified Data.ByteString.Internal as S
125+import qualified Data.ByteString.Lazy.Internal as L
141126#endif
142127
143128toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
@@ -156,16 +141,19 @@ realFloatToJSON d
156141
157142-- | Class of generic representation types that can be converted to
158143-- JSON.
159−class GToJSON enc arity f where
144+class GToJSON arity f where
160145 -- | 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
146+ -- default generic implementation of 'toJSON' (if the @arity@ is 'Zero')
147+ -- or 'liftToJSON' (if the @arity@ is 'One').
148+ gToJSON :: Options -> ToArgs Value arity a -> f a -> Value
149+
150+-- | Class of generic representation types that can be converted to
151+-- a JSON 'Encoding'.
152+class GToEncoding arity f where
153+ -- | This method (applied to 'defaultOptions') can be used as the
154+ -- default generic implementation of 'toEncoding' (if the @arity@ is 'Zero')
155+ -- or 'liftToEncoding' (if the @arity@ is 'One').
156+ gToEncoding :: Options -> ToArgs Encoding arity a -> f a -> Encoding
169157
170158-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
171159-- function arguments that encode occurrences of the type parameter (for
@@ -177,14 +165,14 @@ data ToArgs res arity a where
177165-- | A configurable generic JSON creator. This function applied to
178166-- 'defaultOptions' is used as the default for 'toJSON' when the type
179167-- is an instance of 'Generic'.
180−genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
168+genericToJSON :: (Generic a, GToJSON Zero (Rep a))
181169 => Options -> a -> Value
182170genericToJSON opts = gToJSON opts NoToArgs . from
183171
184172-- | A configurable generic JSON creator. This function applied to
185173-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
186174-- is an instance of 'Generic1'.
187−genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
175+genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
188176 => Options -> (a -> Value) -> ([a] -> Value)
189177 -> f a -> Value
190178genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
@@ -192,17 +180,17 @@ genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
192180-- | A configurable generic JSON encoder. This function applied to
193181-- 'defaultOptions' is used as the default for 'toEncoding' when the type
194182-- is an instance of 'Generic'.
195−genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
183+genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))
196184 => Options -> a -> Encoding
197−genericToEncoding opts = gToJSON opts NoToArgs . from
185+genericToEncoding opts = gToEncoding opts NoToArgs . from
198186
199187-- | A configurable generic JSON encoder. This function applied to
200188-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
201189-- is an instance of 'Generic1'.
202−genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
190+genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
203191 => Options -> (a -> Encoding) -> ([a] -> Encoding)
204192 -> f a -> Encoding
205−genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
193+genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
206194
207195-------------------------------------------------------------------------------
208196-- Class
@@ -210,9 +198,6 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
210198
211199-- | A type that can be converted to JSON.
212200--
213−-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214−-- to) specify 'toEncoding'.
215−--
216201-- An example type and instance:
217202--
218203-- @
@@ -221,10 +206,10 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
221206--
222207-- data Coord = Coord { x :: Double, y :: Double }
223208--
224−-- instance 'ToJSON' Coord where
225−-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
209+-- instance ToJSON Coord where
210+-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
226211--
227−-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
212+-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
228213-- @
229214--
230215-- Instead of manually writing your 'ToJSON' instance, there are two options
@@ -232,15 +217,17 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
232217--
233218-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
234219-- instance at compile time. The generated instance is optimized for your type
235−-- so it will probably be more efficient than the following option.
220+-- so will probably be more efficient than the following two options:
236221--
237222-- * The compiler can provide a default generic implementation for
238223-- 'toJSON'.
239224--
240225-- 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):
226+-- datatype and declare a 'ToJSON' instance for your datatype without giving
227+-- definitions for 'toJSON' or 'toEncoding'.
228+--
229+-- For example, the previous example can be simplified to a more
230+-- minimal instance:
244231--
245232-- @
246233-- {-\# LANGUAGE DeriveGeneric \#-}
@@ -249,46 +236,35 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
249236--
250237-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
251238--
252−-- instance 'ToJSON' Coord where
253−-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
239+-- instance ToJSON Coord where
240+-- toEncoding = 'genericToEncoding' 'defaultOptions'
254241-- @
255242--
256−-- If on the other hand you wish to customize the generic decoding, you have
257−-- to implement both methods:
243+-- Why do we provide an implementation for 'toEncoding' here? The
244+-- 'toEncoding' function is a relatively new addition to this class.
245+-- To allow users of older versions of this library to upgrade without
246+-- having to edit all of their instances or encounter surprising
247+-- incompatibilities, the default implementation of 'toEncoding' uses
248+-- 'toJSON'. This produces correct results, but since it performs an
249+-- intermediate conversion to a 'Value', it will be less efficient
250+-- than directly emitting an 'Encoding'. Our one-liner definition of
251+-- 'toEncoding' above bypasses the intermediate 'Value'.
252+--
253+-- If @DefaultSignatures@ doesn't give exactly the results you want,
254+-- you can customize the generic encoding with only a tiny amount of
255+-- effort, using 'genericToJSON' and 'genericToEncoding' with your
256+-- preferred 'Options':
258257--
259258-- @
260−-- customOptions = 'defaultOptions'
261−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
262−-- }
263−--
264−-- instance 'ToJSON' Coord where
265−-- 'toJSON' = 'genericToJSON' customOptions
266−-- 'toEncoding' = 'genericToEncoding' customOptions
259+-- instance ToJSON Coord where
260+-- toJSON = 'genericToJSON' 'defaultOptions'
261+-- toEncoding = 'genericToEncoding' 'defaultOptions'
267262-- @
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.)
287263class ToJSON a where
288264 -- | Convert a Haskell value to a JSON-friendly intermediate type.
289265 toJSON :: a -> Value
290266
291− default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
267+ default toJSON :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
292268 toJSON = genericToJSON defaultOptions
293269
294270 -- | Encode a Haskell value as JSON.
@@ -305,8 +281,8 @@ class ToJSON a where
305281 -- extension, and then have GHC generate a method body as follows.
306282 --
307283 -- @
308− -- instance 'ToJSON' Coord where
309− -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
284+ -- instance ToJSON Coord where
285+ -- toEncoding = 'genericToEncoding' 'defaultOptions'
310286 -- @
311287
312288 toEncoding :: a -> Encoding
@@ -338,13 +314,6 @@ instance KeyValue Pair where
338314 name .= value = (name, toJSON value)
339315 {-# INLINE (.=) #-}
340316
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−
348317-------------------------------------------------------------------------------
349318-- Classes and types for map keys
350319-------------------------------------------------------------------------------
@@ -402,7 +371,7 @@ instance KeyValue Object where
402371-- newtype wrapper around 'Text'. The recommended approach is to use
403372-- generalized newtype deriving:
404373--
405−-- > newtype RecordId = RecordId { getRecordId :: Text }
374+-- > newtype RecordId = RecordId { getRecordId :: Text}
406375-- > deriving (Eq,Ord,ToJSONKey)
407376--
408377-- Then we may write:
@@ -417,18 +386,8 @@ instance KeyValue Object where
417386--
418387-- It is possible to get the 'ToJSONKey' instance for free as we did
419388-- 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−--
389+-- and from 'Text' that does not require any escape sequences. So, in
390+-- this example, 'ToJSONKeyText' will be used instead of 'ToJSONKeyValue'.
432391-- The 'Show' instance can be used to help write 'ToJSONKey':
433392--
434393-- > instance ToJSONKey Color where
@@ -503,42 +462,16 @@ toJSONKeyTextEnc e = ToJSONKeyText tot e
503462 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
504463 tot = T.dropAround (== '"')
505464 . T.decodeLatin1
506− . L.toStrict
465+ . lazyToStrictByteString
507466 . E.encodingToLazyByteString
508467 . e
509468
510−instance Contravariant ToJSONKeyFunction where
511− contramap = contramapToJSONKeyFunction
512−
513469-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
514470contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
515471contramapToJSONKeyFunction h x = case x of
516472 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
517473 ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
518474
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−
542475-------------------------------------------------------------------------------
543476-- Lifings of FromJSON and ToJSON to unary and binary type constructors
544477-------------------------------------------------------------------------------
@@ -551,7 +484,7 @@ instance GetConName f => GToJSONKey f
551484--
552485-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
553486-- instance at compile time. The generated instance is optimized for your type
554−-- so it will probably be more efficient than the following option.
487+-- so will probably be more efficient than the following two options:
555488--
556489-- * The compiler can provide a default generic implementation for
557490-- 'toJSON1'.
@@ -569,29 +502,23 @@ instance GetConName f => GToJSONKey f
569502--
570503-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
571504--
572−-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
505+-- instance ToJSON a => ToJSON1 (Pair a)
573506-- @
574507--
575−-- If the default implementation doesn't give exactly the results you want,
508+-- If @DefaultSignatures@ doesn't give exactly the results you want,
576509-- you can customize the generic encoding with only a tiny amount of
577510-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
578511-- your preferred 'Options':
579512--
580513-- @
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
514+-- instance ToJSON a => ToJSON1 (Pair a) where
515+-- liftToJSON = 'genericLiftToJSON' 'defaultOptions'
516+-- liftToEncoding = 'genericLiftToEncoding' 'defaultOptions'
588517-- @
589−--
590−-- See also 'ToJSON'.
591518class ToJSON1 f where
592519 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
593520
594− default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
521+ default liftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
595522 => (a -> Value) -> ([a] -> Value) -> f a -> Value
596523 liftToJSON = genericLiftToJSON defaultOptions
597524
@@ -600,7 +527,7 @@ class ToJSON1 f where
600527
601528 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
602529
603− default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
530+ default liftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
604531 => (a -> Encoding) -> ([a] -> Encoding)
605532 -> f a -> Encoding
606533 liftToEncoding = genericLiftToEncoding defaultOptions
@@ -654,7 +581,7 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
654581-- @
655582-- newtype F a = F [a]
656583--
657−-- -- This instance encodes 'String' as an array of chars
584+-- -- This instance encodes String as an array of chars
658585-- instance 'ToJSON1' F where
659586-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
660587-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
@@ -685,11 +612,6 @@ instance ToJSON1 [] where
685612 {-# INLINE liftToEncoding #-}
686613
687614instance (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−
693615 toJSON = toJSON1
694616 {-# INLINE toJSON #-}
695617
@@ -700,80 +622,39 @@ instance (ToJSON a) => ToJSON [a] where
700622-- Generic toJSON / toEncoding
701623-------------------------------------------------------------------------------
702624
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−
744625--------------------------------------------------------------------------------
745626-- Generic toJSON
746627
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 #-}
628+instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where
629+ -- Meta-information, which is not handled elsewhere, is ignored:
630+ gToJSON opts targs = gToJSON opts targs . unM1
756631
757−instance ToJSON a => GToJSON Value arity (K1 i a) where
632+instance (ToJSON a) => GToJSON arity (K1 i a) where
758633 -- Constant values are encoded using their ToJSON instance:
759634 gToJSON _opts _ = toJSON . unK1
760− {-# INLINE gToJSON #-}
761635
762−instance ToJSON1 f => GToJSON Value One (Rec1 f) where
636+instance GToJSON One Par1 where
637+ -- Direct occurrences of the last type parameter are encoded with the
638+ -- function passed in as an argument:
639+ gToJSON _opts (To1Args tj _) = tj . unPar1
640+
641+instance (ToJSON1 f) => GToJSON One (Rec1 f) where
763642 -- Recursive occurrences of the last type parameter are encoded using their
764643 -- ToJSON1 instance:
765644 gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766− {-# INLINE gToJSON #-}
767645
768−instance GToJSON Value arity U1 where
646+instance GToJSON arity U1 where
769647 -- Empty constructors are encoded to an empty array:
770648 gToJSON _opts _ _ = emptyArray
771− {-# INLINE gToJSON #-}
649+
650+instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where
651+ -- Constructors need to be encoded differently depending on whether they're
652+ -- a record or not. This distinction is made by 'consToJSON':
653+ gToJSON opts targs = consToJSON opts targs . unM1
772654
773655instance ( WriteProduct arity a, WriteProduct arity b
774656 , ProductSize a, ProductSize b
775− ) => GToJSON Value arity (a :*: b)
776− where
657+ ) => GToJSON arity (a :*: b) where
777658 -- Products are encoded to an array. Here we allocate a mutable vector of
778659 -- the same size as the product and write the product's elements to it using
779660 -- 'writeProduct':
@@ -785,175 +666,238 @@ instance ( WriteProduct arity a, WriteProduct arity b
785666 where
786667 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
787668 productSize
788− {-# INLINE gToJSON #-}
789669
790−instance ( ToJSON1 f
791− , GToJSON Value One g
792− ) => GToJSON Value One (f :.: g)
793− where
670+instance ( AllNullary (a :+: b) allNullary
671+ , SumToJSON arity (a :+: b) allNullary
672+ ) => GToJSON arity (a :+: b) where
673+ -- If all constructors of a sum datatype are nullary and the
674+ -- 'allNullaryToStringTag' option is set they are encoded to
675+ -- strings. This distinction is made by 'sumToJSON':
676+ gToJSON opts targs = (unTagged :: Tagged allNullary Value -> Value)
677+ . sumToJSON opts targs
678+
679+instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where
794680 -- If an occurrence of the last type parameter is nested inside two
795681 -- composed types, it is encoded by using the outermost type's ToJSON1
796682 -- instance to generically encode the innermost type:
797683 gToJSON opts targs =
798684 let gtj = gToJSON opts targs in
799685 liftToJSON gtj (listValue gtj) . unComp1
800− {-# INLINE gToJSON #-}
801686
802687--------------------------------------------------------------------------------
803688-- Generic toEncoding
804689
805−instance ToJSON a => GToJSON Encoding arity (K1 i a) where
690+instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where
691+ -- Meta-information, which is not handled elsewhere, is ignored:
692+ gToEncoding opts targs = gToEncoding opts targs . unM1
693+
694+instance (ToJSON a) => GToEncoding arity (K1 i a) where
806695 -- Constant values are encoded using their ToJSON instance:
807− gToJSON _opts _ = toEncoding . unK1
808− {-# INLINE gToJSON #-}
696+ gToEncoding _opts _ = toEncoding . unK1
697+
698+instance GToEncoding One Par1 where
699+ -- Direct occurrences of the last type parameter are encoded with the
700+ -- function passed in as an argument:
701+ gToEncoding _opts (To1Args te _) = te . unPar1
809702
810−instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
703+instance (ToJSON1 f) => GToEncoding One (Rec1 f) where
811704 -- Recursive occurrences of the last type parameter are encoded using their
812705 -- ToEncoding1 instance:
813− gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814− {-# INLINE gToJSON #-}
706+ gToEncoding _opts (To1Args te tel) = liftToEncoding te tel . unRec1
815707
816−instance GToJSON Encoding arity U1 where
708+instance GToEncoding arity U1 where
817709 -- Empty constructors are encoded to an empty array:
818− gToJSON _opts _ _ = E.emptyArray_
819− {-# INLINE gToJSON #-}
710+ gToEncoding _opts _ _ = E.emptyArray_
711+
712+instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where
713+ -- Constructors need to be encoded differently depending on whether they're
714+ -- a record or not. This distinction is made by 'consToEncoding':
715+ gToEncoding opts targs = consToEncoding opts targs . unM1
820716
821717instance ( EncodeProduct arity a
822718 , EncodeProduct arity b
823− ) => GToJSON Encoding arity (a :*: b)
824− where
719+ ) => GToEncoding arity (a :*: b) where
825720 -- Products are encoded to an array. Here we allocate a mutable vector of
826721 -- the same size as the product and write the product's elements to it using
827722 -- 'encodeProduct':
828− gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
829− {-# INLINE gToJSON #-}
723+ gToEncoding opts targs p = E.tuple $ encodeProduct opts targs p
830724
831−instance ( ToJSON1 f
832− , GToJSON Encoding One g
833− ) => GToJSON Encoding One (f :.: g)
834− where
725+instance ( AllNullary (a :+: b) allNullary
726+ , SumToEncoding arity (a :+: b) allNullary
727+ ) => GToEncoding arity (a :+: b) where
728+ -- If all constructors of a sum datatype are nullary and the
729+ -- 'allNullaryToStringTag' option is set they are encoded to
730+ -- strings. This distinction is made by 'sumToEncoding':
731+ gToEncoding opts targs
732+ = (unTagged :: Tagged allNullary Encoding -> Encoding)
733+ . sumToEncoding opts targs
734+
735+instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where
835736 -- If an occurrence of the last type parameter is nested inside two
836737 -- composed types, it is encoded by using the outermost type's ToJSON1
837738 -- instance to generically encode the innermost type:
838− gToJSON opts targs =
839− let gte = gToJSON opts targs in
739+ gToEncoding opts targs =
740+ let gte = gToEncoding opts targs in
840741 liftToEncoding gte (listEncoding gte) . unComp1
841− {-# INLINE gToJSON #-}
842742
843743--------------------------------------------------------------------------------
844744
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
745+class SumToJSON arity f allNullary where
746+ sumToJSON :: Options -> ToArgs Value arity a
747+ -> f a -> Tagged allNullary Value
748+
749+instance ( GetConName f
750+ , TaggedObjectPairs arity f
751+ , ObjectWithSingleFieldObj arity f
752+ , TwoElemArrayObj arity f
753+ , UntaggedValueObj arity f
754+ ) => SumToJSON arity f True where
857755 sumToJSON opts targs
858− | allNullaryToStringTag opts = Tagged . fromString
756+ | allNullaryToStringTag opts = Tagged . String . pack
859757 . constructorTagModifier opts . getConName
860758 | otherwise = Tagged . nonAllNullarySumToJSON opts targs
861759
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
760+instance ( TwoElemArrayObj arity f
761+ , TaggedObjectPairs arity f
762+ , ObjectWithSingleFieldObj arity f
763+ , UntaggedValueObj arity f
764+ ) => SumToJSON arity f False where
868765 sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
869766
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
767+nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f
768+ , TaggedObjectPairs arity f
769+ , ObjectWithSingleFieldObj arity f
770+ , UntaggedValueObj arity f
771+ ) => Options -> ToArgs Value arity a
772+ -> f a -> Value
876773nonAllNullarySumToJSON opts targs =
877774 case sumEncoding opts of
878−
879775 TaggedObject{..} ->
880− taggedObject opts targs tagFieldName contentsFieldName
776+ object . taggedObjectPairs opts targs tagFieldName contentsFieldName
777+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts targs
778+ TwoElemArray -> Array . twoElemArrayObj opts targs
779+ UntaggedValue -> untaggedValueObj opts targs
881780
882− ObjectWithSingleField ->
883− (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884− . sumToJSON' opts targs
885−
886− TwoElemArray ->
887− (unTagged :: Tagged TwoElemArray enc -> enc)
888− . sumToJSON' opts targs
781+--------------------------------------------------------------------------------
889782
890− UntaggedValue ->
891− (unTagged :: Tagged UntaggedValue enc -> enc)
892− . sumToJSON' opts targs
783+class SumToEncoding arity f allNullary where
784+ sumToEncoding :: Options -> ToArgs Encoding arity a
785+ -> f a -> Tagged allNullary Encoding
786+
787+instance ( GetConName f
788+ , TaggedObjectEnc arity f
789+ , ObjectWithSingleFieldEnc arity f
790+ , TwoElemArrayEnc arity f
791+ , UntaggedValueEnc arity f
792+ ) => SumToEncoding arity f True where
793+ sumToEncoding opts targs
794+ | allNullaryToStringTag opts = Tagged . toEncoding .
795+ constructorTagModifier opts . getConName
796+ | otherwise = Tagged . nonAllNullarySumToEncoding opts targs
797+
798+instance ( TwoElemArrayEnc arity f
799+ , TaggedObjectEnc arity f
800+ , ObjectWithSingleFieldEnc arity f
801+ , UntaggedValueEnc arity f
802+ ) => SumToEncoding arity f False where
803+ sumToEncoding opts targs = Tagged . nonAllNullarySumToEncoding opts targs
804+
805+nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f
806+ , TaggedObjectEnc arity f
807+ , ObjectWithSingleFieldEnc arity f
808+ , UntaggedValueEnc arity f
809+ ) => Options -> ToArgs Encoding arity a
810+ -> f a -> Encoding
811+nonAllNullarySumToEncoding opts targs =
812+ case sumEncoding opts of
813+ TaggedObject{..} ->
814+ taggedObjectEnc opts targs tagFieldName contentsFieldName
815+ ObjectWithSingleField -> objectWithSingleFieldEnc opts targs
816+ TwoElemArray -> twoElemArrayEnc opts targs
817+ UntaggedValue -> untaggedValueEnc opts targs
893818
894819--------------------------------------------------------------------------------
895820
896−class FromString enc where
897− fromString :: String -> enc
821+class TaggedObjectPairs arity f where
822+ taggedObjectPairs :: Options -> ToArgs Value arity a
823+ -> String -> String
824+ -> f a -> [Pair]
825+
826+instance ( TaggedObjectPairs arity a
827+ , TaggedObjectPairs arity b
828+ ) => TaggedObjectPairs arity (a :+: b) where
829+ taggedObjectPairs opts targs tagFieldName contentsFieldName (L1 x) =
830+ taggedObjectPairs opts targs tagFieldName contentsFieldName x
831+ taggedObjectPairs opts targs tagFieldName contentsFieldName (R1 x) =
832+ taggedObjectPairs opts targs tagFieldName contentsFieldName x
833+
834+instance ( IsRecord a isRecord
835+ , TaggedObjectPairs' arity a isRecord
836+ , Constructor c
837+ ) => TaggedObjectPairs arity (C1 c a) where
838+ taggedObjectPairs opts targs tagFieldName contentsFieldName =
839+ (pack tagFieldName .= constructorTagModifier opts
840+ (conName (undefined :: t c a p)) :) .
841+ (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
842+ taggedObjectPairs' opts targs contentsFieldName . unM1
898843
899−instance FromString Encoding where
900− fromString = toEncoding
844+class TaggedObjectPairs' arity f isRecord where
845+ taggedObjectPairs' :: Options -> ToArgs Value arity a
846+ -> String -> f a -> Tagged isRecord [Pair]
901847
902−instance FromString Value where
903− fromString = String . pack
848+instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where
849+ taggedObjectPairs' _ _ _ _ = Tagged []
904850
905−--------------------------------------------------------------------------------
851+instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where
852+ taggedObjectPairs' opts targs _ =
853+ Tagged . toList . recordToPairs opts targs
906854
907−class TaggedObject enc arity f where
908− taggedObject :: Options -> ToArgs enc arity a
909− -> String -> String
910− -> f a -> enc
855+instance (GToJSON arity f) => TaggedObjectPairs' arity f False where
856+ taggedObjectPairs' opts targs contentsFieldName =
857+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts targs
911858
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
926− , 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
859+--------------------------------------------------------------------------------
952860
953−instance ( RecordToPairs enc pairs arity f
954− ) => TaggedObject' enc pairs arity f True
955− where
956− taggedObject' opts targs _ = Tagged . recordToPairs opts targs
861+class TaggedObjectEnc arity f where
862+ taggedObjectEnc :: Options -> ToArgs Encoding arity a
863+ -> String -> String
864+ -> f a -> Encoding
865+
866+instance ( TaggedObjectEnc arity a
867+ , TaggedObjectEnc arity b
868+ ) => TaggedObjectEnc arity (a :+: b) where
869+ taggedObjectEnc opts targs tagFieldName contentsFieldName (L1 x) =
870+ taggedObjectEnc opts targs tagFieldName contentsFieldName x
871+ taggedObjectEnc opts targs tagFieldName contentsFieldName (R1 x) =
872+ taggedObjectEnc opts targs tagFieldName contentsFieldName x
873+
874+instance ( IsRecord a isRecord
875+ , TaggedObjectEnc' arity a isRecord
876+ , Constructor c
877+ ) => TaggedObjectEnc arity (C1 c a) where
878+ taggedObjectEnc opts targs tagFieldName contentsFieldName v =
879+ E.wrapObject $
880+ (E.string tagFieldName ><
881+ E.colon ><
882+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) ><
883+ ((unTagged :: Tagged isRecord Encoding -> Encoding) .
884+ taggedObjectEnc' opts targs contentsFieldName . unM1 $ v)
885+
886+class TaggedObjectEnc' arity f isRecord where
887+ taggedObjectEnc' :: Options -> ToArgs Encoding arity a
888+ -> String -> f a -> Tagged isRecord Encoding
889+
890+instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where
891+ taggedObjectEnc' _ _ _ _ = Tagged E.empty
892+
893+instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where
894+ taggedObjectEnc' opts targs _ = Tagged . (E.comma ><) . fst
895+ . recordToEncoding opts targs
896+
897+instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where
898+ taggedObjectEnc' opts targs contentsFieldName =
899+ Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .
900+ gToEncoding opts targs
957901
958902--------------------------------------------------------------------------------
959903
@@ -968,38 +912,23 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where
968912instance (Constructor c) => GetConName (C1 c a) where
969913 getConName = conName
970914
971−-- For genericToJSONKey
972−instance GetConName a => GetConName (D1 d a) where
973− getConName (M1 x) = getConName x
974−
975915--------------------------------------------------------------------------------
976916
977−-- Reflection of SumEncoding variants
978−
979−data ObjectWithSingleField
980−data TwoElemArray
981−data UntaggedValue
982−
983−--------------------------------------------------------------------------------
917+class TwoElemArrayObj arity f where
918+ twoElemArrayObj :: Options -> ToArgs Value arity a
919+ -> f a -> V.Vector Value
984920
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−--------------------------------------------------------------------------------
921+instance ( TwoElemArrayObj arity a
922+ , TwoElemArrayObj arity b
923+ ) => TwoElemArrayObj arity (a :+: b) where
924+ twoElemArrayObj opts targs (L1 x) = twoElemArrayObj opts targs x
925+ twoElemArrayObj opts targs (R1 x) = twoElemArrayObj opts targs x
997926
998−instance ( GToJSON Value arity a
999− , ConsToJSON Value arity a
927+instance ( GToJSON arity a
928+ , ConsToJSON arity a
1000929 , Constructor c
1001− ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
1002− sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
930+ ) => TwoElemArrayObj arity (C1 c a) where
931+ twoElemArrayObj opts targs x = V.create $ do
1003932 mv <- VM.unsafeNew 2
1004933 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
1005934 $ conName (undefined :: t c a p)
@@ -1008,121 +937,148 @@ instance ( GToJSON Value arity a
1008937
1009938--------------------------------------------------------------------------------
1010939
1011−instance ( GToJSON Encoding arity a
1012− , ConsToJSON Encoding arity a
940+class TwoElemArrayEnc arity f where
941+ twoElemArrayEnc :: Options -> ToArgs Encoding arity a
942+ -> f a -> Encoding
943+
944+instance ( TwoElemArrayEnc arity a
945+ , TwoElemArrayEnc arity b
946+ ) => TwoElemArrayEnc arity (a :+: b) where
947+ twoElemArrayEnc opts targs (L1 x) = twoElemArrayEnc opts targs x
948+ twoElemArrayEnc opts targs (R1 x) = twoElemArrayEnc opts targs x
949+
950+instance ( GToEncoding arity a
951+ , ConsToEncoding arity a
1013952 , 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− ]
953+ ) => TwoElemArrayEnc arity (C1 c a) where
954+ twoElemArrayEnc opts targs x = E.tuple $
955+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
956+ gToEncoding opts targs x
1020957
1021958--------------------------------------------------------------------------------
1022959
1023−class ConsToJSON enc arity f where
1024− consToJSON :: Options -> ToArgs enc arity a
1025− -> f a -> enc
960+class ConsToJSON arity f where
961+ consToJSON :: Options -> ToArgs Value arity a
962+ -> f a -> Value
1026963
1027−class ConsToJSON' enc arity f isRecord where
1028− consToJSON' :: Options -> ToArgs enc arity a
1029− -> f a -> Tagged isRecord enc
964+class ConsToJSON' arity f isRecord where
965+ consToJSON' :: Options -> ToArgs Value arity a
966+ -> Bool -- ^ Are we a record with one field?
967+ -> f a -> Tagged isRecord Value
1030968
1031−instance ( IsRecord f isRecord
1032− , ConsToJSON' enc arity f isRecord
1033− ) => ConsToJSON enc arity f
1034− where
969+instance ( IsRecord f isRecord
970+ , ConsToJSON' arity f isRecord
971+ ) => ConsToJSON arity f where
1035972 consToJSON opts targs =
1036− (unTagged :: Tagged isRecord enc -> enc)
1037− . consToJSON' opts targs
1038− {-# INLINE consToJSON #-}
973+ (unTagged :: Tagged isRecord Value -> Value)
974+ . consToJSON' opts targs (isUnary (undefined :: f a))
1039975
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' #-}
976+instance (RecordToPairs arity f) => ConsToJSON' arity f True where
977+ consToJSON' opts targs isUn f = let
978+ vals = toList $ recordToPairs opts targs f
979+ in case (unwrapUnaryRecords opts,isUn,vals) of
980+ (True,True,[(_,val)]) -> Tagged val
981+ _ -> Tagged $ object vals
1057982
1058−instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1059− consToJSON' opts targs = Tagged . gToJSON opts targs
1060− {-# INLINE consToJSON' #-}
983+instance GToJSON arity f => ConsToJSON' arity f False where
984+ consToJSON' opts targs _ = Tagged . gToJSON opts targs
1061985
1062986--------------------------------------------------------------------------------
1063987
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
988+class ConsToEncoding arity f where
989+ consToEncoding :: Options -> ToArgs Encoding arity a
990+ -> f a -> Encoding
1070991
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
992+class ConsToEncoding' arity f isRecord where
993+ consToEncoding' :: Options -> ToArgs Encoding arity a
994+ -> Bool -- ^ Are we a record with one field?
995+ -> f a -> Tagged isRecord Encoding
996+
997+instance ( IsRecord f isRecord
998+ , ConsToEncoding' arity f isRecord
999+ ) => ConsToEncoding arity f where
1000+ consToEncoding opts targs =
1001+ (unTagged :: Tagged isRecord Encoding -> Encoding)
1002+ . consToEncoding' opts targs (isUnary (undefined :: f a))
1003+
1004+instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where
1005+ consToEncoding' opts targs isUn x =
1006+ let (enc, mbVal) = recordToEncoding opts targs x
1007+ in case (unwrapUnaryRecords opts, isUn, mbVal) of
1008+ (True, True, Just val) -> Tagged val
1009+ _ -> Tagged $ E.wrapObject enc
1010+
1011+instance GToEncoding arity f => ConsToEncoding' arity f False where
1012+ consToEncoding' opts targs _ = Tagged . gToEncoding opts targs
1013+
1014+--------------------------------------------------------------------------------
1015+
1016+class RecordToPairs arity f where
1017+ recordToPairs :: Options -> ToArgs Value arity a
1018+ -> f a -> DList Pair
1019+
1020+instance ( RecordToPairs arity a
1021+ , RecordToPairs arity b
1022+ ) => RecordToPairs arity (a :*: b) where
1023+ recordToPairs opts targs (a :*: b) = recordToPairs opts targs a <>
1024+ recordToPairs opts targs b
1025+
1026+instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where
10881027 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
1028+
1029+instance OVERLAPPING_ (Selector s, ToJSON a) =>
1030+ RecordToPairs arity (S1 s (K1 i (Maybe a))) where
10981031 recordToPairs opts _ (M1 k1) | omitNothingFields opts
1099− , K1 Nothing <- k1 = mempty
1032+ , K1 Nothing <- k1 = DList.empty
11001033 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 #-}
1034+
1035+fieldToPair :: (Selector s, GToJSON arity a)
1036+ => Options -> ToArgs Value arity p
1037+ -> S1 s a p -> DList Pair
1038+fieldToPair opts targs m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
1039+ , gToJSON opts targs (unM1 m1)
1040+ )
1041+
1042+--------------------------------------------------------------------------------
1043+
1044+class RecordToEncoding arity f where
1045+ -- 1st element: whole thing
1046+ -- 2nd element: in case the record has only 1 field, just the value
1047+ -- of the field (without the key); 'Nothing' otherwise
1048+ recordToEncoding :: Options -> ToArgs Encoding arity a
1049+ -> f a -> (Encoding, Maybe Encoding)
1050+
1051+instance ( RecordToEncoding arity a
1052+ , RecordToEncoding arity b
1053+ ) => RecordToEncoding arity (a :*: b) where
1054+ recordToEncoding opts targs (a :*: b) | omitNothingFields opts =
1055+ (E.econcat $ intersperse E.comma $
1056+ filter (not . E.nullEncoding)
1057+ [ fst (recordToEncoding opts targs a)
1058+ , fst (recordToEncoding opts targs b) ]
1059+ , Nothing)
1060+ recordToEncoding opts targs (a :*: b) =
1061+ (fst (recordToEncoding opts targs a) >< E.comma ><
1062+ fst (recordToEncoding opts targs b),
1063+ Nothing)
1064+
1065+
1066+instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) where
1067+ recordToEncoding = fieldToEncoding
1068+
1069+instance OVERLAPPING_ (Selector s, ToJSON a) =>
1070+ RecordToEncoding arity (S1 s (K1 i (Maybe a))) where
1071+ recordToEncoding opts _ (M1 k1) | omitNothingFields opts
1072+ , K1 Nothing <- k1 = (E.empty, Nothing)
1073+ recordToEncoding opts targs m1 = fieldToEncoding opts targs m1
1074+
1075+fieldToEncoding :: (Selector s, GToEncoding arity a)
1076+ => Options -> ToArgs Encoding arity p
1077+ -> S1 s a p -> (Encoding, Maybe Encoding)
1078+fieldToEncoding opts targs m1 =
1079+ let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
1080+ valueBuilder = gToEncoding opts targs (unM1 m1)
1081+ in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)
11261082
11271083--------------------------------------------------------------------------------
11281084
@@ -1145,12 +1101,10 @@ instance ( WriteProduct arity a
11451101 lenL = len `unsafeShiftR` 1
11461102 lenR = len - lenL
11471103 ixR = ix + lenL
1148− {-# INLINE writeProduct #-}
11491104
1150−instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
1105+instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
11511106 writeProduct opts targs mv ix _ =
11521107 VM.unsafeWrite mv ix . gToJSON opts targs
1153− {-# INLINE writeProduct #-}
11541108
11551109--------------------------------------------------------------------------------
11561110
@@ -1165,44 +1119,114 @@ instance ( EncodeProduct arity a
11651119 E.econcat $ intersperse E.comma $
11661120 filter (not . E.nullEncoding)
11671121 [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 #-}
1122+ encodeProduct opts targs (a :*: b) = encodeProduct opts targs a >*<
1123+ encodeProduct opts targs b
11721124
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 #-}
1125+instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1126+ encodeProduct opts targs a = E.retagEncoding $ gToEncoding opts targs a
11761127
11771128--------------------------------------------------------------------------------
11781129
1179−instance ( GToJSON enc arity a
1180− , ConsToJSON enc arity a
1181− , FromPairs enc pairs
1182− , KeyValuePair enc pairs
1130+class ObjectWithSingleFieldObj arity f where
1131+ objectWithSingleFieldObj :: Options -> ToArgs Value arity a
1132+ -> f a -> Object
1133+
1134+instance ( ObjectWithSingleFieldObj arity a
1135+ , ObjectWithSingleFieldObj arity b
1136+ ) => ObjectWithSingleFieldObj arity (a :+: b) where
1137+ objectWithSingleFieldObj opts targs (L1 x) =
1138+ objectWithSingleFieldObj opts targs x
1139+ objectWithSingleFieldObj opts targs (R1 x) =
1140+ objectWithSingleFieldObj opts targs x
1141+
1142+instance ( GToJSON arity a
1143+ , ConsToJSON arity a
11831144 , Constructor c
1184− ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1185− where
1186− sumToJSON' opts targs =
1187− Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
1145+ ) => ObjectWithSingleFieldObj arity (C1 c a) where
1146+ objectWithSingleFieldObj opts targs = H.singleton typ . gToJSON opts targs
11881147 where
1189− typ = constructorTagModifier opts $
1148+ typ = pack $ constructorTagModifier opts $
11901149 conName (undefined :: t c a p)
11911150
11921151--------------------------------------------------------------------------------
11931152
1153+class ObjectWithSingleFieldEnc arity f where
1154+ objectWithSingleFieldEnc :: Options -> ToArgs Encoding arity a
1155+ -> f a -> Encoding
1156+
1157+instance ( ObjectWithSingleFieldEnc arity a
1158+ , ObjectWithSingleFieldEnc arity b
1159+ ) => ObjectWithSingleFieldEnc arity (a :+: b) where
1160+ objectWithSingleFieldEnc opts targs (L1 x) =
1161+ objectWithSingleFieldEnc opts targs x
1162+ objectWithSingleFieldEnc opts targs (R1 x) =
1163+ objectWithSingleFieldEnc opts targs x
1164+
1165+instance ( GToEncoding arity a
1166+ , ConsToEncoding arity a
1167+ , Constructor c
1168+ ) => ObjectWithSingleFieldEnc arity (C1 c a) where
1169+ objectWithSingleFieldEnc opts targs v =
1170+ E.openCurly ><
1171+ toEncoding
1172+ (constructorTagModifier opts
1173+ (conName (undefined :: t c a p))) ><
1174+ E.colon ><
1175+ gToEncoding opts targs v ><
1176+ E.closeCurly
1177+
1178+--------------------------------------------------------------------------------
1179+
1180+class UntaggedValueObj arity f where
1181+ untaggedValueObj :: Options -> ToArgs Value arity a
1182+ -> f a -> Value
1183+
1184+instance
1185+ ( UntaggedValueObj arity a
1186+ , UntaggedValueObj arity b
1187+ ) => UntaggedValueObj arity (a :+: b)
1188+ where
1189+ untaggedValueObj opts targs (L1 x) = untaggedValueObj opts targs x
1190+ untaggedValueObj opts targs (R1 x) = untaggedValueObj opts targs x
1191+
11941192instance OVERLAPPABLE_
1195− ( ConsToJSON enc arity a
1196− ) => SumToJSON' UntaggedValue enc arity (C1 c a)
1193+ ( GToJSON arity a
1194+ , ConsToJSON arity a
1195+ ) => UntaggedValueObj arity (C1 c a) where
1196+ untaggedValueObj = gToJSON
1197+
1198+instance OVERLAPPING_
1199+ ( Constructor c )
1200+ => UntaggedValueObj arity (C1 c U1)
11971201 where
1198− sumToJSON' opts targs = Tagged . gToJSON opts targs
1202+ untaggedValueObj opts _ _ = toJSON $
1203+ constructorTagModifier opts $ conName (undefined :: t c U1 p)
1204+
1205+--------------------------------------------------------------------------------
1206+
1207+class UntaggedValueEnc arity f where
1208+ untaggedValueEnc :: Options -> ToArgs Encoding arity a
1209+ -> f a -> Encoding
1210+instance
1211+ ( UntaggedValueEnc arity a
1212+ , UntaggedValueEnc arity b
1213+ ) => UntaggedValueEnc arity (a :+: b)
1214+ where
1215+ untaggedValueEnc opts targs (L1 x) = untaggedValueEnc opts targs x
1216+ untaggedValueEnc opts targs (R1 x) = untaggedValueEnc opts targs x
1217+
1218+instance OVERLAPPABLE_
1219+ ( GToEncoding arity a
1220+ , ConsToEncoding arity a
1221+ ) => UntaggedValueEnc arity (C1 c a)
1222+ where
1223+ untaggedValueEnc = gToEncoding
11991224
12001225instance OVERLAPPING_
1201− ( Constructor c
1202− , FromString enc
1203− ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
1226+ ( Constructor c )
1227+ => UntaggedValueEnc arity (C1 c U1)
12041228 where
1205− sumToJSON' opts _ _ = Tagged . fromString $
1229+ untaggedValueEnc opts _ _ = toEncoding $
12061230 constructorTagModifier opts $ conName (undefined :: t c U1 p)
12071231
12081232-------------------------------------------------------------------------------
@@ -1276,13 +1300,6 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
12761300 toEncoding = toEncoding2
12771301 {-# INLINE toEncoding #-}
12781302
1279−instance ToJSON Void where
1280− toJSON = absurd
1281− {-# INLINE toJSON #-}
1282−
1283− toEncoding = absurd
1284− {-# INLINE toEncoding #-}
1285−
12861303
12871304instance ToJSON Bool where
12881305 toJSON = Bool
@@ -1468,6 +1485,7 @@ instance ToJSONKey Int64 where
14681485 toJSONKey = toJSONKeyTextEnc E.int64Text
14691486 {-# INLINE toJSONKey #-}
14701487
1488+
14711489instance ToJSON Word where
14721490 toJSON = Number . fromIntegral
14731491 {-# INLINE toJSON #-}
@@ -1527,12 +1545,6 @@ instance ToJSONKey Word64 where
15271545 toJSONKey = toJSONKeyTextEnc E.word64Text
15281546 {-# INLINE toJSONKey #-}
15291547
1530−instance ToJSON CTime where
1531− toJSON (CTime i) = toJSON i
1532− {-# INLINE toJSON #-}
1533−
1534− toEncoding (CTime i) = toEncoding i
1535− {-# INLINE toEncoding #-}
15361548
15371549instance ToJSON Text where
15381550 toJSON = String
@@ -1647,7 +1659,7 @@ instance (ToJSON a) => ToJSON (Identity a) where
16471659 toEncodingList = liftToEncodingList toEncoding toEncodingList
16481660 {-# INLINE toEncodingList #-}
16491661
1650−instance (ToJSONKey a) => ToJSONKey (Identity a) where
1662+instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
16511663 toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
16521664 toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
16531665
@@ -1796,11 +1808,13 @@ instance ToJSONKey k => ToJSON1 (M.Map k) where
17961808 ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
17971809 {-# INLINE liftToJSON #-}
17981810
1811+ -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
17991812 liftToEncoding g _ = case toJSONKey of
18001813 ToJSONKeyText _ f -> dict f g M.foldrWithKey
18011814 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
18021815 where
1803− pairEncoding f (a, b) = E.list id [f a, g b]
1816+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1817+ pairEncoding f (a, b) = tuple $ f a >*< g b
18041818 {-# INLINE liftToEncoding #-}
18051819
18061820
@@ -1838,17 +1852,6 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
18381852 toEncoding = toEncoding1
18391853 {-# INLINE toEncoding #-}
18401854
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
18521855
18531856-------------------------------------------------------------------------------
18541857-- vector
@@ -1862,8 +1865,6 @@ instance ToJSON1 Vector where
18621865 {-# INLINE liftToEncoding #-}
18631866
18641867instance (ToJSON a) => ToJSON (Vector a) where
1865− {-# SPECIALIZE instance ToJSON Array #-}
1866−
18671868 toJSON = toJSON1
18681869 {-# INLINE toJSON #-}
18691870
@@ -1931,12 +1932,11 @@ instance ToJSONKey k => ToJSON1 (H.HashMap k) where
19311932 ToJSONKeyText _ f -> dict f g H.foldrWithKey
19321933 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
19331934 where
1934− pairEncoding f (a, b) = E.list id [f a, g b]
1935+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1936+ pairEncoding f (a, b) = tuple $ f a >*< g b
19351937 {-# INLINE liftToEncoding #-}
19361938
19371939instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938− {-# SPECIALIZE instance ToJSON Object #-}
1939−
19401940 toJSON = toJSON1
19411941 {-# INLINE toJSON #-}
19421942
@@ -1966,32 +1966,6 @@ dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
19661966formatMillis :: (FormatTime t) => t -> String
19671967formatMillis = take 3 . formatTime defaultTimeLocale "%q"
19681968
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−
19951969-------------------------------------------------------------------------------
19961970-- time
19971971-------------------------------------------------------------------------------
@@ -2040,11 +2014,10 @@ stringEncoding :: Encoding' Text -> Value
20402014stringEncoding = String
20412015 . T.dropAround (== '"')
20422016 . T.decodeLatin1
2043− . L.toStrict
2017+ . lazyToStrictByteString
20442018 . E.encodingToLazyByteString
20452019{-# INLINE stringEncoding #-}
20462020
2047−
20482021instance ToJSON NominalDiffTime where
20492022 toJSON = Number . realToFrac
20502023 {-# INLINE toJSON #-}
@@ -2052,159 +2025,18 @@ instance ToJSON NominalDiffTime where
20522025 toEncoding = E.scientific . realToFrac
20532026 {-# INLINE toEncoding #-}
20542027
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−
21072028-------------------------------------------------------------------------------
21082029-- base Monoid/Semigroup
21092030-------------------------------------------------------------------------------
21102031
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
2032+instance ToJSON1 Dual where
2033+ liftToJSON t _ = t . getDual
22022034 {-# INLINE liftToJSON #-}
22032035
2204− liftToEncoding t _ (Semigroup.Last x) = t x
2036+ liftToEncoding t _ = t . getDual
22052037 {-# INLINE liftToEncoding #-}
22062038
2207−instance ToJSON a => ToJSON (Semigroup.Last a) where
2039+instance ToJSON a => ToJSON (Dual a) where
22082040 toJSON = toJSON1
22092041 {-# INLINE toJSON #-}
22102042
@@ -2212,14 +2044,14 @@ instance ToJSON a => ToJSON (Semigroup.Last a) where
22122044 {-# INLINE toEncoding #-}
22132045
22142046
2215−instance ToJSON1 Semigroup.WrappedMonoid where
2216− liftToJSON t _ (Semigroup.WrapMonoid x) = t x
2047+instance ToJSON1 First where
2048+ liftToJSON t to' = liftToJSON t to' . getFirst
22172049 {-# INLINE liftToJSON #-}
22182050
2219− liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
2051+ liftToEncoding t to' = liftToEncoding t to' . getFirst
22202052 {-# INLINE liftToEncoding #-}
22212053
2222−instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2054+instance ToJSON a => ToJSON (First a) where
22232055 toJSON = toJSON1
22242056 {-# INLINE toJSON #-}
22252057
@@ -2227,14 +2059,14 @@ instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
22272059 {-# INLINE toEncoding #-}
22282060
22292061
2230−instance ToJSON1 Semigroup.Option where
2231− liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
2062+instance ToJSON1 Last where
2063+ liftToJSON t to' = liftToJSON t to' . getLast
22322064 {-# INLINE liftToJSON #-}
22332065
2234− liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
2066+ liftToEncoding t to' = liftToEncoding t to' . getLast
22352067 {-# INLINE liftToEncoding #-}
22362068
2237−instance ToJSON a => ToJSON (Semigroup.Option a) where
2069+instance ToJSON a => ToJSON (Last a) where
22382070 toJSON = toJSON1
22392071 {-# INLINE toJSON #-}
22402072
@@ -2245,13 +2077,6 @@ instance ToJSON a => ToJSON (Semigroup.Option a) where
22452077-- tagged
22462078-------------------------------------------------------------------------------
22472079
2248−instance ToJSON1 Proxy where
2249− liftToJSON _ _ _ = Null
2250− {-# INLINE liftToJSON #-}
2251−
2252− liftToEncoding _ _ _ = E.null_
2253− {-# INLINE liftToEncoding #-}
2254−
22552080instance ToJSON (Proxy a) where
22562081 toJSON _ = Null
22572082 {-# INLINE toJSON #-}
@@ -2260,13 +2085,6 @@ instance ToJSON (Proxy a) where
22602085 {-# INLINE toEncoding #-}
22612086
22622087
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−
22702088instance ToJSON1 (Tagged a) where
22712089 liftToJSON t _ (Tagged x) = t x
22722090 {-# INLINE liftToJSON #-}
@@ -2281,6 +2099,7 @@ instance ToJSON b => ToJSON (Tagged a b) where
22812099 toEncoding = toEncoding1
22822100 {-# INLINE toEncoding #-}
22832101
2102+
22842103instance ToJSONKey b => ToJSONKey (Tagged a b) where
22852104 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
22862105 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
@@ -2301,7 +2120,7 @@ instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
23012120 toJSONKey = toJSONKeyList
23022121
23032122-------------------------------------------------------------------------------
2304−-- Tuple instances
2123+-- Tuple instances, see tuple-instances-to.hs
23052124-------------------------------------------------------------------------------
23062125
23072126instance ToJSON2 (,) where
@@ -2312,7 +2131,9 @@ instance ToJSON2 (,) where
23122131 return mv
23132132 {-# INLINE liftToJSON2 #-}
23142133
2315− liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
2134+ liftToEncoding2 toA _ toB _ (a, b) = tuple $
2135+ toA a >*<
2136+ toB b
23162137 {-# INLINE liftToEncoding2 #-}
23172138
23182139instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -2336,11 +2157,10 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
23362157 return mv
23372158 {-# INLINE liftToJSON2 #-}
23382159
2339− liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2340− [ toEncoding a
2341− , toB b
2342− , toC c
2343− ]
2160+ liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
2161+ toEncoding a >*<
2162+ toB b >*<
2163+ toC c
23442164 {-# INLINE liftToEncoding2 #-}
23452165
23462166instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -2365,12 +2185,11 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
23652185 return mv
23662186 {-# INLINE liftToJSON2 #-}
23672187
2368− liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2369− [ toEncoding a
2370− , toEncoding b
2371− , toC c
2372− , toD d
2373− ]
2188+ liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
2189+ toEncoding a >*<
2190+ toEncoding b >*<
2191+ toC c >*<
2192+ toD d
23742193 {-# INLINE liftToEncoding2 #-}
23752194
23762195instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -2396,13 +2215,12 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
23962215 return mv
23972216 {-# INLINE liftToJSON2 #-}
23982217
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− ]
2218+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
2219+ toEncoding a >*<
2220+ toEncoding b >*<
2221+ toEncoding c >*<
2222+ toD d >*<
2223+ toE e
24062224 {-# INLINE liftToEncoding2 #-}
24072225
24082226instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
@@ -2429,14 +2247,13 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
24292247 return mv
24302248 {-# INLINE liftToJSON2 #-}
24312249
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− ]
2250+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
2251+ toEncoding a >*<
2252+ toEncoding b >*<
2253+ toEncoding c >*<
2254+ toEncoding d >*<
2255+ toE e >*<
2256+ toF f
24402257 {-# INLINE liftToEncoding2 #-}
24412258
24422259instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
@@ -2464,15 +2281,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
24642281 return mv
24652282 {-# INLINE liftToJSON2 #-}
24662283
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− ]
2284+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
2285+ toEncoding a >*<
2286+ toEncoding b >*<
2287+ toEncoding c >*<
2288+ toEncoding d >*<
2289+ toEncoding e >*<
2290+ toF f >*<
2291+ toG g
24762292 {-# INLINE liftToEncoding2 #-}
24772293
24782294instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
@@ -2501,16 +2317,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
25012317 return mv
25022318 {-# INLINE liftToJSON2 #-}
25032319
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− ]
2320+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
2321+ toEncoding a >*<
2322+ toEncoding b >*<
2323+ toEncoding c >*<
2324+ toEncoding d >*<
2325+ toEncoding e >*<
2326+ toEncoding f >*<
2327+ toG g >*<
2328+ toH h
25142329 {-# INLINE liftToEncoding2 #-}
25152330
25162331instance (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 +2355,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
25402355 return mv
25412356 {-# INLINE liftToJSON2 #-}
25422357
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− ]
2358+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
2359+ toEncoding a >*<
2360+ toEncoding b >*<
2361+ toEncoding c >*<
2362+ toEncoding d >*<
2363+ toEncoding e >*<
2364+ toEncoding f >*<
2365+ toEncoding g >*<
2366+ toH h >*<
2367+ toI i
25542368 {-# INLINE liftToEncoding2 #-}
25552369
25562370instance (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 +2395,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
25812395 return mv
25822396 {-# INLINE liftToJSON2 #-}
25832397
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− ]
2398+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
2399+ toEncoding a >*<
2400+ toEncoding b >*<
2401+ toEncoding c >*<
2402+ toEncoding d >*<
2403+ toEncoding e >*<
2404+ toEncoding f >*<
2405+ toEncoding g >*<
2406+ toEncoding h >*<
2407+ toI i >*<
2408+ toJ j
25962409 {-# INLINE liftToEncoding2 #-}
25972410
25982411instance (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 +2437,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
26242437 return mv
26252438 {-# INLINE liftToJSON2 #-}
26262439
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− ]
2440+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
2441+ toEncoding a >*<
2442+ toEncoding b >*<
2443+ toEncoding c >*<
2444+ toEncoding d >*<
2445+ toEncoding e >*<
2446+ toEncoding f >*<
2447+ toEncoding g >*<
2448+ toEncoding h >*<
2449+ toEncoding i >*<
2450+ toJ j >*<
2451+ toK k
26402452 {-# INLINE liftToEncoding2 #-}
26412453
26422454instance (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 +2481,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
26692481 return mv
26702482 {-# INLINE liftToJSON2 #-}
26712483
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− ]
2484+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
2485+ toEncoding a >*<
2486+ toEncoding b >*<
2487+ toEncoding c >*<
2488+ toEncoding d >*<
2489+ toEncoding e >*<
2490+ toEncoding f >*<
2491+ toEncoding g >*<
2492+ toEncoding h >*<
2493+ toEncoding i >*<
2494+ toEncoding j >*<
2495+ toK k >*<
2496+ toL l
26862497 {-# INLINE liftToEncoding2 #-}
26872498
26882499instance (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 +2527,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
27162527 return mv
27172528 {-# INLINE liftToJSON2 #-}
27182529
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− ]
2530+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
2531+ toEncoding a >*<
2532+ toEncoding b >*<
2533+ toEncoding c >*<
2534+ toEncoding d >*<
2535+ toEncoding e >*<
2536+ toEncoding f >*<
2537+ toEncoding g >*<
2538+ toEncoding h >*<
2539+ toEncoding i >*<
2540+ toEncoding j >*<
2541+ toEncoding k >*<
2542+ toL l >*<
2543+ toM m
27342544 {-# INLINE liftToEncoding2 #-}
27352545
27362546instance (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 +2575,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
27652575 return mv
27662576 {-# INLINE liftToJSON2 #-}
27672577
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− ]
2578+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
2579+ toEncoding a >*<
2580+ toEncoding b >*<
2581+ toEncoding c >*<
2582+ toEncoding d >*<
2583+ toEncoding e >*<
2584+ toEncoding f >*<
2585+ toEncoding g >*<
2586+ toEncoding h >*<
2587+ toEncoding i >*<
2588+ toEncoding j >*<
2589+ toEncoding k >*<
2590+ toEncoding l >*<
2591+ toM m >*<
2592+ toN n
27842593 {-# INLINE liftToEncoding2 #-}
27852594
27862595instance (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 +2625,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
28162625 return mv
28172626 {-# INLINE liftToJSON2 #-}
28182627
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− ]
2628+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
2629+ toEncoding a >*<
2630+ toEncoding b >*<
2631+ toEncoding c >*<
2632+ toEncoding d >*<
2633+ toEncoding e >*<
2634+ toEncoding f >*<
2635+ toEncoding g >*<
2636+ toEncoding h >*<
2637+ toEncoding i >*<
2638+ toEncoding j >*<
2639+ toEncoding k >*<
2640+ toEncoding l >*<
2641+ toEncoding m >*<
2642+ toN n >*<
2643+ toO o
28362644 {-# INLINE liftToEncoding2 #-}
28372645
28382646instance (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
@@ -2847,26 +2655,27 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
28472655 toEncoding = toEncoding2
28482656 {-# INLINE toEncoding #-}
28492657
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
2658+-------------------------------------------------------------------------------
2659+-- pre-bytestring-0.10 compatibility
2660+-------------------------------------------------------------------------------
28612661
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
2662+{-# INLINE lazyToStrictByteString #-}
2663+lazyToStrictByteString :: L.ByteString -> S.ByteString
2664+#if MIN_VERSION_bytestring(0,10,0)
2665+lazyToStrictByteString = L.toStrict
2666+#else
2667+lazyToStrictByteString = packChunks
28672668
2868−instance (v ~ Value) => KeyValuePair v (DList Pair) where
2869− pair k v = DList.singleton (pack k .= v)
2669+-- packChunks is taken from the blaze-builder package.
28702670
2871−instance (e ~ Encoding) => KeyValuePair e Series where
2872− pair = E.pairStr
2671+-- | Pack the chunks of a lazy bytestring into a single strict bytestring.
2672+packChunks :: L.ByteString -> S.ByteString
2673+packChunks lbs = do
2674+ S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
2675+ where
2676+ copyChunks !L.Empty !_pf = return ()
2677+ copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do
2678+ withForeignPtr fpbuf $ \pbuf ->
2679+ copyBytes pf (pbuf `plusPtr` o) l
2680+ copyChunks lbs' (pf `plusPtr` l)
2681+#endif