Make Generic1 poly-kinded

This generalizes the `Generic1` typeclass to be of kind `k -> *`, and
this also makes the relevant datatypes and typeclasses in `GHC.Generics`
poly-kinded. If `PolyKinds` is enabled, `DeriveGeneric` derives
`Generic1` instances such that they use the most general kind possible.
Otherwise, deriving `Generic1` defaults to make an instance where the
argument is of kind `* -> *` (the current behavior).

Fixes #10604. Depends on D2117.

Test Plan: ./validate

Reviewers: kosmikus, dreixel, goldfire, austin, hvr, simonpj, bgamari

Reviewed By: simonpj, bgamari

Subscribers: thomie, ekmett

Differential Revision: https://phabricator.haskell.org/D2168

GHC Trac Issues: #10604

1 files changed, 68 insertions, 47 deletions

diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index 62c35760de..e45b761026 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -475,7 +475,9 @@ module GHC.Generics  (
 --
 -- Like 'Generic', there is a class 'Generic1' that defines a
 -- representation 'Rep1' and conversion functions 'from1' and 'to1',
--- only that 'Generic1' ranges over types of kind @* -> *@.
+-- only that 'Generic1' ranges over types of kind @* -> *@. (More generally,
+-- it can range over types of kind @k -> *@, for any kind @k@, if the
+-- @PolyKinds@ extension is enabled. More on this later.)
 -- The 'Generic1' class is also derivable.
 --
 -- The representation 'Rep1' is ever so slightly different from 'Rep'.
@@ -512,7 +514,7 @@ module GHC.Generics  (
 --                          'DecidedLazy)
 --                ('Rec1' Tree)))
 --   ...
---  @
+-- @
 --
 -- The representation reuses 'D1', 'C1', 'S1' (and thereby 'M1') as well
 -- as ':+:' and ':*:' from 'Rep'. (This reusability is the reason that we
@@ -552,7 +554,7 @@ module GHC.Generics  (
 -- yields
 --
 -- @
--- class 'Rep1' WithInt where
+-- instance 'Generic1' WithInt where
 --   type 'Rep1' WithInt =
 --     'D1' ('MetaData \"WithInt\" \"Main\" \"package-name\" 'False)
 --       ('C1' ('MetaCons \"WithInt\" 'PrefixI 'False)
@@ -579,7 +581,7 @@ module GHC.Generics  (
 -- yields
 --
 -- @
--- class 'Rep1' Rose where
+-- instance 'Generic1' Rose where
 --   type 'Rep1' Rose =
 --     'D1' ('MetaData \"Rose\" \"Main\" \"package-name\" 'False)
 --       ('C1' ('MetaCons \"Fork\" 'PrefixI 'False)
@@ -602,6 +604,22 @@ module GHC.Generics  (
 -- newtype (':.:') f g p = 'Comp1' { 'unComp1' :: f (g p) }
 -- @
 
+-- *** Representation of @k -> *@ types
+--
+-- |
+--
+-- The 'Generic1' class can be generalized to range over types of kind
+-- @k -> *@, for any kind @k@. To do so, derive a 'Generic1' instance with the
+-- @PolyKinds@ extension enabled. For example, the declaration
+--
+-- @
+-- data Proxy (a :: k) = Proxy deriving 'Generic1'
+-- @
+--
+-- yields a slightly different instance depending on whether @PolyKinds@ is
+-- enabled. If compiled without @PolyKinds@, then @'Rep1' Proxy :: * -> *@, but
+-- if compiled with @PolyKinds@, then @'Rep1' Proxy :: k -> *@.
+
 -- *** Representation of unlifted types
 --
 -- |
@@ -609,8 +627,8 @@ module GHC.Generics  (
 -- If one were to attempt to derive a Generic instance for a datatype with an
 -- unlifted argument (for example, 'Int#'), one might expect the occurrence of
 -- the 'Int#' argument to be marked with @'Rec0' 'Int#'@. This won't work,
--- though, since 'Int#' is of kind @#@ and 'Rec0' expects a type of kind @*@.
--- In fact, polymorphism over unlifted types is disallowed completely.
+-- though, since 'Int#' is of an unlifted kind, and 'Rec0' expects a type of
+-- kind @*@.
 --
 -- One solution would be to represent an occurrence of 'Int#' with 'Rec0 Int'
 -- instead. With this approach, however, the programmer has no way of knowing
@@ -726,7 +744,7 @@ import GHC.TypeLits ( Nat, Symbol, KnownSymbol, KnownNat, symbolVal, natVal )
 --------------------------------------------------------------------------------
 
 -- | Void: used for datatypes without constructors
-data V1 (p :: *)
+data V1 (p :: k)
   deriving (Functor, Generic, Generic1)
 
 deriving instance Eq   (V1 p)
@@ -735,7 +753,7 @@ deriving instance Read (V1 p)
 deriving instance Show (V1 p)
 
 -- | Unit: used for constructors without arguments
-data U1 (p :: *) = U1
+data U1 (p :: k) = U1
   deriving (Generic, Generic1)
 
 instance Eq (U1 p) where
@@ -777,8 +795,9 @@ instance Applicative Par1 where
 instance Monad Par1 where
   Par1 x >>= f = f x
 
--- | Recursive calls of kind * -> *
-newtype Rec1 f (p :: *) = Rec1 { unRec1 :: f p }
+-- | Recursive calls of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@
+-- is enabled)
+newtype Rec1 (f :: k -> *) (p :: k) = Rec1 { unRec1 :: f p }
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 instance Applicative f => Applicative (Rec1 f) where
@@ -794,8 +813,8 @@ instance Monad f => Monad (Rec1 f) where
 
 instance MonadPlus f => MonadPlus (Rec1 f)
 
--- | Constants, additional parameters and recursion of kind *
-newtype K1 (i :: *) c (p :: *) = K1 { unK1 :: c }
+-- | Constants, additional parameters and recursion of kind @*@
+newtype K1 (i :: *) c (p :: k) = K1 { unK1 :: c }
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 instance Applicative f => Applicative (M1 i c f) where
@@ -812,17 +831,17 @@ instance Monad f => Monad (M1 i c f) where
 instance MonadPlus f => MonadPlus (M1 i c f)
 
 -- | Meta-information (constructor names, etc.)
-newtype M1 (i :: *) (c :: Meta) f (p :: *) = M1 { unM1 :: f p }
+newtype M1 (i :: *) (c :: Meta) (f :: k -> *) (p :: k) = M1 { unM1 :: f p }
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 -- | Sums: encode choice between constructors
 infixr 5 :+:
-data (:+:) f g (p :: *) = L1 (f p) | R1 (g p)
+data (:+:) (f :: k -> *) (g :: k -> *) (p :: k) = L1 (f p) | R1 (g p)
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 -- | Products: encode multiple arguments to constructors
 infixr 6 :*:
-data (:*:) f g (p :: *) = f p :*: g p
+data (:*:) (f :: k -> *) (g :: k -> *) (p :: k) = f p :*: g p
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 instance (Applicative f, Applicative g) => Applicative (f :*: g) where
@@ -843,7 +862,8 @@ instance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g)
 
 -- | Composition of functors
 infixr 7 :.:
-newtype (:.:) f (g :: * -> *) (p :: *) = Comp1 { unComp1 :: f (g p) }
+newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) =
+    Comp1 { unComp1 :: f (g p) }
   deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
 
 instance (Applicative f, Applicative g) => Applicative (f :.: g) where
@@ -854,76 +874,76 @@ instance (Alternative f, Applicative g) => Alternative (f :.: g) where
   empty = Comp1 empty
   Comp1 x <|> Comp1 y = Comp1 (x <|> y)
 
--- | Constants of kind @#@
+-- | Constants of unlifted kinds
 --
 -- @since 4.9.0.0
-data family URec (a :: *) (p :: *)
+data family URec (a :: *) (p :: k)
 
 -- | Used for marking occurrences of 'Addr#'
 --
 -- @since 4.9.0.0
-data instance URec (Ptr ()) p = UAddr { uAddr# :: Addr# }
+data instance URec (Ptr ()) (p :: k) = UAddr { uAddr# :: Addr# }
   deriving (Eq, Ord, Functor, Generic, Generic1)
 
 -- | Used for marking occurrences of 'Char#'
 --
 -- @since 4.9.0.0
-data instance URec Char p = UChar { uChar# :: Char# }
+data instance URec Char (p :: k) = UChar { uChar# :: Char# }
   deriving (Eq, Ord, Show, Functor, Generic, Generic1)
 
 -- | Used for marking occurrences of 'Double#'
 --
 -- @since 4.9.0.0
-data instance URec Double p = UDouble { uDouble# :: Double# }
+data instance URec Double (p :: k) = UDouble { uDouble# :: Double# }
   deriving (Eq, Ord, Show, Functor, Generic, Generic1)
 
 -- | Used for marking occurrences of 'Float#'
 --
 -- @since 4.9.0.0
-data instance URec Float p = UFloat { uFloat# :: Float# }
+data instance URec Float (p :: k) = UFloat { uFloat# :: Float# }
   deriving (Eq, Ord, Show, Functor, Generic, Generic1)
 
 -- | Used for marking occurrences of 'Int#'
 --
 -- @since 4.9.0.0
-data instance URec Int p = UInt { uInt# :: Int# }
+data instance URec Int (p :: k) = UInt { uInt# :: Int# }
   deriving (Eq, Ord, Show, Functor, Generic, Generic1)
 
 -- | Used for marking occurrences of 'Word#'
 --
 -- @since 4.9.0.0
-data instance URec Word p = UWord { uWord# :: Word# }
+data instance URec Word (p :: k) = UWord { uWord# :: Word# }
   deriving (Eq, Ord, Show, Functor, Generic, Generic1)
 
--- | Type synonym for 'URec': 'Addr#'
+-- | Type synonym for @'URec' 'Addr#'@
 --
 -- @since 4.9.0.0
 type UAddr   = URec (Ptr ())
--- | Type synonym for 'URec': 'Char#'
+-- | Type synonym for @'URec' 'Char#'@
 --
 -- @since 4.9.0.0
 type UChar   = URec Char
--- | Type synonym for 'URec': 'Double#'
+-- | Type synonym for @'URec' 'Double#'@
 --
 -- @since 4.9.0.0
 type UDouble = URec Double
--- | Type synonym for 'URec': 'Float#'
+-- | Type synonym for @'URec' 'Float#'@
 --
 -- @since 4.9.0.0
 type UFloat  = URec Float
--- | Type synonym for 'URec': 'Int#'
+-- | Type synonym for @'URec' 'Int#'@
 --
 -- @since 4.9.0.0
 type UInt    = URec Int
--- | Type synonym for 'URec': 'Word#'
+-- | Type synonym for @'URec' 'Word#'@
 --
 -- @since 4.9.0.0
 type UWord   = URec Word
 
--- | Tag for K1: recursion (of kind *)
+-- | Tag for K1: recursion (of kind @*@)
 data R
 
--- | Type synonym for encoding recursion (of kind *)
+-- | Type synonym for encoding recursion (of kind @*@)
 type Rec0  = K1 R
 
 -- | Tag for M1: datatype
@@ -945,17 +965,17 @@ type S1 = M1 S
 -- | Class for datatypes that represent datatypes
 class Datatype d where
   -- | The name of the datatype (unqualified)
-  datatypeName :: t d (f :: * -> *) a -> [Char]
+  datatypeName :: t d (f :: k -> *) (a :: k) -> [Char]
   -- | The fully-qualified name of the module where the type is declared
-  moduleName   :: t d (f :: * -> *) a -> [Char]
+  moduleName   :: t d (f :: k -> *) (a :: k) -> [Char]
   -- | The package name of the module where the type is declared
   --
   -- @since 4.9.0.0
-  packageName :: t d (f :: * -> *) a -> [Char]
+  packageName :: t d (f :: k -> *) (a :: k) -> [Char]
   -- | Marks if the datatype is actually a newtype
   --
   -- @since 4.7.0.0
-  isNewtype    :: t d (f :: * -> *) a -> Bool
+  isNewtype    :: t d (f :: k -> *) (a :: k) -> Bool
   isNewtype _ = False
 
 instance (KnownSymbol n, KnownSymbol m, KnownSymbol p, SingI nt)
@@ -968,14 +988,14 @@ instance (KnownSymbol n, KnownSymbol m, KnownSymbol p, SingI nt)
 -- | Class for datatypes that represent data constructors
 class Constructor c where
   -- | The name of the constructor
-  conName :: t c (f :: * -> *) a -> [Char]
+  conName :: t c (f :: k -> *) (a :: k) -> [Char]
 
   -- | The fixity of the constructor
-  conFixity :: t c (f :: * -> *) a -> Fixity
+  conFixity :: t c (f :: k -> *) (a :: k) -> Fixity
   conFixity _ = Prefix
 
   -- | Marks if this constructor is a record
-  conIsRecord :: t c (f :: * -> *) a -> Bool
+  conIsRecord :: t c (f :: k -> *) (a :: k) -> Bool
   conIsRecord _ = False
 
 instance (KnownSymbol n, SingI f, SingI r)
@@ -1069,19 +1089,19 @@ data DecidedStrictness = DecidedLazy
 -- | Class for datatypes that represent records
 class Selector s where
   -- | The name of the selector
-  selName :: t s (f :: * -> *) a -> [Char]
+  selName :: t s (f :: k -> *) (a :: k) -> [Char]
   -- | The selector's unpackedness annotation (if any)
   --
   -- @since 4.9.0.0
-  selSourceUnpackedness :: t s (f :: * -> *) a -> SourceUnpackedness
+  selSourceUnpackedness :: t s (f :: k -> *) (a :: k) -> SourceUnpackedness
   -- | The selector's strictness annotation (if any)
   --
   -- @since 4.9.0.0
-  selSourceStrictness :: t s (f :: * -> *) a -> SourceStrictness
+  selSourceStrictness :: t s (f :: k -> *) (a :: k) -> SourceStrictness
   -- | The strictness that the compiler inferred for the selector
   --
   -- @since 4.9.0.0
-  selDecidedStrictness :: t s (f :: * -> *) a -> DecidedStrictness
+  selDecidedStrictness :: t s (f :: k -> *) (a :: k) -> DecidedStrictness
 
 instance (SingI mn, SingI su, SingI ss, SingI ds)
     => Selector ('MetaSel mn su ss ds) where
@@ -1101,11 +1121,12 @@ class Generic a where
   to    :: (Rep a) x -> a
 
 
--- | Representable types of kind * -> *.
--- This class is derivable in GHC with the DeriveGeneric flag on.
-class Generic1 f where
+-- | Representable types of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@
+-- is enabled).
+-- This class is derivable in GHC with the @DeriveGeneric@ flag on.
+class Generic1 (f :: k -> *) where
   -- | Generic representation type
-  type Rep1 f :: * -> *
+  type Rep1 f :: k -> *
   -- | Convert from the datatype to its representation
   from1  :: f a -> (Rep1 f) a
   -- | Convert from the representation to the datatype