aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNiklas Haas <git@nand.wakku.to>2014-02-23 15:21:52 +0100
committerNiklas Haas <git@nand.wakku.to>2014-02-23 15:21:52 +0100
commit14531f7838c5abd0ba2aaf5217a477194d7b1897 (patch)
tree193113d2e0c81bb918b5436f34618b5f4d5c2f77
parent1944b94edca881d14e979d564719da6f196f8e63 (diff)
Make ImplicitParams render correctly (#260)
This introduces a new precedence level for single contexts (because implicit param contexts always need parens around them, but other types of contexts don't necessarily, even when alone)
-rw-r--r--html-test/ref/ImplicitParams.html89
-rw-r--r--html-test/src/ImplicitParams.hs10
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs19
-rw-r--r--src/Haddock/Backends/Xhtml/Names.hs2
4 files changed, 112 insertions, 8 deletions
diff --git a/html-test/ref/ImplicitParams.html b/html-test/ref/ImplicitParams.html
new file mode 100644
index 00000000..0219b323
--- /dev/null
+++ b/html-test/ref/ImplicitParams.html
@@ -0,0 +1,89 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+ ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+ /><title
+ >ImplicitParams</title
+ ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean"
+ /><script src="haddock-util.js" type="text/javascript"
+ ></script
+ ><script type="text/javascript"
+ >//<![CDATA[
+window.onload = function () {pageLoad();setSynopsis("mini_ImplicitParams.html");};
+//]]>
+</script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href="index.html"
+ >Contents</a
+ ></li
+ ><li
+ ><a href="doc-index.html"
+ >Index</a
+ ></li
+ ></ul
+ ><p class="caption empty"
+ >&nbsp;</p
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >Safe-Inferred</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >ImplicitParams</p
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >data</span
+ > <a name="t:X" class="def"
+ >X</a
+ ></p
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a name="v:c" class="def"
+ >c</a
+ > :: (?x :: <a href="ImplicitParams.html#t:X"
+ >X</a
+ >) =&gt; <a href="ImplicitParams.html#t:X"
+ >X</a
+ ></p
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a name="v:d" class="def"
+ >d</a
+ > :: (?x :: <a href="ImplicitParams.html#t:X"
+ >X</a
+ >, ?y :: <a href="ImplicitParams.html#t:X"
+ >X</a
+ >) =&gt; (<a href="ImplicitParams.html#t:X"
+ >X</a
+ >, <a href="ImplicitParams.html#t:X"
+ >X</a
+ >)</p
+ ></div
+ ></div
+ ></div
+ ><div id="footer"
+ ><p
+ >Produced by <a href="http://www.haskell.org/haddock/"
+ >Haddock</a
+ > version 2.14.0</p
+ ></div
+ ></body
+ ></html
+>
diff --git a/html-test/src/ImplicitParams.hs b/html-test/src/ImplicitParams.hs
new file mode 100644
index 00000000..4595b8f7
--- /dev/null
+++ b/html-test/src/ImplicitParams.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE ImplicitParams #-}
+module ImplicitParams where
+
+data X
+
+c :: (?x :: X) => X
+c = ?x
+
+d :: (?x :: X, ?y :: X) => (X, X)
+d = (?x, ?y)
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 72369069..427d5670 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -325,7 +325,7 @@ ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual
ppHsContext :: [HsType DocName] -> Bool -> Qualification-> Html
ppHsContext [] _ _ = noHtml
-ppHsContext [p] unicode qual = ppType unicode qual p
+ppHsContext [p] unicode qual = ppCtxType unicode qual p
ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt)
@@ -669,14 +669,16 @@ tupleParens _ = parenList
--------------------------------------------------------------------------------
-pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
+pREC_TOP, pREC_CTX, pREC_FUN, pREC_OP, pREC_CON :: Int
pREC_TOP = 0 :: Int -- type in ParseIface.y in GHC
-pREC_FUN = 1 :: Int -- btype in ParseIface.y in GHC
+pREC_CTX = 1 :: Int -- Used for single contexts, eg. ctx => type
+ -- (as opposed to (ctx1, ctx2) => type)
+pREC_FUN = 2 :: Int -- btype in ParseIface.y in GHC
-- Used for LH arg of (->)
-pREC_OP = 2 :: Int -- Used for arg of any infix operator
+pREC_OP = 3 :: Int -- Used for arg of any infix operator
-- (we don't keep their fixities around)
-pREC_CON = 3 :: Int -- Used for arg of type applicn:
+pREC_CON = 4 :: Int -- Used for arg of type applicn:
-- always parenthesise unless atomic
maybeParen :: Int -- Precedence of context
@@ -693,8 +695,10 @@ ppLParendType unicode qual y = ppParendType unicode qual (unLoc y)
ppLFunLhType unicode qual y = ppFunLhType unicode qual (unLoc y)
-ppType, ppParendType, ppFunLhType :: Bool -> Qualification-> HsType DocName -> Html
+ppType, ppCtxType, ppParendType, ppFunLhType :: Bool -> Qualification
+ -> HsType DocName -> Html
ppType unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual
+ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual
ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual
ppFunLhType unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual
@@ -735,7 +739,8 @@ ppr_mono_ty _ (HsKindSig ty kind) u q =
parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind)
ppr_mono_ty _ (HsListTy ty) u q = brackets (ppr_mono_lty pREC_TOP ty u q)
ppr_mono_ty _ (HsPArrTy ty) u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)
-ppr_mono_ty _ (HsIParamTy n ty) u q = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q)
+ppr_mono_ty ctxt_prec (HsIParamTy n ty) u q =
+ maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q
ppr_mono_ty _ (HsSpliceTy {}) _ _ = error "ppr_mono_ty HsSpliceTy"
ppr_mono_ty _ (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy"
ppr_mono_ty _ (HsRecTy {}) _ _ = error "ppr_mono_ty HsRecTy"
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index 24577e2a..33cd4f78 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -46,7 +46,7 @@ ppRdrName :: RdrName -> Html
ppRdrName = ppOccName . rdrNameOcc
ppIPName :: HsIPName -> Html
-ppIPName = toHtml . unpackFS . hsIPNameFS
+ppIPName = toHtml . ('?':) . unpackFS . hsIPNameFS
ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html