th-abstraction 0.4.4.0 → 0.4.5.0

raw patch · 5 files changed

+88/−32 lines, 5 filesdep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• src/Language/Haskell/TH/Datatype.hs +54/−31
• test/Main.hs +25/−0
• test/Types.hs +3/−0
• th-abstraction.cabal +1/−1

@@ -1,5 +1,10 @@ # Revision history for th-abstraction +## 0.4.5.0 -- 2022.09.12+* Fix a bug in which data family declarations with interesting return kinds+  (e.g., `data family F :: Type -> Type`) would be reified incorrectly when+  using `reifyDatatype`.+ ## 0.4.4.0 -- 2022.07.23 * Support free variable substitution and infix resolution for   `PromotedInfixT` and `PromotedUInfixT` on `template-haskell-2.19.0.0` or

@@ -492,7 +492,7 @@        TyConI dec -> normalizeDecFor isReified dec #if MIN_VERSION_template_haskell(2,7,0)        FamilyI dec instances ->-         do let instances1 = map (repairDataFam dec) instances+         do instances1 <- mapM (repairDataFam dec) instances             instances2 <- mapM (normalizeDecFor isReified) instances1             case find p instances2 of               Just inst -> return inst@@ -524,8 +524,8 @@ -- 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_ flag] -> [Type] -> [Type]-repairVarKindsWith' dvars ts =+repairVarKindsWith' :: [TyVarBndrUnit] -> Maybe Kind -> [Type] -> Q [Type]+repairVarKindsWith' dvars dkind ts =   let kindVars                = freeVariables . map kindPart       kindPart (KindedTV _ k) = [k]       kindPart (PlainTV  _  ) = []@@ -536,8 +536,8 @@       tsKinds'            = map sanitizeStars tsKinds       extraTys            = drop (length tsNoKinds) (bndrParams dvars)       ts'                 = tsNoKinds ++ extraTys -- eta-expand-  in applySubstitution (Map.fromList (zip kparams tsKinds')) $-     repairVarKindsWith dvars ts'+  in fmap (applySubstitution (Map.fromList (zip kparams tsKinds'))) $+     repairVarKindsWith dvars dkind ts'   -- Sadly, Template Haskell's treatment of data family instances leaves much@@ -556,54 +556,77 @@ repairDataFam ::   Dec {- ^ family declaration   -} ->   Dec {- ^ instance declaration -} ->-  Dec {- ^ instance declaration -}+  Q Dec {- ^ instance declaration -}  repairDataFam-  (FamilyD _ _ dvars _)-  (NewtypeInstD cx n ts con deriv) =-    NewtypeInstD cx n (repairVarKindsWith' dvars ts) con deriv+  (FamilyD _ _ dvars dk)+  (NewtypeInstD cx n ts con deriv) = do+    ts' <- repairVarKindsWith' dvars dk ts+    return $ NewtypeInstD cx n ts' con deriv repairDataFam-  (FamilyD _ _ dvars _)-  (DataInstD cx n ts cons deriv) =-    DataInstD cx n (repairVarKindsWith' dvars ts) cons deriv+  (FamilyD _ _ dvars dk)+  (DataInstD cx n ts cons deriv) = do+    ts' <- repairVarKindsWith' dvars dk ts+    return $ DataInstD cx n ts' cons deriv #else repairDataFam famD instD # if MIN_VERSION_template_haskell(2,15,0)-      | DataFamilyD _ dvars _ <- famD+      | DataFamilyD _ dvars dk <- famD       , NewtypeInstD cx mbInstVars nts k c deriv <- instD       , con :| ts <- decomposeType nts-      = NewtypeInstD cx mbInstVars-          (foldl' AppT con (repairVarKindsWith dvars ts))-          k c deriv+      = do ts' <- repairVarKindsWith dvars dk ts+           return $ NewtypeInstD cx mbInstVars (foldl' AppT con ts') k c deriv -      | DataFamilyD _ dvars _ <- famD+      | DataFamilyD _ dvars dk <- famD       , DataInstD cx mbInstVars nts k c deriv <- instD       , con :| ts <- decomposeType nts-      = DataInstD cx mbInstVars-          (foldl' AppT con (repairVarKindsWith dvars ts))-          k c deriv+      = do ts' <- repairVarKindsWith dvars dk ts+           return $ DataInstD cx mbInstVars (foldl' AppT con ts') k c deriv # elif MIN_VERSION_template_haskell(2,11,0)-      | DataFamilyD _ dvars _ <- famD+      | DataFamilyD _ dvars dk <- famD       , NewtypeInstD cx n ts k c deriv <- instD-      = NewtypeInstD cx n (repairVarKindsWith dvars ts) k c deriv+      = do ts' <- repairVarKindsWith dvars dk ts+           return $ NewtypeInstD cx n ts' k c deriv -      | DataFamilyD _ dvars _ <- famD+      | DataFamilyD _ dvars dk <- famD       , DataInstD cx n ts k c deriv <- instD-      = DataInstD cx n (repairVarKindsWith dvars ts) k c deriv+      = do ts' <- repairVarKindsWith dvars dk ts+           return $ DataInstD cx n ts' k c deriv # else-      | FamilyD _ _ dvars _ <- famD+      | FamilyD _ _ dvars dk <- famD       , NewtypeInstD cx n ts c deriv <- instD-      = NewtypeInstD cx n (repairVarKindsWith dvars ts) c deriv+      = do ts' <- repairVarKindsWith dvars dk ts+           return $ NewtypeInstD cx n ts' c deriv -      | FamilyD _ _ dvars _ <- famD+      | FamilyD _ _ dvars dk <- famD       , DataInstD cx n ts c deriv <- instD-      = DataInstD cx n (repairVarKindsWith dvars ts) c deriv+      = do ts' <- repairVarKindsWith dvars dk ts+           return $ DataInstD cx n ts' c deriv # endif #endif-repairDataFam _ instD = instD+repairDataFam _ instD = return instD -repairVarKindsWith :: [TyVarBndr_ flag] -> [Type] -> [Type]-repairVarKindsWith = zipWith stealKindForType+-- | @'repairVarKindsWith' tvbs mbKind ts@ returns @ts@, but where each element+-- has an explicit kind signature taken from a 'TyVarBndr' in the corresponding+-- position in @tvbs@, or from the corresponding kind argument in 'mbKind' if+-- there aren't enough 'TyVarBndr's available. An example where @tvbs@ can be+-- shorter than @ts@ can be found in this example from #95:+--+-- @+-- data family F :: Type -> Type+-- data instance F a = C+-- @+--+-- 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 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+  return $ zipWith stealKindForType tvbs' ts  -- If a VarT is missing an explicit kind signature, steal it from a TyVarBndr. stealKindForType :: TyVarBndr_ flag -> Type -> Type

@@ -74,6 +74,7 @@      recordFamTest      t46Test      t73Test+     t95Test #endif      fixityLookupTest #if __GLASGOW_HASKELL__ >= 704@@ -678,6 +679,30 @@                    , constructorVars       = []                    , constructorContext    = []                    , constructorFields     = [bVar]+                   , constructorStrictness = [notStrictAnnot]+                   , constructorVariant    = NormalConstructor }]+           }+   )++t95Test :: IO ()+t95Test =+  $(do info <- reifyDatatype 'MkT95+       let a    = mkName "a"+           aTvb = kindedTV a starK+           aVar = VarT a+       validateDI info+         DatatypeInfo+           { datatypeName      = ''T95+           , datatypeContext   = []+           , datatypeVars      = [aTvb]+           , datatypeInstTypes = [AppT ListT aVar]+           , datatypeVariant   = DataInstance+           , datatypeCons      =+               [ ConstructorInfo+                   { constructorName       = 'MkT95+                   , constructorVars       = []+                   , constructorContext    = []+                   , constructorFields     = [aVar]                    , constructorStrictness = [notStrictAnnot]                    , constructorVariant    = NormalConstructor }]            }

@@ -116,6 +116,9 @@  data family   T73 a   b data instance T73 Int b = MkT73 b++data family T95 :: * -> *+data instance T95 [a] = MkT95 a #endif  #if __GLASGOW_HASKELL__ >= 704

@@ -1,5 +1,5 @@ name:                th-abstraction-version:             0.4.4.0+version:             0.4.5.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