[haddock @ 2002-06-20 12:39:01 by simonmar]

Add support for a "prologue" - a description for the whole library,
placed on the contents page before the module list.

2 files changed, 33 insertions, 6 deletions

diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index cebb9690..4739c84b 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -46,8 +46,10 @@ ppHtml	:: String
 	-> Maybe String			-- CSS file
 	-> String			-- $libdir
 	-> InstMaps
+	-> Maybe Doc			-- prologue text, maybe
 	-> IO ()
-ppHtml title source_url ifaces odir maybe_css libdir inst_maps =  do
+
+ppHtml title source_url ifaces odir maybe_css libdir inst_maps prologue =  do
   let 
 	css_file = case maybe_css of
 			Nothing -> libdir ++ pathSeparator:cssFile
@@ -65,7 +67,7 @@ ppHtml title source_url ifaces odir maybe_css libdir inst_maps =  do
   icon_contents <- readFile icon_file
   writeFile icon_destination icon_contents
 
-  ppHtmlContents odir title source_url (map fst visible_ifaces)
+  ppHtmlContents odir title source_url (map fst visible_ifaces) prologue
   ppHtmlIndex odir title visible_ifaces
   mapM_ (ppHtmlModule odir title source_url inst_maps) visible_ifaces
 
@@ -151,9 +153,9 @@ moduleInfo iface
 -- ---------------------------------------------------------------------------
 -- Generate the module contents
 
-ppHtmlContents :: FilePath -> String -> Maybe String -> [Module]
+ppHtmlContents :: FilePath -> String -> Maybe String -> [Module] -> Maybe Doc
    -> IO ()
-ppHtmlContents odir title source_url mods = do
+ppHtmlContents odir title source_url mods prologue = do
   let tree = mkModuleTree mods  
       html = 
 	header (thetitle (toHtml title) +++
@@ -161,11 +163,19 @@ ppHtmlContents odir title source_url mods = do
 		  rel "stylesheet", thetype "text/css"]) +++
         body << vanillaTable << (
    	    simpleHeader title </>
+	    ppPrologue prologue </>
 	    ppModuleTree title tree </>
+	    s15 </>
 	    footer
 	  )
   writeFile (odir ++ pathSeparator:contentsHtmlFile) (renderHtml html)
 
+ppPrologue :: Maybe Doc -> HtmlTable
+ppPrologue Nothing = Html.emptyTable
+ppPrologue (Just doc) = 
+  (tda [theclass "section1"] << toHtml "Description") </>
+  docBox (docToHtml doc)
+
 ppModuleTree :: String -> [ModuleTree] -> HtmlTable
 ppModuleTree title ts = 
   tda [theclass "section1"] << toHtml "Modules" </>
diff --git a/src/Main.hs b/src/Main.hs
index 82162ef1..3d8c86dc 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -8,6 +8,7 @@ module Main (main) where
 
 import HaddockRename
 import HaddockParse
+import HaddockLex
 --import HaddockDB   -- not compiling
 import HaddockHtml
 import HaddockTypes
@@ -54,6 +55,7 @@ data Flag
   | Flag_DocBook
   | Flag_Html
   | Flag_Heading String
+  | Flag_Prologue FilePath
   | Flag_SourceURL String
   | Flag_CSS String
   | Flag_Lib String
@@ -68,9 +70,11 @@ options =
 	"output in HTML",
     Option ['o']  ["odir"]     (ReqArg Flag_OutputDir "DIR")
 	"directory in which to put the output files",
+    Option ['p']  ["prologue"] (ReqArg Flag_Prologue "FILE")
+	"file containing prologue text",
     Option ['s']  ["source"]   (ReqArg Flag_SourceURL "URL") 
 	"base URL for links to source code",
-    Option ['t']  ["title"]  (ReqArg Flag_Heading "TITLE")
+    Option ['t']  ["title"]    (ReqArg Flag_Heading "TITLE")
 	"page heading",
     Option ['v']  ["verbose"]  (NoArg Flag_Verbose)
 	"be verbose",
@@ -104,6 +108,8 @@ run flags files = do
 		[] -> return "."
 		fs -> return (last fs)
 
+  prologue <- getPrologue flags
+
   writeIORef saved_flags flags
   parsed_mods <- sequence (map parse_file files)
 
@@ -129,7 +135,7 @@ run flags files = do
   let inst_maps = collectInstances mod_ifaces
 
   when (Flag_Html `elem` flags) $
-    ppHtml title source_url mod_ifaces odir css_file libdir inst_maps
+    ppHtml title source_url mod_ifaces odir css_file libdir inst_maps prologue
 
 parse_file file = do
   bracket 
@@ -142,6 +148,17 @@ parse_file file = do
 				 exitWith (ExitFailure 1)
     )
 
+getPrologue :: [Flag] -> IO (Maybe Doc)
+getPrologue flags
+  = case [filename | Flag_Prologue filename <- flags ] of
+	[] -> return Nothing 
+	[filename] -> do
+	   str <- readFile filename
+	   case parseParas (tokenise str) of
+		Left err -> dieMsg err
+		Right doc -> return (Just doc)
+	_otherwise -> dieMsg "multiple -p/--prologue options"
+
 -----------------------------------------------------------------------------
 -- Figuring out the definitions that are exported from a module