diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,36 +1,42 @@ # Revision history for aeson-gadt-th -## 0.2.5.0 +## 0.2.5.1 - 2022-01-04 +* Remove dependency on `th-extras`. We were just using a reexport (under a + different name) of something from `th-abstractions` anyways. +* Support GHC 9.0 + +## 0.2.5.0 - 2020-11-18 + * Support for GHC 8.10 * Support for aeson 1.5.* * Fix [#21](https://github.com/obsidiansystems/aeson-gadt-th/issues/21): deriveJSONGADT requires `toJSON` and `parseJSON` to be in scope * Fix [#25](https://github.com/obsidiansystems/aeson-gadt-th/issues/25): Test suite does not compile (on GHC 8.10) -## 0.2.4 +## 0.2.4 - 2020-10-21 * Support for GHC 8.8 -## 0.2.2 +## 0.2.2 - 2019-12-16 * Do a better job determining which variables are rigid when looking for instances * Unify discovered instance head with argument type and make the same substitution in the context that constrains the instance we're writing -## 0.2.1.2 +## 0.2.1.2 - 2019-10-10 * Add version bounds to cabal file -## 0.2.1.1 +## 0.2.1.1 - 2019-05-17 * Drop markdown-unlit in favor of "Bird"-style LHS to avoid some cross-compilation issues. -## 0.2.1.0 +## 0.2.1.0 - 2019-05-09 * Extend type variable substitution to handle all current cases in template-haskell. * Better deal with data constructors having an index that is polymorphic, but can be determined from the other type parameters. * Handle data constructors that are constrained by type classes. -## 0.2.0.0 +## 0.2.0.0 - 2019-03-28 * Add changelog * Add option to modify constructor tag in derived JSON diff --git a/aeson-gadt-th.cabal b/aeson-gadt-th.cabal --- a/aeson-gadt-th.cabal +++ b/aeson-gadt-th.cabal @@ -1,6 +1,6 @@ cabal-version: 1.24 name: aeson-gadt-th -version: 0.2.5.0 +version: 0.2.5.1 synopsis: Derivation of Aeson instances for GADTs category: JSON description: Template Haskell for generating ToJSON and FromJSON instances for GADTs. See for examples. @@ -20,14 +20,13 @@ library exposed-modules: Data.Aeson.GADT.TH - build-depends: base >= 4.8 && < 4.15 + build-depends: base >= 4.8 && < 4.16 , aeson >= 1.3 && < 1.6 , containers >= 0.5 && < 0.7 , dependent-sum >= 0.4 && < 0.8 , transformers >= 0.5 && < 0.6 - , template-haskell >= 2.11.0 && < 2.17 - , th-abstraction >= 0.2.8.0 && < 0.4 - , th-extras >= 0.0.0.4 && < 0.1 + , template-haskell >= 2.11.0 && < 2.18 + , th-abstraction >= 0.4 && < 0.5 if impl(ghc < 8.2) build-depends: dependent-sum < 0.6.2.2 hs-source-dirs: src diff --git a/src/Data/Aeson/GADT/TH.hs b/src/Data/Aeson/GADT/TH.hs --- a/src/Data/Aeson/GADT/TH.hs +++ b/src/Data/Aeson/GADT/TH.hs @@ -45,7 +45,7 @@ import Data.Some (Some(..)) import Language.Haskell.TH hiding (cxt) import Language.Haskell.TH.Datatype (ConstructorInfo(..), applySubstitution, datatypeCons, reifyDatatype, unifyTypes) -import Language.Haskell.TH.Extras (nameOfBinder) +import Language.Haskell.TH.Datatype.TyVarBndr (TyVarBndr_, tvName) #if MIN_VERSION_dependent_sum(0,5,0) #else @@ -56,14 +56,9 @@ -- Do not export this type family, it must remain empty. It's used as a way to trick GHC into not unifying certain type variables. type family Skolem :: k -> k -tyVarBndrName :: TyVarBndr -> Name -tyVarBndrName = \case - PlainTV n -> n - KindedTV n _ -> n - skolemize :: Set Name -> Type -> Type skolemize rigids t = case t of - ForallT bndrs cxt t' -> ForallT bndrs cxt (skolemize (Set.difference rigids (Set.fromList (map tyVarBndrName bndrs))) t') + ForallT bndrs cxt t' -> ForallT bndrs cxt (skolemize (Set.difference rigids (Set.fromList (map tvName bndrs))) t') AppT t1 t2 -> AppT (skolemize rigids t1) (skolemize rigids t2) SigT t1 k -> SigT (skolemize rigids t1) k VarT v -> if Set.member v rigids @@ -80,7 +75,7 @@ -- | Determine the type variables which occur freely in a type. freeTypeVariables :: Type -> Set Name freeTypeVariables t = case t of - ForallT bndrs _ t' -> Set.difference (freeTypeVariables t') (Set.fromList (map nameOfBinder bndrs)) + ForallT bndrs _ t' -> Set.difference (freeTypeVariables t') (Set.fromList (map tvName bndrs)) AppT t1 t2 -> Set.union (freeTypeVariables t1) (freeTypeVariables t2) SigT t1 _ -> freeTypeVariables t1 VarT n -> Set.singleton n @@ -123,7 +118,7 @@ makeTopVars tyConName = do (tyVarBndrs, kArity) <- tyConArity' tyConName extraVars <- replicateM kArity (newName "topvar") - return (map tyVarBndrName tyVarBndrs ++ extraVars) + return (map tvName tyVarBndrs ++ extraVars) deriveFromJSONGADT :: Name -> DecsQ deriveFromJSONGADT = deriveFromJSONGADTWithOptions defaultJSONGADTOptions @@ -271,7 +266,7 @@ -- its declaration, and the arity of the kind of type being defined (i.e. how many more arguments would -- need to be supplied in addition to the bound parameters in order to obtain an ordinary type of kind *). -- If the supplied 'Name' is anything other than a data or newtype, produces an error. -tyConArity' :: Name -> Q ([TyVarBndr], Int) +tyConArity' :: Name -> Q ([TyVarBndr_ ()], Int) tyConArity' n = reify n >>= return . \case TyConI (DataD _ _ ts mk _ _) -> (ts, maybe 0 kindArity mk) TyConI (NewtypeD _ _ ts mk _ _) -> (ts, maybe 0 kindArity mk) diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -23,6 +23,30 @@ pattern Some x = This x #endif +data Foo a where + Bar :: Char -> Foo Char + Baz :: Float -> Foo Float + +deriving instance Show (Foo a) +deriving instance Eq (Foo a) + +instance GShow Foo where gshowsPrec = showsPrec + +data Spam a where + Spam'Eggs :: Char -> Spam Char + Spam'Life :: Float -> Spam Float + +deriving instance Show (Spam a) +deriving instance Eq (Spam a) + +instance GShow Spam where gshowsPrec = showsPrec + +deriveJSONGADT ''Foo + +deriveJSONGADTWithOptions + (JSONGADTOptions { gadtConstructorModifier = drop 5 }) + ''Spam + main :: IO () main = hspec $ do describe "aeson-gadt-th" $ do @@ -47,27 +71,3 @@ `shouldMatchPattern_` (\case Success (Some (Spam'Life 1.2)) -> ()) (fromJSON [aesonQQ| ["bad", "input"] |] :: Result (Some Spam)) `shouldMatchPattern_` (\case Error "Expected tag to be one of [Eggs, Life] but got: bad" -> ()) - -data Foo a where - Bar :: Char -> Foo Char - Baz :: Float -> Foo Float - -deriving instance Show (Foo a) -deriving instance Eq (Foo a) - -instance GShow Foo where gshowsPrec = showsPrec - -data Spam a where - Spam'Eggs :: Char -> Spam Char - Spam'Life :: Float -> Spam Float - -deriving instance Show (Spam a) -deriving instance Eq (Spam a) - -instance GShow Spam where gshowsPrec = showsPrec - -deriveJSONGADT ''Foo - -deriveJSONGADTWithOptions - (JSONGADTOptions { gadtConstructorModifier = drop 5 }) - ''Spam