aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2019-01-07 13:55:22 -0800
committerGitHub <noreply@github.com>2019-01-07 13:55:22 -0800
commita6504507cb7f575dad63aa9f992cfc8d4f70c582 (patch)
tree8f2cf19af05c675454ad1ea7b02860e6d0886ca9
parent39251d3aa339958aafd8b955f41323a8b0b60012 (diff)
Print kinded tyvars in constructors for Hoogle (#993)
Fixes #992
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs10
-rw-r--r--hoogle-test/ref/Bug992/test.txt9
-rw-r--r--hoogle-test/src/Bug992/Bug992.hs5
3 files changed, 22 insertions, 2 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 5f77c38c..7e2ce2f2 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -266,8 +266,14 @@ ppCtor dflags dat subdocs con@ConDeclH98 {}
-- docs for con_names on why it is a list to begin with.
name = commaSeparate dflags . map unL $ getConNames con
- resType = apps $ map (reL . HsTyVar NoExt NotPromoted . reL) $
- (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _ _) <- hsQTvExplicit $ tyClDeclTyVars dat]
+ resType = let c = HsTyVar NoExt NotPromoted (noLoc (tcdName dat))
+ as = map (tyVarBndr2Type . unLoc) (hsQTvExplicit $ tyClDeclTyVars dat)
+ in apps (map noLoc (c : as))
+
+ tyVarBndr2Type :: HsTyVarBndr GhcRn -> HsType GhcRn
+ tyVarBndr2Type (UserTyVar _ n) = HsTyVar NoExt NotPromoted n
+ tyVarBndr2Type (KindedTyVar _ n k) = HsKindSig NoExt (noLoc (HsTyVar NoExt NotPromoted n)) k
+ tyVarBndr2Type (XTyVarBndr _) = panic "haddock:ppCtor"
ppCtor dflags _dat subdocs con@(ConDeclGADT { })
= concatMap (lookupCon dflags subdocs) (getConNames con) ++ f
diff --git a/hoogle-test/ref/Bug992/test.txt b/hoogle-test/ref/Bug992/test.txt
new file mode 100644
index 00000000..8ae145c3
--- /dev/null
+++ b/hoogle-test/ref/Bug992/test.txt
@@ -0,0 +1,9 @@
+-- Hoogle documentation, generated by Haddock
+-- See Hoogle, http://www.haskell.org/hoogle/
+
+@package test
+@version 0.0.0
+
+module Bug992
+data K (m :: * -> *)
+K :: K (m :: * -> *)
diff --git a/hoogle-test/src/Bug992/Bug992.hs b/hoogle-test/src/Bug992/Bug992.hs
new file mode 100644
index 00000000..bd772427
--- /dev/null
+++ b/hoogle-test/src/Bug992/Bug992.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE KindSignatures #-}
+
+module Bug992 where
+
+data K (m :: * -> *) = K