aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-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
-----------------------------------------------------------------------------