[haddock @ 2002-05-08 11:21:56 by simonmar]

Add a facility for specifying options that affect Haddock's treatment
of the module.  Options are given at the top of the module in a
comma-separated list, beginning with '-- #'.  eg.

	-- # prune, hide, ignore-exports

Options currently available, with their meanings:

  prune:
	ignore declarations which have no documentation annotations

  ignore-exports:
	act as if the export list were not specified (i.e. export
   	everything local to the module).

  hide:
	do not include this module in the generated documentation, but
 	propagate any exported definitions to modules which re-export
	them.

There's a slight change in the semantics for re-exporting a full
module by giving 'module M' in the export list: if module M does not
have the 'hide' option, then the documentation will now just contain a
reference to module M rather than the full inlined contents of that
module.

These features, and some other changes in the pipeline, are the result
of discussions between myself and Manuel Chakravarty
<chak@cse.unsw.edu.au> (author of IDoc) yesterday.

Also: some cleanups, use a Writer monad to collect error messages in
some places instead of just printing them with trace.

7 files changed, 268 insertions, 154 deletions

diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index 5059070e..7d7700a4 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -48,14 +48,17 @@ ppHtml title source_url ifaces odir maybe_css libdir =  do
 	icon_file        = libdir ++ pathSeparator:iconFile
 	icon_destination = odir   ++ pathSeparator:iconFile
 
+	visible_ifaces = filter visible ifaces
+	visible (m,i) = OptHide `notElem` iface_options i
+
   css_contents <- readFile css_file
   writeFile css_destination css_contents
   icon_contents <- readFile icon_file
   writeFile icon_destination icon_contents
 
-  ppHtmlContents odir title source_url (map fst ifaces)
-  ppHtmlIndex odir title ifaces
-  mapM_ (ppHtmlModule odir title source_url) ifaces
+  ppHtmlContents odir title source_url (map fst visible_ifaces)
+  ppHtmlIndex odir title visible_ifaces
+  mapM_ (ppHtmlModule odir title source_url) visible_ifaces
 
 moduleHtmlFile :: String -> FilePath
 moduleHtmlFile mod = mod ++ ".html" -- ToDo: Z-encode filename?
@@ -359,8 +362,6 @@ ppModuleContents exports
 
   process :: Int -> [ExportItem] -> ([Html],[ExportItem])
   process n [] = ([], [])
-  process n (ExportDecl _ : rest) = process n rest
-  process n (ExportDoc _ : rest) = process n rest
   process n items@(ExportGroup lev id doc : rest) 
     | lev <= n  = ( [], items )
     | otherwise = ( html:sections, rest2 )
@@ -369,6 +370,7 @@ ppModuleContents exports
 		 +++ mk_subsections subsections
 	(subsections, rest1) = process lev rest
 	(sections,    rest2) = process n   rest1
+  process n (_ : rest) = process n rest
 
   mk_subsections [] = noHtml
   mk_subsections ss = ddef << dlist << concatHtml ss
@@ -392,6 +394,8 @@ processExport doc_map summary (ExportDecl decl)
 processExport doc_map summary (ExportDoc doc)
   | summary = Html.emptyTable
   | otherwise = docBox (markup htmlMarkup doc)
+processExport doc_map summary (ExportModule (Module mod))
+  = declBox (toHtml "module" <+> ppHsModule mod)
 
 ppDocGroup lev doc
   | lev == 1  = tda [ theclass "section1" ] << doc
diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs
index ce954a52..f897c600 100644
--- a/src/HaddockRename.hs
+++ b/src/HaddockRename.hs
@@ -194,6 +194,8 @@ lookupIdString str = do
 
 renameExportItems items = mapM rn items
   where
+	rn (ExportModule mod)
+	   = return (ExportModule mod)
  	rn (ExportGroup lev id doc) 
 	   = do doc <- renameDoc doc
 	        return (ExportGroup lev id doc)
diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs
index f99d2893..5af102d4 100644
--- a/src/HaddockTypes.hs
+++ b/src/HaddockTypes.hs
@@ -7,6 +7,7 @@
 module HaddockTypes (
   -- * Module interfaces
   NameEnv, Interface(..), ModuleInfo(..), ExportItem(..), ModuleMap,
+  DocOption(..),
 
   -- * User documentation strings
   DocString, GenDoc(..), Doc, ParsedDoc, DocMarkup(..),
@@ -52,8 +53,11 @@ data Interface
 	iface_info :: Maybe ModuleInfo,
 		-- ^ information from the module header
 
-	iface_doc :: Maybe Doc
+	iface_doc :: Maybe Doc,
 		-- ^ documentation from the module header
+
+	iface_options :: [DocOption]
+		-- ^ module-wide doc options
   }
 
 data ModuleInfo = ModuleInfo
@@ -61,6 +65,9 @@ data ModuleInfo = ModuleInfo
 	  stability   :: String,
 	  maintainer  :: String }
 
+data DocOption = OptHide | OptPrune | OptIgnoreExports 
+  deriving (Eq)
+
 type DocString = String
 
 data ExportItem 
@@ -75,6 +82,9 @@ data ExportItem
   | ExportDoc		-- some documentation
 	Doc
 
+  | ExportModule	-- a cross-reference to another module
+	Module
+
 type ModuleMap = FiniteMap Module Interface
 
 -- -----------------------------------------------------------------------------
diff --git a/src/HsLexer.lhs b/src/HsLexer.lhs
index 8f5c0174..1899dda5 100644
--- a/src/HsLexer.lhs
+++ b/src/HsLexer.lhs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: HsLexer.lhs,v 1.4 2002/04/25 14:40:05 simonmar Exp $
+-- $Id: HsLexer.lhs,v 1.5 2002/05/08 11:21:56 simonmar Exp $
 --
 -- (c) The GHC Team, 1997-2000
 --
@@ -68,6 +68,7 @@ data Token
 	| DocCommentPrev String		-- something beginning '-- ^'
 	| DocCommentNamed String	-- something beginning '-- $'
 	| DocSection Int String		-- a section heading
+	| DocOptions String
 
 -- Reserved operators
 
@@ -223,6 +224,7 @@ lexer cont input (SrcLoc _ x) y col =
 	doc (' ':'^':_) = True
 	doc (' ':'*':_) = True
 	doc (' ':'$':_) = True
+	doc (' ':'#':_) = True
 	doc _ = False
 
 nextTab x = x + (tAB_LENGTH - (x-1) `mod` tAB_LENGTH)
@@ -283,6 +285,7 @@ lexToken cont s loc y x =
 	'-':'-':' ':'^':s -> docComment DocCommentPrev cont s loc y x
 	'-':'-':' ':'$':s -> docComment DocCommentNamed cont s loc y x
 	'-':'-':' ':'*':s -> docSection cont ('*':s) loc y x
+	'-':'-':' ':'#':s -> docComment DocOptions cont s loc y x
 
         '\'':s -> lexChar cont s loc y (x+1)
         '\"':s{-"-} -> lexString cont s loc y (x+1)
diff --git a/src/HsParser.ly b/src/HsParser.ly
index 5a254ec1..2ca9c88f 100644
--- a/src/HsParser.ly
+++ b/src/HsParser.ly
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
-$Id: HsParser.ly,v 1.7 2002/05/06 12:32:32 simonmar Exp $
+$Id: HsParser.ly,v 1.8 2002/05/08 11:21:56 simonmar Exp $
 
 (c) Simon Marlow, Sven Panne 1997-2000
 
@@ -72,6 +72,7 @@ Docs
 >	DOCPREV    { DocCommentPrev $$ }
 >	DOCNAMED   { DocCommentNamed $$ }
 >	DOCGROUP   { DocSection _ _ }
+>	DOCOPTIONS { DocOptions $$ }
 
 Symbols
 
@@ -152,13 +153,18 @@ Module Header
 
 > module :: { HsModule }
 > 	: optdoc 'module' modid maybeexports 'where' body
->		{ HsModule $3 $4 (reverse (fst $6)) (reverse (snd $6)) $1 }
+>	    { HsModule $3 $4 (reverse (fst $6)) (reverse (snd $6)) 
+>		(fst $1) (snd $1) }
 >	| body
->		{ HsModule main_mod Nothing (reverse (fst $1)) (reverse (snd $1)) Nothing }
-
-> optdoc :: { Maybe String }
->	: DOCNEXT					{ Just $1 }
->	| {- empty -}					{ Nothing }
+>	    { HsModule main_mod Nothing (reverse (fst $1)) (reverse (snd $1))
+>		Nothing Nothing }
+
+> optdoc :: { (Maybe String, Maybe String) }
+>	: DOCNEXT					{ (Nothing, Just $1) }
+>	| DOCOPTIONS					{ (Just $1, Nothing) }
+>	| DOCOPTIONS DOCNEXT 				{ (Just $1, Just $2) }
+>	| DOCNEXT DOCOPTIONS 				{ (Just $2, Just $1) }
+>	| {- empty -}					{ (Nothing, Nothing) }
 
 > body :: { ([HsImportDecl],[HsDecl]) }
 >	:  '{' bodyaux '}'				{ $2 }
diff --git a/src/HsSyn.lhs b/src/HsSyn.lhs
index e732f2f8..5054a8df 100644
--- a/src/HsSyn.lhs
+++ b/src/HsSyn.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: HsSyn.lhs,v 1.5 2002/04/26 11:18:57 simonmar Exp $
+% $Id: HsSyn.lhs,v 1.6 2002/05/08 11:21:56 simonmar Exp $
 %
 % (c) The GHC Team, 1997-2002
 %
@@ -68,7 +68,9 @@ instance Show HsIdentifier where
    showsPrec _ (HsSpecial s) = showString s
 
 data HsModule = HsModule Module (Maybe [HsExportSpec])
-                         [HsImportDecl] [HsDecl] (Maybe String)
+                        [HsImportDecl] [HsDecl] 
+			(Maybe String)	-- the doc options
+			(Maybe String)	-- the module doc
   deriving Show
 
 -- Export/Import Specifications
diff --git a/src/Main.hs b/src/Main.hs
index 08a70bde..c5d39844 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -25,12 +25,15 @@ import FiniteMap
 --import Pretty
 
 import RegexString
+import Maybe	( maybeToList )
 import List	( nub )
 import Monad	( when )
 import Char	( isSpace )
 import IO
 import IOExts
 
+import MonadWriter
+
 #if __GLASGOW_HASKELL__ < 500
 import Regex
 import PackedString
@@ -106,14 +109,15 @@ run flags files = do
   writeIORef saved_flags flags
   parsed_mods <- sequence (map parse_file files)
 
-  let ifaces = [ mkInterface module_map file parsed 
+  let ifaces = [ runWriter (mkInterface module_map file parsed)
 	       | (file,parsed) <- zip files parsed_mods ]
 
-      mod_ifaces = [ (m,i) | (m,i,_,_) <- ifaces ]
+      mod_ifaces = [ (m,i) | ((m,i),msgs) <- ifaces ]
+      all_msgs = concat (map snd ifaces)
+	
       module_map = listToFM mod_ifaces
 
-  sequence [ reportMissingNames m ns_docs ns_decls 
-	   | (m, _, ns_docs, ns_decls) <- ifaces ]
+  mapM (hPutStrLn stderr) all_msgs
 
   when (Flag_DocBook `elem` flags) $
     putStr (ppDocBook odir mod_ifaces)
@@ -133,116 +137,142 @@ parse_file file = do
 				 exitWith (ExitFailure 1)
     )
 
-reportMissingNames m [] [] = return ()
-reportMissingNames (Module m) ns_docs ns_decls =  do
-  hPutStrLn stderr ("Warning: in module " ++ m ++ 
-		  ", the following names could not be resolved:")
-  let name_strings = nub (map show ns_decls ++ ns_docs)
-  hPutStrLn stderr ("   " ++ concat (map (' ':) name_strings))
-
 -----------------------------------------------------------------------------
 -- Figuring out the definitions that are exported from a module
 
-mkInterface :: ModuleMap -> FilePath -> HsModule
-   -> (Module, 		-- the module name
-       Interface,	-- its "interface"
-       [String],	-- a list of names we couldn't resolve in the docs
-       [HsQName]	-- a list of names we couldn't resolve in the decls
-      )
+mkInterface
+   :: ModuleMap -> FilePath -> HsModule
+   -> ErrMsgM (
+	       Module, 		-- the module name
+	       Interface	-- its "interface"
+	      )
 
-mkInterface mod_map filename (HsModule mod exps imps decls maybe_doc)
-  = (mod, Interface { 
-	   iface_filename = filename,
-	   iface_env = name_env,
-	   iface_exports = renamed_export_list,
-	   iface_orig_exports = orig_export_list,
-	   iface_decls =  decl_map,
-	   iface_info = maybe_info,
-	   iface_name_docs   = doc_map,
-	   iface_doc         = module_doc
-	},
-      missing_names_doc1 ++ missing_names_doc2,   
-      missing_names1 ++ missing_names2 --ignore missing_names3 for now,
-    )
-  where
-  (module_doc, maybe_info, missing_names_doc1) = 
-    case maybe_doc of
-	Nothing  -> (Nothing, Nothing, [])
-	Just doc -> (Just doc2, maybe_info, ns)
-	  where 
-	    (doc1, maybe_info) = parseModuleHeader doc
-	    (doc2,ns) = formatDocString (lookupForDoc import_env) doc1
+mkInterface mod_map filename 
+	(HsModule mod exps imps decls maybe_opts maybe_doc) = do  
 
-  locally_defined_names = collectNames decls
+  -- Process the options, if available
+  options <- case maybe_opts of
+		Just opt_str -> processOptions opt_str
+		Nothing      -> return []
 
-  qual_local_names   = map (Qual mod) locally_defined_names
-  unqual_local_names = map UnQual     locally_defined_names
+  let
+     locally_defined_names = collectNames decls
 
-  local_env = listToFM (zip unqual_local_names qual_local_names ++
-			zip qual_local_names   qual_local_names)
+     qual_local_names   = map (Qual mod) locally_defined_names
+     unqual_local_names = map UnQual     locally_defined_names
+
+     local_env = listToFM (zip unqual_local_names qual_local_names ++
+			  zip qual_local_names   qual_local_names)
 	 -- both qualified and unqualifed names are in scope for local things
 
-  -- build the orig_env, which maps names to *original* names (so we can
-  -- find the original declarations & docs for things).
-  (ext_orig_envs, ext_import_envs) 
+     -- build the orig_env, which maps names to *original* names (so we can
+     -- find the original declarations & docs for things).
+     (ext_orig_envs, ext_import_envs) 
 	= unzip (map (buildEnv mod_map mod exported_names) imps)
-  orig_env   = foldr plusFM local_env ext_orig_envs  
-  import_env = foldr plusFM local_env ext_import_envs  
+     orig_env   = foldr plusFM local_env ext_orig_envs  
+     import_env = foldr plusFM local_env ext_import_envs  
 
-  -- convert names in source code to original, fully qualified, names
-  (orig_exports, missing_names1) 
+     -- convert names in source code to original, fully qualified, names
+     (orig_exports, missing_names1) 
 	= runRnFM orig_env (mapMaybeM renameExportList exps)
 
-  (orig_decls, missing_names2)
+     (orig_decls, missing_names2)
 	= runRnFM orig_env (mapM renameDecl decls)
 
-  orig_decl_map :: FiniteMap HsName HsDecl
-  orig_decl_map = listToFM [ (n,d) | d <- orig_decls, n <- declBinders d ]
+     orig_decl_map :: FiniteMap HsName HsDecl
+     orig_decl_map = listToFM [ (n,d) | d <- orig_decls, n <- declBinders d ]
 
-  -- gather up a list of entities that are exported (original names)
-  exported_names = exportedNames mod mod_map orig_decls
+     -- gather up a list of entities that are exported (original names)
+     exported_names = exportedNames mod mod_map orig_decls
 			locally_defined_names orig_exports
-			orig_decl_map
-
-  final_decls = concat (map expandDecl orig_decls)
-
-  -- match documentation to names, and resolve identifiers in the documentation
-  local_docstrings :: [(HsName,DocString)]
-  local_docstrings = collectDoc final_decls
-
-  local_docs_formatted :: [(HsName,(Doc,[String]))]
-  local_docs_formatted = 
-      [ (n, formatDocString (lookupForDoc orig_env) doc) 
-      | (n, doc) <- local_docstrings ]
-
-  local_docs :: [(HsName,Doc)]		-- with *original* names
-  local_docs = [ (n,doc) | (n,(doc,_)) <- local_docs_formatted ]
-
-  -- collect the list of names which we couldn't resolve in the documentation
-  missing_names_doc2 = concat [ ns | (n,(doc,ns)) <- local_docs_formatted ]
-
-  -- get the documentation associated with entities exported from this module
-  -- ToDo: we should really store the documentation in both orig and imported
-  -- forms, like the export items.
-  doc_map :: FiniteMap HsName Doc	-- with *imported* names
-  doc_map = listToFM 
-    [ (nameOfQName n, doc)
-    | n <- exported_names,
-      Just doc <- [lookupDoc mod_map mod local_docs import_env n] ]
-
-  decl_map :: FiniteMap HsName HsDecl
-  decl_map = listToFM [ (n,d) | d <- final_decls, n <- declBinders d ]
+			orig_decl_map options
+
+  -- Parse the module header
+  (module_doc, maybe_info, missing_names_doc1) <-
+       case maybe_doc of
+	 Nothing  -> return (Nothing, Nothing, [])
+	 Just doc -> do
+	    let (doc1, maybe_info) = parseModuleHeader doc
+	    (doc2,ns) <- formatDocString (lookupForDoc import_env) doc1
+	    return (Just doc2, maybe_info, ns)
+
+  let
+     final_decls = concat (map expandDecl orig_decls)
+
+     -- match documentation to names, and resolve identifiers in the 
+     -- documentation
+     local_docstrings :: [(HsName,DocString)]
+     local_docstrings = collectDoc final_decls
+
+     formatLocalDoc (n,doc) = do
+	doc' <- formatDocString (lookupForDoc orig_env) doc
+	return (n,doc')
+
+  local_docs_formatted <- mapM formatLocalDoc local_docstrings
+
+  let
+     local_docs :: [(HsName,Doc)]		-- with *original* names
+     local_docs = [ (n,doc) | (n,(doc,_)) <- local_docs_formatted ]
+
+     -- collect the list of names which we couldn't resolve in the documentation
+     missing_names_doc2 = concat [ ns | (n,(doc,ns)) <- local_docs_formatted ]
+
+     -- get the documentation associated with entities exported from this module
+     -- ToDo: we should really store the documentation in both orig and imported
+     -- forms, like the export items.
+     doc_map :: FiniteMap HsName Doc	-- with *imported* names
+     doc_map = listToFM 
+       [ (nameOfQName n, doc)
+       | n <- exported_names,
+         Just doc <- [lookupDoc mod_map mod local_docs import_env n] ]
+
+     decl_map :: FiniteMap HsName HsDecl
+     decl_map = listToFM [ (n,d) | d <- final_decls, n <- declBinders d ]
 
   -- make the "export items", which will be converted into docs later
-  orig_export_list = mkExportItems mod_map mod orig_env
-			decl_map final_decls orig_exports 
-
-  -- rename names in the exported declarations to point to things that
-  -- are closer, or maybe even exported by, the current module.
-  (renamed_export_list, missing_names3)
-     = runRnFM import_env (renameExportItems orig_export_list)
-
-  name_env = listToFM [ (nameOfQName n, n) | n <- exported_names ]
+  orig_export_list <- mkExportItems mod_map mod orig_env
+   			 decl_map final_decls options orig_exports
+
+  let
+     -- prune the export list to just those declarations that have
+     -- documentation, if the 'prune' option is on.
+     pruned_export_list
+	| OptPrune `elem` options = pruneExportItems doc_map orig_export_list
+	| otherwise = orig_export_list
+
+     -- rename names in the exported declarations to point to things that
+     -- are closer, or maybe even exported by, the current module.
+     (renamed_export_list, missing_names3)
+        = runRnFM import_env (renameExportItems pruned_export_list)
+
+     name_env = listToFM [ (nameOfQName n, n) | n <- exported_names ]
+
+  -- report any names we couldn't find/resolve
+
+  let missing_names_doc = missing_names_doc1 ++ missing_names_doc2
+      missing_names = missing_names1 ++ missing_names2
+			 --ignore missing_names3 for now,
+
+      name_strings = nub (map show missing_names ++ missing_names_doc)
+
+  when (not (null name_strings)) $
+	  tell ["Warning: in module " ++ (case mod of Module m -> m) ++ 
+		", the following names could not be resolved:\n\ 
+		\   " ++ concat (map (' ':) name_strings)
+		]
+
+  return (mod, Interface { 
+		   iface_filename = filename,
+		   iface_env = name_env,
+		   iface_exports = renamed_export_list,
+		   iface_orig_exports = pruned_export_list,
+		   iface_decls =  decl_map,
+		   iface_info = maybe_info,
+		   iface_name_docs   = doc_map,
+		   iface_doc         = module_doc,
+		   iface_options     = options
+		}
+      	  )
 
 -- -----------------------------------------------------------------------------
 -- Find the documentation for a particular name, and rename the
@@ -274,13 +304,20 @@ mkExportItems :: ModuleMap -> Module
 	-> FiniteMap HsQName HsQName	-- maps orig to imported names
 	-> FiniteMap HsName HsDecl	-- maps local names to declarations
 	-> [HsDecl]			-- decls in the current module
+	-> [DocOption]
 	-> Maybe [HsExportSpec]
-	-> [ExportItem]
-mkExportItems mod_map mod env decl_map decls Nothing
-  = fullContentsOfThisModule decls env -- everything exported
-mkExportItems mod_map mod env decl_map decls (Just specs)
-  = concat (map lookupExport specs)
+	-> ErrMsgM [ExportItem]
+mkExportItems mod_map mod env decl_map decls options maybe_exps
+  | Nothing <- maybe_exps	    = everything_local_exported
+  | OptIgnoreExports `elem` options = everything_local_exported
+  | Just specs <- maybe_exps = do 
+	exps <- mapM lookupExport specs
+        return (concat exps)
   where
+
+    everything_local_exported =
+	fullContentsOfThisModule decls env -- everything exported
+
     lookupExport (HsEVar x) 
 	| Just decl <- findDecl x
 	= let decl' | HsTypeSig loc ns ty <- decl
@@ -288,39 +325,46 @@ mkExportItems mod_map mod env decl_map decls (Just specs)
 		    | otherwise
 		  	= decl
 	  in
-	  [ ExportDecl decl' ]
+	  return [ ExportDecl decl' ]
 	  -- ToDo: cope with record selectors here
     lookupExport (HsEAbs t)
 	| Just decl <- findDecl t
-	= [ ExportDecl (restrictTo [] decl) ]
+	= return [ ExportDecl (restrictTo [] decl) ]
     lookupExport (HsEThingAll t)
 	| Just decl <- findDecl t
-	= [ ExportDecl decl ]
+	= return [ ExportDecl decl ]
     lookupExport (HsEThingWith t cs)
 	| Just decl <- findDecl t
-	= [ ExportDecl (restrictTo (map nameOfQName cs) decl) ]
+	= return [ ExportDecl (restrictTo (map nameOfQName cs) decl) ]
     lookupExport (HsEModuleContents m) = fullContentsOf m
     lookupExport (HsEGroup lev str)
-	= [ ExportGroup lev "" doc ]
-	where (doc, _names) = formatDocHeading (lookupForDoc env) str
-	-- ToDo: report the unresolved names
+	= do (doc, _names) <- formatDocHeading (lookupForDoc env) str
+	     return [ ExportGroup lev "" doc ]
+	  -- ToDo: report the unresolved names
     lookupExport (HsEDoc str)
-	= [ ExportDoc doc ]
-	where (doc, _names) = formatDocString (lookupForDoc env) str
+	= do (doc, _names) <- formatDocString (lookupForDoc env) str
+	     return [ ExportDoc doc ]
 	-- ToDo: report the unresolved names
     lookupExport (HsEDocNamed str)
-	| Just found <- findNamedDoc str decls
-	= let (doc, _names) = formatDocString (lookupForDoc env) found in
-	  [ ExportDoc doc ]
+	= do r <- findNamedDoc str decls
+	     case r of
+		Nothing -> return []
+		Just found -> do
+		  (doc, _nms) <- formatDocString (lookupForDoc env) found
+	  	  return [ ExportDoc doc ]
 	
-    lookupExport _ = [] -- didn't find it?
+    lookupExport _ = return [] -- didn't find it?
 
     fullContentsOf m
 	| m == mod  = fullContentsOfThisModule decls env
 	| otherwise = 
 	   case lookupFM mod_map m of
-	     Just iface -> iface_orig_exports iface
-	     Nothing    -> trace ("Warning: module not found: " ++ show m) []
+	     Just iface
+		| OptHide `elem` iface_options iface
+			-> return (iface_orig_exports iface)
+		| otherwise -> return [ ExportModule m ]
+	     Nothing -> do tell ["Warning: module not found: " ++ show m]
+			   return []
 
     findDecl :: HsQName -> Maybe HsDecl
     findDecl (UnQual n)
@@ -330,17 +374,15 @@ mkExportItems mod_map mod env decl_map decls (Just specs)
 	| otherwise = 
 	   case lookupFM mod_map m of
 		Just iface -> lookupFM (iface_decls iface) n
-		Nothing -> 
-		   trace ("Warning: module not found: " ++ show m) Nothing
+		Nothing -> Nothing
 
 fullContentsOfThisModule decls env = 
-  [ mkExportItem decl | decl <- decls, keepDecl decl ]
-  where mkExportItem (HsDocGroup lev str) =
-	   ExportGroup lev "" doc
-	  where
-	   (doc, _names) = formatDocHeading (lookupForDoc env) str
+  mapM mkExportItem (filter keepDecl decls)
+  where mkExportItem (HsDocGroup lev str) = do
+	   (doc, _names) <- formatDocHeading (lookupForDoc env) str
+	   return (ExportGroup lev "" doc)
 	   -- ToDo: report the unresolved names
-	mkExportItem decl = ExportDecl decl
+	mkExportItem decl = return (ExportDecl decl)
 
 
 keepDecl HsTypeSig{}     = True
@@ -352,17 +394,29 @@ keepDecl HsDocGroup{}	 = True
 keepDecl _ = False
 
 -- -----------------------------------------------------------------------------
+-- Pruning
+
+pruneExportItems :: FiniteMap HsName Doc -> [ExportItem] -> [ExportItem]
+pruneExportItems doc_map items = filter has_doc items
+  where has_doc (ExportDecl d) | Just n <- declMainBinder d = n `elemFM` doc_map
+	has_doc _ = True
+
+-- -----------------------------------------------------------------------------
 -- Gather a list of original names exported from this module
 
 exportedNames :: Module -> ModuleMap -> [HsDecl] -> [HsName]
 	-> Maybe [HsExportSpec]
 	-> FiniteMap HsName HsDecl
+	-> [DocOption]
 	-> [HsQName]
-exportedNames mod mod_scope decls local_names Nothing decl_map
-  = map (Qual mod) local_names
-exportedNames mod mod_scope decls local_names (Just expspecs) decl_map
-  = concat (map extract expspecs)
+
+exportedNames mod mod_scope decls local_names maybe_exps decl_map options
+  | Nothing <- maybe_exps 	    = all_local_names
+  | OptIgnoreExports `elem` options = all_local_names
+  | Just expspecs <- maybe_exps     = concat (map extract expspecs)
  where
+  all_local_names = map (Qual mod) local_names
+
   extract e = 
    case e of
     HsEVar x -> [x]
@@ -493,24 +547,26 @@ docsFromField (HsFieldDecl nms ty Nothing) rest
 
 -- this one formats a heading
 formatDocHeading :: (String -> Maybe HsQName) -> DocString
-  -> (Doc,[String])
+  -> ErrMsgM (Doc,[String])
 formatDocHeading lookup string = format parseString lookup string
 
 -- this one formats a sequence of paragraphs
 formatDocString :: (String -> Maybe HsQName) -> DocString
-  -> (Doc,[String])
+  -> ErrMsgM (Doc,[String])
 formatDocString lookup string = format parseParas lookup string
 
 format 	:: ([Token] -> Either String ParsedDoc)
 	-> (String -> Maybe HsQName)
 	-> DocString
-       	-> (Doc, [String])
+       	-> ErrMsgM (Doc, [String])
 format parse lookup string
   = case parse (tokenise string) of
-	Left error -> trace ("Warning: parse error in doc string beginning:\n\ 
-			     \    " ++ take 40 string) (DocEmpty, [])
-	Right doc -> runRn lookup (resolveDoc doc)
-  
+	Left error -> do 	
+	  tell ["Warning: parse error in doc string beginning:\n\ 
+		\    " ++ take 40 string]
+	  return (DocEmpty, [])
+	Right doc -> 
+	  return (runRn lookup (resolveDoc doc))
 
 -- ---------------------------------------------------------------------------
 -- Looking up names in documentation
@@ -584,17 +640,48 @@ mkRegexWithOpts s single_line case_sensitive
 -- -----------------------------------------------------------------------------
 -- Named documentation
 
-findNamedDoc :: String -> [HsDecl] -> Maybe String
+findNamedDoc :: String -> [HsDecl] -> ErrMsgM (Maybe String)
 findNamedDoc str decls = 
   case matchRegex docNameRE str of
      Just (name:_) -> search decls
-	where search [] = Nothing
+	where search [] = do
+		tell ["Cannot find documentation for: $" ++ name]
+		return Nothing
 	      search (HsDocCommentNamed str : rest) = 
 		case matchRegexAll docNameRE str of
 		   Just (_, _, after, _, name':_)
-			| name == name' -> Just after
+			| name == name' -> return (Just after)
 		   _otherwise -> search rest
 	      search (_other_decl : rest) = search rest
-     _other -> Nothing
+     _other -> do
+	tell ["Invalid documentation name: $" ++ str]
+	return Nothing
 
 docNameRE = mkRegex "[ \t]*([A-Za-z0-9_]*)"
+
+-- -----------------------------------------------------------------------------
+-- Haddock options embedded in the source file
+
+processOptions :: String -> ErrMsgM [DocOption]
+processOptions str = do
+  case break (== ',') str of
+    (this, ',':rest) -> do
+	opt <- parseOption this
+	opts <- processOptions rest
+	return (maybeToList opt ++ opts)
+    (this, _)
+	| all isSpace this -> return []
+	| otherwise -> do opt <- parseOption this; return (maybeToList opt)
+
+parseOption :: String -> ErrMsgM (Maybe DocOption)
+parseOption "hide" = return (Just OptHide)
+parseOption "prune" = return (Just OptPrune)
+parseOption "ignore-exports" = return (Just OptIgnoreExports)
+parseOption other = do tell ["Unrecognised option: " ++ other]; return Nothing
+
+-- -----------------------------------------------------------------------------
+-- A monad which collects error messages
+
+type ErrMsg = String
+type ErrMsgM a = Writer [ErrMsg] a
+