Hello community, here is the log from the commit of package ghc-th-abstraction for openSUSE:Factory checked in at 2020-03-09 14:17:02 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-th-abstraction (Old) and /work/SRC/openSUSE:Factory/.ghc-th-abstraction.new.26092 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-th-abstraction" Mon Mar 9 14:17:02 2020 rev:9 rq:780037 version:0.3.2.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-th-abstraction/ghc-th-abstraction.changes 2019-12-27 13:58:18.568801552 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-th-abstraction.new.26092/ghc-th-abstraction.changes 2020-03-09 14:17:06.754654080 +0100 @@ -1,0 +2,14 @@ +Fri Feb 7 08:06:47 UTC 2020 - [email protected] + +- Update th-abstraction to version 0.3.2.0. + ## 0.3.2.0 -- 2020-02-06 + * Support substituting into and extracting free variables from `ForallVisT`s + on `template-haskell-2.16.0.0` (GHC 8.10) or later. + * Fix a bug in which `freeVariables` could report duplicate kind variables when + they occur in the kinds of the type variable binders in a `ForallT`. + * Fix a bug in which `resolveInfixT` would not resolve `UInfixT`s occurring in + the kinds of type variable binders in a `ForallT`. + * Fix a bug in which the `TypeSubstitution ConstructorInfo` instance would not + detect free kind variables in the `constructorVars`. + +------------------------------------------------------------------- Old: ---- th-abstraction-0.3.1.0.tar.gz th-abstraction.cabal New: ---- th-abstraction-0.3.2.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-th-abstraction.spec ++++++ --- /var/tmp/diff_new_pack.Ugj5jg/_old 2020-03-09 14:17:07.422654520 +0100 +++ /var/tmp/diff_new_pack.Ugj5jg/_new 2020-03-09 14:17:07.426654523 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-th-abstraction # -# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2020 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,13 +19,12 @@ %global pkg_name th-abstraction %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.3.1.0 +Version: 0.3.2.0 Release: 0 Summary: Nicer interface for reified information about data types License: ISC URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-containers-devel BuildRequires: ghc-rpm-macros @@ -49,7 +48,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ th-abstraction-0.3.1.0.tar.gz -> th-abstraction-0.3.2.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.3.1.0/ChangeLog.md new/th-abstraction-0.3.2.0/ChangeLog.md --- old/th-abstraction-0.3.1.0/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 +++ new/th-abstraction-0.3.2.0/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,15 @@ # Revision history for th-abstraction +## 0.3.2.0 -- 2020-02-06 +* Support substituting into and extracting free variables from `ForallVisT`s + on `template-haskell-2.16.0.0` (GHC 8.10) or later. +* Fix a bug in which `freeVariables` could report duplicate kind variables when + they occur in the kinds of the type variable binders in a `ForallT`. +* Fix a bug in which `resolveInfixT` would not resolve `UInfixT`s occurring in + the kinds of type variable binders in a `ForallT`. +* Fix a bug in which the `TypeSubstitution ConstructorInfo` instance would not + detect free kind variables in the `constructorVars`. + ## 0.3.1.0 -- 2019-04-28 * Fix a bug which would cause data family information to be reified incorrectly with GHC 8.8+ in some situations. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.3.1.0/src/Language/Haskell/TH/Datatype.hs new/th-abstraction-0.3.2.0/src/Language/Haskell/TH/Datatype.hs --- old/th-abstraction-0.3.1.0/src/Language/Haskell/TH/Datatype.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/th-abstraction-0.3.2.0/src/Language/Haskell/TH/Datatype.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1168,7 +1168,6 @@ kindsOfFVsOfTypes = foldMap go where go :: Type -> Map Name Kind - go (ForallT {}) = error "`forall` type used in data family pattern" go (AppT t1 t2) = go t1 `Map.union` go t2 go (SigT t k) = let kSigs = @@ -1180,8 +1179,17 @@ in case t of VarT n -> Map.insert n k kSigs _ -> go t `Map.union` kSigs + + go (ForallT {}) = forallError +#if MIN_VERSION_template_haskell(2,16,0) + go (ForallVisT {}) = forallError +#endif + go _ = Map.empty + forallError :: a + forallError = error "`forall` type used in data family pattern" + -- Look into a list of type variable binder and map each free variable name -- to its kind (also map the names that KindedTVs bind to their respective -- kinds). This function considers the kind of a PlainTV to be *. @@ -1285,7 +1293,12 @@ #endif #if MIN_VERSION_template_haskell(2,15,0) ImplicitParamT n t -> do - ImplicitParamT n `fmap` resolveTypeSynonyms t + ImplicitParamT n <$> resolveTypeSynonyms t +#endif +#if MIN_VERSION_template_haskell(2,16,0) + ForallVisT tvbs body -> + ForallVisT `fmap` mapM resolve_tvb_syns tvbs + `ap` resolveTypeSynonyms body #endif _ -> notTypeSynCase f @@ -1457,7 +1470,9 @@ resolveInfixT :: Type -> Q Type #if MIN_VERSION_template_haskell(2,11,0) -resolveInfixT (ForallT vs cx t) = forallT vs (mapM resolveInfixT cx) (resolveInfixT t) +resolveInfixT (ForallT vs cx t) = ForallT <$> traverse (traverseTvbKind resolveInfixT) vs + <*> mapM resolveInfixT cx + <*> resolveInfixT t resolveInfixT (f `AppT` x) = resolveInfixT f `appT` resolveInfixT x resolveInfixT (ParensT t) = resolveInfixT t resolveInfixT (InfixT l o r) = conT o `appT` resolveInfixT l `appT` resolveInfixT r @@ -1468,6 +1483,10 @@ resolveInfixT (ImplicitParamT n t) = implicitParamT n $ resolveInfixT t # endif +# if MIN_VERSION_template_haskell(2,16,0) +resolveInfixT (ForallVisT vs t) = ForallVisT <$> traverse (traverseTvbKind resolveInfixT) vs + <*> resolveInfixT t +# endif resolveInfixT t = return t gatherUInfixT :: Type -> InfixList @@ -1640,6 +1659,10 @@ go_ty (AppKindT t k) = go_ty t `mappend` go_ty k go_ty (ImplicitParamT _ t) = go_ty t #endif +#if MIN_VERSION_template_haskell(2,16,0) + go_ty (ForallVisT tvbs t) = + foldr (\tvb -> Map.delete (tvName tvb)) (go_ty t) tvbs +#endif go_ty _ = mempty go_pred :: Pred -> Map Name Kind @@ -1766,11 +1789,7 @@ applySubstitution subst = go where go (ForallT tvs context 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 + subst_tvbs tvs $ \subst' -> ForallT (map (mapTvbKind (applySubstitution subst')) tvs) (applySubstitution subst' context) (applySubstitution subst' t) @@ -1787,15 +1806,21 @@ go (ImplicitParamT n t) = ImplicitParamT n (go t) #endif +#if MIN_VERSION_template_haskell(2,16,0) + go (ForallVisT tvs t) = + subst_tvbs tvs $ \subst' -> + ForallVisT (map (mapTvbKind (applySubstitution subst')) tvs) + (applySubstitution subst' t) +#endif go t = t + subst_tvbs :: [TyVarBndr] -> (Map Name Type -> a) -> a + subst_tvbs tvs k = k $ foldl' (flip Map.delete) subst (map tvName tvs) + freeVariables t = case t of ForallT tvs context t' -> - (concatMap (freeVariables . tvKind) tvs - `union` freeVariables context - `union` freeVariables t') - \\ map tvName tvs + fvs_under_forall tvs (freeVariables context `union` freeVariables t') AppT f x -> freeVariables f `union` freeVariables x SigT t' k -> freeVariables t' `union` freeVariables k VarT v -> [v] @@ -1809,20 +1834,40 @@ ImplicitParamT _ t -> freeVariables t #endif +#if MIN_VERSION_template_haskell(2,16,0) + ForallVisT tvs t' + -> fvs_under_forall tvs (freeVariables t') +#endif _ -> [] + where + fvs_under_forall :: [TyVarBndr] -> [Name] -> [Name] + fvs_under_forall tvs fvs = + (freeVariables (map tvKind tvs) `union` fvs) + \\ map tvName tvs instance TypeSubstitution ConstructorInfo where freeVariables ci = - (freeVariables (constructorContext ci) `union` - freeVariables (constructorFields ci)) + (freeVariables (map tvKind (constructorVars ci)) + `union` freeVariables (constructorContext ci) + `union` freeVariables (constructorFields ci)) \\ (tvName <$> constructorVars ci) applySubstitution subst ci = let subst' = foldl' (flip Map.delete) subst (map tvName (constructorVars ci)) in - ci { constructorContext = applySubstitution subst' (constructorContext ci) + ci { constructorVars = map (mapTvbKind (applySubstitution subst')) + (constructorVars ci) + , constructorContext = applySubstitution subst' (constructorContext ci) , constructorFields = applySubstitution subst' (constructorFields ci) } +mapTvbKind :: (Kind -> Kind) -> TyVarBndr -> TyVarBndr +mapTvbKind f tvb@PlainTV{} = tvb +mapTvbKind f (KindedTV n k) = KindedTV n (f k) + +traverseTvbKind :: Applicative f => (Kind -> f Kind) -> TyVarBndr -> f TyVarBndr +traverseTvbKind f tvb@PlainTV{} = pure tvb +traverseTvbKind f (KindedTV n k) = KindedTV n <$> f k + -- 'Pred' became a type synonym for 'Type' #if !MIN_VERSION_template_haskell(2,10,0) instance TypeSubstitution Pred where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.3.1.0/test/Main.hs new/th-abstraction-0.3.2.0/test/Main.hs --- old/th-abstraction-0.3.1.0/test/Main.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/th-abstraction-0.3.2.0/test/Main.hs 2001-09-09 03:46:40.000000000 +0200 @@ -88,6 +88,10 @@ t59Test t61Test t66Test + t80Test +#endif +#if MIN_VERSION_template_haskell(2,11,0) + t79Test #endif #if __GLASGOW_HASKELL__ >= 800 t37Test @@ -851,6 +855,41 @@ , constructorVariant = NormalConstructor } ] } ) + +t80Test :: IO () +t80Test = do + let [k,a,b] = map mkName ["k","a","b"] + -- forall k (a :: k) (b :: k). () + t = ForallT [PlainTV k, KindedTV a (VarT k), KindedTV b (VarT k)] [] (ConT ''()) + + expected, actual :: [Name] + expected = [] + actual = freeVariables t + + unless (expected == actual) $ + fail $ "Bug in ForallT substitution: " + ++ unlines [ "Expected: " ++ pprint expected + , "Actual: " ++ pprint actual + ] + return () +#endif + +#if MIN_VERSION_template_haskell(2,11,0) +t79Test :: IO () +t79Test = + $(do let [a,b,c] = map mkName ["a","b","c"] + t = ForallT [KindedTV a (UInfixT (VarT b) ''(:+:) (VarT c))] [] + (ConT ''()) + expected = ForallT [KindedTV a (ConT ''(:+:) `AppT` VarT b `AppT` VarT c)] [] + (ConT ''()) + actual <- resolveInfixT t + unless (expected == actual) $ + fail $ "resolveInfixT does not recur into the kinds of " + ++ "ForallT type variable binders: " + ++ unlines [ "Expected: " ++ pprint expected + , "Actual: " ++ pprint actual + ] + [| return () |]) #endif #if __GLASGOW_HASKELL__ >= 800 @@ -952,6 +991,24 @@ ++ show [a1, a2] [| return () |] ) + +t75Test :: IO () +t75Test = + $(do info <- reifyDatatype ''T75 + case datatypeCons info of + [c] -> let datatypeVarTypes = map (VarT . tvName) $ datatypeVars info + constructorVarKinds = map tvKind $ constructorVars c in + unless (datatypeVarTypes == constructorVarKinds) $ + fail $ "Mismatch between datatypeVars and constructorVars' kinds: " + ++ unlines [ "datatypeVars: " + ++ pprint datatypeVarTypes + , "constructorVars' kinds: " + ++ pprint constructorVarKinds + ] + cs -> fail $ "Unexpected number of constructors for T75: " + ++ show (length cs) + [| return () |] + ) #endif #if __GLASGOW_HASKELL__ >= 807 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.3.1.0/test/Types.hs new/th-abstraction-0.3.2.0/test/Types.hs --- old/th-abstraction-0.3.1.0/test/Types.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/th-abstraction-0.3.2.0/test/Types.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,4 @@ -{-# Language CPP, FlexibleContexts, TypeFamilies, KindSignatures, TemplateHaskell, GADTs, ScopedTypeVariables #-} +{-# Language CPP, FlexibleContexts, TypeFamilies, KindSignatures, TemplateHaskell, GADTs, ScopedTypeVariables, TypeOperators #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE ConstraintKinds #-} @@ -68,6 +68,8 @@ data StrictDemo = StrictDemo Int !Int {-# UNPACK #-} !Int +type (:+:) = Either + -- Data families data family T43Fam @@ -139,6 +141,9 @@ data T48 :: Type -> Type where MkT48 :: forall a (x :: a). Prox x -> T48 a + +data T75 (k :: Type) where + MkT75 :: forall k (a :: k). Prox a -> T75 k #endif -- We must define these here due to Template Haskell staging restrictions diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.3.1.0/th-abstraction.cabal new/th-abstraction-0.3.2.0/th-abstraction.cabal --- old/th-abstraction-0.3.1.0/th-abstraction.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/th-abstraction-0.3.2.0/th-abstraction.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ name: th-abstraction -version: 0.3.1.0 +version: 0.3.2.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 @@ -17,7 +17,7 @@ build-type: Simple extra-source-files: ChangeLog.md README.md cabal-version: >=1.10 -tested-with: GHC==8.8.1, GHC==8.6.4, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 +tested-with: GHC==8.10.1, GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 source-repository head type: git @@ -28,7 +28,7 @@ other-modules: Language.Haskell.TH.Datatype.Internal build-depends: base >=4.3 && <5, ghc-prim, - template-haskell >=2.5 && <2.16, + template-haskell >=2.5 && <2.17, containers >=0.4 && <0.7 hs-source-dirs: src default-language: Haskell2010
