From dbb505ca7e196697336ff82a931e98dbf0ad2aaa Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 31 Oct 2017 21:31:18 +0100 Subject: Reexported modules: Report warnings if argument cannot be parsed or ... module cannot be found --- haddock-api/src/Haddock.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'haddock-api/src') 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 -- cgit v1.2.3