474932b..master · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

4 files changed+28−72

since splitsnapshots

unifiedsplit

Data/Aeson.hs+2−2 Data/Aeson/TH.hs+13−37 Data/Aeson/Types/Internal.hs+13−25 tests/UnitTests.hs−8

Data/Aeson.hs+2−2

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

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

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

259259eitherDecodeFileStrict =

260− fmap eitherDecodeStrict . B.readFile

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

261261{-# INLINE eitherDecodeFileStrict #-}

262262

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

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

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

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

276276eitherDecodeFileStrict' =

277− fmap eitherDecodeStrict' . B.readFile

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

278278{-# INLINE eitherDecodeFileStrict' #-}

279279

280280-- $use

Data/Aeson/TH.hs+13−37

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

13041304 tyVarNames :: [Name]

13051305 tyVarNames = M.keys tvMap

13061306

1307− itf <- isInTypeFamilyApp tyVarNames tyCon tyArgs

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

1307+ itf <- isTyFamily tyCon

1308+ if any (`mentionsName` tyVarNames) lhsArgs

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

13091310 then outOfPlaceTyVarError jc conName

13101311 else if any (`mentionsName` tyVarNames) rhsArgs

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

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

16561657isTyVar (SigT t _) = isTyVar t

16571658isTyVar _ = False

16581659

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

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

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

1677− info <- reify tcName

1678− case info of

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

1661+isTyFamily :: Type -> Q Bool

1662+isTyFamily (ConT n) = do

1663+ info <- reify n

1664+ return $ case info of

16791665#if MIN_VERSION_template_haskell(2,11,0)

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

1681− -> withinFirstArgs bndrs

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

1683− -> withinFirstArgs bndrs

1666+ FamilyI OpenTypeFamilyD{} _ -> True

16841667#else

1685− FamilyI (FamilyD TypeFam _ bndrs _) _

1686− -> withinFirstArgs bndrs

1687− FamilyI (ClosedTypeFamilyD _ bndrs _ _) _

1688− -> withinFirstArgs bndrs

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

16891669#endif

1690− _ -> return False

1691− where

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

1670+ FamilyI ClosedTypeFamilyD{} _ -> True

1671+ _ -> False

1672+isTyFamily _ = return False

16971673

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

16991675unSigT :: Type -> Type

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

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

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

582582 -- follow the `sumEncoding`.

583583 , omitNothingFields :: Bool

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

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

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

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

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

587587 --

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

592588 -- === Note

593589 --

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

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

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

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

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

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

598594 -- specialized upfront in the instance.

599595 --

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

601− --

602596 -- ==== __Example__

603597 --

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

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

606600 --

607601 -- @

608− -- data Fruit a = Fruit

602+ -- data Fruit a =

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

610604 -- , oranges :: 'Maybe' Int

611− -- } deriving 'Generic'

605+ -- }

606+ --

607+ -- options :: 'Options'

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

612609 --

613610 -- -- apples required, oranges optional

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

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

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

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

616614 --

617615 -- -- apples optional, oranges optional

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

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

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

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

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

631619 -- @

632620 , sumEncoding :: SumEncoding

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

tests/UnitTests.hs−8

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

55{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE ScopedTypeVariables #-}

77{-# LANGUAGE TemplateHaskell #-}

8−{-# LANGUAGE TypeFamilies #-}

98{-# LANGUAGE QuasiQuotes #-}

109

1110-- For Data.Aeson.Types.camelTo

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

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

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

750749

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−

756750deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord

757751

758752deriveToJSON defaultOptions ''Foo

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

764758deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

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

766760deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

767−

768−deriveToJSON1 defaultOptions ''Newtype757