4494374 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Add tagSingleConstructors option

4494374lyxia10 years ago

Data/Aeson/TH.hs+5−3

compare with master

unifiedsplit

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

341 matches tjs = case cons of

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

343 -- forgotten.

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

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

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

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

347 | con <- cons

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

384 matches tes = case cons of

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

386 -- forgotten.

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

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

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

389 -- constructors are nullary.

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

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

792

793 where

794 lamExpr value pjs = case cons of

795+ [con]

796+ | not (tagSingleConstructors opts)

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

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

796 _ | sumEncoding opts == UntaggedValue

798 _ | sumEncoding opts == UntaggedValue

797 -> parseUntaggedValue pjs cons value

799 -> parseUntaggedValue pjs cons value

798 | otherwise

800 | otherwise

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

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

524 , unwrapUnaryRecords :: Bool

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

526 -- field, like a newtype.

527+ , tagSingleConstructors :: Bool

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

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

527 }

530 }

528

531

529instance Show Options where

532instance Show Options where

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

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

531 "Options {"

534 "Options {"

532 ++ intercalate ", "

535 ++ intercalate ", "

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

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

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

536 , "omitNothingFields = " ++ show o

539 , "omitNothingFields = " ++ show o

537 , "sumEncoding = " ++ show s

540 , "sumEncoding = " ++ show s

538 , "unwrapUnaryRecords = " ++ show u

541 , "unwrapUnaryRecords = " ++ show u

542+ , "tagSingleConstructors = " ++ show t

539 ]

543 ]

540 ++ "}"

544 ++ "}"

541

545

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

589-- , 'omitNothingFields' = False

593-- , 'omitNothingFields' = False

590-- , 'sumEncoding' = 'defaultTaggedObject'

594-- , 'sumEncoding' = 'defaultTaggedObject'

591-- , 'unwrapUnaryRecords' = False

595-- , 'unwrapUnaryRecords' = False

596+-- , 'tagSingleConstructors' = False

592-- }

597-- }

593-- @

598-- @

594defaultOptions :: Options

599defaultOptions :: Options

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

599 , omitNothingFields = False

604 , omitNothingFields = False

600 , sumEncoding = defaultTaggedObject

605 , sumEncoding = defaultTaggedObject

601 , unwrapUnaryRecords = False

606 , unwrapUnaryRecords = False

607+ , tagSingleConstructors = False

602 }

608 }

603

609

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

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

tests/UnitTests.hs+1

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

493 ++ ", omitNothingFields = False"

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

495 ++ ", unwrapUnaryRecords = False"

496+ ++ ", tagSingleConstructors = False"

496 ++ "}")

497 ++ "}")

497 (show defaultOptions)

498 (show defaultOptions)

498

499