dd56788 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Remove use of Proxy and undefined in generics code

dd56788Ryan Scott10 years ago

Data/Aeson.hs+2

compare with master

unifiedsplit

@@ -75,8 +75,10 @@ module Data.Aeson

75 , toEncoding2

76 -- ** Generic JSON classes and options

77 , GFromJSON(..)

78+ , FromArgs(..)

78 , GToJSON(..)

79 , GToJSON(..)

79 , GToEncoding(..)

80 , GToEncoding(..)

81+ , ToArgs(..)

80 , Zero

82 , Zero

81 , One

83 , One

82 , genericToJSON

84 , genericToJSON

Data/Aeson/Types.hs+2

@@ -62,8 +62,10 @@ module Data.Aeson.Types

63 -- ** Generic JSON classes

64 , GFromJSON(..)

65+ , FromArgs(..)

65 , GToJSON(..)

66 , GToJSON(..)

66 , GToEncoding(..)

67 , GToEncoding(..)

68+ , ToArgs(..)

67 , Zero

69 , Zero

68 , One

70 , One

69 , genericToJSON

71 , genericToJSON

Data/Aeson/Types/Class.hs+2

@@ -35,8 +35,10 @@ module Data.Aeson.Types.Class

35 , toEncoding2

36 -- * Generic JSON classes

37 , GFromJSON(..)

38+ , FromArgs(..)

38 , GToJSON(..)

39 , GToJSON(..)

39 , GToEncoding(..)

40 , GToEncoding(..)

41+ , ToArgs(..)

40 , Zero

42 , Zero

41 , One

43 , One

42 , genericToJSON

44 , genericToJSON

Data/Aeson/Types/FromJSON.hs+73−77

@@ -33,6 +33,7 @@ module Data.Aeson.Types.FromJSON (

33 , parseJSON2

34 -- * Generic JSON classes

35 , GFromJSON(..)

36+ , FromArgs(..)

36 , genericParseJSON

37 , genericParseJSON

37 , genericLiftParseJSON

38 , genericLiftParseJSON

38 -- * Classes and types for map keys

39 -- * Classes and types for map keys

@@ -207,16 +208,21 @@ class GFromJSON arity f where

207 -- | This method (applied to 'defaultOptions') is used as the

208 -- | This method (applied to 'defaultOptions') is used as the

208 -- default generic implementation of 'parseJSON' (if the @arity@ is 'Zero')

209 -- default generic implementation of 'parseJSON' (if the @arity@ is 'Zero')

209 -- or 'liftParseJSON' (if the @arity@ is 'One').

210 -- or 'liftParseJSON' (if the @arity@ is 'One').

210− gParseJSON :: Options -> Proxy arity

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

211− -> (Value -> Parser a) -> (Value -> Parser [a])

218+ From1Args :: (Value -> Parser a) -> (Value -> Parser [a]) -> FromArgs One a

212− -> Value -> Parser (f a)

213

219

214-- | A configurable generic JSON decoder. This function applied to

220-- | A configurable generic JSON decoder. This function applied to

215-- 'defaultOptions' is used as the default for 'parseJSON' when the

221-- 'defaultOptions' is used as the default for 'parseJSON' when the

216-- type is an instance of 'Generic'.

222-- type is an instance of 'Generic'.

217genericParseJSON :: (Generic a, GFromJSON Zero (Rep a))

223genericParseJSON :: (Generic a, GFromJSON Zero (Rep a))

218 => Options -> Value -> Parser a

224 => Options -> Value -> Parser a

219−genericParseJSON opts = fmap to . gParseJSON opts proxyZero undefined undefined

225+genericParseJSON opts = fmap to . gParseJSON opts NoFromArgs

220

226

221-- | A configurable generic JSON decoder. This function applied to

227-- | A configurable generic JSON decoder. This function applied to

222-- 'defaultOptions' is used as the default for 'liftParseJSON' when the

228-- 'defaultOptions' is used as the default for 'liftParseJSON' when the

@@ -224,7 +230,7 @@ genericParseJSON opts = fmap to . gParseJSON opts proxyZero undefined undefined

224genericLiftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))

230genericLiftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))

225 => Options -> (Value -> Parser a) -> (Value -> Parser [a])

231 => Options -> (Value -> Parser a) -> (Value -> Parser [a])

226 -> Value -> Parser (f a)

232 -> 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)

228

234

229-------------------------------------------------------------------------------

235-------------------------------------------------------------------------------

230-- Class

236-- Class

@@ -673,32 +679,32 @@ pmval .!= val = fromMaybe val <$> pmval

673instance OVERLAPPABLE_ (GFromJSON arity a) => GFromJSON arity (M1 i c a) where

679instance OVERLAPPABLE_ (GFromJSON arity a) => GFromJSON arity (M1 i c a) where

674 -- Meta-information, which is not handled elsewhere, is just added to the

680 -- Meta-information, which is not handled elsewhere, is just added to the

675 -- parsed value:

681 -- parsed value:

676− gParseJSON opts pa pj pjl = fmap M1 . gParseJSON opts pa pj pjl

682+ gParseJSON opts fargs = fmap M1 . gParseJSON opts fargs

677

683

678instance (FromJSON a) => GFromJSON arity (K1 i a) where

684instance (FromJSON a) => GFromJSON arity (K1 i a) where

679 -- Constant values are decoded using their FromJSON instance:

685 -- Constant values are decoded using their FromJSON instance:

680− gParseJSON _opts _ _ _ = fmap K1 . parseJSON

686+ gParseJSON _opts _ = fmap K1 . parseJSON

681

687

682instance GFromJSON One Par1 where

688instance GFromJSON One Par1 where

683 -- Direct occurrences of the last type parameter are decoded with the

689 -- Direct occurrences of the last type parameter are decoded with the

684 -- function passed in as an argument:

690 -- function passed in as an argument:

685− gParseJSON _opts _ pj _ = fmap Par1 . pj

691+ gParseJSON _opts (From1Args pj _) = fmap Par1 . pj

686

692

687instance (FromJSON1 f) => GFromJSON One (Rec1 f) where

693instance (FromJSON1 f) => GFromJSON One (Rec1 f) where

688 -- Recursive occurrences of the last type parameter are decoded using their

694 -- Recursive occurrences of the last type parameter are decoded using their

689 -- FromJSON1 instance:

695 -- FromJSON1 instance:

690− gParseJSON _opts _ pj pjl = fmap Rec1 . liftParseJSON pj pjl

696+ gParseJSON _opts (From1Args pj pjl) = fmap Rec1 . liftParseJSON pj pjl

691

697

692instance GFromJSON arity U1 where

698instance GFromJSON arity U1 where

693 -- Empty constructors are expected to be encoded as an empty array:

699 -- Empty constructors are expected to be encoded as an empty array:

694− gParseJSON _opts _ _ _ v

700+ gParseJSON _opts _ v

695 | isEmptyArray v = pure U1

701 | isEmptyArray v = pure U1

696 | otherwise = typeMismatch "unit constructor (U1)" v

702 | otherwise = typeMismatch "unit constructor (U1)" v

697

703

698instance (ConsFromJSON arity a) => GFromJSON arity (C1 c a) where

704instance (ConsFromJSON arity a) => GFromJSON arity (C1 c a) where

699 -- Constructors need to be decoded differently depending on whether they're

705 -- Constructors need to be decoded differently depending on whether they're

700 -- a record or not. This distinction is made by consParseJSON:

706 -- 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

702

708

703instance ( FromProduct arity a, FromProduct arity b

709instance ( FromProduct arity a, FromProduct arity b

704 , ProductSize a, ProductSize b

710 , ProductSize a, ProductSize b

@@ -706,12 +712,12 @@ instance ( FromProduct arity a, FromProduct arity b

706 -- Products are expected to be encoded to an array. Here we check whether we

712 -- Products are expected to be encoded to an array. Here we check whether we

707 -- got an array of the same size as the product, then parse each of the

713 -- got an array of the same size as the product, then parse each of the

708 -- product's elements using parseProduct:

714 -- product's elements using parseProduct:

709− gParseJSON opts pa pj pjl = withArray "product (:*:)" $ \arr ->

715+ gParseJSON opts fargs = withArray "product (:*:)" $ \arr ->

710 let lenArray = V.length arr

716 let lenArray = V.length arr

711 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)

717 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)

712 productSize in

718 productSize in

713 if lenArray == lenProduct

719 if lenArray == lenProduct

714− then parseProduct opts pa arr 0 lenProduct pj pjl

720+ then parseProduct opts fargs arr 0 lenProduct

715 else fail $ "When expecting a product of " ++ show lenProduct ++

721 else fail $ "When expecting a product of " ++ show lenProduct ++

716 " values, encountered an Array of " ++ show lenArray ++

722 " values, encountered an Array of " ++ show lenArray ++

717 " elements instead"

723 " elements instead"

@@ -722,38 +728,37 @@ instance ( AllNullary (a :+: b) allNullary

722 -- If all constructors of a sum datatype are nullary and the

728 -- If all constructors of a sum datatype are nullary and the

723 -- 'allNullaryToStringTag' option is set they are expected to be

729 -- 'allNullaryToStringTag' option is set they are expected to be

724 -- encoded as strings. This distinction is made by 'parseSum':

730 -- encoded as strings. This distinction is made by 'parseSum':

725− gParseJSON opts pa pj pjl =

731+ gParseJSON opts fargs =

726 (unTagged :: Tagged allNullary (Parser ((a :+: b) d)) ->

732 (unTagged :: Tagged allNullary (Parser ((a :+: b) d)) ->

727 Parser ((a :+: b) d))

733 Parser ((a :+: b) d))

728− . parseSum opts pa pj pjl

734+ . parseSum opts fargs

729

735

730instance (FromJSON1 f, GFromJSON One g) => GFromJSON One (f :.: g) where

736instance (FromJSON1 f, GFromJSON One g) => GFromJSON One (f :.: g) where

731 -- If an occurrence of the last type parameter is nested inside two

737 -- If an occurrence of the last type parameter is nested inside two

732 -- composed types, it is decoded by using the outermost type's FromJSON1

738 -- composed types, it is decoded by using the outermost type's FromJSON1

733 -- instance to generically decode the innermost type:

739 -- instance to generically decode the innermost type:

734− gParseJSON opts pa pj pjl =

740+ gParseJSON opts fargs =

735− let gpj = gParseJSON opts pa pj pjl in

741+ let gpj = gParseJSON opts fargs in

736 fmap Comp1 . liftParseJSON gpj (listParser gpj)

742 fmap Comp1 . liftParseJSON gpj (listParser gpj)

737

743

738--------------------------------------------------------------------------------

744--------------------------------------------------------------------------------

739

745

740class ParseSum arity f allNullary where

746class ParseSum arity f allNullary where

741− parseSum :: Options -> Proxy arity

747+ parseSum :: Options -> FromArgs arity a

742− -> (Value -> Parser a) -> (Value -> Parser [a])

743 -> Value -> Tagged allNullary (Parser (f a))

748 -> Value -> Tagged allNullary (Parser (f a))

744

749

745instance ( SumFromString (a :+: b)

750instance ( SumFromString (a :+: b)

746 , FromPair arity (a :+: b)

751 , FromPair arity (a :+: b)

747 , FromTaggedObject arity (a :+: b)

752 , FromTaggedObject arity (a :+: b)

748 ) => ParseSum arity (a :+: b) True where

753 ) => ParseSum arity (a :+: b) True where

749− parseSum opts pa pj pjl

754+ parseSum opts fargs

750 | allNullaryToStringTag opts = Tagged . parseAllNullarySum opts

755 | allNullaryToStringTag opts = Tagged . parseAllNullarySum opts

751− | otherwise = Tagged . parseNonAllNullarySum opts pa pj pjl

756+ | otherwise = Tagged . parseNonAllNullarySum opts fargs

752

757

753instance ( FromPair arity (a :+: b)

758instance ( FromPair arity (a :+: b)

754 , FromTaggedObject arity (a :+: b)

759 , FromTaggedObject arity (a :+: b)

755 ) => ParseSum arity (a :+: b) False where

760 ) => 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

757

762

758--------------------------------------------------------------------------------

763--------------------------------------------------------------------------------

759

764

@@ -780,22 +785,21 @@ instance (Constructor c) => SumFromString (C1 c U1) where

780

785

781parseNonAllNullarySum :: ( FromPair arity (a :+: b)

786parseNonAllNullarySum :: ( FromPair arity (a :+: b)

782 , FromTaggedObject arity (a :+: b)

787 , FromTaggedObject arity (a :+: b)

783− ) => Options -> Proxy arity

788+ ) => Options -> FromArgs arity c

784− -> (Value -> Parser c) -> (Value -> Parser [c])

785 -> Value -> Parser ((a :+: b) c)

789 -> Value -> Parser ((a :+: b) c)

786−parseNonAllNullarySum opts pa pj pjl =

790+parseNonAllNullarySum opts fargs =

787 case sumEncoding opts of

791 case sumEncoding opts of

788 TaggedObject{..} ->

792 TaggedObject{..} ->

789 withObject "Object" $ \obj -> do

793 withObject "Object" $ \obj -> do

790 tag <- obj .: pack tagFieldName

794 tag <- obj .: pack tagFieldName

791 fromMaybe (notFound tag) $

795 fromMaybe (notFound tag) $

792− parseFromTaggedObject opts pa contentsFieldName obj pj pjl tag

796+ parseFromTaggedObject opts fargs contentsFieldName obj tag

793

797

794 ObjectWithSingleField ->

798 ObjectWithSingleField ->

795 withObject "Object" $ \obj ->

799 withObject "Object" $ \obj ->

796 case H.toList obj of

800 case H.toList obj of

797 [pair@(tag, _)] -> fromMaybe (notFound tag) $

801 [pair@(tag, _)] -> fromMaybe (notFound tag) $

798− parsePair opts pa pj pjl pair

802+ parsePair opts fargs pair

799 _ -> fail "Object doesn't have a single field"

803 _ -> fail "Object doesn't have a single field"

800

804

801 TwoElemArray ->

805 TwoElemArray ->

@@ -803,30 +807,29 @@ parseNonAllNullarySum opts pa pj pjl =

803 if V.length arr == 2

807 if V.length arr == 2

804 then case V.unsafeIndex arr 0 of

808 then case V.unsafeIndex arr 0 of

805 String tag -> fromMaybe (notFound tag) $

809 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)

807 _ -> fail "First element is not a String"

811 _ -> fail "First element is not a String"

808 else fail "Array doesn't have 2 elements"

812 else fail "Array doesn't have 2 elements"

809

813

810--------------------------------------------------------------------------------

814--------------------------------------------------------------------------------

811

815

812class FromTaggedObject arity f where

816class FromTaggedObject arity f where

813− parseFromTaggedObject :: Options -> Proxy arity

817+ parseFromTaggedObject :: Options -> FromArgs arity a

814 -> String -> Object

818 -> String -> Object

815− -> (Value -> Parser a) -> (Value -> Parser [a])

816 -> Text -> Maybe (Parser (f a))

819 -> Text -> Maybe (Parser (f a))

817

820

818instance ( FromTaggedObject arity a, FromTaggedObject arity b) =>

821instance ( FromTaggedObject arity a, FromTaggedObject arity b) =>

819 FromTaggedObject arity (a :+: b) where

822 FromTaggedObject arity (a :+: b) where

820− parseFromTaggedObject opts pa contentsFieldName obj pj pjl tag =

823+ parseFromTaggedObject opts fargs contentsFieldName obj tag =

821− (fmap L1 <$> parseFromTaggedObject opts pa contentsFieldName obj pj pjl tag) <|>

824+ (fmap L1 <$> parseFromTaggedObject opts fargs contentsFieldName obj tag) <|>

822− (fmap R1 <$> parseFromTaggedObject opts pa contentsFieldName obj pj pjl tag)

825+ (fmap R1 <$> parseFromTaggedObject opts fargs contentsFieldName obj tag)

823

826

824instance ( FromTaggedObject' arity f

827instance ( FromTaggedObject' arity f

825 , Constructor c

828 , Constructor c

826 ) => FromTaggedObject arity (C1 c f) where

829 ) => FromTaggedObject arity (C1 c f) where

827− parseFromTaggedObject opts pa contentsFieldName obj pj pjl tag

830+ parseFromTaggedObject opts fargs contentsFieldName obj tag

828 | tag == name = Just $ M1 <$> parseFromTaggedObject'

831 | tag == name = Just $ M1 <$> parseFromTaggedObject'

829− opts pa contentsFieldName pj pjl obj

832+ opts fargs contentsFieldName obj

830 | otherwise = Nothing

833 | otherwise = Nothing

831 where

834 where

832 name = pack $ constructorTagModifier opts $

835 name = pack $ constructorTagModifier opts $

@@ -835,87 +838,82 @@ instance ( FromTaggedObject' arity f

835--------------------------------------------------------------------------------

838--------------------------------------------------------------------------------

836

839

837class FromTaggedObject' arity f where

840class FromTaggedObject' arity f where

838− parseFromTaggedObject' :: Options -> Proxy arity -> String

841+ parseFromTaggedObject' :: Options -> FromArgs arity a -> String

839− -> (Value -> Parser a) -> (Value -> Parser [a])

840 -> Object -> Parser (f a)

842 -> Object -> Parser (f a)

841

843

842class FromTaggedObject'' arity f isRecord where

844class FromTaggedObject'' arity f isRecord where

843− parseFromTaggedObject'' :: Options -> Proxy arity -> String

845+ parseFromTaggedObject'' :: Options -> FromArgs arity a -> String

844− -> (Value -> Parser a) -> (Value -> Parser [a])

845 -> Object -> Tagged isRecord (Parser (f a))

846 -> Object -> Tagged isRecord (Parser (f a))

846

847

847instance ( IsRecord f isRecord

848instance ( IsRecord f isRecord

848 , FromTaggedObject'' arity f isRecord

849 , FromTaggedObject'' arity f isRecord

849 ) => FromTaggedObject' arity f where

850 ) => FromTaggedObject' arity f where

850− parseFromTaggedObject' opts pa contentsFieldName pj pjl =

851+ parseFromTaggedObject' opts fargs contentsFieldName =

851 (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .

852 (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .

852− parseFromTaggedObject'' opts pa contentsFieldName pj pjl

853+ parseFromTaggedObject'' opts fargs contentsFieldName

853

854

854instance (FromRecord arity f) => FromTaggedObject'' arity f True where

855instance (FromRecord arity f) => FromTaggedObject'' arity f True where

855− parseFromTaggedObject'' opts pa _ pj pjl =

856+ parseFromTaggedObject'' opts fargs _ =

856− Tagged . parseRecord opts pa Nothing pj pjl

857+ Tagged . parseRecord opts fargs Nothing

857

858

858instance (GFromJSON arity f) => FromTaggedObject'' arity f False where

859instance (GFromJSON arity f) => FromTaggedObject'' arity f False where

859− parseFromTaggedObject'' opts pa contentsFieldName pj pjl = Tagged .

860+ parseFromTaggedObject'' opts fargs contentsFieldName = Tagged .

860− (gParseJSON opts pa pj pjl <=< (.: pack contentsFieldName))

861+ (gParseJSON opts fargs <=< (.: pack contentsFieldName))

861

862

862instance OVERLAPPING_ FromTaggedObject'' arity U1 False where

863instance OVERLAPPING_ FromTaggedObject'' arity U1 False where

863− parseFromTaggedObject'' _ _ _ _ _ _ = Tagged (pure U1)

864+ parseFromTaggedObject'' _ _ _ _ = Tagged (pure U1)

864

865

865--------------------------------------------------------------------------------

866--------------------------------------------------------------------------------

866

867

867class ConsFromJSON arity f where

868class ConsFromJSON arity f where

868− consParseJSON :: Options -> Proxy arity

869+ consParseJSON :: Options -> FromArgs arity a

869− -> (Value -> Parser a) -> (Value -> Parser [a])

870 -> Value -> Parser (f a)

871

872class ConsFromJSON' arity f isRecord where

873− consParseJSON' :: Options -> Proxy arity

873+ consParseJSON' :: Options -> FromArgs arity a

874 -> Maybe Text -- ^ A dummy label

875 -- (Nothing to use proper label)

876− -> (Value -> Parser a) -> (Value -> Parser [a])

877 -> Value -> Tagged isRecord (Parser (f a))

876 -> Value -> Tagged isRecord (Parser (f a))

878

877

879instance ( IsRecord f isRecord

878instance ( IsRecord f isRecord

880 , ConsFromJSON' arity f isRecord

879 , ConsFromJSON' arity f isRecord

881 ) => ConsFromJSON arity f where

880 ) => ConsFromJSON arity f where

882− consParseJSON opts pa pj pjl v = let

881+ consParseJSON opts fargs v = let

883 (v2,lab) = case (unwrapUnaryRecords opts,isUnary (undefined :: f a)) of

882 (v2,lab) = case (unwrapUnaryRecords opts,isUnary (undefined :: f a)) of

884 -- use a dummy object with a dummy label

883 -- use a dummy object with a dummy label

885 (True,True) -> (object [(pack "dummy",v)], Just $ pack "dummy")

884 (True,True) -> (object [(pack "dummy",v)], Just $ pack "dummy")

886 _ ->(v,Nothing)

885 _ ->(v,Nothing)

887 in (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))

886 in (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))

888− $ consParseJSON' opts pa lab pj pjl v2

887+ $ consParseJSON' opts fargs lab v2

889

888

890

889

891instance (FromRecord arity f) => ConsFromJSON' arity f True where

890instance (FromRecord arity f) => ConsFromJSON' arity f True where

892− consParseJSON' opts pa mlab pj pjl = Tagged . withObject "record (:*:)"

891+ consParseJSON' opts fargs mlab = Tagged . withObject "record (:*:)"

893− (parseRecord opts pa mlab pj pjl)

892+ (parseRecord opts fargs mlab)

894

893

895instance (GFromJSON arity f) => ConsFromJSON' arity f False where

894instance (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

897

896

898--------------------------------------------------------------------------------

897--------------------------------------------------------------------------------

899

898

900class FromRecord arity f where

899class FromRecord arity f where

901− parseRecord :: Options -> Proxy arity

900+ parseRecord :: Options -> FromArgs arity a

902 -> Maybe Text -- ^ A dummy label

901 -> Maybe Text -- ^ A dummy label

903 -- (Nothing to use proper label)

902 -- (Nothing to use proper label)

904− -> (Value -> Parser a) -> (Value -> Parser [a])

905 -> Object -> Parser (f a)

903 -> Object -> Parser (f a)

906

904

907instance ( FromRecord arity a

905instance ( FromRecord arity a

908 , FromRecord arity b

906 , FromRecord arity b

909 ) => FromRecord arity (a :*: b) where

907 ) => FromRecord arity (a :*: b) where

910− parseRecord opts pa _ pj pjl obj =

908+ parseRecord opts fargs _ obj =

911− (:*:) <$> parseRecord opts pa Nothing pj pjl obj

909+ (:*:) <$> parseRecord opts fargs Nothing obj

912− <*> parseRecord opts pa Nothing pj pjl obj

910+ <*> parseRecord opts fargs Nothing obj

913

911

914instance ( Selector s

912instance ( Selector s

915 , GFromJSON arity a

913 , GFromJSON arity a

916 ) => FromRecord arity (S1 s a) where

914 ) => FromRecord arity (S1 s a) where

917− parseRecord opts pa lab pj pjl =

915+ parseRecord opts fargs lab =

918− (<?> Key label) . gParseJSON opts pa pj pjl <=< (.: label)

916+ (<?> Key label) . gParseJSON opts fargs <=< (.: label)

919 where

917 where

920 label = fromMaybe defLabel lab

918 label = fromMaybe defLabel lab

921 defLabel = pack . fieldLabelModifier opts $

919 defLabel = pack . fieldLabelModifier opts $

@@ -923,8 +921,8 @@ instance ( Selector s

923

921

924instance OVERLAPPING_ (Selector s, FromJSON a) =>

922instance OVERLAPPING_ (Selector s, FromJSON a) =>

925 FromRecord arity (S1 s (K1 i (Maybe a))) where

923 FromRecord arity (S1 s (K1 i (Maybe a))) where

926− parseRecord _ _ (Just lab) _ _ obj = (M1 . K1) <$> obj .:? lab

924+ parseRecord _ _ (Just lab) obj = (M1 . K1) <$> obj .:? lab

927− parseRecord opts _ Nothing _ _ obj = (M1 . K1) <$> obj .:? pack label

925+ parseRecord opts _ Nothing obj = (M1 . K1) <$> obj .:? pack label

928 where

926 where

929 label = fieldLabelModifier opts $

927 label = fieldLabelModifier opts $

930 selName (undefined :: t s (K1 i (Maybe a)) p)

928 selName (undefined :: t s (K1 i (Maybe a)) p)

@@ -932,45 +930,43 @@ instance OVERLAPPING_ (Selector s, FromJSON a) =>

932--------------------------------------------------------------------------------

930--------------------------------------------------------------------------------

933

931

934class FromProduct arity f where

932class FromProduct arity f where

935− parseProduct :: Options -> Proxy arity

933+ parseProduct :: Options -> FromArgs arity a

936 -> Array -> Int -> Int

934 -> Array -> Int -> Int

937− -> (Value -> Parser a) -> (Value -> Parser [a])

938 -> Parser (f a)

935 -> Parser (f a)

939

936

940instance ( FromProduct arity a

937instance ( FromProduct arity a

941 , FromProduct arity b

938 , FromProduct arity b

942 ) => FromProduct arity (a :*: b) where

939 ) => FromProduct arity (a :*: b) where

943− parseProduct opts pa arr ix len pj pjl =

940+ parseProduct opts fargs arr ix len =

944− (:*:) <$> parseProduct opts pa arr ix lenL pj pjl

941+ (:*:) <$> parseProduct opts fargs arr ix lenL

945− <*> parseProduct opts pa arr ixR lenR pj pjl

942+ <*> parseProduct opts fargs arr ixR lenR

946 where

943 where

947 lenL = len `unsafeShiftR` 1

944 lenL = len `unsafeShiftR` 1

948 ixR = ix + lenL

945 ixR = ix + lenL

949 lenR = len - lenL

946 lenR = len - lenL

950

947

951instance (GFromJSON arity a) => FromProduct arity (S1 s a) where

948instance (GFromJSON arity a) => FromProduct arity (S1 s a) where

952− parseProduct opts pa arr ix _ pj pjl =

949+ parseProduct opts fargs arr ix _ =

953− gParseJSON opts pa pj pjl $ V.unsafeIndex arr ix

950+ gParseJSON opts fargs $ V.unsafeIndex arr ix

954

951

955--------------------------------------------------------------------------------

952--------------------------------------------------------------------------------

956

953

957class FromPair arity f where

954class FromPair arity f where

958− parsePair :: Options -> Proxy arity

955+ parsePair :: Options -> FromArgs arity a

959− -> (Value -> Parser a) -> (Value -> Parser [a])

960 -> Pair -> Maybe (Parser (f a))

956 -> Pair -> Maybe (Parser (f a))

961

957

962instance ( FromPair arity a

958instance ( FromPair arity a

963 , FromPair arity b

959 , FromPair arity b

964 ) => FromPair arity (a :+: b) where

960 ) => FromPair arity (a :+: b) where

965− parsePair opts pa pj pjl pair = (fmap L1 <$> parsePair opts pa pj pjl pair) <|>

961+ parsePair opts fargs pair = (fmap L1 <$> parsePair opts fargs pair) <|>

966− (fmap R1 <$> parsePair opts pa pj pjl pair)

962+ (fmap R1 <$> parsePair opts fargs pair)

967

963

968instance ( Constructor c

964instance ( Constructor c

969 , GFromJSON arity a

965 , GFromJSON arity a

970 , ConsFromJSON arity a

966 , ConsFromJSON arity a

971 ) => FromPair arity (C1 c a) where

967 ) => FromPair arity (C1 c a) where

972− parsePair opts pa pj pjl (tag, value)

968+ parsePair opts fargs (tag, value)

973− | tag == tag' = Just $ gParseJSON opts pa pj pjl value

969+ | tag == tag' = Just $ gParseJSON opts fargs value

974 | otherwise = Nothing

970 | otherwise = Nothing

975 where

971 where

976 tag' = pack $ constructorTagModifier opts $

972 tag' = pack $ constructorTagModifier opts $

Data/Aeson/Types/Generic.hs−7

@@ -29,7 +29,6 @@ import Prelude ()

29import Prelude.Compat

31import GHC.Generics

32−import Data.Proxy (Proxy (..))

34--------------------------------------------------------------------------------

33--------------------------------------------------------------------------------

@@ -89,12 +88,6 @@ data Zero

89-- | A type-level indicator that 'ToJSON1' or 'FromJSON1' is being derived generically.

88-- | A type-level indicator that 'ToJSON1' or 'FromJSON1' is being derived generically.

90data One

89data One

92−proxyZero :: Proxy Zero

93−proxyZero = Proxy

94−

95−proxyOne :: Proxy One

96−proxyOne = Proxy

97−

98--------------------------------------------------------------------------------

91--------------------------------------------------------------------------------

100class ProductSize f where

93class ProductSize f where

Data/Aeson/Types/ToJSON.hs+155−172

@@ -36,6 +36,7 @@ module Data.Aeson.Types.ToJSON (

36 -- * Generic JSON classes

37 , GToJSON(..)

38 , GToEncoding(..)

39+ , ToArgs(..)

39 , genericToJSON

40 , genericToJSON

40 , genericToEncoding

41 , genericToEncoding

41 , genericLiftToJSON

42 , genericLiftToJSON

@@ -138,8 +139,7 @@ class GToJSON arity f where

138 -- | This method (applied to 'defaultOptions') is used as the

139 -- | This method (applied to 'defaultOptions') is used as the

139 -- default generic implementation of 'toJSON' (if the @arity@ is 'Zero')

140 -- default generic implementation of 'toJSON' (if the @arity@ is 'Zero')

140 -- or 'liftToJSON' (if the @arity@ is 'One').

141 -- or 'liftToJSON' (if the @arity@ is 'One').

141− gToJSON :: Options -> Proxy arity

142+ gToJSON :: Options -> ToArgs Value arity a -> f a -> Value

142− -> (a -> Value) -> ([a] -> Value) -> f a -> Value

143

144-- | Class of generic representation types that can be converted to

145-- a JSON 'Encoding'.

@@ -147,15 +147,21 @@ class GToEncoding arity f where

147 -- | This method (applied to 'defaultOptions') can be used as the

148 -- default generic implementation of 'toEncoding' (if the @arity@ is 'Zero')

149 -- or 'liftToEncoding' (if the @arity@ is 'One').

150− gToEncoding :: Options -> Proxy arity

150+ gToEncoding :: Options -> ToArgs Encoding arity a -> f a -> Encoding

151− -> (a -> Encoding) -> ([a] -> Encoding) -> 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

152

158

153-- | A configurable generic JSON creator. This function applied to

159-- | A configurable generic JSON creator. This function applied to

154-- 'defaultOptions' is used as the default for 'toJSON' when the type

160-- 'defaultOptions' is used as the default for 'toJSON' when the type

155-- is an instance of 'Generic'.

161-- is an instance of 'Generic'.

156genericToJSON :: (Generic a, GToJSON Zero (Rep a))

162genericToJSON :: (Generic a, GToJSON Zero (Rep a))

157 => Options -> a -> Value

163 => Options -> a -> Value

158−genericToJSON opts = gToJSON opts proxyZero undefined undefined . from

164+genericToJSON opts = gToJSON opts NoToArgs . from

159

165

160-- | A configurable generic JSON creator. This function applied to

166-- | A configurable generic JSON creator. This function applied to

161-- 'defaultOptions' is used as the default for 'liftToJSON' when the type

167-- 'defaultOptions' is used as the default for 'liftToJSON' when the type

@@ -163,14 +169,14 @@ genericToJSON opts = gToJSON opts proxyZero undefined undefined . from

163genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))

169genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))

164 => Options -> (a -> Value) -> ([a] -> Value)

170 => Options -> (a -> Value) -> ([a] -> Value)

165 -> f a -> Value

171 -> 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

167

173

168-- | A configurable generic JSON encoder. This function applied to

174-- | A configurable generic JSON encoder. This function applied to

169-- 'defaultOptions' is used as the default for 'toEncoding' when the type

175-- 'defaultOptions' is used as the default for 'toEncoding' when the type

170-- is an instance of 'Generic'.

176-- is an instance of 'Generic'.

171genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))

177genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))

172 => Options -> a -> Encoding

178 => Options -> a -> Encoding

173−genericToEncoding opts = gToEncoding opts proxyZero undefined undefined . from

179+genericToEncoding opts = gToEncoding opts NoToArgs . from

174

180

175-- | A configurable generic JSON encoder. This function applied to

181-- | A configurable generic JSON encoder. This function applied to

176-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type

182-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type

@@ -178,7 +184,7 @@ genericToEncoding opts = gToEncoding opts proxyZero undefined undefined . from

178genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))

184genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))

179 => Options -> (a -> Encoding) -> ([a] -> Encoding)

185 => Options -> (a -> Encoding) -> ([a] -> Encoding)

180 -> f a -> Encoding

186 -> 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

182

188

183-------------------------------------------------------------------------------

189-------------------------------------------------------------------------------

184-- Class

190-- Class

@@ -595,30 +601,30 @@ instance (ToJSON a) => ToJSON [a] where

595

601

596instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where

602instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where

597 -- Meta-information, which is not handled elsewhere, is ignored:

603 -- 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

599

605

600instance (ToJSON a) => GToJSON arity (K1 i a) where

606instance (ToJSON a) => GToJSON arity (K1 i a) where

601 -- Constant values are encoded using their ToJSON instance:

607 -- Constant values are encoded using their ToJSON instance:

602− gToJSON _opts _ _ _ = toJSON . unK1

608+ gToJSON _opts _ = toJSON . unK1

603

609

604instance GToJSON One Par1 where

610instance GToJSON One Par1 where

605 -- Direct occurrences of the last type parameter are encoded with the

611 -- Direct occurrences of the last type parameter are encoded with the

606 -- function passed in as an argument:

612 -- function passed in as an argument:

607− gToJSON _opts _ tj _ = tj . unPar1

613+ gToJSON _opts (To1Args tj _) = tj . unPar1

608

614

609instance (ToJSON1 f) => GToJSON One (Rec1 f) where

615instance (ToJSON1 f) => GToJSON One (Rec1 f) where

610 -- Recursive occurrences of the last type parameter are encoded using their

616 -- Recursive occurrences of the last type parameter are encoded using their

611 -- ToJSON1 instance:

617 -- ToJSON1 instance:

612− gToJSON _opts _ tj tjl = liftToJSON tj tjl . unRec1

618+ gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1

613

619

614instance GToJSON arity U1 where

620instance GToJSON arity U1 where

615 -- Empty constructors are encoded to an empty array:

621 -- Empty constructors are encoded to an empty array:

616− gToJSON _opts _ _ _ _ = emptyArray

622+ gToJSON _opts _ _ = emptyArray

617

623

618instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where

624instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where

619 -- Constructors need to be encoded differently depending on whether they're

625 -- Constructors need to be encoded differently depending on whether they're

620 -- a record or not. This distinction is made by 'consToJSON':

626 -- 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

622

628

623instance ( WriteProduct arity a, WriteProduct arity b

629instance ( WriteProduct arity a, WriteProduct arity b

624 , ProductSize a, ProductSize b

630 , ProductSize a, ProductSize b

@@ -626,10 +632,10 @@ instance ( WriteProduct arity a, WriteProduct arity b

626 -- Products are encoded to an array. Here we allocate a mutable vector of

632 -- Products are encoded to an array. Here we allocate a mutable vector of

627 -- the same size as the product and write the product's elements to it using

633 -- the same size as the product and write the product's elements to it using

628 -- 'writeProduct':

634 -- 'writeProduct':

629− gToJSON opts pa tj tjl p =

635+ gToJSON opts targs p =

630 Array $ V.create $ do

636 Array $ V.create $ do

631 mv <- VM.unsafeNew lenProduct

637 mv <- VM.unsafeNew lenProduct

632− writeProduct opts pa mv 0 lenProduct tj tjl p

638+ writeProduct opts targs mv 0 lenProduct p

633 return mv

639 return mv

634 where

640 where

635 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)

641 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)

@@ -641,15 +647,15 @@ instance ( AllNullary (a :+: b) allNullary

641 -- If all constructors of a sum datatype are nullary and the

647 -- If all constructors of a sum datatype are nullary and the

642 -- 'allNullaryToStringTag' option is set they are encoded to

648 -- 'allNullaryToStringTag' option is set they are encoded to

643 -- strings. This distinction is made by 'sumToJSON':

649 -- strings. This distinction is made by 'sumToJSON':

644− gToJSON opts pa tj tjl = (unTagged :: Tagged allNullary Value -> Value)

650+ gToJSON opts targs = (unTagged :: Tagged allNullary Value -> Value)

645− . sumToJSON opts pa tj tjl

651+ . sumToJSON opts targs

646

652

647instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where

653instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where

648 -- If an occurrence of the last type parameter is nested inside two

654 -- If an occurrence of the last type parameter is nested inside two

649 -- composed types, it is encoded by using the outermost type's ToJSON1

655 -- composed types, it is encoded by using the outermost type's ToJSON1

650 -- instance to generically encode the innermost type:

656 -- instance to generically encode the innermost type:

651− gToJSON opts pa tj tjl =

657+ gToJSON opts targs =

652− let gtj = gToJSON opts pa tj tjl in

658+ let gtj = gToJSON opts targs in

653 liftToJSON gtj (listValue gtj) . unComp1

659 liftToJSON gtj (listValue gtj) . unComp1

654

660

655--------------------------------------------------------------------------------

661--------------------------------------------------------------------------------

@@ -657,30 +663,30 @@ instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where

657

663

658instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where

664instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where

659 -- Meta-information, which is not handled elsewhere, is ignored:

665 -- 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

661

667

662instance (ToJSON a) => GToEncoding arity (K1 i a) where

668instance (ToJSON a) => GToEncoding arity (K1 i a) where

663 -- Constant values are encoded using their ToJSON instance:

669 -- Constant values are encoded using their ToJSON instance:

664− gToEncoding _opts _ _ _ = toEncoding . unK1

670+ gToEncoding _opts _ = toEncoding . unK1

665

671

666instance GToEncoding One Par1 where

672instance GToEncoding One Par1 where

667 -- Direct occurrences of the last type parameter are encoded with the

673 -- Direct occurrences of the last type parameter are encoded with the

668 -- function passed in as an argument:

674 -- function passed in as an argument:

669− gToEncoding _opts _ te _ = te . unPar1

675+ gToEncoding _opts (To1Args te _) = te . unPar1

670

676

671instance (ToJSON1 f) => GToEncoding One (Rec1 f) where

677instance (ToJSON1 f) => GToEncoding One (Rec1 f) where

672 -- Recursive occurrences of the last type parameter are encoded using their

678 -- Recursive occurrences of the last type parameter are encoded using their

673 -- ToEncoding1 instance:

679 -- ToEncoding1 instance:

674− gToEncoding _opts _ te tel = liftToEncoding te tel . unRec1

680+ gToEncoding _opts (To1Args te tel) = liftToEncoding te tel . unRec1

675

681

676instance GToEncoding arity U1 where

682instance GToEncoding arity U1 where

677 -- Empty constructors are encoded to an empty array:

683 -- Empty constructors are encoded to an empty array:

678− gToEncoding _opts _ _ _ _ = E.emptyArray_

684+ gToEncoding _opts _ _ = E.emptyArray_

679

685

680instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where

686instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where

681 -- Constructors need to be encoded differently depending on whether they're

687 -- Constructors need to be encoded differently depending on whether they're

682 -- a record or not. This distinction is made by 'consToEncoding':

688 -- 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

684

690

685instance ( EncodeProduct arity a

691instance ( EncodeProduct arity a

686 , EncodeProduct arity b

692 , EncodeProduct arity b

@@ -688,7 +694,7 @@ instance ( EncodeProduct arity a

688 -- Products are encoded to an array. Here we allocate a mutable vector of

694 -- Products are encoded to an array. Here we allocate a mutable vector of

689 -- the same size as the product and write the product's elements to it using

695 -- the same size as the product and write the product's elements to it using

690 -- 'encodeProduct':

696 -- '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

692

698

693instance ( AllNullary (a :+: b) allNullary

699instance ( AllNullary (a :+: b) allNullary

694 , SumToEncoding arity (a :+: b) allNullary

700 , SumToEncoding arity (a :+: b) allNullary

@@ -696,23 +702,22 @@ instance ( AllNullary (a :+: b) allNullary

696 -- If all constructors of a sum datatype are nullary and the

702 -- If all constructors of a sum datatype are nullary and the

697 -- 'allNullaryToStringTag' option is set they are encoded to

703 -- 'allNullaryToStringTag' option is set they are encoded to

698 -- strings. This distinction is made by 'sumToEncoding':

704 -- strings. This distinction is made by 'sumToEncoding':

699− gToEncoding opts pa te tel

705+ gToEncoding opts targs

700 = (unTagged :: Tagged allNullary Encoding -> Encoding)

706 = (unTagged :: Tagged allNullary Encoding -> Encoding)

701− . sumToEncoding opts pa te tel

707+ . sumToEncoding opts targs

702

708

703instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where

709instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where

704 -- If an occurrence of the last type parameter is nested inside two

710 -- If an occurrence of the last type parameter is nested inside two

705 -- composed types, it is encoded by using the outermost type's ToJSON1

711 -- composed types, it is encoded by using the outermost type's ToJSON1

706 -- instance to generically encode the innermost type:

712 -- instance to generically encode the innermost type:

707− gToEncoding opts pa te tel =

713+ gToEncoding opts targs =

708− let gte = gToEncoding opts pa te tel in

714+ let gte = gToEncoding opts targs in

709 liftToEncoding gte (listEncoding gte) . unComp1

715 liftToEncoding gte (listEncoding gte) . unComp1

710

716

711--------------------------------------------------------------------------------

717--------------------------------------------------------------------------------

712

718

713class SumToJSON arity f allNullary where

719class SumToJSON arity f allNullary where

714− sumToJSON :: Options -> Proxy arity

720+ sumToJSON :: Options -> ToArgs Value arity a

715− -> (a -> Value) -> ([a] -> Value)

716 -> f a -> Tagged allNullary Value

721 -> f a -> Tagged allNullary Value

717

722

718instance ( GetConName f

723instance ( GetConName f

@@ -720,35 +725,33 @@ instance ( GetConName f

720 , ObjectWithSingleFieldObj arity f

725 , ObjectWithSingleFieldObj arity f

721 , TwoElemArrayObj arity f

726 , TwoElemArrayObj arity f

722 ) => SumToJSON arity f True where

727 ) => SumToJSON arity f True where

723− sumToJSON opts pa tj tjl

728+ sumToJSON opts targs

724 | allNullaryToStringTag opts = Tagged . String . pack

729 | allNullaryToStringTag opts = Tagged . String . pack

725 . constructorTagModifier opts . getConName

730 . constructorTagModifier opts . getConName

726− | otherwise = Tagged . nonAllNullarySumToJSON opts pa tj tjl

731+ | otherwise = Tagged . nonAllNullarySumToJSON opts targs

727

732

728instance ( TwoElemArrayObj arity f

733instance ( TwoElemArrayObj arity f

729 , TaggedObjectPairs arity f

734 , TaggedObjectPairs arity f

730 , ObjectWithSingleFieldObj arity f

735 , ObjectWithSingleFieldObj arity f

731 ) => SumToJSON arity f False where

736 ) => 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

733

738

734nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f

739nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f

735 , TaggedObjectPairs arity f

740 , TaggedObjectPairs arity f

736 , ObjectWithSingleFieldObj arity f

741 , ObjectWithSingleFieldObj arity f

737− ) => Options -> Proxy arity

742+ ) => Options -> ToArgs Value arity a

738− -> (a -> Value) -> ([a] -> Value)

739 -> f a -> Value

743 -> f a -> Value

740−nonAllNullarySumToJSON opts pa tj tjl =

744+nonAllNullarySumToJSON opts targs =

741 case sumEncoding opts of

745 case sumEncoding opts of

742 TaggedObject{..} ->

746 TaggedObject{..} ->

743− object . taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl

747+ object . taggedObjectPairs opts targs tagFieldName contentsFieldName

744− ObjectWithSingleField -> Object . objectWithSingleFieldObj opts pa tj tjl

748+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts targs

745− TwoElemArray -> Array . twoElemArrayObj opts pa tj tjl

749+ TwoElemArray -> Array . twoElemArrayObj opts targs

746

750

747--------------------------------------------------------------------------------

751--------------------------------------------------------------------------------

748

752

749class SumToEncoding arity f allNullary where

753class SumToEncoding arity f allNullary where

750− sumToEncoding :: Options -> Proxy arity

754+ sumToEncoding :: Options -> ToArgs Encoding arity a

751− -> (a -> Encoding) -> ([a] -> Encoding)

752 -> f a -> Tagged allNullary Encoding

755 -> f a -> Tagged allNullary Encoding

753

756

754instance ( GetConName f

757instance ( GetConName f

@@ -756,116 +759,111 @@ instance ( GetConName f

756 , ObjectWithSingleFieldEnc arity f

759 , ObjectWithSingleFieldEnc arity f

757 , TwoElemArrayEnc arity f

760 , TwoElemArrayEnc arity f

758 ) => SumToEncoding arity f True where

761 ) => SumToEncoding arity f True where

759− sumToEncoding opts pa te tel

762+ sumToEncoding opts targs

760 | allNullaryToStringTag opts = Tagged . toEncoding .

763 | allNullaryToStringTag opts = Tagged . toEncoding .

761 constructorTagModifier opts . getConName

764 constructorTagModifier opts . getConName

762− | otherwise = Tagged . nonAllNullarySumToEncoding opts pa te tel

765+ | otherwise = Tagged . nonAllNullarySumToEncoding opts targs

763

766

764instance ( TwoElemArrayEnc arity f

767instance ( TwoElemArrayEnc arity f

765 , TaggedObjectEnc arity f

768 , TaggedObjectEnc arity f

766 , ObjectWithSingleFieldEnc arity f

769 , ObjectWithSingleFieldEnc arity f

767 ) => SumToEncoding arity f False where

770 ) => 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

769

772

770nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f

773nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f

771 , TaggedObjectEnc arity f

774 , TaggedObjectEnc arity f

772 , ObjectWithSingleFieldEnc arity f

775 , ObjectWithSingleFieldEnc arity f

773− ) => Options -> Proxy arity

776+ ) => Options -> ToArgs Encoding arity a

774− -> (a -> Encoding) -> ([a] -> Encoding)

775 -> f a -> Encoding

777 -> f a -> Encoding

776−nonAllNullarySumToEncoding opts pa te tel =

778+nonAllNullarySumToEncoding opts targs =

777 case sumEncoding opts of

779 case sumEncoding opts of

778 TaggedObject{..} ->

780 TaggedObject{..} ->

779− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel

781+ taggedObjectEnc opts targs tagFieldName contentsFieldName

780− ObjectWithSingleField -> objectWithSingleFieldEnc opts pa te tel

782+ ObjectWithSingleField -> objectWithSingleFieldEnc opts targs

781− TwoElemArray -> twoElemArrayEnc opts pa te tel

783+ TwoElemArray -> twoElemArrayEnc opts targs

782

784

783--------------------------------------------------------------------------------

785--------------------------------------------------------------------------------

784

786

785class TaggedObjectPairs arity f where

787class TaggedObjectPairs arity f where

786− taggedObjectPairs :: Options -> Proxy arity

788+ taggedObjectPairs :: Options -> ToArgs Value arity a

787 -> String -> String

789 -> String -> String

788− -> (a -> Value) -> ([a] -> Value)

789 -> f a -> [Pair]

790 -> f a -> [Pair]

790

791

791instance ( TaggedObjectPairs arity a

792instance ( TaggedObjectPairs arity a

792 , TaggedObjectPairs arity b

793 , TaggedObjectPairs arity b

793 ) => TaggedObjectPairs arity (a :+: b) where

794 ) => TaggedObjectPairs arity (a :+: b) where

794− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (L1 x) =

795+ taggedObjectPairs opts targs tagFieldName contentsFieldName (L1 x) =

795− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x

796+ taggedObjectPairs opts targs tagFieldName contentsFieldName x

796− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (R1 x) =

797+ taggedObjectPairs opts targs tagFieldName contentsFieldName (R1 x) =

797− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x

798+ taggedObjectPairs opts targs tagFieldName contentsFieldName x

798

799

799instance ( IsRecord a isRecord

800instance ( IsRecord a isRecord

800 , TaggedObjectPairs' arity a isRecord

801 , TaggedObjectPairs' arity a isRecord

801 , Constructor c

802 , Constructor c

802 ) => TaggedObjectPairs arity (C1 c a) where

803 ) => TaggedObjectPairs arity (C1 c a) where

803− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl =

804+ taggedObjectPairs opts targs tagFieldName contentsFieldName =

804 (pack tagFieldName .= constructorTagModifier opts

805 (pack tagFieldName .= constructorTagModifier opts

805 (conName (undefined :: t c a p)) :) .

806 (conName (undefined :: t c a p)) :) .

806 (unTagged :: Tagged isRecord [Pair] -> [Pair]) .

807 (unTagged :: Tagged isRecord [Pair] -> [Pair]) .

807− taggedObjectPairs' opts pa contentsFieldName tj tjl . unM1

808+ taggedObjectPairs' opts targs contentsFieldName . unM1

808

809

809class TaggedObjectPairs' arity f isRecord where

810class TaggedObjectPairs' arity f isRecord where

810− taggedObjectPairs' :: Options -> Proxy arity

811+ taggedObjectPairs' :: Options -> ToArgs Value arity a

811− -> String -> (a -> Value) -> ([a] -> Value)

812− -> f a -> Tagged isRecord [Pair]

812+ -> String -> f a -> Tagged isRecord [Pair]

813

814instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where

815− taggedObjectPairs' _ _ _ _ _ _ = Tagged []

815+ taggedObjectPairs' _ _ _ _ = Tagged []

816

817instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where

818− taggedObjectPairs' opts pa _ tj tjl =

818+ taggedObjectPairs' opts targs _ =

819− Tagged . toList . recordToPairs opts pa tj tjl

819+ Tagged . toList . recordToPairs opts targs

820

821instance (GToJSON arity f) => TaggedObjectPairs' arity f False where

822− taggedObjectPairs' opts pa contentsFieldName tj tjl =

822+ taggedObjectPairs' opts targs contentsFieldName =

823− Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts pa tj tjl

823+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts targs

824

825--------------------------------------------------------------------------------

826

827class TaggedObjectEnc arity f where

828− taggedObjectEnc :: Options -> Proxy arity

828+ taggedObjectEnc :: Options -> ToArgs Encoding arity a

829 -> String -> String

830− -> (a -> Encoding) -> ([a] -> Encoding)

831 -> f a -> Encoding

830 -> f a -> Encoding

832

831

833instance ( TaggedObjectEnc arity a

832instance ( TaggedObjectEnc arity a

834 , TaggedObjectEnc arity b

833 , TaggedObjectEnc arity b

835 ) => TaggedObjectEnc arity (a :+: b) where

834 ) => TaggedObjectEnc arity (a :+: b) where

836− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (L1 x) =

835+ taggedObjectEnc opts targs tagFieldName contentsFieldName (L1 x) =

837− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x

836+ taggedObjectEnc opts targs tagFieldName contentsFieldName x

838− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (R1 x) =

837+ taggedObjectEnc opts targs tagFieldName contentsFieldName (R1 x) =

839− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x

838+ taggedObjectEnc opts targs tagFieldName contentsFieldName x

840

839

841instance ( IsRecord a isRecord

840instance ( IsRecord a isRecord

842 , TaggedObjectEnc' arity a isRecord

841 , TaggedObjectEnc' arity a isRecord

843 , Constructor c

842 , Constructor c

844 ) => TaggedObjectEnc arity (C1 c a) where

843 ) => TaggedObjectEnc arity (C1 c a) where

845− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel v =

844+ taggedObjectEnc opts targs tagFieldName contentsFieldName v =

846 E.wrapObject $

845 E.wrapObject $

847 (E.string tagFieldName ><

846 (E.string tagFieldName ><

848 E.colon ><

847 E.colon ><

849 toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) ><

848 toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) ><

850 ((unTagged :: Tagged isRecord Encoding -> Encoding) .

849 ((unTagged :: Tagged isRecord Encoding -> Encoding) .

851− taggedObjectEnc' opts pa contentsFieldName te tel . unM1 $ v)

850+ taggedObjectEnc' opts targs contentsFieldName . unM1 $ v)

852

851

853class TaggedObjectEnc' arity f isRecord where

852class TaggedObjectEnc' arity f isRecord where

854− taggedObjectEnc' :: Options -> Proxy arity

853+ taggedObjectEnc' :: Options -> ToArgs Encoding arity a

855− -> String -> (a -> Encoding) -> ([a] -> Encoding)

856− -> f a -> Tagged isRecord Encoding

854+ -> String -> f a -> Tagged isRecord Encoding

857

855

858instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where

856instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where

859− taggedObjectEnc' _ _ _ _ _ _ = Tagged E.empty

857+ taggedObjectEnc' _ _ _ _ = Tagged E.empty

860

858

861instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where

859instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where

862− taggedObjectEnc' opts pa _ te tel = Tagged . (E.comma ><) . fst

860+ taggedObjectEnc' opts targs _ = Tagged . (E.comma ><) . fst

863− . recordToEncoding opts pa te tel

861+ . recordToEncoding opts targs

864

862

865instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where

863instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where

866− taggedObjectEnc' opts pa contentsFieldName te tel =

864+ taggedObjectEnc' opts targs contentsFieldName =

867 Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .

865 Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .

868− gToEncoding opts pa te tel

866+ gToEncoding opts targs

869

867

870--------------------------------------------------------------------------------

868--------------------------------------------------------------------------------

871

869

@@ -883,137 +881,129 @@ instance (Constructor c) => GetConName (C1 c a) where

883--------------------------------------------------------------------------------

881--------------------------------------------------------------------------------

884

882

885class TwoElemArrayObj arity f where

883class TwoElemArrayObj arity f where

886− twoElemArrayObj :: Options -> Proxy arity

884+ twoElemArrayObj :: Options -> ToArgs Value arity a

887− -> (a -> Value) -> ([a] -> Value)

888 -> f a -> V.Vector Value

885 -> f a -> V.Vector Value

889

886

890instance ( TwoElemArrayObj arity a

887instance ( TwoElemArrayObj arity a

891 , TwoElemArrayObj arity b

888 , TwoElemArrayObj arity b

892 ) => TwoElemArrayObj arity (a :+: b) where

889 ) => TwoElemArrayObj arity (a :+: b) where

893− twoElemArrayObj opts pa tj tjl (L1 x) = twoElemArrayObj opts pa tj tjl x

890+ twoElemArrayObj opts targs (L1 x) = twoElemArrayObj opts targs x

894− twoElemArrayObj opts pa tj tjl (R1 x) = twoElemArrayObj opts pa tj tjl x

891+ twoElemArrayObj opts targs (R1 x) = twoElemArrayObj opts targs x

895

892

896instance ( GToJSON arity a

893instance ( GToJSON arity a

897 , ConsToJSON arity a

894 , ConsToJSON arity a

898 , Constructor c

895 , Constructor c

899 ) => TwoElemArrayObj arity (C1 c a) where

896 ) => TwoElemArrayObj arity (C1 c a) where

900− twoElemArrayObj opts pa tj tjl x = V.create $ do

897+ twoElemArrayObj opts targs x = V.create $ do

901 mv <- VM.unsafeNew 2

898 mv <- VM.unsafeNew 2

902 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts

899 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts

903 $ conName (undefined :: t c a p)

900 $ 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

905 return mv

902 return mv

906

903

907--------------------------------------------------------------------------------

904--------------------------------------------------------------------------------

908

905

909class TwoElemArrayEnc arity f where

906class TwoElemArrayEnc arity f where

910− twoElemArrayEnc :: Options -> Proxy arity

907+ twoElemArrayEnc :: Options -> ToArgs Encoding arity a

911− -> (a -> Encoding) -> ([a] -> Encoding)

912 -> f a -> Encoding

908 -> f a -> Encoding

913

909

914instance ( TwoElemArrayEnc arity a

910instance ( TwoElemArrayEnc arity a

915 , TwoElemArrayEnc arity b

911 , TwoElemArrayEnc arity b

916 ) => TwoElemArrayEnc arity (a :+: b) where

912 ) => TwoElemArrayEnc arity (a :+: b) where

917− twoElemArrayEnc opts pa te tel (L1 x) = twoElemArrayEnc opts pa te tel x

913+ twoElemArrayEnc opts targs (L1 x) = twoElemArrayEnc opts targs x

918− twoElemArrayEnc opts pa te tel (R1 x) = twoElemArrayEnc opts pa te tel x

914+ twoElemArrayEnc opts targs (R1 x) = twoElemArrayEnc opts targs x

919

915

920instance ( GToEncoding arity a

916instance ( GToEncoding arity a

921 , ConsToEncoding arity a

917 , ConsToEncoding arity a

922 , Constructor c

918 , Constructor c

923 ) => TwoElemArrayEnc arity (C1 c a) where

919 ) => TwoElemArrayEnc arity (C1 c a) where

924− twoElemArrayEnc opts pa te tel x = E.tuple $

920+ twoElemArrayEnc opts targs x = E.tuple $

925 toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<

921 toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<

926− gToEncoding opts pa te tel x

922+ gToEncoding opts targs x

927

923

928--------------------------------------------------------------------------------

924--------------------------------------------------------------------------------

929

925

930class ConsToJSON arity f where

926class ConsToJSON arity f where

931− consToJSON :: Options -> Proxy arity

927+ consToJSON :: Options -> ToArgs Value arity a

932− -> (a -> Value) -> ([a] -> Value)

933 -> f a -> Value

928 -> f a -> Value

934

929

935class ConsToJSON' arity f isRecord where

930class ConsToJSON' arity f isRecord where

936− consToJSON' :: Options -> Proxy arity

931+ consToJSON' :: Options -> ToArgs Value arity a

937 -> Bool -- ^ Are we a record with one field?

932 -> Bool -- ^ Are we a record with one field?

938− -> (a -> Value) -> ([a] -> Value)

939 -> f a -> Tagged isRecord Value

933 -> f a -> Tagged isRecord Value

940

934

941instance ( IsRecord f isRecord

935instance ( IsRecord f isRecord

942 , ConsToJSON' arity f isRecord

936 , ConsToJSON' arity f isRecord

943 ) => ConsToJSON arity f where

937 ) => ConsToJSON arity f where

944− consToJSON opts pa tj tjl =

938+ consToJSON opts targs =

945 (unTagged :: Tagged isRecord Value -> Value)

939 (unTagged :: Tagged isRecord Value -> Value)

946− . consToJSON' opts pa (isUnary (undefined :: f a)) tj tjl

940+ . consToJSON' opts targs (isUnary (undefined :: f a))

947

941

948instance (RecordToPairs arity f) => ConsToJSON' arity f True where

942instance (RecordToPairs arity f) => ConsToJSON' arity f True where

949− consToJSON' opts pa isUn tj tjl f = let

943+ consToJSON' opts targs isUn f = let

950− vals = toList $ recordToPairs opts pa tj tjl f

944+ vals = toList $ recordToPairs opts targs f

951 in case (unwrapUnaryRecords opts,isUn,vals) of

945 in case (unwrapUnaryRecords opts,isUn,vals) of

952 (True,True,[(_,val)]) -> Tagged val

946 (True,True,[(_,val)]) -> Tagged val

953 _ -> Tagged $ object vals

947 _ -> Tagged $ object vals

954

948

955instance GToJSON arity f => ConsToJSON' arity f False where

949instance 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

957

951

958--------------------------------------------------------------------------------

952--------------------------------------------------------------------------------

959

953

960class ConsToEncoding arity f where

954class ConsToEncoding arity f where

961− consToEncoding :: Options -> Proxy arity

955+ consToEncoding :: Options -> ToArgs Encoding arity a

962− -> (a -> Encoding) -> ([a] -> Encoding)

963 -> f a -> Encoding

956 -> f a -> Encoding

964

957

965class ConsToEncoding' arity f isRecord where

958class ConsToEncoding' arity f isRecord where

966− consToEncoding' :: Options -> Proxy arity

959+ consToEncoding' :: Options -> ToArgs Encoding arity a

967 -> Bool -- ^ Are we a record with one field?

960 -> Bool -- ^ Are we a record with one field?

968− -> (a -> Encoding) -> ([a] -> Encoding)

969 -> f a -> Tagged isRecord Encoding

961 -> f a -> Tagged isRecord Encoding

970

962

971instance ( IsRecord f isRecord

963instance ( IsRecord f isRecord

972 , ConsToEncoding' arity f isRecord

964 , ConsToEncoding' arity f isRecord

973 ) => ConsToEncoding arity f where

965 ) => ConsToEncoding arity f where

974− consToEncoding opts pa te tel =

966+ consToEncoding opts targs =

975 (unTagged :: Tagged isRecord Encoding -> Encoding)

967 (unTagged :: Tagged isRecord Encoding -> Encoding)

976− . consToEncoding' opts pa (isUnary (undefined :: f a)) te tel

968+ . consToEncoding' opts targs (isUnary (undefined :: f a))

977

969

978instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where

970instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where

979− consToEncoding' opts pa isUn te tel x =

971+ consToEncoding' opts targs isUn x =

980− let (enc, mbVal) = recordToEncoding opts pa te tel x

972+ let (enc, mbVal) = recordToEncoding opts targs x

981 in case (unwrapUnaryRecords opts, isUn, mbVal) of

973 in case (unwrapUnaryRecords opts, isUn, mbVal) of

982 (True, True, Just val) -> Tagged val

974 (True, True, Just val) -> Tagged val

983 _ -> Tagged $ E.wrapObject enc

975 _ -> Tagged $ E.wrapObject enc

984

976

985instance GToEncoding arity f => ConsToEncoding' arity f False where

977instance 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

987

979

988--------------------------------------------------------------------------------

980--------------------------------------------------------------------------------

989

981

990class RecordToPairs arity f where

982class RecordToPairs arity f where

991− recordToPairs :: Options -> Proxy arity

983+ recordToPairs :: Options -> ToArgs Value arity a

992− -> (a -> Value) -> ([a] -> Value)

993 -> f a -> DList Pair

984 -> f a -> DList Pair

994

985

995instance ( RecordToPairs arity a

986instance ( RecordToPairs arity a

996 , RecordToPairs arity b

987 , RecordToPairs arity b

997 ) => RecordToPairs arity (a :*: b) where

988 ) => RecordToPairs arity (a :*: b) where

998− recordToPairs opts pa tj tjl (a :*: b) = recordToPairs opts pa tj tjl a <>

989+ recordToPairs opts targs (a :*: b) = recordToPairs opts targs a <>

999− recordToPairs opts pa tj tjl b

990+ recordToPairs opts targs b

1000

991

1001instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where

992instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where

1002 recordToPairs = fieldToPair

993 recordToPairs = fieldToPair

1003

994

1004instance OVERLAPPING_ (Selector s, ToJSON a) =>

995instance OVERLAPPING_ (Selector s, ToJSON a) =>

1005 RecordToPairs arity (S1 s (K1 i (Maybe a))) where

996 RecordToPairs arity (S1 s (K1 i (Maybe a))) where

1006− recordToPairs opts _ _ _ (M1 k1) | omitNothingFields opts

997+ recordToPairs opts _ (M1 k1) | omitNothingFields opts

1007− , K1 Nothing <- k1 = DList.empty

998+ , K1 Nothing <- k1 = DList.empty

1008− recordToPairs opts pa tj tjl m1 = fieldToPair opts pa tj tjl m1

999+ recordToPairs opts targs m1 = fieldToPair opts targs m1

1009

1000

1010fieldToPair :: (Selector s, GToJSON arity a)

1001fieldToPair :: (Selector s, GToJSON arity a)

1011− => Options -> Proxy arity

1002+ => Options -> ToArgs Value arity p

1012− -> (p -> Value) -> ([p] -> Value)

1013 -> S1 s a p -> DList Pair

1003 -> S1 s a p -> DList Pair

1014−fieldToPair opts pa tj tjl m1 = pure ( pack $ fieldLabelModifier opts $ selName m1

1004+fieldToPair opts targs m1 = pure ( pack $ fieldLabelModifier opts $ selName m1

1015− , gToJSON opts pa tj tjl (unM1 m1)

1005+ , gToJSON opts targs (unM1 m1)

1016− )

1006+ )

1017

1007

1018--------------------------------------------------------------------------------

1008--------------------------------------------------------------------------------

1019

1009

@@ -1021,22 +1011,21 @@ class RecordToEncoding arity f where

1021 -- 1st element: whole thing

1011 -- 1st element: whole thing

1022 -- 2nd element: in case the record has only 1 field, just the value

1012 -- 2nd element: in case the record has only 1 field, just the value

1023 -- of the field (without the key); 'Nothing' otherwise

1013 -- of the field (without the key); 'Nothing' otherwise

1024− recordToEncoding :: Options -> Proxy arity

1014+ recordToEncoding :: Options -> ToArgs Encoding arity a

1025− -> (a -> Encoding) -> ([a] -> Encoding)

1026 -> f a -> (Encoding, Maybe Encoding)

1015 -> f a -> (Encoding, Maybe Encoding)

1027

1016

1028instance ( RecordToEncoding arity a

1017instance ( RecordToEncoding arity a

1029 , RecordToEncoding arity b

1018 , RecordToEncoding arity b

1030 ) => RecordToEncoding arity (a :*: b) where

1019 ) => RecordToEncoding arity (a :*: b) where

1031− recordToEncoding opts pa te tel (a :*: b) | omitNothingFields opts =

1020+ recordToEncoding opts targs (a :*: b) | omitNothingFields opts =

1032 (E.econcat $ intersperse E.comma $

1021 (E.econcat $ intersperse E.comma $

1033 filter (not . E.nullEncoding)

1022 filter (not . E.nullEncoding)

1034− [ fst (recordToEncoding opts pa te tel a)

1023+ [ fst (recordToEncoding opts targs a)

1035− , fst (recordToEncoding opts pa te tel b) ]

1024+ , fst (recordToEncoding opts targs b) ]

1036 , Nothing)

1025 , Nothing)

1037− recordToEncoding opts pa te tel (a :*: b) =

1026+ recordToEncoding opts targs (a :*: b) =

1038− (fst (recordToEncoding opts pa te tel a) >< E.comma ><

1027+ (fst (recordToEncoding opts targs a) >< E.comma ><

1039− fst (recordToEncoding opts pa te tel b),

1028+ fst (recordToEncoding opts targs b),

1040 Nothing)

1029 Nothing)

1041

1030

1042

1031

@@ -1045,87 +1034,82 @@ instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) wh

1045

1034

1046instance OVERLAPPING_ (Selector s, ToJSON a) =>

1035instance OVERLAPPING_ (Selector s, ToJSON a) =>

1047 RecordToEncoding arity (S1 s (K1 i (Maybe a))) where

1036 RecordToEncoding arity (S1 s (K1 i (Maybe a))) where

1048− recordToEncoding opts _ _ _ (M1 k1) | omitNothingFields opts

1037+ recordToEncoding opts _ (M1 k1) | omitNothingFields opts

1049− , K1 Nothing <- k1 = (E.empty, Nothing)

1038+ , K1 Nothing <- k1 = (E.empty, Nothing)

1050− recordToEncoding opts pa te tel m1 = fieldToEncoding opts pa te tel m1

1039+ recordToEncoding opts targs m1 = fieldToEncoding opts targs m1

1051

1040

1052fieldToEncoding :: (Selector s, GToEncoding arity a)

1041fieldToEncoding :: (Selector s, GToEncoding arity a)

1053− => Options -> Proxy arity

1042+ => Options -> ToArgs Encoding arity p

1054− -> (p -> Encoding) -> ([p] -> Encoding)

1055 -> S1 s a p -> (Encoding, Maybe Encoding)

1043 -> S1 s a p -> (Encoding, Maybe Encoding)

1056−fieldToEncoding opts pa te tel m1 =

1044+fieldToEncoding opts targs m1 =

1057 let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)

1045 let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)

1058− valueBuilder = gToEncoding opts pa te tel (unM1 m1)

1046+ valueBuilder = gToEncoding opts targs (unM1 m1)

1059 in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)

1047 in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)

1060

1048

1061--------------------------------------------------------------------------------

1049--------------------------------------------------------------------------------

1062

1050

1063class WriteProduct arity f where

1051class WriteProduct arity f where

1064 writeProduct :: Options

1052 writeProduct :: Options

1065− -> Proxy arity

1053+ -> ToArgs Value arity a

1066 -> VM.MVector s Value

1054 -> VM.MVector s Value

1067 -> Int -- ^ index

1055 -> Int -- ^ index

1068 -> Int -- ^ length

1056 -> Int -- ^ length

1069− -> (a -> Value)

1070− -> ([a] -> Value)

1071 -> f a

1057 -> f a

1072 -> ST s ()

1058 -> ST s ()

1073

1059

1074instance ( WriteProduct arity a

1060instance ( WriteProduct arity a

1075 , WriteProduct arity b

1061 , WriteProduct arity b

1076 ) => WriteProduct arity (a :*: b) where

1062 ) => WriteProduct arity (a :*: b) where

1077− writeProduct opts pa mv ix len tj tjl (a :*: b) = do

1063+ writeProduct opts targs mv ix len (a :*: b) = do

1078− writeProduct opts pa mv ix lenL tj tjl a

1064+ writeProduct opts targs mv ix lenL a

1079− writeProduct opts pa mv ixR lenR tj tjl b

1065+ writeProduct opts targs mv ixR lenR b

1080 where

1066 where

1081 lenL = len `unsafeShiftR` 1

1067 lenL = len `unsafeShiftR` 1

1082 lenR = len - lenL

1068 lenR = len - lenL

1083 ixR = ix + lenL

1069 ixR = ix + lenL

1084

1070

1085instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where

1071instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where

1086− writeProduct opts pa mv ix _ tj tjl =

1072+ writeProduct opts targs mv ix _ =

1087− VM.unsafeWrite mv ix . gToJSON opts pa tj tjl

1073+ VM.unsafeWrite mv ix . gToJSON opts targs

1088

1074

1089--------------------------------------------------------------------------------

1075--------------------------------------------------------------------------------

1090

1076

1091class EncodeProduct arity f where

1077class EncodeProduct arity f where

1092− encodeProduct :: Options -> Proxy arity

1078+ encodeProduct :: Options -> ToArgs Encoding arity a

1093− -> (a -> Encoding) -> ([a] -> Encoding)

1094 -> f a -> Encoding' E.InArray

1079 -> f a -> Encoding' E.InArray

1095

1080

1096instance ( EncodeProduct arity a

1081instance ( EncodeProduct arity a

1097 , EncodeProduct arity b

1082 , EncodeProduct arity b

1098 ) => EncodeProduct arity (a :*: b) where

1083 ) => EncodeProduct arity (a :*: b) where

1099− encodeProduct opts pa te tel (a :*: b) | omitNothingFields opts =

1084+ encodeProduct opts targs (a :*: b) | omitNothingFields opts =

1100 E.econcat $ intersperse E.comma $

1085 E.econcat $ intersperse E.comma $

1101 filter (not . E.nullEncoding)

1086 filter (not . E.nullEncoding)

1102− [encodeProduct opts pa te tel a, encodeProduct opts pa te tel b]

1087+ [encodeProduct opts targs a, encodeProduct opts targs b]

1103− encodeProduct opts pa te tel (a :*: b) = encodeProduct opts pa te tel a >*<

1088+ encodeProduct opts targs (a :*: b) = encodeProduct opts targs a >*<

1104− encodeProduct opts pa te tel b

1089+ encodeProduct opts targs b

1105

1090

1106instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where

1091instance 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

1108

1093

1109--------------------------------------------------------------------------------

1094--------------------------------------------------------------------------------

1110

1095

1111class ObjectWithSingleFieldObj arity f where

1096class ObjectWithSingleFieldObj arity f where

1112− objectWithSingleFieldObj :: Options -> Proxy arity

1097+ objectWithSingleFieldObj :: Options -> ToArgs Value arity a

1113− -> (a -> Value) -> ([a] -> Value)

1114 -> f a -> Object

1098 -> f a -> Object

1115

1099

1116instance ( ObjectWithSingleFieldObj arity a

1100instance ( ObjectWithSingleFieldObj arity a

1117 , ObjectWithSingleFieldObj arity b

1101 , ObjectWithSingleFieldObj arity b

1118 ) => ObjectWithSingleFieldObj arity (a :+: b) where

1102 ) => ObjectWithSingleFieldObj arity (a :+: b) where

1119− objectWithSingleFieldObj opts pa tj tjl (L1 x) =

1103+ objectWithSingleFieldObj opts targs (L1 x) =

1120− objectWithSingleFieldObj opts pa tj tjl x

1104+ objectWithSingleFieldObj opts targs x

1121− objectWithSingleFieldObj opts pa tj tjl (R1 x) =

1105+ objectWithSingleFieldObj opts targs (R1 x) =

1122− objectWithSingleFieldObj opts pa tj tjl x

1106+ objectWithSingleFieldObj opts targs x

1123

1107

1124instance ( GToJSON arity a

1108instance ( GToJSON arity a

1125 , ConsToJSON arity a

1109 , ConsToJSON arity a

1126 , Constructor c

1110 , Constructor c

1127 ) => ObjectWithSingleFieldObj arity (C1 c a) where

1111 ) => 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

1129 where

1113 where

1130 typ = pack $ constructorTagModifier opts $

1114 typ = pack $ constructorTagModifier opts $

1131 conName (undefined :: t c a p)

1115 conName (undefined :: t c a p)

@@ -1133,29 +1117,28 @@ instance ( GToJSON arity a

1133--------------------------------------------------------------------------------

1117--------------------------------------------------------------------------------

1134

1118

1135class ObjectWithSingleFieldEnc arity f where

1119class ObjectWithSingleFieldEnc arity f where

1136− objectWithSingleFieldEnc :: Options -> Proxy arity

1120+ objectWithSingleFieldEnc :: Options -> ToArgs Encoding arity a

1137− -> (a -> Encoding) -> ([a] -> Encoding)

1138 -> f a -> Encoding

1121 -> f a -> Encoding

1139

1122

1140instance ( ObjectWithSingleFieldEnc arity a

1123instance ( ObjectWithSingleFieldEnc arity a

1141 , ObjectWithSingleFieldEnc arity b

1124 , ObjectWithSingleFieldEnc arity b

1142 ) => ObjectWithSingleFieldEnc arity (a :+: b) where

1125 ) => ObjectWithSingleFieldEnc arity (a :+: b) where

1143− objectWithSingleFieldEnc opts pa te tel (L1 x) =

1126+ objectWithSingleFieldEnc opts targs (L1 x) =

1144− objectWithSingleFieldEnc opts pa te tel x

1127+ objectWithSingleFieldEnc opts targs x

1145− objectWithSingleFieldEnc opts pa te tel (R1 x) =

1128+ objectWithSingleFieldEnc opts targs (R1 x) =

1146− objectWithSingleFieldEnc opts pa te tel x

1129+ objectWithSingleFieldEnc opts targs x

1147

1130

1148instance ( GToEncoding arity a

1131instance ( GToEncoding arity a

1149 , ConsToEncoding arity a

1132 , ConsToEncoding arity a

1150 , Constructor c

1133 , Constructor c

1151 ) => ObjectWithSingleFieldEnc arity (C1 c a) where

1134 ) => ObjectWithSingleFieldEnc arity (C1 c a) where

1152− objectWithSingleFieldEnc opts pa te tel v =

1135+ objectWithSingleFieldEnc opts targs v =

1153 E.openCurly ><

1136 E.openCurly ><

1154 toEncoding

1137 toEncoding

1155 (constructorTagModifier opts

1138 (constructorTagModifier opts

1156 (conName (undefined :: t c a p))) ><

1139 (conName (undefined :: t c a p))) ><

1157 E.colon ><

1140 E.colon ><

1158− gToEncoding opts pa te tel v ><

1141+ gToEncoding opts targs v ><

1159 E.closeCurly

1142 E.closeCurly

1160

1143

1161-------------------------------------------------------------------------------

1144-------------------------------------------------------------------------------