diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,168 @@ # Revision history for th-abstraction +## 0.6.0.0 -- 2023.07.31 +* Support building with `template-haskell-2.21.0.0` (GHC 9.8). +* Adapt to `TyVarBndr`s for type-level declarations changing their type from + `TyVarBndr ()` to `TyVarBndr BndrVis` in `template-haskell`: + + * `Language.Haskell.TH.Datatype.TyVarBndr` now backports `type BndrVis = ()`, + as well as `BndrReq` and `BndrInvis` pattern synonyms. These make it + possible to write code involving `BndrVis` that is somewhat backwards + compatible (but do see the caveats in the Haddocks for `BndrInvis`). + * `Language.Haskell.TH.Datatype.TyVarBndr` also backports the following + definitions: + * The `type TyVarBndrVis = TyVarBndr BndrVis` type synonym. + * The `DefaultBndrFlag` class, which can be used to write code that is + polymorphic over `TyVarBndr` flags while still allowing the code to return + a reasonable default value for the flag. + * The `bndrReq` and `bndrInvis` definitions, which behave identically to + `BndrReq` and `BndrInvis`. + * `Language.Haskell.TH.Datatype.TyVarBndr` now defines the following utility + functions, which are not present in `template-haskell`: + * `plainTVReq`, `plainTVInvis`, `kindedTVReq`, and `kindedTVInvis` + functions, which construct `PlainTV`s and `KindedTV`s with particular + `BndrVis` flags. + * An `elimTVFlag`, which behaves like `elimTV`, but where the continuation + arguments also take a `flag` argument. (Note that the type of this + function is slightly different on old versions of `template-haskell`. + See the Haddocks for more.) + * A `tvFlag` function, which extracts the `flag` from a `TyVarBndr`. (Note + that the type of this function is slightly different on old versions of + `template-haskell`. See the Haddocks for more.) + * The types of the `dataDCompat` and `newtypeDCompat` functions have had + their `[TyVarBndrUnit]` arguments changed to `[TyVarBndrVis]`, matching + similar changes to `DataD` and `NewtypeD` in `template-haskell`. + + Because `BndrVis` is a synonym for `()` on pre-9.8 versions of GHC, this + change is unlikely to break any existing code, provided that you build it + with GHC 9.6 or earlier. If you build with GHC 9.8 or later, on the other + hand, it is likely that you will need to update your existing code. Here are + some possible ways that your code might fail to compile with GHC 9.8, along + with some migration strategies: + + * Your code passes a `TyVarBndrUnit` in a place where a `TyVarBndrVis` is now + expected in GHC 9.8, such as in the arguments to `dataDCompat`: + + ```hs + import "template-haskell" Language.Haskell.TH + import "th-abstraction" Language.Haskell.TH.Datatype (dataDCompat) + + dec :: DecQ + dec = dataDCompat (pure []) d [PlainTV a ()] [] [] + where + d = mkName "d" + a = mkName "a" + ``` + + With GHC 9.8, this will fail to compile with: + + ``` + error: [GHC-83865] + • Couldn't match expected type ‘BndrVis’ with actual type ‘()’ + • In the second argument of ‘PlainTV’, namely ‘()’ + In the expression: PlainTV a () + In the third argument of ‘dataDCompat’, namely ‘[PlainTV a ()]’ + | + | dec = dataDCompat (pure []) d [PlainTV a ()] [] [] + | ^^ + ``` + + Some possible ways to migrate this code include: + + * Use the `bndrReq` function or `BndrReq` pattern synonym in place of `()`, + making sure to import them from `Language.Haskell.TH.Datatype.TyVarBndr`: + + ```hs + ... + import "th-abstraction" Language.Haskell.TH.Datatype.TyVarBndr + + dec :: DecQ + dec = dataDCompat (pure []) d [PlainTV a bndrReq] [] [] + -- Or, alternatively: + {- + dec = dataDCompat (pure []) d [PlainTV a BndrReq] [] [] + -} + where + ... + ``` + * Use the `plainTV` function from `Language.Haskell.TH.Datatype.TyVarBndr`, + which is now sufficiently polymorphic to work as both a `TyVarBndrUnit` + and a `TyVarBndrVis`: + + ```hs + ... + import Language.Haskell.TH.Datatype.TyVarBndr + + dec :: DecQ + dec = dataDCompat (pure []) d [plainTV a] [] [] + where + ... + ``` + * You may have to replace some uses of `TyVarBndrUnit` with `TyVarBndrVis` + in your code. For instance, this will no longer typecheck in GHC 9.8 for + similar reasons to the previous example: + + ```hs + import "template-haskell" Language.Haskell.TH + import "th-abstraction" Language.Haskell.TH.Datatype (dataDCompat) + + dec :: DecQ + dec = dataDCompat (pure []) d tvbs [] [] + where + tvbs :: [TyVarBndrUnit] + tvbs = [plainTV a] + + d = mkName "d" + a = mkName "a" + ``` + + Here is a version that will typecheck with GHC 9.8 and earlier: + + ```hs + ... + import "th-abstraction" Language.Haskell.TH.Datatype.TyVarBndr + + dec :: DecQ + dec = dataDCompat (pure []) d tvbs [] [] + where + tvbs :: [TyVarBndrVis] + tvbs = [plainTV a] + + ... + ``` + * In some cases, the `TyVarBndrUnit`s might come from another place in the + code, e.g., + + ```hs + import "template-haskell" Language.Haskell.TH + import "th-abstraction" Language.Haskell.TH.Datatype (dataDCompat) + + dec :: [TyVarBndrUnit] -> DecQ + dec tvbs = dataDCompat (pure []) d tvbs [] [] + where + d = mkName "d" + ``` + + If it is not straightforward to change `dec`'s type to accept + `[TyVarBndrVis]` as an argument, another viable option is to use the + `changeTVFlags` function: + + ```hs + ... + import "th-abstraction" Language.Haskell.TH.Datatype.TyVarBndr + + dec :: [TyVarBndrUnit] -> DecQ + dec tvbs = dataDCompat (pure []) d tvbs' [] [] + where + tvbs' :: [TyVarBndrVis] + tvbs' = changeTVFlags bndrReq tvbs + + ... + ``` + + This guide, while not comprehensive, should cover most of the common cases one + will encounter when migrating their `th-abstraction` code to support GHC 9.8. + ## 0.5.0.0 -- 2023.02.27 * Support the `TypeData` language extension added in GHC 9.6. The `DatatypeVariant` data type now has a separate `TypeData` constructor to diff --git a/src/Language/Haskell/TH/Datatype.hs b/src/Language/Haskell/TH/Datatype.hs --- a/src/Language/Haskell/TH/Datatype.hs +++ b/src/Language/Haskell/TH/Datatype.hs @@ -173,6 +173,11 @@ -- @'datatypeInstTypes' = ['SigT' ('VarT' a) ('VarT' k)]@, since there is -- only one explicit type argument to @Proxy@. -- +-- The same outcome would occur if @Proxy@ were declared using +-- @TypeAbstractions@, i.e., if it were declared as +-- @data Proxy \@k (a :: k) = MkProxy@. The 'datatypeInstTypes' would /not/ +-- include a separate type for @\@k@. +-- -- * For @data instance@s and @newtype instance@s of data families, -- 'datatypeVars' and 'datatypeInstTypes' can be quite different. Here is -- an example to illustrate the difference: @@ -641,12 +646,12 @@ -- The @F@ has no type variable binders in its @data family@ declaration, and -- it has a return kind of @Type -> Type@. As a result, we pair up @Type@ with -- @VarT a@ to get @SigT a (ConT ''Type)@. -repairVarKindsWith :: [TyVarBndrUnit] -> Maybe Kind -> [Type] -> Q [Type] +repairVarKindsWith :: [TyVarBndrVis] -> Maybe Kind -> [Type] -> Q [Type] repairVarKindsWith tvbs mbKind ts = do extra_tvbs <- mkExtraKindBinders $ fromMaybe starK mbKind -- This list should be the same length as @ts@. If it isn't, something has -- gone terribly wrong. - let tvbs' = tvbs ++ extra_tvbs + let tvbs' = changeTVFlags () tvbs ++ extra_tvbs return $ zipWith stealKindForType tvbs' ts -- If a VarT is missing an explicit kind signature, steal it from a TyVarBndr. @@ -738,12 +743,19 @@ [] -- No kind variables #endif - normalizeDataD :: Cxt -> Name -> [TyVarBndrUnit] -> Maybe Kind + normalizeDataD :: Cxt -> Name -> [TyVarBndrVis] -> Maybe Kind -> [Con] -> DatatypeVariant -> Q DatatypeInfo normalizeDataD context name tyvars mbKind cons variant = - let params = bndrParams tyvars in - normalize' context name (datatypeFreeVars params mbKind) - params mbKind cons variant + -- NB: use `filter isRequiredTvb tyvars` here. It is possible for some of + -- the `tyvars` to be `BndrInvis` if the data type is quoted, e.g., + -- + -- data D @k (a :: k) + -- + -- th-abstraction adopts the convention that all binders in the + -- 'datatypeInstTypes' are required, so we want to filter out the `@k`. + let tys = bndrParams $ filter isRequiredTvb tyvars in + normalize' context name (datatypeFreeVars (bndrParams tyvars) mbKind) + tys mbKind cons variant normalizeDataInstDPostTH2'15 :: String -> Cxt -> Maybe [TyVarBndrUnit] -> Type -> Maybe Kind @@ -808,6 +820,14 @@ bndrParams :: [TyVarBndr_ flag] -> [Type] bndrParams = map $ elimTV VarT (\n k -> SigT (VarT n) k) +-- | Returns 'True' if the flag of the supplied 'TyVarBndrVis' is 'BndrReq'. +isRequiredTvb :: TyVarBndrVis -> Bool +#if __GLASGOW_HASKELL__ >= 708 +isRequiredTvb tvb = tvFlag tvb == BndrReq +#else +isRequiredTvb _ = True +#endif + -- | Remove the outermost 'SigT'. stripSigT :: Type -> Type stripSigT (SigT t _) = t @@ -2170,11 +2190,11 @@ -- | Backward compatible version of 'dataD' dataDCompat :: - CxtQ {- ^ context -} -> - Name {- ^ type constructor -} -> - [TyVarBndrUnit] {- ^ type parameters -} -> - [ConQ] {- ^ constructor definitions -} -> - [Name] {- ^ derived class names -} -> + CxtQ {- ^ context -} -> + Name {- ^ type constructor -} -> + [TyVarBndrVis] {- ^ type parameters -} -> + [ConQ] {- ^ constructor definitions -} -> + [Name] {- ^ derived class names -} -> DecQ #if MIN_VERSION_template_haskell(2,12,0) dataDCompat c n ts cs ds = @@ -2190,11 +2210,11 @@ -- | Backward compatible version of 'newtypeD' newtypeDCompat :: - CxtQ {- ^ context -} -> - Name {- ^ type constructor -} -> - [TyVarBndrUnit] {- ^ type parameters -} -> - ConQ {- ^ constructor definition -} -> - [Name] {- ^ derived class names -} -> + CxtQ {- ^ context -} -> + Name {- ^ type constructor -} -> + [TyVarBndrVis] {- ^ type parameters -} -> + ConQ {- ^ constructor definition -} -> + [Name] {- ^ derived class names -} -> DecQ #if MIN_VERSION_template_haskell(2,12,0) newtypeDCompat c n ts cs ds = diff --git a/src/Language/Haskell/TH/Datatype/TyVarBndr.hs b/src/Language/Haskell/TH/Datatype/TyVarBndr.hs --- a/src/Language/Haskell/TH/Datatype/TyVarBndr.hs +++ b/src/Language/Haskell/TH/Datatype/TyVarBndr.hs @@ -11,6 +11,11 @@ {-# Language Trustworthy #-} #endif +#if __GLASGOW_HASKELL__ >= 708 +{-# Language PatternSynonyms #-} +{-# Language ViewPatterns #-} +#endif + #if __GLASGOW_HASKELL__ >= 800 #define HAS_TH_LIFT {-# Language DeriveLift #-} @@ -33,7 +38,18 @@ TyVarBndr_ , TyVarBndrUnit , TyVarBndrSpec + , TyVarBndrVis , Specificity(..) +#if __GLASGOW_HASKELL__ >= 907 + , BndrVis(..) +#elif __GLASGOW_HASKELL__ >= 708 + , BndrVis + , pattern BndrReq + , pattern BndrInvis +#else + , BndrVis +#endif + , DefaultBndrFlag(..) -- * Constructing @TyVarBndr@s -- ** @flag@-polymorphic @@ -47,13 +63,23 @@ , plainTVSpecified , kindedTVInferred , kindedTVSpecified + -- ** @TyVarBndrVis@ + , plainTVReq + , plainTVInvis + , kindedTVReq + , kindedTVInvis -- * Constructing @Specificity@ , inferredSpec , specifiedSpec + -- * Constructing @BndrVis@ + , bndrReq + , bndrInvis + -- * Modifying @TyVarBndr@s , elimTV + , elimTVFlag , mapTV , mapTVName , mapTVFlag @@ -71,6 +97,7 @@ -- * Properties of @TyVarBndr@s , tvName , tvKind + , tvFlag ) where import Control.Applicative @@ -86,18 +113,19 @@ -- | 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). +-- parameter (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. +-- | A 'TyVarBndr' without a flag. This is used for 'TyVarBndr's that do not +-- interact with visible type application and are not binders for type-level +-- declarations. type TyVarBndrUnit = TyVarBndr --- | A 'TyVarBndr' with an explicit 'Specificity'. This is used for --- 'TyVarBndr's that interact with visible type application. +-- | A 'TyVarBndr' with a 'Specificity' flag. This is used for 'TyVarBndr's that +-- interact with visible type application. type TyVarBndrSpec = TyVarBndr -- | Determines how a 'TyVarBndr' interacts with visible type application. @@ -120,6 +148,81 @@ specifiedSpec = SpecifiedSpec #endif +#if !MIN_VERSION_template_haskell(2,21,0) +-- | A 'TyVarBndr' with a 'BndrVis' flag. This is used for 'TyVarBndr's in +-- type-level declarations (e.g., the binders in @data D \@k (a :: k)@). +type TyVarBndrVis = TyVarBndr_ BndrVis + +-- | Because pre-9.8 GHCs do not support invisible binders in type-level +-- declarations, we simply make 'BndrVis' an alias for @()@ as a compatibility +-- shim for old GHCs. This matches how type-level 'TyVarBndr's were flagged +-- prior to GHC 9.8. +type BndrVis = () +#if __GLASGOW_HASKELL__ >= 802 +{-# COMPLETE BndrReq, BndrInvis #-} +#endif + +#if __GLASGOW_HASKELL__ >= 708 +-- | Because pre-9.8 GHCs do not support invisible binders in type-level +-- declarations, we simply make 'BndrReq' a pattern synonym for @()@ as a +-- compatibility shim for old GHCs. This matches how type-level 'TyVarBndr's +-- were flagged prior to GHC 9.8. +#if __GLASGOW_HASKELL__ >= 800 +pattern BndrReq :: BndrVis +#endif +pattern BndrReq = () + +-- | Because pre-9.8 GHCs do not support invisible binders in type-level +-- declarations, this compatibility shim is defined in a somewhat unusual way: +-- +-- * As a pattern, 'BndrInvis' will never match on pre-9.8 GHCs. That way, if +-- you write pattern matches like this: +-- +-- @ +-- case flag of +-- 'BndrInvis' -> ... +-- 'BndrVis' -> ... +-- @ +-- +-- Then the first branch will never be taken on pre-9.8 GHCs. +-- +-- * 'BndrInvis' is a unidirectional pattern synonym on pre-9.8 GHCs, so it +-- cannot be used as an expression on these GHC versions. This is done in an +-- effort to avoid pitfalls that could occur if 'BndrInvis' were defined like +-- so: +-- +-- @ +-- pattern 'BndrInvis' = () +-- @ +-- +-- If this were the definition, then a user could write code involving +-- 'BndrInvis' that would construct an invisible type-level binder on GHC 9.8 +-- or later, but a /visible/ type-level binder on older GHCs! This would be +-- disastrous, so we prevent the user from doing such a thing. +#if __GLASGOW_HASKELL__ >= 800 +pattern BndrInvis :: BndrVis +#endif +pattern BndrInvis <- ((\() -> True) -> False) +#endif + +bndrReq :: BndrVis +bndrReq = () + +bndrInvis :: BndrVis +bndrInvis = () + +-- | A class characterizing reasonable default values for various 'TyVarBndr' +-- @flag@ types. +class DefaultBndrFlag flag where + defaultBndrFlag :: flag + +instance DefaultBndrFlag () where + defaultBndrFlag = () + +instance DefaultBndrFlag Specificity where + defaultBndrFlag = SpecifiedSpec +#endif + -- | Construct a 'PlainTV' with the given @flag@. plainTVFlag :: Name -> flag -> TyVarBndr_ flag #if MIN_VERSION_template_haskell(2,17,0) @@ -136,6 +239,14 @@ plainTVSpecified :: Name -> TyVarBndrSpec plainTVSpecified n = plainTVFlag n SpecifiedSpec +-- | Construct a 'PlainTV' with a 'BndrReq'. +plainTVReq :: Name -> TyVarBndrVis +plainTVReq n = plainTVFlag n bndrReq + +-- | Construct a 'PlainTV' with a 'BndrInvis'. +plainTVInvis :: Name -> TyVarBndrVis +plainTVInvis n = plainTVFlag n bndrInvis + -- | Construct a 'KindedTV' with the given @flag@. kindedTVFlag :: Name -> flag -> Kind -> TyVarBndr_ flag #if MIN_VERSION_template_haskell(2,17,0) @@ -152,6 +263,14 @@ kindedTVSpecified :: Name -> Kind -> TyVarBndrSpec kindedTVSpecified n k = kindedTVFlag n SpecifiedSpec k +-- | Construct a 'KindedTV' with a 'BndrReq'. +kindedTVReq :: Name -> Kind -> TyVarBndrVis +kindedTVReq n k = kindedTVFlag n bndrReq k + +-- | Construct a 'KindedTV' with a 'BndrInvis'. +kindedTVInvis :: Name -> Kind -> TyVarBndrVis +kindedTVInvis n k = kindedTVFlag n bndrInvis 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@. @@ -164,6 +283,20 @@ elimTV _ptv ktv (KindedTV n k) = ktv n k #endif +-- | Case analysis for a 'TyVarBndr' that includes @flag@s in the continuation +-- arguments. Note that 'TyVarBndr's did not include @flag@s prior to +-- @template-haskell-2.17.0.0@, so on older versions of @template-haskell@, +-- these @flag@s instead become @()@. +#if MIN_VERSION_template_haskell(2,17,0) +elimTVFlag :: (Name -> flag -> r) -> (Name -> flag -> Kind -> r) -> TyVarBndr_ flag -> r +elimTVFlag ptv _ktv (PlainTV n flag) = ptv n flag +elimTVFlag _ptv ktv (KindedTV n flag k) = ktv n flag k +#else +elimTVFlag :: (Name -> () -> r) -> (Name -> () -> Kind -> r) -> TyVarBndr_ flag -> r +elimTVFlag ptv _ktv (PlainTV n) = ptv n () +elimTVFlag _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' @@ -354,3 +487,14 @@ -- | Extract the kind from a 'TyVarBndr'. Assumes 'PlainTV' has kind @*@. tvKind :: TyVarBndr_ flag -> Kind tvKind = elimTV (\_ -> starK) (\_ k -> k) + +-- | Extract the @flag@ from a 'TyVarBndr'. Note that 'TyVarBndr's did not +-- include @flag@s prior to @template-haskell-2.17.0.0@, so on older versions of +-- @template-haskell@, this functions instead returns @()@. +#if MIN_VERSION_template_haskell(2,17,0) +tvFlag :: TyVarBndr_ flag -> flag +tvFlag = elimTVFlag (\_ flag -> flag) (\_ flag _ -> flag) +#else +tvFlag :: TyVarBndr_ flag -> () +tvFlag _ = () +#endif diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -13,6 +13,10 @@ {-# Language PolyKinds #-} #endif +#if MIN_VERSION_template_haskell(2,21,0) +{-# Language TypeAbstractions #-} +#endif + {-| Module : Main Description : Test cases for the th-abstraction package @@ -113,6 +117,9 @@ #if MIN_VERSION_template_haskell(2,20,0) t100Test #endif +#if MIN_VERSION_template_haskell(2,21,0) + t103Test +#endif adt1Test :: IO () adt1Test = @@ -1177,5 +1184,24 @@ mkT100Info <- reifyDatatype ''MkT100 validateDI mkT100Info expectedInfo + ) +#endif + +#if MIN_VERSION_template_haskell(2,21,0) +t103Test :: IO () +t103Test = + $(do [dec] <- [d| data T102 @k (a :: k) |] + info <- normalizeDec dec + let k = mkName "k" + a = mkName "a" + validateDI info + DatatypeInfo + { datatypeName = mkName "T102" + , datatypeContext = [] + , datatypeVars = [plainTV k, kindedTV a (VarT k)] + , datatypeInstTypes = [SigT (VarT a) (VarT k)] + , datatypeVariant = Datatype + , datatypeCons = [] + } ) #endif diff --git a/th-abstraction.cabal b/th-abstraction.cabal --- a/th-abstraction.cabal +++ b/th-abstraction.cabal @@ -1,5 +1,5 @@ name: th-abstraction -version: 0.5.0.0 +version: 0.6.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==9.6.1, GHC==9.4.4, GHC==9.2.6, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, 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==9.6.2, GHC==9.4.5, GHC==9.2.7, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, 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 @@ -29,7 +29,7 @@ other-modules: Language.Haskell.TH.Datatype.Internal build-depends: base >=4.3 && <5, ghc-prim, - template-haskell >=2.5 && <2.21, + template-haskell >=2.5 && <2.22, containers >=0.4 && <0.7 hs-source-dirs: src default-language: Haskell2010