master..474932b · typeable/aeson

git.iko.soy/typeable/aeson

on 474932b help sign in

Data/Aeson.hs+2−2

since splitsnapshots

unifiedsplit

@@ -257,7 +257,7 @@ eitherDecodeStrict =

257-- | Like 'decodeFileStrict' but returns an error message when decoding fails.

258eitherDecodeFileStrict :: (FromJSON a) => FilePath -> IO (Either String a)

259eitherDecodeFileStrict =

260− fmap (eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON) . B.readFile

260+ fmap eitherDecodeStrict . B.readFile

261{-# INLINE eitherDecodeFileStrict #-}

262

263-- | Like 'decode'' but returns an error message when decoding fails.

@@ -274,7 +274,7 @@ eitherDecodeStrict' =

274-- | Like 'decodeFileStrict'' but returns an error message when decoding fails.

275eitherDecodeFileStrict' :: (FromJSON a) => FilePath -> IO (Either String a)

276eitherDecodeFileStrict' =

277− fmap (eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON) . B.readFile

277+ fmap eitherDecodeStrict' . B.readFile

278{-# INLINE eitherDecodeFileStrict' #-}

279

280-- $use

Data/Aeson/TH.hs+37−13

@@ -1304,9 +1304,8 @@ dispatchFunByType jc jf conName tvMap list ty = do

1304 tyVarNames :: [Name]

1305 tyVarNames = M.keys tvMap

1306

1307− itf <- isTyFamily tyCon

1307+ itf <- isInTypeFamilyApp tyVarNames tyCon tyArgs

1308− if any (`mentionsName` tyVarNames) lhsArgs

1308+ if any (`mentionsName` tyVarNames) lhsArgs || itf

1309− || itf && any (`mentionsName` tyVarNames) tyArgs

1310 then outOfPlaceTyVarError jc conName

1309 then outOfPlaceTyVarError jc conName

1311 else if any (`mentionsName` tyVarNames) rhsArgs

1310 else if any (`mentionsName` tyVarNames) rhsArgs

1312 then appsE $ varE (jsonFunValOrListName list jf $ toEnum numLastArgs)

1311 then appsE $ varE (jsonFunValOrListName list jf $ toEnum numLastArgs)

@@ -1657,19 +1656,44 @@ isTyVar (VarT _) = True

1657isTyVar (SigT t _) = isTyVar t

1656isTyVar (SigT t _) = isTyVar t

1658isTyVar _ = False

1657isTyVar _ = False

1659

1658

1660−-- | Is the given type a type family constructor (and not a data family constructor)?

1659+-- | Detect if a Name in a list of provided Names occurs as an argument to some

1661−isTyFamily :: Type -> Q Bool

1660+-- type family. This makes an effort to exclude /oversaturated/ arguments to

1662−isTyFamily (ConT n) = do

1661+-- type families. For instance, if one declared the following type family:

1662+--

1663+-- @

1664+-- type family F a :: Type -> Type

1665+-- @

1666+--

1667+-- Then in the type @F a b@, we would consider @a@ to be an argument to @F@,

1668+-- but not @b@.

1669+isInTypeFamilyApp :: [Name] -> Type -> [Type] -> Q Bool

1670+isInTypeFamilyApp names tyFun tyArgs =

1671+ case tyFun of

1672+ ConT tcName -> go tcName

1673+ _ -> return False

1674+ where

1675+ go :: Name -> Q Bool

1676+ go tcName = do

1663− info <- reify n

1677+ info <- reify tcName

1664− return $ case info of

1678+ case info of

1665#if MIN_VERSION_template_haskell(2,11,0)

1679#if MIN_VERSION_template_haskell(2,11,0)

1666− FamilyI OpenTypeFamilyD{} _ -> True

1680+ FamilyI (OpenTypeFamilyD (TypeFamilyHead _ bndrs _ _)) _

1681+ -> withinFirstArgs bndrs

1682+ FamilyI (ClosedTypeFamilyD (TypeFamilyHead _ bndrs _ _) _) _

1683+ -> withinFirstArgs bndrs

1667#else

1684#else

1668− FamilyI (FamilyD TypeFam _ _ _) _ -> True

1685+ FamilyI (FamilyD TypeFam _ bndrs _) _

1686+ -> withinFirstArgs bndrs

1687+ FamilyI (ClosedTypeFamilyD _ bndrs _ _) _

1688+ -> withinFirstArgs bndrs

1669#endif

1689#endif

1670− FamilyI ClosedTypeFamilyD{} _ -> True

1690+ _ -> return False

1671− _ -> False

1691+ where

1672−isTyFamily _ = return False

1692+ withinFirstArgs :: [a] -> Q Bool

1693+ withinFirstArgs bndrs =

1694+ let firstArgs = take (length bndrs) tyArgs

1695+ argFVs = freeVariables firstArgs

1696+ in return $ any (`elem` argFVs) names

1673

1697

1674-- | Peel off a kind signature from a Type (if it has one).

1698-- | Peel off a kind signature from a Type (if it has one).

1675unSigT :: Type -> Type

1699unSigT :: Type -> Type

Data/Aeson/Types/Internal.hs+25−13

@@ -581,41 +581,53 @@ data Options = Options

581 -- the constructor tag. If 'False' the encoding will always

582 -- follow the `sumEncoding`.

583 , omitNothingFields :: Bool

584− -- ^ If 'True' record fields with a 'Nothing' value will be

584+ -- ^ If 'True', record fields with a 'Nothing' value will be

585− -- omitted from the resulting object. If 'False' the resulting

585+ -- omitted from the resulting object. If 'False', the resulting

586 -- object will include those fields mapping to @null@.

587 --

588+ -- Note that this /does not/ affect parsing: 'Maybe' fields are

589+ -- optional regardless of the value of 'omitNothingFields', subject

590+ -- to the note below.

591+ --

588 -- === Note

592 -- === Note

589 --

593 --

590 -- Setting 'omitNothingFields' to 'True' only affects fields which are of

594 -- Setting 'omitNothingFields' to 'True' only affects fields which are of

591− -- type 'Maybe' /uniformly/ in the 'ToJSON' or 'FromJSON' instance. In

595+ -- type 'Maybe' /uniformly/ in the 'ToJSON' instance.

592− -- particular, if the type of a field is declared as a type variable, it

596+ -- In particular, if the type of a field is declared as a type variable, it

593 -- will not be omitted from the JSON object, unless the field is

597 -- will not be omitted from the JSON object, unless the field is

594 -- specialized upfront in the instance.

598 -- specialized upfront in the instance.

595 --

599 --

600+ -- The same holds for 'Maybe' fields being optional in the 'FromJSON' instance.

601+ --

596 -- ==== __Example__

602 -- ==== __Example__

597 --

603 --

598 -- The generic instance for the following type @Fruit@ depends on whether

604 -- The generic instance for the following type @Fruit@ depends on whether

599 -- the instance head is @Fruit a@ or @Fruit (Maybe a)@.

605 -- the instance head is @Fruit a@ or @Fruit (Maybe a)@.

600 --

606 --

601 -- @

607 -- @

602− -- data Fruit a =

608+ -- data Fruit a = Fruit

603 -- { apples :: a -- A field whose type is a type variable.

609 -- { apples :: a -- A field whose type is a type variable.

604 -- , oranges :: 'Maybe' Int

610 -- , oranges :: 'Maybe' Int

605− -- }

611+ -- } deriving 'Generic'

606− --

607− -- options :: 'Options'

608− -- options = 'defaultOptions' { 'omitNothingFields' = 'True' }

609 --

612 --

610 -- -- apples required, oranges optional

613 -- -- apples required, oranges optional

611 -- -- Even if 'Data.Aeson.fromJSON' is then specialized to (Fruit ('Maybe' a)).

614 -- -- Even if 'Data.Aeson.fromJSON' is then specialized to (Fruit ('Maybe' a)).

612− -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit a) where

615+ -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit a)

613− -- 'Data.Aeson.fromJSON' = 'Data.Aeson.genericFromJSON' options

614 --

616 --

615 -- -- apples optional, oranges optional

617 -- -- apples optional, oranges optional

616 -- -- In this instance, the field apples is uniformly of type ('Maybe' a).

618 -- -- In this instance, the field apples is uniformly of type ('Maybe' a).

617− -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit ('Maybe' a)) where

619+ -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit ('Maybe' a))

618− -- 'Data.Aeson.fromJSON' = 'Data.Aeson.genericFromJSON' options

620+ --

621+ -- options :: 'Options'

622+ -- options = 'defaultOptions' { 'omitNothingFields' = 'True' }

623+ --

624+ -- -- apples always present in the output, oranges is omitted if 'Nothing'

625+ -- instance 'Data.Aeson.ToJSON' a => 'Data.Aeson.ToJSON' (Fruit a) where

626+ -- 'Data.Aeson.toJSON' = 'Data.Aeson.genericToJSON' options

627+ --

628+ -- -- both apples and oranges are omitted if 'Nothing'

629+ -- instance 'Data.Aeson.ToJSON' a => 'Data.Aeson.ToJSON' (Fruit ('Maybe' a)) where

630+ -- 'Data.Aeson.toJSON' = 'Data.Aeson.genericToJSON' options

619 -- @

631 -- @

620 , sumEncoding :: SumEncoding

632 , sumEncoding :: SumEncoding

621 -- ^ Specifies how to encode constructors of a sum datatype.

633 -- ^ Specifies how to encode constructors of a sum datatype.

tests/UnitTests.hs+8

@@ -5,6 +5,7 @@

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE TemplateHaskell #-}

8+{-# LANGUAGE TypeFamilies #-}

8{-# LANGUAGE QuasiQuotes #-}

9{-# LANGUAGE QuasiQuotes #-}

10-- For Data.Aeson.Types.camelTo

11-- For Data.Aeson.Types.camelTo

@@ -747,6 +748,11 @@ bigNaturalKeyDecoding =

747 (Left "Error in $['1e2000']: found a number with exponent 2000, but it must not be greater than 1024")

748 (Left "Error in $['1e2000']: found a number with exponent 2000, but it must not be greater than 1024")

748 ((eitherDecode :: L.ByteString -> Either String (HashMap Natural Value)) "{ \"1e2000\": null }")

749 ((eitherDecode :: L.ByteString -> Either String (HashMap Natural Value)) "{ \"1e2000\": null }")

749

750

751+-- A regression test for: https://github.com/bos/aeson/issues/757

752+type family Fam757 :: * -> *

753+type instance Fam757 = Maybe

754+newtype Newtype757 a = MkNewtype757 (Fam757 a)

755+

750deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord

756deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord

751

757

752deriveToJSON defaultOptions ''Foo

758deriveToJSON defaultOptions ''Foo

@@ -758,3 +764,5 @@ deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFields

758deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

764deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

759deriveJSON defaultOptions{tagSingleConstructors=True,rejectUnknownFields=True} ''UnknownFieldsUnaryTagged

765deriveJSON defaultOptions{tagSingleConstructors=True,rejectUnknownFields=True} ''UnknownFieldsUnaryTagged

760deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

766deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

767+

768+deriveToJSON1 defaultOptions ''Newtype757