Hello community, here is the log from the commit of package ghc-th-abstraction for openSUSE:Factory checked in at 2018-12-28 12:35:19 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-th-abstraction (Old) and /work/SRC/openSUSE:Factory/.ghc-th-abstraction.new.28833 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-th-abstraction" Fri Dec 28 12:35:19 2018 rev:5 rq:661501 version:0.2.10.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-th-abstraction/ghc-th-abstraction.changes 2018-10-25 09:05:59.110517703 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-th-abstraction.new.28833/ghc-th-abstraction.changes 2018-12-28 12:35:29.643956260 +0100 @@ -1,0 +2,22 @@ +Fri Dec 21 03:02:45 UTC 2018 - psimons@suse.com + +- Update th-abstraction to version 0.2.10.0. + ## 0.2.10.0 -- 2018-12-20 + * Optimization: `quantifyType` now collapses consecutive `forall`s. For + instance, calling `quantifyType` on `forall b. a -> b -> T a` now produces + `forall a b. a -> b -> T a` instead of `forall a. forall b. a -> b -> T a`. + + ## 0.2.9.0 -- 2018-12-20 + * Fix a bug in which `resolveTypeSynonyms` would not look into `ForallT`s, + `SigT`s, `InfixT`s, or `ParensT`s. + * Fix a bug in which `quantifyType` would not respect the dependency order of + type variables (e.g., `Proxy (a :: k)` would have erroneously been quantified + as `forall a k. Proxy (a :: k)`). + * Fix a bug in which `asEqualPred` would return incorrect results with GHC 8.7. + * Add a `freeVariablesWellScoped` function which computes the free variables of + a list of types and sorts them according to dependency order. + * Add a `resolveKindSynonyms` function which expands all type synonyms in a + `Kind`. This is mostly useful for supporting old GHCs where `Type` and `Kind` + were not the same. + +------------------------------------------------------------------- Old: ---- th-abstraction-0.2.8.0.tar.gz th-abstraction.cabal New: ---- th-abstraction-0.2.10.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-th-abstraction.spec ++++++ --- /var/tmp/diff_new_pack.WEc6ek/_old 2018-12-28 12:35:30.099955941 +0100 +++ /var/tmp/diff_new_pack.WEc6ek/_new 2018-12-28 12:35:30.103955938 +0100 @@ -19,14 +19,13 @@ %global pkg_name th-abstraction %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.2.8.0 +Version: 0.2.10.0 Release: 0 Summary: Nicer interface for reified information about data types License: ISC Group: Development/Libraries/Haskell 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 @@ -51,7 +50,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ th-abstraction-0.2.8.0.tar.gz -> th-abstraction-0.2.10.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.2.8.0/ChangeLog.md new/th-abstraction-0.2.10.0/ChangeLog.md --- old/th-abstraction-0.2.8.0/ChangeLog.md 2018-06-29 18:03:23.000000000 +0200 +++ new/th-abstraction-0.2.10.0/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,23 @@ # Revision history for th-abstraction +## 0.2.10.0 -- 2018-12-20 +* Optimization: `quantifyType` now collapses consecutive `forall`s. For + instance, calling `quantifyType` on `forall b. a -> b -> T a` now produces + `forall a b. a -> b -> T a` instead of `forall a. forall b. a -> b -> T a`. + +## 0.2.9.0 -- 2018-12-20 +* Fix a bug in which `resolveTypeSynonyms` would not look into `ForallT`s, + `SigT`s, `InfixT`s, or `ParensT`s. +* Fix a bug in which `quantifyType` would not respect the dependency order of + type variables (e.g., `Proxy (a :: k)` would have erroneously been quantified + as `forall a k. Proxy (a :: k)`). +* Fix a bug in which `asEqualPred` would return incorrect results with GHC 8.7. +* Add a `freeVariablesWellScoped` function which computes the free variables of + a list of types and sorts them according to dependency order. +* Add a `resolveKindSynonyms` function which expands all type synonyms in a + `Kind`. This is mostly useful for supporting old GHCs where `Type` and `Kind` + were not the same. + ## 0.2.8.0 -- 2018-06-29 * GADT reification is now much more robust with respect to `PolyKinds`: * A bug in which universally quantified kind variables were mistakenly diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.2.8.0/src/Language/Haskell/TH/Datatype/Internal.hs new/th-abstraction-0.2.10.0/src/Language/Haskell/TH/Datatype/Internal.hs --- old/th-abstraction-0.2.8.0/src/Language/Haskell/TH/Datatype/Internal.hs 2018-06-29 18:03:23.000000000 +0200 +++ new/th-abstraction-0.2.10.0/src/Language/Haskell/TH/Datatype/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -15,7 +15,9 @@ import Language.Haskell.TH.Syntax eqTypeName :: Name -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,9,0) && __GLASGOW_HASKELL__ < 807 + -- TODO: Replace __GLASGOW_HASKELL__ < 807 with + -- !(MIN_VERSION_base(4,13,0)) once base-4.13 exists eqTypeName = mkNameG_tc "base" "Data.Type.Equality" "~" #else eqTypeName = mkNameG_tc "ghc-prim" "GHC.Types" "~" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.2.8.0/src/Language/Haskell/TH/Datatype.hs new/th-abstraction-0.2.10.0/src/Language/Haskell/TH/Datatype.hs --- old/th-abstraction-0.2.8.0/src/Language/Haskell/TH/Datatype.hs 2018-06-29 18:03:23.000000000 +0200 +++ new/th-abstraction-0.2.10.0/src/Language/Haskell/TH/Datatype.hs 2001-09-09 03:46:40.000000000 +0200 @@ -78,6 +78,7 @@ -- * Type variable manipulation , TypeSubstitution(..) , quantifyType + , freeVariablesWellScoped , freshenFreeVariables -- * 'Pred' functions @@ -100,6 +101,7 @@ -- * Type simplification , resolveTypeSynonyms + , resolveKindSynonyms , resolvePredSynonyms , resolveInfixT @@ -117,6 +119,7 @@ import Data.Data (Typeable, Data) import Data.Foldable (foldMap, foldl') +import Data.Graph import Data.List (nub, find, union, (\\)) import Data.Map (Map) import qualified Data.Map as Map @@ -136,6 +139,7 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative (Applicative(..), (<$>)) +import Data.Monoid (Monoid(..)) #endif -- | Normalized information about newtypes and data types. @@ -1085,20 +1089,61 @@ #endif -- | Expand all of the type synonyms in a type. +-- +-- Note that this function will drop parentheses as a side effect. resolveTypeSynonyms :: Type -> Q Type resolveTypeSynonyms t = let f :| xs = decomposeType t - notTypeSynCase = foldl AppT f <$> mapM resolveTypeSynonyms xs in + notTypeSynCase :: Type -> Q Type + notTypeSynCase ty = foldl AppT ty <$> mapM resolveTypeSynonyms xs - case f of - ConT n -> - do mbInfo <- reifyMaybe n - case mbInfo of - Just (TyConI (TySynD _ synvars def)) - -> resolveTypeSynonyms $ expandSynonymRHS synvars xs def - _ -> notTypeSynCase - _ -> notTypeSynCase + expandCon :: Name -- The Name to check whether it is a type synonym or not + -> Type -- The argument type to fall back on if the supplied + -- Name isn't a type synonym + -> Q Type + expandCon n ty = do + mbInfo <- reifyMaybe n + case mbInfo of + Just (TyConI (TySynD _ synvars def)) + -> resolveTypeSynonyms $ expandSynonymRHS synvars xs def + _ -> notTypeSynCase ty + + in case f of + ForallT tvbs ctxt body -> + ForallT `fmap` mapM resolve_tvb_syns tvbs + `ap` mapM resolvePredSynonyms ctxt + `ap` resolveTypeSynonyms body + SigT ty ki -> do + ty' <- resolveTypeSynonyms ty + ki' <- resolveKindSynonyms ki + notTypeSynCase $ SigT ty' ki' + ConT n -> expandCon n (ConT n) +#if MIN_VERSION_template_haskell(2,11,0) + InfixT t1 n t2 -> do + t1' <- resolveTypeSynonyms t1 + t2' <- resolveTypeSynonyms t2 + expandCon n (InfixT t1' n t2') + UInfixT t1 n t2 -> do + t1' <- resolveTypeSynonyms t1 + t2' <- resolveTypeSynonyms t2 + expandCon n (UInfixT t1' n t2') +#endif + _ -> notTypeSynCase f + +-- | Expand all of the type synonyms in a 'Kind'. +resolveKindSynonyms :: Kind -> Q Kind +#if MIN_VERSION_template_haskell(2,8,0) +resolveKindSynonyms = resolveTypeSynonyms +#else +resolveKindSynonyms = return -- One simply couldn't put type synonyms into + -- kinds on old versions of GHC. +#endif + +-- | Expand all of the type synonyms in a the kind of a 'TyVarBndr'. +resolve_tvb_syns :: TyVarBndr -> Q TyVarBndr +resolve_tvb_syns tvb@PlainTV{} = return tvb +resolve_tvb_syns (KindedTV n k) = KindedTV n <$> resolveKindSynonyms k expandSynonymRHS :: [TyVarBndr] {- ^ Substitute these variables... -} -> @@ -1156,8 +1201,11 @@ decomposeType :: Type -> NonEmpty Type decomposeType = go [] where - go args (AppT f x) = go (x:args) f - go args t = t :| args + go args (AppT f x) = go (x:args) f +#if MIN_VERSION_template_haskell(2,11,0) + go args (ParensT t) = go args t +#endif + go args t = t :| args -- 'NonEmpty' didn't move into base until recently. Reimplementing it locally -- saves dependencies for supporting older GHCs @@ -1294,11 +1342,108 @@ -- contrast with being dependent upon the Ord instance for 'Name') quantifyType :: Type -> Type quantifyType t - | null vs = t - | otherwise = ForallT (PlainTV <$> vs) [] t + | null tvbs + = t + | ForallT tvbs' ctxt' t' <- t -- Collapse two consecutive foralls (#63) + = ForallT (tvbs ++ tvbs') ctxt' t' + | otherwise + = ForallT tvbs [] t where - vs = freeVariables t + tvbs = freeVariablesWellScoped [t] + +-- | Take a list of 'Type's, find their free variables, and sort them +-- according to dependency order. +-- +-- As an example of how this function works, consider the following type: +-- +-- @ +-- Proxy (a :: k) +-- @ +-- +-- Calling 'freeVariables' on this type would yield @[a, k]@, since that is +-- the order in which those variables appear in a left-to-right fashion. But +-- this order does not preserve the fact that @k@ is the kind of @a@. Moreover, +-- if you tried writing the type @forall a k. Proxy (a :: k)@, GHC would reject +-- this, since GHC would demand that @k@ come before @a@. +-- +-- 'freeVariablesWellScoped' orders the free variables of a type in a way that +-- preserves this dependency ordering. If one were to call +-- 'freeVariablesWellScoped' on the type above, it would return +-- @[k, (a :: k)]@. (This is why 'freeVariablesWellScoped' returns a list of +-- 'TyVarBndr's instead of 'Name's, since it must make it explicit that @k@ +-- is the kind of @a@.) +-- +-- On older GHCs, this takes measures to avoid returning explicitly bound +-- kind variables, which was not possible before @TypeInType@. +freeVariablesWellScoped :: [Type] -> [TyVarBndr] +freeVariablesWellScoped tys = + let fvs :: [Name] + fvs = freeVariables tys + + varKindSigs :: Map Name Kind + varKindSigs = foldMap go_ty tys + where + go_ty :: Type -> Map Name Kind + go_ty (ForallT tvbs ctxt t) = + foldr (\tvb -> Map.delete (tvName tvb)) + (foldMap go_pred ctxt `mappend` go_ty t) tvbs + go_ty (AppT t1 t2) = go_ty t1 `mappend` go_ty t2 + go_ty (SigT t k) = + let kSigs = +#if MIN_VERSION_template_haskell(2,8,0) + go_ty k +#else + mempty +#endif + in case t of + VarT n -> Map.insert n k kSigs + _ -> go_ty t `mappend` kSigs + go_ty _ = mempty + + go_pred :: Pred -> Map Name Kind +#if MIN_VERSION_template_haskell(2,10,0) + go_pred = go_ty +#else + go_pred (ClassP _ ts) = foldMap go_ty ts + go_pred (EqualP t1 t2) = go_ty t1 `mappend` go_ty t2 +#endif + + (g, gLookup, _) + = graphFromEdges [ (fv, fv, kindVars) + | fv <- fvs + , let kindVars = + case Map.lookup fv varKindSigs of + Nothing -> [] + Just ks -> freeVariables ks + ] + tg = reverse $ topSort g + + lookupVertex x = + case gLookup x of + (n, _, _) -> n + + ascribeWithKind n + | Just k <- Map.lookup n varKindSigs + = KindedTV n k + | otherwise + = PlainTV n + + -- An annoying wrinkle: GHCs before 8.0 don't support explicitly + -- quantifying kinds, so something like @forall k (a :: k)@ would be + -- rejected. To work around this, we filter out any binders whose names + -- also appear in a kind on old GHCs. + isKindBinderOnOldGHCs +#if __GLASGOW_HASKELL__ >= 800 + = const False +#else + = (`elem` kindVars) + where + kindVars = freeVariables $ Map.elems varKindSigs +#endif + in map ascribeWithKind $ + filter (not . isKindBinderOnOldGHCs) $ + map lookupVertex tg -- | Substitute all of the free variables in a type with fresh ones freshenFreeVariables :: Type -> Q Type diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.2.8.0/test/Main.hs new/th-abstraction-0.2.10.0/test/Main.hs --- old/th-abstraction-0.2.8.0/test/Main.hs 2018-06-29 18:03:23.000000000 +0200 +++ new/th-abstraction-0.2.10.0/test/Main.hs 2001-09-09 03:46:40.000000000 +0200 @@ -78,12 +78,15 @@ #endif #if MIN_VERSION_template_haskell(2,8,0) kindSubstTest + t59Test + t61Test #endif #if __GLASGOW_HASKELL__ >= 800 t37Test polyKindedExTyvarTest #endif regressionTest44 + t63Test adt1Test :: IO () adt1Test = @@ -661,6 +664,58 @@ checkFreeVars ty [k1] checkFreeVars substTy [k2] [| return () |]) + +t59Test :: IO () +t59Test = + $(do k <- newName "k" + a <- newName "a" + let proxyAK = ConT (mkName "Proxy") `AppT` SigT (VarT a) (VarT k) + -- Proxy (a :: k) + expected = ForallT +#if __GLASGOW_HASKELL__ >= 800 + [PlainTV k, KindedTV a (VarT k)] +#else + [KindedTV a (VarT k)] +#endif + [] proxyAK + actual = quantifyType proxyAK + unless (expected == actual) $ + fail $ "quantifyType does not respect dependency order: " + ++ unlines [ "Expected: " ++ pprint expected + , "Actual: " ++ pprint actual + ] + [| return () |]) + +t61Test :: IO () +t61Test = + $(do let test :: Type -> Type -> Q () + test orig expected = do + actual <- resolveTypeSynonyms orig + unless (expected == actual) $ + fail $ "Type synonym expansion failed: " + ++ unlines [ "Expected: " ++ pprint expected + , "Actual: " ++ pprint actual + ] + + idAppT = (ConT ''Id `AppT`) + a = mkName "a" + test (SigT (idAppT $ ConT ''Int) (idAppT StarT)) + (SigT (ConT ''Int) StarT) +#if MIN_VERSION_template_haskell(2,10,0) + test (ForallT [KindedTV a (idAppT StarT)] + [idAppT (ConT ''Show `AppT` VarT a)] + (idAppT $ VarT a)) + (ForallT [KindedTV a StarT] + [ConT ''Show `AppT` VarT a] + (VarT a)) +#endif +#if MIN_VERSION_template_haskell(2,11,0) + test (InfixT (idAppT $ ConT ''Int) ''Either (idAppT $ ConT ''Int)) + (InfixT (ConT ''Int) ''Either (ConT ''Int)) + test (ParensT (idAppT $ ConT ''Int)) + (ConT ''Int) +#endif + [| return () |]) #endif #if __GLASGOW_HASKELL__ >= 800 @@ -760,3 +815,20 @@ unified <- unifyTypes [intToInt, intToInt] unless (Map.null unified) (fail "regression test for ticket #44 failed") [| return () |]) + +t63Test :: IO () +t63Test = + $(do a <- newName "a" + b <- newName "b" + t <- newName "T" + let tauType = ArrowT `AppT` VarT a `AppT` (ArrowT `AppT` VarT b + `AppT` (ConT t `AppT` VarT a)) + sigmaType = ForallT [PlainTV b] [] tauType + expected = ForallT [PlainTV a, PlainTV b] [] tauType + actual = quantifyType sigmaType + unless (expected == actual) $ + fail $ "quantifyType does not collapse consecutive foralls: " + ++ unlines [ "Expected: " ++ pprint expected + , "Actual: " ++ pprint actual + ] + [| return () |]) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.2.8.0/test/Types.hs new/th-abstraction-0.2.10.0/test/Types.hs --- old/th-abstraction-0.2.8.0/test/Types.hs 2018-06-29 18:03:23.000000000 +0200 +++ new/th-abstraction-0.2.10.0/test/Types.hs 2001-09-09 03:46:40.000000000 +0200 @@ -71,6 +71,8 @@ -- Data families data family T43Fam +type Id (a :: *) = a + #if MIN_VERSION_template_haskell(2,7,0) data family DF (a :: *) data instance DF (Maybe a) = DFMaybe Int [a] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-abstraction-0.2.8.0/th-abstraction.cabal new/th-abstraction-0.2.10.0/th-abstraction.cabal --- old/th-abstraction-0.2.8.0/th-abstraction.cabal 2018-06-29 18:03:23.000000000 +0200 +++ new/th-abstraction-0.2.10.0/th-abstraction.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ name: th-abstraction -version: 0.2.8.0 +version: 0.2.10.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.4.3, 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.6.3, 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,8 +28,8 @@ other-modules: Language.Haskell.TH.Datatype.Internal build-depends: base >=4.3 && <5, ghc-prim, - template-haskell >=2.5 && <2.14, - containers >=0.4 && <0.6 + template-haskell >=2.5 && <2.15, + containers >=0.4 && <0.7 hs-source-dirs: src default-language: Haskell2010