aeson-gadt-th 0.2.5.0 → 0.2.5.1
raw patch · 4 files changed
+46/−46 lines, 4 filesdep −th-extrasdep ~basedep ~template-haskelldep ~th-abstractionPVP ok
version bump matches the API change (PVP)
Dependencies removed: th-extras
Dependency ranges changed: base, template-haskell, th-abstraction
API changes (from Hackage documentation)
Files
- ChangeLog.md +13/−7
- aeson-gadt-th.cabal +4/−5
- src/Data/Aeson/GADT/TH.hs +5/−10
- test/Test.hs +24/−24
ChangeLog.md view
@@ -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
aeson-gadt-th.cabal view
@@ -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 <https://github.com/obsidiansystems/aeson-gadt-th/blob/master/README.md README.md> 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
src/Data/Aeson/GADT/TH.hs view
@@ -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)
test/Test.hs view
@@ -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