From fe2f0cc0e8fda4b4cfe6ea64083c91dbfec2cadb Mon Sep 17 00:00:00 2001
From: David Waern <davve@dtek.chalmers.se>
Date: Tue, 2 Oct 2007 01:05:19 +0000
Subject: Improve parsing of doc options

---
 src/Haddock/Interface/Create.hs | 27 ++++++---------------------
 src/Haddock/Utils.hs            | 12 ++++++++++++
 2 files changed, 18 insertions(+), 21 deletions(-)

(limited to 'src')

diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 61f2d51c..df952ad8 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -107,28 +107,13 @@ createInterface ghcMod flags modMap = do
 mkDocOpts :: Maybe String -> [Flag] -> Module -> ErrMsgM [DocOption]
 mkDocOpts mbOpts flags mod = do
   opts <- case mbOpts of 
-    Just opts -> processOptions opts
+    Just opts -> case words $ replace ',' ' ' opts of
+      [] -> tell ["No option supplied to DOC_OPTION/doc_option"] >> return []
+      xs -> liftM catMaybes (mapM parseOption xs)
     Nothing -> return []
-  let opts' = if Flag_HideModule (moduleString mod) `elem` flags 
-                then OptHide : opts
-                else opts      
-  return opts'
-
-
-processOptions_ str = let (opts, msg) = runWriter (processOptions str) 
-                      in print msg >> return opts 
-
-
-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)
+  if Flag_HideModule (moduleString mod) `elem` flags 
+    then return $ OptHide : opts
+    else return opts
 
 
 parseOption :: String -> ErrMsgM (Maybe DocOption)
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 502a4795..fd19de9f 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -28,6 +28,9 @@ module Haddock.Utils (
   markup, 
   idMarkup,
 
+  -- * List utilities
+  replace,
+
   -- * Binary extras
 --  FormatVersion, mkFormatVersion  
  ) where
@@ -249,6 +252,15 @@ html_xrefs_ref = unsafePerformIO (newIORef (error "module_map"))
 html_xrefs :: Map Module FilePath
 html_xrefs = unsafePerformIO (readIORef html_xrefs_ref)
 
+
+-----------------------------------------------------------------------------
+-- List utils
+-----------------------------------------------------------------------------
+
+
+replace a b xs = map (\x -> if x == a then b else x) xs 
+
+
 -----------------------------------------------------------------------------
 -- put here temporarily
 
-- 
cgit v1.2.3