From d4375d8ec96991de2578fd65c79d0487f6a440d8 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Tue, 24 Oct 2017 07:07:15 -0400
Subject: Overhaul Haddock's rendering of kind signatures (#681)

* Overhaul Haddock's rendering of kind signatures

* Strip off kind signatures when specializing

As an added bonus, this lets us remove an ugly hack specifically for `(->)`.
Yay!

* Update due to 0390e4a0f61e37bd1dcc24a36d499e92f2561b67

* @alexbiehl's suggestions

* Import injectiveVarsOfBinder from GHC
---
 haddock-api/src/Haddock/Interface/Rename.hs     | 2 --
 haddock-api/src/Haddock/Interface/Specialize.hs | 8 +++++++-
 2 files changed, 7 insertions(+), 3 deletions(-)

(limited to 'haddock-api/src/Haddock/Interface')

diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 70962d9c..7023a908 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -294,7 +294,6 @@ renameWildCardInfo (AnonWildCard  (L l name)) = AnonWildCard . L l <$> rename na
 renameInstHead :: InstHead GhcRn -> RnM (InstHead DocNameI)
 renameInstHead InstHead {..} = do
   cname <- rename ihdClsName
-  kinds <- mapM renameType ihdKinds
   types <- mapM renameType ihdTypes
   itype <- case ihdInstType of
     ClassInst { .. } -> ClassInst
@@ -306,7 +305,6 @@ renameInstHead InstHead {..} = do
     DataInst  dd -> DataInst  <$> renameTyClD dd
   return InstHead
     { ihdClsName = cname
-    , ihdKinds = kinds
     , ihdTypes = types
     , ihdInstType = itype
     }
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 0c8e89c2..6d2888d3 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -34,7 +34,13 @@ specialize :: forall name a. (Ord (IdP name), DataId name, NamedThing (IdP name)
 specialize specs = go
   where
     go :: forall x. Data x => x -> x
-    go = everywhereButType @name $ mkT $ sugar . specialize_ty_var
+    go = everywhereButType @name $ mkT $ sugar . strip_kind_sig . specialize_ty_var
+
+    strip_kind_sig :: HsType name -> HsType name
+    strip_kind_sig (HsKindSig (L _ t) _) = t
+    strip_kind_sig typ = typ
+
+    specialize_ty_var :: HsType name -> HsType name
     specialize_ty_var (HsTyVar _ (L _ name'))
       | Just t <- Map.lookup name' spec_map = t
     specialize_ty_var typ = typ
-- 
cgit v1.2.3