Cleanup loadTarget logic

Language/Haskell/GhcMod/DynFlags.hs

@@ -25,8 +25,8 @@ setDebugLogger put df = do
 -- * Friendly to foreign export
 -- * Not friendly to -XTemplateHaskell and -XPatternSynonyms
 -- * Uses little memory
-setModeSimple :: DynFlags -> DynFlags
+setHscNothing :: DynFlags -> DynFlags
-setModeSimple df = df {
+setHscNothing df = df {
     ghcMode   = CompManager
   , ghcLink   = NoLink
   , hscTarget = HscNothing
@@ -37,8 +37,8 @@ setModeSimple df = df {
 -- * Not friendly to foreign export
 -- * Friendly to -XTemplateHaskell and -XPatternSynonyms
 -- * Uses lots of memory
-setModeIntelligent :: DynFlags -> DynFlags
+setHscInterpreted :: DynFlags -> DynFlags
-setModeIntelligent df = df {
+setHscInterpreted df = df {
     ghcMode   = CompManager
   , ghcLink   = LinkInMemory
   , hscTarget = HscInterpreted

Language/Haskell/GhcMod/Internal.hs

@@ -17,7 +17,6 @@ module Language.Haskell.GhcMod.Internal (
   -- * Environment, state and logging
   , GhcModEnv(..)
   , GhcModState
-  , CompilerMode(..)
   , GhcModLog
   , GmLog(..)
   , GmLogLevel(..)
@@ -34,8 +33,6 @@ module Language.Haskell.GhcMod.Internal (
   -- ** Accessing 'GhcModEnv' and 'GhcModState'
   , options
   , cradle
-  , getCompilerMode
-  , setCompilerMode
   , targetGhcOptions
   , withOptions
   -- * 'GhcModError'

Language/Haskell/GhcMod/Monad/Types.hs

@@ -36,7 +36,6 @@ module Language.Haskell.GhcMod.Monad.Types (
   , defaultGhcModState
   , GmGhcSession(..)
   , GmComponent(..)
-  , CompilerMode(..)
   -- * Accessing 'GhcModEnv', 'GhcModState' and 'GhcModLog'
   , GmLogLevel(..)
   , GhcModLog(..)
@@ -50,8 +49,6 @@ module Language.Haskell.GhcMod.Monad.Types (
   , options
   , outputOpts
   , withOptions
-  , getCompilerMode
-  , setCompilerMode
   , getMMappedFiles
   , setMMappedFiles
   , addMMappedFile
@@ -549,12 +546,6 @@ outputOpts = gmoOptions `liftM` gmoAsk
 cradle :: GmEnv m => m Cradle
 cradle = gmCradle `liftM` gmeAsk
 
-getCompilerMode :: GmState m => m CompilerMode
-getCompilerMode = gmCompilerMode `liftM` gmsGet
-
-setCompilerMode :: GmState m => CompilerMode -> m ()
-setCompilerMode mode = (\s -> gmsPut s { gmCompilerMode = mode } ) =<< gmsGet
-
 getMMappedFiles :: GmState m => m FileMappingMap
 getMMappedFiles = gmMMappedFiles `liftM` gmsGet
 

Language/Haskell/GhcMod/Target.hs

@@ -143,7 +143,7 @@ runGmlTWith efnmns' mdf wrapper action = do
                   | otherwise = setEmptyLogger
 
     initSession opts' $
-        setModeSimple >>> setLogger >>> mdf
+        setHscNothing >>> setLogger >>> mdf
 
     mappedStrs <- getMMappedFilePaths
     let targetStrs = mappedStrs ++ map moduleNameString mns ++ cfns
@@ -430,20 +430,24 @@ loadTargets opts targetStrs = do
 
     setTargets targets
 
-    mode <- getCompilerMode
+    mg <- depanal [] False
-    if mode == Intelligent
+
-      then loadTargets' Intelligent
+    let interp = needsHscInterpreted mg
-      else do
+    target <- hscTarget <$> getSessionDynFlags
-        mdls <- depanal [] False
+    when (interp && target /= HscInterpreted) $ do
-        let fallback = needsFallback mdls
+      resetTargets targets
-        if fallback then do
+      _ <- setSessionDynFlags . setHscInterpreted =<< getSessionDynFlags
-            resetTargets targets
+      gmLog GmInfo "loadTargets" $ text "Target needs interpeter, switching to LinkInMemory/HscInterpreted. Perfectly normal if anything is using TemplateHaskell, QuasiQuotes or PatternSynonyms."
-            setIntelligent
+
-            gmLog GmInfo "loadTargets" $
+    target' <- hscTarget <$> getSessionDynFlags
-                text "Target needs interpeter, switching to LinkInMemory/HscInterpreted. Perfectly normal if anything is using TemplateHaskell, QuasiQuotes or PatternSynonyms."
+
-            loadTargets' Intelligent
+    case target' of
-          else
+      HscNothing -> do
-            loadTargets' Simple
+        void $ load LoadAllTargets
+        mapM_ (parseModule >=> typecheckModule >=> desugarModule) mg
+      HscInterpreted -> do
+        void $ load LoadAllTargets
+      _ -> error ("loadTargets: unsupported hscTarget")
 
     gmLog GmDebug "loadTargets" $ text "Loading done"
 
@@ -455,30 +459,16 @@ loadTargets opts targetStrs = do
       return $ Target tid taoc src
     relativize tgt = return tgt
 
-    loadTargets' Simple = do
-        void $ load LoadAllTargets
-        mapM_ (parseModule >=> typecheckModule >=> desugarModule) =<< getModuleGraph
-
-    loadTargets' Intelligent = do
-        df <- getSessionDynFlags
-        void $ setSessionDynFlags (setModeIntelligent df)
-        void $ load LoadAllTargets
-
     resetTargets targets' = do
         setTargets []
         void $ load LoadAllTargets
         setTargets targets'
 
-    setIntelligent = do
-        newdf <- setModeIntelligent <$> getSessionDynFlags
-        void $ setSessionDynFlags newdf
-        setCompilerMode Intelligent
-
     showTargetId (Target (TargetModule s) _ _) = moduleNameString s
     showTargetId (Target (TargetFile s _) _ _) = s
 
-needsFallback :: ModuleGraph -> Bool
+needsHscInterpreted :: ModuleGraph -> Bool
-needsFallback = any $ \ms ->
+needsHscInterpreted = any $ \ms ->
                 let df = ms_hspp_opts ms in
                    Opt_TemplateHaskell `xopt` df
                 || Opt_QuasiQuotes     `xopt` df

Language/Haskell/GhcMod/Types.hs

@@ -199,16 +199,13 @@ data GhcModCaches = GhcModCaches {
 
 data GhcModState = GhcModState {
       gmGhcSession   :: !(Maybe GmGhcSession)
-    , gmCompilerMode :: !CompilerMode
     , gmCaches       :: !GhcModCaches
     , gmMMappedFiles :: !FileMappingMap
     }
 
-data CompilerMode = Simple | Intelligent deriving (Eq,Show,Read)
-
 defaultGhcModState :: GhcModState
 defaultGhcModState =
-    GhcModState n Simple (GhcModCaches n n n n) Map.empty
+    GhcModState n (GhcModCaches n n n n) Map.empty
  where n = Nothing
 
 ----------------------------------------------------------------