From 4dc9cd002027a83d8c2491313317ee06989f29f1 Mon Sep 17 00:00:00 2001 From: Neil Mitchell <35463327+neil-da@users.noreply.github.com> Date: Wed, 3 Jul 2019 16:38:57 +0100 Subject: [PATCH] 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 --- .../src/Development/IDE/Core/Compile.hs | 82 +++++++++---------- .../src/Development/IDE/Core/Rules.hs | 12 +-- .../src/Development/IDE/Import/FindImports.hs | 36 +------- .../src/Development/IDE/Spans/Calculate.hs | 16 +++- 4 files changed, 63 insertions(+), 83 deletions(-) diff --git a/compiler/hie-core/src/Development/IDE/Core/Compile.hs b/compiler/hie-core/src/Development/IDE/Core/Compile.hs index c6a5e2b5ea..15c5c6941d 100644 --- a/compiler/hie-core/src/Development/IDE/Core/Compile.hs +++ b/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 -getGhcDynFlags mod pkg = runGhcSession (Just mod) pkg getSessionDynFlags - --- | 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 - +addRelativeImport :: ParsedModule -> DynFlags -> DynFlags +addRelativeImport modu dflags = dflags + {importPaths = nubOrd $ maybeToList (moduleImportPaths modu) ++ importPaths dflags} 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 diff --git a/compiler/hie-core/src/Development/IDE/Core/Rules.hs b/compiler/hie-core/src/Development/IDE/Core/Rules.hs index 6e601f7979..f61a286e9c 100644 --- a/compiler/hie-core/src/Development/IDE/Core/Rules.hs +++ b/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 "" - dflags <- liftIO $ Compile.getGhcDynFlags pm packageState + env <- use_ GhcSession "" + 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 = diff --git a/compiler/hie-core/src/Development/IDE/Import/FindImports.hs b/compiler/hie-core/src/Development/IDE/Import/FindImports.hs index 2d1904194d..c5162c9be4 100644 --- a/compiler/hie-core/src/Development/IDE/Import/FindImports.hs +++ b/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 diff --git a/compiler/hie-core/src/Development/IDE/Spans/Calculate.hs b/compiler/hie-core/src/Development/IDE/Spans/Calculate.hs index 7ea037ac1e..502a26a2a7 100644 --- a/compiler/hie-core/src/Development/IDE/Spans/Calculate.hs +++ b/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