[commit: haddock] ghc-7.8: Make ImplicitParams render correctly (#260) (90f216b)
git at git.haskell.org
git at git.haskell.org
Mon Feb 24 21:36:17 UTC 2014
Repository : ssh://git@git.haskell.org/haddock
On branch : ghc-7.8
Link : http://git.haskell.org/haddock.git/commitdiff/90f216bd3c1b1d708a5b41c31d2a1a067fce3d32
>---------------------------------------------------------------
commit 90f216bd3c1b1d708a5b41c31d2a1a067fce3d32
Author: Niklas Haas <git at nand.wakku.to>
Date: Sun Feb 23 15:21:52 2014 +0100
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)
(cherry picked from commit 14531f7838c5abd0ba2aaf5217a477194d7b1897)
>---------------------------------------------------------------
90f216bd3c1b1d708a5b41c31d2a1a067fce3d32
html-test/ref/{Bold.html => ImplicitParams.html} | 74 ++++++++++------------
html-test/src/ImplicitParams.hs | 10 +++
src/Haddock/Backends/Xhtml/Decl.hs | 19 ++++--
src/Haddock/Backends/Xhtml/Names.hs | 2 +-
4 files changed, 55 insertions(+), 50 deletions(-)
diff --git a/html-test/ref/Bold.html b/html-test/ref/ImplicitParams.html
similarity index 59%
copy from html-test/ref/Bold.html
copy to html-test/ref/ImplicitParams.html
index f6bdbd5..0219b32 100644
--- a/html-test/ref/Bold.html
+++ b/html-test/ref/ImplicitParams.html
@@ -3,13 +3,13 @@
><head
><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
/><title
- >Bold</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_Bold.html");};
+window.onload = function () {pageLoad();setSynopsis("mini_ImplicitParams.html");};
//]]>
</script
></head
@@ -39,52 +39,42 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bold.html");};
></tr
></table
><p class="caption"
- >Bold</p
- ></div
- ><div id="synopsis"
- ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')"
- >Synopsis</p
- ><ul id="section.syn" class="hide" onclick="toggleSection('syn')"
- ><li class="src short"
- ><a href="#v:foo"
- >foo</a
- > :: t</li
- ></ul
+ >ImplicitParams</p
></div
><div id="interface"
><h1
>Documentation</h1
><div class="top"
><p class="src"
- ><a name="v:foo" class="def"
- >foo</a
- > :: t</p
- ><div class="doc"
- ><p
- >Some <strong
- >bold text</strong
- >.</p
- ><ul
- ><li
- ><strong
- >Bold</strong
- > in a list</li
- ></ul
- ><dl
- ><dt
- ><strong
- >bold in a definition</strong
- ></dt
- ><dd
- >list</dd
- ></dl
- ><pre
- > bold <strong
- >in</strong
- > a <strong
- >code</strong
- > block</pre
- ></div
+ ><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
+ >) => <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
+ >) => (<a href="ImplicitParams.html#t:X"
+ >X</a
+ >, <a href="ImplicitParams.html#t:X"
+ >X</a
+ >)</p
></div
></div
></div
diff --git a/html-test/src/ImplicitParams.hs b/html-test/src/ImplicitParams.hs
new file mode 100644
index 0000000..4595b8f
--- /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 7236906..427d567 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 24577e2..33cd4f7 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
More information about the ghc-commits
mailing list