[commit: haddock] master: Make ImplicitParams render correctly (#260) (14531f7)

git at git.haskell.org git at git.haskell.org
Sun Feb 23 22:29:40 UTC 2014


Repository : ssh://git@git.haskell.org/haddock

On branch  : master
Link       : http://git.haskell.org/haddock.git/commitdiff/14531f7838c5abd0ba2aaf5217a477194d7b1897

>---------------------------------------------------------------

commit 14531f7838c5abd0ba2aaf5217a477194d7b1897
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)


>---------------------------------------------------------------

14531f7838c5abd0ba2aaf5217a477194d7b1897
 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