[haddock @ 2005-05-18 12:41:59 by ross]

fix 3 bugs in --use-package, and document it.

2 files changed, 34 insertions, 24 deletions

diff --git a/doc/haddock.xml b/doc/haddock.xml
index f9dbb1ff..c027170c 100644
--- a/doc/haddock.xml
+++ b/doc/haddock.xml
@@ -280,6 +280,22 @@
 
       <varlistentry>
 	<term>
+	  <indexterm><primary><option>--use-package</option></primary></indexterm>
+          <option>--use-package</option>=<replaceable>package</replaceable>
+        </term>
+	<listitem>
+	  <para>Like <option>--read-interface</option>, but use
+	  <command>ghc-pkg</command> to locate the interface file and
+	  HTML documentation for <replaceable>package</replaceable>,
+	  to reference when generating the documentation.</para>
+
+	  <para>Multiple <option>--use-package</option> options may
+	  be given.</para>
+	</listitem>
+      </varlistentry>
+
+      <varlistentry>
+	<term>
   	  <indexterm><primary><option>-D</option></primary></indexterm>
           <option>-D</option> <replaceable>file</replaceable>
         </term>
@@ -619,7 +635,7 @@
 	  all the specified interfaces (interfaces are specified using
 	  <option>-i</option> or <option>--read-interface</option>).
 	  This is used to generate a single index for multiple sets of
-	  Haddock documentstation.</para>
+	  Haddock documentation.</para>
 	</listitem>
       </varlistentry>
 
diff --git a/src/Main.hs b/src/Main.hs
index 3599d6da..deda34ca 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -371,8 +371,21 @@ getPackageIfaces flags verbose =
 		  return Nothing)
 
   getPkgIface' pkg = do
+	html <- getPkgField pkg "haddock-html"
+	html_exists <- doesDirectoryExist html
+	when (not html_exists) $ do
+	   throwIO (ErrorCall ("HTML directory " ++ html ++ " does not exist."))
+
+	iface <- getPkgField pkg "haddock-interfaces"
+	iface_exists <- doesFileExist iface
+	when (not iface_exists) $ do
+	   throwIO (ErrorCall ("interface " ++ iface ++ " does not exist."))
+
+	return (Just (html, iface))
+
+  getPkgField pkg field = do
 	(hin,hout,herr,p) <- runInteractiveProcess hc_pkg 
-				["field", "haddock-interfaces", pkg]
+				["field", pkg, field]
 				Nothing Nothing
 	hClose hin
 	out <- hGetContents hout
@@ -380,29 +393,10 @@ getPackageIfaces flags verbose =
 	r <- waitForProcess p
 	when (r /= ExitSuccess) $
 	   throwIO (ErrorCall ("ghc-pkg failed"))
-	let iface = dropWhile isSpace (tail (dropWhile (/=':') out))
-
-	(hin,hout,herr,p) <- runInteractiveProcess hc_pkg
-	  			["field", "haddock-html", pkg]
-				Nothing Nothing
-	hClose hin
-	forkIO (hGetContents herr >> return ()) -- just sink the stderr
-	out <- hGetContents hout
-	r <- waitForProcess p
-	when (r /= ExitSuccess) $
-	   throwIO (ErrorCall ("ghc-pkg failed"))
-	let html = dropWhile isSpace (tail (dropWhile (/=':') out))
-
+	let value = dropWhile isSpace $ init $ tail $ dropWhile (/=':') out
 	when verbose $ 
-	   putStrLn ("   interface: " ++ iface ++ "\n   html: " ++ html)
-
-	iface_exists <- doesFileExist iface
-	when (not iface_exists) $ do
-	   throwIO (ErrorCall ("interface " ++ iface ++ " does not exist."))
-	html_exists <- doesDirectoryExist html
-	when (not html_exists) $ do
-	   throwIO (ErrorCall ("HTML directory " ++ html ++ " does not exist."))
-	return (Just (iface, html))
+	   putStrLn ("   " ++ field ++ ": " ++ value)
+	return value
 #endif
 
 -----------------------------------------------------------------------------