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
 


Reply via email to