[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.

1 files changed, 18 insertions, 10 deletions

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