packages feed

kind-generics-th 0.2.2.3 → 0.2.3.0

raw patch · 4 files changed

+355/−88 lines, 4 filesdep +fcf-familydep ~kind-genericsdep ~template-haskell

Dependencies added: fcf-family

Dependency ranges changed: kind-generics, template-haskell

Files

README.md view
@@ -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.
kind-generics-th.cabal view
@@ -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
src/Generics/Kind/TH.hs view
@@ -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+--   <https://hackage.haskell.org/package/fcf-family fcf-family>).+--   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
tests/Main.hs view
@@ -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 ()