9e30cc9 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Merge pull request #758 from RyanGlScott/master

9e30cc9Adam Bergmark7 years ago

Data/Aeson/TH.hs+37−13

compare with master

unifiedsplit

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

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