diff options
-rw-r--r-- | src/Haddock/Interface/Create.hs | 27 | ||||
-rw-r--r-- | src/Haddock/Utils.hs | 12 |
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 |