@@ -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,55 @@ 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)
6464import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
65−import Data.Aeson.Encoding.Internal ((>*<))
65+import Data.Aeson.Encoding.Internal ((>*<), (><), tuple)
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, Nano)
72+import Data.Fixed (Fixed, HasResolution)
7373import Data.Foldable (toList)
7474import Data.Functor.Compose (Compose(..))
75−import Data.Functor.Contravariant (Contravariant (..))
7675import Data.Functor.Identity (Identity(..))
7776import Data.Functor.Product (Product(..))
7877import Data.Functor.Sum (Sum(..))
7978import Data.Int (Int16, Int32, Int64, Int8)
8079import Data.List (intersperse)
8180import Data.List.NonEmpty (NonEmpty(..))
82−import Data.Semigroup ((<>))
81+import Data.Monoid ((<>), Dual(..), First(..), Last(..))
8382import Data.Proxy (Proxy(..))
8483import Data.Ratio (Ratio, denominator, numerator)
8584import Data.Scientific (Scientific)
8685import Data.Tagged (Tagged(..))
8786import 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)
87+import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
88+import Data.Time.Format (FormatTime, formatTime)
89+import Data.Time.Locale.Compat (defaultTimeLocale)
9390import Data.Vector (Vector)
9491import Data.Version (Version, showVersion)
95−import Data.Void (Void, absurd)
9692import Data.Word (Word16, Word32, Word64, Word8)
9793import Foreign.Storable (Storable)
98−import Foreign.C.Types (CTime (..))
9994import GHC.Generics
10095import Numeric.Natural (Natural)
10196import qualified Data.Aeson.Encoding as E
102−import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
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
103100import qualified Data.ByteString.Lazy as L
104101import qualified Data.DList as DList
105102import qualified Data.HashMap.Strict as H
@@ -108,16 +105,13 @@ import qualified Data.IntMap as IntMap
108105import qualified Data.IntSet as IntSet
109106import qualified Data.List.NonEmpty as NE
110107import qualified Data.Map as M
111−import qualified Data.Monoid as Monoid
112108import qualified Data.Scientific as Scientific
113−import qualified Data.Semigroup as Semigroup
114109import qualified Data.Sequence as Seq
115110import qualified Data.Set as Set
116111import qualified Data.Text as T
117112import qualified Data.Text.Encoding as T
118113import qualified Data.Text.Lazy as LT
119114import qualified Data.Tree as Tree
120−import qualified Data.UUID.Types as UUID
121115import qualified Data.Vector as V
122116import qualified Data.Vector.Generic as VG
123117import qualified Data.Vector.Mutable as VM
@@ -125,19 +119,12 @@ import qualified Data.Vector.Primitive as VP
125119import qualified Data.Vector.Storable as VS
126120import qualified Data.Vector.Unboxed as VU
127121
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
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
141128#endif
142129
143130toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
@@ -156,16 +143,19 @@ realFloatToJSON d
156143
157144-- | Class of generic representation types that can be converted to
158145-- JSON.
159−class GToJSON enc arity f where
146+class GToJSON arity f where
160147 -- | 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
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
169159
170160-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
171161-- function arguments that encode occurrences of the type parameter (for
@@ -177,14 +167,14 @@ data ToArgs res arity a where
177167-- | A configurable generic JSON creator. This function applied to
178168-- 'defaultOptions' is used as the default for 'toJSON' when the type
179169-- is an instance of 'Generic'.
180−genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
170+genericToJSON :: (Generic a, GToJSON Zero (Rep a))
181171 => Options -> a -> Value
182172genericToJSON opts = gToJSON opts NoToArgs . from
183173
184174-- | A configurable generic JSON creator. This function applied to
185175-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
186176-- is an instance of 'Generic1'.
187−genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
177+genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
188178 => Options -> (a -> Value) -> ([a] -> Value)
189179 -> f a -> Value
190180genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
@@ -192,17 +182,17 @@ genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
192182-- | A configurable generic JSON encoder. This function applied to
193183-- 'defaultOptions' is used as the default for 'toEncoding' when the type
194184-- is an instance of 'Generic'.
195−genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
185+genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))
196186 => Options -> a -> Encoding
197−genericToEncoding opts = gToJSON opts NoToArgs . from
187+genericToEncoding opts = gToEncoding opts NoToArgs . from
198188
199189-- | A configurable generic JSON encoder. This function applied to
200190-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
201191-- is an instance of 'Generic1'.
202−genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
192+genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
203193 => Options -> (a -> Encoding) -> ([a] -> Encoding)
204194 -> f a -> Encoding
205−genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
195+genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
206196
207197-------------------------------------------------------------------------------
208198-- Class
@@ -210,9 +200,6 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
210200
211201-- | A type that can be converted to JSON.
212202--
213−-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214−-- to) specify 'toEncoding'.
215−--
216203-- An example type and instance:
217204--
218205-- @
@@ -221,10 +208,10 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
221208--
222209-- data Coord = Coord { x :: Double, y :: Double }
223210--
224−-- instance 'ToJSON' Coord where
225−-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
211+-- instance ToJSON Coord where
212+-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
226213--
227−-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
214+-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
228215-- @
229216--
230217-- Instead of manually writing your 'ToJSON' instance, there are two options
@@ -232,15 +219,17 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
232219--
233220-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
234221-- instance at compile time. The generated instance is optimized for your type
235−-- so it will probably be more efficient than the following option.
222+-- so will probably be more efficient than the following two options:
236223--
237224-- * The compiler can provide a default generic implementation for
238225-- 'toJSON'.
239226--
240227-- 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):
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:
244233--
245234-- @
246235-- {-\# LANGUAGE DeriveGeneric \#-}
@@ -249,46 +238,35 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
249238--
250239-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
251240--
252−-- instance 'ToJSON' Coord where
253−-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
241+-- instance ToJSON Coord where
242+-- toEncoding = 'genericToEncoding' 'defaultOptions'
254243-- @
255244--
256−-- If on the other hand you wish to customize the generic decoding, you have
257−-- to implement both methods:
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':
258259--
259260-- @
260−-- customOptions = 'defaultOptions'
261−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
262−-- }
263−--
264−-- instance 'ToJSON' Coord where
265−-- 'toJSON' = 'genericToJSON' customOptions
266−-- 'toEncoding' = 'genericToEncoding' customOptions
261+-- instance ToJSON Coord where
262+-- toJSON = 'genericToJSON' 'defaultOptions'
263+-- toEncoding = 'genericToEncoding' 'defaultOptions'
267264-- @
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.)
287265class ToJSON a where
288266 -- | Convert a Haskell value to a JSON-friendly intermediate type.
289267 toJSON :: a -> Value
290268
291− default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
269+ default toJSON :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
292270 toJSON = genericToJSON defaultOptions
293271
294272 -- | Encode a Haskell value as JSON.
@@ -305,8 +283,8 @@ class ToJSON a where
305283 -- extension, and then have GHC generate a method body as follows.
306284 --
307285 -- @
308− -- instance 'ToJSON' Coord where
309− -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
286+ -- instance ToJSON Coord where
287+ -- toEncoding = 'genericToEncoding' 'defaultOptions'
310288 -- @
311289
312290 toEncoding :: a -> Encoding
@@ -338,13 +316,6 @@ instance KeyValue Pair where
338316 name .= value = (name, toJSON value)
339317 {-# INLINE (.=) #-}
340318
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−
348319-------------------------------------------------------------------------------
349320-- Classes and types for map keys
350321-------------------------------------------------------------------------------
@@ -402,7 +373,7 @@ instance KeyValue Object where
402373-- newtype wrapper around 'Text'. The recommended approach is to use
403374-- generalized newtype deriving:
404375--
405−-- > newtype RecordId = RecordId { getRecordId :: Text }
376+-- > newtype RecordId = RecordId { getRecordId :: Text}
406377-- > deriving (Eq,Ord,ToJSONKey)
407378--
408379-- Then we may write:
@@ -417,18 +388,8 @@ instance KeyValue Object where
417388--
418389-- It is possible to get the 'ToJSONKey' instance for free as we did
419390-- 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−--
391+-- and from 'Text' that does not require any escape sequences. So, in
392+-- this example, 'ToJSONKeyText' will be used instead of 'ToJSONKeyValue'.
432393-- The 'Show' instance can be used to help write 'ToJSONKey':
433394--
434395-- > instance ToJSONKey Color where
@@ -503,42 +464,16 @@ toJSONKeyTextEnc e = ToJSONKeyText tot e
503464 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
504465 tot = T.dropAround (== '"')
505466 . T.decodeLatin1
506− . L.toStrict
467+ . lazyToStrictByteString
507468 . E.encodingToLazyByteString
508469 . e
509470
510−instance Contravariant ToJSONKeyFunction where
511− contramap = contramapToJSONKeyFunction
512−
513471-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
514472contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
515473contramapToJSONKeyFunction h x = case x of
516474 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
517475 ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
518476
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−
542477-------------------------------------------------------------------------------
543478-- Lifings of FromJSON and ToJSON to unary and binary type constructors
544479-------------------------------------------------------------------------------
@@ -551,7 +486,7 @@ instance GetConName f => GToJSONKey f
551486--
552487-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
553488-- instance at compile time. The generated instance is optimized for your type
554−-- so it will probably be more efficient than the following option.
489+-- so will probably be more efficient than the following two options:
555490--
556491-- * The compiler can provide a default generic implementation for
557492-- 'toJSON1'.
@@ -569,29 +504,23 @@ instance GetConName f => GToJSONKey f
569504--
570505-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
571506--
572−-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
507+-- instance ToJSON a => ToJSON1 (Pair a)
573508-- @
574509--
575−-- If the default implementation doesn't give exactly the results you want,
510+-- If @DefaultSignatures@ doesn't give exactly the results you want,
576511-- you can customize the generic encoding with only a tiny amount of
577512-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
578513-- your preferred 'Options':
579514--
580515-- @
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
516+-- instance ToJSON a => ToJSON1 (Pair a) where
517+-- liftToJSON = 'genericLiftToJSON' 'defaultOptions'
518+-- liftToEncoding = 'genericLiftToEncoding' 'defaultOptions'
588519-- @
589−--
590−-- See also 'ToJSON'.
591520class ToJSON1 f where
592521 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
593522
594− default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
523+ default liftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
595524 => (a -> Value) -> ([a] -> Value) -> f a -> Value
596525 liftToJSON = genericLiftToJSON defaultOptions
597526
@@ -600,7 +529,7 @@ class ToJSON1 f where
600529
601530 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
602531
603− default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
532+ default liftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
604533 => (a -> Encoding) -> ([a] -> Encoding)
605534 -> f a -> Encoding
606535 liftToEncoding = genericLiftToEncoding defaultOptions
@@ -654,7 +583,7 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
654583-- @
655584-- newtype F a = F [a]
656585--
657−-- -- This instance encodes 'String' as an array of chars
586+-- -- This instance encodes String as an array of chars
658587-- instance 'ToJSON1' F where
659588-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
660589-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
@@ -685,11 +614,6 @@ instance ToJSON1 [] where
685614 {-# INLINE liftToEncoding #-}
686615
687616instance (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−
693617 toJSON = toJSON1
694618 {-# INLINE toJSON #-}
695619
@@ -700,80 +624,39 @@ instance (ToJSON a) => ToJSON [a] where
700624-- Generic toJSON / toEncoding
701625-------------------------------------------------------------------------------
702626
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−
744627--------------------------------------------------------------------------------
745628-- Generic toJSON
746629
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 #-}
630+instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where
631+ -- Meta-information, which is not handled elsewhere, is ignored:
632+ gToJSON opts targs = gToJSON opts targs . unM1
756633
757−instance ToJSON a => GToJSON Value arity (K1 i a) where
634+instance (ToJSON a) => GToJSON arity (K1 i a) where
758635 -- Constant values are encoded using their ToJSON instance:
759636 gToJSON _opts _ = toJSON . unK1
760− {-# INLINE gToJSON #-}
761637
762−instance ToJSON1 f => GToJSON Value One (Rec1 f) where
638+instance GToJSON One Par1 where
639+ -- Direct occurrences of the last type parameter are encoded with the
640+ -- function passed in as an argument:
641+ gToJSON _opts (To1Args tj _) = tj . unPar1
642+
643+instance (ToJSON1 f) => GToJSON One (Rec1 f) where
763644 -- Recursive occurrences of the last type parameter are encoded using their
764645 -- ToJSON1 instance:
765646 gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766− {-# INLINE gToJSON #-}
767647
768−instance GToJSON Value arity U1 where
648+instance GToJSON arity U1 where
769649 -- Empty constructors are encoded to an empty array:
770650 gToJSON _opts _ _ = emptyArray
771− {-# INLINE gToJSON #-}
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
772656
773657instance ( WriteProduct arity a, WriteProduct arity b
774658 , ProductSize a, ProductSize b
775− ) => GToJSON Value arity (a :*: b)
776− where
659+ ) => GToJSON arity (a :*: b) where
777660 -- Products are encoded to an array. Here we allocate a mutable vector of
778661 -- the same size as the product and write the product's elements to it using
779662 -- 'writeProduct':
@@ -785,175 +668,238 @@ instance ( WriteProduct arity a, WriteProduct arity b
785668 where
786669 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
787670 productSize
788− {-# INLINE gToJSON #-}
789671
790−instance ( ToJSON1 f
791− , GToJSON Value One g
792− ) => GToJSON Value One (f :.: g)
793− where
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
794682 -- If an occurrence of the last type parameter is nested inside two
795683 -- composed types, it is encoded by using the outermost type's ToJSON1
796684 -- instance to generically encode the innermost type:
797685 gToJSON opts targs =
798686 let gtj = gToJSON opts targs in
799687 liftToJSON gtj (listValue gtj) . unComp1
800− {-# INLINE gToJSON #-}
801688
802689--------------------------------------------------------------------------------
803690-- Generic toEncoding
804691
805−instance ToJSON a => GToJSON Encoding arity (K1 i a) where
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
806697 -- Constant values are encoded using their ToJSON instance:
807− gToJSON _opts _ = toEncoding . unK1
808− {-# INLINE gToJSON #-}
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
809704
810−instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
705+instance (ToJSON1 f) => GToEncoding One (Rec1 f) where
811706 -- Recursive occurrences of the last type parameter are encoded using their
812707 -- ToEncoding1 instance:
813− gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814− {-# INLINE gToJSON #-}
708+ gToEncoding _opts (To1Args te tel) = liftToEncoding te tel . unRec1
815709
816−instance GToJSON Encoding arity U1 where
710+instance GToEncoding arity U1 where
817711 -- Empty constructors are encoded to an empty array:
818− gToJSON _opts _ _ = E.emptyArray_
819− {-# INLINE gToJSON #-}
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
820718
821719instance ( EncodeProduct arity a
822720 , EncodeProduct arity b
823− ) => GToJSON Encoding arity (a :*: b)
824− where
721+ ) => GToEncoding arity (a :*: b) where
825722 -- Products are encoded to an array. Here we allocate a mutable vector of
826723 -- the same size as the product and write the product's elements to it using
827724 -- 'encodeProduct':
828− gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
829− {-# INLINE gToJSON #-}
725+ gToEncoding opts targs p = E.tuple $ encodeProduct opts targs p
830726
831−instance ( ToJSON1 f
832− , GToJSON Encoding One g
833− ) => GToJSON Encoding One (f :.: g)
834− where
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
835738 -- If an occurrence of the last type parameter is nested inside two
836739 -- composed types, it is encoded by using the outermost type's ToJSON1
837740 -- instance to generically encode the innermost type:
838− gToJSON opts targs =
839− let gte = gToJSON opts targs in
741+ gToEncoding opts targs =
742+ let gte = gToEncoding opts targs in
840743 liftToEncoding gte (listEncoding gte) . unComp1
841− {-# INLINE gToJSON #-}
842744
843745--------------------------------------------------------------------------------
844746
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
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
857757 sumToJSON opts targs
858− | allNullaryToStringTag opts = Tagged . fromString
758+ | allNullaryToStringTag opts = Tagged . String . pack
859759 . constructorTagModifier opts . getConName
860760 | otherwise = Tagged . nonAllNullarySumToJSON opts targs
861761
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
762+instance ( TwoElemArrayObj arity f
763+ , TaggedObjectPairs arity f
764+ , ObjectWithSingleFieldObj arity f
765+ , UntaggedValueObj arity f
766+ ) => SumToJSON arity f False where
868767 sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
869768
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
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
876775nonAllNullarySumToJSON opts targs =
877776 case sumEncoding opts of
878−
879777 TaggedObject{..} ->
880− taggedObject opts targs tagFieldName contentsFieldName
778+ object . taggedObjectPairs opts targs tagFieldName contentsFieldName
779+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts targs
780+ TwoElemArray -> Array . twoElemArrayObj opts targs
781+ UntaggedValue -> untaggedValueObj opts targs
881782
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
783+--------------------------------------------------------------------------------
889784
890− UntaggedValue ->
891− (unTagged :: Tagged UntaggedValue enc -> enc)
892− . sumToJSON' opts targs
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
815+ TaggedObject{..} ->
816+ taggedObjectEnc opts targs tagFieldName contentsFieldName
817+ ObjectWithSingleField -> objectWithSingleFieldEnc opts targs
818+ TwoElemArray -> twoElemArrayEnc opts targs
819+ UntaggedValue -> untaggedValueEnc opts targs
893820
894821--------------------------------------------------------------------------------
895822
896−class FromString enc where
897− fromString :: String -> enc
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
898845
899−instance FromString Encoding where
900− fromString = toEncoding
846+class TaggedObjectPairs' arity f isRecord where
847+ taggedObjectPairs' :: Options -> ToArgs Value arity a
848+ -> String -> f a -> Tagged isRecord [Pair]
901849
902−instance FromString Value where
903− fromString = String . pack
850+instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where
851+ taggedObjectPairs' _ _ _ _ = Tagged []
904852
905−--------------------------------------------------------------------------------
853+instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where
854+ taggedObjectPairs' opts targs _ =
855+ Tagged . toList . recordToPairs opts targs
906856
907−class TaggedObject enc arity f where
908− taggedObject :: Options -> ToArgs enc arity a
909− -> String -> String
910− -> f a -> enc
857+instance (GToJSON arity f) => TaggedObjectPairs' arity f False where
858+ taggedObjectPairs' opts targs contentsFieldName =
859+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts targs
911860
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
861+--------------------------------------------------------------------------------
952862
953−instance ( RecordToPairs enc pairs arity f
954− ) => TaggedObject' enc pairs arity f True
955− where
956− taggedObject' opts targs _ = Tagged . recordToPairs opts targs
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
878+ , 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
957903
958904--------------------------------------------------------------------------------
959905
@@ -968,38 +914,23 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where
968914instance (Constructor c) => GetConName (C1 c a) where
969915 getConName = conName
970916
971−-- For genericToJSONKey
972−instance GetConName a => GetConName (D1 d a) where
973− getConName (M1 x) = getConName x
974−
975917--------------------------------------------------------------------------------
976918
977−-- Reflection of SumEncoding variants
978−
979−data ObjectWithSingleField
980−data TwoElemArray
981−data UntaggedValue
982−
983−--------------------------------------------------------------------------------
919+class TwoElemArrayObj arity f where
920+ twoElemArrayObj :: Options -> ToArgs Value arity a
921+ -> f a -> V.Vector Value
984922
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−--------------------------------------------------------------------------------
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
997928
998−instance ( GToJSON Value arity a
999− , ConsToJSON Value arity a
929+instance ( GToJSON arity a
930+ , ConsToJSON arity a
1000931 , Constructor c
1001− ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
1002− sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
932+ ) => TwoElemArrayObj arity (C1 c a) where
933+ twoElemArrayObj opts targs x = V.create $ do
1003934 mv <- VM.unsafeNew 2
1004935 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
1005936 $ conName (undefined :: t c a p)
@@ -1008,121 +939,148 @@ instance ( GToJSON Value arity a
1008939
1009940--------------------------------------------------------------------------------
1010941
1011−instance ( GToJSON Encoding arity a
1012− , ConsToJSON Encoding arity a
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
1013954 , 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− ]
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
1020959
1021960--------------------------------------------------------------------------------
1022961
1023−class ConsToJSON enc arity f where
1024− consToJSON :: Options -> ToArgs enc arity a
1025− -> f a -> enc
962+class ConsToJSON arity f where
963+ consToJSON :: Options -> ToArgs Value arity a
964+ -> f a -> Value
1026965
1027−class ConsToJSON' enc arity f isRecord where
1028− consToJSON' :: Options -> ToArgs enc arity a
1029− -> f a -> Tagged isRecord enc
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
1030970
1031−instance ( IsRecord f isRecord
1032− , ConsToJSON' enc arity f isRecord
1033− ) => ConsToJSON enc arity f
1034− where
971+instance ( IsRecord f isRecord
972+ , ConsToJSON' arity f isRecord
973+ ) => ConsToJSON arity f where
1035974 consToJSON opts targs =
1036− (unTagged :: Tagged isRecord enc -> enc)
1037− . consToJSON' opts targs
1038− {-# INLINE consToJSON #-}
975+ (unTagged :: Tagged isRecord Value -> Value)
976+ . consToJSON' opts targs (isUnary (undefined :: f a))
1039977
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' #-}
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
1057984
1058−instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1059− consToJSON' opts targs = Tagged . gToJSON opts targs
1060− {-# INLINE consToJSON' #-}
985+instance GToJSON arity f => ConsToJSON' arity f False where
986+ consToJSON' opts targs _ = Tagged . gToJSON opts targs
1061987
1062988--------------------------------------------------------------------------------
1063989
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
990+class ConsToEncoding arity f where
991+ consToEncoding :: Options -> ToArgs Encoding arity a
992+ -> f a -> Encoding
1070993
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
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
998+
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
1015+
1016+--------------------------------------------------------------------------------
1017+
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
1027+
1028+instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where
10881029 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
1030+
1031+instance OVERLAPPING_ (Selector s, ToJSON a) =>
1032+ RecordToPairs arity (S1 s (K1 i (Maybe a))) where
10981033 recordToPairs opts _ (M1 k1) | omitNothingFields opts
1099− , K1 Nothing <- k1 = mempty
1034+ , K1 Nothing <- k1 = DList.empty
11001035 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 #-}
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)
11261084
11271085--------------------------------------------------------------------------------
11281086
@@ -1145,12 +1103,10 @@ instance ( WriteProduct arity a
11451103 lenL = len `unsafeShiftR` 1
11461104 lenR = len - lenL
11471105 ixR = ix + lenL
1148− {-# INLINE writeProduct #-}
11491106
1150−instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
1107+instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
11511108 writeProduct opts targs mv ix _ =
11521109 VM.unsafeWrite mv ix . gToJSON opts targs
1153− {-# INLINE writeProduct #-}
11541110
11551111--------------------------------------------------------------------------------
11561112
@@ -1165,44 +1121,114 @@ instance ( EncodeProduct arity a
11651121 E.econcat $ intersperse E.comma $
11661122 filter (not . E.nullEncoding)
11671123 [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 #-}
1124+ encodeProduct opts targs (a :*: b) = encodeProduct opts targs a >*<
1125+ encodeProduct opts targs b
11721126
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 #-}
1127+instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1128+ encodeProduct opts targs a = E.retagEncoding $ gToEncoding opts targs a
11761129
11771130--------------------------------------------------------------------------------
11781131
1179−instance ( GToJSON enc arity a
1180− , ConsToJSON enc arity a
1181− , FromPairs enc pairs
1182− , KeyValuePair enc pairs
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
11831146 , Constructor c
1184− ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1185− where
1186− sumToJSON' opts targs =
1187− Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
1147+ ) => ObjectWithSingleFieldObj arity (C1 c a) where
1148+ objectWithSingleFieldObj opts targs = H.singleton typ . gToJSON opts targs
11881149 where
1189− typ = constructorTagModifier opts $
1150+ typ = pack $ constructorTagModifier opts $
11901151 conName (undefined :: t c a p)
11911152
11921153--------------------------------------------------------------------------------
11931154
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− ( ConsToJSON enc arity a
1196− ) => SumToJSON' UntaggedValue enc arity (C1 c a)
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)
11971203 where
1198− sumToJSON' opts targs = Tagged . gToJSON opts targs
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
11991226
12001227instance OVERLAPPING_
1201− ( Constructor c
1202− , FromString enc
1203− ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
1228+ ( Constructor c )
1229+ => UntaggedValueEnc arity (C1 c U1)
12041230 where
1205− sumToJSON' opts _ _ = Tagged . fromString $
1231+ untaggedValueEnc opts _ _ = toEncoding $
12061232 constructorTagModifier opts $ conName (undefined :: t c U1 p)
12071233
12081234-------------------------------------------------------------------------------
@@ -1276,13 +1302,6 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
12761302 toEncoding = toEncoding2
12771303 {-# INLINE toEncoding #-}
12781304
1279−instance ToJSON Void where
1280− toJSON = absurd
1281− {-# INLINE toJSON #-}
1282−
1283− toEncoding = absurd
1284− {-# INLINE toEncoding #-}
1285−
12861305
12871306instance ToJSON Bool where
12881307 toJSON = Bool
@@ -1468,6 +1487,7 @@ instance ToJSONKey Int64 where
14681487 toJSONKey = toJSONKeyTextEnc E.int64Text
14691488 {-# INLINE toJSONKey #-}
14701489
1490+
14711491instance ToJSON Word where
14721492 toJSON = Number . fromIntegral
14731493 {-# INLINE toJSON #-}
@@ -1527,12 +1547,6 @@ instance ToJSONKey Word64 where
15271547 toJSONKey = toJSONKeyTextEnc E.word64Text
15281548 {-# INLINE toJSONKey #-}
15291549
1530−instance ToJSON CTime where
1531− toJSON (CTime i) = toJSON i
1532− {-# INLINE toJSON #-}
1533−
1534− toEncoding (CTime i) = toEncoding i
1535− {-# INLINE toEncoding #-}
15361550
15371551instance ToJSON Text where
15381552 toJSON = String
@@ -1647,7 +1661,7 @@ instance (ToJSON a) => ToJSON (Identity a) where
16471661 toEncodingList = liftToEncodingList toEncoding toEncodingList
16481662 {-# INLINE toEncodingList #-}
16491663
1650−instance (ToJSONKey a) => ToJSONKey (Identity a) where
1664+instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
16511665 toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
16521666 toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
16531667
@@ -1796,11 +1810,13 @@ instance ToJSONKey k => ToJSON1 (M.Map k) where
17961810 ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
17971811 {-# INLINE liftToJSON #-}
17981812
1813+ -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
17991814 liftToEncoding g _ = case toJSONKey of
18001815 ToJSONKeyText _ f -> dict f g M.foldrWithKey
18011816 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
18021817 where
1803− pairEncoding f (a, b) = E.list id [f a, g b]
1818+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1819+ pairEncoding f (a, b) = tuple $ f a >*< g b
18041820 {-# INLINE liftToEncoding #-}
18051821
18061822
@@ -1838,17 +1854,6 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
18381854 toEncoding = toEncoding1
18391855 {-# INLINE toEncoding #-}
18401856
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
18521857
18531858-------------------------------------------------------------------------------
18541859-- vector
@@ -1862,8 +1867,6 @@ instance ToJSON1 Vector where
18621867 {-# INLINE liftToEncoding #-}
18631868
18641869instance (ToJSON a) => ToJSON (Vector a) where
1865− {-# SPECIALIZE instance ToJSON Array #-}
1866−
18671870 toJSON = toJSON1
18681871 {-# INLINE toJSON #-}
18691872
@@ -1931,12 +1934,11 @@ instance ToJSONKey k => ToJSON1 (H.HashMap k) where
19311934 ToJSONKeyText _ f -> dict f g H.foldrWithKey
19321935 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
19331936 where
1934− pairEncoding f (a, b) = E.list id [f a, g b]
1937+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1938+ pairEncoding f (a, b) = tuple $ f a >*< g b
19351939 {-# INLINE liftToEncoding #-}
19361940
19371941instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938− {-# SPECIALIZE instance ToJSON Object #-}
1939−
19401942 toJSON = toJSON1
19411943 {-# INLINE toJSON #-}
19421944
@@ -1966,32 +1968,6 @@ dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
19661968formatMillis :: (FormatTime t) => t -> String
19671969formatMillis = take 3 . formatTime defaultTimeLocale "%q"
19681970
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−
19951971-------------------------------------------------------------------------------
19961972-- time
19971973-------------------------------------------------------------------------------
@@ -2040,11 +2016,10 @@ stringEncoding :: Encoding' Text -> Value
20402016stringEncoding = String
20412017 . T.dropAround (== '"')
20422018 . T.decodeLatin1
2043− . L.toStrict
2019+ . lazyToStrictByteString
20442020 . E.encodingToLazyByteString
20452021{-# INLINE stringEncoding #-}
20462022
2047−
20482023instance ToJSON NominalDiffTime where
20492024 toJSON = Number . realToFrac
20502025 {-# INLINE toJSON #-}
@@ -2052,159 +2027,18 @@ instance ToJSON NominalDiffTime where
20522027 toEncoding = E.scientific . realToFrac
20532028 {-# INLINE toEncoding #-}
20542029
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−
21072030-------------------------------------------------------------------------------
21082031-- base Monoid/Semigroup
21092032-------------------------------------------------------------------------------
21102033
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
2034+instance ToJSON1 Dual where
2035+ liftToJSON t _ = t . getDual
22022036 {-# INLINE liftToJSON #-}
22032037
2204− liftToEncoding t _ (Semigroup.Last x) = t x
2038+ liftToEncoding t _ = t . getDual
22052039 {-# INLINE liftToEncoding #-}
22062040
2207−instance ToJSON a => ToJSON (Semigroup.Last a) where
2041+instance ToJSON a => ToJSON (Dual a) where
22082042 toJSON = toJSON1
22092043 {-# INLINE toJSON #-}
22102044
@@ -2212,14 +2046,14 @@ instance ToJSON a => ToJSON (Semigroup.Last a) where
22122046 {-# INLINE toEncoding #-}
22132047
22142048
2215−instance ToJSON1 Semigroup.WrappedMonoid where
2216− liftToJSON t _ (Semigroup.WrapMonoid x) = t x
2049+instance ToJSON1 First where
2050+ liftToJSON t to' = liftToJSON t to' . getFirst
22172051 {-# INLINE liftToJSON #-}
22182052
2219− liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
2053+ liftToEncoding t to' = liftToEncoding t to' . getFirst
22202054 {-# INLINE liftToEncoding #-}
22212055
2222−instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2056+instance ToJSON a => ToJSON (First a) where
22232057 toJSON = toJSON1
22242058 {-# INLINE toJSON #-}
22252059
@@ -2227,14 +2061,14 @@ instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
22272061 {-# INLINE toEncoding #-}
22282062
22292063
2230−instance ToJSON1 Semigroup.Option where
2231− liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
2064+instance ToJSON1 Last where
2065+ liftToJSON t to' = liftToJSON t to' . getLast
22322066 {-# INLINE liftToJSON #-}
22332067
2234− liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
2068+ liftToEncoding t to' = liftToEncoding t to' . getLast
22352069 {-# INLINE liftToEncoding #-}
22362070
2237−instance ToJSON a => ToJSON (Semigroup.Option a) where
2071+instance ToJSON a => ToJSON (Last a) where
22382072 toJSON = toJSON1
22392073 {-# INLINE toJSON #-}
22402074
@@ -2245,13 +2079,6 @@ instance ToJSON a => ToJSON (Semigroup.Option a) where
22452079-- tagged
22462080-------------------------------------------------------------------------------
22472081
2248−instance ToJSON1 Proxy where
2249− liftToJSON _ _ _ = Null
2250− {-# INLINE liftToJSON #-}
2251−
2252− liftToEncoding _ _ _ = E.null_
2253− {-# INLINE liftToEncoding #-}
2254−
22552082instance ToJSON (Proxy a) where
22562083 toJSON _ = Null
22572084 {-# INLINE toJSON #-}
@@ -2260,13 +2087,6 @@ instance ToJSON (Proxy a) where
22602087 {-# INLINE toEncoding #-}
22612088
22622089
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−
22702090instance ToJSON1 (Tagged a) where
22712091 liftToJSON t _ (Tagged x) = t x
22722092 {-# INLINE liftToJSON #-}
@@ -2281,6 +2101,7 @@ instance ToJSON b => ToJSON (Tagged a b) where
22812101 toEncoding = toEncoding1
22822102 {-# INLINE toEncoding #-}
22832103
2104+
22842105instance ToJSONKey b => ToJSONKey (Tagged a b) where
22852106 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
22862107 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
@@ -2301,7 +2122,7 @@ instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
23012122 toJSONKey = toJSONKeyList
23022123
23032124-------------------------------------------------------------------------------
2304−-- Tuple instances
2125+-- Tuple instances, see tuple-instances-to.hs
23052126-------------------------------------------------------------------------------
23062127
23072128instance ToJSON2 (,) where
@@ -2312,7 +2133,9 @@ instance ToJSON2 (,) where
23122133 return mv
23132134 {-# INLINE liftToJSON2 #-}
23142135
2315− liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
2136+ liftToEncoding2 toA _ toB _ (a, b) = tuple $
2137+ toA a >*<
2138+ toB b
23162139 {-# INLINE liftToEncoding2 #-}
23172140
23182141instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -2336,11 +2159,10 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
23362159 return mv
23372160 {-# INLINE liftToJSON2 #-}
23382161
2339− liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2340− [ toEncoding a
2341− , toB b
2342− , toC c
2343− ]
2162+ liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
2163+ toEncoding a >*<
2164+ toB b >*<
2165+ toC c
23442166 {-# INLINE liftToEncoding2 #-}
23452167
23462168instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -2365,12 +2187,11 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
23652187 return mv
23662188 {-# INLINE liftToJSON2 #-}
23672189
2368− liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2369− [ toEncoding a
2370− , toEncoding b
2371− , toC c
2372− , toD d
2373− ]
2190+ liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
2191+ toEncoding a >*<
2192+ toEncoding b >*<
2193+ toC c >*<
2194+ toD d
23742195 {-# INLINE liftToEncoding2 #-}
23752196
23762197instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -2396,13 +2217,12 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
23962217 return mv
23972218 {-# INLINE liftToJSON2 #-}
23982219
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− ]
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
24062226 {-# INLINE liftToEncoding2 #-}
24072227
24082228instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
@@ -2429,14 +2249,13 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
24292249 return mv
24302250 {-# INLINE liftToJSON2 #-}
24312251
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− ]
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
24402259 {-# INLINE liftToEncoding2 #-}
24412260
24422261instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
@@ -2464,15 +2283,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
24642283 return mv
24652284 {-# INLINE liftToJSON2 #-}
24662285
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− ]
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
24762294 {-# INLINE liftToEncoding2 #-}
24772295
24782296instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
@@ -2501,16 +2319,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
25012319 return mv
25022320 {-# INLINE liftToJSON2 #-}
25032321
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− ]
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
25142331 {-# INLINE liftToEncoding2 #-}
25152332
25162333instance (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 +2357,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
25402357 return mv
25412358 {-# INLINE liftToJSON2 #-}
25422359
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− ]
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
25542370 {-# INLINE liftToEncoding2 #-}
25552371
25562372instance (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 +2397,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
25812397 return mv
25822398 {-# INLINE liftToJSON2 #-}
25832399
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− ]
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
25962411 {-# INLINE liftToEncoding2 #-}
25972412
25982413instance (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 +2439,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
26242439 return mv
26252440 {-# INLINE liftToJSON2 #-}
26262441
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− ]
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
26402454 {-# INLINE liftToEncoding2 #-}
26412455
26422456instance (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 +2483,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
26692483 return mv
26702484 {-# INLINE liftToJSON2 #-}
26712485
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− ]
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
26862499 {-# INLINE liftToEncoding2 #-}
26872500
26882501instance (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 +2529,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
27162529 return mv
27172530 {-# INLINE liftToJSON2 #-}
27182531
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− ]
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
27342546 {-# INLINE liftToEncoding2 #-}
27352547
27362548instance (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 +2577,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
27652577 return mv
27662578 {-# INLINE liftToJSON2 #-}
27672579
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− ]
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
27842595 {-# INLINE liftToEncoding2 #-}
27852596
27862597instance (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 +2627,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
28162627 return mv
28172628 {-# INLINE liftToJSON2 #-}
28182629
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− ]
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
28362646 {-# INLINE liftToEncoding2 #-}
28372647
28382648instance (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 +2657,27 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
28472657 toEncoding = toEncoding2
28482658 {-# INLINE toEncoding #-}
28492659
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
2660+-------------------------------------------------------------------------------
2661+-- pre-bytestring-0.10 compatibility
2662+-------------------------------------------------------------------------------
28612663
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
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
28672670
2868−instance (v ~ Value) => KeyValuePair v (DList Pair) where
2869− pair k v = DList.singleton (pack k .= v)
2671+-- packChunks is taken from the blaze-builder package.
28702672
2871−instance (e ~ Encoding) => KeyValuePair e Series where
2872− pair = E.pairStr
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