Introduce HasHscEnv class, parallel to HasDynFlagswip/get-hscenv

4 files changed, 14 insertions, 10 deletions

diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index c4a08c4e40..6af9cdf77f 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -1906,8 +1906,8 @@ instance Monad BcM where
 instance HasDynFlags BcM where
     getDynFlags = BcM $ \st -> return (st, hsc_dflags (bcm_hsc_env st))
 
-getHscEnv :: BcM HscEnv
-getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st)
+instance HasHscEnv BcM where
+    getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st)
 
 emitBc :: ([FFIInfo] -> ProtoBCO Name) -> BcM (ProtoBCO Name)
 emitBc bco
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 911d52cbfd..7698b55ddc 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -73,7 +73,6 @@ module HscMain
       -- We want to make sure that we export enough to be able to redefine
       -- hscFileFrontEnd in client code
     , hscParse', hscSimplify', hscDesugar', tcRnModule'
-    , getHscEnv
     , hscSimpleIface', hscNormalIface'
     , oneShotMsg
     , hscFileFrontEnd, genericHscFrontend, dumpIfaceStats
@@ -216,9 +215,6 @@ clearWarnings = Hsc $ \_ _ -> return ((), emptyBag)
 logWarnings :: WarningMessages -> Hsc ()
 logWarnings w = Hsc $ \_ w0 -> return ((), w0 `unionBags` w)
 
-getHscEnv :: Hsc HscEnv
-getHscEnv = Hsc $ \e w -> return (e, w)
-
 handleWarnings :: Hsc ()
 handleWarnings = do
     dflags <- getDynFlags
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 8c41f9b9fc..cb1cc7e862 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -12,6 +12,7 @@
 module HscTypes (
         -- * compilation state
         HscEnv(..), hscEPS,
+        HasHscEnv(..),
         FinderCache, FindResult(..), InstalledFindResult(..),
         Target(..), TargetId(..), pprTarget, pprTargetId,
         HscStatus(..),
@@ -246,6 +247,9 @@ instance Monad Hsc where
 instance MonadIO Hsc where
     liftIO io = Hsc $ \_ w -> do a <- io; return (a, w)
 
+instance HasHscEnv Hsc where
+    getHscEnv = Hsc $ \e w -> return (e, w)
+
 instance HasDynFlags Hsc where
     getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w)
 
@@ -494,6 +498,10 @@ data IServ = IServ
 hscEPS :: HscEnv -> IO ExternalPackageState
 hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
 
+
+class Monad m => HasHscEnv m where
+    getHscEnv :: m HscEnv
+
 -- | A compilation target.
 --
 -- A target may be supplied with the actual text of the
diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs
index 013b1414ee..dde4cb6c50 100644
--- a/compiler/simplCore/CoreMonad.hs
+++ b/compiler/simplCore/CoreMonad.hs
@@ -25,7 +25,7 @@ module CoreMonad (
     CoreM, runCoreM,
 
     -- ** Reading from the monad
-    getHscEnv, getRuleBase, getModule,
+    getRuleBase, getModule,
     getDynFlags, getOrigNameCache, getPackageFamInstEnv,
     getVisibleOrphanMods,
     getPrintUnqualified, getSrcSpanM,
@@ -685,9 +685,6 @@ liftIOWithCount what = liftIO what >>= (\(count, x) -> addSimplCount count >> re
 ************************************************************************
 -}
 
-getHscEnv :: CoreM HscEnv
-getHscEnv = read cr_hsc_env
-
 getRuleBase :: CoreM RuleBase
 getRuleBase = read cr_rule_base
 
@@ -708,6 +705,9 @@ addSimplCount count = write (CoreWriter { cw_simpl_count = count })
 instance HasDynFlags CoreM where
     getDynFlags = fmap hsc_dflags getHscEnv
 
+instance HasHscEnv CoreM where
+    getHscEnv = read cr_hsc_env
+
 instance HasModule CoreM where
     getModule = read cr_module