aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock.hs
diff options
context:
space:
mode:
authoralexbiehl <alex.biehl@gmail.com>2017-10-31 21:31:18 +0100
committeralexbiehl <alex.biehl@gmail.com>2017-10-31 21:31:18 +0100
commitdbb505ca7e196697336ff82a931e98dbf0ad2aaa (patch)
treefcdd803d43571f557149c47dcdc339695e255487 /haddock-api/src/Haddock.hs
parent75c784e474bd1fc824e2f0214f37908d0d4410c3 (diff)
Reexported modules: Report warnings if argument cannot be parsed or
... module cannot be found
Diffstat (limited to 'haddock-api/src/Haddock.hs')
-rw-r--r--haddock-api/src/Haddock.hs17
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