064db05 · typeable/aeson

Data/Aeson/TH.hs+33−4

@@ -112,7 +112,7 @@ module Data.Aeson.TH

112112 , mkLiftParseJSON2

113113 ) where

114114

115−import Control.Applicative ( pure, (<$>), (<*>) )

115+import Control.Applicative ( pure, (<$>), (<*>), (<|>) )

116116import Data.Aeson ( Object, (.=), (.:)

117117 , ToJSON(..), FromJSON(..)

118118 , ToJSON1(..), FromJSON1(..)

@@ -437,7 +437,7 @@ sumToValue opts multiCons conName exp

437437 [|A.object|] `appE` listE

438438 [ infixApp (conTxt opts conName) [|(.=)|] exp

439439 ]

440−

440+ UntaggedValue -> exp

441441 | otherwise = exp

442442

443443nullarySumToValue :: Options -> Bool -> Name -> Q Exp

@@ -447,6 +447,7 @@ nullarySumToValue opts multiCons conName =

447447 [|A.object|] `appE` listE

448448 [ infixApp [|T.pack tagFieldName|] [|(.=)|] (conStr opts conName)

449449 ]

450+ UntaggedValue -> conStr opts conName

450451 _ -> sumToValue opts multiCons conName [e|toJSON ([] :: [()])|]

451452

452453-- | Generates code to generate the JSON encoding of a single constructor.

@@ -545,6 +546,7 @@ argsToValue jc tjs opts multiCons (RecC conName ts) = case (unwrapUnaryRecords o

545546 ObjectWithSingleField ->

546547 [|A.object|] `appE` listE

547548 [ infixApp (conTxt opts conName) [|(.=)|] exp ]

549+ UntaggedValue -> exp

548550 else exp

549551 ) []

550552

@@ -610,7 +612,7 @@ sumToEncoding opts multiCons conName exp

610612 ([|E.text (T.pack contentsFieldName)|] <:> fexp)

611613 ObjectWithSingleField ->

612614 object (encStr opts conName <:> fexp)

613−

615+ UntaggedValue -> exp

614616 | otherwise = exp

615617

616618nullarySumToEncoding :: Options -> Bool -> Name -> Q Exp

@@ -619,6 +621,7 @@ nullarySumToEncoding opts multiCons conName =

619621 TaggedObject{tagFieldName} ->

620622 object $

621623 [|E.text (T.pack tagFieldName)|] <:> encStr opts conName

624+ UntaggedValue -> encStr opts conName

622625 _ -> sumToEncoding opts multiCons conName [e|toEncoding ([] :: [()])|]

623626

624627-- | Generates code to generate the JSON encoding of a single constructor.

@@ -706,6 +709,7 @@ argsToEncoding jc tes opts multiCons (RecC conName ts) = case (unwrapUnaryRecord

706709 objBody

707710 ObjectWithSingleField -> object $

708711 encStr opts conName <:> exp

712+ UntaggedValue -> exp

709713 else exp

710714 ) []

711715

@@ -836,7 +840,10 @@ consFromJSON jc tName opts cons = do

836840 where

837841 lamExpr value pjs = case cons of

838842 [con] -> parseArgs jc pjs tName opts con (Right value)

839− _ -> caseE (varE value) $

843+ _ | sumEncoding opts == UntaggedValue

844+ -> parseUntaggedValue pjs cons value

845+ | otherwise

846+ -> caseE (varE value) $

840847 if allNullaryToStringTag opts && all isNullary cons

841848 then allNullaryMatches

842849 else mixedMatches pjs

@@ -878,6 +885,7 @@ consFromJSON jc tName opts cons = do

878885 case sumEncoding opts of

879886 TaggedObject {tagFieldName, contentsFieldName} ->

880887 parseObject $ parseTaggedObject pjs tagFieldName contentsFieldName

888+ UntaggedValue -> error "UntaggedValue: Should be handled already"

881889 ObjectWithSingleField ->

882890 parseObject $ parseObjectWithSingleField pjs

883891 TwoElemArray ->

@@ -927,6 +935,27 @@ consFromJSON jc tName opts cons = do

927935 , noBindS $ parseContents pjs conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject

928936 ]

929937

938+ parseUntaggedValue pjs cons' conVal =

939+ foldr1 (\e e' -> infixApp e [|(<|>)|] e')

940+ (map (\x -> parseValue pjs x conVal) cons')

941+

942+ parseValue _pjs (NormalC conName []) conVal = do

943+ str <- newName "str"

944+ caseE (varE conVal)

945+ [ match (conP 'String [varP str])

946+ (guardedB

947+ [ liftM2 (,) (normalG $ infixApp (varE str) [|(==)|] ([|T.pack|] `appE` conStringE opts conName)

948+ )

949+ ([|pure|] `appE` conE conName)

950+ ]

951+ )

952+ []

953+ , matchFailed tName conName "String"

954+ ]

955+ parseValue pjs con conVal =

956+ parseArgs jc pjs tName opts con (Right conVal)

957+

958+

930959 parse2ElemArray pjs arr = do

931960 conKey <- newName "conKey"

932961 conVal <- newName "conVal"

Data/Aeson/Types/FromJSON.hs+48−9

@@ -748,17 +748,19 @@ class ParseSum arity f allNullary where

748748 parseSum :: Options -> FromArgs arity a

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

750750

751−instance ( SumFromString (a :+: b)

752− , FromPair arity (a :+: b)

753− , FromTaggedObject arity (a :+: b)

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

751+instance ( SumFromString (a :+: b)

752+ , FromPair arity (a :+: b)

753+ , FromTaggedObject arity (a :+: b)

754+ , FromUntaggedValue arity (a :+: b)

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

755756 parseSum opts fargs

756757 | allNullaryToStringTag opts = Tagged . parseAllNullarySum opts

757758 | otherwise = Tagged . parseNonAllNullarySum opts fargs

758759

759−instance ( FromPair arity (a :+: b)

760− , FromTaggedObject arity (a :+: b)

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

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

761+ , FromTaggedObject arity (a :+: b)

762+ , FromUntaggedValue arity (a :+: b)

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

762764 parseSum opts fargs = Tagged . parseNonAllNullarySum opts fargs

763765

764766--------------------------------------------------------------------------------

@@ -784,8 +786,9 @@ instance (Constructor c) => SumFromString (C1 c U1) where

784786

785787--------------------------------------------------------------------------------

786788

787−parseNonAllNullarySum :: ( FromPair arity (a :+: b)

788− , FromTaggedObject arity (a :+: b)

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

790+ , FromTaggedObject arity (a :+: b)

791+ , FromUntaggedValue arity (a :+: b)

789792 ) => Options -> FromArgs arity c

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

791794parseNonAllNullarySum opts fargs =

@@ -812,6 +815,8 @@ parseNonAllNullarySum opts fargs =

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

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

814817

818+ UntaggedValue -> parseUntaggedValue opts fargs

819+

815820--------------------------------------------------------------------------------

816821

817822class FromTaggedObject arity f where

@@ -975,6 +980,40 @@ instance ( Constructor c

975980

976981--------------------------------------------------------------------------------

977982

983+class FromUntaggedValue arity f where

984+ parseUntaggedValue :: Options -> FromArgs arity a

985+ -> Value -> Parser (f a)

986+

987+instance

988+ ( FromUntaggedValue arity a

989+ , FromUntaggedValue arity b

990+ ) => FromUntaggedValue arity (a :+: b)

991+ where

992+ parseUntaggedValue opts fargs value =

993+ L1 <$> parseUntaggedValue opts fargs value <|>

994+ R1 <$> parseUntaggedValue opts fargs value

995+

996+instance OVERLAPPABLE_

997+ ( GFromJSON arity a

998+ , ConsFromJSON arity a

999+ ) => FromUntaggedValue arity (C1 c a)

1000+ where

1001+ parseUntaggedValue = gParseJSON

1002+

1003+instance OVERLAPPING_

1004+ ( Constructor c )

1005+ => FromUntaggedValue arity (C1 c U1)

1006+ where

1007+ parseUntaggedValue opts _ (String s)

1008+ | s == pack (constructorTagModifier opts (conName (undefined :: t c U1 p))) =

1009+ pure $ M1 U1

1010+ | otherwise =

1011+ fail $ "Invalid tag: " ++ unpack s

1012+ parseUntaggedValue _ _ v = typeMismatch (conName (undefined :: t c U1 p)) v

1013+

1014+

1015+--------------------------------------------------------------------------------

1016+

9781017notFound :: Text -> Parser a

9791018notFound key = fail $ "The key \"" ++ unpack key ++ "\" was not found"

9801019{-# INLINE notFound #-}

Data/Aeson/Types/Internal.hs+14

@@ -549,6 +549,20 @@ data SumEncoding =

549549 -- by the encoded value of that field! If the constructor is not a

550550 -- record the encoded constructor contents will be stored under

551551 -- the 'contentsFieldName' field.

552+ | UntaggedValue

553+ -- ^ Constructor names won't be encoded. Instead only the contents of the

554+ -- constructor will be encoded as if the type had single constructor. JSON

555+ -- encodings have to be disjoint for decoding to work properly.

556+ --

557+ -- When decoding, constructors are tried in the order of definition. If some

558+ -- encodings overlap, the first one defined will succeed.

559+ --

560+ -- /Note:/ Nullary constructors are encoded as the string (using

561+ -- 'constructorTagModifier'). Having a nullary constructor alongside a

562+ -- single field constructor that encodes to a string leads to ambiguity.

563+ --

564+ -- /Note:/ Only the last error is kept when decoding, so in the case of

565+ -- mailformed JSON, only an error for the last constructor will be reported.

552566 | ObjectWithSingleField

553567 -- ^ A constructor will be encoded to an object with a single

554568 -- field named after the constructor tag (modified by the

Data/Aeson/Types/ToJSON.hs+62

@@ -755,6 +755,7 @@ instance ( GetConName f

755755 , TaggedObjectPairs arity f

756756 , ObjectWithSingleFieldObj arity f

757757 , TwoElemArrayObj arity f

758+ , UntaggedValueObj arity f

758759 ) => SumToJSON arity f True where

759760 sumToJSON opts targs

760761 | allNullaryToStringTag opts = Tagged . String . pack

@@ -764,12 +765,14 @@ instance ( GetConName f

764765instance ( TwoElemArrayObj arity f

765766 , TaggedObjectPairs arity f

766767 , ObjectWithSingleFieldObj arity f

768+ , UntaggedValueObj arity f

767769 ) => SumToJSON arity f False where

768770 sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs

769771

770772nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f

771773 , TaggedObjectPairs arity f

772774 , ObjectWithSingleFieldObj arity f

775+ , UntaggedValueObj arity f

773776 ) => Options -> ToArgs Value arity a

774777 -> f a -> Value

775778nonAllNullarySumToJSON opts targs =

@@ -778,6 +781,7 @@ nonAllNullarySumToJSON opts targs =

778781 object . taggedObjectPairs opts targs tagFieldName contentsFieldName

779782 ObjectWithSingleField -> Object . objectWithSingleFieldObj opts targs

780783 TwoElemArray -> Array . twoElemArrayObj opts targs

784+ UntaggedValue -> untaggedValueObj opts targs

781785

782786--------------------------------------------------------------------------------

783787

@@ -789,6 +793,7 @@ instance ( GetConName f

789793 , TaggedObjectEnc arity f

790794 , ObjectWithSingleFieldEnc arity f

791795 , TwoElemArrayEnc arity f

796+ , UntaggedValueEnc arity f

792797 ) => SumToEncoding arity f True where

793798 sumToEncoding opts targs

794799 | allNullaryToStringTag opts = Tagged . toEncoding .

@@ -798,12 +803,14 @@ instance ( GetConName f

798803instance ( TwoElemArrayEnc arity f

799804 , TaggedObjectEnc arity f

800805 , ObjectWithSingleFieldEnc arity f

806+ , UntaggedValueEnc arity f

801807 ) => SumToEncoding arity f False where

802808 sumToEncoding opts targs = Tagged . nonAllNullarySumToEncoding opts targs

803809

804810nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f

805811 , TaggedObjectEnc arity f

806812 , ObjectWithSingleFieldEnc arity f

813+ , UntaggedValueEnc arity f

807814 ) => Options -> ToArgs Encoding arity a

808815 -> f a -> Encoding

809816nonAllNullarySumToEncoding opts targs =

@@ -812,6 +819,7 @@ nonAllNullarySumToEncoding opts targs =

812819 taggedObjectEnc opts targs tagFieldName contentsFieldName

813820 ObjectWithSingleField -> objectWithSingleFieldEnc opts targs

814821 TwoElemArray -> twoElemArrayEnc opts targs

822+ UntaggedValue -> untaggedValueEnc opts targs

815823

816824--------------------------------------------------------------------------------

817825

@@ -1172,6 +1180,60 @@ instance ( GToEncoding arity a

11721180 gToEncoding opts targs v ><

11731181 E.closeCurly

11741182

1183+--------------------------------------------------------------------------------

1184+

1185+class UntaggedValueObj arity f where

1186+ untaggedValueObj :: Options -> ToArgs Value arity a

1187+ -> f a -> Value

1188+

1189+instance

1190+ ( UntaggedValueObj arity a

1191+ , UntaggedValueObj arity b

1192+ ) => UntaggedValueObj arity (a :+: b)

1193+ where

1194+ untaggedValueObj opts targs (L1 x) = untaggedValueObj opts targs x

1195+ untaggedValueObj opts targs (R1 x) = untaggedValueObj opts targs x

1196+

1197+instance OVERLAPPABLE_

1198+ ( GToJSON arity a

1199+ , ConsToJSON arity a

1200+ ) => UntaggedValueObj arity (C1 c a) where

1201+ untaggedValueObj = gToJSON

1202+

1203+instance OVERLAPPING_

1204+ ( Constructor c )

1205+ => UntaggedValueObj arity (C1 c U1)

1206+ where

1207+ untaggedValueObj opts _ _ = toJSON $

1208+ constructorTagModifier opts $ conName (undefined :: t c U1 p)

1209+

1210+--------------------------------------------------------------------------------

1211+

1212+class UntaggedValueEnc arity f where

1213+ untaggedValueEnc :: Options -> ToArgs Encoding arity a

1214+ -> f a -> Encoding

1215+instance

1216+ ( UntaggedValueEnc arity a

1217+ , UntaggedValueEnc arity b

1218+ ) => UntaggedValueEnc arity (a :+: b)

1219+ where

1220+ untaggedValueEnc opts targs (L1 x) = untaggedValueEnc opts targs x

1221+ untaggedValueEnc opts targs (R1 x) = untaggedValueEnc opts targs x

1222+

1223+instance OVERLAPPABLE_

1224+ ( GToEncoding arity a

1225+ , ConsToEncoding arity a

1226+ ) => UntaggedValueEnc arity (C1 c a)

1227+ where

1228+ untaggedValueEnc = gToEncoding

1229+

1230+instance OVERLAPPING_

1231+ ( Constructor c )

1232+ => UntaggedValueEnc arity (C1 c U1)

1233+ where

1234+ untaggedValueEnc opts _ _ = toEncoding $

1235+ constructorTagModifier opts $ conName (undefined :: t c U1 p)

1236+

11751237-------------------------------------------------------------------------------

11761238-- Instances

11771239-------------------------------------------------------------------------------

changelog.md+2

@@ -13,6 +13,8 @@ For the latest version of this document, please see [https://github.com/bos/aeso

1313

1414* Added `Data.Aeson.Encoding` with functions to work with `Encoding` in an abstract way.

1515

16+* Added `UntaggedValue` to `SumEncoding`

17+

1618* Export `decodeWith`, `decodeStrictWith`, `eitherDecodeWith`, and

1719 `eitherDecodeStrictWith` from `Data.Aeson.Parser`. This allows

1820 decoding using explicit parsers instead of using `FromJSON`

tests/Encoders.hs+22

@@ -232,6 +232,28 @@ gSomeTypeToJSONOmitNothingFields = genericToJSON optsOmitNothingFields

232232gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding

233233gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields

234234

235+-------------------------------------------------------------------------------

236+-- EitherTextInt encoders/decodes

237+-------------------------------------------------------------------------------

238+

239+thEitherTextIntToJSONUntaggedValue :: EitherTextInt -> Value

240+thEitherTextIntToJSONUntaggedValue = $(mkToJSON optsUntaggedValue ''EitherTextInt)

241+

242+thEitherTextIntToEncodingUntaggedValue :: EitherTextInt -> Encoding

243+thEitherTextIntToEncodingUntaggedValue = $(mkToEncoding optsUntaggedValue ''EitherTextInt)

244+

245+thEitherTextIntParseJSONUntaggedValue :: Value -> Parser EitherTextInt

246+thEitherTextIntParseJSONUntaggedValue = $(mkParseJSON optsUntaggedValue ''EitherTextInt)

247+

248+

249+gEitherTextIntToJSONUntaggedValue :: EitherTextInt -> Value

250+gEitherTextIntToJSONUntaggedValue = genericToJSON optsUntaggedValue

251+

252+gEitherTextIntToEncodingUntaggedValue :: EitherTextInt -> Encoding

253+gEitherTextIntToEncodingUntaggedValue = genericToEncoding optsUntaggedValue

254+

255+gEitherTextIntParseJSONUntaggedValue :: Value -> Parser EitherTextInt

256+gEitherTextIntParseJSONUntaggedValue = genericParseJSON optsUntaggedValue

235257

236258--------------------------------------------------------------------------------

237259-- Approx encoders/decoders

tests/Instances.hs+8

@@ -155,6 +155,14 @@ instance Arbitrary a => Arbitrary (SomeType a) where

155155 , Record <$> arbitrary <*> arbitrary <*> arbitrary

156156 ]

157157

158+instance Arbitrary EitherTextInt where

159+ arbitrary = oneof

160+ [ LeftBool <$> arbitrary

161+ , RightInt <$> arbitrary

162+ , BothTextInt <$> arbitrary <*> arbitrary

163+ , pure NoneNullary

164+ ]

165+

158166instance Arbitrary (GADT String) where

159167 arbitrary = GADT <$> arbitrary

160168

tests/Options.hs+5

@@ -34,3 +34,8 @@ optsOmitNothingFields :: Options

3434optsOmitNothingFields = optsDefault

3535 { omitNothingFields = True

3636 }

37+

38+optsUntaggedValue :: Options

39+optsUntaggedValue = optsDefault

40+ { sumEncoding = UntaggedValue

41+ }

tests/Properties.hs+24

@@ -172,6 +172,16 @@ isObjectWithSingleField :: Value -> Bool

172172isObjectWithSingleField (Object obj) = H.size obj == 1

173173isObjectWithSingleField _ = False

174174

175+-- | is untaggedValue of EitherTextInt

176+isUntaggedValueETI :: Value -> Bool

177+isUntaggedValueETI (String s)

178+ | s == "nonenullary" = True

179+isUntaggedValueETI (Bool _) = True

180+isUntaggedValueETI (Number _) = True

181+isUntaggedValueETI (Array a) = length a == 2

182+isUntaggedValueETI _ = False

183+

184+

175185--------------------------------------------------------------------------------

176186

177187

@@ -293,6 +303,10 @@ tests = testGroup "properties" [

293303 , testProperty "ObjectWithSingleField" (toParseJSON gNullaryParseJSONObjectWithSingleField gNullaryToJSONObjectWithSingleField)

294304 ]

295305 ]

306+ , testGroup "EitherTextInt" [

307+ testProperty "UntaggedValue" (isUntaggedValueETI . gEitherTextIntToJSONUntaggedValue)

308+ , testProperty "roundtrip" (toParseJSON gEitherTextIntParseJSONUntaggedValue gEitherTextIntToJSONUntaggedValue)

309+ ]

296310 , testGroup "SomeType" [

297311 testProperty "2ElemArray" (is2ElemArray . gSomeTypeToJSON2ElemArray)

298312 , testProperty "TaggedObject" (isTaggedObject . gSomeTypeToJSONTaggedObject)

@@ -325,6 +339,9 @@ tests = testGroup "properties" [

325339 , testProperty "ApproxDefault" $

326340 gApproxToJSONDefault `sameAs` gApproxToEncodingDefault

327341

342+ , testProperty "EitherTextInt UntaggedValue" $

343+ gEitherTextIntToJSONUntaggedValue `sameAs` gEitherTextIntToEncodingUntaggedValue

344+

328345 , testProperty "SomeType2ElemArray" $

329346 gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray

330347#if __GLASGOW_HASKELL__ >= 706

@@ -371,6 +388,10 @@ tests = testGroup "properties" [

371388 , testProperty "ObjectWithSingleField" (toParseJSON thNullaryParseJSONObjectWithSingleField thNullaryToJSONObjectWithSingleField)

372389 ]

373390 ]

391+ , testGroup "EitherTextInt" [

392+ testProperty "UntaggedValue" (isUntaggedValueETI . thEitherTextIntToJSONUntaggedValue)

393+ , testProperty "roundtrip" (toParseJSON thEitherTextIntParseJSONUntaggedValue thEitherTextIntToJSONUntaggedValue)

394+ ]

374395 , testGroup "SomeType" [

375396 testProperty "2ElemArray" (is2ElemArray . thSomeTypeToJSON2ElemArray)

376397 , testProperty "TaggedObject" (isTaggedObject . thSomeTypeToJSONTaggedObject)

@@ -418,6 +439,9 @@ tests = testGroup "properties" [

418439 , testProperty "ApproxDefault" $

419440 thApproxToJSONDefault `sameAs` thApproxToEncodingDefault

420441

442+ , testProperty "EitherTextInt UntaggedValue" $

443+ thEitherTextIntToJSONUntaggedValue `sameAs` thEitherTextIntToEncodingUntaggedValue

444+

421445 , testProperty "SomeType2ElemArray" $

422446 thSomeTypeToJSON2ElemArray `sameAs` thSomeTypeToEncoding2ElemArray

423447 , testProperty "SomeType2ElemArray unary" $

tests/Types.hs+9

@@ -65,6 +65,14 @@ data SomeType a = Nullary

6565 , testThree :: Maybe a

6666 } deriving (Eq, Show)

6767

68+-- Used for testing UntaggedValue SumEncoding

69+data EitherTextInt

70+ = LeftBool Bool

71+ | RightInt Int

72+ | BothTextInt Text Int

73+ | NoneNullary

74+ deriving (Eq, Show)

75+

6876data GADT a where

6977 GADT :: { gadt :: String } -> GADT String

7078 deriving Typeable

@@ -85,6 +93,7 @@ deriving instance Generic (SomeType a)

8593#if __GLASGOW_HASKELL__ >= 706

8694deriving instance Generic1 SomeType

8795#endif

96+deriving instance Generic EitherTextInt

8897

8998failure :: Show a => String -> String -> a -> Property

9099failure func msg v = counterexample

tests/UnitTests.hs+17−2

@@ -15,11 +15,11 @@ import Instances ()

1515

1616import Control.Applicative (Const(..))

1717import Control.Monad (forM)

18−import Data.Aeson (FromJSONKeyFunction(..), FromJSONKey(..), decode, eitherDecode, encode, genericToJSON, genericToEncoding, object, FromJSON(..), withObject, (.=), (.:), (.:?), (.:!))

18+import Data.Aeson (FromJSONKeyFunction(..), FromJSONKey(..), decode, eitherDecode, encode, genericParseJSON, genericToJSON, genericToEncoding, object, FromJSON(..), withObject, (.=), (.:), (.:?), (.:!))

1919import Data.Aeson.Text (encodeToTextBuilder)

2020import Data.Aeson.Internal (JSONPathElement(..), formatError)

2121import Data.Aeson.TH (deriveJSON)

22−import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)

22+import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields, Options(..), SumEncoding(..))

2323import Data.Char (toUpper)

2424import Data.Hashable (hash)

2525import Data.List.NonEmpty (NonEmpty(..))

@@ -108,6 +108,18 @@ camelFrom c s = let (p:ps) = split c s

108108 split c' s' = map L.unpack $ L.split c' $ L.pack s'

109109 capitalize t = toUpper (head t) : tail t

110110

111+

112+data MyEither a b = MyLeft a | MyRight b

113+ deriving (Generic, Show, Eq)

114+

115+instance (ToJSON a, ToJSON b) => ToJSON (MyEither a b) where

116+ toJSON = genericToJSON defaultOptions { sumEncoding = UntaggedValue }

117+ toEncoding = genericToEncoding defaultOptions { sumEncoding = UntaggedValue }

118+

119+instance (FromJSON a, FromJSON b) => FromJSON (MyEither a b) where

120+ parseJSON = genericParseJSON defaultOptions { sumEncoding = UntaggedValue }

121+

122+

111123data Wibble = Wibble {

112124 wibbleString :: String

113125 , wibbleInt :: Int

@@ -392,6 +404,9 @@ jsonExamples =

392404 , Example "Compose3' [] I [] Char" "[\"x\"]" (pure 'x' :: Compose3' [] I [] Char)

393405 , Example "Compose3' [] [] I Char" "[\"x\"]" (pure 'x' :: Compose3' [] [] I Char)

394406 , Example "Compose3' [] [] [] Char" "[[\"x\"]]" (pure 'x' :: Compose3' [] [] [] Char)

407+

408+ , Example "MyEither Int String: Left" "42" (MyLeft 42 :: MyEither Int String)

409+ , Example "MyEither Int String: Right" "\"foo\"" (MyRight "foo" :: MyEither Int String)

395410 ]

396411

397412