th-abstraction 0.3.2.0 → 0.4.0.0

raw patch · 9 files changed

+497/−166 lines, 9 filesdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• ChangeLog.md +15/−0
• LICENSE +1/−1
• src/Language/Haskell/TH/Datatype.hs +78/−104
• src/Language/Haskell/TH/Datatype/Internal.hs +1/−3
• src/Language/Haskell/TH/Datatype/TyVarBndr.hs +342/−0
• test/Harness.hs +5/−9
• test/Main.hs +49/−45
• test/Types.hs +2/−1
• th-abstraction.cabal +4/−3

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

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

@@ -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  : emertens@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

@@ -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" "~"

@@ -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  : emertens@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)

@@ -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 =

@@ -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] 

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

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