aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorross <unknown>2005-05-18 12:41:59 +0000
committerross <unknown>2005-05-18 12:41:59 +0000
commit23281f787a412ebc54c3e3074ed49327f2942e6c (patch)
tree215e681be7eb490186099f805dc06f7db35f8e3c /src/Main.hs
parent9e1eb7840dab2790b79892a1c33bc40d0ba1a3c5 (diff)
[haddock @ 2005-05-18 12:41:59 by ross]
fix 3 bugs in --use-package, and document it.
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs40
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
-----------------------------------------------------------------------------