[commit: haddock] ghc-head, master, wip/revert-ttg-2017-11-20, wip/ttg-2017-11-06, wip/ttg2-2017-11-10, wip/ttg3-2017-11-12, wip/ttg4-constraints-2017-11-13: Reexported modules: Report warnings if argument cannot be parsed or (dbb505c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branches: ghc-head,master,wip/revert-ttg-2017-11-20,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13
Link       : http://git.haskell.org/haddock.git/commitdiff/dbb505ca7e196697336ff82a931e98dbf0ad2aaa

>---------------------------------------------------------------

commit dbb505ca7e196697336ff82a931e98dbf0ad2aaa
Author: alexbiehl <alex.biehl at gmail.com>
Date:   Tue Oct 31 21:31:18 2017 +0100

    Reexported modules: Report warnings if argument cannot be parsed or
    
    ... module cannot be found


>---------------------------------------------------------------

dbb505ca7e196697336ff82a931e98dbf0ad2aaa
 haddock-api/src/Haddock.hs | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index d9bc3ea..4b4bad4 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