diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 40 |
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 ----------------------------------------------------------------------------- |