[haddock @ 2003-11-28 12:09:58 by simonmar]

Fix some of the problems with Haddock generating pages that are too
wide.  Now we only specify 'nowrap' when it is necessary to avoid a
code box getting squashed up by the text to the right of it.

2 files changed, 37 insertions, 11 deletions

diff --git a/html/haddock.css b/html/haddock.css
index 67ef28d2..927d1ecd 100644
--- a/html/haddock.css
+++ b/html/haddock.css
@@ -51,10 +51,23 @@ TD.decl {
   padding: 2px;
   background-color: #f0f0f0; 
   font-family: monospace;
-  white-space: nowrap;
   vertical-align: top;
   }
 
+/* 
+  arg is just like decl, except that wrapping is not allowed.  It is
+  used for function and constructor arguments which have a text box
+  to the right, where if wrapping is allowed the text box squashes up
+  the declaration by wrapping it.
+*/
+TD.arg { 
+  padding: 2px;
+  background-color: #f0f0f0; 
+  font-family: monospace;
+  vertical-align: top;
+  white-space: nowrap;
+  }
+
 TD.recfield { padding-left: 20px }
 
 TD.doc  { 
@@ -76,6 +89,11 @@ TD.body  {
   padding-left: 10px
   }
 
+TD.pkg {
+  width: 100%;
+  padding-left: 10px
+}
+
 TD.indexentry {
   vertical-align: top;
   padding-right: 10px
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index d0e8d5e5..f100471a 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -6,7 +6,7 @@
 
 module HaddockHtml ( 
 	ppHtml, copyHtmlBits, 
-	ppHtmlIndex, ppHtmlContents
+	ppHtmlIndex, ppHtmlContents, foo
   ) where
 
 import Prelude hiding (div)
@@ -34,6 +34,8 @@ import Network.URI ( escapeString, unreserved )
 import Html
 import qualified Html
 
+foo = 42
+
 -- -----------------------------------------------------------------------------
 -- Files we need to copy from our $libdir
 
@@ -610,18 +612,18 @@ ppHsConstrHdr tvs ctxt
 
 ppSideBySideConstr :: HsConDecl -> HtmlTable
 ppSideBySideConstr (HsConDecl _ nm tvs ctxt typeList doc) =
-  declBox (hsep ((ppHsConstrHdr tvs ctxt +++ 
+  argBox (hsep ((ppHsConstrHdr tvs ctxt +++ 
 		ppHsBinder False nm) : map ppHsBangType typeList)) <->
   maybeRDocBox doc
 ppSideBySideConstr (HsRecDecl _ nm tvs ctxt fields doc) =
-  declBox (ppHsConstrHdr tvs ctxt +++ ppHsBinder False nm) <->
+  argBox (ppHsConstrHdr tvs ctxt +++ ppHsBinder False nm) <->
   maybeRDocBox doc </>
   (tda [theclass "body"] << spacedTable1 <<
      aboves (map ppSideBySideField fields))
 
 ppSideBySideField :: HsFieldDecl -> HtmlTable
 ppSideBySideField (HsFieldDecl ns ty doc) =
-  declBox (hsep (punctuate comma (map (ppHsBinder False) ns))
+  argBox (hsep (punctuate comma (map (ppHsBinder False) ns))
 	   <+> dcolon <+> ppHsBangType ty) <->
   maybeRDocBox doc
 
@@ -790,26 +792,26 @@ ppFunSig summary nm ty0 doc
 
 	do_args :: Html -> HsType -> HtmlTable
 	do_args leader (HsForAllType (Just tvs) ctxt ty)
-	  = (declBox (
+	  = (argBox (
 		leader <+> 
 		hsep (keyword "forall" : map ppHsName tvs ++ [toHtml "."]) <+>
 		ppHsIPContext ctxt)
 	      <-> rdocBox noHtml) </> 
 	    do_args darrow ty
 	do_args leader (HsForAllType Nothing ctxt ty)
-	  = (declBox (leader <+> ppHsIPContext ctxt)
+	  = (argBox (leader <+> ppHsIPContext ctxt)
 		<-> rdocBox noHtml) </> 
 	    do_args darrow ty
 	do_args leader (HsTyFun (HsTyDoc ty doc0) r)
-	  = (declBox (leader <+> ppHsBType ty) <-> rdocBox (docToHtml doc0))
+	  = (argBox (leader <+> ppHsBType ty) <-> rdocBox (docToHtml doc0))
             </> do_args arrow r
 	do_args leader (HsTyFun ty r)
-	  = (declBox (leader <+> ppHsBType ty) <-> rdocBox noHtml) </>
+	  = (argBox (leader <+> ppHsBType ty) <-> rdocBox noHtml) </>
 	    do_args arrow r
 	do_args leader (HsTyDoc ty doc0)
-	  = (declBox (leader <+> ppHsBType ty) <-> rdocBox (docToHtml doc0))
+	  = (argBox (leader <+> ppHsBType ty) <-> rdocBox (docToHtml doc0))
 	do_args leader ty
-	  = declBox (leader <+> ppHsBType ty) <-> rdocBox (noHtml)
+	  = argBox (leader <+> ppHsBType ty) <-> rdocBox (noHtml)
 
 -- ----------------------------------------------------------------------------
 -- Types and contexts
@@ -1035,6 +1037,12 @@ text   = strAttr "TEXT"
 declBox :: Html -> HtmlTable
 declBox html = tda [theclass "decl"] << html
 
+-- a box for displaying an 'argument' (some code which has text to the
+-- right of it).  Wrapping is not allowed in these boxes, whereas it is
+-- in a declBox.
+argBox :: Html -> HtmlTable
+argBox html = tda [theclass "arg"] << html
+
 -- a box for displaying documentation, 
 -- indented and with a little padding at the top
 docBox :: Html -> HtmlTable