diff options
author | alexbiehl <alex.biehl@gmail.com> | 2017-10-31 21:31:18 +0100 |
---|---|---|
committer | alexbiehl <alex.biehl@gmail.com> | 2017-10-31 21:31:18 +0100 |
commit | dbb505ca7e196697336ff82a931e98dbf0ad2aaa (patch) | |
tree | fcdd803d43571f557149c47dcdc339695e255487 | |
parent | 75c784e474bd1fc824e2f0214f37908d0d4410c3 (diff) |
Reexported modules: Report warnings if argument cannot be parsed or
... module cannot be found
-rw-r--r-- | haddock-api/src/Haddock.hs | 17 |
1 files changed, 10 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index d9bc3ea6..4b4bad4c 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -44,6 +44,7 @@ import Haddock.Utils import Control.Monad hiding (forM_) import Control.Applicative import Data.Foldable (forM_) +import Data.Traversable (for) import Data.List (isPrefixOf) import Control.Exception import Data.Maybe @@ -297,7 +298,6 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do sourceUrls' = (srcBase, srcModule', pkgSrcMap', pkgSrcLMap') - -- TODO: This silently suppresses errors installedMap :: Map Module InstalledInterface installedMap = Map.fromList [ (unwire (instMod iface), iface) | iface <- installedIfaces ] @@ -307,12 +307,15 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do unwire :: Module -> Module unwire m = m { moduleUnitId = unwireUnitId dflags (moduleUnitId m) } - reexportedIfaces = - [ iface - | mod_str <- reexportFlags flags - , (m, "") <- readP_to_S parseModuleId mod_str - , Just iface <- [Map.lookup m installedMap] - ] + reexportedIfaces <- concat `fmap` (for (reexportFlags flags) $ \mod_str -> do + let warn = hPutStrLn stderr . ("Warning: " ++) + case readP_to_S parseModuleId mod_str of + [(m, "")] + | Just iface <- Map.lookup m installedMap + -> return [iface] + | otherwise + -> warn ("Cannot find reexported module '" ++ mod_str ++ "'") >> return [] + _ -> warn ("Cannot parse reexported module flag '" ++ mod_str ++ "'") >> return []) libDir <- getHaddockLibDir flags prologue <- getPrologue dflags' flags |