aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
authorDavid Waern <davve@dtek.chalmers.se>2007-10-02 01:05:19 +0000
committerDavid Waern <davve@dtek.chalmers.se>2007-10-02 01:05:19 +0000
commitfe2f0cc0e8fda4b4cfe6ea64083c91dbfec2cadb (patch)
tree93a9dd60b44238b0baeceba991870bd30bc56ff6 /src/Haddock
parenteda2c60c5040c6869d3de3e130e07fd6cca590a4 (diff)
Improve parsing of doc options
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Interface/Create.hs27
-rw-r--r--src/Haddock/Utils.hs12
2 files changed, 18 insertions, 21 deletions
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