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>

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

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

ghcide.cabal

@@ -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

session-loader/Development/IDE/Session.hs

@@ -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

src/Development/IDE/Core/Compile.hs

@@ -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

src/Development/IDE/Core/FileStore.hs

@@ -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

src/Development/IDE/Core/OfInterest.hs

@@ -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

src/Development/IDE/Core/RuleTypes.hs

@@ -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

src/Development/IDE/Core/Rules.hs

@@ -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

src/Development/IDE/Core/Shake.hs

@@ -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

src/Development/IDE/GHC/Util.hs

@@ -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

src/Development/IDE/Import/DependencyInformation.hs

@@ -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

src/Development/IDE/LSP/LanguageServer.hs

@@ -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

src/Development/IDE/LSP/Notifications.hs

@@ -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

src/Development/IDE/Types/Options.hs

@@ -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
     }
 
 

test/exe/Main.hs

@@ -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