mirror of
https://github.com/haskell/ghcide.git
synced 2024-09-11 05:36:09 +03:00
Typecheck entire project on Initial Load and typecheck reverse dependencies of a file on saving (#688)
* Add new command to GetModuleGraph for a session and propate changes to modules Only propagate changes to parent modules when saving Typecheck files when they are opened, don't TC FOI Add known files rule Don't save ifaces for files with defered errors Co-authored-by: Zubin Duggal <zubin@cmi.ac.in> * Add configuration for parent typechecking * hlint ignore * Use targets to filter located imports (#10) * Use targets to filter located imports * Remove import paths from the GHC session Otherwise GHC will prioritize source files found in the import path * Update session-loader/Development/IDE/Session.hs Co-authored-by: Pepe Iborra <pepeiborra@me.com> * Add session-loader to hie.yaml (#714) * move known files rule to RuleTypes * Disable checkParents on open and close document (#12) * Really disable expensive checkParents * Add an option to check parents on close Co-authored-by: Matthew Pickering <matthewtpickering@gmail.com> Co-authored-by: Pepe Iborra <pepeiborra@me.com> Co-authored-by: Luke Lau <luke_lau@icloud.com>
This commit is contained in:
parent
6128c74ba2
commit
b4589aebe6
18
README.md
18
README.md
@ -95,6 +95,24 @@ If you can't get `ghcide` working outside the editor, see [this setup troublesho
|
||||
|
||||
`ghcide` has been designed to handle projects with hundreds or thousands of modules. If `ghci` can handle it, then `ghcide` should be able to handle it. The only caveat is that this currently requires GHC >= 8.6, and that the first time a module is loaded in the editor will trigger generation of support files in the background if those do not already exist.
|
||||
|
||||
### Configuration
|
||||
|
||||
`ghcide` accepts the following lsp configuration options:
|
||||
|
||||
```typescript
|
||||
{
|
||||
// When to check the dependents of a module
|
||||
// AlwaysCheck means retypechecking them on every change
|
||||
// CheckOnSave means dependent/parent modules will only be checked when you save
|
||||
// "CheckOnSaveAndClose" by default
|
||||
checkParents : "NeverCheck" | "CheckOnClose" | "CheckOnSaveAndClose" | "AlwaysCheck" | ,
|
||||
// Whether to check the entire project on initial load
|
||||
// true by default
|
||||
checkProject : boolean
|
||||
|
||||
}
|
||||
```
|
||||
|
||||
### Using with VS Code
|
||||
|
||||
You can install the VSCode extension from the [VSCode
|
||||
|
17
exe/Main.hs
17
exe/Main.hs
@ -8,6 +8,7 @@ module Main(main) where
|
||||
import Arguments
|
||||
import Control.Concurrent.Extra
|
||||
import Control.Monad.Extra
|
||||
import Control.Lens ( (^.) )
|
||||
import Data.Default
|
||||
import Data.List.Extra
|
||||
import Data.Maybe
|
||||
@ -33,6 +34,7 @@ import Development.IDE.Session
|
||||
import qualified Language.Haskell.LSP.Core as LSP
|
||||
import Language.Haskell.LSP.Messages
|
||||
import Language.Haskell.LSP.Types
|
||||
import Language.Haskell.LSP.Types.Lens (params, initializationOptions)
|
||||
import Development.IDE.LSP.LanguageServer
|
||||
import qualified System.Directory.Extra as IO
|
||||
import System.Environment
|
||||
@ -44,6 +46,7 @@ import System.Time.Extra
|
||||
import Paths_ghcide
|
||||
import Development.GitRev
|
||||
import qualified Data.HashSet as HashSet
|
||||
import qualified Data.Aeson as J
|
||||
|
||||
import HIE.Bios.Cradle
|
||||
|
||||
@ -78,8 +81,13 @@ main = do
|
||||
command <- makeLspCommandId "typesignature.add"
|
||||
|
||||
let plugins = Completions.plugin <> CodeAction.plugin
|
||||
onInitialConfiguration = const $ Right ()
|
||||
onConfigurationChange = const $ Right ()
|
||||
onInitialConfiguration :: InitializeRequest -> Either T.Text LspConfig
|
||||
onInitialConfiguration x = case x ^. params . initializationOptions of
|
||||
Nothing -> Right defaultLspConfig
|
||||
Just v -> case J.fromJSON v of
|
||||
J.Error err -> Left $ T.pack err
|
||||
J.Success a -> Right a
|
||||
onConfigurationChange = const $ Left "Updating Not supported"
|
||||
options = def { LSP.executeCommandCommands = Just [command]
|
||||
, LSP.completionTriggerCharacters = Just "."
|
||||
}
|
||||
@ -88,15 +96,18 @@ main = do
|
||||
t <- offsetTime
|
||||
hPutStrLn stderr "Starting LSP server..."
|
||||
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
|
||||
runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg -> do
|
||||
runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig -> do
|
||||
t <- t
|
||||
hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
|
||||
sessionLoader <- loadSession dir
|
||||
config <- fromMaybe defaultLspConfig <$> getConfig
|
||||
let options = (defaultIdeOptions sessionLoader)
|
||||
{ optReportProgress = clientSupportsProgress caps
|
||||
, optShakeProfiling = argsShakeProfiling
|
||||
, optTesting = IdeTesting argsTesting
|
||||
, optThreads = argsThreads
|
||||
, optCheckParents = checkParents config
|
||||
, optCheckProject = checkProject config
|
||||
}
|
||||
logLevel = if argsVerbose then minBound else Info
|
||||
debouncer <- newAsyncDebouncer
|
||||
|
@ -263,6 +263,7 @@ executable ghcide
|
||||
"-with-rtsopts=-I0 -qg -A128M"
|
||||
main-is: Main.hs
|
||||
build-depends:
|
||||
aeson,
|
||||
base == 4.*,
|
||||
data-default,
|
||||
directory,
|
||||
@ -274,6 +275,7 @@ executable ghcide
|
||||
haskell-lsp-types,
|
||||
hie-bios >= 0.6.0 && < 0.7,
|
||||
ghcide,
|
||||
lens,
|
||||
optparse-applicative,
|
||||
text,
|
||||
unordered-containers
|
||||
|
@ -25,6 +25,8 @@ import Data.Bifunctor
|
||||
import qualified Data.ByteString.Base16 as B16
|
||||
import Data.Either.Extra
|
||||
import Data.Function
|
||||
import qualified Data.HashSet as HashSet
|
||||
import Data.Hashable
|
||||
import Data.List
|
||||
import Data.IORef
|
||||
import Data.Maybe
|
||||
@ -32,6 +34,7 @@ import Data.Time.Clock
|
||||
import Data.Version
|
||||
import Development.IDE.Core.OfInterest
|
||||
import Development.IDE.Core.Shake
|
||||
import Development.IDE.Core.RuleTypes
|
||||
import Development.IDE.GHC.Util
|
||||
import Development.IDE.Session.VersionCheck
|
||||
import Development.IDE.Types.Diagnostics
|
||||
@ -47,6 +50,7 @@ import Language.Haskell.LSP.Core
|
||||
import Language.Haskell.LSP.Messages
|
||||
import Language.Haskell.LSP.Types
|
||||
import System.Directory
|
||||
import qualified System.Directory.Extra as IO
|
||||
import System.FilePath
|
||||
import System.Info
|
||||
import System.IO
|
||||
@ -96,8 +100,10 @@ loadSession dir = do
|
||||
runningCradle <- newVar dummyAs :: IO (Var (Async (IdeResult HscEnvEq,[FilePath])))
|
||||
|
||||
return $ do
|
||||
ShakeExtras{logger, eventer, restartShakeSession, withIndefiniteProgress, ideNc} <- getShakeExtras
|
||||
IdeOptions{optTesting = IdeTesting optTesting} <- getIdeOptions
|
||||
ShakeExtras{logger, eventer, restartShakeSession, withIndefiniteProgress
|
||||
,ideNc, knownFilesVar, session=ideSession} <- getShakeExtras
|
||||
|
||||
IdeOptions{optTesting = IdeTesting optTesting, optCheckProject = CheckProject checkProject } <- getIdeOptions
|
||||
|
||||
-- Create a new HscEnv from a hieYaml root and a set of options
|
||||
-- If the hieYaml file already has an HscEnv, the new component is
|
||||
@ -170,7 +176,7 @@ loadSession dir = do
|
||||
|
||||
|
||||
let session :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath)
|
||||
-> IO (IdeResult HscEnvEq,[FilePath])
|
||||
-> IO ([NormalizedFilePath],(IdeResult HscEnvEq,[FilePath]))
|
||||
session args@(hieYaml, _cfp, _opts, _libDir) = do
|
||||
(hscEnv, new, old_deps) <- packageSetup args
|
||||
-- Make a map from unit-id to DynFlags, this is used when trying to
|
||||
@ -194,9 +200,9 @@ loadSession dir = do
|
||||
invalidateShakeCache
|
||||
restartShakeSession [kick]
|
||||
|
||||
return (second Map.keys res)
|
||||
return (map fst cs ++ map fst cached_targets, second Map.keys res)
|
||||
|
||||
let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath])
|
||||
let consultCradle :: Maybe FilePath -> FilePath -> IO ([NormalizedFilePath], (IdeResult HscEnvEq, [FilePath]))
|
||||
consultCradle hieYaml cfp = do
|
||||
when optTesting $ eventer $ notifyCradleLoaded cfp
|
||||
logInfo logger $ T.pack ("Consulting the cradle for " <> show cfp)
|
||||
@ -219,7 +225,7 @@ loadSession dir = do
|
||||
InstallationNotFound{..} ->
|
||||
error $ "GHC installation not found in libdir: " <> libdir
|
||||
InstallationMismatch{..} ->
|
||||
return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[])
|
||||
return ([],(([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[]))
|
||||
InstallationChecked _compileTime _ghcLibCheck ->
|
||||
session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
|
||||
-- Failure case, either a cradle error or the none cradle
|
||||
@ -229,11 +235,12 @@ loadSession dir = do
|
||||
let res = (map (renderCradleError ncfp) err, Nothing)
|
||||
modifyVar_ fileToFlags $ \var -> do
|
||||
pure $ Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) var
|
||||
return (res,[])
|
||||
return ([ncfp],(res,[]))
|
||||
|
||||
-- This caches the mapping from hie.yaml + Mod.hs -> [String]
|
||||
-- Returns the Ghc session and the cradle dependencies
|
||||
let sessionOpts :: (Maybe FilePath, FilePath) -> IO (IdeResult HscEnvEq, [FilePath])
|
||||
let sessionOpts :: (Maybe FilePath, FilePath)
|
||||
-> IO ([NormalizedFilePath], (IdeResult HscEnvEq, [FilePath]))
|
||||
sessionOpts (hieYaml, file) = do
|
||||
v <- fromMaybe HM.empty . Map.lookup hieYaml <$> readVar fileToFlags
|
||||
cfp <- canonicalizePath file
|
||||
@ -248,25 +255,38 @@ loadSession dir = do
|
||||
-- Keep the same name cache
|
||||
modifyVar_ hscEnvs (return . Map.adjust (\(h, _) -> (h, [])) hieYaml )
|
||||
consultCradle hieYaml cfp
|
||||
else return (opts, Map.keys old_di)
|
||||
else return (HM.keys v, (opts, Map.keys old_di))
|
||||
Nothing -> consultCradle hieYaml cfp
|
||||
|
||||
-- The main function which gets options for a file. We only want one of these running
|
||||
-- at a time. Therefore the IORef contains the currently running cradle, if we try
|
||||
-- to get some more options then we wait for the currently running action to finish
|
||||
-- before attempting to do so.
|
||||
let getOptions :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])
|
||||
let getOptions :: FilePath -> IO ([NormalizedFilePath],(IdeResult HscEnvEq, [FilePath]))
|
||||
getOptions file = do
|
||||
hieYaml <- cradleLoc file
|
||||
sessionOpts (hieYaml, file) `catch` \e ->
|
||||
return (([renderPackageSetupException file e], Nothing),[])
|
||||
return ([],(([renderPackageSetupException file e], Nothing),[]))
|
||||
|
||||
returnWithVersion $ \file -> do
|
||||
liftIO $ join $ mask_ $ modifyVar runningCradle $ \as -> do
|
||||
(cs, opts) <- liftIO $ join $ mask_ $ modifyVar runningCradle $ \as -> do
|
||||
-- If the cradle is not finished, then wait for it to finish.
|
||||
void $ wait as
|
||||
as <- async $ getOptions file
|
||||
return (as, wait as)
|
||||
return (fmap snd as, wait as)
|
||||
unless (null cs) $
|
||||
-- Typecheck all files in the project on startup
|
||||
void $ shakeEnqueueSession ideSession $ mkDelayedAction "InitialLoad" Debug $ void $ do
|
||||
cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) cs
|
||||
-- populate the knownFilesVar with all the
|
||||
-- files in the project so that `knownFiles` can learn about them and
|
||||
-- we can generate a complete module graph
|
||||
liftIO $ modifyVar_ knownFilesVar $ traverseHashed $ pure . HashSet.union (HashSet.fromList cfps')
|
||||
mmt <- uses GetModificationTime cfps'
|
||||
let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
|
||||
when checkProject $
|
||||
void $ uses GetModIface cs_exist
|
||||
pure opts
|
||||
|
||||
-- | Run the specific cradle on a specific FilePath via hie-bios.
|
||||
-- This then builds dependencies or whatever based on the cradle, gets the
|
||||
|
@ -19,7 +19,7 @@ module Development.IDE.Core.Compile
|
||||
, mkTcModuleResult
|
||||
, generateByteCode
|
||||
, generateAndWriteHieFile
|
||||
, generateAndWriteHiFile
|
||||
, writeHiFile
|
||||
, getModSummaryFromImports
|
||||
, loadHieFile
|
||||
, loadInterface
|
||||
@ -133,9 +133,10 @@ typecheckModule (IdeDefer defer) hsc pm = do
|
||||
(warnings, tcm) <- withWarnings "typecheck" $ \tweak ->
|
||||
GHC.typecheckModule $ enableTopLevelWarnings
|
||||
$ demoteIfDefer pm{pm_mod_summary = tweak modSummary'}
|
||||
tcm2 <- mkTcModuleResult tcm
|
||||
let errorPipeline = unDefer . hideDiag dflags
|
||||
return (map errorPipeline warnings, tcm2)
|
||||
diags = map errorPipeline warnings
|
||||
tcm2 <- mkTcModuleResult tcm (any fst diags)
|
||||
return (map snd diags, tcm2)
|
||||
where
|
||||
demoteIfDefer = if defer then demoteTypeErrorsToWarnings else id
|
||||
|
||||
@ -233,11 +234,11 @@ update_pm_mod_summary :: (ModSummary -> ModSummary) -> ParsedModule -> ParsedMod
|
||||
update_pm_mod_summary up pm =
|
||||
pm{pm_mod_summary = up $ pm_mod_summary pm}
|
||||
|
||||
unDefer :: (WarnReason, FileDiagnostic) -> FileDiagnostic
|
||||
unDefer (Reason Opt_WarnDeferredTypeErrors , fd) = upgradeWarningToError fd
|
||||
unDefer (Reason Opt_WarnTypedHoles , fd) = upgradeWarningToError fd
|
||||
unDefer (Reason Opt_WarnDeferredOutOfScopeVariables, fd) = upgradeWarningToError fd
|
||||
unDefer ( _ , fd) = fd
|
||||
unDefer :: (WarnReason, FileDiagnostic) -> (Bool, FileDiagnostic)
|
||||
unDefer (Reason Opt_WarnDeferredTypeErrors , fd) = (True, upgradeWarningToError fd)
|
||||
unDefer (Reason Opt_WarnTypedHoles , fd) = (True, upgradeWarningToError fd)
|
||||
unDefer (Reason Opt_WarnDeferredOutOfScopeVariables, fd) = (True, upgradeWarningToError fd)
|
||||
unDefer ( _ , fd) = (False, fd)
|
||||
|
||||
upgradeWarningToError :: FileDiagnostic -> FileDiagnostic
|
||||
upgradeWarningToError (nfp, sh, fd) =
|
||||
@ -257,8 +258,9 @@ addRelativeImport fp modu dflags = dflags
|
||||
mkTcModuleResult
|
||||
:: GhcMonad m
|
||||
=> TypecheckedModule
|
||||
-> Bool
|
||||
-> m TcModuleResult
|
||||
mkTcModuleResult tcm = do
|
||||
mkTcModuleResult tcm upgradedError = do
|
||||
session <- getSession
|
||||
let sf = modInfoSafe (tm_checked_module_info tcm)
|
||||
#if MIN_GHC_API_VERSION(8,10,0)
|
||||
@ -267,7 +269,7 @@ mkTcModuleResult tcm = do
|
||||
(iface, _) <- liftIO $ mkIfaceTc session Nothing sf details tcGblEnv
|
||||
#endif
|
||||
let mod_info = HomeModInfo iface details Nothing
|
||||
return $ TcModuleResult tcm mod_info
|
||||
return $ TcModuleResult tcm mod_info upgradedError
|
||||
where
|
||||
(tcGblEnv, details) = tm_internals_ tcm
|
||||
|
||||
@ -294,8 +296,8 @@ generateAndWriteHieFile hscEnv tcm =
|
||||
mod_location = ms_location mod_summary
|
||||
targetPath = Compat.ml_hie_file mod_location
|
||||
|
||||
generateAndWriteHiFile :: HscEnv -> TcModuleResult -> IO [FileDiagnostic]
|
||||
generateAndWriteHiFile hscEnv tc =
|
||||
writeHiFile :: HscEnv -> TcModuleResult -> IO [FileDiagnostic]
|
||||
writeHiFile hscEnv tc =
|
||||
handleGenerationErrors dflags "interface generation" $ do
|
||||
atomicFileWrite targetPath $ \fp ->
|
||||
writeIfaceFile dflags fp modIface
|
||||
|
@ -11,6 +11,7 @@ module Development.IDE.Core.FileStore(
|
||||
setSomethingModified,
|
||||
fileStoreRules,
|
||||
modificationTime,
|
||||
typecheckParents,
|
||||
VFSHandle,
|
||||
makeVFSHandle,
|
||||
makeLSPVFSHandle
|
||||
@ -37,6 +38,7 @@ import Development.IDE.Types.Location
|
||||
import Development.IDE.Core.OfInterest (kick)
|
||||
import Development.IDE.Core.RuleTypes
|
||||
import qualified Data.Rope.UTF16 as Rope
|
||||
import Development.IDE.Import.DependencyInformation
|
||||
|
||||
#ifdef mingw32_HOST_OS
|
||||
import qualified System.Directory as Dir
|
||||
@ -202,8 +204,14 @@ setBufferModified state absFile contents = do
|
||||
|
||||
-- | Note that some buffer for a specific file has been modified but not
|
||||
-- with what changes.
|
||||
setFileModified :: IdeState -> NormalizedFilePath -> IO ()
|
||||
setFileModified state nfp = do
|
||||
setFileModified :: IdeState
|
||||
-> Bool -- ^ True indicates that we should also attempt to recompile
|
||||
-- modules which depended on this file. Currently
|
||||
-- it is true when saving but not on normal
|
||||
-- document modification events
|
||||
-> NormalizedFilePath
|
||||
-> IO ()
|
||||
setFileModified state prop nfp = do
|
||||
VFSHandle{..} <- getIdeGlobalState state
|
||||
when (isJust setVirtualFileContents) $
|
||||
fail "setSomethingModified can't be called on this type of VFSHandle"
|
||||
@ -213,6 +221,22 @@ setFileModified state nfp = do
|
||||
void $ use GetSpanInfo nfp
|
||||
liftIO $ progressUpdate KickCompleted
|
||||
shakeRestart state [da]
|
||||
when prop $
|
||||
typecheckParents state nfp
|
||||
|
||||
typecheckParents :: IdeState -> NormalizedFilePath -> IO ()
|
||||
typecheckParents state nfp = void $ shakeEnqueue state parents
|
||||
where parents = mkDelayedAction "ParentTC" L.Debug (typecheckParentsAction nfp)
|
||||
|
||||
typecheckParentsAction :: NormalizedFilePath -> Action ()
|
||||
typecheckParentsAction nfp = do
|
||||
revs <- reverseDependencies nfp <$> useNoFile_ GetModuleGraph
|
||||
logger <- logger <$> getShakeExtras
|
||||
let log = L.logInfo logger . T.pack
|
||||
liftIO $ do
|
||||
(log $ "Typechecking reverse dependencies for" ++ show nfp ++ ": " ++ show revs)
|
||||
`catch` \(e :: SomeException) -> log (show e)
|
||||
() <$ uses GetModIface revs
|
||||
|
||||
-- | Note that some buffer somewhere has been modified, but don't say what.
|
||||
-- Only valid if the virtual file system was initialised by LSP, as that
|
||||
|
@ -80,8 +80,6 @@ modifyFilesOfInterest state f = do
|
||||
OfInterestVar var <- getIdeGlobalState state
|
||||
files <- modifyVar var $ pure . dupe . f
|
||||
logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show $ HashSet.toList files)
|
||||
let das = map (\nfp -> mkDelayedAction "OfInterest" Debug (use GetSpanInfo nfp)) (HashSet.toList files)
|
||||
shakeRestart state das
|
||||
|
||||
-- | Typecheck all the files of interest.
|
||||
-- Could be improved
|
||||
|
@ -19,6 +19,7 @@ import Development.IDE.GHC.Util
|
||||
import Data.Hashable
|
||||
import Data.Typeable
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.HashSet as HS
|
||||
import Development.Shake
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
@ -28,6 +29,7 @@ import HscTypes (hm_iface, CgGuts, Linkable, HomeModInfo, ModDetails)
|
||||
import Development.IDE.Spans.Type
|
||||
import Development.IDE.Import.FindImports (ArtifactsLocation)
|
||||
import Data.ByteString (ByteString)
|
||||
import Language.Haskell.LSP.Types (NormalizedFilePath)
|
||||
|
||||
|
||||
-- NOTATION
|
||||
@ -46,11 +48,21 @@ type instance RuleResult GetDependencyInformation = DependencyInformation
|
||||
-- This rule is also responsible for calling ReportImportCycles for each file in the transitive closure.
|
||||
type instance RuleResult GetDependencies = TransitiveDependencies
|
||||
|
||||
type instance RuleResult GetModuleGraph = DependencyInformation
|
||||
|
||||
data GetKnownFiles = GetKnownFiles
|
||||
deriving (Show, Generic, Eq, Ord)
|
||||
instance Hashable GetKnownFiles
|
||||
instance NFData GetKnownFiles
|
||||
instance Binary GetKnownFiles
|
||||
type instance RuleResult GetKnownFiles = HS.HashSet NormalizedFilePath
|
||||
|
||||
-- | Contains the typechecked module and the OrigNameCache entry for
|
||||
-- that module.
|
||||
data TcModuleResult = TcModuleResult
|
||||
{ tmrModule :: TypecheckedModule
|
||||
, tmrModInfo :: HomeModInfo
|
||||
, tmrDeferedError :: !Bool -- ^ Did we defer any type errors for this module?
|
||||
}
|
||||
instance Show TcModuleResult where
|
||||
show = show . pm_mod_summary . tm_parsed_module . tmrModule
|
||||
@ -145,6 +157,12 @@ instance Hashable GetDependencyInformation
|
||||
instance NFData GetDependencyInformation
|
||||
instance Binary GetDependencyInformation
|
||||
|
||||
data GetModuleGraph = GetModuleGraph
|
||||
deriving (Eq, Show, Typeable, Generic)
|
||||
instance Hashable GetModuleGraph
|
||||
instance NFData GetModuleGraph
|
||||
instance Binary GetModuleGraph
|
||||
|
||||
data ReportImportCycles = ReportImportCycles
|
||||
deriving (Eq, Show, Typeable, Generic)
|
||||
instance Hashable ReportImportCycles
|
||||
|
@ -87,6 +87,8 @@ import Control.Monad.State
|
||||
import FastString (FastString(uniq))
|
||||
import qualified HeaderInfo as Hdr
|
||||
import Data.Time (UTCTime(..))
|
||||
import Data.Hashable
|
||||
import qualified Data.HashSet as HashSet
|
||||
|
||||
-- | This is useful for rules to convert rules that can only produce errors or
|
||||
-- a result into the more general IdeResult type that supports producing
|
||||
@ -297,14 +299,18 @@ getLocatedImportsRule :: Rules ()
|
||||
getLocatedImportsRule =
|
||||
define $ \GetLocatedImports file -> do
|
||||
ms <- use_ GetModSummaryWithoutTimestamps file
|
||||
targets <- useNoFile_ GetKnownFiles
|
||||
let imports = [(False, imp) | imp <- ms_textual_imps ms] ++ [(True, imp) | imp <- ms_srcimps ms]
|
||||
env_eq <- use_ GhcSession file
|
||||
let env = hscEnv env_eq
|
||||
let env = hscEnvWithImportPaths env_eq
|
||||
let import_dirs = deps env_eq
|
||||
let dflags = addRelativeImport file (moduleName $ ms_mod ms) $ hsc_dflags env
|
||||
opt <- getIdeOptions
|
||||
let getTargetExists nfp
|
||||
| HashSet.null targets || nfp `HashSet.member` targets = getFileExists nfp
|
||||
| otherwise = return False
|
||||
(diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do
|
||||
diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getFileExists modName mbPkgName isSource
|
||||
diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetExists modName mbPkgName isSource
|
||||
case diagOrImp of
|
||||
Left diags -> pure (diags, Left (modName, Nothing))
|
||||
Right (FileImport path) -> pure ([], Left (modName, Just path))
|
||||
@ -500,6 +506,18 @@ typeCheckRule = define $ \TypeCheck file -> do
|
||||
-- for files of interest on every keystroke
|
||||
typeCheckRuleDefinition hsc pm SkipGenerationOfInterfaceFiles
|
||||
|
||||
knownFilesRule :: Rules ()
|
||||
knownFilesRule = defineEarlyCutOffNoFile $ \GetKnownFiles -> do
|
||||
alwaysRerun
|
||||
fs <- knownFiles
|
||||
pure (BS.pack (show $ hash fs), unhashed fs)
|
||||
|
||||
getModuleGraphRule :: Rules ()
|
||||
getModuleGraphRule = defineNoFile $ \GetModuleGraph -> do
|
||||
fs <- useNoFile_ GetKnownFiles
|
||||
rawDepInfo <- rawDependencyInformation (HashSet.toList fs)
|
||||
pure $ processDependencyInformation rawDepInfo
|
||||
|
||||
data GenerateInterfaceFiles
|
||||
= DoGenerateInterfaceFiles
|
||||
| SkipGenerationOfInterfaceFiles
|
||||
@ -521,9 +539,14 @@ typeCheckRuleDefinition hsc pm generateArtifacts = do
|
||||
addUsageDependencies $ liftIO $ do
|
||||
res <- typecheckModule defer hsc pm
|
||||
case res of
|
||||
(diags, Just (hsc,tcm)) | DoGenerateInterfaceFiles <- generateArtifacts -> do
|
||||
(diags, Just (hsc,tcm))
|
||||
| DoGenerateInterfaceFiles <- generateArtifacts
|
||||
-- Don't save interface files for modules that compiled due to defering
|
||||
-- type errors, as we won't get proper diagnostics if we load these from
|
||||
-- disk
|
||||
, not $ tmrDeferedError tcm -> do
|
||||
diagsHie <- generateAndWriteHieFile hsc (tmrModule tcm)
|
||||
diagsHi <- generateAndWriteHiFile hsc tcm
|
||||
diagsHi <- writeHiFile hsc tcm
|
||||
return (diags <> diagsHi <> diagsHie, Just tcm)
|
||||
(diags, res) ->
|
||||
return (diags, snd <$> res)
|
||||
@ -802,6 +825,8 @@ mainRule = do
|
||||
isFileOfInterestRule
|
||||
getModSummaryRule
|
||||
isHiFileStableRule
|
||||
getModuleGraphRule
|
||||
knownFilesRule
|
||||
|
||||
-- | Given the path to a module src file, this rule returns True if the
|
||||
-- corresponding `.hi` file is stable, that is, if it is newer
|
||||
|
@ -28,7 +28,7 @@ module Development.IDE.Core.Shake(
|
||||
GetModificationTime(GetModificationTime, GetModificationTime_, missingFileDiagnostics),
|
||||
shakeOpen, shakeShut,
|
||||
shakeRestart,
|
||||
shakeEnqueue,
|
||||
shakeEnqueue, shakeEnqueueSession,
|
||||
shakeProfile,
|
||||
use, useNoFile, uses, useWithStaleFast, useWithStaleFast', delayedAction,
|
||||
FastResult(..),
|
||||
@ -44,6 +44,7 @@ module Development.IDE.Core.Shake(
|
||||
getIdeOptionsIO,
|
||||
GlobalIdeOptions(..),
|
||||
garbageCollect,
|
||||
knownFiles,
|
||||
setPriority,
|
||||
sendEvent,
|
||||
ideLogger,
|
||||
@ -67,6 +68,7 @@ import Development.Shake.Database
|
||||
import Development.Shake.Classes
|
||||
import Development.Shake.Rule
|
||||
import qualified Data.HashMap.Strict as HMap
|
||||
import qualified Data.HashSet as HSet
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Data.Dynamic
|
||||
@ -111,6 +113,7 @@ import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Traversable
|
||||
import Data.Hashable
|
||||
|
||||
import Data.IORef
|
||||
import NameCache
|
||||
@ -148,7 +151,8 @@ data ShakeExtras = ShakeExtras
|
||||
,withIndefiniteProgress :: WithIndefiniteProgressFunc
|
||||
-- ^ Same as 'withProgress', but for processes that do not report the percentage complete
|
||||
,restartShakeSession :: [DelayedAction ()] -> IO ()
|
||||
, ideNc :: IORef NameCache
|
||||
,ideNc :: IORef NameCache
|
||||
,knownFilesVar :: Var (Hashed (HSet.HashSet NormalizedFilePath))
|
||||
}
|
||||
|
||||
type WithProgressFunc = forall a.
|
||||
@ -358,6 +362,12 @@ getValues state key file = do
|
||||
-- (which would be an internal error).
|
||||
evaluate (r `seqValue` Just r)
|
||||
|
||||
-- | Get all the files in the project
|
||||
knownFiles :: Action (Hashed (HSet.HashSet NormalizedFilePath))
|
||||
knownFiles = do
|
||||
ShakeExtras{knownFilesVar} <- getShakeExtras
|
||||
liftIO $ readVar knownFilesVar
|
||||
|
||||
-- | Seq the result stored in the Shake value. This only
|
||||
-- evaluates the value to WHNF not NF. We take care of the latter
|
||||
-- elsewhere and doing it twice is expensive.
|
||||
@ -393,6 +403,7 @@ shakeOpen getLspId eventer withProgress withIndefiniteProgress logger debouncer
|
||||
hiddenDiagnostics <- newVar mempty
|
||||
publishedDiagnostics <- newVar mempty
|
||||
positionMapping <- newVar HMap.empty
|
||||
knownFilesVar <- newVar $ hashed HSet.empty
|
||||
let restartShakeSession = shakeRestart ideState
|
||||
let session = shakeSession
|
||||
mostRecentProgressEvent <- newTVarIO KickCompleted
|
||||
|
@ -6,6 +6,7 @@ module Development.IDE.GHC.Util(
|
||||
-- * HcsEnv and environment
|
||||
HscEnvEq,
|
||||
hscEnv, newHscEnvEq,
|
||||
hscEnvWithImportPaths,
|
||||
modifyDynFlags,
|
||||
evalGhcEnv,
|
||||
runGhcEnv,
|
||||
@ -169,36 +170,46 @@ moduleImportPath (takeDirectory . fromNormalizedFilePath -> pathDir) mn
|
||||
|
||||
-- | An 'HscEnv' with equality. Two values are considered equal
|
||||
-- if they are created with the same call to 'newHscEnvEq'.
|
||||
data HscEnvEq
|
||||
= HscEnvEq !Unique !HscEnv
|
||||
[(InstalledUnitId, DynFlags)] -- In memory components for this HscEnv
|
||||
data HscEnvEq = HscEnvEq
|
||||
{ envUnique :: !Unique
|
||||
, hscEnv :: !HscEnv
|
||||
, deps :: [(InstalledUnitId, DynFlags)]
|
||||
-- ^ In memory components for this HscEnv
|
||||
-- This is only used at the moment for the import dirs in
|
||||
-- the DynFlags
|
||||
|
||||
-- | Unwrap an 'HsEnvEq'.
|
||||
hscEnv :: HscEnvEq -> HscEnv
|
||||
hscEnv = either error id . hscEnv'
|
||||
|
||||
hscEnv' :: HscEnvEq -> Either String HscEnv
|
||||
hscEnv' (HscEnvEq _ x _) = Right x
|
||||
deps :: HscEnvEq -> [(InstalledUnitId, DynFlags)]
|
||||
deps (HscEnvEq _ _ u) = u
|
||||
, envImportPaths :: [String]
|
||||
-- ^ Import dirs originally configured in this env
|
||||
-- We remove them to prevent GHC from loading modules on its own
|
||||
}
|
||||
|
||||
-- | Wrap an 'HscEnv' into an 'HscEnvEq'.
|
||||
newHscEnvEq :: HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq
|
||||
newHscEnvEq e uids = do u <- newUnique; return $ HscEnvEq u e uids
|
||||
newHscEnvEq hscEnv0 deps = do
|
||||
envUnique <- newUnique
|
||||
let envImportPaths = importPaths $ hsc_dflags hscEnv0
|
||||
hscEnv = removeImportPaths hscEnv0
|
||||
return HscEnvEq{..}
|
||||
|
||||
-- | Unwrap the 'HscEnv' with the original import paths.
|
||||
-- Used only for locating imports
|
||||
hscEnvWithImportPaths :: HscEnvEq -> HscEnv
|
||||
hscEnvWithImportPaths HscEnvEq{..} =
|
||||
hscEnv{hsc_dflags = (hsc_dflags hscEnv){importPaths = envImportPaths}}
|
||||
|
||||
removeImportPaths :: HscEnv -> HscEnv
|
||||
removeImportPaths hsc = hsc{hsc_dflags = (hsc_dflags hsc){importPaths = []}}
|
||||
|
||||
instance Show HscEnvEq where
|
||||
show (HscEnvEq a _ _) = "HscEnvEq " ++ show (hashUnique a)
|
||||
show HscEnvEq{envUnique} = "HscEnvEq " ++ show (hashUnique envUnique)
|
||||
|
||||
instance Eq HscEnvEq where
|
||||
HscEnvEq a _ _ == HscEnvEq b _ _ = a == b
|
||||
a == b = envUnique a == envUnique b
|
||||
|
||||
instance NFData HscEnvEq where
|
||||
rnf (HscEnvEq a b c) = rnf (hashUnique a) `seq` b `seq` c `seq` ()
|
||||
rnf (HscEnvEq a b c d) = rnf (hashUnique a) `seq` b `seq` c `seq` rnf d
|
||||
|
||||
instance Hashable HscEnvEq where
|
||||
hashWithSalt s (HscEnvEq a _b _c) = hashWithSalt s a
|
||||
hashWithSalt s = hashWithSalt s . envUnique
|
||||
|
||||
-- Fake instance needed to persuade Shake to accept this type as a key.
|
||||
-- No harm done as ghcide never persists these keys currently
|
||||
|
@ -21,6 +21,7 @@ module Development.IDE.Import.DependencyInformation
|
||||
, reachableModules
|
||||
, processDependencyInformation
|
||||
, transitiveDeps
|
||||
, reverseDependencies
|
||||
|
||||
, BootIdMap
|
||||
, insertBootId
|
||||
@ -142,6 +143,8 @@ data DependencyInformation =
|
||||
, depModuleDeps :: !(FilePathIdMap FilePathIdSet)
|
||||
-- ^ For a non-error node, this contains the set of module immediate dependencies
|
||||
-- in the same package.
|
||||
, depReverseModuleDeps :: !(IntMap IntSet)
|
||||
-- ^ Contains a reverse mapping from a module to all those that immediately depend on it.
|
||||
, depPkgDeps :: !(FilePathIdMap (Set InstalledUnitId))
|
||||
-- ^ For a non-error node, this contains the set of immediate pkg deps.
|
||||
, depPathIdMap :: !PathIdMap
|
||||
@ -222,6 +225,7 @@ processDependencyInformation rawDepInfo@RawDependencyInformation{..} =
|
||||
DependencyInformation
|
||||
{ depErrorNodes = IntMap.fromList errorNodes
|
||||
, depModuleDeps = moduleDeps
|
||||
, depReverseModuleDeps = reverseModuleDeps
|
||||
, depModuleNames = IntMap.fromList $ coerce moduleNames
|
||||
, depPkgDeps = pkgDependencies rawDepInfo
|
||||
, depPathIdMap = rawPathIdMap
|
||||
@ -232,15 +236,20 @@ processDependencyInformation rawDepInfo@RawDependencyInformation{..} =
|
||||
moduleNames :: [(FilePathId, ModuleName)]
|
||||
moduleNames =
|
||||
[ (fId, modName) | (_, imports) <- successNodes, (L _ modName, fId) <- imports]
|
||||
successEdges :: [(FilePathId, FilePathId, [FilePathId])]
|
||||
successEdges :: [(FilePathId, [FilePathId])]
|
||||
successEdges =
|
||||
map
|
||||
(\(file, imports) -> (FilePathId file, FilePathId file, map snd imports))
|
||||
(bimap FilePathId (map snd))
|
||||
successNodes
|
||||
moduleDeps =
|
||||
IntMap.fromList $
|
||||
map (\(_, FilePathId v, vs) -> (v, IntSet.fromList $ coerce vs))
|
||||
map (\(FilePathId v, vs) -> (v, IntSet.fromList $ coerce vs))
|
||||
successEdges
|
||||
reverseModuleDeps =
|
||||
foldr (\(p, cs) res ->
|
||||
let new = IntMap.fromList (map (, IntSet.singleton (coerce p)) (coerce cs))
|
||||
in IntMap.unionWith IntSet.union new res ) IntMap.empty successEdges
|
||||
|
||||
|
||||
-- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows:
|
||||
-- 1. Mark each node that is part of an import cycle as an error node.
|
||||
@ -306,6 +315,18 @@ partitionSCC (CyclicSCC xs:rest) = second (xs:) $ partitionSCC rest
|
||||
partitionSCC (AcyclicSCC x:rest) = first (x:) $ partitionSCC rest
|
||||
partitionSCC [] = ([], [])
|
||||
|
||||
-- | Transitive reverse dependencies of a file
|
||||
reverseDependencies :: NormalizedFilePath -> DependencyInformation -> [NormalizedFilePath]
|
||||
reverseDependencies file DependencyInformation{..} =
|
||||
let FilePathId cur_id = pathToId depPathIdMap file
|
||||
in map (idToPath depPathIdMap . FilePathId) (IntSet.toList (go cur_id IntSet.empty))
|
||||
where
|
||||
go :: Int -> IntSet -> IntSet
|
||||
go k i =
|
||||
let outwards = fromMaybe IntSet.empty (IntMap.lookup k depReverseModuleDeps )
|
||||
res = IntSet.union i outwards
|
||||
new = IntSet.difference i outwards
|
||||
in IntSet.foldr go res new
|
||||
|
||||
transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe TransitiveDependencies
|
||||
transitiveDeps DependencyInformation{..} file = do
|
||||
|
@ -46,7 +46,7 @@ runLanguageServer
|
||||
-> (InitializeRequest -> Either T.Text config)
|
||||
-> (DidChangeConfigurationNotification -> Either T.Text config)
|
||||
-> (IO LspId -> (FromServerMessage -> IO ()) -> VFSHandle -> ClientCapabilities
|
||||
-> WithProgressFunc -> WithIndefiniteProgressFunc -> IO IdeState)
|
||||
-> WithProgressFunc -> WithIndefiniteProgressFunc -> IO (Maybe config) -> IO IdeState)
|
||||
-> IO ()
|
||||
runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeState = do
|
||||
-- Move stdout to another file descriptor and duplicate stderr
|
||||
@ -133,7 +133,7 @@ runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeStat
|
||||
handleInit exitClientMsg clearReqId waitForCancel clientMsgChan lspFuncs@LSP.LspFuncs{..} = do
|
||||
|
||||
ide <- getIdeState getNextReqId sendFunc (makeLSPVFSHandle lspFuncs) clientCapabilities
|
||||
withProgress withIndefiniteProgress
|
||||
withProgress withIndefiniteProgress config
|
||||
|
||||
_ <- flip forkFinally (const exitClientMsg) $ forever $ do
|
||||
msg <- readChan clientMsgChan
|
||||
|
@ -15,8 +15,10 @@ import qualified Language.Haskell.LSP.Types as LSP
|
||||
|
||||
import Development.IDE.Core.IdeConfiguration
|
||||
import Development.IDE.Core.Service
|
||||
import Development.IDE.Core.Shake
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Logger
|
||||
import Development.IDE.Types.Options
|
||||
|
||||
import Control.Monad.Extra
|
||||
import Data.Foldable as F
|
||||
@ -24,7 +26,7 @@ import Data.Maybe
|
||||
import qualified Data.HashSet as S
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import Development.IDE.Core.FileStore (setSomethingModified, setFileModified)
|
||||
import Development.IDE.Core.FileStore (setSomethingModified, setFileModified, typecheckParents)
|
||||
import Development.IDE.Core.FileExists (modifyFileExists)
|
||||
import Development.IDE.Core.OfInterest
|
||||
|
||||
@ -37,26 +39,35 @@ setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x
|
||||
{LSP.didOpenTextDocumentNotificationHandler = withNotification (LSP.didOpenTextDocumentNotificationHandler x) $
|
||||
\_ ide (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> do
|
||||
updatePositionMapping ide (VersionedTextDocumentIdentifier _uri (Just _version)) (List [])
|
||||
IdeOptions{optCheckParents} <- getIdeOptionsIO $ shakeExtras ide
|
||||
whenUriFile _uri $ \file -> do
|
||||
modifyFilesOfInterest ide (S.insert file)
|
||||
setFileModified ide file
|
||||
let checkParents = optCheckParents == AlwaysCheck
|
||||
setFileModified ide checkParents file
|
||||
logInfo (ideLogger ide) $ "Opened text document: " <> getUri _uri
|
||||
|
||||
,LSP.didChangeTextDocumentNotificationHandler = withNotification (LSP.didChangeTextDocumentNotificationHandler x) $
|
||||
\_ ide (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> do
|
||||
updatePositionMapping ide identifier changes
|
||||
whenUriFile _uri $ \file -> setFileModified ide file
|
||||
IdeOptions{optCheckParents} <- getIdeOptionsIO $ shakeExtras ide
|
||||
let checkParents = optCheckParents == AlwaysCheck
|
||||
whenUriFile _uri $ \file -> setFileModified ide checkParents file
|
||||
logInfo (ideLogger ide) $ "Modified text document: " <> getUri _uri
|
||||
|
||||
,LSP.didSaveTextDocumentNotificationHandler = withNotification (LSP.didSaveTextDocumentNotificationHandler x) $
|
||||
\_ ide (DidSaveTextDocumentParams TextDocumentIdentifier{_uri}) -> do
|
||||
whenUriFile _uri $ \file -> setFileModified ide file
|
||||
IdeOptions{optCheckParents} <- getIdeOptionsIO $ shakeExtras ide
|
||||
let checkParents = optCheckParents >= CheckOnSaveAndClose
|
||||
whenUriFile _uri $ \file -> setFileModified ide checkParents file
|
||||
logInfo (ideLogger ide) $ "Saved text document: " <> getUri _uri
|
||||
|
||||
,LSP.didCloseTextDocumentNotificationHandler = withNotification (LSP.didCloseTextDocumentNotificationHandler x) $
|
||||
\_ ide (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> do
|
||||
whenUriFile _uri $ \file -> do
|
||||
modifyFilesOfInterest ide (S.delete file)
|
||||
-- Refresh all the files that depended on this
|
||||
IdeOptions{optCheckParents} <- getIdeOptionsIO $ shakeExtras ide
|
||||
when (optCheckParents >= CheckOnClose) $ typecheckParents ide file
|
||||
logInfo (ideLogger ide) $ "Closed text document: " <> getUri _uri
|
||||
,LSP.didChangeWatchedFilesNotificationHandler = withNotification (LSP.didChangeWatchedFilesNotificationHandler x) $
|
||||
\_ ide (DidChangeWatchedFilesParams fileEvents) -> do
|
||||
|
@ -2,6 +2,11 @@
|
||||
-- SPDX-License-Identifier: Apache-2.0
|
||||
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
|
||||
{- HLINT ignore "Avoid restricted extensions" -}
|
||||
|
||||
-- | Options
|
||||
module Development.IDE.Types.Options
|
||||
@ -15,6 +20,10 @@ module Development.IDE.Types.Options
|
||||
, defaultIdeOptions
|
||||
, IdeResult
|
||||
, IdeGhcSession(..)
|
||||
, LspConfig(..)
|
||||
, defaultLspConfig
|
||||
, CheckProject(..)
|
||||
, CheckParents(..)
|
||||
) where
|
||||
|
||||
import Development.Shake
|
||||
@ -25,6 +34,8 @@ import qualified Language.Haskell.LSP.Types.Capabilities as LSP
|
||||
import qualified Data.Text as T
|
||||
import Development.IDE.Types.Diagnostics
|
||||
import Control.DeepSeq (NFData(..))
|
||||
import Data.Aeson
|
||||
import GHC.Generics
|
||||
|
||||
data IdeGhcSession = IdeGhcSession
|
||||
{ loadSessionFun :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])
|
||||
@ -73,8 +84,35 @@ data IdeOptions = IdeOptions
|
||||
-- features such as diagnostics and go-to-definition, in
|
||||
-- situations in which they would become unavailable because of
|
||||
-- the presence of type errors, holes or unbound variables.
|
||||
, optCheckProject :: CheckProject
|
||||
-- ^ Whether to typecheck the entire project on load
|
||||
, optCheckParents :: CheckParents
|
||||
-- ^ When to typecheck reverse dependencies of a file
|
||||
}
|
||||
|
||||
newtype CheckProject = CheckProject { shouldCheckProject :: Bool }
|
||||
deriving stock (Eq, Ord, Show)
|
||||
deriving newtype (FromJSON,ToJSON)
|
||||
data CheckParents
|
||||
-- Note that ordering of constructors is meaningful and must be monotonically
|
||||
-- increasing in the scenarios where parents are checked
|
||||
= NeverCheck
|
||||
| CheckOnClose
|
||||
| CheckOnSaveAndClose
|
||||
| AlwaysCheck
|
||||
deriving stock (Eq, Ord, Show, Generic)
|
||||
deriving anyclass (FromJSON, ToJSON)
|
||||
|
||||
data LspConfig
|
||||
= LspConfig
|
||||
{ checkParents :: CheckParents
|
||||
, checkProject :: CheckProject
|
||||
} deriving stock (Eq, Ord, Show, Generic)
|
||||
deriving anyclass (FromJSON, ToJSON)
|
||||
|
||||
defaultLspConfig :: LspConfig
|
||||
defaultLspConfig = LspConfig CheckOnSaveAndClose (CheckProject True)
|
||||
|
||||
data IdePreprocessedSource = IdePreprocessedSource
|
||||
{ preprocWarnings :: [(GHC.SrcSpan, String)]
|
||||
-- ^ Warnings emitted by the preprocessor.
|
||||
@ -107,6 +145,8 @@ defaultIdeOptions session = IdeOptions
|
||||
,optKeywords = haskellKeywords
|
||||
,optDefer = IdeDefer True
|
||||
,optTesting = IdeTesting False
|
||||
,optCheckProject = checkProject defaultLspConfig
|
||||
,optCheckParents = checkParents defaultLspConfig
|
||||
}
|
||||
|
||||
|
||||
|
@ -2821,28 +2821,26 @@ ifaceTHTest = testCase "iface-th-test" $ withoutStackEnv $ runWithExtraFiles "TH
|
||||
|
||||
ifaceErrorTest :: TestTree
|
||||
ifaceErrorTest = testCase "iface-error-test-1" $ withoutStackEnv $ runWithExtraFiles "recomp" $ \dir -> do
|
||||
let aPath = dir </> "A.hs"
|
||||
bPath = dir </> "B.hs"
|
||||
let bPath = dir </> "B.hs"
|
||||
pPath = dir </> "P.hs"
|
||||
|
||||
aSource <- liftIO $ readFileUtf8 aPath -- x = y :: Int
|
||||
bSource <- liftIO $ readFileUtf8 bPath -- y :: Int
|
||||
pSource <- liftIO $ readFileUtf8 pPath -- bar = x :: Int
|
||||
|
||||
bdoc <- createDoc bPath "haskell" bSource
|
||||
pdoc <- createDoc pPath "haskell" pSource
|
||||
expectDiagnostics [("P.hs", [(DsWarning,(4,0), "Top-level binding")]) -- So what we know P has been loaded
|
||||
]
|
||||
|
||||
-- Change y from Int to B
|
||||
changeDoc bdoc [TextDocumentContentChangeEvent Nothing Nothing $ T.unlines ["module B where", "y :: Bool", "y = undefined"]]
|
||||
-- save so that we can that the error propogates to A
|
||||
sendNotification TextDocumentDidSave (DidSaveTextDocumentParams bdoc)
|
||||
|
||||
-- Check that the error propogates to A
|
||||
adoc <- createDoc aPath "haskell" aSource
|
||||
expectDiagnostics
|
||||
[("A.hs", [(DsError, (5, 4), "Couldn't match expected type 'Int' with actual type 'Bool'")])]
|
||||
closeDoc adoc -- Close A
|
||||
|
||||
pdoc <- createDoc pPath "haskell" pSource
|
||||
changeDoc pdoc [TextDocumentContentChangeEvent Nothing Nothing $ pSource <> "\nfoo = y :: Bool" ]
|
||||
-- Now in P we have
|
||||
-- bar = x :: Int
|
||||
|
Loading…
Reference in New Issue
Block a user