th-abstraction 0.2.5.0 → 0.2.6.0
raw patch · 4 files changed
+57/−18 lines, 4 filesdep ~template-haskellPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: template-haskell
API changes (from Hackage documentation)
Files
- ChangeLog.md +4/−0
- src/Language/Haskell/TH/Datatype.hs +18/−10
- test/Main.hs +34/−7
- th-abstraction.cabal +1/−1
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for th-abstraction +## 0.2.6.0 -- 2017-09-04+* Fix bug in which `applySubstitution` and `freeVariables` would ignore+ type variables in the kinds of type variable binders.+ ## 0.2.5.0 * Added `pragLineDCompat`, `newtypeDCompat` and `tySynInstDCompat`
src/Language/Haskell/TH/Datatype.hs view
@@ -812,17 +812,18 @@ mightHaveBeenEtaReduced ts = case unsnoc ts of Nothing -> False- Just (initTs,lastT) ->+ Just (initTs :|- lastT) -> case varTName lastT of Nothing -> False Just n -> not (n `elem` freeVariables initTs) - -- If the list is empty returns 'Nothing', otherwise returns the 'init' and the 'last'.- unsnoc :: [a] -> Maybe ([a], a)+ -- If the list is empty returns 'Nothing', otherwise returns the+ -- 'init' and the 'last'.+ unsnoc :: [a] -> Maybe (NonEmptySnoc a) unsnoc [] = Nothing- unsnoc [x] = Just ([], x)- unsnoc (x:xs) = Just (x:a, b)- where Just (a,b) = unsnoc xs+ unsnoc (x:xs) = case unsnoc xs of+ Just (a :|- b) -> Just ((x:a) :|- b)+ Nothing -> Just ([] :|- x) -- If a Type is a VarT, find Just its Name. Otherwise, return Nothing. varTName :: Type -> Maybe Name@@ -1182,9 +1183,14 @@ applySubstitution subst = go where go (ForallT tvs context t) =- let subst' = foldl' (flip Map.delete) subst (map tvName tvs) in- ForallT tvs (applySubstitution subst' context)- (applySubstitution subst' t)+ let subst' = foldl' (flip Map.delete) subst (map tvName tvs)++ mapTvbKind :: (Kind -> Kind) -> TyVarBndr -> TyVarBndr+ mapTvbKind f (PlainTV n) = PlainTV n+ mapTvbKind f (KindedTV n k) = KindedTV n (f k) in+ ForallT (map (mapTvbKind (applySubstitution subst')) tvs)+ (applySubstitution subst' context)+ (applySubstitution subst' t) go (AppT f x) = AppT (go f) (go x) go (SigT t k) = SigT (go t) (applySubstitution subst k) -- k could be Kind go (VarT v) = Map.findWithDefault (VarT v) v subst@@ -1198,7 +1204,9 @@ freeVariables t = case t of ForallT tvs context t' ->- (freeVariables context `union` freeVariables t')+ (concatMap (freeVariables . tvKind) tvs+ `union` freeVariables context+ `union` freeVariables t') \\ map tvName tvs AppT f x -> freeVariables f `union` freeVariables x SigT t' k -> freeVariables t' `union` freeVariables k
test/Main.hs view
@@ -23,19 +23,24 @@ module Main (main) where #if __GLASGOW_HASKELL__ >= 704-import Control.Monad (zipWithM_)+import Control.Monad (zipWithM_) #endif +#if MIN_VERSION_template_haskell(2,8,0)+import Control.Monad (unless)+import qualified Data.Map as Map+#endif+ #if MIN_VERSION_base(4,7,0)-import Data.Type.Equality ((:~:)(..))+import Data.Type.Equality ((:~:)(..)) #endif -import Language.Haskell.TH-import Language.Haskell.TH.Datatype-import Language.Haskell.TH.Lib (starK)+import Language.Haskell.TH+import Language.Haskell.TH.Datatype+import Language.Haskell.TH.Lib (starK) -import Harness-import Types+import Harness+import Types -- | Test entry point. Tests will pass or fail at compile time. main :: IO ()@@ -69,6 +74,9 @@ #if MIN_VERSION_base(4,7,0) importedEqualityTest #endif+#if MIN_VERSION_template_haskell(2,8,0)+ kindSubstTest+#endif adt1Test :: IO () adt1Test =@@ -578,4 +586,23 @@ , constructorVariant = NormalConstructor } ] } )+#endif++#if MIN_VERSION_template_haskell(2,8,0)+kindSubstTest :: IO ()+kindSubstTest =+ $(do k1 <- newName "k1"+ k2 <- newName "k2"+ a <- newName "a"+ let ty = ForallT [KindedTV a (VarT k1)] [] (VarT a)+ substTy = applySubstitution (Map.singleton k1 (VarT k2)) ty++ checkFreeVars :: Type -> [Name] -> Q ()+ checkFreeVars t freeVars =+ unless (freeVariables t == freeVars) $+ fail $ "free variables of " ++ show t ++ " should be " ++ show freeVars++ checkFreeVars ty [k1]+ checkFreeVars substTy [k2]+ [| return () |]) #endif
th-abstraction.cabal view
@@ -1,5 +1,5 @@ name: th-abstraction-version: 0.2.5.0+version: 0.2.6.0 synopsis: Nicer interface for reified information about data types description: This package normalizes variations in the interface for inspecting datatype information via Template Haskell