diff options
| -rw-r--r-- | doc/haddock.xml | 18 | ||||
| -rw-r--r-- | src/Main.hs | 40 |
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 ----------------------------------------------------------------------------- |