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 - psim...@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
