`kindSigOptions` example in the documentation doesn't actually work

[RyanGlScott]

The Haddocks in Generics.Deriving.TH give the following example of how to use kindSigOptions:

https://github.com/dreixel/generic-deriving/blob/e858579e4f50bd2984b1ef7b736ad9f23279d4c1/src/Generics/Deriving/TH.hs#L135-L138

However, this doesn't seem to work in practice. If you compile the following file:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -ddump-splices #-}
module Bug where

import Generics.Deriving.TH

newtype Compose (f :: k2 -> *) (g :: k1 -> k2) (a :: k1) = Compose (f (g a))
$(deriveAll1Options defaultOptions{kindSigOptions = False} ''Compose)

It will fail thusly:

Bug.hs:11:2-69: Splicing declarations
    deriveAll1Options defaultOptions {kindSigOptions = False} ''Compose
  ======>
    instance GHC.Generics.Generic1 (Compose f_afKA g_afKB) where
      type GHC.Generics.Rep1 (Compose f_afKA g_afKB) = GHC.Generics.D1 ('GHC.Generics.MetaData "Compose" "Bug" "generic-deriving-1.14.1-inplace" 'True) (GHC.Generics.C1 ('GHC.Generics.MetaCons "Compose" 'GHC.Generics.PrefixI 'False) (GHC.Generics.S1 ('GHC.Generics.MetaSel 'Nothing 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) ((GHC.Generics.:.:) g_afKB (GHC.Generics.Rec1 g_afKB))))
      GHC.Generics.from1
        = \ val_afLC
            -> case val_afLC of {
                 y_afLD
                   -> GHC.Generics.M1
                        (case y_afLD of {
                           Compose f1_afLE
                             -> GHC.Generics.M1
                                  (GHC.Generics.M1
                                     ((GHC.Generics.Comp1 . fmap GHC.Generics.Rec1) f1_afLE)) }) }
      GHC.Generics.to1
        = \ val_afLF
            -> case val_afLF of {
                 GHC.Generics.M1 y_afLG
                   -> case y_afLG of {
                        GHC.Generics.M1 (GHC.Generics.M1 f1_afLH)
                          -> Compose
                               ((fmap GHC.Generics.unRec1 . GHC.Generics.unComp1) f1_afLH) } }

Bug.hs:11:2: error:
    • Couldn't match kind ‘k2’ with ‘*’
      Expected kind ‘k -> *’, but ‘g_afKB’ has kind ‘k -> k2’
    • In the first argument of ‘(GHC.Generics.:.:)’, namely ‘g_afKB’
      In the second argument of ‘GHC.Generics.S1’, namely
        ‘((GHC.Generics.:.:) g_afKB (GHC.Generics.Rec1 g_afKB))’
      In the second argument of ‘GHC.Generics.C1’, namely
        ‘(GHC.Generics.S1 ('GHC.Generics.MetaSel 'Nothing 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) ((GHC.Generics.:.:) g_afKB (GHC.Generics.Rec1 g_afKB)))’
   |
11 | $(deriveAll1Options defaultOptions{kindSigOptions = False} ''Compose)
   |  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

The ((GHC.Generics.:.:) g_afKB (GHC.Generics.Rec1 g_afKB)) bit is flat-out wrong—that should be ((GHC.Generics.:.:) f_afKA (GHC.Generics.Rec1 g_afKB)) instead. Curiously, this g_afKB-to-f_afKA switcheroo doesn't happen when kindSigOptions is True. Investigate why, fix it, and add a test case for it.

[RyanGlScott]

Actually, this instance wouldn't kind-check even without the type-variable switcheroo. You'd end up with something like this:

instance Generic1 (Compose f g) where
  type Rep1 (Compose f g) =
    D1 (MetaData "Compose" "ModuleName" "package-name" True)
      (C1 (MetaCons "Compose" 'PrefixI False)
        (S1 (MetaSel Nothing NoSourceUnpackedness NoSourceStrictness DecidedLazy)
          (f :.: Rec1 g)))
  from1 (Compose x) = M1 (M1 (M1 (Comp1 (fmap Rec1 x))))
  to1 (M1 (M1 (M1 x))) = Compose (fmap unRec1 (unComp1 x))

Which would fail thusly:

error:
    • Couldn't match kind ‘k2’ with ‘*’
      Expected kind ‘k -> *’, but ‘g’ has kind ‘k -> k2’
    • In the first argument of ‘Rec1’, namely ‘g’
      In the second argument of ‘(:.:)’, namely ‘Rec1 g’
      In the second argument of ‘S1’, namely ‘(f :.: Rec1 g)’
   |
   |           (f :.: Rec1 g)))
   |                       ^

Perhaps there is a less complicated example we could check in as a test case, however.

[RyanGlScott]

Another example on this phenomenon occurs if you use GHC 8.0 specifically on this code:

λ> newtype T f a b = MkT (f a b)
λ> ; $(deriveAll1 ''T)
<interactive>:12:5-18: Splicing declarations
    deriveAll1 ''T
  ======>
    instance Generic1 (T (f_aCtp :: k_aCtw
                                    -> GHC.Types.Type
                                       -> GHC.Types.Type) (a_aCtq :: k_aCtw) :: GHC.Types.Type
                                                                                -> GHC.Types.Type) where
      type Rep1 (T (f_aCtp :: k_aCtw
                              -> GHC.Types.Type
                                 -> GHC.Types.Type) (a_aCtq :: k_aCtw) :: GHC.Types.Type
                                                                          -> GHC.Types.Type) = D1 (MetaData "T" "Ghci4" "interactive" True) (C1 (MetaCons "MkT" PrefixI False) (S1 (MetaSel Nothing NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec1 (a_aCtq a_aCtq))))
      from1
        = \ val_aCVi
            -> case val_aCVi of {
                 y_aCVj
                   -> M1 (case y_aCVj of { MkT f1_aCVk -> M1 (M1 (Rec1 f1_aCVk)) }) }
      to1
        = \ val_aCVl
            -> case val_aCVl of {
                 M1 y_aCVm
                   -> case y_aCVm of { M1 (M1 f1_aCVn) -> MkT (unRec1 f1_aCVn) } }

<interactive>:12:5: error:
    • Occurs check: cannot construct the infinite kind: k ~ k -> * -> *
    • In the first argument of ‘Rec1’, namely ‘a_aCtq a_aCtq’
      In the second argument of ‘S1’, namely ‘Rec1 (a_aCtq a_aCtq)’
      In the second argument of ‘C1’, namely
        ‘S1 (MetaSel Nothing NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec1 (a_aCtq a_aCtq))’

Note the (Rec1 (a_aCtq a_aCtq)) bit.