Clean up hie-core (#1992)

* Split off addRelativeImport from modifying the session

* Switch located imports to adding their own relative imports

* Delete the unused getGhcDynFlags

* Make runGhcEnv no longer need to consult import paths

* Call runGhcEnv directly

* Move getSrcSpanInfos out to Spans

* Remove a redundant import

* Make findImports in Either rather than ExceptT

* Move getImports over to the right place

* Switch to liftEither

compiler/hie-core/src/Development/IDE/Core/Compile.hs

@@ -9,24 +9,21 @@
 --   Given a list of paths to find libraries, and a file to compile, produce a list of 'CoreModule' values.
 module Development.IDE.Core.Compile
   ( TcModuleResult(..)
-  , getGhcDynFlags
   , compileModule
-  , getSrcSpanInfos
   , parseModule
-  , parseFileContents
   , typecheckModule
   , computePackageDeps
+  , addRelativeImport
   ) where
 
 import           Development.IDE.GHC.Warnings
 import           Development.IDE.GHC.CPP
 import           Development.IDE.Types.Diagnostics
-import qualified Development.IDE.Import.FindImports as FindImports
 import           Development.IDE.GHC.Error
-import           Development.IDE.Spans.Calculate
 import Development.IDE.GHC.Orphans()
 import Development.IDE.GHC.Util
 import Development.IDE.GHC.Compat
+import qualified GHC.LanguageExtensions.Type as GHC
 import Development.IDE.Types.Options
 import Development.IDE.Types.Location
 
@@ -47,6 +44,7 @@ import qualified GHC.LanguageExtensions as LangExt
 
 import Control.DeepSeq
 import Control.Monad.Extra
+import Control.Monad.Except
 import Control.Monad.Trans.Except
 import qualified Data.Text as T
 import           Data.IORef
@@ -54,7 +52,6 @@ import           Data.List.Extra
 import           Data.Maybe
 import           Data.Tuple.Extra
 import qualified Data.Map.Strict                          as Map
-import           Development.IDE.Spans.Type
 import           System.FilePath
 import           System.Directory
 import System.IO.Extra
@@ -74,19 +71,6 @@ instance NFData TcModuleResult where
     rnf = rwhnf
 
 
--- | Get source span info, used for e.g. AtPoint and Goto Definition.
-getSrcSpanInfos
-    :: ParsedModule
-    -> HscEnv
-    -> [(Located ModuleName, Maybe NormalizedFilePath)]
-    -> TcModuleResult
-    -> IO [SpanInfo]
-getSrcSpanInfos mod env imports tc =
-    runGhcSession (Just mod) env
-        . getSpanInfo imports
-        $ tmrModule tc
-
-
 -- | Given a string buffer, return a pre-processed @ParsedModule@.
 parseModule
     :: IdeOptions
@@ -97,7 +81,7 @@ parseModule
 parseModule IdeOptions{..} env file =
     fmap (either (, Nothing) (second Just)) .
     -- We need packages since imports fail to resolve otherwise.
-    runGhcSession Nothing env . runExceptT . parseFileContents optPreprocessor file
+    runGhcEnv env . runExceptT . parseFileContents optPreprocessor file
 
 
 -- | Given a package identifier, what packages does it depend on
@@ -122,7 +106,7 @@ typecheckModule
     -> IO ([FileDiagnostic], Maybe TcModuleResult)
 typecheckModule opt packageState deps pm =
     fmap (either (, Nothing) (second Just)) $
-    runGhcSession (Just pm) packageState $
+    runGhcEnv packageState $
         catchSrcErrors $ do
             setupEnv deps
             (warnings, tcm) <- withWarnings $ \tweak ->
@@ -133,14 +117,13 @@ typecheckModule opt packageState deps pm =
 -- | Compile a single type-checked module to a 'CoreModule' value, or
 -- provide errors.
 compileModule
-    :: ParsedModule
+    :: HscEnv
-    -> HscEnv
     -> [TcModuleResult]
     -> TcModuleResult
     -> IO ([FileDiagnostic], Maybe CoreModule)
-compileModule mod packageState deps tmr =
+compileModule packageState deps tmr =
     fmap (either (, Nothing) (second Just)) $
-    runGhcSession (Just mod) packageState $
+    runGhcEnv packageState $
         catchSrcErrors $ do
             setupEnv (deps ++ [tmr])
 
@@ -164,21 +147,9 @@ compileModule mod packageState deps tmr =
             return (warnings, core)
 
 
-getGhcDynFlags :: ParsedModule -> HscEnv -> IO DynFlags
+addRelativeImport :: ParsedModule -> DynFlags -> DynFlags
-getGhcDynFlags mod pkg = runGhcSession (Just mod) pkg getSessionDynFlags
+addRelativeImport modu dflags = dflags
-
+    {importPaths = nubOrd $ maybeToList (moduleImportPaths modu) ++ importPaths dflags}
--- | Evaluate a GHC session using a new environment constructed with
--- the supplied options.
-runGhcSession
-    :: Maybe ParsedModule
-    -> HscEnv
-    -> Ghc a
-    -> IO a
-runGhcSession modu env act = runGhcEnv env $ do
-    modifyDynFlags $ \x -> x
-        {importPaths = nubOrd $ maybeToList (moduleImportPaths =<< modu) ++ importPaths x}
-    act
-
 
 moduleImportPaths :: GHC.ParsedModule -> Maybe FilePath
 moduleImportPaths pm
@@ -258,6 +229,35 @@ loadModuleHome tmr = modifySession $ \e ->
     mod_info = tmrModInfo tmr
     mod      = ms_mod_name ms
 
+
+
+-- | GhcMonad function to chase imports of a module given as a StringBuffer. Returns given module's
+-- name and its imports.
+getImportsParsed ::  DynFlags ->
+               GHC.ParsedSource ->
+               Either [FileDiagnostic] (GHC.ModuleName, [(Maybe FastString, Located GHC.ModuleName)])
+getImportsParsed dflags (L loc parsed) = do
+  let modName = maybe (GHC.mkModuleName "Main") GHC.unLoc $ GHC.hsmodName parsed
+
+  -- refuse source imports
+  let srcImports = filter (ideclSource . GHC.unLoc) $ GHC.hsmodImports parsed
+  when (not $ null srcImports) $ Left $
+    concat
+      [ diagFromString mloc ("Illegal source import of " <> GHC.moduleNameString (GHC.unLoc $ GHC.ideclName i))
+      | L mloc i <- srcImports ]
+
+  -- most of these corner cases are also present in https://hackage.haskell.org/package/ghc-8.6.1/docs/src/HeaderInfo.html#getImports
+  -- but we want to avoid parsing the module twice
+  let implicit_prelude = xopt GHC.ImplicitPrelude dflags
+      implicit_imports = Hdr.mkPrelImports modName loc implicit_prelude $ GHC.hsmodImports parsed
+
+  -- filter out imports that come from packages
+  return (modName, [(fmap sl_fs $ ideclPkgQual i, ideclName i)
+    | i <- map GHC.unLoc $ implicit_imports ++ GHC.hsmodImports parsed
+    , GHC.moduleNameString (GHC.unLoc $ ideclName i) /= "GHC.Prim"
+    ])
+
+
 -- | Produce a module summary from a StringBuffer.
 getModSummaryFromBuffer
     :: GhcMonad m
@@ -267,7 +267,7 @@ getModSummaryFromBuffer
     -> GHC.ParsedSource
     -> ExceptT [FileDiagnostic] m ModSummary
 getModSummaryFromBuffer fp contents dflags parsed = do
-  (modName, imports) <- FindImports.getImportsParsed dflags parsed
+  (modName, imports) <- liftEither $ getImportsParsed dflags parsed
 
   let modLoc = ModLocation
           { ml_hs_file  = Just fp

compiler/hie-core/src/Development/IDE/Core/Rules.hs

@@ -30,6 +30,7 @@ import           Control.Monad.Except
 import Control.Monad.Trans.Maybe
 import qualified Development.IDE.Core.Compile             as Compile
 import qualified Development.IDE.Types.Options as Compile
+import qualified Development.IDE.Spans.Calculate as Compile
 import Development.IDE.Import.DependencyInformation
 import Development.IDE.Import.FindImports
 import           Development.IDE.Core.FileStore
@@ -50,6 +51,7 @@ import           GHC
 import Development.IDE.GHC.Compat
 import           UniqSupply
 import NameCache
+import HscTypes
 
 import qualified Development.IDE.Spans.AtPoint as AtPoint
 import Development.IDE.Core.Service
@@ -143,8 +145,8 @@ getLocatedImportsRule =
         pm <- use_ GetParsedModule file
         let ms = pm_mod_summary pm
         let imports = ms_textual_imps ms
-        packageState <- use_ GhcSession ""
+        env <- use_ GhcSession ""
-        dflags <- liftIO $ Compile.getGhcDynFlags pm packageState
+        let dflags = Compile.addRelativeImport pm $ hsc_dflags env
         opt <- getIdeOptions
         xs <- forM imports $ \(mbPkgName, modName) ->
             (modName, ) <$> locateModule dflags (Compile.optExtensions opt) getFileExists modName mbPkgName
@@ -229,11 +231,10 @@ getDependenciesRule =
 getSpanInfoRule :: Rules ()
 getSpanInfoRule =
     define $ \GetSpanInfo file -> do
-        pm <- use_ GetParsedModule file
         tc <- use_ TypeCheck file
         imports <- use_ GetLocatedImports file
         packageState <- use_ GhcSession ""
-        x <- liftIO $ Compile.getSrcSpanInfos pm packageState (fileImports imports) tc
+        x <- liftIO $ Compile.getSrcSpanInfos packageState (fileImports imports) tc
         return ([], Just x)
 
 -- Typechecks a module.
@@ -254,10 +255,9 @@ generateCoreRule =
     define $ \GenerateCore file -> do
         deps <- use_ GetDependencies file
         (tm:tms) <- uses_ TypeCheck (file:transitiveModuleDeps deps)
-        let pm = tm_parsed_module . Compile.tmrModule $ tm
         setPriority priorityGenerateCore
         packageState <- use_ GhcSession ""
-        liftIO $ Compile.compileModule pm packageState tms tm
+        liftIO $ Compile.compileModule packageState tms tm
 
 loadGhcSession :: Rules ()
 loadGhcSession =

compiler/hie-core/src/Development/IDE/Import/FindImports.hs

@@ -4,8 +4,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Development.IDE.Import.FindImports
-  ( getImportsParsed
+  ( locateModule
-  , locateModule
   , Import(..)
   ) where
 
@@ -14,13 +13,10 @@ import Development.IDE.GHC.Orphans()
 import Development.IDE.Types.Diagnostics
 import Development.IDE.Types.Location
 -- GHC imports
-import           BasicTypes                  (StringLiteral(..))
 import           DynFlags
 import           FastString
 import           GHC
-import qualified HeaderInfo                  as Hdr
 import qualified Module                      as M
-import qualified GHC.LanguageExtensions.Type as GHC
 import           Packages
 import           Outputable                  (showSDoc, ppr, pprPanic)
 import           Finder
@@ -29,7 +25,6 @@ import Control.DeepSeq
 -- standard imports
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
-import qualified Control.Monad.Trans.Except            as Ex
 import           System.FilePath
 
 data Import
@@ -42,35 +37,6 @@ instance NFData Import where
   rnf (PackageImport x) = rnf x
 
 
--- | GhcMonad function to chase imports of a module given as a StringBuffer. Returns given module's
--- name and its imports.
-getImportsParsed :: Monad m =>
-               DynFlags ->
-               GHC.ParsedSource ->
-               Ex.ExceptT [FileDiagnostic] m
-                          (M.ModuleName, [(Maybe FastString, Located M.ModuleName)])
-getImportsParsed dflags (L loc parsed) = do
-  let modName = maybe (GHC.mkModuleName "Main") GHC.unLoc $ GHC.hsmodName parsed
-
-  -- refuse source imports
-  let srcImports = filter (ideclSource . GHC.unLoc) $ GHC.hsmodImports parsed
-  when (not $ null srcImports) $ Ex.throwE $
-    concat
-      [ diagFromString mloc ("Illegal source import of " <> GHC.moduleNameString (GHC.unLoc $ GHC.ideclName i))
-      | L mloc i <- srcImports ]
-
-  -- most of these corner cases are also present in https://hackage.haskell.org/package/ghc-8.6.1/docs/src/HeaderInfo.html#getImports
-  -- but we want to avoid parsing the module twice
-  let implicit_prelude = xopt GHC.ImplicitPrelude dflags
-      implicit_imports = Hdr.mkPrelImports modName loc implicit_prelude $ GHC.hsmodImports parsed
-
-  -- filter out imports that come from packages
-  return (modName, [(fmap sl_fs $ ideclPkgQual i, ideclName i)
-    | i <- map GHC.unLoc $ implicit_imports ++ GHC.hsmodImports parsed
-    , GHC.moduleNameString (GHC.unLoc $ ideclName i) /= "GHC.Prim"
-    ])
-
-
 -- | locate a module in the file system. Where we go from *daml to Haskell
 locateModuleFile :: MonadIO m
              => DynFlags

compiler/hie-core/src/Development/IDE/Spans/Calculate.hs

@@ -7,7 +7,7 @@
 
 -- | Get information on modules, identifiers, etc.
 
-module Development.IDE.Spans.Calculate(getSpanInfo,listifyAllSpans) where
+module Development.IDE.Spans.Calculate(getSrcSpanInfos,listifyAllSpans) where
 
 import           ConLike
 import           Control.Monad
@@ -27,6 +27,20 @@ import           Development.IDE.GHC.Error (zeroSpan)
 import           Prelude hiding (mod)
 import           TcHsSyn
 import           Var
+import Development.IDE.Core.Compile
+import Development.IDE.GHC.Util
+
+
+-- | Get source span info, used for e.g. AtPoint and Goto Definition.
+getSrcSpanInfos
+    :: HscEnv
+    -> [(Located ModuleName, Maybe NormalizedFilePath)]
+    -> TcModuleResult
+    -> IO [SpanInfo]
+getSrcSpanInfos env imports tc =
+    runGhcEnv env
+        . getSpanInfo imports
+        $ tmrModule tc
 
 -- | Get ALL source spans in the module.
 getSpanInfo :: GhcMonad m