4494374 · typeable/aeson

git.iko.soy/typeable/aeson

Add tagSingleConstructors option

commit4494374b472310c0f9ef28a9e026e2b9bcfbdf84 authorlyxia <lysxia@gmail.com> dateSat 18 Mar 2017, 17:38 (10 years ago) parent0afa912

3 files changed+13−4

compare with master

unifiedsplit

Data/Aeson/TH.hs+5−3 Data/Aeson/Types/Internal.hs+7−1 tests/UnitTests.hs+1

Data/Aeson/TH.hs+5−3

@@ -341,7 +341,7 @@ consToValue jc opts cons = do

341341 matches tjs = case cons of

342342 -- A single constructor is directly encoded. The constructor itself may be

343343 -- forgotten.

344− [con] -> [argsToValue jc tjs opts False con]

344+ [con] | not (tagSingleConstructors opts) -> [argsToValue jc tjs opts False con]

345345 _ | allNullaryToStringTag opts && all isNullary cons ->

346346 [ match (conP conName []) (normalB $ conStr opts conName) []

347347 | con <- cons

@@ -384,7 +384,7 @@ consToEncoding jc opts cons = do

384384 matches tes = case cons of

385385 -- A single constructor is directly encoded. The constructor itself may be

386386 -- forgotten.

387− [con] -> [argsToEncoding jc tes opts False con]

387+ [con] | not (tagSingleConstructors opts) -> [argsToEncoding jc tes opts False con]

388388 -- Encode just the name of the constructor of a sum type iff all the

389389 -- constructors are nullary.

390390 _ | allNullaryToStringTag opts && all isNullary cons ->

@@ -792,7 +792,9 @@ consFromJSON jc tName opts cons = do

792792

793793 where

794794 lamExpr value pjs = case cons of

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

795+ [con]

796+ | not (tagSingleConstructors opts)

797+ -> parseArgs jc pjs tName opts con (Right value)

796798 _ | sumEncoding opts == UntaggedValue

797799 -> parseUntaggedValue pjs cons value

798800 | otherwise

Data/Aeson/Types/Internal.hs+7−1

@@ -524,10 +524,13 @@ data Options = Options

524524 , unwrapUnaryRecords :: Bool

525525 -- ^ Hide the field name when a record constructor has only one

526526 -- field, like a newtype.

527+ , tagSingleConstructors :: Bool

528+ -- ^ Encode types with a single constructor as sums,

529+ -- so that `allNullaryToStringTag` and `sumEncoding` apply.

527530 }

528531

529532instance Show Options where

530− show (Options f c a o s u) =

533+ show (Options f c a o s u t) =

531534 "Options {"

532535 ++ intercalate ", "

533536 [ "fieldLabelModifier =~ " ++ show (f "exampleField")

@@ -536,6 +539,7 @@ instance Show Options where

536539 , "omitNothingFields = " ++ show o

537540 , "sumEncoding = " ++ show s

538541 , "unwrapUnaryRecords = " ++ show u

542+ , "tagSingleConstructors = " ++ show t

539543 ]

540544 ++ "}"

541545

@@ -589,6 +593,7 @@ data SumEncoding =

589593-- , 'omitNothingFields' = False

590594-- , 'sumEncoding' = 'defaultTaggedObject'

591595-- , 'unwrapUnaryRecords' = False

596+-- , 'tagSingleConstructors' = False

592597-- }

593598-- @

594599defaultOptions :: Options

@@ -599,6 +604,7 @@ defaultOptions = Options

599604 , omitNothingFields = False

600605 , sumEncoding = defaultTaggedObject

601606 , unwrapUnaryRecords = False

607+ , tagSingleConstructors = False

602608 }

603609

604610-- | Default 'TaggedObject' 'SumEncoding' options:

tests/UnitTests.hs+1

@@ -493,6 +493,7 @@ showOptions =

493493 ++ ", omitNothingFields = False"

494494 ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"

495495 ++ ", unwrapUnaryRecords = False"

496+ ++ ", tagSingleConstructors = False"

496497 ++ "}")

497498 (show defaultOptions)

498499