aboutsummaryrefslogtreecommitdiff
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
parent9e1eb7840dab2790b79892a1c33bc40d0ba1a3c5 (diff)
[haddock @ 2005-05-18 12:41:59 by ross]
fix 3 bugs in --use-package, and document it.
-rw-r--r--doc/haddock.xml18
-rw-r--r--src/Main.hs40
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
-----------------------------------------------------------------------------