git.iko.soy/typeable/aeson
on master help sign in
Merge pull request #435 from RyanGlScott/rework-generics

Remove use of Proxy and undefined in generics code

commitd1b468cd8452bf2ac4eb80240473be901852621c authorAdam Bergmark <adam@bergmark.nl> dateThu 23 Jun 2016, 18:02 (10 years ago) parent569c1d9dd56788
6 files changed+234−256
compare with master
unifiedsplit
Data/Aeson.hs+2 Data/Aeson/Types.hs+2 Data/Aeson/Types/Class.hs+2 Data/Aeson/Types/FromJSON.hs+73−77 Data/Aeson/Types/Generic.hs−7 Data/Aeson/Types/ToJSON.hs+155−172
Data/Aeson.hs+2
@@ -75,8 +75,10 @@ module Data.Aeson
7575 , toEncoding2
7676 -- ** Generic JSON classes and options
7777 , GFromJSON(..)
78+ , FromArgs(..)
7879 , GToJSON(..)
7980 , GToEncoding(..)
81+ , ToArgs(..)
8082 , Zero
8183 , One
8284 , genericToJSON
Data/Aeson/Types.hs+2
@@ -62,8 +62,10 @@ module Data.Aeson.Types
6262
6363 -- ** Generic JSON classes
6464 , GFromJSON(..)
65+ , FromArgs(..)
6566 , GToJSON(..)
6667 , GToEncoding(..)
68+ , ToArgs(..)
6769 , Zero
6870 , One
6971 , genericToJSON
Data/Aeson/Types/Class.hs+2
@@ -35,8 +35,10 @@ module Data.Aeson.Types.Class
3535 , toEncoding2
3636 -- * Generic JSON classes
3737 , GFromJSON(..)
38+ , FromArgs(..)
3839 , GToJSON(..)
3940 , GToEncoding(..)
41+ , ToArgs(..)
4042 , Zero
4143 , One
4244 , genericToJSON
Data/Aeson/Types/FromJSON.hs+73−77
@@ -33,6 +33,7 @@ module Data.Aeson.Types.FromJSON (
3333 , parseJSON2
3434 -- * Generic JSON classes
3535 , GFromJSON(..)
36+ , FromArgs(..)
3637 , genericParseJSON
3738 , genericLiftParseJSON
3839 -- * Classes and types for map keys
@@ -207,16 +208,21 @@ class GFromJSON arity f where
207208 -- | This method (applied to 'defaultOptions') is used as the
208209 -- default generic implementation of 'parseJSON' (if the @arity@ is 'Zero')
209210 -- or 'liftParseJSON' (if the @arity@ is 'One').
210− gParseJSON :: Options -> Proxy arity
211− -> (Value -> Parser a) -> (Value -> Parser [a])
212− -> Value -> Parser (f a)
211+ gParseJSON :: Options -> FromArgs arity a -> Value -> Parser (f a)
212+
213+-- | A 'FromArgs' value either stores nothing (for 'FromJSON') or it stores the
214+-- two function arguments that decode occurrences of the type parameter (for
215+-- 'FromJSON1').
216+data FromArgs arity a where
217+ NoFromArgs :: FromArgs Zero a
218+ From1Args :: (Value -> Parser a) -> (Value -> Parser [a]) -> FromArgs One a
213219
214220-- | A configurable generic JSON decoder. This function applied to
215221-- 'defaultOptions' is used as the default for 'parseJSON' when the
216222-- type is an instance of 'Generic'.
217223genericParseJSON :: (Generic a, GFromJSON Zero (Rep a))
218224 => Options -> Value -> Parser a
219−genericParseJSON opts = fmap to . gParseJSON opts proxyZero undefined undefined
225+genericParseJSON opts = fmap to . gParseJSON opts NoFromArgs
220226
221227-- | A configurable generic JSON decoder. This function applied to
222228-- 'defaultOptions' is used as the default for 'liftParseJSON' when the
@@ -224,7 +230,7 @@ genericParseJSON opts = fmap to . gParseJSON opts proxyZero undefined undefined
224230genericLiftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))
225231 => Options -> (Value -> Parser a) -> (Value -> Parser [a])
226232 -> Value -> Parser (f a)
227−genericLiftParseJSON opts pj pjl = fmap to1 . gParseJSON opts proxyOne pj pjl
233+genericLiftParseJSON opts pj pjl = fmap to1 . gParseJSON opts (From1Args pj pjl)
228234
229235-------------------------------------------------------------------------------
230236-- Class
@@ -673,32 +679,32 @@ pmval .!= val = fromMaybe val <$> pmval
673679instance OVERLAPPABLE_ (GFromJSON arity a) => GFromJSON arity (M1 i c a) where
674680 -- Meta-information, which is not handled elsewhere, is just added to the
675681 -- parsed value:
676− gParseJSON opts pa pj pjl = fmap M1 . gParseJSON opts pa pj pjl
682+ gParseJSON opts fargs = fmap M1 . gParseJSON opts fargs
677683
678684instance (FromJSON a) => GFromJSON arity (K1 i a) where
679685 -- Constant values are decoded using their FromJSON instance:
680− gParseJSON _opts _ _ _ = fmap K1 . parseJSON
686+ gParseJSON _opts _ = fmap K1 . parseJSON
681687
682688instance GFromJSON One Par1 where
683689 -- Direct occurrences of the last type parameter are decoded with the
684690 -- function passed in as an argument:
685− gParseJSON _opts _ pj _ = fmap Par1 . pj
691+ gParseJSON _opts (From1Args pj _) = fmap Par1 . pj
686692
687693instance (FromJSON1 f) => GFromJSON One (Rec1 f) where
688694 -- Recursive occurrences of the last type parameter are decoded using their
689695 -- FromJSON1 instance:
690− gParseJSON _opts _ pj pjl = fmap Rec1 . liftParseJSON pj pjl
696+ gParseJSON _opts (From1Args pj pjl) = fmap Rec1 . liftParseJSON pj pjl
691697
692698instance GFromJSON arity U1 where
693699 -- Empty constructors are expected to be encoded as an empty array:
694− gParseJSON _opts _ _ _ v
700+ gParseJSON _opts _ v
695701 | isEmptyArray v = pure U1
696702 | otherwise = typeMismatch "unit constructor (U1)" v
697703
698704instance (ConsFromJSON arity a) => GFromJSON arity (C1 c a) where
699705 -- Constructors need to be decoded differently depending on whether they're
700706 -- a record or not. This distinction is made by consParseJSON:
701− gParseJSON opts pa pj pjl = fmap M1 . consParseJSON opts pa pj pjl
707+ gParseJSON opts fargs = fmap M1 . consParseJSON opts fargs
702708
703709instance ( FromProduct arity a, FromProduct arity b
704710 , ProductSize a, ProductSize b
@@ -706,12 +712,12 @@ instance ( FromProduct arity a, FromProduct arity b
706712 -- Products are expected to be encoded to an array. Here we check whether we
707713 -- got an array of the same size as the product, then parse each of the
708714 -- product's elements using parseProduct:
709− gParseJSON opts pa pj pjl = withArray "product (:*:)" $ \arr ->
715+ gParseJSON opts fargs = withArray "product (:*:)" $ \arr ->
710716 let lenArray = V.length arr
711717 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
712718 productSize in
713719 if lenArray == lenProduct
714− then parseProduct opts pa arr 0 lenProduct pj pjl
720+ then parseProduct opts fargs arr 0 lenProduct
715721 else fail $ "When expecting a product of " ++ show lenProduct ++
716722 " values, encountered an Array of " ++ show lenArray ++
717723 " elements instead"
@@ -722,38 +728,37 @@ instance ( AllNullary (a :+: b) allNullary
722728 -- If all constructors of a sum datatype are nullary and the
723729 -- 'allNullaryToStringTag' option is set they are expected to be
724730 -- encoded as strings. This distinction is made by 'parseSum':
725− gParseJSON opts pa pj pjl =
731+ gParseJSON opts fargs =
726732 (unTagged :: Tagged allNullary (Parser ((a :+: b) d)) ->
727733 Parser ((a :+: b) d))
728− . parseSum opts pa pj pjl
734+ . parseSum opts fargs
729735
730736instance (FromJSON1 f, GFromJSON One g) => GFromJSON One (f :.: g) where
731737 -- If an occurrence of the last type parameter is nested inside two
732738 -- composed types, it is decoded by using the outermost type's FromJSON1
733739 -- instance to generically decode the innermost type:
734− gParseJSON opts pa pj pjl =
735− let gpj = gParseJSON opts pa pj pjl in
740+ gParseJSON opts fargs =
741+ let gpj = gParseJSON opts fargs in
736742 fmap Comp1 . liftParseJSON gpj (listParser gpj)
737743
738744--------------------------------------------------------------------------------
739745
740746class ParseSum arity f allNullary where
741− parseSum :: Options -> Proxy arity
742− -> (Value -> Parser a) -> (Value -> Parser [a])
747+ parseSum :: Options -> FromArgs arity a
743748 -> Value -> Tagged allNullary (Parser (f a))
744749
745750instance ( SumFromString (a :+: b)
746751 , FromPair arity (a :+: b)
747752 , FromTaggedObject arity (a :+: b)
748753 ) => ParseSum arity (a :+: b) True where
749− parseSum opts pa pj pjl
754+ parseSum opts fargs
750755 | allNullaryToStringTag opts = Tagged . parseAllNullarySum opts
751− | otherwise = Tagged . parseNonAllNullarySum opts pa pj pjl
756+ | otherwise = Tagged . parseNonAllNullarySum opts fargs
752757
753758instance ( FromPair arity (a :+: b)
754759 , FromTaggedObject arity (a :+: b)
755760 ) => ParseSum arity (a :+: b) False where
756− parseSum opts pa pj pjl = Tagged . parseNonAllNullarySum opts pa pj pjl
761+ parseSum opts fargs = Tagged . parseNonAllNullarySum opts fargs
757762
758763--------------------------------------------------------------------------------
759764
@@ -780,22 +785,21 @@ instance (Constructor c) => SumFromString (C1 c U1) where
780785
781786parseNonAllNullarySum :: ( FromPair arity (a :+: b)
782787 , FromTaggedObject arity (a :+: b)
783− ) => Options -> Proxy arity
784− -> (Value -> Parser c) -> (Value -> Parser [c])
788+ ) => Options -> FromArgs arity c
785789 -> Value -> Parser ((a :+: b) c)
786−parseNonAllNullarySum opts pa pj pjl =
790+parseNonAllNullarySum opts fargs =
787791 case sumEncoding opts of
788792 TaggedObject{..} ->
789793 withObject "Object" $ \obj -> do
790794 tag <- obj .: pack tagFieldName
791795 fromMaybe (notFound tag) $
792− parseFromTaggedObject opts pa contentsFieldName obj pj pjl tag
796+ parseFromTaggedObject opts fargs contentsFieldName obj tag
793797
794798 ObjectWithSingleField ->
795799 withObject "Object" $ \obj ->
796800 case H.toList obj of
797801 [pair@(tag, _)] -> fromMaybe (notFound tag) $
798− parsePair opts pa pj pjl pair
802+ parsePair opts fargs pair
799803 _ -> fail "Object doesn't have a single field"
800804
801805 TwoElemArray ->
@@ -803,30 +807,29 @@ parseNonAllNullarySum opts pa pj pjl =
803807 if V.length arr == 2
804808 then case V.unsafeIndex arr 0 of
805809 String tag -> fromMaybe (notFound tag) $
806− parsePair opts pa pj pjl (tag, V.unsafeIndex arr 1)
810+ parsePair opts fargs (tag, V.unsafeIndex arr 1)
807811 _ -> fail "First element is not a String"
808812 else fail "Array doesn't have 2 elements"
809813
810814--------------------------------------------------------------------------------
811815
812816class FromTaggedObject arity f where
813− parseFromTaggedObject :: Options -> Proxy arity
817+ parseFromTaggedObject :: Options -> FromArgs arity a
814818 -> String -> Object
815− -> (Value -> Parser a) -> (Value -> Parser [a])
816819 -> Text -> Maybe (Parser (f a))
817820
818821instance ( FromTaggedObject arity a, FromTaggedObject arity b) =>
819822 FromTaggedObject arity (a :+: b) where
820− parseFromTaggedObject opts pa contentsFieldName obj pj pjl tag =
821− (fmap L1 <$> parseFromTaggedObject opts pa contentsFieldName obj pj pjl tag) <|>
822− (fmap R1 <$> parseFromTaggedObject opts pa contentsFieldName obj pj pjl tag)
823+ parseFromTaggedObject opts fargs contentsFieldName obj tag =
824+ (fmap L1 <$> parseFromTaggedObject opts fargs contentsFieldName obj tag) <|>
825+ (fmap R1 <$> parseFromTaggedObject opts fargs contentsFieldName obj tag)
823826
824827instance ( FromTaggedObject' arity f
825828 , Constructor c
826829 ) => FromTaggedObject arity (C1 c f) where
827− parseFromTaggedObject opts pa contentsFieldName obj pj pjl tag
830+ parseFromTaggedObject opts fargs contentsFieldName obj tag
828831 | tag == name = Just $ M1 <$> parseFromTaggedObject'
829− opts pa contentsFieldName pj pjl obj
832+ opts fargs contentsFieldName obj
830833 | otherwise = Nothing
831834 where
832835 name = pack $ constructorTagModifier opts $
@@ -835,87 +838,82 @@ instance ( FromTaggedObject' arity f
835838--------------------------------------------------------------------------------
836839
837840class FromTaggedObject' arity f where
838− parseFromTaggedObject' :: Options -> Proxy arity -> String
839− -> (Value -> Parser a) -> (Value -> Parser [a])
841+ parseFromTaggedObject' :: Options -> FromArgs arity a -> String
840842 -> Object -> Parser (f a)
841843
842844class FromTaggedObject'' arity f isRecord where
843− parseFromTaggedObject'' :: Options -> Proxy arity -> String
844− -> (Value -> Parser a) -> (Value -> Parser [a])
845+ parseFromTaggedObject'' :: Options -> FromArgs arity a -> String
845846 -> Object -> Tagged isRecord (Parser (f a))
846847
847848instance ( IsRecord f isRecord
848849 , FromTaggedObject'' arity f isRecord
849850 ) => FromTaggedObject' arity f where
850− parseFromTaggedObject' opts pa contentsFieldName pj pjl =
851+ parseFromTaggedObject' opts fargs contentsFieldName =
851852 (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .
852− parseFromTaggedObject'' opts pa contentsFieldName pj pjl
853+ parseFromTaggedObject'' opts fargs contentsFieldName
853854
854855instance (FromRecord arity f) => FromTaggedObject'' arity f True where
855− parseFromTaggedObject'' opts pa _ pj pjl =
856− Tagged . parseRecord opts pa Nothing pj pjl
856+ parseFromTaggedObject'' opts fargs _ =
857+ Tagged . parseRecord opts fargs Nothing
857858
858859instance (GFromJSON arity f) => FromTaggedObject'' arity f False where
859− parseFromTaggedObject'' opts pa contentsFieldName pj pjl = Tagged .
860− (gParseJSON opts pa pj pjl <=< (.: pack contentsFieldName))
860+ parseFromTaggedObject'' opts fargs contentsFieldName = Tagged .
861+ (gParseJSON opts fargs <=< (.: pack contentsFieldName))
861862
862863instance OVERLAPPING_ FromTaggedObject'' arity U1 False where
863− parseFromTaggedObject'' _ _ _ _ _ _ = Tagged (pure U1)
864+ parseFromTaggedObject'' _ _ _ _ = Tagged (pure U1)
864865
865866--------------------------------------------------------------------------------
866867
867868class ConsFromJSON arity f where
868− consParseJSON :: Options -> Proxy arity
869− -> (Value -> Parser a) -> (Value -> Parser [a])
869+ consParseJSON :: Options -> FromArgs arity a
870870 -> Value -> Parser (f a)
871871
872872class ConsFromJSON' arity f isRecord where
873− consParseJSON' :: Options -> Proxy arity
873+ consParseJSON' :: Options -> FromArgs arity a
874874 -> Maybe Text -- ^ A dummy label
875875 -- (Nothing to use proper label)
876− -> (Value -> Parser a) -> (Value -> Parser [a])
877876 -> Value -> Tagged isRecord (Parser (f a))
878877
879878instance ( IsRecord f isRecord
880879 , ConsFromJSON' arity f isRecord
881880 ) => ConsFromJSON arity f where
882− consParseJSON opts pa pj pjl v = let
881+ consParseJSON opts fargs v = let
883882 (v2,lab) = case (unwrapUnaryRecords opts,isUnary (undefined :: f a)) of
884883 -- use a dummy object with a dummy label
885884 (True,True) -> (object [(pack "dummy",v)], Just $ pack "dummy")
886885 _ ->(v,Nothing)
887886 in (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))
888− $ consParseJSON' opts pa lab pj pjl v2
887+ $ consParseJSON' opts fargs lab v2
889888
890889
891890instance (FromRecord arity f) => ConsFromJSON' arity f True where
892− consParseJSON' opts pa mlab pj pjl = Tagged . withObject "record (:*:)"
893− (parseRecord opts pa mlab pj pjl)
891+ consParseJSON' opts fargs mlab = Tagged . withObject "record (:*:)"
892+ (parseRecord opts fargs mlab)
894893
895894instance (GFromJSON arity f) => ConsFromJSON' arity f False where
896− consParseJSON' opts pa _ pj pjl = Tagged . gParseJSON opts pa pj pjl
895+ consParseJSON' opts fargs _ = Tagged . gParseJSON opts fargs
897896
898897--------------------------------------------------------------------------------
899898
900899class FromRecord arity f where
901− parseRecord :: Options -> Proxy arity
900+ parseRecord :: Options -> FromArgs arity a
902901 -> Maybe Text -- ^ A dummy label
903902 -- (Nothing to use proper label)
904− -> (Value -> Parser a) -> (Value -> Parser [a])
905903 -> Object -> Parser (f a)
906904
907905instance ( FromRecord arity a
908906 , FromRecord arity b
909907 ) => FromRecord arity (a :*: b) where
910− parseRecord opts pa _ pj pjl obj =
911− (:*:) <$> parseRecord opts pa Nothing pj pjl obj
912− <*> parseRecord opts pa Nothing pj pjl obj
908+ parseRecord opts fargs _ obj =
909+ (:*:) <$> parseRecord opts fargs Nothing obj
910+ <*> parseRecord opts fargs Nothing obj
913911
914912instance ( Selector s
915913 , GFromJSON arity a
916914 ) => FromRecord arity (S1 s a) where
917− parseRecord opts pa lab pj pjl =
918− (<?> Key label) . gParseJSON opts pa pj pjl <=< (.: label)
915+ parseRecord opts fargs lab =
916+ (<?> Key label) . gParseJSON opts fargs <=< (.: label)
919917 where
920918 label = fromMaybe defLabel lab
921919 defLabel = pack . fieldLabelModifier opts $
@@ -923,8 +921,8 @@ instance ( Selector s
923921
924922instance OVERLAPPING_ (Selector s, FromJSON a) =>
925923 FromRecord arity (S1 s (K1 i (Maybe a))) where
926− parseRecord _ _ (Just lab) _ _ obj = (M1 . K1) <$> obj .:? lab
927− parseRecord opts _ Nothing _ _ obj = (M1 . K1) <$> obj .:? pack label
924+ parseRecord _ _ (Just lab) obj = (M1 . K1) <$> obj .:? lab
925+ parseRecord opts _ Nothing obj = (M1 . K1) <$> obj .:? pack label
928926 where
929927 label = fieldLabelModifier opts $
930928 selName (undefined :: t s (K1 i (Maybe a)) p)
@@ -932,45 +930,43 @@ instance OVERLAPPING_ (Selector s, FromJSON a) =>
932930--------------------------------------------------------------------------------
933931
934932class FromProduct arity f where
935− parseProduct :: Options -> Proxy arity
933+ parseProduct :: Options -> FromArgs arity a
936934 -> Array -> Int -> Int
937− -> (Value -> Parser a) -> (Value -> Parser [a])
938935 -> Parser (f a)
939936
940937instance ( FromProduct arity a
941938 , FromProduct arity b
942939 ) => FromProduct arity (a :*: b) where
943− parseProduct opts pa arr ix len pj pjl =
944− (:*:) <$> parseProduct opts pa arr ix lenL pj pjl
945− <*> parseProduct opts pa arr ixR lenR pj pjl
940+ parseProduct opts fargs arr ix len =
941+ (:*:) <$> parseProduct opts fargs arr ix lenL
942+ <*> parseProduct opts fargs arr ixR lenR
946943 where
947944 lenL = len `unsafeShiftR` 1
948945 ixR = ix + lenL
949946 lenR = len - lenL
950947
951948instance (GFromJSON arity a) => FromProduct arity (S1 s a) where
952− parseProduct opts pa arr ix _ pj pjl =
953− gParseJSON opts pa pj pjl $ V.unsafeIndex arr ix
949+ parseProduct opts fargs arr ix _ =
950+ gParseJSON opts fargs $ V.unsafeIndex arr ix
954951
955952--------------------------------------------------------------------------------
956953
957954class FromPair arity f where
958− parsePair :: Options -> Proxy arity
959− -> (Value -> Parser a) -> (Value -> Parser [a])
955+ parsePair :: Options -> FromArgs arity a
960956 -> Pair -> Maybe (Parser (f a))
961957
962958instance ( FromPair arity a
963959 , FromPair arity b
964960 ) => FromPair arity (a :+: b) where
965− parsePair opts pa pj pjl pair = (fmap L1 <$> parsePair opts pa pj pjl pair) <|>
966− (fmap R1 <$> parsePair opts pa pj pjl pair)
961+ parsePair opts fargs pair = (fmap L1 <$> parsePair opts fargs pair) <|>
962+ (fmap R1 <$> parsePair opts fargs pair)
967963
968964instance ( Constructor c
969965 , GFromJSON arity a
970966 , ConsFromJSON arity a
971967 ) => FromPair arity (C1 c a) where
972− parsePair opts pa pj pjl (tag, value)
973− | tag == tag' = Just $ gParseJSON opts pa pj pjl value
968+ parsePair opts fargs (tag, value)
969+ | tag == tag' = Just $ gParseJSON opts fargs value
974970 | otherwise = Nothing
975971 where
976972 tag' = pack $ constructorTagModifier opts $
Data/Aeson/Types/Generic.hs−7
@@ -29,7 +29,6 @@ import Prelude ()
2929import Prelude.Compat
3030
3131import GHC.Generics
32−import Data.Proxy (Proxy (..))
3332
3433--------------------------------------------------------------------------------
3534
@@ -89,12 +88,6 @@ data Zero
8988-- | A type-level indicator that 'ToJSON1' or 'FromJSON1' is being derived generically.
9089data One
9190
92−proxyZero :: Proxy Zero
93−proxyZero = Proxy
94−
95−proxyOne :: Proxy One
96−proxyOne = Proxy
97−
9891--------------------------------------------------------------------------------
9992
10093class ProductSize f where
Data/Aeson/Types/ToJSON.hs+155−172
@@ -36,6 +36,7 @@ module Data.Aeson.Types.ToJSON (
3636 -- * Generic JSON classes
3737 , GToJSON(..)
3838 , GToEncoding(..)
39+ , ToArgs(..)
3940 , genericToJSON
4041 , genericToEncoding
4142 , genericLiftToJSON
@@ -138,8 +139,7 @@ class GToJSON arity f where
138139 -- | This method (applied to 'defaultOptions') is used as the
139140 -- default generic implementation of 'toJSON' (if the @arity@ is 'Zero')
140141 -- or 'liftToJSON' (if the @arity@ is 'One').
141− gToJSON :: Options -> Proxy arity
142− -> (a -> Value) -> ([a] -> Value) -> f a -> Value
142+ gToJSON :: Options -> ToArgs Value arity a -> f a -> Value
143143
144144-- | Class of generic representation types that can be converted to
145145-- a JSON 'Encoding'.
@@ -147,15 +147,21 @@ class GToEncoding arity f where
147147 -- | This method (applied to 'defaultOptions') can be used as the
148148 -- default generic implementation of 'toEncoding' (if the @arity@ is 'Zero')
149149 -- or 'liftToEncoding' (if the @arity@ is 'One').
150− gToEncoding :: Options -> Proxy arity
151− -> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
150+ gToEncoding :: Options -> ToArgs Encoding arity a -> f a -> Encoding
151+
152+-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
153+-- function arguments that encode occurrences of the type parameter (for
154+-- 'ToJSON1').
155+data ToArgs res arity a where
156+ NoToArgs :: ToArgs res Zero a
157+ To1Args :: (a -> res) -> ([a] -> res) -> ToArgs res One a
152158
153159-- | A configurable generic JSON creator. This function applied to
154160-- 'defaultOptions' is used as the default for 'toJSON' when the type
155161-- is an instance of 'Generic'.
156162genericToJSON :: (Generic a, GToJSON Zero (Rep a))
157163 => Options -> a -> Value
158−genericToJSON opts = gToJSON opts proxyZero undefined undefined . from
164+genericToJSON opts = gToJSON opts NoToArgs . from
159165
160166-- | A configurable generic JSON creator. This function applied to
161167-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
@@ -163,14 +169,14 @@ genericToJSON opts = gToJSON opts proxyZero undefined undefined . from
163169genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
164170 => Options -> (a -> Value) -> ([a] -> Value)
165171 -> f a -> Value
166−genericLiftToJSON opts tj tjl = gToJSON opts proxyOne tj tjl . from1
172+genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
167173
168174-- | A configurable generic JSON encoder. This function applied to
169175-- 'defaultOptions' is used as the default for 'toEncoding' when the type
170176-- is an instance of 'Generic'.
171177genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))
172178 => Options -> a -> Encoding
173−genericToEncoding opts = gToEncoding opts proxyZero undefined undefined . from
179+genericToEncoding opts = gToEncoding opts NoToArgs . from
174180
175181-- | A configurable generic JSON encoder. This function applied to
176182-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
@@ -178,7 +184,7 @@ genericToEncoding opts = gToEncoding opts proxyZero undefined undefined . from
178184genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
179185 => Options -> (a -> Encoding) -> ([a] -> Encoding)
180186 -> f a -> Encoding
181−genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
187+genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
182188
183189-------------------------------------------------------------------------------
184190-- Class
@@ -595,30 +601,30 @@ instance (ToJSON a) => ToJSON [a] where
595601
596602instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where
597603 -- Meta-information, which is not handled elsewhere, is ignored:
598− gToJSON opts pa tj tjl = gToJSON opts pa tj tjl . unM1
604+ gToJSON opts targs = gToJSON opts targs . unM1
599605
600606instance (ToJSON a) => GToJSON arity (K1 i a) where
601607 -- Constant values are encoded using their ToJSON instance:
602− gToJSON _opts _ _ _ = toJSON . unK1
608+ gToJSON _opts _ = toJSON . unK1
603609
604610instance GToJSON One Par1 where
605611 -- Direct occurrences of the last type parameter are encoded with the
606612 -- function passed in as an argument:
607− gToJSON _opts _ tj _ = tj . unPar1
613+ gToJSON _opts (To1Args tj _) = tj . unPar1
608614
609615instance (ToJSON1 f) => GToJSON One (Rec1 f) where
610616 -- Recursive occurrences of the last type parameter are encoded using their
611617 -- ToJSON1 instance:
612− gToJSON _opts _ tj tjl = liftToJSON tj tjl . unRec1
618+ gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
613619
614620instance GToJSON arity U1 where
615621 -- Empty constructors are encoded to an empty array:
616− gToJSON _opts _ _ _ _ = emptyArray
622+ gToJSON _opts _ _ = emptyArray
617623
618624instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where
619625 -- Constructors need to be encoded differently depending on whether they're
620626 -- a record or not. This distinction is made by 'consToJSON':
621− gToJSON opts pa tj tjl = consToJSON opts pa tj tjl . unM1
627+ gToJSON opts targs = consToJSON opts targs . unM1
622628
623629instance ( WriteProduct arity a, WriteProduct arity b
624630 , ProductSize a, ProductSize b
@@ -626,10 +632,10 @@ instance ( WriteProduct arity a, WriteProduct arity b
626632 -- Products are encoded to an array. Here we allocate a mutable vector of
627633 -- the same size as the product and write the product's elements to it using
628634 -- 'writeProduct':
629− gToJSON opts pa tj tjl p =
635+ gToJSON opts targs p =
630636 Array $ V.create $ do
631637 mv <- VM.unsafeNew lenProduct
632− writeProduct opts pa mv 0 lenProduct tj tjl p
638+ writeProduct opts targs mv 0 lenProduct p
633639 return mv
634640 where
635641 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
@@ -641,15 +647,15 @@ instance ( AllNullary (a :+: b) allNullary
641647 -- If all constructors of a sum datatype are nullary and the
642648 -- 'allNullaryToStringTag' option is set they are encoded to
643649 -- strings. This distinction is made by 'sumToJSON':
644− gToJSON opts pa tj tjl = (unTagged :: Tagged allNullary Value -> Value)
645− . sumToJSON opts pa tj tjl
650+ gToJSON opts targs = (unTagged :: Tagged allNullary Value -> Value)
651+ . sumToJSON opts targs
646652
647653instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where
648654 -- If an occurrence of the last type parameter is nested inside two
649655 -- composed types, it is encoded by using the outermost type's ToJSON1
650656 -- instance to generically encode the innermost type:
651− gToJSON opts pa tj tjl =
652− let gtj = gToJSON opts pa tj tjl in
657+ gToJSON opts targs =
658+ let gtj = gToJSON opts targs in
653659 liftToJSON gtj (listValue gtj) . unComp1
654660
655661--------------------------------------------------------------------------------
@@ -657,30 +663,30 @@ instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where
657663
658664instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where
659665 -- Meta-information, which is not handled elsewhere, is ignored:
660− gToEncoding opts pa te tel = gToEncoding opts pa te tel . unM1
666+ gToEncoding opts targs = gToEncoding opts targs . unM1
661667
662668instance (ToJSON a) => GToEncoding arity (K1 i a) where
663669 -- Constant values are encoded using their ToJSON instance:
664− gToEncoding _opts _ _ _ = toEncoding . unK1
670+ gToEncoding _opts _ = toEncoding . unK1
665671
666672instance GToEncoding One Par1 where
667673 -- Direct occurrences of the last type parameter are encoded with the
668674 -- function passed in as an argument:
669− gToEncoding _opts _ te _ = te . unPar1
675+ gToEncoding _opts (To1Args te _) = te . unPar1
670676
671677instance (ToJSON1 f) => GToEncoding One (Rec1 f) where
672678 -- Recursive occurrences of the last type parameter are encoded using their
673679 -- ToEncoding1 instance:
674− gToEncoding _opts _ te tel = liftToEncoding te tel . unRec1
680+ gToEncoding _opts (To1Args te tel) = liftToEncoding te tel . unRec1
675681
676682instance GToEncoding arity U1 where
677683 -- Empty constructors are encoded to an empty array:
678− gToEncoding _opts _ _ _ _ = E.emptyArray_
684+ gToEncoding _opts _ _ = E.emptyArray_
679685
680686instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where
681687 -- Constructors need to be encoded differently depending on whether they're
682688 -- a record or not. This distinction is made by 'consToEncoding':
683− gToEncoding opts pa te tel = consToEncoding opts pa te tel . unM1
689+ gToEncoding opts targs = consToEncoding opts targs . unM1
684690
685691instance ( EncodeProduct arity a
686692 , EncodeProduct arity b
@@ -688,7 +694,7 @@ instance ( EncodeProduct arity a
688694 -- Products are encoded to an array. Here we allocate a mutable vector of
689695 -- the same size as the product and write the product's elements to it using
690696 -- 'encodeProduct':
691− gToEncoding opts pa te tel p = E.tuple $ encodeProduct opts pa te tel p
697+ gToEncoding opts targs p = E.tuple $ encodeProduct opts targs p
692698
693699instance ( AllNullary (a :+: b) allNullary
694700 , SumToEncoding arity (a :+: b) allNullary
@@ -696,23 +702,22 @@ instance ( AllNullary (a :+: b) allNullary
696702 -- If all constructors of a sum datatype are nullary and the
697703 -- 'allNullaryToStringTag' option is set they are encoded to
698704 -- strings. This distinction is made by 'sumToEncoding':
699− gToEncoding opts pa te tel
705+ gToEncoding opts targs
700706 = (unTagged :: Tagged allNullary Encoding -> Encoding)
701− . sumToEncoding opts pa te tel
707+ . sumToEncoding opts targs
702708
703709instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where
704710 -- If an occurrence of the last type parameter is nested inside two
705711 -- composed types, it is encoded by using the outermost type's ToJSON1
706712 -- instance to generically encode the innermost type:
707− gToEncoding opts pa te tel =
708− let gte = gToEncoding opts pa te tel in
713+ gToEncoding opts targs =
714+ let gte = gToEncoding opts targs in
709715 liftToEncoding gte (listEncoding gte) . unComp1
710716
711717--------------------------------------------------------------------------------
712718
713719class SumToJSON arity f allNullary where
714− sumToJSON :: Options -> Proxy arity
715− -> (a -> Value) -> ([a] -> Value)
720+ sumToJSON :: Options -> ToArgs Value arity a
716721 -> f a -> Tagged allNullary Value
717722
718723instance ( GetConName f
@@ -720,35 +725,33 @@ instance ( GetConName f
720725 , ObjectWithSingleFieldObj arity f
721726 , TwoElemArrayObj arity f
722727 ) => SumToJSON arity f True where
723− sumToJSON opts pa tj tjl
728+ sumToJSON opts targs
724729 | allNullaryToStringTag opts = Tagged . String . pack
725730 . constructorTagModifier opts . getConName
726− | otherwise = Tagged . nonAllNullarySumToJSON opts pa tj tjl
731+ | otherwise = Tagged . nonAllNullarySumToJSON opts targs
727732
728733instance ( TwoElemArrayObj arity f
729734 , TaggedObjectPairs arity f
730735 , ObjectWithSingleFieldObj arity f
731736 ) => SumToJSON arity f False where
732− sumToJSON opts pa tj tjl = Tagged . nonAllNullarySumToJSON opts pa tj tjl
737+ sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
733738
734739nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f
735740 , TaggedObjectPairs arity f
736741 , ObjectWithSingleFieldObj arity f
737− ) => Options -> Proxy arity
738− -> (a -> Value) -> ([a] -> Value)
742+ ) => Options -> ToArgs Value arity a
739743 -> f a -> Value
740−nonAllNullarySumToJSON opts pa tj tjl =
744+nonAllNullarySumToJSON opts targs =
741745 case sumEncoding opts of
742746 TaggedObject{..} ->
743− object . taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl
744− ObjectWithSingleField -> Object . objectWithSingleFieldObj opts pa tj tjl
745− TwoElemArray -> Array . twoElemArrayObj opts pa tj tjl
747+ object . taggedObjectPairs opts targs tagFieldName contentsFieldName
748+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts targs
749+ TwoElemArray -> Array . twoElemArrayObj opts targs
746750
747751--------------------------------------------------------------------------------
748752
749753class SumToEncoding arity f allNullary where
750− sumToEncoding :: Options -> Proxy arity
751− -> (a -> Encoding) -> ([a] -> Encoding)
754+ sumToEncoding :: Options -> ToArgs Encoding arity a
752755 -> f a -> Tagged allNullary Encoding
753756
754757instance ( GetConName f
@@ -756,116 +759,111 @@ instance ( GetConName f
756759 , ObjectWithSingleFieldEnc arity f
757760 , TwoElemArrayEnc arity f
758761 ) => SumToEncoding arity f True where
759− sumToEncoding opts pa te tel
762+ sumToEncoding opts targs
760763 | allNullaryToStringTag opts = Tagged . toEncoding .
761764 constructorTagModifier opts . getConName
762− | otherwise = Tagged . nonAllNullarySumToEncoding opts pa te tel
765+ | otherwise = Tagged . nonAllNullarySumToEncoding opts targs
763766
764767instance ( TwoElemArrayEnc arity f
765768 , TaggedObjectEnc arity f
766769 , ObjectWithSingleFieldEnc arity f
767770 ) => SumToEncoding arity f False where
768− sumToEncoding opts pa te tel = Tagged . nonAllNullarySumToEncoding opts pa te tel
771+ sumToEncoding opts targs = Tagged . nonAllNullarySumToEncoding opts targs
769772
770773nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f
771774 , TaggedObjectEnc arity f
772775 , ObjectWithSingleFieldEnc arity f
773− ) => Options -> Proxy arity
774− -> (a -> Encoding) -> ([a] -> Encoding)
776+ ) => Options -> ToArgs Encoding arity a
775777 -> f a -> Encoding
776−nonAllNullarySumToEncoding opts pa te tel =
778+nonAllNullarySumToEncoding opts targs =
777779 case sumEncoding opts of
778780 TaggedObject{..} ->
779− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel
780− ObjectWithSingleField -> objectWithSingleFieldEnc opts pa te tel
781− TwoElemArray -> twoElemArrayEnc opts pa te tel
781+ taggedObjectEnc opts targs tagFieldName contentsFieldName
782+ ObjectWithSingleField -> objectWithSingleFieldEnc opts targs
783+ TwoElemArray -> twoElemArrayEnc opts targs
782784
783785--------------------------------------------------------------------------------
784786
785787class TaggedObjectPairs arity f where
786− taggedObjectPairs :: Options -> Proxy arity
788+ taggedObjectPairs :: Options -> ToArgs Value arity a
787789 -> String -> String
788− -> (a -> Value) -> ([a] -> Value)
789790 -> f a -> [Pair]
790791
791792instance ( TaggedObjectPairs arity a
792793 , TaggedObjectPairs arity b
793794 ) => TaggedObjectPairs arity (a :+: b) where
794− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (L1 x) =
795− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x
796− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (R1 x) =
797− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x
795+ taggedObjectPairs opts targs tagFieldName contentsFieldName (L1 x) =
796+ taggedObjectPairs opts targs tagFieldName contentsFieldName x
797+ taggedObjectPairs opts targs tagFieldName contentsFieldName (R1 x) =
798+ taggedObjectPairs opts targs tagFieldName contentsFieldName x
798799
799800instance ( IsRecord a isRecord
800801 , TaggedObjectPairs' arity a isRecord
801802 , Constructor c
802803 ) => TaggedObjectPairs arity (C1 c a) where
803− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl =
804+ taggedObjectPairs opts targs tagFieldName contentsFieldName =
804805 (pack tagFieldName .= constructorTagModifier opts
805806 (conName (undefined :: t c a p)) :) .
806807 (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
807− taggedObjectPairs' opts pa contentsFieldName tj tjl . unM1
808+ taggedObjectPairs' opts targs contentsFieldName . unM1
808809
809810class TaggedObjectPairs' arity f isRecord where
810− taggedObjectPairs' :: Options -> Proxy arity
811− -> String -> (a -> Value) -> ([a] -> Value)
812− -> f a -> Tagged isRecord [Pair]
811+ taggedObjectPairs' :: Options -> ToArgs Value arity a
812+ -> String -> f a -> Tagged isRecord [Pair]
813813
814814instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where
815− taggedObjectPairs' _ _ _ _ _ _ = Tagged []
815+ taggedObjectPairs' _ _ _ _ = Tagged []
816816
817817instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where
818− taggedObjectPairs' opts pa _ tj tjl =
819− Tagged . toList . recordToPairs opts pa tj tjl
818+ taggedObjectPairs' opts targs _ =
819+ Tagged . toList . recordToPairs opts targs
820820
821821instance (GToJSON arity f) => TaggedObjectPairs' arity f False where
822− taggedObjectPairs' opts pa contentsFieldName tj tjl =
823− Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts pa tj tjl
822+ taggedObjectPairs' opts targs contentsFieldName =
823+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts targs
824824
825825--------------------------------------------------------------------------------
826826
827827class TaggedObjectEnc arity f where
828− taggedObjectEnc :: Options -> Proxy arity
828+ taggedObjectEnc :: Options -> ToArgs Encoding arity a
829829 -> String -> String
830− -> (a -> Encoding) -> ([a] -> Encoding)
831830 -> f a -> Encoding
832831
833832instance ( TaggedObjectEnc arity a
834833 , TaggedObjectEnc arity b
835834 ) => TaggedObjectEnc arity (a :+: b) where
836− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (L1 x) =
837− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x
838− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (R1 x) =
839− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x
835+ taggedObjectEnc opts targs tagFieldName contentsFieldName (L1 x) =
836+ taggedObjectEnc opts targs tagFieldName contentsFieldName x
837+ taggedObjectEnc opts targs tagFieldName contentsFieldName (R1 x) =
838+ taggedObjectEnc opts targs tagFieldName contentsFieldName x
840839
841840instance ( IsRecord a isRecord
842841 , TaggedObjectEnc' arity a isRecord
843842 , Constructor c
844843 ) => TaggedObjectEnc arity (C1 c a) where
845− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel v =
844+ taggedObjectEnc opts targs tagFieldName contentsFieldName v =
846845 E.wrapObject $
847846 (E.string tagFieldName ><
848847 E.colon ><
849848 toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) ><
850849 ((unTagged :: Tagged isRecord Encoding -> Encoding) .
851− taggedObjectEnc' opts pa contentsFieldName te tel . unM1 $ v)
850+ taggedObjectEnc' opts targs contentsFieldName . unM1 $ v)
852851
853852class TaggedObjectEnc' arity f isRecord where
854− taggedObjectEnc' :: Options -> Proxy arity
855− -> String -> (a -> Encoding) -> ([a] -> Encoding)
856− -> f a -> Tagged isRecord Encoding
853+ taggedObjectEnc' :: Options -> ToArgs Encoding arity a
854+ -> String -> f a -> Tagged isRecord Encoding
857855
858856instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where
859− taggedObjectEnc' _ _ _ _ _ _ = Tagged E.empty
857+ taggedObjectEnc' _ _ _ _ = Tagged E.empty
860858
861859instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where
862− taggedObjectEnc' opts pa _ te tel = Tagged . (E.comma ><) . fst
863− . recordToEncoding opts pa te tel
860+ taggedObjectEnc' opts targs _ = Tagged . (E.comma ><) . fst
861+ . recordToEncoding opts targs
864862
865863instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where
866− taggedObjectEnc' opts pa contentsFieldName te tel =
864+ taggedObjectEnc' opts targs contentsFieldName =
867865 Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .
868− gToEncoding opts pa te tel
866+ gToEncoding opts targs
869867
870868--------------------------------------------------------------------------------
871869
@@ -883,137 +881,129 @@ instance (Constructor c) => GetConName (C1 c a) where
883881--------------------------------------------------------------------------------
884882
885883class TwoElemArrayObj arity f where
886− twoElemArrayObj :: Options -> Proxy arity
887− -> (a -> Value) -> ([a] -> Value)
884+ twoElemArrayObj :: Options -> ToArgs Value arity a
888885 -> f a -> V.Vector Value
889886
890887instance ( TwoElemArrayObj arity a
891888 , TwoElemArrayObj arity b
892889 ) => TwoElemArrayObj arity (a :+: b) where
893− twoElemArrayObj opts pa tj tjl (L1 x) = twoElemArrayObj opts pa tj tjl x
894− twoElemArrayObj opts pa tj tjl (R1 x) = twoElemArrayObj opts pa tj tjl x
890+ twoElemArrayObj opts targs (L1 x) = twoElemArrayObj opts targs x
891+ twoElemArrayObj opts targs (R1 x) = twoElemArrayObj opts targs x
895892
896893instance ( GToJSON arity a
897894 , ConsToJSON arity a
898895 , Constructor c
899896 ) => TwoElemArrayObj arity (C1 c a) where
900− twoElemArrayObj opts pa tj tjl x = V.create $ do
897+ twoElemArrayObj opts targs x = V.create $ do
901898 mv <- VM.unsafeNew 2
902899 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
903900 $ conName (undefined :: t c a p)
904− VM.unsafeWrite mv 1 $ gToJSON opts pa tj tjl x
901+ VM.unsafeWrite mv 1 $ gToJSON opts targs x
905902 return mv
906903
907904--------------------------------------------------------------------------------
908905
909906class TwoElemArrayEnc arity f where
910− twoElemArrayEnc :: Options -> Proxy arity
911− -> (a -> Encoding) -> ([a] -> Encoding)
907+ twoElemArrayEnc :: Options -> ToArgs Encoding arity a
912908 -> f a -> Encoding
913909
914910instance ( TwoElemArrayEnc arity a
915911 , TwoElemArrayEnc arity b
916912 ) => TwoElemArrayEnc arity (a :+: b) where
917− twoElemArrayEnc opts pa te tel (L1 x) = twoElemArrayEnc opts pa te tel x
918− twoElemArrayEnc opts pa te tel (R1 x) = twoElemArrayEnc opts pa te tel x
913+ twoElemArrayEnc opts targs (L1 x) = twoElemArrayEnc opts targs x
914+ twoElemArrayEnc opts targs (R1 x) = twoElemArrayEnc opts targs x
919915
920916instance ( GToEncoding arity a
921917 , ConsToEncoding arity a
922918 , Constructor c
923919 ) => TwoElemArrayEnc arity (C1 c a) where
924− twoElemArrayEnc opts pa te tel x = E.tuple $
920+ twoElemArrayEnc opts targs x = E.tuple $
925921 toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
926− gToEncoding opts pa te tel x
922+ gToEncoding opts targs x
927923
928924--------------------------------------------------------------------------------
929925
930926class ConsToJSON arity f where
931− consToJSON :: Options -> Proxy arity
932− -> (a -> Value) -> ([a] -> Value)
927+ consToJSON :: Options -> ToArgs Value arity a
933928 -> f a -> Value
934929
935930class ConsToJSON' arity f isRecord where
936− consToJSON' :: Options -> Proxy arity
931+ consToJSON' :: Options -> ToArgs Value arity a
937932 -> Bool -- ^ Are we a record with one field?
938− -> (a -> Value) -> ([a] -> Value)
939933 -> f a -> Tagged isRecord Value
940934
941935instance ( IsRecord f isRecord
942936 , ConsToJSON' arity f isRecord
943937 ) => ConsToJSON arity f where
944− consToJSON opts pa tj tjl =
938+ consToJSON opts targs =
945939 (unTagged :: Tagged isRecord Value -> Value)
946− . consToJSON' opts pa (isUnary (undefined :: f a)) tj tjl
940+ . consToJSON' opts targs (isUnary (undefined :: f a))
947941
948942instance (RecordToPairs arity f) => ConsToJSON' arity f True where
949− consToJSON' opts pa isUn tj tjl f = let
950− vals = toList $ recordToPairs opts pa tj tjl f
943+ consToJSON' opts targs isUn f = let
944+ vals = toList $ recordToPairs opts targs f
951945 in case (unwrapUnaryRecords opts,isUn,vals) of
952946 (True,True,[(_,val)]) -> Tagged val
953947 _ -> Tagged $ object vals
954948
955949instance GToJSON arity f => ConsToJSON' arity f False where
956− consToJSON' opts pa _ tj tjl = Tagged . gToJSON opts pa tj tjl
950+ consToJSON' opts targs _ = Tagged . gToJSON opts targs
957951
958952--------------------------------------------------------------------------------
959953
960954class ConsToEncoding arity f where
961− consToEncoding :: Options -> Proxy arity
962− -> (a -> Encoding) -> ([a] -> Encoding)
955+ consToEncoding :: Options -> ToArgs Encoding arity a
963956 -> f a -> Encoding
964957
965958class ConsToEncoding' arity f isRecord where
966− consToEncoding' :: Options -> Proxy arity
959+ consToEncoding' :: Options -> ToArgs Encoding arity a
967960 -> Bool -- ^ Are we a record with one field?
968− -> (a -> Encoding) -> ([a] -> Encoding)
969961 -> f a -> Tagged isRecord Encoding
970962
971963instance ( IsRecord f isRecord
972964 , ConsToEncoding' arity f isRecord
973965 ) => ConsToEncoding arity f where
974− consToEncoding opts pa te tel =
966+ consToEncoding opts targs =
975967 (unTagged :: Tagged isRecord Encoding -> Encoding)
976− . consToEncoding' opts pa (isUnary (undefined :: f a)) te tel
968+ . consToEncoding' opts targs (isUnary (undefined :: f a))
977969
978970instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where
979− consToEncoding' opts pa isUn te tel x =
980− let (enc, mbVal) = recordToEncoding opts pa te tel x
971+ consToEncoding' opts targs isUn x =
972+ let (enc, mbVal) = recordToEncoding opts targs x
981973 in case (unwrapUnaryRecords opts, isUn, mbVal) of
982974 (True, True, Just val) -> Tagged val
983975 _ -> Tagged $ E.wrapObject enc
984976
985977instance GToEncoding arity f => ConsToEncoding' arity f False where
986− consToEncoding' opts pa _ te tel = Tagged . gToEncoding opts pa te tel
978+ consToEncoding' opts targs _ = Tagged . gToEncoding opts targs
987979
988980--------------------------------------------------------------------------------
989981
990982class RecordToPairs arity f where
991− recordToPairs :: Options -> Proxy arity
992− -> (a -> Value) -> ([a] -> Value)
983+ recordToPairs :: Options -> ToArgs Value arity a
993984 -> f a -> DList Pair
994985
995986instance ( RecordToPairs arity a
996987 , RecordToPairs arity b
997988 ) => RecordToPairs arity (a :*: b) where
998− recordToPairs opts pa tj tjl (a :*: b) = recordToPairs opts pa tj tjl a <>
999− recordToPairs opts pa tj tjl b
989+ recordToPairs opts targs (a :*: b) = recordToPairs opts targs a <>
990+ recordToPairs opts targs b
1000991
1001992instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where
1002993 recordToPairs = fieldToPair
1003994
1004995instance OVERLAPPING_ (Selector s, ToJSON a) =>
1005996 RecordToPairs arity (S1 s (K1 i (Maybe a))) where
1006− recordToPairs opts _ _ _ (M1 k1) | omitNothingFields opts
1007− , K1 Nothing <- k1 = DList.empty
1008− recordToPairs opts pa tj tjl m1 = fieldToPair opts pa tj tjl m1
997+ recordToPairs opts _ (M1 k1) | omitNothingFields opts
998+ , K1 Nothing <- k1 = DList.empty
999+ recordToPairs opts targs m1 = fieldToPair opts targs m1
10091000
10101001fieldToPair :: (Selector s, GToJSON arity a)
1011− => Options -> Proxy arity
1012− -> (p -> Value) -> ([p] -> Value)
1002+ => Options -> ToArgs Value arity p
10131003 -> S1 s a p -> DList Pair
1014−fieldToPair opts pa tj tjl m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
1015− , gToJSON opts pa tj tjl (unM1 m1)
1016− )
1004+fieldToPair opts targs m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
1005+ , gToJSON opts targs (unM1 m1)
1006+ )
10171007
10181008--------------------------------------------------------------------------------
10191009
@@ -1021,22 +1011,21 @@ class RecordToEncoding arity f where
10211011 -- 1st element: whole thing
10221012 -- 2nd element: in case the record has only 1 field, just the value
10231013 -- of the field (without the key); 'Nothing' otherwise
1024− recordToEncoding :: Options -> Proxy arity
1025− -> (a -> Encoding) -> ([a] -> Encoding)
1014+ recordToEncoding :: Options -> ToArgs Encoding arity a
10261015 -> f a -> (Encoding, Maybe Encoding)
10271016
10281017instance ( RecordToEncoding arity a
10291018 , RecordToEncoding arity b
10301019 ) => RecordToEncoding arity (a :*: b) where
1031− recordToEncoding opts pa te tel (a :*: b) | omitNothingFields opts =
1020+ recordToEncoding opts targs (a :*: b) | omitNothingFields opts =
10321021 (E.econcat $ intersperse E.comma $
10331022 filter (not . E.nullEncoding)
1034− [ fst (recordToEncoding opts pa te tel a)
1035− , fst (recordToEncoding opts pa te tel b) ]
1023+ [ fst (recordToEncoding opts targs a)
1024+ , fst (recordToEncoding opts targs b) ]
10361025 , Nothing)
1037− recordToEncoding opts pa te tel (a :*: b) =
1038− (fst (recordToEncoding opts pa te tel a) >< E.comma ><
1039− fst (recordToEncoding opts pa te tel b),
1026+ recordToEncoding opts targs (a :*: b) =
1027+ (fst (recordToEncoding opts targs a) >< E.comma ><
1028+ fst (recordToEncoding opts targs b),
10401029 Nothing)
10411030
10421031
@@ -1045,87 +1034,82 @@ instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) wh
10451034
10461035instance OVERLAPPING_ (Selector s, ToJSON a) =>
10471036 RecordToEncoding arity (S1 s (K1 i (Maybe a))) where
1048− recordToEncoding opts _ _ _ (M1 k1) | omitNothingFields opts
1049− , K1 Nothing <- k1 = (E.empty, Nothing)
1050− recordToEncoding opts pa te tel m1 = fieldToEncoding opts pa te tel m1
1037+ recordToEncoding opts _ (M1 k1) | omitNothingFields opts
1038+ , K1 Nothing <- k1 = (E.empty, Nothing)
1039+ recordToEncoding opts targs m1 = fieldToEncoding opts targs m1
10511040
10521041fieldToEncoding :: (Selector s, GToEncoding arity a)
1053− => Options -> Proxy arity
1054− -> (p -> Encoding) -> ([p] -> Encoding)
1042+ => Options -> ToArgs Encoding arity p
10551043 -> S1 s a p -> (Encoding, Maybe Encoding)
1056−fieldToEncoding opts pa te tel m1 =
1044+fieldToEncoding opts targs m1 =
10571045 let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
1058− valueBuilder = gToEncoding opts pa te tel (unM1 m1)
1046+ valueBuilder = gToEncoding opts targs (unM1 m1)
10591047 in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)
10601048
10611049--------------------------------------------------------------------------------
10621050
10631051class WriteProduct arity f where
10641052 writeProduct :: Options
1065− -> Proxy arity
1053+ -> ToArgs Value arity a
10661054 -> VM.MVector s Value
10671055 -> Int -- ^ index
10681056 -> Int -- ^ length
1069− -> (a -> Value)
1070− -> ([a] -> Value)
10711057 -> f a
10721058 -> ST s ()
10731059
10741060instance ( WriteProduct arity a
10751061 , WriteProduct arity b
10761062 ) => WriteProduct arity (a :*: b) where
1077− writeProduct opts pa mv ix len tj tjl (a :*: b) = do
1078− writeProduct opts pa mv ix lenL tj tjl a
1079− writeProduct opts pa mv ixR lenR tj tjl b
1063+ writeProduct opts targs mv ix len (a :*: b) = do
1064+ writeProduct opts targs mv ix lenL a
1065+ writeProduct opts targs mv ixR lenR b
10801066 where
10811067 lenL = len `unsafeShiftR` 1
10821068 lenR = len - lenL
10831069 ixR = ix + lenL
10841070
10851071instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
1086− writeProduct opts pa mv ix _ tj tjl =
1087− VM.unsafeWrite mv ix . gToJSON opts pa tj tjl
1072+ writeProduct opts targs mv ix _ =
1073+ VM.unsafeWrite mv ix . gToJSON opts targs
10881074
10891075--------------------------------------------------------------------------------
10901076
10911077class EncodeProduct arity f where
1092− encodeProduct :: Options -> Proxy arity
1093− -> (a -> Encoding) -> ([a] -> Encoding)
1078+ encodeProduct :: Options -> ToArgs Encoding arity a
10941079 -> f a -> Encoding' E.InArray
10951080
10961081instance ( EncodeProduct arity a
10971082 , EncodeProduct arity b
10981083 ) => EncodeProduct arity (a :*: b) where
1099− encodeProduct opts pa te tel (a :*: b) | omitNothingFields opts =
1084+ encodeProduct opts targs (a :*: b) | omitNothingFields opts =
11001085 E.econcat $ intersperse E.comma $
11011086 filter (not . E.nullEncoding)
1102− [encodeProduct opts pa te tel a, encodeProduct opts pa te tel b]
1103− encodeProduct opts pa te tel (a :*: b) = encodeProduct opts pa te tel a >*<
1104− encodeProduct opts pa te tel b
1087+ [encodeProduct opts targs a, encodeProduct opts targs b]
1088+ encodeProduct opts targs (a :*: b) = encodeProduct opts targs a >*<
1089+ encodeProduct opts targs b
11051090
11061091instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1107− encodeProduct opts pa te tel a = E.retagEncoding $ gToEncoding opts pa te tel a
1092+ encodeProduct opts targs a = E.retagEncoding $ gToEncoding opts targs a
11081093
11091094--------------------------------------------------------------------------------
11101095
11111096class ObjectWithSingleFieldObj arity f where
1112− objectWithSingleFieldObj :: Options -> Proxy arity
1113− -> (a -> Value) -> ([a] -> Value)
1097+ objectWithSingleFieldObj :: Options -> ToArgs Value arity a
11141098 -> f a -> Object
11151099
11161100instance ( ObjectWithSingleFieldObj arity a
11171101 , ObjectWithSingleFieldObj arity b
11181102 ) => ObjectWithSingleFieldObj arity (a :+: b) where
1119− objectWithSingleFieldObj opts pa tj tjl (L1 x) =
1120− objectWithSingleFieldObj opts pa tj tjl x
1121− objectWithSingleFieldObj opts pa tj tjl (R1 x) =
1122− objectWithSingleFieldObj opts pa tj tjl x
1103+ objectWithSingleFieldObj opts targs (L1 x) =
1104+ objectWithSingleFieldObj opts targs x
1105+ objectWithSingleFieldObj opts targs (R1 x) =
1106+ objectWithSingleFieldObj opts targs x
11231107
11241108instance ( GToJSON arity a
11251109 , ConsToJSON arity a
11261110 , Constructor c
11271111 ) => ObjectWithSingleFieldObj arity (C1 c a) where
1128− objectWithSingleFieldObj opts pa tj tjl = H.singleton typ . gToJSON opts pa tj tjl
1112+ objectWithSingleFieldObj opts targs = H.singleton typ . gToJSON opts targs
11291113 where
11301114 typ = pack $ constructorTagModifier opts $
11311115 conName (undefined :: t c a p)
@@ -1133,29 +1117,28 @@ instance ( GToJSON arity a
11331117--------------------------------------------------------------------------------
11341118
11351119class ObjectWithSingleFieldEnc arity f where
1136− objectWithSingleFieldEnc :: Options -> Proxy arity
1137− -> (a -> Encoding) -> ([a] -> Encoding)
1120+ objectWithSingleFieldEnc :: Options -> ToArgs Encoding arity a
11381121 -> f a -> Encoding
11391122
11401123instance ( ObjectWithSingleFieldEnc arity a
11411124 , ObjectWithSingleFieldEnc arity b
11421125 ) => ObjectWithSingleFieldEnc arity (a :+: b) where
1143− objectWithSingleFieldEnc opts pa te tel (L1 x) =
1144− objectWithSingleFieldEnc opts pa te tel x
1145− objectWithSingleFieldEnc opts pa te tel (R1 x) =
1146− objectWithSingleFieldEnc opts pa te tel x
1126+ objectWithSingleFieldEnc opts targs (L1 x) =
1127+ objectWithSingleFieldEnc opts targs x
1128+ objectWithSingleFieldEnc opts targs (R1 x) =
1129+ objectWithSingleFieldEnc opts targs x
11471130
11481131instance ( GToEncoding arity a
11491132 , ConsToEncoding arity a
11501133 , Constructor c
11511134 ) => ObjectWithSingleFieldEnc arity (C1 c a) where
1152− objectWithSingleFieldEnc opts pa te tel v =
1135+ objectWithSingleFieldEnc opts targs v =
11531136 E.openCurly ><
11541137 toEncoding
11551138 (constructorTagModifier opts
11561139 (conName (undefined :: t c a p))) ><
11571140 E.colon ><
1158− gToEncoding opts pa te tel v ><
1141+ gToEncoding opts targs v ><
11591142 E.closeCurly
11601143
11611144-------------------------------------------------------------------------------