diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -36,7 +36,38 @@ * `PolyKinds` (if using a poly-kinded data type) * `TemplateHaskell` * `TypeFamilies` +* `UndecidableInstances` (if using a data type involving type families) +### Type families + +If the data type uses a type family (more precisely, if a type +variable occurs in a type family application), `deriveGenericK` +will warn that it won't generate all of the instances that you'd +normally expect, and it will tell you what to do if you do want those +instances or if you want to silence the warning. + +```haskell +type family F a +data T a = C (F a) + +$(deriveGenericK ''T) +``` + +Warning message: + +``` +Found type family in definition of ''T. Some instances have been skipped. +Declared instances: + instance GenericK (T a) +Skipped instances: + instance GenericK T +To enable type family support and obtain those skipped instances: + $(preDeriveGenericK ''T) + $(postDeriveGenericK ''T) +To silence this warning: + $(deriveGenericKQuiet ''T) +``` + ## How many `GenericK` instances are generated `deriveGenericK` typically generates multiple `GenericK` instances per data @@ -76,43 +107,7 @@ * `instance GenericK (Baz k a)` * `instance GenericK (Baz k) ` -3. Data types with type family applications. In the following example: - ```haskell - type family Fam a - newtype WrappedFam a = WrapFam (Fam a) - ``` - - It is impossible to write a `GenericK` instance for a partial application - of `WrappedFam`, since the representation type would necessarily need to - partially apply `Fam`, which GHC does not permit. Therefore, - `$(deriveGenericK ''WrappedFam)` will only generate a single instance for - `GenericK (WrappedFam a)`. - - There are some uses of type families that are not supported altogether. - For instance, if a type family is applied to an _existentially_ quantified - type variable, as in the following example: - - ```haskell - data ExFam where - MkExFam :: forall a. Fam a -> ExFam - ``` - - Representing `ExFam` would fundamentally require a partial application of - `Fam`, as `type RepK ExFam = Exists * (Field (Fam :$: Var0))`. As a result, - it is impossible to give `ExFam` a `GenericK` instance. - - Note that not all type families are problematic. For instance: - - ```haskell - type family Fam2 :: * -> * - newtype WrappedFam2 a = WrapFam2 (Fam2 a) - ``` - - In this example, `Fam2` is perfectly fine to partially apply, so - `$(deriveGenericK ''WrappedFam2)` will generate two instances (as opposed - to just one, as was the case for `WrappedFam`). - ## Limitations `kind-generics` is capable of representing a wide variety of data types. The @@ -122,7 +117,20 @@ known limitations of `deriveGenericK`: 1. Data constructors with rank-_n_ field types (e.g., `(forall a. a -> a)`) - are currently not supported. + are partially supported: `forall` and constraints `c =>` are allowed only + at the root of a field's type. + + ```haskell + data Ok = Ok + { a :: forall a. a -> a + , b :: forall a b. Eq a => a -> b + } + + data NotOk = NotOk + { c :: (forall a. a -> a) -> Bool + } + ``` + 2. Data constructors with unlifted field types (e.g., `Int#` or `(# Bool #)`) are unlikely to work. 3. GADTs that make use of certain forms of kind equalities are currently not @@ -155,3 +163,6 @@ into the explicitly existential form is not straightforward, however. In particular, `deriveGenericK` only detects the `k ~ *` part correctly at the moment, so it will generate an ill kinded instance for `Quux`. +4. While there is support for data types that use type families in their fields, + they cannot be dependently typed, *i.e.*, the result type may not + depend on visible arguments. diff --git a/kind-generics-th.cabal b/kind-generics-th.cabal --- a/kind-generics-th.cabal +++ b/kind-generics-th.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: kind-generics-th -version: 0.2.2.3 +version: 0.2.3.0 synopsis: Template Haskell support for generating `GenericK` instances description: This package provides Template Haskell functionality to automatically derive @GenericK@ instances (from the @@ -23,9 +23,10 @@ library exposed-modules: Generics.Kind.TH build-depends: base >=4.12 && <5 + , fcf-family >= 0.1 && < 0.3 , ghc-prim >= 0.5.3 - , kind-generics >=0.4 - , template-haskell >=2.14 && <2.19 + , kind-generics >=0.5 + , template-haskell >=2.14 && <2.20 , th-abstraction >=0.4 && <0.5 hs-source-dirs: src default-language: Haskell2010 @@ -37,7 +38,7 @@ build-depends: base >=4.12 && <5 , kind-generics >=0.4 , kind-generics-th - , template-haskell >=2.14 && <2.18 + , template-haskell hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Generics/Kind/TH.hs b/src/Generics/Kind/TH.hs --- a/src/Generics/Kind/TH.hs +++ b/src/Generics/Kind/TH.hs @@ -5,7 +5,12 @@ -- | Main module of @kind-generics-th@. -- Please refer to the @README@ file for documentation on how to use this package. -module Generics.Kind.TH (deriveGenericK) where +module Generics.Kind.TH + ( deriveGenericK + , deriveGenericKQuiet + , preDeriveGenericK + , postDeriveGenericK + ) where import Control.Applicative import Control.Monad @@ -13,10 +18,12 @@ import Data.List import Data.Maybe import Data.Type.Equality (type (~~)) +import Fcf.Family.TH (fcfify, isTypeFamilyOrSynonym, promoteNDFamily) import GHC.Generics as Generics hiding (conIsRecord, conName, datatypeName) import Generics.Kind import Language.Haskell.TH as TH +import Language.Haskell.TH.Syntax as TH import Language.Haskell.TH.Datatype as THAbs import Language.Haskell.TH.Datatype.TyVarBndr @@ -42,8 +49,72 @@ -- * @TemplateHaskell@ -- -- * @TypeFamilies@ +-- +-- If the data type uses type families, 'deriveGenericK' warns that it +-- skips the 'GenericK' instances that require special support for it +-- +-- - Use 'preDeriveGenericK' and 'postDeriveGenericK' to support type families. +-- - Use 'deriveGenericKQuiet' to silence the warnings. deriveGenericK :: Name -> Q [Dec] -deriveGenericK n = do +deriveGenericK = deriveGenericKWarnIf True + +-- | Variant of 'deriveGenericK' that doesn't emit warnings. +deriveGenericKQuiet :: Name -> Q [Dec] +deriveGenericKQuiet = deriveGenericKWarnIf False + +deriveGenericKWarnIf :: Bool -> Name -> Q [Dec] +deriveGenericKWarnIf warn name = uncurry (++) <$> deriveGenericK' (NoFamilies warn) name + +-- | Generate 'GenericK' instances for data types that may mention +-- type families. +-- +-- This 'preDeriveGenericK' is to be used in combination with +-- 'postDeriveGenericK'. These two functions let us stage the compilation of +-- the generated type instances, because GHC cannot compile them in a single +-- group. +-- +-- - 'preDeriveGenericK' generates type instances to promote type families +-- that occur in the given data types (using 'fcfify'; see +-- ). +-- The 'GenericK' instances are not produced at this stage, +-- they are accumulated in some internal global queue. +-- - 'postDeriveGenericK' produces all of the accumulated 'GenericK' instances. +-- It should be called in a slice separated from 'preDeriveGenericK'. +-- Multiple calls to `preDeriveGenericK` may precede 'postDeriveGenericK'. +-- +-- @ +-- 'preDeriveGenericK' ''MyT1 +-- 'preDeriveGenericK' ''MyT2 +-- 'preDeriveGenericK' ''MyT3 +-- 'postDeriveGenericK' +-- @ +-- +-- You will need to enable the extensions @UndecidableInstances@ and @PolyKinds@ +-- (even if your data types are not poly-kinded) +-- in addition to those mentioned in the documentation of 'deriveGenericK'. +preDeriveGenericK :: Name -> Q [Dec] +preDeriveGenericK n = do + (pre, post) <- deriveGenericK' YesFamilies n + pushGenericKQueue post + pure pre + +-- | See 'preDeriveGenericK'. +postDeriveGenericK :: Q [Dec] +postDeriveGenericK = takeGenericKQueue + +-- | Flag to control support for type families, because that requires a +-- different API (preDeriveGenericK, postDeriveGenericK instead of +-- deriveGenericK). +data FamilyFriendliness + = NoFamilies Bool -- ^ Whether to warn when a type family is detected. + | YesFamilies + +-- | Return a pair of: +-- +-- - 'fcfify'-generated instances +-- - 'GenericK' instances +deriveGenericK' :: FamilyFriendliness -> Name -> Q ([Dec], [Dec]) +deriveGenericK' familyFriendliness n = do DatatypeInfo{ datatypeName = dataName , datatypeInstTypes = univVars , datatypeVariant = variant @@ -68,9 +139,13 @@ -- Check if the argument appears in a type family application. inTyFamApp <- or <$> traverse (isInTypeFamilyApp argNameToDrop) allInnerTypes - if inTyFamApp - then pure [inst] - else (inst:) <$> deriveInsts argsToKeep' (argToDrop':argsToDrop) + case familyFriendliness of + NoFamilies warn | inTyFamApp -> do + -- Found type family application when family suppport is disabled. + -- Emit a warning and don't generate GenericK instances for fewer argsToKeep. + when warn (reportWarning $ tyFamWarning n dataName argsToKeep argsToDrop) + pure [inst] + _ -> (inst:) <$> deriveInsts argsToKeep' (argToDrop':argsToDrop) | otherwise -> pure [inst] @@ -90,8 +165,59 @@ , deriveToK cons' ] - deriveInsts (reverse univVars) [] + insts <- deriveInsts (reverse univVars) [] + fcfInsts <- takeFcfifyQueue + pure (fcfInsts, insts) +-- | Warning to show when a type family is found by 'deriveGenericK'. +tyFamWarning :: Name -> Name -> [Type] -> [Type] -> String +tyFamWarning name dataName argsToKeep' argsToDrop' = + let argsToKeep = getVarTName <$> reverse argsToKeep' + argsToDrop = getVarTName <$> argsToDrop' + in tyFamWarning' name dataName argsToKeep argsToDrop + +-- | 'tyFamWarning' with variable names instead of Type, all in left-to-right order. +tyFamWarning' :: Name -> Name -> [String] -> [String] -> String +tyFamWarning' name dataName argsToKeep argsToDrop = unlines $ + ("Found type family in definition of " + ++ quoteName name ++ ". Some instances have been skipped.") : + map (" " ++) ( + "Declared instances:" : + showDeclaredInstances dataName argsToKeep argsToDrop ++ + "Skipped instances:" : + showSkippedInstances dataName argsToKeep ++ + "To enable type family support and obtain those skipped instances:" : + ("\t$(preDeriveGenericK " ++ quoteName name ++ ")") : + ("\t$(postDeriveGenericK " ++ quoteName name ++ ")") : + "To silence this warning:" : + ("\t$(deriveGenericKQuiet " ++ quoteName name ++ ")") : + []) + +-- | This assumes most uses are going to be unqualified names. +quoteName :: Name -> String +quoteName name@(Name _ (NameG DataName _ _)) = "'" ++ nameBase name +quoteName name = "''" ++ nameBase name + +showDeclaredInstances :: Name -> [String] -> [String] -> [String] +showDeclaredInstances name argsToKeep argsToDrop = + (\args -> "\tinstance GenericK " ++ showConArgs name (argsToKeep ++ args)) <$> inits argsToDrop + +showSkippedInstances :: Name -> [String] -> [String] +showSkippedInstances name argsToKeep = + (\args -> "\tinstance GenericK " ++ showConArgs name args) <$> init (inits argsToKeep) + +-- We manually pretty-print the types to drop module qualifiers. +showConArgs :: Name -> [String] -> String +showConArgs name [] = nameBase name +showConArgs name args = "(" ++ intercalate " " (nameBase name : args) ++ ")" + +-- | Find type variable stored in types coming from 'datatypeInstTypes' +-- (should be of the form (v :: k)) +getVarTName :: Type -> String +getVarTName (SigT t _) = getVarTName t +getVarTName (VarT name) = nameBase name +getVarTName _ = "_a" + -- | @'distinctTyVarType' tvSet ty@ returns @'Just' tvTy@ if @ty@: -- -- a. Is a type variable named @tvTy@, and @@ -155,10 +281,16 @@ RecordConstructor{} -> False context :: Type -> Q Type - context ty = - case conCtxt of + context = ntext ''(:=>:) allTvbNames conCtxt + + cocontext :: [Name] -> Cxt -> Type -> Q Type + cocontext = ntext '(:=>>:) + + ntext :: Name -> [Name] -> Cxt -> Type -> Q Type + ntext (==>) tvbNames ctxt ty = + case ctxt of [] -> pure ty -- Don't use (:=>:) if there are no constraints - _ -> infixT (atomizeContext conCtxt) ''(:=>:) (pure ty) + _ -> infixT (atomizeContext tvbNames ctxt) (==>) (pure ty) existentials :: Type -> Q Type existentials ty = @@ -195,25 +327,56 @@ promoteSourceUnpackedness (generifyUnpackedness fu) `appT` promoteSourceStrictness (generifyStrictness fs) `appT` promoteDecidedStrictness (generifyDecidedStrictness ds)) - `appT` (conT ''Field `appT` atomize field) + `appT` (conT ''Field `appT` prenex allTvbNames field) - atomizeContext :: Cxt -> Q Type - atomizeContext = foldBal (\x y -> infixT x '(:&:) y) - (promotedT 'Kon `appT` tupleT 0) - . map atomize + atomizeContext :: [Name] -> Cxt -> Q Type + atomizeContext tvbNames = + foldBal (\x y -> infixT x '(:&:) y) + (promotedT 'Kon `appT` tupleT 0) + . map (atomize tvbNames) - atomize :: Type -> Q Type - atomize = go +#if MIN_VERSION_template_haskell(2,17,0) + foralls :: [TyVarBndr Specificity] -> Q Type -> Q Type +#else + foralls :: [TyVarBndr] -> Q Type -> Q Type +#endif + foralls vs ty = + foldr (\_ x -> promotedT 'ForAll `appT` x) ty vs + + prenex :: [Name] -> Type -> Q Type + prenex tvbNames (ForallT vars ctxt ty) = + let tvbNames' = reverse (map tvName vars) ++ tvbNames in + (foralls vars . (cocontext tvbNames' ctxt =<<) . prenex tvbNames') ty + prenex tvbNames ty = atomize tvbNames ty + + atomize :: [Name] -> Type -> Q Type + atomize tvbNames = flip go [] where - go :: Type -> Q Type + -- Collect arguments in a list while descending to the left of AppT, + -- in case this is a type family application. + go :: Type -> [Q Type] -> Q Type -- Var case go ty@(VarT n) = - case elemIndex n allTvbNames of - Just idx -> pure $ enumerateTyVar idx + case elemIndex n tvbNames of + Just idx -> appsT $ enumerateTyVar idx Nothing -> kon ty + -- Either a type constructor or a type family + go ty@(ConT n) = \args -> do + isTFS <- isTypeFamilyOrSynonym n + if isTFS + then do (fam, arity) <- promoteNDFamily n + (args1, args2) <- splitAt arity <$> sequence args + let saturated = all isKonApp args1 + if saturated then kon ty args + else do + fcfify n >>= pushFcfifyQueue + PromotedT 'Eval + `AppT` (PromotedT 'Kon `AppT` fam `appAtom` consTupleAtom args1) + `appsT` (pure <$> args2) + else kon ty args + -- Kon cases - go ty@ConT{} = kon ty go ty@PromotedT{} = kon ty go ty@TupleT{} = kon ty go ty@ArrowT = kon ty @@ -239,18 +402,15 @@ #endif -- Recursive cases - go (AppT ty1 ty2) = do ty1' <- go ty1 - ty2' <- go ty2 - case (ty1', ty2') of - (PromotedT kon1 `AppT` tyArg1, - PromotedT kon2 `AppT` tyArg2) - | kon1 == 'Kon, kon2 == 'Kon - -> kon (AppT tyArg1 tyArg2) - (_, _) -> pure $ InfixT ty1' '(:@:) ty2' + go (AppT ty1 ty2) = go ty1 . (go ty2 [] :) go (InfixT ty1 n ty2) = go (ConT n `AppT` ty1 `AppT` ty2) go (UInfixT ty1 n ty2) = go (ConT n `AppT` ty1 `AppT` ty2) +#if MIN_VERSION_template_haskell(2,19,0) + go (PromotedInfixT ty1 n ty2) = go (ConT n `AppT` ty1 `AppT` ty2) + go (PromotedUInfixT ty1 n ty2) = go (ConT n `AppT` ty1 `AppT` ty2) +#endif go (SigT ty _) = go ty - go (ParensT ty) = ParensT <$> go ty + go (ParensT ty) = fmap ParensT . go ty #if MIN_VERSION_template_haskell(2,15,0) go (AppKindT ty _) = go ty go (ImplicitParamT n ty) = go (ConT ''IP `AppT` LitT (StrTyLit n) `AppT` ty) @@ -258,14 +418,25 @@ #endif -- Failure cases - go ty@ForallT{} = can'tRepresent "rank-n type" ty + go ty@ForallT{} = \_ -> can'tRepresent "rank-n type" ty #if MIN_VERSION_template_haskell(2,16,0) - go ty@ForallVisT{} = can'tRepresent "rank-n type" ty + go ty@ForallVisT{} = \_ -> can'tRepresent "rank-n type" ty #endif - kon :: Type -> Q Type - kon ty = promotedT 'Kon `appT` pure ty + kon :: Type -> [Q Type] -> Q Type + kon ty tys = do ty' <- promotedT 'Kon `appT` pure ty + appsT ty' tys + appsT :: Type -> [Q Type] -> Q Type + appsT ty1 [] = pure ty1 + appsT ty1 (ty2' : tys) = do ty2 <- ty2' + case (ty1, ty2) of + (PromotedT kon1 `AppT` tyArg1, + PromotedT kon2 `AppT` tyArg2) + | kon1 == 'Kon, kon2 == 'Kon + -> kon (AppT tyArg1 tyArg2) tys + (_, _) -> appsT (ty1 `appAtom` ty2) tys + can'tRepresent :: String -> Type -> Q a can'tRepresent thing ty = fail $ "Unsupported " ++ thing ++ ": " ++ pprint ty @@ -281,6 +452,18 @@ Fixity n fd = fromMaybe defaultFixity mbFi fixityIPromotedType _ False = promotedT 'PrefixI +isKonApp :: Type -> Bool +isKonApp (PromotedT kon `AppT` _) = kon == 'Kon +isKonApp _ = False + +appAtom :: Type -> Type -> Type +appAtom t t' = InfixT t '(:@:) t' + +consTupleAtom :: [Type] -> Type +consTupleAtom [] = PromotedT 'Kon `AppT` PromotedT '() +consTupleAtom (t : ts) = + (PromotedT 'Kon `AppT` PromotedT '(,)) `appAtom` t `appAtom` consTupleAtom ts + deriveFromK :: [ConstructorInfo] -> Q Dec deriveFromK cons = do x <- newName "x" @@ -305,19 +488,30 @@ (normalB $ lrE i n $ conE 'M1 `appE` do prod <- foldBal (\x y -> infixE (Just x) (conE '(:*:)) (Just y)) (conE 'U1) - (map fromField fNames) + (zipWith fromField fNames fields) ctxtProd <- context prod existentials ctxtProd) [] where - fromField :: Name -> Q Exp - fromField fName = conE 'M1 `appE` (conE 'Field `appE` varE fName) + fromField :: Name -> Type -> Q Exp + fromField fName fty = conE 'M1 `appE` (conE 'Field `appE` prenex fty (varE fName)) + prenex :: Type -> Q Exp -> Q Exp + prenex (ForallT vars ctxt ty) e = + foldr (\_ -> appE (conE 'ForAllI)) (cocontext ctxt =<< prenex ty e) vars + prenex _ e = e + context :: Exp -> Q Exp - context e = - case conCtxt of + context = ntext 'SuchThat conCtxt + + cocontext :: Cxt -> Exp -> Q Exp + cocontext = ntext 'SuchThatI + + ntext :: Name -> Cxt -> Exp -> Q Exp + ntext suchThat ctxt e = + case ctxt of [] -> pure e - _ -> conE 'SuchThat `appE` pure e + _ -> conE suchThat `appE` pure e existentials :: Exp -> Q Exp existentials e = foldl' (\x _ -> conE 'Exists `appE` x) (pure e) exTvbs @@ -345,21 +539,32 @@ match (lrP i n $ conP 'M1 [ do prod <- foldBal (\x y -> infixP x '(:*:) y) (conP 'U1 []) - (map toField fNames) + (map (\x -> conP 'M1 [conP 'Field [varP x]]) fNames) ctxtProd <- context prod existentials ctxtProd ] ) - (normalB $ foldl' appE (conE conName) (map varE fNames)) + (normalB $ foldl' appE (conE conName) (zipWith toField fNames fields)) [] where - toField :: Name -> Q Pat - toField fName = conP 'M1 [conP 'Field [varP fName]] + toField :: Name -> Type -> Q Exp + toField fName ty = prenex ty (varE fName) + prenex :: Type -> Q Exp -> Q Exp + prenex (ForallT vars ctxt ty) e = + prenex ty (cocontext ctxt =<< foldl (\x _ -> varE 'unwrapI `appE` (varE 'toWrappedI `appE` x)) e vars) + prenex _ e = e + context :: Pat -> Q Pat - context p = - case conCtxt of + context = ntext (conP 'SuchThat . (:[])) conCtxt + + cocontext :: Cxt -> Exp -> Q Exp + cocontext = ntext (varE 'unSuchThatI `appE`) + + ntext :: (Q a -> Q a) -> Cxt -> a -> Q a + ntext suchThat ctxt p = + case ctxt of [] -> pure p - _ -> conP 'SuchThat [pure p] + _ -> suchThat (pure p) existentials :: Pat -> Q Pat existentials p = foldl' (\x _ -> conP 'Exists [x]) (pure p) exTvbs @@ -559,3 +764,34 @@ , constructorContext = context' , constructorFields = fields' } + +-- | Store 'GenericK' instances to be produced after having typechecked +-- 'fcfify'-generated instances. +newtype GenericKQueue = GenericKQueue [Dec] + +pushGenericKQueue :: [Dec] -> Q () +pushGenericKQueue d = do + GenericKQueue decs <- fromMaybe (GenericKQueue []) <$> TH.getQ + TH.putQ (GenericKQueue (d ++ decs)) + +takeGenericKQueue :: Q [Dec] +takeGenericKQueue = do + GenericKQueue decs <- fromMaybe (GenericKQueue []) <$> TH.getQ + TH.putQ (GenericKQueue []) + pure decs + +-- | Store 'fcfify'-generated instances for the current data type. +-- This could also be done with StateT in deriveRepK but that's +-- a more invasive change. +newtype FcfifyQueue = FcfifyQueue [Dec] + +pushFcfifyQueue :: [Dec] -> Q () +pushFcfifyQueue d = do + FcfifyQueue decs <- fromMaybe (FcfifyQueue []) <$> TH.getQ + TH.putQ (FcfifyQueue (d ++ decs)) + +takeFcfifyQueue :: Q [Dec] +takeFcfifyQueue = do + FcfifyQueue decs <- fromMaybe (FcfifyQueue []) <$> TH.getQ + TH.putQ (FcfifyQueue []) + pure decs diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -7,16 +7,19 @@ {-# language ImplicitParams #-} {-# language MultiParamTypeClasses #-} {-# language PolyKinds #-} +{-# language RankNTypes #-} {-# language ScopedTypeVariables #-} {-# language TemplateHaskell #-} {-# language TypeApplications #-} {-# language TypeFamilies #-} {-# language TypeOperators #-} +{-# language UndecidableInstances #-} {-# options_ghc -Wno-orphans #-} module Main (main) where import Data.Kind import Data.Proxy +import Data.Type.Bool (If) import Generics.Kind import Generics.Kind.TH @@ -60,9 +63,17 @@ MkTC6 :: (?n :: Bool) => TC6 #endif +-- Polymorphic fields +data TC7 :: Type where + MkTC7 :: (forall a. Num a => a -> a) -> TC7 + +-- Type families +data TC8 :: Bool -> Type where + MkTC8 :: If b Bool Int -> TC8 b + $(concat <$> traverse deriveGenericK [ -- Representation types - ''V1, ''(:+:), ''(:*:), ''U1, ''M1, ''Field, ''(:=>:), ''Exists + ''V1, ''(:+:), ''(:*:), ''U1, ''M1, ''Exists -- Other data types , ''LoT, ''TyEnv @@ -75,7 +86,13 @@ #if MIN_VERSION_template_haskell(2,15,0) , ''TC6 #endif + , ''TC7 ]) +$(concat <$> traverse preDeriveGenericK + [ ''Field, ''(:=>:) + , ''TC8 + ]) +$(postDeriveGenericK) ------- -- main @@ -147,6 +164,8 @@ #if MIN_VERSION_template_haskell(2,15,0) , isGenericK @_ @TC6 @'LoT0 #endif + + , isGenericK @_ @TC7 @'LoT0 ] in insts `seq` pure ()