[haddock @ 2002-04-24 15:14:11 by simonmar]

Grok the kind of module headers we use in fptools/libraries, and pass
the "portability", "stability", and "maintainer" strings through into
the generated HTML.  If the module header doesn't match the pattern,
then we don't include the info in the HTML.

1 files changed, 35 insertions, 23 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 7be91b9a..ee6c0d3b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -24,6 +24,7 @@ import FiniteMap
 
 --import Pretty
 
+import RegexString
 import List	( nub )
 import Monad	( when )
 import Char	( isSpace )
@@ -144,9 +145,7 @@ mkInterface mod_map filename (HsModule mod exps imps decls maybe_doc)
 	   iface_exports = renamed_export_list,
 	   iface_orig_exports = orig_export_list,
 	   iface_decls =  decl_map,
-	   iface_portability = "portable",
-	   iface_maintainer  = "libraries@haskell.org",
-	   iface_stability   = "stable",
+	   iface_info = maybe_info,
 	   iface_name_docs   = doc_map,
 	   iface_doc         = module_doc
 	},
@@ -154,11 +153,13 @@ mkInterface mod_map filename (HsModule mod exps imps decls maybe_doc)
       missing_names1 ++ missing_names2 --ignore missing_names3 for now,
     )
   where
-  (module_doc, missing_names_doc1) = 
+  (module_doc, maybe_info, missing_names_doc1) = 
     case maybe_doc of
-	Nothing  -> (Nothing, [])
-	Just doc -> (Just doc', ns)
-	  where (doc',ns) = formatDocString (lookupForDoc import_env) doc
+	Nothing  -> (Nothing, Nothing, [])
+	Just doc -> (Just doc2, maybe_info, ns)
+	  where 
+	    (doc1, maybe_info) = parseModuleHeader doc
+	    (doc2,ns) = formatDocString (lookupForDoc import_env) doc1
 
   locally_defined_names = collectNames decls
 
@@ -524,19 +525,30 @@ strToHsQNames str
 		     Qual (Module mod) (HsVarName (HsSymbol str)) ]
 	other -> []
 
------------------------------------------------------------------------------
--- misc.
-
-die :: String -> IO a
-die s = hPutStr stderr s >> exitWith (ExitFailure 1)
-
-dieMsg :: String -> IO a
-dieMsg s = getProgName >>= \prog -> die (prog ++ ": " ++ s)
-
-mapSnd f [] = []
-mapSnd f ((x,y):xs) = (x,f y) : mapSnd f xs
-
-mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
-mapMaybeM f Nothing = return Nothing
-mapMaybeM f (Just a) = f a >>= return . Just
-
+-- -----------------------------------------------------------------------------
+-- Parsing module headers
+
+parseModuleHeader :: String -> (String, Maybe ModuleInfo)
+parseModuleHeader str =
+  case matchRegexAll moduleHeaderRE str of
+	Just (before, match, after, _, (_:_:_:s1:s2:s3:_)) -> 
+	   (after, Just (ModuleInfo { 
+				 portability = s3,
+				 stability   = s2,
+				 maintainer  = s1 }))
+	_other -> (str, Nothing)
+
+moduleHeaderRE = mkRegexWithOpts
+			 "^([ \t\n]*Module[ \t]*:.*\n)?\ 
+			  \([ \t\n]*Copyright[ \t]*:.*\n)?\ 
+			  \([ \t\n]*License[ \t]*:.*\n)?\ 
+			  \[ \t\n]*Maintainer[ \t]*:(.*)\n\ 
+			  \[ \t\n]*Stability[ \t]*:(.*)\n\ 
+			  \[ \t\n]*Portability[ \t]*:([^\n]*)\n"
+		True -- match "\n" with "."
+		False -- not case sensitive
+	-- All fields except the last (Portability) may be multi-line.
+	-- This is so that the portability field doesn't swallow up the
+	-- rest of the module documentation - we might want to revist
+	-- this at some point (perhaps have a separator between the 
+	-- portability field and the module documentation?).