Hello community,
here is the log from the commit of package ghc-th-abstraction for
openSUSE:Factory checked in at 2020-10-23 15:15:02
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-th-abstraction (Old)
and /work/SRC/openSUSE:Factory/.ghc-th-abstraction.new.3463 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-th-abstraction"
Fri Oct 23 15:15:02 2020 rev:12 rq:842768 version:0.4.0.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-th-abstraction/ghc-th-abstraction.changes
2020-08-28 21:39:24.492838360 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-th-abstraction.new.3463/ghc-th-abstraction.changes
2020-10-23 15:15:02.666154417 +0200
@@ -1,0 +2,19 @@
+Wed Sep 30 08:36:12 UTC 2020 - psim...@suse.com
+
+- Update th-abstraction to version 0.4.0.0.
+ ## 0.4.0.0 -- 2020-09-29
+ * Adapt to the `TyVarBndr` data type gaining a new `flag` type parameter
+ (in `template-haskell-2.17.0.0`) to represent its specificity:
+ * Introduce a new `Language.Haskell.TH.Datatype.TyVarBndr` module that
+ defines `TyVarBndr_`, a backwards-compatible type synonym for
`TyVarBndr`,
+ as well as backporting `TyVarBndrSpec`, `TyVarBndrUnit`, and
`Specificity`.
+ This module also defines other useful functions for constructing and
+ manipulating `TyVarBndr`s.
+ * The types in `Language.Haskell.TH.Datatype` now use `TyVarBndr_`,
+ `TyVarBndrUnit`, and `TyVarBndrSpec` where appropriate. Technically, this
+ is not a breaking change, since all three are simple type synonyms around
+ `TyVarBndr`, but it is likely that you will need to update your
+ `th-abstraction`-using code anyway if it involves a `TyVarBndr`-consuming
+ function.
+
+-------------------------------------------------------------------
Old:
----
th-abstraction-0.3.2.0.tar.gz
New:
----
th-abstraction-0.4.0.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-th-abstraction.spec ++++++
--- /var/tmp/diff_new_pack.0YbeCo/_old 2020-10-23 15:15:03.426154783 +0200
+++ /var/tmp/diff_new_pack.0YbeCo/_new 2020-10-23 15:15:03.426154783 +0200
@@ -19,7 +19,7 @@
%global pkg_name th-abstraction
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.3.2.0
+Version: 0.4.0.0
Release: 0
Summary: Nicer interface for reified information about data types
License: ISC
++++++ th-abstraction-0.3.2.0.tar.gz -> th-abstraction-0.4.0.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/th-abstraction-0.3.2.0/ChangeLog.md
new/th-abstraction-0.4.0.0/ChangeLog.md
--- old/th-abstraction-0.3.2.0/ChangeLog.md 2001-09-09 03:46:40.000000000
+0200
+++ new/th-abstraction-0.4.0.0/ChangeLog.md 2001-09-09 03:46:40.000000000
+0200
@@ -1,5 +1,20 @@
# Revision history for th-abstraction
+## 0.4.0.0 -- 2020-09-29
+* Adapt to the `TyVarBndr` data type gaining a new `flag` type parameter
+ (in `template-haskell-2.17.0.0`) to represent its specificity:
+ * Introduce a new `Language.Haskell.TH.Datatype.TyVarBndr` module that
+ defines `TyVarBndr_`, a backwards-compatible type synonym for `TyVarBndr`,
+ as well as backporting `TyVarBndrSpec`, `TyVarBndrUnit`, and `Specificity`.
+ This module also defines other useful functions for constructing and
+ manipulating `TyVarBndr`s.
+ * The types in `Language.Haskell.TH.Datatype` now use `TyVarBndr_`,
+ `TyVarBndrUnit`, and `TyVarBndrSpec` where appropriate. Technically, this
+ is not a breaking change, since all three are simple type synonyms around
+ `TyVarBndr`, but it is likely that you will need to update your
+ `th-abstraction`-using code anyway if it involves a `TyVarBndr`-consuming
+ function.
+
## 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.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/th-abstraction-0.3.2.0/LICENSE
new/th-abstraction-0.4.0.0/LICENSE
--- old/th-abstraction-0.3.2.0/LICENSE 2001-09-09 03:46:40.000000000 +0200
+++ new/th-abstraction-0.4.0.0/LICENSE 2001-09-09 03:46:40.000000000 +0200
@@ -1,4 +1,4 @@
-Copyright (c) 2017 Eric Mertens
+Copyright (c) 2017-2020 Eric Mertens
Permission to use, copy, modify, and/or distribute this software for any
purpose
with or without fee is hereby granted, provided that the above copyright notice
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/th-abstraction-0.3.2.0/src/Language/Haskell/TH/Datatype/Internal.hs
new/th-abstraction-0.4.0.0/src/Language/Haskell/TH/Datatype/Internal.hs
--- old/th-abstraction-0.3.2.0/src/Language/Haskell/TH/Datatype/Internal.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/th-abstraction-0.4.0.0/src/Language/Haskell/TH/Datatype/Internal.hs
2001-09-09 03:46:40.000000000 +0200
@@ -15,9 +15,7 @@
import Language.Haskell.TH.Syntax
eqTypeName :: Name
-#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
+#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,13,0))
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.3.2.0/src/Language/Haskell/TH/Datatype/TyVarBndr.hs
new/th-abstraction-0.4.0.0/src/Language/Haskell/TH/Datatype/TyVarBndr.hs
--- old/th-abstraction-0.3.2.0/src/Language/Haskell/TH/Datatype/TyVarBndr.hs
1970-01-01 01:00:00.000000000 +0100
+++ new/th-abstraction-0.4.0.0/src/Language/Haskell/TH/Datatype/TyVarBndr.hs
2001-09-09 03:46:40.000000000 +0200
@@ -0,0 +1,342 @@
+{-# Language CPP, DeriveDataTypeable #-}
+
+#if MIN_VERSION_base(4,4,0)
+#define HAS_GENERICS
+{-# Language DeriveGeneric #-}
+#endif
+
+{-|
+Module : Language.Haskell.TH.Datatype.TyVarBndr
+Description : Backwards-compatible type variable binders
+Copyright : Eric Mertens 2020
+License : ISC
+Maintainer : emert...@gmail.com
+
+This module provides a backwards-compatible API for constructing and
+manipulating 'TyVarBndr's across multiple versions of the @template-haskell@
+package.
+
+-}
+module Language.Haskell.TH.Datatype.TyVarBndr (
+ -- * @TyVarBndr@-related types
+ TyVarBndr_
+ , TyVarBndrUnit
+ , TyVarBndrSpec
+ , Specificity(..)
+
+ -- * Constructing @TyVarBndr@s
+ -- ** @flag@-polymorphic
+ , plainTVFlag
+ , kindedTVFlag
+ -- ** @TyVarBndrUnit@
+ , plainTV
+ , kindedTV
+ -- ** @TyVarBndrSpec@
+ , plainTVInferred
+ , plainTVSpecified
+ , kindedTVInferred
+ , kindedTVSpecified
+
+ -- * Constructing @Specificity@
+ , inferredSpec
+ , specifiedSpec
+
+ -- * Modifying @TyVarBndr@s
+ , elimTV
+ , mapTV
+ , mapTVName
+ , mapTVFlag
+ , mapTVKind
+ , traverseTV
+ , traverseTVName
+ , traverseTVFlag
+ , traverseTVKind
+ , mapMTV
+ , mapMTVName
+ , mapMTVFlag
+ , mapMTVKind
+ , changeTVFlags
+
+ -- * Properties of @TyVarBndr@s
+ , tvName
+ , tvKind
+ ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Data (Typeable, Data)
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Syntax
+
+#ifdef HAS_GENERICS
+import GHC.Generics (Generic)
+#endif
+
+-- | A type synonym for 'TyVarBndr'. This is the recommended way to refer to
+-- 'TyVarBndr's if you wish to achieve backwards compatibility with older
+-- versions of @template-haskell@, where 'TyVarBndr' lacked a @flag@ type
+-- parameter representing its specificity (if it has one).
+#if MIN_VERSION_template_haskell(2,17,0)
+type TyVarBndr_ flag = TyVarBndr flag
+#else
+type TyVarBndr_ flag = TyVarBndr
+
+-- | A 'TyVarBndr' where the specificity is irrelevant. This is used for
+-- 'TyVarBndr's that do not interact with visible type application.
+type TyVarBndrUnit = TyVarBndr
+
+-- | A 'TyVarBndr' with an explicit 'Specificity'. This is used for
+-- 'TyVarBndr's that interact with visible type application.
+type TyVarBndrSpec = TyVarBndr
+
+-- | Determines how a 'TyVarBndr' interacts with visible type application.
+data Specificity
+ = SpecifiedSpec -- ^ @a@. Eligible for visible type application.
+ | InferredSpec -- ^ @{a}@. Not eligible for visible type application.
+ deriving (Show, Eq, Ord, Typeable, Data
+#ifdef HAS_GENERICS
+ ,Generic
+#endif
+ )
+
+inferredSpec :: Specificity
+inferredSpec = InferredSpec
+
+specifiedSpec :: Specificity
+specifiedSpec = SpecifiedSpec
+#endif
+
+-- | Construct a 'PlainTV' with the given @flag@.
+plainTVFlag :: Name -> flag -> TyVarBndr_ flag
+#if MIN_VERSION_template_haskell(2,17,0)
+plainTVFlag = PlainTV
+#else
+plainTVFlag n _ = PlainTV n
+#endif
+
+-- | Construct a 'PlainTV' with an 'InferredSpec'.
+plainTVInferred :: Name -> TyVarBndrSpec
+plainTVInferred n = plainTVFlag n InferredSpec
+
+-- | Construct a 'PlainTV' with a 'SpecifiedSpec'.
+plainTVSpecified :: Name -> TyVarBndrSpec
+plainTVSpecified n = plainTVFlag n SpecifiedSpec
+
+-- | Construct a 'KindedTV' with the given @flag@.
+kindedTVFlag :: Name -> flag -> Kind -> TyVarBndr_ flag
+#if MIN_VERSION_template_haskell(2,17,0)
+kindedTVFlag = KindedTV
+#else
+kindedTVFlag n _ kind = KindedTV n kind
+#endif
+
+-- | Construct a 'KindedTV' with an 'InferredSpec'.
+kindedTVInferred :: Name -> Kind -> TyVarBndrSpec
+kindedTVInferred n k = kindedTVFlag n InferredSpec k
+
+-- | Construct a 'KindedTV' with a 'SpecifiedSpec'.
+kindedTVSpecified :: Name -> Kind -> TyVarBndrSpec
+kindedTVSpecified n k = kindedTVFlag n SpecifiedSpec k
+
+-- | Case analysis for a 'TyVarBndr'. If the value is a @'PlainTV' n _@, apply
+-- the first function to @n@; if it is @'KindedTV' n _ k@, apply the second
+-- function to @n@ and @k@.
+elimTV :: (Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r
+#if MIN_VERSION_template_haskell(2,17,0)
+elimTV ptv _ktv (PlainTV n _) = ptv n
+elimTV _ptv ktv (KindedTV n _ k) = ktv n k
+#else
+elimTV ptv _ktv (PlainTV n) = ptv n
+elimTV _ptv ktv (KindedTV n k) = ktv n k
+#endif
+
+-- | Map over the components of a 'TyVarBndr'.
+mapTV :: (Name -> Name) -> (flag -> flag') -> (Kind -> Kind)
+ -> TyVarBndr_ flag -> TyVarBndr_ flag'
+#if MIN_VERSION_template_haskell(2,17,0)
+mapTV fn fflag _fkind (PlainTV n flag) = PlainTV (fn n) (fflag flag)
+mapTV fn fflag fkind (KindedTV n flag kind) = KindedTV (fn n) (fflag flag)
(fkind kind)
+#else
+mapTV fn _fflag _fkind (PlainTV n) = PlainTV (fn n)
+mapTV fn _fflag fkind (KindedTV n kind) = KindedTV (fn n) (fkind kind)
+#endif
+
+-- | Map over the 'Name' of a 'TyVarBndr'.
+mapTVName :: (Name -> Name) -> TyVarBndr_ flag -> TyVarBndr_ flag
+mapTVName fname = mapTV fname id id
+
+-- | Map over the @flag@ of a 'TyVarBndr'.
+mapTVFlag :: (flag -> flag') -> TyVarBndr_ flag -> TyVarBndr_ flag'
+#if MIN_VERSION_template_haskell(2,17,0)
+mapTVFlag = fmap
+#else
+mapTVFlag _ = id
+#endif
+
+-- | Map over the 'Kind' of a 'TyVarBndr'.
+mapTVKind :: (Kind -> Kind) -> TyVarBndr_ flag -> TyVarBndr_ flag
+mapTVKind fkind = mapTV id id fkind
+
+-- | Traverse the components of a 'TyVarBndr'.
+traverseTV :: Applicative f
+ => (Name -> f Name) -> (flag -> f flag') -> (Kind -> f Kind)
+ -> TyVarBndr_ flag -> f (TyVarBndr_ flag')
+#if MIN_VERSION_template_haskell(2,17,0)
+traverseTV fn fflag _fkind (PlainTV n flag) =
+ liftA2 PlainTV (fn n) (fflag flag)
+traverseTV fn fflag fkind (KindedTV n flag kind) =
+ liftA3 KindedTV (fn n) (fflag flag) (fkind kind)
+#else
+traverseTV fn _fflag _fkind (PlainTV n) =
+ PlainTV <$> fn n
+traverseTV fn _fflag fkind (KindedTV n kind) =
+ liftA2 KindedTV (fn n) (fkind kind)
+#endif
+
+-- | Traverse the 'Name' of a 'TyVarBndr'.
+traverseTVName :: Functor f
+ => (Name -> f Name)
+ -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
+#if MIN_VERSION_template_haskell(2,17,0)
+traverseTVName fn (PlainTV n flag) =
+ (\n' -> PlainTV n' flag) <$> fn n
+traverseTVName fn (KindedTV n flag kind) =
+ (\n' -> KindedTV n' flag kind) <$> fn n
+#else
+traverseTVName fn (PlainTV n) =
+ PlainTV <$> fn n
+traverseTVName fn (KindedTV n kind) =
+ (\n' -> KindedTV n' kind) <$> fn n
+#endif
+
+-- | Traverse the @flag@ of a 'TyVarBndr'.
+traverseTVFlag :: Applicative f
+ => (flag -> f flag')
+ -> TyVarBndr_ flag -> f (TyVarBndr_ flag')
+#if MIN_VERSION_template_haskell(2,17,0)
+traverseTVFlag fflag (PlainTV n flag) =
+ PlainTV n <$> fflag flag
+traverseTVFlag fflag (KindedTV n flag kind) =
+ (\flag' -> KindedTV n flag' kind) <$> fflag flag
+#else
+traverseTVFlag _ = pure
+#endif
+
+-- | Traverse the 'Kind' of a 'TyVarBndr'.
+traverseTVKind :: Applicative f
+ => (Kind -> f Kind)
+ -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
+#if MIN_VERSION_template_haskell(2,17,0)
+traverseTVKind _fkind tvb@PlainTV{} =
+ pure tvb
+traverseTVKind fkind (KindedTV n flag kind) =
+ KindedTV n flag <$> fkind kind
+#else
+traverseTVKind _fkind tvb@PlainTV{} =
+ pure tvb
+traverseTVKind fkind (KindedTV n kind) =
+ KindedTV n <$> fkind kind
+#endif
+
+-- | Map over the components of a 'TyVarBndr' in a monadic fashion.
+--
+-- This is the same as 'traverseTV', but with a 'Monad' constraint. This is
+-- mainly useful for use with old versions of @base@ where 'Applicative' was
+-- not a superclass of 'Monad'.
+mapMTV :: Monad m
+ => (Name -> m Name) -> (flag -> m flag') -> (Kind -> m Kind)
+ -> TyVarBndr_ flag -> m (TyVarBndr_ flag')
+#if MIN_VERSION_template_haskell(2,17,0)
+mapMTV fn fflag _fkind (PlainTV n flag) =
+ liftM2 PlainTV (fn n) (fflag flag)
+mapMTV fn fflag fkind (KindedTV n flag kind) =
+ liftM3 KindedTV (fn n) (fflag flag) (fkind kind)
+#else
+mapMTV fn _fflag _fkind (PlainTV n) =
+ liftM PlainTV (fn n)
+mapMTV fn _fflag fkind (KindedTV n kind) =
+ liftM2 KindedTV (fn n) (fkind kind)
+#endif
+
+-- | Map over the 'Name' of a 'TyVarBndr' in a monadic fashion.
+--
+-- This is the same as 'traverseTVName', but with a 'Monad' constraint. This is
+-- mainly useful for use with old versions of @base@ where 'Applicative' was
+-- not a superclass of 'Monad'.
+mapMTVName :: Monad m
+ => (Name -> m Name)
+ -> TyVarBndr_ flag -> m (TyVarBndr_ flag)
+#if MIN_VERSION_template_haskell(2,17,0)
+mapMTVName fn (PlainTV n flag) =
+ liftM (\n' -> PlainTV n' flag) (fn n)
+mapMTVName fn (KindedTV n flag kind) =
+ liftM (\n' -> KindedTV n' flag kind) (fn n)
+#else
+mapMTVName fn (PlainTV n) =
+ liftM PlainTV (fn n)
+mapMTVName fn (KindedTV n kind) =
+ liftM (\n' -> KindedTV n' kind) (fn n)
+#endif
+
+-- | Map over the @flag@ of a 'TyVarBndr' in a monadic fashion.
+--
+-- This is the same as 'traverseTVFlag', but with a 'Monad' constraint. This is
+-- mainly useful for use with old versions of @base@ where 'Applicative' was
+-- not a superclass of 'Monad'.
+mapMTVFlag :: Monad m
+ => (flag -> m flag')
+ -> TyVarBndr_ flag -> m (TyVarBndr_ flag')
+#if MIN_VERSION_template_haskell(2,17,0)
+mapMTVFlag fflag (PlainTV n flag) =
+ liftM (PlainTV n) (fflag flag)
+mapMTVFlag fflag (KindedTV n flag kind) =
+ liftM (\flag' -> KindedTV n flag' kind) (fflag flag)
+#else
+mapMTVFlag _ = return
+#endif
+
+-- | Map over the 'Kind' of a 'TyVarBndr' in a monadic fashion.
+--
+-- This is the same as 'traverseTVKind', but with a 'Monad' constraint. This is
+-- mainly useful for use with old versions of @base@ where 'Applicative' was
+-- not a superclass of 'Monad'.
+mapMTVKind :: Monad m
+ => (Kind -> m Kind)
+ -> TyVarBndr_ flag -> m (TyVarBndr_ flag)
+#if MIN_VERSION_template_haskell(2,17,0)
+mapMTVKind _fkind tvb@PlainTV{} =
+ return tvb
+mapMTVKind fkind (KindedTV n flag kind) =
+ liftM (KindedTV n flag) (fkind kind)
+#else
+mapMTVKind _fkind tvb@PlainTV{} =
+ return tvb
+mapMTVKind fkind (KindedTV n kind) =
+ liftM (KindedTV n) (fkind kind)
+#endif
+
+-- | Set the flag in a list of 'TyVarBndr's. This is often useful in contexts
+-- where one needs to re-use a list of 'TyVarBndr's from one flag setting to
+-- another flag setting. For example, in order to re-use the 'TyVarBndr's bound
+-- by a 'DataD' in a 'ForallT', one can do the following:
+--
+-- @
+-- case x of
+-- 'DataD' _ _ tvbs _ _ _ ->
+-- 'ForallT' ('changeTVFlags' 'SpecifiedSpec' tvbs) ...
+-- @
+changeTVFlags :: newFlag -> [TyVarBndr_ oldFlag] -> [TyVarBndr_ newFlag]
+#if MIN_VERSION_template_haskell(2,17,0)
+changeTVFlags newFlag = map (newFlag <$)
+#else
+changeTVFlags _ = id
+#endif
+
+-- | Extract the type variable name from a 'TyVarBndr', ignoring the
+-- kind signature if one exists.
+tvName :: TyVarBndr_ flag -> Name
+tvName = elimTV id (\n _ -> n)
+
+-- | Extract the kind from a 'TyVarBndr'. Assumes 'PlainTV' has kind @*@.
+tvKind :: TyVarBndr_ flag -> Kind
+tvKind = elimTV (\_ -> starK) (\_ k -> k)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/th-abstraction-0.3.2.0/src/Language/Haskell/TH/Datatype.hs
new/th-abstraction-0.4.0.0/src/Language/Haskell/TH/Datatype.hs
--- old/th-abstraction-0.3.2.0/src/Language/Haskell/TH/Datatype.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/th-abstraction-0.4.0.0/src/Language/Haskell/TH/Datatype.hs
2001-09-09 03:46:40.000000000 +0200
@@ -8,13 +8,13 @@
{-|
Module : Language.Haskell.TH.Datatype
Description : Backwards-compatible interface to reified information about
datatypes.
-Copyright : Eric Mertens 2017
+Copyright : Eric Mertens 2017-2020
License : ISC
Maintainer : emert...@gmail.com
This module provides a flattened view of information about data types
and newtypes that can be supported uniformly across multiple versions
-of the template-haskell package.
+of the @template-haskell@ package.
Sample output for @'reifyDatatype' ''Maybe@
@@ -22,7 +22,7 @@
'DatatypeInfo'
{ 'datatypeContext' = []
, 'datatypeName' = GHC.Base.Maybe
- , 'datatypeVars' = [ 'KindedTV' a_3530822107858468866 'StarT' ]
+ , 'datatypeVars' = [ 'KindedTV' a_3530822107858468866 () 'StarT' ]
, 'datatypeInstTypes' = [ 'SigT' ('VarT' a_3530822107858468866) 'StarT' ]
, 'datatypeVariant' = 'Datatype'
, 'datatypeCons' =
@@ -133,6 +133,7 @@
hiding (Extension(..))
#endif
import Language.Haskell.TH.Datatype.Internal
+import Language.Haskell.TH.Datatype.TyVarBndr
import Language.Haskell.TH.Lib (arrowK, starK) -- needed for th-2.4
#ifdef HAS_GENERICS
@@ -155,14 +156,14 @@
-- * For ADTs declared with @data@ and @newtype@, it will likely be the case
-- that 'datatypeVars' and 'datatypeInstTypes' coincide. For instance, given
-- @newtype Id a = MkId a@, in the 'DatatypeInfo' for @Id@ we would
--- have @'datatypeVars' = ['KindedTV' a 'StarT']@ and
+-- have @'datatypeVars' = ['KindedTV' a () 'StarT']@ and
-- @'datatypeInstVars' = ['SigT' ('VarT' a) 'StarT']@.
--
-- ADTs that leverage @PolyKinds@ may have more 'datatypeVars' than
-- 'datatypeInstTypes'. For instance, given @data Proxy (a :: k) = MkProxy@,
-- in the 'DatatypeInfo' for @Proxy@ we would have
--- @'datatypeVars' = ['KindedTV' k 'StarT', 'KindedTV' a ('VarT' k)]@ (since
--- there are two variables, @k@ and @a@), whereas
+-- @'datatypeVars' = ['KindedTV' k () 'StarT', 'KindedTV' a () ('VarT' k)]@
+-- (since there are two variables, @k@ and @a@), whereas
-- @'datatypeInstTypes' = ['SigT' ('VarT' a) ('VarT' k)]@, since there is
-- only one explicit type argument to @Proxy@.
--
@@ -178,16 +179,16 @@
-- Then in the 'DatatypeInfo' for @F@'s data instance, we would have:
--
-- @
--- 'datatypeVars' = [ 'KindedTV' c 'StarT'
--- , 'KindedTV' f 'StarT'
--- , 'KindedTV' x 'StarT' ]
+-- 'datatypeVars' = [ 'KindedTV' c () 'StarT'
+-- , 'KindedTV' f () 'StarT'
+-- , 'KindedTV' x () 'StarT' ]
-- 'datatypeInstTypes' = [ 'AppT' ('ConT' ''Maybe) ('VarT' c)
-- , 'AppT' ('VarT' f) ('VarT' x) ]
-- @
data DatatypeInfo = DatatypeInfo
{ datatypeContext :: Cxt -- ^ Data type context (deprecated)
, datatypeName :: Name -- ^ Type constructor
- , datatypeVars :: [TyVarBndr] -- ^ Type parameters
+ , datatypeVars :: [TyVarBndrUnit] -- ^ Type parameters
, datatypeInstTypes :: [Type] -- ^ Argument types
, datatypeVariant :: DatatypeVariant -- ^ Extra information
, datatypeCons :: [ConstructorInfo] -- ^ Normalize constructor
information
@@ -214,7 +215,7 @@
-- data types.
data ConstructorInfo = ConstructorInfo
{ constructorName :: Name -- ^ Constructor name
- , constructorVars :: [TyVarBndr] -- ^ Constructor type
parameters
+ , constructorVars :: [TyVarBndrUnit] -- ^ Constructor type
parameters
, constructorContext :: Cxt -- ^ Constructor constraints
, constructorFields :: [Type] -- ^ Constructor fields
, constructorStrictness :: [FieldStrictness] -- ^ Constructor fields'
strictness
@@ -517,7 +518,7 @@
-- A version of repairVarKindsWith that does much more extra work to
-- (1) eta-expand missing type patterns, and (2) ensure that the kind
-- signatures for these new type patterns match accordingly.
-repairVarKindsWith' :: [TyVarBndr] -> [Type] -> [Type]
+repairVarKindsWith' :: [TyVarBndr_ flag] -> [Type] -> [Type]
repairVarKindsWith' dvars ts =
let kindVars = freeVariables . map kindPart
kindPart (KindedTV _ k) = [k]
@@ -595,11 +596,11 @@
#endif
repairDataFam _ instD = instD
-repairVarKindsWith :: [TyVarBndr] -> [Type] -> [Type]
+repairVarKindsWith :: [TyVarBndr_ flag] -> [Type] -> [Type]
repairVarKindsWith = zipWith stealKindForType
-- If a VarT is missing an explicit kind signature, steal it from a TyVarBndr.
-stealKindForType :: TyVarBndr -> Type -> Type
+stealKindForType :: TyVarBndr_ flag -> Type -> Type
stealKindForType tvb t@VarT{} = SigT t (tvKind tvb)
stealKindForType _ t = t
@@ -674,7 +675,7 @@
= return di
-- Given a data type's instance types and kind, compute its free variables.
- datatypeFreeVars :: [Type] -> Maybe Kind -> [TyVarBndr]
+ datatypeFreeVars :: [Type] -> Maybe Kind -> [TyVarBndrUnit]
datatypeFreeVars instTys mbKind =
freeVariablesWellScoped $ instTys ++
#if MIN_VERSION_template_haskell(2,8,0)
@@ -683,7 +684,7 @@
[] -- No kind variables
#endif
- normalizeDataD :: Cxt -> Name -> [TyVarBndr] -> Maybe Kind
+ normalizeDataD :: Cxt -> Name -> [TyVarBndrUnit] -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalizeDataD context name tyvars mbKind cons variant =
let params = bndrParams tyvars in
@@ -691,7 +692,7 @@
params mbKind cons variant
normalizeDataInstDPostTH2'15
- :: String -> Cxt -> Maybe [TyVarBndr] -> Type -> Maybe Kind
+ :: String -> Cxt -> Maybe [TyVarBndrUnit] -> Type -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalizeDataInstDPostTH2'15 what context mbTyvars nameInstTys
mbKind cons variant =
@@ -710,7 +711,7 @@
instTys mbKind cons variant
-- The main worker of this function.
- normalize' :: Cxt -> Name -> [TyVarBndr] -> [Type] -> Maybe Kind
+ normalize' :: Cxt -> Name -> [TyVarBndrUnit] -> [Type] -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalize' context name tvbs instTys mbKind cons variant = do
extra_tvbs <- mkExtraKindBinders $ fromMaybe starK mbKind
@@ -733,12 +734,12 @@
-- are fresh type variable names.
--
-- This expands kind synonyms if necessary.
-mkExtraKindBinders :: Kind -> Q [TyVarBndr]
+mkExtraKindBinders :: Kind -> Q [TyVarBndrUnit]
mkExtraKindBinders kind = do
kind' <- resolveKindSynonyms kind
let (_, _, args :|- _) = uncurryKind kind'
names <- replicateM (length args) (newName "x")
- return $ zipWith KindedTV names args
+ return $ zipWith kindedTV names args
-- | Is a declaration for a @data instance@ or @newtype instance@?
isFamInstVariant :: DatatypeVariant -> Bool
@@ -749,16 +750,8 @@
DataInstance -> True
NewtypeInstance -> True
-bndrParams :: [TyVarBndr] -> [Type]
-bndrParams = map $ \bndr ->
- case bndr of
- KindedTV t k -> SigT (VarT t) k
- PlainTV t -> VarT t
-
--- | Extract the kind from a 'TyVarBndr'. Assumes 'PlainTV' has kind @*@.
-tvKind :: TyVarBndr -> Kind
-tvKind (PlainTV _) = starK
-tvKind (KindedTV _ k) = k
+bndrParams :: [TyVarBndr_ flag] -> [Type]
+bndrParams = map $ elimTV VarT (\n k -> SigT (VarT n) k)
-- | Remove the outermost 'SigT'.
stripSigT :: Type -> Type
@@ -770,7 +763,7 @@
IsReifiedDec {- ^ Is this a reified 'Dec'? -} ->
Cxt {- ^ Datatype context -} ->
Name {- ^ Type constructor -} ->
- [TyVarBndr] {- ^ Type parameters -} ->
+ [TyVarBndrUnit] {- ^ Type parameters -} ->
[Type] {- ^ Argument types -} ->
[Con] {- ^ Constructors -} ->
DatatypeVariant {- ^ Extra information -} ->
@@ -792,7 +785,7 @@
-- 'Dec'.
normalizeCon ::
Name {- ^ Type constructor -} ->
- [TyVarBndr] {- ^ Type parameters -} ->
+ [TyVarBndrUnit] {- ^ Type parameters -} ->
[Type] {- ^ Argument types -} ->
DatatypeVariant {- ^ Extra information -} ->
Con {- ^ Constructor -} ->
@@ -802,7 +795,7 @@
normalizeConFor ::
IsReifiedDec {- ^ Is this a reified 'Dec'? -} ->
Name {- ^ Type constructor -} ->
- [TyVarBndr] {- ^ Type parameters -} ->
+ [TyVarBndrUnit] {- ^ Type parameters -} ->
[Type] {- ^ Argument types -} ->
DatatypeVariant {- ^ Extra information -} ->
Con {- ^ Constructor -} ->
@@ -857,7 +850,7 @@
let defaultCase :: Con -> Q [ConstructorInfo]
defaultCase = go [] [] False
where
- go :: [TyVarBndr]
+ go :: [TyVarBndrUnit]
-> Cxt
-> Bool -- Is this a GADT? (see the documentation for
-- for checkGadtFixity)
@@ -883,7 +876,7 @@
return [ConstructorInfo n tyvars context
(takeFieldTypes xs) stricts (RecordConstructor
fns)]
ForallC tyvars' context' c' ->
- go (tyvars'++tyvars) (context'++context) True c'
+ go (changeTVFlags () tyvars'++tyvars) (context'++context)
True c'
#if MIN_VERSION_template_haskell(2,11,0)
GadtC ns xs innerType ->
let (bangs, ts) = unzip xs
@@ -1016,9 +1009,9 @@
normalizeGadtC ::
Name {- ^ Type constructor -} ->
- [TyVarBndr] {- ^ Type parameters -} ->
+ [TyVarBndrUnit] {- ^ Type parameters -} ->
[Type] {- ^ Argument types -} ->
- [TyVarBndr] {- ^ Constructor parameters -} ->
+ [TyVarBndrUnit] {- ^ Constructor parameters -} ->
Cxt {- ^ Constructor context -} ->
[Name] {- ^ Constructor names -} ->
Type {- ^ Declared type of constructor -} ->
@@ -1040,7 +1033,8 @@
-- so we use freeVariablesWellScoped to obtain the implicit type
-- variables' binders before proceeding.
let implicitTyvars = freeVariablesWellScoped
- [curryType tyvars context fields innerType]
+ [curryType (changeTVFlags SpecifiedSpec tyvars)
+ context fields innerType]
allTyvars = implicitTyvars ++ tyvars
-- Due to GHC Trac #13885, it's possible that the type variables bound by
@@ -1055,10 +1049,9 @@
| n <- conBoundNames ]
let conSubst' = fmap VarT conSubst
renamedTyvars =
- map (\tvb -> case tvb of
- PlainTV n -> PlainTV (conSubst Map.! n)
- KindedTV n k -> KindedTV (conSubst Map.! n)
- (applySubstitution
conSubst' k)) allTyvars
+ map (elimTV (\n -> plainTV (conSubst Map.! n))
+ (\n k -> kindedTV (conSubst Map.! n)
+ (applySubstitution conSubst' k)))
allTyvars
renamedContext = applySubstitution conSubst' context
renamedInnerType = applySubstitution conSubst' innerType
renamedFields = applySubstitution conSubst' fields
@@ -1193,19 +1186,18 @@
-- 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 *.
-kindsOfFVsOfTvbs :: [TyVarBndr] -> Map Name Kind
+kindsOfFVsOfTvbs :: [TyVarBndr_ flag] -> Map Name Kind
kindsOfFVsOfTvbs = foldMap go
where
- go :: TyVarBndr -> Map Name Kind
- go (PlainTV n) = Map.singleton n starK
- go (KindedTV n k) =
- let kSigs =
+ go :: TyVarBndr_ flag -> Map Name Kind
+ go = elimTV (\n -> Map.singleton n starK)
+ (\n k -> let kSigs =
#if MIN_VERSION_template_haskell(2,8,0)
- kindsOfFVsOfTypes [k]
+ kindsOfFVsOfTypes [k]
#else
- Map.empty
+ Map.empty
#endif
- in Map.insert n k kSigs
+ in Map.insert n k kSigs)
mergeArguments ::
[Type] {- ^ outer parameters -} ->
@@ -1317,14 +1309,13 @@
#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
+resolve_tvb_syns :: TyVarBndr_ flag -> Q (TyVarBndr_ flag)
+resolve_tvb_syns = mapMTVKind resolveKindSynonyms
expandSynonymRHS ::
- [TyVarBndr] {- ^ Substitute these variables... -} ->
- [Type] {- ^ ...with these types... -} ->
- Type {- ^ ...inside of this type. -} ->
+ [TyVarBndr_ flag] {- ^ Substitute these variables... -} ->
+ [Type] {- ^ ...with these types... -} ->
+ Type {- ^ ...inside of this type. -} ->
Type
expandSynonymRHS synvars ts def =
let argNames = map tvName synvars
@@ -1433,7 +1424,7 @@
-- becomes
--
-- ([a, b], [Show a, b ~ Int], [a -> b, Char] :|- Int)
-uncurryType :: Type -> ([TyVarBndr], Cxt, NonEmptySnoc Type)
+uncurryType :: Type -> ([TyVarBndrSpec], Cxt, NonEmptySnoc Type)
uncurryType = go [] [] []
where
go tvbs ctxt args (AppT (AppT ArrowT t1) t2) = go tvbs ctxt (t1:args) t2
@@ -1448,7 +1439,7 @@
-- becomes
--
-- ([a, b], [], [Maybe a, Maybe b] :|- Type)
-uncurryKind :: Kind -> ([TyVarBndr], Cxt, NonEmptySnoc Kind)
+uncurryKind :: Kind -> ([TyVarBndrSpec], Cxt, NonEmptySnoc Kind)
#if MIN_VERSION_template_haskell(2,8,0)
uncurryKind = uncurryType
#else
@@ -1460,7 +1451,7 @@
-- Reconstruct a function type from its type variable binders, context,
-- argument types and return type.
-curryType :: [TyVarBndr] -> Cxt -> [Type] -> Type -> Type
+curryType :: [TyVarBndrSpec] -> Cxt -> [Type] -> Type -> Type
curryType tvbs ctxt args res =
ForallT tvbs ctxt $ foldr (\arg t -> ArrowT `AppT` arg `AppT` t) res args
@@ -1470,7 +1461,7 @@
resolveInfixT :: Type -> Q Type
#if MIN_VERSION_template_haskell(2,11,0)
-resolveInfixT (ForallT vs cx t) = ForallT <$> traverse (traverseTvbKind
resolveInfixT) vs
+resolveInfixT (ForallT vs cx t) = ForallT <$> traverse (traverseTVKind
resolveInfixT) vs
<*> mapM resolveInfixT cx
<*> resolveInfixT t
resolveInfixT (f `AppT` x) = resolveInfixT f `appT` resolveInfixT x
@@ -1484,7 +1475,7 @@
= implicitParamT n $ resolveInfixT t
# endif
# if MIN_VERSION_template_haskell(2,16,0)
-resolveInfixT (ForallVisT vs t) = ForallVisT <$> traverse (traverseTvbKind
resolveInfixT) vs
+resolveInfixT (ForallVisT vs t) = ForallVisT <$> traverse (traverseTVKind
resolveInfixT) vs
<*> resolveInfixT t
# endif
resolveInfixT t = return t
@@ -1553,13 +1544,6 @@
showFixityDirection InfixR = "infixr"
showFixityDirection InfixN = "infix"
-
--- | Extract the type variable name from a 'TyVarBndr' ignoring the
--- kind signature if one exists.
-tvName :: TyVarBndr -> Name
-tvName (PlainTV name ) = name
-tvName (KindedTV name _) = name
-
takeFieldNames :: [(Name,a,b)] -> [Name]
takeFieldNames xs = [a | (a,_,_) <- xs]
@@ -1596,7 +1580,7 @@
| otherwise
= ForallT tvbs [] t
where
- tvbs = freeVariablesWellScoped [t]
+ tvbs = changeTVFlags SpecifiedSpec $ freeVariablesWellScoped [t]
-- | Take a list of 'Type's, find their free variables, and sort them
-- according to dependency order.
@@ -1632,7 +1616,7 @@
--
-- On older GHCs, this takes measures to avoid returning explicitly bound
-- kind variables, which was not possible before @TypeInType@.
-freeVariablesWellScoped :: [Type] -> [TyVarBndr]
+freeVariablesWellScoped :: [Type] -> [TyVarBndrUnit]
freeVariablesWellScoped tys =
let fvs :: [Name]
fvs = freeVariables tys
@@ -1724,7 +1708,7 @@
kindFVSet n =
maybe Set.empty (Set.fromList . freeVariables) (Map.lookup n
varKindSigs)
ascribeWithKind n =
- maybe (PlainTV n) (KindedTV n) (Map.lookup n varKindSigs)
+ maybe (plainTV n) (kindedTV n) (Map.lookup n varKindSigs)
-- An annoying wrinkle: GHCs before 8.0 don't support explicitly
-- quantifying kinds, so something like @forall k (a :: k)@ would be
@@ -1790,7 +1774,7 @@
where
go (ForallT tvs context t) =
subst_tvbs tvs $ \subst' ->
- ForallT (map (mapTvbKind (applySubstitution subst')) tvs)
+ ForallT (map (mapTVKind (applySubstitution subst')) tvs)
(applySubstitution subst' context)
(applySubstitution subst' t)
go (AppT f x) = AppT (go f) (go x)
@@ -1809,12 +1793,12 @@
#if MIN_VERSION_template_haskell(2,16,0)
go (ForallVisT tvs t) =
subst_tvbs tvs $ \subst' ->
- ForallVisT (map (mapTvbKind (applySubstitution subst')) tvs)
+ ForallVisT (map (mapTVKind (applySubstitution subst')) tvs)
(applySubstitution subst' t)
#endif
go t = t
- subst_tvbs :: [TyVarBndr] -> (Map Name Type -> a) -> a
+ subst_tvbs :: [TyVarBndr_ flag] -> (Map Name Type -> a) -> a
subst_tvbs tvs k = k $ foldl' (flip Map.delete) subst (map tvName tvs)
freeVariables t =
@@ -1840,7 +1824,7 @@
#endif
_ -> []
where
- fvs_under_forall :: [TyVarBndr] -> [Name] -> [Name]
+ fvs_under_forall :: [TyVarBndr_ flag] -> [Name] -> [Name]
fvs_under_forall tvs fvs =
(freeVariables (map tvKind tvs) `union` fvs)
\\ map tvName tvs
@@ -1854,20 +1838,12 @@
applySubstitution subst ci =
let subst' = foldl' (flip Map.delete) subst (map tvName (constructorVars
ci)) in
- ci { constructorVars = map (mapTvbKind (applySubstitution subst'))
+ ci { constructorVars = map (mapTVKind (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
@@ -1888,11 +1864,10 @@
-- | Substitutes into the kinds of type variable binders.
-- Not capture-avoiding.
-substTyVarBndrs :: Map Name Type -> [TyVarBndr] -> [TyVarBndr]
+substTyVarBndrs :: Map Name Type -> [TyVarBndr_ flag] -> [TyVarBndr_ flag]
substTyVarBndrs subst = map go
where
- go tvb@(PlainTV {}) = tvb
- go (KindedTV n k) = KindedTV n (applySubstitution subst k)
+ go = mapTVKind (applySubstitution subst)
------------------------------------------------------------------------
@@ -2014,9 +1989,8 @@
giveCIVarsStarKinds info =
info { constructorVars = map giveTyVarBndrStarKind (constructorVars info) }
-giveTyVarBndrStarKind :: TyVarBndr -> TyVarBndr
-giveTyVarBndrStarKind (PlainTV n) = KindedTV n starK
-giveTyVarBndrStarKind tvb@KindedTV{} = tvb
+giveTyVarBndrStarKind :: TyVarBndrUnit -> TyVarBndrUnit
+giveTyVarBndrStarKind tvb = elimTV (\n -> kindedTV n starK) (\_ _ -> tvb) tvb
giveTypeStarKind :: Type -> Type
giveTypeStarKind t@(VarT n) = SigT t starK
@@ -2062,11 +2036,11 @@
-- | Backward compatible version of 'dataD'
dataDCompat ::
- CxtQ {- ^ context -} ->
- Name {- ^ type constructor -} ->
- [TyVarBndr] {- ^ type parameters -} ->
- [ConQ] {- ^ constructor definitions -} ->
- [Name] {- ^ derived class names -} ->
+ CxtQ {- ^ context -} ->
+ Name {- ^ type constructor -} ->
+ [TyVarBndrUnit] {- ^ type parameters -} ->
+ [ConQ] {- ^ constructor definitions -} ->
+ [Name] {- ^ derived class names -} ->
DecQ
#if MIN_VERSION_template_haskell(2,12,0)
dataDCompat c n ts cs ds =
@@ -2082,11 +2056,11 @@
-- | Backward compatible version of 'newtypeD'
newtypeDCompat ::
- CxtQ {- ^ context -} ->
- Name {- ^ type constructor -} ->
- [TyVarBndr] {- ^ type parameters -} ->
- ConQ {- ^ constructor definition -} ->
- [Name] {- ^ derived class names -} ->
+ CxtQ {- ^ context -} ->
+ Name {- ^ type constructor -} ->
+ [TyVarBndrUnit] {- ^ type parameters -} ->
+ ConQ {- ^ constructor definition -} ->
+ [Name] {- ^ derived class names -} ->
DecQ
#if MIN_VERSION_template_haskell(2,12,0)
newtypeDCompat c n ts cs ds =
@@ -2102,10 +2076,10 @@
-- | Backward compatible version of 'tySynInstD'
tySynInstDCompat ::
- Name {- ^ type family name -} ->
- Maybe [Q TyVarBndr] {- ^ type variable binders -} ->
- [TypeQ] {- ^ instance parameters -} ->
- TypeQ {- ^ instance result -} ->
+ Name {- ^ type family name -} ->
+ Maybe [Q TyVarBndrUnit] {- ^ type variable binders -} ->
+ [TypeQ] {- ^ instance parameters -} ->
+ TypeQ {- ^ instance result -} ->
DecQ
#if MIN_VERSION_template_haskell(2,15,0)
tySynInstDCompat n mtvbs ps r = TySynInstD <$> (TySynEqn <$> mapM sequence
mtvbs
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/th-abstraction-0.3.2.0/test/Harness.hs
new/th-abstraction-0.4.0.0/test/Harness.hs
--- old/th-abstraction-0.3.2.0/test/Harness.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/th-abstraction-0.4.0.0/test/Harness.hs 2001-09-09 03:46:40.000000000
+0200
@@ -27,6 +27,7 @@
import Data.Maybe
import Language.Haskell.TH
import Language.Haskell.TH.Datatype
+import Language.Haskell.TH.Datatype.TyVarBndr
import Language.Haskell.TH.Lib (starK)
validateDI :: DatatypeInfo -> DatatypeInfo -> ExpQ
@@ -110,12 +111,10 @@
RecordConstructor fields -> RecordConstructor $ map (mkName .
nameBase) fields
-- Substitutes both type variable names and kinds.
-substIntoTyVarBndrs :: Map Name Type -> [TyVarBndr] -> [TyVarBndr]
+substIntoTyVarBndrs :: Map Name Type -> [TyVarBndr_ flag] -> [TyVarBndr_ flag]
substIntoTyVarBndrs subst = map go
where
- go (PlainTV n) = PlainTV $ substName subst n
- go (KindedTV n k) = KindedTV (substName subst n)
- (applySubstitution subst k)
+ go = mapTV (substName subst) id (applySubstitution subst)
substName :: Map Name Type -> Name -> Name
substName subst n = fromMaybe n $ do
@@ -124,11 +123,8 @@
VarT n' -> Just n'
_ -> Nothing
-bndrParams :: [TyVarBndr] -> [Type]
-bndrParams = map $ \bndr ->
- case bndr of
- KindedTV t k -> SigT (VarT t) k
- PlainTV t -> VarT t
+bndrParams :: [TyVarBndr_ flag] -> [Type]
+bndrParams = map $ elimTV VarT (\n k -> SigT (VarT n) k)
equateStrictness :: FieldStrictness -> FieldStrictness -> Either String ()
equateStrictness fs1 fs2 =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/th-abstraction-0.3.2.0/test/Main.hs
new/th-abstraction-0.4.0.0/test/Main.hs
--- old/th-abstraction-0.3.2.0/test/Main.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/th-abstraction-0.4.0.0/test/Main.hs 2001-09-09 03:46:40.000000000
+0200
@@ -40,6 +40,7 @@
import Language.Haskell.TH
import Language.Haskell.TH.Datatype
+import Language.Haskell.TH.Datatype.TyVarBndr
import Language.Haskell.TH.Lib (starK)
import Harness
@@ -109,7 +110,7 @@
$(do info <- reifyDatatype ''Adt1
let names = map mkName ["a","b"]
- [aTvb,bTvb] = map (\v -> KindedTV v starK) names
+ [aTvb,bTvb] = map (\v -> kindedTV v starK) names
vars@[aVar,bVar] = map (VarT . mkName) ["a","b"]
[aSig,bSig] = map (\v -> SigT v starK) vars
@@ -150,7 +151,7 @@
DatatypeInfo
{ datatypeName = ''Gadt1
, datatypeContext = []
- , datatypeVars = [KindedTV a starK]
+ , datatypeVars = [kindedTV a starK]
, datatypeInstTypes = [SigT aVar starK]
, datatypeVariant = Datatype
, datatypeCons =
@@ -197,7 +198,7 @@
DatatypeInfo
{ datatypeName = ''Gadtrec1
, datatypeContext = []
- , datatypeVars = [KindedTV a starK]
+ , datatypeVars = [kindedTV a starK]
, datatypeInstTypes = [SigT (VarT a) starK]
, datatypeVariant = Datatype
, datatypeCons =
@@ -210,7 +211,7 @@
$(do info <- reifyDatatype ''Equal
let names = map mkName ["a","b","c"]
- [aTvb,bTvb,cTvb] = map (\v -> KindedTV v starK) names
+ [aTvb,bTvb,cTvb] = map (\v -> kindedTV v starK) names
vars@[aVar,bVar,cVar] = map VarT names
[aSig,bSig,cSig] = map (\v -> SigT v starK) vars
@@ -256,7 +257,7 @@
, datatypeCons =
[ ConstructorInfo
{ constructorName = 'Showable
- , constructorVars = [KindedTV a starK]
+ , constructorVars = [kindedTV a starK]
, constructorContext = [classPred ''Show [VarT a]]
, constructorFields = [VarT a]
, constructorStrictness = [notStrictAnnot]
@@ -291,7 +292,7 @@
gadt2Test =
$(do info <- reifyDatatype ''Gadt2
let names = map mkName ["a","b"]
- [aTvb,bTvb] = map (\v -> KindedTV v starK) names
+ [aTvb,bTvb] = map (\v -> kindedTV v starK) names
vars@[aVar,bVar] = map VarT names
[aSig,bSig] = map (\v -> SigT v starK) vars
x = mkName "x"
@@ -316,7 +317,7 @@
, con { constructorName = 'Gadt2c2
, constructorContext = [equalPred aVar (AppT ListT bVar)]
}
, con { constructorName = 'Gadt2c3
- , constructorVars = [KindedTV x starK]
+ , constructorVars = [kindedTV x starK]
, constructorContext =
[equalPred aVar (AppT ListT (VarT x))
,equalPred bVar (AppT ListT (VarT x))] } ]
@@ -331,7 +332,7 @@
DatatypeInfo
{ datatypeName = ''VoidStoS
, datatypeContext = []
- , datatypeVars = [KindedTV g (arrowKCompat starK starK)]
+ , datatypeVars = [kindedTV g (arrowKCompat starK starK)]
, datatypeInstTypes = [SigT (VarT g) (arrowKCompat starK starK)]
, datatypeVariant = Datatype
, datatypeCons = []
@@ -425,7 +426,7 @@
, datatypeCons =
[ ConstructorInfo
{ constructorName = mkName "MkFoo"
- , constructorVars = [KindedTV a starK]
+ , constructorVars = [kindedTV a starK]
, constructorContext = []
, constructorFields = [VarT a]
, constructorStrictness = [notStrictAnnot]
@@ -443,7 +444,7 @@
DatatypeInfo
{ datatypeName = ''DF
, datatypeContext = []
- , datatypeVars = [KindedTV a starK]
+ , datatypeVars = [kindedTV a starK]
, datatypeInstTypes = [AppT (ConT ''Maybe) (VarT a)]
, datatypeVariant = DataInstance
, datatypeCons =
@@ -466,7 +467,7 @@
DatatypeInfo
{ datatypeName = ''DF1
, datatypeContext = []
- , datatypeVars = [KindedTV c starK]
+ , datatypeVars = [kindedTV c starK]
, datatypeInstTypes = [SigT cVar starK]
, datatypeVariant = DataInstance
, datatypeCons =
@@ -490,7 +491,7 @@
DatatypeInfo
{ datatypeName = mkName "Quoted"
, datatypeContext = []
- , datatypeVars = [KindedTV a starK]
+ , datatypeVars = [kindedTV a starK]
, datatypeInstTypes = [SigT aVar starK]
, datatypeVariant = DataInstance
, datatypeCons =
@@ -515,9 +516,9 @@
, datatypeContext = []
, datatypeVars = [
#if __GLASGOW_HASKELL__ >= 800
- KindedTV k starK,
+ kindedTV k starK,
#endif
- KindedTV a kVar ]
+ kindedTV a kVar ]
, datatypeInstTypes = [SigT (VarT a) kVar]
, datatypeVariant = DataInstance
, datatypeCons =
@@ -535,7 +536,7 @@
gadtFamTest =
$(do info <- reifyDatatype 'MkGadtFam1
let names@[c,d,e,q] = map mkName ["c","d","e","q"]
- [cTvb,dTvb,eTvb,qTvb] = map (\v -> KindedTV v starK) names
+ [cTvb,dTvb,eTvb,qTvb] = map (\v -> kindedTV v starK) names
[cTy,dTy,eTy,qTy] = map VarT names
[cSig,dSig] = map (\v -> SigT v starK) [cTy,dTy]
validateDI info
@@ -555,7 +556,7 @@
, constructorVariant = NormalConstructor }
, ConstructorInfo
{ constructorName = '(:&&:)
- , constructorVars = [KindedTV e starK]
+ , constructorVars = [kindedTV e starK]
, constructorContext = [equalPred cTy (AppT ListT eTy)]
, constructorFields = [eTy,dTy]
, constructorStrictness = [notStrictAnnot, notStrictAnnot]
@@ -581,7 +582,7 @@
, constructorVariant = NormalConstructor }
, ConstructorInfo
{ constructorName = 'MkGadtFam5
- , constructorVars = [KindedTV q starK]
+ , constructorVars = [kindedTV q starK]
, constructorContext = [ equalPred cTy (ConT ''Bool)
, equalPred dTy (ConT ''Bool)
, equalPred qTy (ConT ''Char)
@@ -619,7 +620,7 @@
$(do [dec] <- [d| data instance FamLocalDec2 Int (a, b) a = FamLocalDec2Int
{ fm0 :: (b, a), fm1 :: Int } |]
info <- normalizeDec dec
let names = map mkName ["a", "b"]
- [aTvb,bTvb] = map (\v -> KindedTV v starK) names
+ [aTvb,bTvb] = map (\v -> kindedTV v starK) names
vars@[aVar,bVar] = map (VarT . mkName) ["a", "b"]
[aSig,bSig] = map (\v -> SigT v starK) vars
validateDI info
@@ -658,7 +659,7 @@
t73Test =
$(do info <- reifyDatatype 'MkT73
let b = mkName "b"
- bTvb = KindedTV b starK
+ bTvb = kindedTV b starK
bVar = VarT b
validateDI info
DatatypeInfo
@@ -706,7 +707,7 @@
DatatypeInfo
{ datatypeContext = []
, datatypeName = ''Maybe
- , datatypeVars = [KindedTV a starK]
+ , datatypeVars = [kindedTV a starK]
, datatypeInstTypes = [SigT (VarT a) starK]
, datatypeVariant = Datatype
, datatypeCons =
@@ -742,9 +743,9 @@
, datatypeName = ''(:~:)
, datatypeVars = [
#if __GLASGOW_HASKELL__ >= 800
- KindedTV k starK,
+ kindedTV k starK,
#endif
- KindedTV a kKind, KindedTV b kKind]
+ kindedTV a kKind, kindedTV b kKind]
, datatypeInstTypes = [SigT aVar kKind, SigT bVar kKind]
, datatypeVariant = Datatype
, datatypeCons =
@@ -765,7 +766,7 @@
$(do k1 <- newName "k1"
k2 <- newName "k2"
a <- newName "a"
- let ty = ForallT [KindedTV a (VarT k1)] [] (VarT a)
+ let ty = ForallT [kindedTVSpecified a (VarT k1)] [] (VarT a)
substTy = applySubstitution (Map.singleton k1 (VarT k2)) ty
checkFreeVars :: Type -> [Name] -> Q ()
@@ -785,9 +786,9 @@
-- Proxy (a :: k)
expected = ForallT
#if __GLASGOW_HASKELL__ >= 800
- [PlainTV k, KindedTV a (VarT k)]
+ [plainTVSpecified k, kindedTVSpecified a (VarT k)]
#else
- [KindedTV a (VarT k)]
+ [kindedTVSpecified a (VarT k)]
#endif
[] proxyAK
actual = quantifyType proxyAK
@@ -814,10 +815,10 @@
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)]
+ test (ForallT [kindedTVSpecified a (idAppT StarT)]
[idAppT (ConT ''Show `AppT` VarT a)]
(idAppT $ VarT a))
- (ForallT [KindedTV a StarT]
+ (ForallT [kindedTVSpecified a StarT]
[ConT ''Show `AppT` VarT a]
(VarT a))
#endif
@@ -840,8 +841,8 @@
DatatypeInfo
{ datatypeName = mkName "Foo"
, datatypeContext = []
- , datatypeVars = [ KindedTV a starK ,KindedTV b starK
- , KindedTV f fKind, KindedTV x starK ]
+ , datatypeVars = [ kindedTV a starK, kindedTV b starK
+ , kindedTV f fKind, kindedTV x starK ]
, datatypeInstTypes = [ SigT (VarT a) starK, SigT (VarT b) starK
, SigT (VarT f) fKind, SigT (VarT x) starK ]
, datatypeVariant = Datatype
@@ -860,7 +861,10 @@
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 ''())
+ t = ForallT [ plainTVSpecified k
+ , kindedTVSpecified a (VarT k)
+ , kindedTVSpecified b (VarT k)
+ ] [] (ConT ''())
expected, actual :: [Name]
expected = []
@@ -878,9 +882,9 @@
t79Test :: IO ()
t79Test =
$(do let [a,b,c] = map mkName ["a","b","c"]
- t = ForallT [KindedTV a (UInfixT (VarT b) ''(:+:) (VarT c))]
[]
+ t = ForallT [kindedTVSpecified a (UInfixT (VarT b) ''(:+:)
(VarT c))] []
(ConT ''())
- expected = ForallT [KindedTV a (ConT ''(:+:) `AppT` VarT b `AppT`
VarT c)] []
+ expected = ForallT [kindedTVSpecified a (ConT ''(:+:) `AppT` VarT b
`AppT` VarT c)] []
(ConT ''())
actual <- resolveInfixT t
unless (expected == actual) $
@@ -900,8 +904,8 @@
[kVar,aVar] = map VarT names
kSig = SigT kVar starK
aSig = SigT aVar kVar
- kTvb = KindedTV k starK
- aTvb = KindedTV a kVar
+ kTvb = kindedTV k starK
+ aTvb = kindedTV a kVar
validateDI infoA
DatatypeInfo
{ datatypeContext = []
@@ -965,13 +969,13 @@
DatatypeInfo
{ datatypeContext = []
, datatypeName = ''T48
- , datatypeVars = [KindedTV a starK]
+ , datatypeVars = [kindedTV a starK]
, datatypeInstTypes = [SigT aVar starK]
, datatypeVariant = Datatype
, datatypeCons =
[ ConstructorInfo
{ constructorName = 'MkT48
- , constructorVars = [KindedTV x aVar]
+ , constructorVars = [kindedTV x aVar]
, constructorContext = []
, constructorFields = [ConT ''Prox `AppT` VarT x]
, constructorStrictness = [notStrictAnnot]
@@ -982,13 +986,13 @@
-- unfortunately does not check if the uses of `a` in datatypeVars and
-- constructorVars are the same. We perform this check explicitly here.
case info of
- DatatypeInfo { datatypeVars = [KindedTV a1 starK]
+ DatatypeInfo { datatypeVars = [v1]
, datatypeCons =
- [ ConstructorInfo
- { constructorVars = [KindedTV _ (VarT a2)] } ] }
->
- unless (a1 == a2) $
- fail $ "Two occurrences of the same variable have different
names: "
- ++ show [a1, a2]
+ [ConstructorInfo { constructorVars = [v2] }] }
+ | a1 <- tvName v1, starK == tvKind v1, VarT a2 <- tvKind v2
+ -> unless (a1 == a2) $
+ fail $ "Two occurrences of the same variable have different
names: "
+ ++ show [a1, a2]
[| return () |]
)
@@ -1036,8 +1040,8 @@
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
+ sigmaType = ForallT [plainTVSpecified b] [] tauType
+ expected = ForallT [plainTVSpecified a, plainTVSpecified b] []
tauType
actual = quantifyType sigmaType
unless (expected == actual) $
fail $ "quantifyType does not collapse consecutive foralls: "
@@ -1051,7 +1055,7 @@
$(do a <- newName "a"
b <- newName "b"
let [aVar, bVar] = map VarT [a, b]
- [aTvb, bTvb] = map PlainTV [a, b]
+ [aTvb, bTvb] = map plainTV [a, b]
let fvsABExpected = [aTvb, bTvb]
fvsABActual = freeVariablesWellScoped [aVar, bVar]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/th-abstraction-0.3.2.0/test/Types.hs
new/th-abstraction-0.4.0.0/test/Types.hs
--- old/th-abstraction-0.3.2.0/test/Types.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/th-abstraction-0.4.0.0/test/Types.hs 2001-09-09 03:46:40.000000000
+0200
@@ -31,6 +31,7 @@
import Language.Haskell.TH hiding (Type)
import Language.Haskell.TH.Datatype
+import Language.Haskell.TH.Datatype.TyVarBndr
import Language.Haskell.TH.Lib (starK)
#if __GLASGOW_HASKELL__ >= 800
@@ -171,7 +172,7 @@
where
a = VarT (mkName "a")
names@[v1,v2] = map mkName ["v1","v2"]
- [v1K,v2K] = map (\n -> KindedTV n starK) names
+ [v1K,v2K] = map (\n -> kindedTV n starK) names
#if MIN_VERSION_template_haskell(2,7,0)
gadtRecFamCI :: ConstructorInfo
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/th-abstraction-0.3.2.0/th-abstraction.cabal
new/th-abstraction-0.4.0.0/th-abstraction.cabal
--- old/th-abstraction-0.3.2.0/th-abstraction.cabal 2001-09-09
03:46:40.000000000 +0200
+++ new/th-abstraction-0.4.0.0/th-abstraction.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -1,5 +1,5 @@
name: th-abstraction
-version: 0.3.2.0
+version: 0.4.0.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.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
+tested-with: GHC==8.10.1, GHC==8.8.3, 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
@@ -25,10 +25,11 @@
library
exposed-modules: Language.Haskell.TH.Datatype
+ Language.Haskell.TH.Datatype.TyVarBndr
other-modules: Language.Haskell.TH.Datatype.Internal
build-depends: base >=4.3 && <5,
ghc-prim,
- template-haskell >=2.5 && <2.17,
+ template-haskell >=2.5 && <2.18,
containers >=0.4 && <0.7
hs-source-dirs: src
default-language: Haskell2010
