From fe9b10f8c0758645c680b339b8cc26bfb25697e8 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Thu, 11 Apr 2002 13:40:31 +0000
Subject: [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).
---
 src/Main.hs | 52 ++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 36 insertions(+), 16 deletions(-)

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index 19941ed1..7be91b9a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -12,6 +12,7 @@ import HaddockLex
 import HaddockDB
 import HaddockHtml
 import HaddockTypes
+import HaddockUtil
 
 import HsLexer hiding (Token)
 import HsParser
@@ -47,27 +48,48 @@ data Flag
   | Flag_Html
   | Flag_Heading String
   | Flag_SourceURL String
+  | Flag_CSS String
+  | Flag_OutputDir FilePath
   deriving (Eq)
 
 options =
   [ 
-    Option ['t']  ["heading"]  (ReqArg Flag_Heading "HEADING")
-	"page heading",
-    Option ['v']  ["verbose"]  (NoArg Flag_Verbose)
-	"be verbose",
     Option ['d']  ["docbook"]  (NoArg Flag_DocBook)
 	"output in docbook (SGML)",
     Option ['h']  ["html"]     (NoArg Flag_Html)
 	"output in HTML",
+    Option ['o']  ["odir"]     (ReqArg Flag_OutputDir "DIR")
+	"directory in which to put the output files",
     Option ['s']  ["source"]   (ReqArg Flag_SourceURL "URL") 
-	"base URL for links to source code"
+	"base URL for links to source code",
+    Option ['t']  ["heading"]  (ReqArg Flag_Heading "HEADING")
+	"page heading",
+    Option ['v']  ["verbose"]  (NoArg Flag_Verbose)
+	"be verbose",
+    Option []  ["css"]         (ReqArg Flag_CSS "FILE") 
+	"The CSS file to use for HTML output"
   ]
 
 saved_flags :: IORef [Flag]
 saved_flags = unsafePerformIO (newIORef (error "no flags yet"))
 
 run flags files = do
-  seq stderr $ do
+  let title = case [str | Flag_Heading str <- flags] of
+		[] -> ""
+		(t:ts) -> t
+
+      source_url = case [str | Flag_SourceURL str <- flags] of
+			[] -> Nothing
+			(t:ts) -> Just t
+
+  css_file <- case [str | Flag_CSS str <- flags] of
+		[] -> dieMsg "no --css option"
+		fs -> return (last fs)
+
+  odir <- case [str | Flag_OutputDir str <- flags] of
+		[] -> return "."
+		fs -> return (last fs)
+
   writeIORef saved_flags flags
   parsed_mods <- sequence (map parse_file files)
 
@@ -77,22 +99,14 @@ run flags files = do
       mod_ifaces = [ (m,i) | (m,i,_,_) <- ifaces ]
       module_map = listToFM mod_ifaces
 
-  let title = case [str | Flag_Heading str <- flags] of
-		[] -> ""
-		(t:ts) -> t
-
-      source_url = case [str | Flag_SourceURL str <- flags] of
-			[] -> Nothing
-			(t:ts) -> Just t
-
   sequence [ reportMissingNames m ns_docs ns_decls 
 	   | (m, _, ns_docs, ns_decls) <- ifaces ]
 
   when (Flag_DocBook `elem` flags) $
-    putStr (ppDocBook mod_ifaces)
+    putStr (ppDocBook odir mod_ifaces)
 
   when (Flag_Html `elem` flags) $
-    ppHtml title source_url mod_ifaces
+    ppHtml title source_url mod_ifaces odir css_file
 
 
 parse_file file = do
@@ -513,6 +527,12 @@ strToHsQNames str
 -----------------------------------------------------------------------------
 -- misc.
 
+die :: String -> IO a
+die s = hPutStr stderr s >> exitWith (ExitFailure 1)
+
+dieMsg :: String -> IO a
+dieMsg s = getProgName >>= \prog -> die (prog ++ ": " ++ s)
+
 mapSnd f [] = []
 mapSnd f ((x,y):xs) = (x,f y) : mapSnd f xs
 
-- 
cgit v1.2.3