405d62b · ghcide · git.iko.soy

git.iko.soy/ghcide

Add multi environment support

commit405d62b0645e6daa3a43b5c4d4efec50622fa471 authorNeil Mitchell <ndmitchell@gmail.com> dateWed 11 Sep 2019, 09:13 (7 years ago) parent31e000e

6 files changed+88−33

compare with master

unifiedsplit

exe/Main.hs+10−7 src/Development/IDE/Core/RuleTypes.hs+2−1 src/Development/IDE/Core/Rules.hs+34−11 src/Development/IDE/GHC/Orphans.hs−6 src/Development/IDE/GHC/Util.hs+23−2 src/Development/IDE/Types/Options.hs+19−6

exe/Main.hs+10−7

@@ -23,6 +23,7 @@ import Development.IDE.Types.Location

2323import Development.IDE.Types.Diagnostics

2424import Development.IDE.Types.Options

2525import Development.IDE.Types.Logger

26+import Development.IDE.GHC.Util

2627import qualified Data.Text as T

2728import qualified Data.Text.IO as T

2829import Language.Haskell.LSP.Messages

@@ -36,9 +37,6 @@ import System.IO

3637import Development.Shake hiding (Env)

3738import qualified Data.Set as Set

3839

39−-- import CmdLineParser

40−-- import DynFlags

41−-- import Panic

4240import GHC hiding (def)

4341import qualified GHC.Paths

4442

@@ -71,7 +69,7 @@ main = do

7169 runLanguageServer def def $ \event vfs caps -> do

7270 t <- t

7371 hPutStrLn stderr $ "Started LSP server in " ++ showDuration t

74− let options = (defaultIdeOptions $ liftIO $ newSession' =<< findCradle (dir <> "/"))

72+ let options = (defaultIdeOptions $ loadEnvironment dir)

7573 { optReportProgress = clientSupportsProgress caps }

7674 initialise (mainRule >> action kick) event logger options vfs

7775 else do

@@ -84,7 +82,7 @@ main = do

8482

8583 putStrLn "\n[3/6] Initialising IDE session"

8684 vfs <- makeVFSHandle

87− ide <- initialise mainRule (showEvent lock) logger (defaultIdeOptions $ return env) vfs

85+ ide <- initialise mainRule (showEvent lock) logger (defaultIdeOptions $ return $ const $ return env) vfs

8886

8987 putStrLn "\n[4/6] Finding interesting files"

9088 files <- nubOrd <$> expandFiles (argFiles ++ ["." | null argFiles])

@@ -128,10 +126,15 @@ showEvent lock (EventFileDiagnostics (toNormalizedFilePath -> file) diags) =

128126 withLock lock $ T.putStrLn $ showDiagnosticsColored $ map (file,) diags

129127showEvent lock e = withLock lock $ print e

130128

131−newSession' :: Cradle -> IO HscEnv

129+newSession' :: Cradle -> IO HscEnvEq

132130newSession' cradle = getLibdir >>= \libdir -> do

133131 env <- runGhc (Just libdir) $ do

134132 initializeFlagsWithCradle "" cradle

135133 getSession

136134 initDynLinker env

137− pure env

135+ newHscEnvEq env

136+

137+loadEnvironment :: FilePath -> IO (FilePath -> Action HscEnvEq)

138+loadEnvironment dir = do

139+ res <- liftIO $ newSession' =<< findCradle (dir <> "/")

140+ return $ const $ return res

src/Development/IDE/Core/RuleTypes.hs+2−1

@@ -13,6 +13,7 @@ module Development.IDE.Core.RuleTypes(

1313

1414import Control.DeepSeq

1515import Development.IDE.Import.DependencyInformation

16+import Development.IDE.GHC.Util

1617import Development.IDE.Types.Location

1718import Data.Hashable

1819import Data.Typeable

@@ -66,7 +67,7 @@ type instance RuleResult GetSpanInfo = [SpanInfo]

6667type instance RuleResult GenerateCore = CoreModule

6768

6869-- | A GHC session that we reuse.

69−type instance RuleResult GhcSession = HscEnv

70+type instance RuleResult GhcSession = HscEnvEq

7071

7172-- | Resolve the imports in a module to the file path of a module

7273-- in the same package or the package id of another package.

src/Development/IDE/Core/Rules.hs+34−11

@@ -36,6 +36,7 @@ import Development.IDE.Import.FindImports

3636import Development.IDE.Core.FileStore

3737import Development.IDE.Types.Diagnostics

3838import Development.IDE.Types.Location

39+import Development.IDE.GHC.Util

3940import Data.Coerce

4041import Data.Either.Extra

4142import Data.Maybe

@@ -54,10 +55,12 @@ import Development.IDE.GHC.Compat

5455import UniqSupply

5556import NameCache

5657import HscTypes

58+import GHC.Generics(Generic)

5759

5860import qualified Development.IDE.Spans.AtPoint as AtPoint

5961import Development.IDE.Core.Service

6062import Development.IDE.Core.Shake

63+import Development.Shake.Classes

6164import System.Directory

6265import System.FilePath

6366import MkIface

@@ -116,7 +119,7 @@ getAtPoint file pos = fmap join $ runMaybeT $ do

116119getDefinition :: NormalizedFilePath -> Position -> Action (Maybe Location)

117120getDefinition file pos = fmap join $ runMaybeT $ do

118121 spans <- useE GetSpanInfo file

119− pkgState <- useNoFileE GhcSession

122+ pkgState <- hscEnv <$> useE GhcSession file

120123 opts <- lift getIdeOptions

121124 let getHieFile x = useNoFile (GetHieFile x)

122125 lift $ AtPoint.gotoDefinition getHieFile opts pkgState spans pos

@@ -131,8 +134,9 @@ writeIfacesAndHie ::

131134writeIfacesAndHie ifDir files =

132135 runMaybeT $ do

133136 tcms <- usesE TypeCheck files

134− session <- lift $ useNoFile_ GhcSession

135− liftIO $ concat <$> mapM (writeTcm session) tcms

137+ fmap concat $ forM (zip files tcms) $ \(file, tcm) -> do

138+ session <- lift $ hscEnv <$> use_ GhcSession file

139+ liftIO $ writeTcm session tcm

136140 where

137141 writeTcm session tcm =

138142 do

@@ -174,7 +178,7 @@ getParsedModuleRule :: Rules ()

174178getParsedModuleRule =

175179 define $ \GetParsedModule file -> do

176180 (_, contents) <- getFileContents file

177− packageState <- useNoFile_ GhcSession

181+ packageState <- hscEnv <$> use_ GhcSession file

178182 opt <- getIdeOptions

179183 liftIO $ parseModule opt packageState (fromNormalizedFilePath file) contents

180184

@@ -184,7 +188,7 @@ getLocatedImportsRule =

184188 pm <- use_ GetParsedModule file

185189 let ms = pm_mod_summary pm

186190 let imports = [(False, imp) | imp <- ms_textual_imps ms] ++ [(True, imp) | imp <- ms_srcimps ms]

187− env <- useNoFile_ GhcSession

191+ env <- hscEnv <$> useNoFile_ GhcSession

188192 let dflags = addRelativeImport pm $ hsc_dflags env

189193 opt <- getIdeOptions

190194 (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do

@@ -295,7 +299,7 @@ getSpanInfoRule =

295299 define $ \GetSpanInfo file -> do

296300 tc <- use_ TypeCheck file

297301 (fileImports, _) <- use_ GetLocatedImports file

298− packageState <- useNoFile_ GhcSession

302+ packageState <- hscEnv <$> use_ GhcSession file

299303 x <- liftIO $ getSrcSpanInfos packageState fileImports tc

300304 return ([], Just x)

301305

@@ -307,7 +311,7 @@ typeCheckRule =

307311 deps <- use_ GetDependencies file

308312 tms <- uses_ TypeCheck (transitiveModuleDeps deps)

309313 setPriority priorityTypeCheck

310− packageState <- useNoFile_ GhcSession

314+ packageState <- hscEnv <$> use_ GhcSession file

311315 liftIO $ typecheckModule packageState tms pm

312316

313317

@@ -317,14 +321,33 @@ generateCoreRule =

317321 deps <- use_ GetDependencies file

318322 (tm:tms) <- uses_ TypeCheck (file:transitiveModuleDeps deps)

319323 setPriority priorityGenerateCore

320− packageState <- useNoFile_ GhcSession

324+ packageState <- hscEnv <$> use_ GhcSession file

321325 liftIO $ compileModule packageState tms tm

322326

327+

328+-- A local rule type to get caching. We want to use newCache, but it has

329+-- thread killed exception issues, so we lift it to a full rule.

330+-- https://github.com/digital-asset/daml/pull/2808#issuecomment-529639547

331+type instance RuleResult GhcSessionIO = GhcSessionFun

332+

333+data GhcSessionIO = GhcSessionIO deriving (Eq, Show, Typeable, Generic)

334+instance Hashable GhcSessionIO

335+instance NFData GhcSessionIO

336+

337+newtype GhcSessionFun = GhcSessionFun (FilePath -> Action HscEnvEq)

338+instance Show GhcSessionFun where show _ = "GhcSessionFun"

339+instance NFData GhcSessionFun where rnf !_ = ()

340+

341+

323342loadGhcSession :: Rules ()

324−loadGhcSession =

325− defineNoFile $ \GhcSession -> do

343+loadGhcSession = do

344+ defineNoFile $ \GhcSessionIO -> do

326345 opts <- getIdeOptions

327− optGhcSession opts

346+ liftIO $ GhcSessionFun <$> optGhcSession opts

347+ define $ \GhcSession file -> do

348+ GhcSessionFun fun <- useNoFile_ GhcSessionIO

349+ val <- fun $ fromNormalizedFilePath file

350+ return ([], Just val)

328351

329352

330353getHieFileRule :: Rules ()

src/Development/IDE/GHC/Orphans.hs−6

@@ -46,12 +46,6 @@ instance Show ParsedModule where

4646instance NFData ModSummary where

4747 rnf = rwhnf

4848

49−instance Show HscEnv where

50− show _ = "HscEnv"

51−

52−instance NFData HscEnv where

53− rnf = rwhnf

54−

5549instance NFData ParsedModule where

5650 rnf = rwhnf

5751

src/Development/IDE/GHC/Util.hs+23−2

@@ -16,7 +16,8 @@ module Development.IDE.GHC.Util(

1616 prettyPrint,

1717 runGhcEnv,

1818 textToStringBuffer,

19− moduleImportPaths

19+ moduleImportPaths,

20+ HscEnvEq, hscEnv, newHscEnvEq

2021 ) where

2122

2223import Config

@@ -26,11 +27,13 @@ import Fingerprint

2627#endif

2728import GHC

2829import GhcMonad

29−import GhcPlugins

30+import GhcPlugins hiding (Unique)

3031import Data.IORef

3132import Control.Exception

3233import FileCleanup

3334import Platform

35+import Data.Unique

36+import Development.Shake.Classes

3437import qualified Data.Text as T

3538import StringBuffer

3639import System.FilePath

@@ -110,3 +113,21 @@ moduleImportPaths pm

110113 mod' = GHC.ms_mod ms

111114 rootPathDir = takeDirectory file

112115 rootModDir = takeDirectory . moduleNameSlashes . GHC.moduleName $ mod'

116+

117+-- | An HscEnv with equality.

118+data HscEnvEq = HscEnvEq Unique HscEnv

119+

120+hscEnv :: HscEnvEq -> HscEnv

121+hscEnv (HscEnvEq _ x) = x

122+

123+newHscEnvEq :: HscEnv -> IO HscEnvEq

124+newHscEnvEq e = do u <- newUnique; return $ HscEnvEq u e

125+

126+instance Show HscEnvEq where

127+ show (HscEnvEq a _) = "HscEnvEq " ++ show (hashUnique a)

128+

129+instance Eq HscEnvEq where

130+ HscEnvEq a _ == HscEnvEq b _ = a == b

131+

132+instance NFData HscEnvEq where

133+ rnf (HscEnvEq a b) = rnf (hashUnique a) `seq` b `seq` ()

src/Development/IDE/Types/Options.hs+19−6

@@ -14,23 +14,36 @@ module Development.IDE.Types.Options

1414

1515import Data.Maybe

1616import Development.Shake

17+import Development.IDE.GHC.Util

1718import GHC hiding (parseModule, typecheckModule)

1819import GhcPlugins as GHC hiding (fst3, (<>))

1920import qualified Language.Haskell.LSP.Types.Capabilities as LSP

2021

2122data IdeOptions = IdeOptions

2223 { optPreprocessor :: GHC.ParsedSource -> ([(GHC.SrcSpan, String)], GHC.ParsedSource)

23− , optGhcSession :: Action HscEnv

24− -- ^ Setup a GHC session using a given package state. If a `ParsedModule` is supplied,

25− -- the import path should be setup for that module.

24+ -- ^ Preprocessor to run over all parsed source trees, generating a list of warnings

25+ -- along with a new parse tree.

26+ , optGhcSession :: IO (FilePath -> Action HscEnvEq)

27+ -- ^ Setup a GHC session for a given file, e.g. @Foo.hs@.

28+ -- The 'IO' will be called once, then the resulting function will be applied once per file.

29+ -- It is desirable that many files get the same 'HscEnvEq', so that more IDE features work.

30+ -- You should not use 'newCacheIO' to get that caching, because of

31+ -- https://github.com/ndmitchell/shake/issues/725.

2632 , optPkgLocationOpts :: IdePkgLocationOptions

33+ -- ^ How to locate source and @.hie@ files given a module name.

2734 , optExtensions :: [String]

35+ -- ^ File extensions to search for code, defaults to Haskell sources (including @.hs@)

2836

2937 , optThreads :: Int

38+ -- ^ Number of threads to use. Use 0 for number of threads on the machine.

3039 , optShakeProfiling :: Maybe FilePath

40+ -- ^ Set to 'Just' to create a directory of profiling reports.

3141 , optReportProgress :: IdeReportProgress

32− , optLanguageSyntax :: String -- ^ the ```language to use

33− , optNewColonConvention :: Bool -- ^ whether to use new colon convention

42+ -- ^ Whether to report progress during long operations.

43+ , optLanguageSyntax :: String

44+ -- ^ the ```language to use

45+ , optNewColonConvention :: Bool

46+ -- ^ whether to use new colon convention

3447 }

3548

3649newtype IdeReportProgress = IdeReportProgress Bool

@@ -39,7 +52,7 @@ clientSupportsProgress :: LSP.ClientCapabilities -> IdeReportProgress

3952clientSupportsProgress caps = IdeReportProgress $ fromMaybe False $

4053 LSP._progress =<< LSP._window (caps :: LSP.ClientCapabilities)

4154

42−defaultIdeOptions :: Action HscEnv -> IdeOptions

55+defaultIdeOptions :: IO (FilePath -> Action HscEnvEq) -> IdeOptions

4356defaultIdeOptions session = IdeOptions

4457 {optPreprocessor = (,) []

4558 ,optGhcSession = session