dependent-sum-template 0.1.0.3 → 0.1.1.0
raw patch · 4 files changed
+33/−18 lines, 4 filesdep +th-abstractionPVP ok
version bump matches the API change (PVP)
Dependencies added: th-abstraction
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−1
- dependent-sum-template.cabal +9/−5
- src/Data/Dependent/Sum/TH/Internal.hs +13/−5
- test/test.hs +6/−7
ChangeLog.md view
@@ -1,4 +1,8 @@-# Revision history for dependent-sum+# Revision history for dependent-sum-template++## 0.1.1.0 - 2021-11-25++* Support GHC 9.0 ## 0.1.0.3 - 2020-03-24
dependent-sum-template.cabal view
@@ -1,12 +1,12 @@ name: dependent-sum-template-version: 0.1.0.3+version: 0.1.1.0 stability: experimental -cabal-version: >= 1.8+cabal-version: >= 1.10 build-type: Simple author: James Cook <mokus@deepbondi.net>-maintainer: Ryan Trinkle <ryan.trinkle@obsidian.systems>+maintainer: Obsidian Systems, LLC <maintainer@obsidian.systems> license: PublicDomain homepage: https://github.com/obsidiansystems/dependent-sum @@ -18,7 +18,8 @@ GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5,- GHC == 8.8.3+ GHC == 8.8.3,+ GHC == 9.0.1 extra-source-files: ChangeLog.md @@ -30,19 +31,22 @@ if impl(ghc < 7.10) buildable: False hs-source-dirs: src+ default-language: Haskell2010 exposed-modules: Data.GADT.Compare.TH Data.GADT.Show.TH other-modules: Data.Dependent.Sum.TH.Internal build-depends: base >= 3 && <5, dependent-sum >= 0.4.1 && < 0.8, template-haskell,- th-extras >= 0.0.0.2+ th-extras >= 0.0.0.2,+ th-abstraction test-suite test if impl(ghc < 8.0) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: test+ default-language: Haskell2010 main-is: test.hs build-depends: base , constraints-extras
src/Data/Dependent/Sum/TH/Internal.hs view
@@ -10,6 +10,7 @@ import Control.Monad import Language.Haskell.TH import Language.Haskell.TH.Extras+import Language.Haskell.TH.Datatype.TyVarBndr classHeadToParams :: Type -> (Name, [Type]) classHeadToParams t = (h, reverse reversedParams)@@ -24,8 +25,11 @@ -- Invoke the deriver for the given class instance. We assume that the type -- we're deriving for is always the first typeclass parameter, if there are -- multiple.-deriveForDec :: Name -> (Q Type -> Q Type) -> ([TyVarBndr] -> [Con] -> Q Dec) -> Dec -> Q [Dec]-deriveForDec className _ f (InstanceD overlaps cxt classHead decs) = do+deriveForDec :: Name -> (Q Type -> Q Type) -> ([TyVarBndrSpec] -> [Con] -> Q Dec) -> Dec -> Q [Dec]+deriveForDec className makeClassHead f dec = deriveForDec' className makeClassHead (f . changeTVFlags specifiedSpec) dec++deriveForDec' :: Name -> (Q Type -> Q Type) -> ([TyVarBndrUnit] -> [Con] -> Q Dec) -> Dec -> Q [Dec]+deriveForDec' className _ f (InstanceD overlaps cxt classHead decs) = do let (givenClassName, firstParam : _) = classHeadToParams classHead when (givenClassName /= className) $ fail $ "while deriving " ++ show className ++ ": wrong class name in prototype declaration: " ++ show givenClassName@@ -36,20 +40,24 @@ dec <- f bndrs cons return [InstanceD overlaps cxt classHead [dec]] _ -> fail $ "while deriving " ++ show className ++ ": the name of an algebraic data type constructor is required"-deriveForDec className makeClassHead f (DataD dataCxt name bndrs _ cons _) = return <$> inst+deriveForDec' className makeClassHead f (DataD dataCxt name bndrs _ cons _) = return <$> inst where inst = instanceD (cxt (map return dataCxt)) (makeClassHead $ conT name) [dec] dec = f bndrs cons #if __GLASGOW_HASKELL__ >= 808-deriveForDec className makeClassHead f (DataInstD dataCxt tvBndrs ty _ cons _) = return <$> inst+deriveForDec' className makeClassHead f (DataInstD dataCxt tvBndrs ty _ cons _) = return <$> inst #else-deriveForDec className makeClassHead f (DataInstD dataCxt name tyArgs _ cons _) = return <$> inst+deriveForDec' className makeClassHead f (DataInstD dataCxt name tyArgs _ cons _) = return <$> inst #endif where inst = instanceD (cxt (map return dataCxt)) clhead [dec] #if __GLASGOW_HASKELL__ >= 808 clhead = makeClassHead $ return $ initTy ty+#if __GLASGOW_HASKELL__ >= 900+ bndrs = [PlainTV v x | PlainTV v x <- maybe [] id tvBndrs]+#else bndrs = [PlainTV v | PlainTV v <- maybe [] id tvBndrs]+#endif initTy (AppT ty _) = ty #else clhead = makeClassHead $ foldl1 appT (map return $ (ConT name : init tyArgs))
test/test.hs view
@@ -96,23 +96,22 @@ deriveGEq ''Foo deriveGEq ''Bar-deriveGEq ''Baz deriveGEq ''Qux+deriveGEq ''Baz deriveGCompare ''Foo deriveGCompare ''Bar-deriveGCompare ''Baz deriveGCompare ''Qux+deriveGCompare ''Baz +deriveGShow ''Foo instance Show (Foo a) where showsPrec = gshowsPrec+deriveGShow ''Bar instance Show (Bar a) where showsPrec = gshowsPrec-instance Show (Baz a) where showsPrec = gshowsPrec+deriveGShow ''Qux instance Show (Qux a) where showsPrec = gshowsPrec--deriveGShow ''Foo-deriveGShow ''Bar deriveGShow ''Baz-deriveGShow ''Qux+instance Show (Baz a) where showsPrec = gshowsPrec data Squudge a where E :: Ord a => Foo a -> Squudge a