revert ghcide

ghcide/ghcide.cabal

@@ -171,8 +171,10 @@ library
     Development.IDE.GHC.Util
     Development.IDE.Import.DependencyInformation
     Development.IDE.Import.FindImports
+    Development.IDE.LSP.HoverDefinition
     Development.IDE.LSP.LanguageServer
     Development.IDE.LSP.Notifications
+    Development.IDE.LSP.Outline
     Development.IDE.LSP.Server
     Development.IDE.Main
     Development.IDE.Main.HeapStats
@@ -371,22 +373,29 @@ test-suite ghcide-tests
     BootTests
     ClientSettingsTests
     CodeLensTests
+    CompletionTests
     CPPTests
+    CradleTests
     DependentFileTest
     DiagnosticTests
     ExceptionTests
+    FindDefinitionAndHoverTests
     FuzzySearch
     GarbageCollectionTests
     HaddockTests
     HieDbRetry
+    HighlightTests
     IfaceTests
+    InitializeResponseTests
     LogType
     NonLspCommandLine
     OpenCloseTest
+    OutlineTests
     PluginSimpleTests
     PositionMappingTests
     PreprocessorTests
     Progress
+    ReferenceTests
     RootUriTests
     SafeTests
     SymlinkTests

ghcide/session-loader/Development/IDE/Session.hs

@@ -585,21 +585,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
           let new_cache = newComponentCache recorder optExtensions hieYaml _cfp hscEnv
           all_target_details <- new_cache old_deps new_deps
 
-          this_dep_info <- getDependencyInfo $ maybeToList hieYaml
-          let (all_targets, this_flags_map, this_options)
-                = case HM.lookup _cfp flags_map' of
-                    Just this -> (all_targets', flags_map', this)
-                    Nothing -> (this_target_details : all_targets', HM.insert _cfp this_flags flags_map', this_flags)
-                  where all_targets' = concat all_target_details
-                        flags_map' = HM.fromList (concatMap toFlagsMap all_targets')
-                        this_target_details = TargetDetails (TargetFile _cfp) this_error_env this_dep_info [_cfp]
-                        this_flags = (this_error_env, this_dep_info)
-                        this_error_env = ([this_error], Nothing)
-                        this_error = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) _cfp
-                                       $ T.unlines
-                                       [ "No cradle target found. Is this file listed in the targets of your cradle?"
-                                       , "If you are using a .cabal file, please ensure that this module is listed in either the exposed-modules or other-modules section"
-                                       ]
+          let all_targets = concatMap fst all_target_details
+
+          let this_flags_map = HM.fromList (concatMap toFlagsMap all_targets)
 
           void $ modifyVar' fileToFlags $
               Map.insert hieYaml this_flags_map
@@ -627,7 +615,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
                     let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces
                     liftIO $ atomically $ modifyTVar' (exportsMap shakeExtras) (exportsMap' <>)
 
-          return $ second Map.keys this_options
+          return $ second Map.keys $ this_flags_map HM.! _cfp
 
     let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath])
         consultCradle hieYaml cfp = do
@@ -647,17 +635,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
            -- Display a user friendly progress message here: They probably don't know what a cradle is
            let progMsg = "Setting up " <> T.pack (takeBaseName (cradleRootDir cradle))
                          <> " (for " <> T.pack lfp <> ")"
-           mRunLspT lspEnv $ sendNotification (SMethod_CustomMethod (Proxy @"ghcide/cradle/eopts/before")) (toJSON cfp)
            eopts <- mRunLspTCallback lspEnv (\act -> withIndefiniteProgress progMsg Nothing NotCancellable (const act)) $
               withTrace "Load cradle" $ \addTag -> do
                   addTag "file" lfp
                   old_files <- readIORef cradle_files
                   res <- cradleToOptsAndLibDir recorder cradle cfp old_files
                   addTag "result" (show res)
                   return res
-           mRunLspT lspEnv $ sendNotification (SMethod_CustomMethod (Proxy @"ghcide/cradle/eopts/after")) (toJSON cfp)
+
            logWith recorder Debug $ LogSessionLoadingResult eopts
-           mRunLspT lspEnv $ sendNotification (SMethod_CustomMethod (Proxy @"ghcide/cradle/eopts/afterLog")) (toJSON (show $ pretty (LogSessionLoadingResult eopts)))
            case eopts of
              -- The cradle gave us some options so get to work turning them
              -- into and HscEnv.
@@ -824,7 +810,7 @@ newComponentCache
          -> HscEnv             -- ^ An empty HscEnv
          -> [ComponentInfo]    -- ^ New components to be loaded
          -> [ComponentInfo]    -- ^ old, already existing components
-         -> IO [ [TargetDetails] ]
+         -> IO [ ([TargetDetails], (IdeResult HscEnvEq, DependencyInfo))]
 newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do
     let cis = Map.unionWith unionCIs (mkMap new_cis) (mkMap old_cis)
         -- When we have multiple components with the same uid,
@@ -896,13 +882,14 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do
       henv <- createHscEnvEq thisEnv (zip uids dfs)
       let targetEnv = (if isBad ci then multi_errs else [], Just henv)
           targetDepends = componentDependencyInfo ci
-      logWith recorder Debug $ LogNewComponentCache (targetEnv, targetDepends)
+          res = ( targetEnv, targetDepends)
+      logWith recorder Debug $ LogNewComponentCache res
       evaluate $ liftRnf rwhnf $ componentTargets ci
 
       let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends
       ctargets <- concatMapM mk (componentTargets ci)
 
-      return (L.nubOrdOn targetTarget ctargets)
+      return (L.nubOrdOn targetTarget ctargets, res)
 
 {- Note [Avoiding bad interface files]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1094,20 +1081,15 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
         -- A special target for the file which caused this wonderful
         -- component to be created. In case the cradle doesn't list all the targets for
         -- the component, in which case things will be horribly broken anyway.
-        --
-        -- When we have a single component that is caused to be loaded due to a
-        -- file, we assume the file is part of that component. This is useful
-        -- for bare GHC sessions, such as many of the ones used in the testsuite
+        -- Otherwise, we will immediately attempt to reload this module which
+        -- causes an infinite loop and high CPU usage.
         --
         -- We don't do this when we have multiple components, because each
         -- component better list all targets or there will be anarchy.
         -- It is difficult to know which component to add our file to in
         -- that case.
         -- Multi unit arguments are likely to come from cabal, which
         -- does list all targets.
-        --
-        -- If we don't end up with a target for the current file in the end, then
-        -- we will report it as an error for that file
         abs_fp <- liftIO $ makeAbsolute (fromNormalizedFilePath cfp)
         let special_target = Compat.mkSimpleTarget df abs_fp
         pure $ (df, special_target : targets) :| []

ghcide/src/Development/IDE/Core/Actions.hs

@@ -4,6 +4,8 @@ module Development.IDE.Core.Actions
 , getDefinition
 , getTypeDefinition
 , highlightAtPoint
+, refsAtPoint
+, workspaceSymbols
 , lookupMod
 ) where
 
@@ -122,4 +124,16 @@ highlightAtPoint file pos = runMaybeT $ do
     let toCurrentHighlight (DocumentHighlight range t) = flip DocumentHighlight t <$> toCurrentRange mapping range
     mapMaybe toCurrentHighlight <$>AtPoint.documentHighlight hf rf pos'
 
+-- Refs are not an IDE action, so it is OK to be slow and (more) accurate
+refsAtPoint :: NormalizedFilePath -> Position -> Action [Location]
+refsAtPoint file pos = do
+    ShakeExtras{withHieDb} <- getShakeExtras
+    fs <- HM.keys <$> getFilesOfInterestUntracked
+    asts <- HM.fromList . mapMaybe sequence . zip fs <$> usesWithStale GetHieAst fs
+    AtPoint.referencesAtPoint withHieDb file pos (AtPoint.FOIReferences asts)
 
+workspaceSymbols :: T.Text -> IdeAction (Maybe [SymbolInformation])
+workspaceSymbols query = runMaybeT $ do
+  ShakeExtras{withHieDb} <- ask
+  res <- liftIO $ withHieDb (\hieDb -> HieDb.searchDef hieDb $ T.unpack query)
+  pure $ mapMaybe AtPoint.defRowToSymbolInfo res

ghcide/src/Development/IDE/Core/Rules.hs

@@ -11,8 +11,11 @@
 module Development.IDE.Core.Rules(
     -- * Types
     IdeState, GetParsedModule(..), TransitiveDependencies(..),
-    GhcSessionIO(..), GetClientSettings(..),
+    Priority(..), GhcSessionIO(..), GetClientSettings(..),
     -- * Functions
+    priorityTypeCheck,
+    priorityGenerateCore,
+    priorityFilesOfInterest,
     runAction,
     toIdeResult,
     defineNoFile,
@@ -162,7 +165,6 @@ import           Language.LSP.Protocol.Types                  (MessageType (Mess
                                                                ShowMessageParams (ShowMessageParams))
 import           Language.LSP.Server                          (LspT)
 import qualified Language.LSP.Server                          as LSP
-import qualified Language.LSP.Protocol.Message            as LSP
 import           Language.LSP.VFS
 import           Prelude                                      hiding (mod)
 import           System.Directory                             (doesFileExist,
@@ -171,7 +173,6 @@ import           System.Info.Extra                            (isWindows)
 
 
 import           GHC.Fingerprint
-import qualified Development.IDE.Session as Session
 
 -- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
 
@@ -181,14 +182,12 @@ import           GHC                                          (mgModSummaries)
 
 #if MIN_VERSION_ghc(9,3,0)
 import qualified Data.IntMap                                  as IM
-import Data.Row (KnownSymbol)
 #endif
 
 
 
 data Log
   = LogShake Shake.Log
-  | LogSession Session.Log
   | LogReindexingHieFile !NormalizedFilePath
   | LogLoadingHieFile !NormalizedFilePath
   | LogLoadingHieFileFail !FilePath !SomeException
@@ -218,7 +217,6 @@ instance Pretty Log where
         <+> "the HLS version being used, the plugins enabled, and if possible the codebase and file which"
         <+> "triggered this warning."
       ]
-    LogSession msg -> pretty msg
 
 templateHaskellInstructions :: T.Text
 templateHaskellInstructions = "https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html#static-binaries"
@@ -252,6 +250,15 @@ getParsedModuleWithComments = use GetParsedModuleWithComments
 -- Rules
 -- These typically go from key to value and are oracles.
 
+priorityTypeCheck :: Priority
+priorityTypeCheck = Priority 0
+
+priorityGenerateCore :: Priority
+priorityGenerateCore = Priority (-1)
+
+priorityFilesOfInterest :: Priority
+priorityFilesOfInterest = Priority (-2)
+
 -- | WARNING:
 -- We currently parse the module both with and without Opt_Haddock, and
 -- return the one with Haddocks if it -- succeeds. However, this may not work
@@ -675,6 +682,7 @@ typeCheckRuleDefinition
     -> ParsedModule
     -> Action (IdeResult TcModuleResult)
 typeCheckRuleDefinition hsc pm = do
+  setPriority priorityTypeCheck
   IdeOptions { optDefer = defer } <- getIdeOptions
 
   unlift <- askUnliftIO
@@ -712,24 +720,8 @@ loadGhcSession recorder ghcSessionDepsConfig = do
         return (fingerprint, res)
 
     defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GhcSession file -> do
-        -- todo add signal
-        ShakeExtras{exportsMap, ideTesting = IdeTesting testing, lspEnv, progress} <- getShakeExtras
-        let
-            signal' :: KnownSymbol s => Proxy s -> String -> Action ()
-            signal' msg str = when testing $ liftIO $
-                mRunLspT lspEnv $
-                    LSP.sendNotification (LSP.SMethod_CustomMethod msg) $
-                    toJSON $ [str]
-            signal :: KnownSymbol s => Proxy s -> Action ()
-            signal msg = signal' msg (show file)
-
-
-
-        signal (Proxy @"GhcSession/start")
         IdeGhcSession{loadSessionFun} <- useNoFile_ GhcSessionIO
-        signal (Proxy @"GhcSession/loadSessionFun/before")
         (val,deps) <- liftIO $ loadSessionFun $ fromNormalizedFilePath file
-        signal (Proxy @"GhcSession/loadSessionFun/after")
 
         -- add the deps to the Shake graph
         let addDependency fp = do
@@ -742,7 +734,6 @@ loadGhcSession recorder ghcSessionDepsConfig = do
         mapM_ addDependency deps
 
         let cutoffHash = LBS.toStrict $ B.encode (hash (snd val))
-        signal (Proxy @"GhcSession/done")
         return (Just cutoffHash, val)
 
     defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \(GhcSessionDeps_ fullModSummary) file -> do
@@ -945,6 +936,7 @@ generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts
 generateCore runSimplifier file = do
     packageState <- hscEnv <$> use_ GhcSessionDeps file
     tm <- use_ TypeCheck file
+    setPriority priorityGenerateCore
     liftIO $ compileModule runSimplifier packageState (tmrModSummary tm) (tmrTypechecked tm)
 
 generateCoreRule :: Recorder (WithPriority Log) -> Rules ()

ghcide/src/Development/IDE/Core/Shake.hs

@@ -51,10 +51,12 @@ module Development.IDE.Core.Shake(
     HLS.getClientConfig,
     getPluginConfigAction,
     knownTargets,
+    setPriority,
     ideLogger,
     actionLogger,
     getVirtualFile,
     FileVersion(..),
+    Priority(..),
     updatePositionMapping,
     updatePositionMappingHelper,
     deleteValue, recordDirtyKeys,
@@ -137,7 +139,6 @@ import           Development.IDE.Graph.Database         (ShakeDatabase,
                                                          shakeNewDatabase,
                                                          shakeProfileDatabase,
                                                          shakeRunDatabaseForKeys)
-import           Development.IDE.Graph.Internal.Profile (collectProfileMemory)
 import           Development.IDE.Graph.Rule
 import           Development.IDE.Types.Action
 import           Development.IDE.Types.Diagnostics
@@ -717,7 +718,6 @@ shakeShut IdeState{..} = do
     -- request so we first abort that.
     for_ runner cancelShakeSession
     void $ shakeDatabaseProfile shakeDb
-    void $ collectProfileMemory shakeDb
     progressStop $ progress shakeExtras
     stopMonitoring
 
@@ -1307,6 +1307,11 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
             | otherwise = c
 
 
+newtype Priority = Priority Double
+
+setPriority :: Priority -> Action ()
+setPriority (Priority p) = reschedule p
+
 ideLogger :: IdeState -> Logger
 ideLogger IdeState{shakeExtras=ShakeExtras{logger}} = logger