In --make, give an indication of why a module is being recompiled

e.g.

[3 of 5] Compiling C                (C.hs, C.o)
[4 of 5] Compiling D                (D.hs, D.o) [C changed]
[5 of 5] Compiling E                (E.hs, E.o) [D changed]

The main motivation for this is so that we can give the user a clue
when something is being recompiled because the flags changed:

[1 of 1] Compiling Test2            ( Test2.hs, Test2.o ) [flags changed]

2 files changed, 97 insertions, 76 deletions

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 92e4e517ce..877de44330 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -19,6 +19,7 @@ module MkIface (
 
         checkOldIface,  -- See if recompilation is required, by
                         -- comparing version information
+        RecompileRequired(..), recompileRequired,
 
         tyThingToIfaceDecl -- Converting things to their Iface equivalents
  ) where
@@ -1085,11 +1086,28 @@ Trac #5362 for an example.  Such Names are always
 %*                                                                      *
         Load the old interface file for this module (unless
         we have it already), and check whether it is up to date
-        
 %*                                                                      *
 %************************************************************************
 
 \begin{code}
+data RecompileRequired
+  = UpToDate
+       -- ^ everything is up to date, recompilation is not required
+  | MustCompile
+       -- ^ The .hs file has been touched, or the .o/.hi file does not exist
+  | RecompBecause String
+       -- ^ The .o/.hi files are up to date, but something else has changed
+       -- to force recompilation; the String says what (one-line summary)
+  | RecompForcedByTH
+       -- ^ recompile is forced due to use of TH by the module
+   deriving Eq
+
+recompileRequired :: RecompileRequired -> Bool
+recompileRequired UpToDate = False
+recompileRequired _ = True
+
+
+
 -- | Top level function to check if the version of an old interface file
 -- is equivalent to the current source file the user asked us to compile.
 -- If the same, we can avoid recompilation. We return a tuple where the
@@ -1109,7 +1127,7 @@ checkOldIface hsc_env mod_summary source_modified maybe_iface
             check_old_iface hsc_env mod_summary source_modified maybe_iface
 
 check_old_iface :: HscEnv -> ModSummary -> SourceModified -> Maybe ModIface
-                -> IfG (Bool, Maybe ModIface)
+                -> IfG (RecompileRequired, Maybe ModIface)
 check_old_iface hsc_env mod_summary src_modified maybe_iface
   = let dflags = hsc_dflags hsc_env
         getIface =
@@ -1143,19 +1161,19 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
             -- avoid reading an interface; just return the one we might
             -- have been supplied with.
             True | not (isObjectTarget $ hscTarget dflags) ->
-                return (outOfDate, maybe_iface)
+                return (MustCompile, maybe_iface)
 
             -- Try and read the old interface for the current module
             -- from the .hi file left from the last time we compiled it
             True -> do
                 maybe_iface' <- getIface
-                return (outOfDate, maybe_iface')
+                return (MustCompile, maybe_iface')
 
             False -> do
                 maybe_iface' <- getIface
                 case maybe_iface' of
                     -- We can't retrieve the iface
-                    Nothing    -> return (outOfDate, Nothing)
+                    Nothing    -> return (MustCompile, Nothing)
 
                     -- We have got the old iface; check its versions
                     -- even in the SourceUnmodifiedAndStable case we
@@ -1163,15 +1181,6 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
                     -- might have changed or gone away.
                     Just iface -> checkVersions hsc_env mod_summary iface
 
--- | @recompileRequired@ is called from the HscMain.   It checks whether
--- a recompilation is required.  It needs access to the persistent state,
--- finder, etc, because it may have to load lots of interface files to
--- check their versions.
-type RecompileRequired = Bool
-upToDate, outOfDate :: Bool
-upToDate  = False  -- Recompile not required
-outOfDate = True   -- Recompile required
-
 -- | Check if a module is still the same 'version'.
 --
 -- This function is called in the recompilation checker after we have
@@ -1192,9 +1201,9 @@ checkVersions hsc_env mod_summary iface
                         ppr (mi_module iface) <> colon)
 
        ; recomp <- checkFlagHash hsc_env iface
-       ; if recomp then return (outOfDate, Nothing) else do {
+       ; if recompileRequired recomp then return (recomp, Nothing) else do {
        ; recomp <- checkDependencies hsc_env mod_summary iface
-       ; if recomp then return (outOfDate, Just iface) else do {
+       ; if recompileRequired recomp then return (recomp, Just iface) else do {
 
        -- Source code unchanged and no errors yet... carry on
        --
@@ -1228,7 +1237,8 @@ checkFlagHash hsc_env iface = do
                                              putNameLiterally
     case old_hash == new_hash of
         True  -> up_to_date (ptext $ sLit "Module flags unchanged")
-        False -> out_of_date_hash (ptext $ sLit "  Module flags have changed")
+        False -> out_of_date_hash "flags changed"
+                     (ptext $ sLit "  Module flags have changed")
                      old_hash new_hash
 
 -- If the direct imports of this module are resolved to targets that
@@ -1243,18 +1253,16 @@ checkFlagHash hsc_env iface = do
 -- Returns True if recompilation is required.
 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
 checkDependencies hsc_env summary iface
- = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
+ = checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
   where
    prev_dep_mods = dep_mods (mi_deps iface)
    prev_dep_pkgs = dep_pkgs (mi_deps iface)
 
    this_pkg = thisPackage (hsc_dflags hsc_env)
 
-   orM = foldr f (return False)
-    where f m rest = do b <- m; if b then return True else rest
-
    dep_missing (L _ (ImportDecl { ideclName = L _ mod, ideclPkgQual = pkg })) = do
      find_res <- liftIO $ findImportedModule hsc_env mod pkg
+     let reason = moduleNameString mod ++ " changed"
      case find_res of
         Found _ mod
           | pkg == this_pkg
@@ -1262,20 +1270,20 @@ checkDependencies hsc_env summary iface
                  then do traceHiDiffs $
                            text "imported module " <> quotes (ppr mod) <>
                            text " not among previous dependencies"
-                         return outOfDate
+                         return (RecompBecause reason)
                  else
-                         return upToDate
+                         return UpToDate
           | otherwise
            -> if pkg `notElem` (map fst prev_dep_pkgs)
                  then do traceHiDiffs $
                            text "imported module " <> quotes (ppr mod) <>
                            text " is from package " <> quotes (ppr pkg) <>
                            text ", which is not among previous dependencies"
-                         return outOfDate
+                         return (RecompBecause reason)
                  else
-                         return upToDate
+                         return UpToDate
            where pkg = modulePackageId mod
-        _otherwise  -> return outOfDate
+        _otherwise  -> return (RecompBecause reason)
 
 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
               -> IfG RecompileRequired
@@ -1289,8 +1297,10 @@ needInterface mod continue
         -- Instead, get an Either back which we can test
 
     case mb_iface of
-      Failed _ ->  (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
-                                      ppr mod]))
+      Failed _ -> do
+        traceHiDiffs (sep [ptext (sLit "Couldn't load interface for module"),
+                           ppr mod])
+        return MustCompile
                   -- Couldn't find or parse a module mentioned in the
                   -- old interface file.  Don't complain: it might
                   -- just be that the current module doesn't need that
@@ -1306,7 +1316,8 @@ checkModUsage _this_pkg UsagePackageModule{
                                 usg_mod = mod,
                                 usg_mod_hash = old_mod_hash }
   = needInterface mod $ \iface -> do
-    checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
+    let reason = moduleNameString (moduleName mod) ++ " changed"
+    checkModuleFingerprint reason old_mod_hash (mi_mod_hash iface)
         -- We only track the ABI hash of package modules, rather than
         -- individual entity usages, so if the ABI hash changes we must
         -- recompile.  This is safe but may entail more recompilation when
@@ -1326,19 +1337,21 @@ checkModUsage this_pkg UsageHomeModule{
         new_decl_hash   = mi_hash_fn     iface
         new_export_hash = mi_exp_hash    iface
 
+        reason = moduleNameString mod_name ++ " changed"
+
         -- CHECK MODULE
-    recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
-    if not recompile then return upToDate else do
-                                 
+    recompile <- checkModuleFingerprint reason old_mod_hash new_mod_hash
+    if not (recompileRequired recompile) then return UpToDate else do
+
         -- CHECK EXPORT LIST
-    checkMaybeHash maybe_old_export_hash new_export_hash
+    checkMaybeHash reason maybe_old_export_hash new_export_hash
         (ptext (sLit "  Export list changed")) $ do
 
         -- CHECK ITEMS ONE BY ONE
-    recompile <- checkList [ checkEntityUsage new_decl_hash u 
+    recompile <- checkList [ checkEntityUsage reason new_decl_hash u
                            | u <- old_decl_hash]
-    if recompile 
-      then return outOfDate     -- This one failed, so just bail out now
+    if recompileRequired recompile
+      then return recompile     -- This one failed, so just bail out now
       else up_to_date (ptext (sLit "  Great!  The bits I use are up to date"))
  
 
@@ -1347,65 +1360,72 @@ checkModUsage _this_pkg UsageFile{ usg_file_path = file,
   liftIO $
     handleIO handle $ do
       new_mtime <- getModificationUTCTime file
-      return $ old_mtime /= new_mtime
+      if (old_mtime /= new_mtime)
+         then return recomp
+         else return UpToDate
  where
+   recomp = RecompBecause (file ++ " changed")
    handle =
 #ifdef DEBUG
-       \e -> pprTrace "UsageFile" (text (show e)) $ return True
+       \e -> pprTrace "UsageFile" (text (show e)) $ return recomp
 #else
-       \_ -> return True -- if we can't find the file, just recompile, don't fail
+       \_ -> return recomp -- if we can't find the file, just recompile, don't fail
 #endif
 
 ------------------------
-checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG RecompileRequired
-checkModuleFingerprint old_mod_hash new_mod_hash
+checkModuleFingerprint :: String -> Fingerprint -> Fingerprint
+                       -> IfG RecompileRequired
+checkModuleFingerprint reason old_mod_hash new_mod_hash
   | new_mod_hash == old_mod_hash
   = up_to_date (ptext (sLit "Module fingerprint unchanged"))
 
   | otherwise
-  = out_of_date_hash (ptext (sLit "  Module fingerprint has changed"))
+  = out_of_date_hash reason (ptext (sLit "  Module fingerprint has changed"))
                      old_mod_hash new_mod_hash
 
 ------------------------
-checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
+checkMaybeHash :: String -> Maybe Fingerprint -> Fingerprint -> SDoc
                -> IfG RecompileRequired -> IfG RecompileRequired
-checkMaybeHash maybe_old_hash new_hash doc continue
+checkMaybeHash reason maybe_old_hash new_hash doc continue
   | Just hash <- maybe_old_hash, hash /= new_hash
-  = out_of_date_hash doc hash new_hash
+  = out_of_date_hash reason doc hash new_hash
   | otherwise
   = continue
 
 ------------------------
-checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
+checkEntityUsage :: String
+                 -> (OccName -> Maybe (OccName, Fingerprint))
                  -> (OccName, Fingerprint)
                  -> IfG RecompileRequired
-checkEntityUsage new_hash (name,old_hash)
+checkEntityUsage reason new_hash (name,old_hash)
   = case new_hash name of
 
         Nothing       ->        -- We used it before, but it ain't there now
-                          out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
+                          out_of_date reason (sep [ptext (sLit "No longer exported:"), ppr name])
 
         Just (_, new_hash)      -- It's there, but is it up to date?
           | new_hash == old_hash -> do traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_hash))
-                                       return upToDate
-          | otherwise            -> out_of_date_hash (ptext (sLit "  Out of date:") <+> ppr name)
+                                       return UpToDate
+          | otherwise            -> out_of_date_hash reason (ptext (sLit "  Out of date:") <+> ppr name)
                                                      old_hash new_hash
 
-up_to_date, out_of_date :: SDoc -> IfG RecompileRequired
-up_to_date  msg = traceHiDiffs msg >> return upToDate
-out_of_date msg = traceHiDiffs msg >> return outOfDate
+up_to_date :: SDoc -> IfG RecompileRequired
+up_to_date  msg = traceHiDiffs msg >> return UpToDate
+
+out_of_date :: String -> SDoc -> IfG RecompileRequired
+out_of_date reason msg = traceHiDiffs msg >> return (RecompBecause reason)
 
-out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG RecompileRequired
-out_of_date_hash msg old_hash new_hash 
-  = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
+out_of_date_hash :: String -> SDoc -> Fingerprint -> Fingerprint -> IfG RecompileRequired
+out_of_date_hash reason msg old_hash new_hash
+  = out_of_date reason (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
 
 ----------------------
 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
 -- This helper is used in two places
-checkList []             = return upToDate
+checkList []             = return UpToDate
 checkList (check:checks) = do recompile <- check
-                              if recompile
-                                then return outOfDate
+                              if recompileRequired recompile
+                                then return recompile
                                 else checkList checks
 \end{code}
 
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 89d4d212c2..efad3b7d3c 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -550,7 +550,7 @@ data HsCompiler a = HsCompiler {
   }
 
 genericHscCompile :: HsCompiler a
-                  -> (HscEnv -> Maybe (Int,Int) -> RecompReason -> ModSummary -> IO ())
+                  -> (HscEnv -> Maybe (Int,Int) -> RecompileRequired -> ModSummary -> IO ())
                   -> HscEnv -> ModSummary -> SourceModified
                   -> Maybe ModIface -> Maybe (Int, Int)
                   -> IO a
@@ -568,7 +568,7 @@ genericHscCompile compiler hscMessage hsc_env
     let mb_old_hash = fmap mi_iface_hash mb_checked_iface
 
     let skip iface = do
-            hscMessage hsc_env mb_mod_index RecompNotRequired mod_summary
+            hscMessage hsc_env mb_mod_index UpToDate mod_summary
             runHsc hsc_env $ hscNoRecomp compiler iface
 
         compile reason = do
@@ -591,12 +591,12 @@ genericHscCompile compiler hscMessage hsc_env
         -- doing for us in one-shot mode.
 
     case mb_checked_iface of
-        Just iface | not recomp_reqd ->
+        Just iface | not (recompileRequired recomp_reqd) ->
             if mi_used_th iface && not stable
                 then compile RecompForcedByTH
                 else skip iface
         _otherwise ->
-            compile RecompRequired
+            compile recomp_reqd
 
 hscCheckRecompBackend :: HsCompiler a -> TcGblEnv -> Compiler a
 hscCheckRecompBackend compiler tc_result hsc_env mod_summary
@@ -609,7 +609,7 @@ hscCheckRecompBackend compiler tc_result hsc_env mod_summary
 
     let mb_old_hash = fmap mi_iface_hash mb_checked_iface
     case mb_checked_iface of
-        Just iface | not recomp_reqd
+        Just iface | not (recompileRequired recomp_reqd)
             -> runHsc hsc_env $
                    hscNoRecomp compiler
                        iface{ mi_globals = Just (tcg_rdr_env tc_result) }
@@ -800,32 +800,33 @@ genModDetails old_iface
 -- Progress displayers.
 --------------------------------------------------------------
 
-data RecompReason = RecompNotRequired | RecompRequired | RecompForcedByTH
-    deriving Eq
-
-oneShotMsg :: HscEnv -> Maybe (Int,Int) -> RecompReason -> ModSummary -> IO ()
+oneShotMsg :: HscEnv -> Maybe (Int,Int) -> RecompileRequired -> ModSummary
+            -> IO ()
 oneShotMsg hsc_env _mb_mod_index recomp _mod_summary =
     case recomp of
-        RecompNotRequired ->
+        UpToDate ->
             compilationProgressMsg (hsc_dflags hsc_env) $
                    "compilation IS NOT required"
         _other ->
             return ()
 
-batchMsg :: HscEnv -> Maybe (Int,Int) -> RecompReason -> ModSummary -> IO ()
+batchMsg :: HscEnv -> Maybe (Int,Int) -> RecompileRequired -> ModSummary
+         -> IO ()
 batchMsg hsc_env mb_mod_index recomp mod_summary =
     case recomp of
-        RecompRequired -> showMsg "Compiling "
-        RecompNotRequired
-            | verbosity (hsc_dflags hsc_env) >= 2 -> showMsg "Skipping  "
+        MustCompile -> showMsg "Compiling " ""
+        UpToDate
+            | verbosity (hsc_dflags hsc_env) >= 2 -> showMsg "Skipping  " ""
             | otherwise -> return ()
-        RecompForcedByTH -> showMsg "Compiling [TH] "
+        RecompBecause reason -> showMsg "Compiling " (" [" ++ reason ++ "]")
+        RecompForcedByTH -> showMsg "Compiling " " [TH]"
     where
-        showMsg msg =
+        showMsg msg reason =
             compilationProgressMsg (hsc_dflags hsc_env) $
             (showModuleIndex mb_mod_index ++
             msg ++ showModMsg (hscTarget (hsc_dflags hsc_env))
-                              (recomp == RecompRequired) mod_summary)
+                              (recompileRequired recomp) mod_summary)
+                ++ reason
 
 --------------------------------------------------------------
 -- FrontEnds