git.iko.soy/ghcide
on master help sign in
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

commitddb7bd31d3fd0aa4f2a1c28b05c505206b3bf1a3 authorNeil Mitchell <35463327+neil-da@users.noreply.github.com> dateWed 3 Jul 2019, 16:38 (7 years ago) parent5ebce24
4 files changed+63−83
compare with master
unifiedsplit
src/Development/IDE/Core/Compile.hs+41−41 src/Development/IDE/Core/Rules.hs+6−6 src/Development/IDE/Import/FindImports.hs+1−35 src/Development/IDE/Spans/Calculate.hs+15−1
src/Development/IDE/Core/Compile.hs+41−41
@@ -9,24 +9,21 @@
99-- Given a list of paths to find libraries, and a file to compile, produce a list of 'CoreModule' values.
1010module Development.IDE.Core.Compile
1111 ( TcModuleResult(..)
12− , getGhcDynFlags
1312 , compileModule
14− , getSrcSpanInfos
1513 , parseModule
16− , parseFileContents
1714 , typecheckModule
1815 , computePackageDeps
16+ , addRelativeImport
1917 ) where
2018
2119import Development.IDE.GHC.Warnings
2220import Development.IDE.GHC.CPP
2321import Development.IDE.Types.Diagnostics
24−import qualified Development.IDE.Import.FindImports as FindImports
2522import Development.IDE.GHC.Error
26−import Development.IDE.Spans.Calculate
2723import Development.IDE.GHC.Orphans()
2824import Development.IDE.GHC.Util
2925import Development.IDE.GHC.Compat
26+import qualified GHC.LanguageExtensions.Type as GHC
3027import Development.IDE.Types.Options
3128import Development.IDE.Types.Location
3229
@@ -47,6 +44,7 @@ import qualified GHC.LanguageExtensions as LangExt
4744
4845import Control.DeepSeq
4946import Control.Monad.Extra
47+import Control.Monad.Except
5048import Control.Monad.Trans.Except
5149import qualified Data.Text as T
5250import Data.IORef
@@ -54,7 +52,6 @@ import Data.List.Extra
5452import Data.Maybe
5553import Data.Tuple.Extra
5654import qualified Data.Map.Strict as Map
57−import Development.IDE.Spans.Type
5855import System.FilePath
5956import System.Directory
6057import System.IO.Extra
@@ -74,19 +71,6 @@ instance NFData TcModuleResult where
7471 rnf = rwhnf
7572
7673
77−-- | Get source span info, used for e.g. AtPoint and Goto Definition.
78−getSrcSpanInfos
79− :: ParsedModule
80− -> HscEnv
81− -> [(Located ModuleName, Maybe NormalizedFilePath)]
82− -> TcModuleResult
83− -> IO [SpanInfo]
84−getSrcSpanInfos mod env imports tc =
85− runGhcSession (Just mod) env
86− . getSpanInfo imports
87− $ tmrModule tc
88−
89−
9074-- | Given a string buffer, return a pre-processed @ParsedModule@.
9175parseModule
9276 :: IdeOptions
@@ -97,7 +81,7 @@ parseModule
9781parseModule IdeOptions{..} env file =
9882 fmap (either (, Nothing) (second Just)) .
9983 -- We need packages since imports fail to resolve otherwise.
100− runGhcSession Nothing env . runExceptT . parseFileContents optPreprocessor file
84+ runGhcEnv env . runExceptT . parseFileContents optPreprocessor file
10185
10286
10387-- | Given a package identifier, what packages does it depend on
@@ -122,7 +106,7 @@ typecheckModule
122106 -> IO ([FileDiagnostic], Maybe TcModuleResult)
123107typecheckModule opt packageState deps pm =
124108 fmap (either (, Nothing) (second Just)) $
125− runGhcSession (Just pm) packageState $
109+ runGhcEnv packageState $
126110 catchSrcErrors $ do
127111 setupEnv deps
128112 (warnings, tcm) <- withWarnings $ \tweak ->
@@ -133,14 +117,13 @@ typecheckModule opt packageState deps pm =
133117-- | Compile a single type-checked module to a 'CoreModule' value, or
134118-- provide errors.
135119compileModule
136− :: ParsedModule
137− -> HscEnv
120+ :: HscEnv
138121 -> [TcModuleResult]
139122 -> TcModuleResult
140123 -> IO ([FileDiagnostic], Maybe CoreModule)
141−compileModule mod packageState deps tmr =
124+compileModule packageState deps tmr =
142125 fmap (either (, Nothing) (second Just)) $
143− runGhcSession (Just mod) packageState $
126+ runGhcEnv packageState $
144127 catchSrcErrors $ do
145128 setupEnv (deps ++ [tmr])
146129
@@ -164,21 +147,9 @@ compileModule mod packageState deps tmr =
164147 return (warnings, core)
165148
166149
167−getGhcDynFlags :: ParsedModule -> HscEnv -> IO DynFlags
168−getGhcDynFlags mod pkg = runGhcSession (Just mod) pkg getSessionDynFlags
169−
170−-- | Evaluate a GHC session using a new environment constructed with
171−-- the supplied options.
172−runGhcSession
173− :: Maybe ParsedModule
174− -> HscEnv
175− -> Ghc a
176− -> IO a
177−runGhcSession modu env act = runGhcEnv env $ do
178− modifyDynFlags $ \x -> x
179− {importPaths = nubOrd $ maybeToList (moduleImportPaths =<< modu) ++ importPaths x}
180− act
181−
150+addRelativeImport :: ParsedModule -> DynFlags -> DynFlags
151+addRelativeImport modu dflags = dflags
152+ {importPaths = nubOrd $ maybeToList (moduleImportPaths modu) ++ importPaths dflags}
182153
183154moduleImportPaths :: GHC.ParsedModule -> Maybe FilePath
184155moduleImportPaths pm
@@ -258,6 +229,35 @@ loadModuleHome tmr = modifySession $ \e ->
258229 mod_info = tmrModInfo tmr
259230 mod = ms_mod_name ms
260231
232+
233+
234+-- | GhcMonad function to chase imports of a module given as a StringBuffer. Returns given module's
235+-- name and its imports.
236+getImportsParsed :: DynFlags ->
237+ GHC.ParsedSource ->
238+ Either [FileDiagnostic] (GHC.ModuleName, [(Maybe FastString, Located GHC.ModuleName)])
239+getImportsParsed dflags (L loc parsed) = do
240+ let modName = maybe (GHC.mkModuleName "Main") GHC.unLoc $ GHC.hsmodName parsed
241+
242+ -- refuse source imports
243+ let srcImports = filter (ideclSource . GHC.unLoc) $ GHC.hsmodImports parsed
244+ when (not $ null srcImports) $ Left $
245+ concat
246+ [ diagFromString mloc ("Illegal source import of " <> GHC.moduleNameString (GHC.unLoc $ GHC.ideclName i))
247+ | L mloc i <- srcImports ]
248+
249+ -- most of these corner cases are also present in https://hackage.haskell.org/package/ghc-8.6.1/docs/src/HeaderInfo.html#getImports
250+ -- but we want to avoid parsing the module twice
251+ let implicit_prelude = xopt GHC.ImplicitPrelude dflags
252+ implicit_imports = Hdr.mkPrelImports modName loc implicit_prelude $ GHC.hsmodImports parsed
253+
254+ -- filter out imports that come from packages
255+ return (modName, [(fmap sl_fs $ ideclPkgQual i, ideclName i)
256+ | i <- map GHC.unLoc $ implicit_imports ++ GHC.hsmodImports parsed
257+ , GHC.moduleNameString (GHC.unLoc $ ideclName i) /= "GHC.Prim"
258+ ])
259+
260+
261261-- | Produce a module summary from a StringBuffer.
262262getModSummaryFromBuffer
263263 :: GhcMonad m
@@ -267,7 +267,7 @@ getModSummaryFromBuffer
267267 -> GHC.ParsedSource
268268 -> ExceptT [FileDiagnostic] m ModSummary
269269getModSummaryFromBuffer fp contents dflags parsed = do
270− (modName, imports) <- FindImports.getImportsParsed dflags parsed
270+ (modName, imports) <- liftEither $ getImportsParsed dflags parsed
271271
272272 let modLoc = ModLocation
273273 { ml_hs_file = Just fp
src/Development/IDE/Core/Rules.hs+6−6
@@ -30,6 +30,7 @@ import Control.Monad.Except
3030import Control.Monad.Trans.Maybe
3131import qualified Development.IDE.Core.Compile as Compile
3232import qualified Development.IDE.Types.Options as Compile
33+import qualified Development.IDE.Spans.Calculate as Compile
3334import Development.IDE.Import.DependencyInformation
3435import Development.IDE.Import.FindImports
3536import Development.IDE.Core.FileStore
@@ -50,6 +51,7 @@ import GHC
5051import Development.IDE.GHC.Compat
5152import UniqSupply
5253import NameCache
54+import HscTypes
5355
5456import qualified Development.IDE.Spans.AtPoint as AtPoint
5557import Development.IDE.Core.Service
@@ -143,8 +145,8 @@ getLocatedImportsRule =
143145 pm <- use_ GetParsedModule file
144146 let ms = pm_mod_summary pm
145147 let imports = ms_textual_imps ms
146− packageState <- use_ GhcSession ""
147− dflags <- liftIO $ Compile.getGhcDynFlags pm packageState
148+ env <- use_ GhcSession ""
149+ let dflags = Compile.addRelativeImport pm $ hsc_dflags env
148150 opt <- getIdeOptions
149151 xs <- forM imports $ \(mbPkgName, modName) ->
150152 (modName, ) <$> locateModule dflags (Compile.optExtensions opt) getFileExists modName mbPkgName
@@ -229,11 +231,10 @@ getDependenciesRule =
229231getSpanInfoRule :: Rules ()
230232getSpanInfoRule =
231233 define $ \GetSpanInfo file -> do
232− pm <- use_ GetParsedModule file
233234 tc <- use_ TypeCheck file
234235 imports <- use_ GetLocatedImports file
235236 packageState <- use_ GhcSession ""
236− x <- liftIO $ Compile.getSrcSpanInfos pm packageState (fileImports imports) tc
237+ x <- liftIO $ Compile.getSrcSpanInfos packageState (fileImports imports) tc
237238 return ([], Just x)
238239
239240-- Typechecks a module.
@@ -254,10 +255,9 @@ generateCoreRule =
254255 define $ \GenerateCore file -> do
255256 deps <- use_ GetDependencies file
256257 (tm:tms) <- uses_ TypeCheck (file:transitiveModuleDeps deps)
257− let pm = tm_parsed_module . Compile.tmrModule $ tm
258258 setPriority priorityGenerateCore
259259 packageState <- use_ GhcSession ""
260− liftIO $ Compile.compileModule pm packageState tms tm
260+ liftIO $ Compile.compileModule packageState tms tm
261261
262262loadGhcSession :: Rules ()
263263loadGhcSession =
src/Development/IDE/Import/FindImports.hs+1−35
@@ -4,8 +4,7 @@
44{-# LANGUAGE OverloadedStrings #-}
55
66module Development.IDE.Import.FindImports
7− ( getImportsParsed
8− , locateModule
7+ ( locateModule
98 , Import(..)
109 ) where
1110
@@ -14,13 +13,10 @@ import Development.IDE.GHC.Orphans()
1413import Development.IDE.Types.Diagnostics
1514import Development.IDE.Types.Location
1615-- GHC imports
17−import BasicTypes (StringLiteral(..))
1816import DynFlags
1917import FastString
2018import GHC
21−import qualified HeaderInfo as Hdr
2219import qualified Module as M
23−import qualified GHC.LanguageExtensions.Type as GHC
2420import Packages
2521import Outputable (showSDoc, ppr, pprPanic)
2622import Finder
@@ -29,7 +25,6 @@ import Control.DeepSeq
2925-- standard imports
3026import Control.Monad.Extra
3127import Control.Monad.IO.Class
32−import qualified Control.Monad.Trans.Except as Ex
3328import System.FilePath
3429
3530data Import
@@ -42,35 +37,6 @@ instance NFData Import where
4237 rnf (PackageImport x) = rnf x
4338
4439
45−-- | GhcMonad function to chase imports of a module given as a StringBuffer. Returns given module's
46−-- name and its imports.
47−getImportsParsed :: Monad m =>
48− DynFlags ->
49− GHC.ParsedSource ->
50− Ex.ExceptT [FileDiagnostic] m
51− (M.ModuleName, [(Maybe FastString, Located M.ModuleName)])
52−getImportsParsed dflags (L loc parsed) = do
53− let modName = maybe (GHC.mkModuleName "Main") GHC.unLoc $ GHC.hsmodName parsed
54−
55− -- refuse source imports
56− let srcImports = filter (ideclSource . GHC.unLoc) $ GHC.hsmodImports parsed
57− when (not $ null srcImports) $ Ex.throwE $
58− concat
59− [ diagFromString mloc ("Illegal source import of " <> GHC.moduleNameString (GHC.unLoc $ GHC.ideclName i))
60− | L mloc i <- srcImports ]
61−
62− -- most of these corner cases are also present in https://hackage.haskell.org/package/ghc-8.6.1/docs/src/HeaderInfo.html#getImports
63− -- but we want to avoid parsing the module twice
64− let implicit_prelude = xopt GHC.ImplicitPrelude dflags
65− implicit_imports = Hdr.mkPrelImports modName loc implicit_prelude $ GHC.hsmodImports parsed
66−
67− -- filter out imports that come from packages
68− return (modName, [(fmap sl_fs $ ideclPkgQual i, ideclName i)
69− | i <- map GHC.unLoc $ implicit_imports ++ GHC.hsmodImports parsed
70− , GHC.moduleNameString (GHC.unLoc $ ideclName i) /= "GHC.Prim"
71− ])
72−
73−
7440-- | locate a module in the file system. Where we go from *daml to Haskell
7541locateModuleFile :: MonadIO m
7642 => DynFlags
src/Development/IDE/Spans/Calculate.hs+15−1
@@ -7,7 +7,7 @@
77
88-- | Get information on modules, identifiers, etc.
99
10−module Development.IDE.Spans.Calculate(getSpanInfo,listifyAllSpans) where
10+module Development.IDE.Spans.Calculate(getSrcSpanInfos,listifyAllSpans) where
1111
1212import ConLike
1313import Control.Monad
@@ -27,6 +27,20 @@ import Development.IDE.GHC.Error (zeroSpan)
2727import Prelude hiding (mod)
2828import TcHsSyn
2929import Var
30+import Development.IDE.Core.Compile
31+import Development.IDE.GHC.Util
32+
33+
34+-- | Get source span info, used for e.g. AtPoint and Goto Definition.
35+getSrcSpanInfos
36+ :: HscEnv
37+ -> [(Located ModuleName, Maybe NormalizedFilePath)]
38+ -> TcModuleResult
39+ -> IO [SpanInfo]
40+getSrcSpanInfos env imports tc =
41+ runGhcEnv env
42+ . getSpanInfo imports
43+ $ tmrModule tc
3044
3145-- | Get ALL source spans in the module.
3246getSpanInfo :: GhcMonad m