Use 'GhcMonad' in DriverMkDepend.

diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index 481cd0c..ef28c2c 100644 (file)
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -16,10 +16,10 @@ module DriverMkDepend (
 #include "HsVersions.h"
 
 import qualified GHC
 #include "HsVersions.h"
 
 import qualified GHC

-import GHC              ( Session, ModSummary(..) )
+import GHC              ( ModSummary(..), GhcMonad )

 import DynFlags
 import Util
 import DynFlags
 import Util

-import HscTypes         ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
+import HscTypes         ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath, getSession )

 import SysTools         ( newTempName )
 import qualified SysTools
 import Module
 import SysTools         ( newTempName )
 import qualified SysTools
 import Module

@@ -33,8 +33,8 @@ import FastString
 
 import Exception
 import ErrUtils         ( debugTraceMsg, putMsg )
 
 import Exception
 import ErrUtils         ( debugTraceMsg, putMsg )

+import MonadUtils       ( liftIO )

 
 

-import System.Exit      ( ExitCode(..), exitWith )

 import System.Directory
 import System.FilePath
 import System.IO
 import System.Directory
 import System.FilePath
 import System.IO

@@ -48,37 +48,42 @@ import Data.Maybe       ( isJust )
 --
 -----------------------------------------------------------------
 
 --
 -----------------------------------------------------------------
 

-doMkDependHS :: Session -> [FilePath] -> IO ()
-doMkDependHS session srcs
-  = do  {       -- Initialisation
-          dflags <- GHC.getSessionDynFlags session
-        ; files <- beginMkDependHS dflags
-
-                -- Do the downsweep to find all the modules
-        ; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
-        ; GHC.setTargets session targets
-        ; let excl_mods = depExcludeMods dflags
-        ; r <- GHC.depanal session excl_mods True {- Allow dup roots -}
-        ; case r of
-            Nothing -> exitWith (ExitFailure 1)
-            Just mod_summaries -> do {
+doMkDependHS :: GhcMonad m => [FilePath] -> m ()
+doMkDependHS srcs = do
+    -- Initialisation
+    dflags <- GHC.getSessionDynFlags
+    files <- liftIO $ beginMkDependHS dflags
+
+    -- Do the downsweep to find all the modules
+    targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
+    GHC.setTargets targets
+    let excl_mods = depExcludeMods dflags
+    mod_summaries <- GHC.depanal excl_mods True {- Allow dup roots -}
+
+    -- Sort into dependency order
+    -- There should be no cycles
+    let sorted = GHC.topSortModuleGraph False mod_summaries Nothing
+
+    -- Print out the dependencies if wanted
+    liftIO $ debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)

 
 

-                -- Sort into dependency order
-                -- There should be no cycles
-          let sorted = GHC.topSortModuleGraph False mod_summaries Nothing
+    -- Prcess them one by one, dumping results into makefile
+    -- and complaining about cycles
+    hsc_env <- getSession
+    mapM (liftIO . processDeps dflags hsc_env excl_mods (mkd_tmp_hdl files)) sorted

 
 

-                -- Print out the dependencies if wanted
-        ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
+    -- If -ddump-mod-cycles, show cycles in the module graph
+    liftIO $ dumpModCycles dflags mod_summaries

 
 

-                -- Prcess them one by one, dumping results into makefile
-                -- and complaining about cycles
-        ; mapM (processDeps dflags session excl_mods (mkd_tmp_hdl files)) sorted
+    -- Tidy up
+    liftIO $ endMkDependHS dflags files

 
 

-                -- If -ddump-mod-cycles, show cycles in the module graph
-        ; dumpModCycles dflags mod_summaries
+    -- Unconditional exiting is a bad idea.  If an error occurs we'll get an
+    --exception; if that is not caught it's fine, but at least we have a
+    --chance to find out exactly what went wrong.  Uncomment the following
+    --line if you disagree.

 
 

-                -- Tidy up
-        ; endMkDependHS dflags files }}
+    --`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1)

 
 -----------------------------------------------------------------
 --
 
 -----------------------------------------------------------------
 --

@@ -149,7 +154,7 @@ beginMkDependHS dflags = do
 -----------------------------------------------------------------
 
 processDeps :: DynFlags
 -----------------------------------------------------------------
 
 processDeps :: DynFlags

-            -> Session
+            -> HscEnv

             -> [ModuleName]
             -> Handle           -- Write dependencies to here
             -> SCC ModSummary
             -> [ModuleName]
             -> Handle           -- Write dependencies to here
             -> SCC ModSummary

@@ -173,9 +178,8 @@ processDeps _ _ _ _ (CyclicSCC nodes)
   =     -- There shouldn't be any cycles; report them
     ghcError (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
 
   =     -- There shouldn't be any cycles; report them
     ghcError (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
 

-processDeps dflags session excl_mods hdl (AcyclicSCC node)
-  = do  { hsc_env <- GHC.sessionHscEnv session
-        ; let extra_suffixes = depSuffixes dflags
+processDeps dflags hsc_env excl_mods hdl (AcyclicSCC node)
+  = do  { let extra_suffixes = depSuffixes dflags

               include_pkg_deps = depIncludePkgDeps dflags
               src_file  = msHsFilePath node
               obj_file  = msObjFilePath node
               include_pkg_deps = depIncludePkgDeps dflags
               src_file  = msHsFilePath node
               obj_file  = msObjFilePath node