[haddock @ 2002-04-11 13:40:30 by simonmar]

- copy haddock.css into the same place as the generated HTML

- new option: --css <file>  specifies the style sheet to use

- new option:  -o <dir>  specifies the directory in which to
  generate the output.

- because Haddock now needs to know where to find its default stylesheet,
  we have to have a wrapper script and do the haddock-inplace thing
  (Makefile code copied largely from fptools/happy).

1 files changed, 36 insertions, 20 deletions

diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index daf9732c..8e02e535 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -9,6 +9,7 @@ module HaddockHtml (ppHtml) where
 import Prelude hiding (div)
 import HaddockVersion
 import HaddockTypes
+import HaddockUtil
 import HsSyn
 
 import Maybe	( fromJust, isNothing, isJust )
@@ -23,18 +24,30 @@ import qualified Html
 -- -----------------------------------------------------------------------------
 -- Generating HTML documentation
 
-ppHtml :: String -> Maybe String -> [(Module, Interface)] -> IO ()
-ppHtml title source_url ifaces =  do
-  ppHtmlContents title source_url (map fst ifaces)
-  ppHtmlIndex title ifaces
-  mapM_ (ppHtmlModule title source_url) ifaces
+ppHtml	:: String
+	-> Maybe String
+	-> [(Module, Interface)]
+	-> FilePath			-- destination directory
+	-> String			-- CSS file
+	-> IO ()
+ppHtml title source_url ifaces odir css_file =  do
+  let 
+	(_css_dir, css_basename, css_suff) = splitFilename3 css_file
+	css_filename = css_basename ++ '.':css_suff
+	css_destination = odir ++ pathSeparator:css_filename
+
+  css_contents <- readFile css_file
+  writeFile css_destination css_contents
+
+  ppHtmlContents odir css_filename title source_url (map fst ifaces)
+  ppHtmlIndex odir css_filename title ifaces
+  mapM_ (ppHtmlModule odir css_filename title source_url) ifaces
 
 moduleHtmlFile :: String -> FilePath
 moduleHtmlFile mod = mod ++ ".html" -- ToDo: Z-encode filename?
 
 contentsHtmlFile = "index.html"
 indexHtmlFile    = "doc-index.html"
-styleSheetFile   = "haddock.css"
 subIndexHtmlFile k a = "doc-index-" ++ k:a:".html"
 
 footer = 
@@ -116,12 +129,13 @@ pageHeader mod iface title source_url =
 -- ---------------------------------------------------------------------------
 -- Generate the module contents
 
-ppHtmlContents :: String -> Maybe String -> [Module] -> IO ()
-ppHtmlContents title source_url mods = do
+ppHtmlContents :: FilePath -> String -> String -> Maybe String -> [Module]
+   -> IO ()
+ppHtmlContents odir css_filename title source_url mods = do
   let tree = mkModuleTree mods  
       html = 
 	header (thetitle (toHtml title) +++
-		thelink ! [href styleSheetFile, 
+		thelink ! [href css_filename, 
 		  rel "stylesheet", thetype "text/css"]) +++
         body <<  
 	  table ! [width "100%", cellpadding 0, cellspacing 1] << (
@@ -129,7 +143,7 @@ ppHtmlContents title source_url mods = do
 	    ppModuleTree title tree </>
 	    footer
 	  )
-  writeFile contentsHtmlFile (renderHtml html)
+  writeFile (odir ++ pathSeparator:contentsHtmlFile) (renderHtml html)
 
 ppModuleTree :: String -> [ModuleTree] -> HtmlTable
 ppModuleTree title ts = 
@@ -176,11 +190,11 @@ splitModule (Module mod) = split mod
 -- ---------------------------------------------------------------------------
 -- Generate the index
 
-ppHtmlIndex :: String -> [(Module,Interface)] -> IO ()
-ppHtmlIndex title ifaces = do
+ppHtmlIndex :: FilePath -> String -> String -> [(Module,Interface)] -> IO ()
+ppHtmlIndex odir css_filename title ifaces = do
   let html = 
 	header (thetitle (toHtml (title ++ " (Index)")) +++
-		thelink ! [href styleSheetFile, 
+		thelink ! [href css_filename, 
 		  rel "stylesheet", thetype "text/css"]) +++
         body <<  
 	  table ! [width "100%", cellpadding 0, cellspacing 1] << (
@@ -196,7 +210,7 @@ ppHtmlIndex title ifaces = do
         mapM_ (do_sub_index "Function/Constructor" var_index 'v') ['A'..'Z'] 
     )
 
-  writeFile indexHtmlFile (renderHtml html)
+  writeFile (odir ++ pathSeparator:indexHtmlFile) (renderHtml html)
 
  where
   split_indices = length tycls_index > 50 || length var_index > 50
@@ -212,10 +226,11 @@ ppHtmlIndex title ifaces = do
 	  aboves (map indexElt this_ix) 
  	
   do_sub_index descr this_ix kind c
-    = writeFile (subIndexHtmlFile kind c) (renderHtml html)
+    = writeFile (odir ++ pathSeparator:subIndexHtmlFile kind c)
+	(renderHtml html)
     where 
       html = header (thetitle (toHtml (title ++ " (" ++ descr ++ "Index)")) +++
-		thelink ! [href styleSheetFile, 
+		thelink ! [href css_filename, 
 		  rel "stylesheet", thetype "text/css"]) +++
              body <<  
 	      table ! [width "100%", cellpadding 0, cellspacing 1] << (
@@ -265,11 +280,12 @@ idBeginsWith (HsSpecial s) c = head s `elem` [toLower c, toUpper c]
 -- ---------------------------------------------------------------------------
 -- Generate the HTML page for a module
 
-ppHtmlModule :: String -> Maybe String -> (Module,Interface) -> IO ()
-ppHtmlModule title source_url (Module mod,iface) = do
+ppHtmlModule :: FilePath -> String -> String -> Maybe String
+	-> (Module,Interface) -> IO ()
+ppHtmlModule odir css_filename title source_url (Module mod,iface) = do
   let html = 
 	header (thetitle (toHtml mod) +++
-		thelink ! [href styleSheetFile, 
+		thelink ! [href css_filename,
 		  rel "stylesheet", thetype "text/css"]) +++
         body <<  
 	  table ! [width "100%", cellpadding 0, cellspacing 1] << (
@@ -277,7 +293,7 @@ ppHtmlModule title source_url (Module mod,iface) = do
 	    ifaceToHtml mod iface </>
 	    footer
          )
-  writeFile (moduleHtmlFile mod) (renderHtml html)
+  writeFile (odir ++ pathSeparator:moduleHtmlFile mod) (renderHtml html)
 
 ifaceToHtml :: String -> Interface -> HtmlTable
 ifaceToHtml mod iface