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

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

1 files changed, 17 insertions, 23 deletions

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