Attempt at getting completions from last good tckd module

src/Development/IDE/Core/Completions.hs

@@ -37,6 +37,8 @@ import qualified Language.Haskell.LSP.VFS as VFS
 import Development.IDE.Core.CompletionsTypes
 import Development.IDE.Spans.Documentation
 
+import Debug.Trace
+
 -- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs
 
 data NameDetails
@@ -330,12 +332,13 @@ cacheDataProducer dflags tm tcs = do
 
       (unquals,quals) = getCompls rdrElts
 
-  return $ CC
-    { allModNamesAsNS = allModNamesAsNS
-    , unqualCompls = unquals
-    , qualCompls = quals
-    , importableModules = moduleNames
-    }
+      r = CC { allModNamesAsNS = allModNamesAsNS
+             , unqualCompls = unquals
+             , qualCompls = quals
+             , importableModules = moduleNames
+             }
+
+  return r
 
 newtype WithSnippets = WithSnippets Bool
 
@@ -435,7 +438,8 @@ getCompletions CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules
         = filtModNameCompls ++ map (toggleSnippets caps withSnippets
                                       . mkCompl . stripAutoGenerated) filtCompls
 
-  return result
+  trace (show prefixInfo <> show pos <> show (getCContext pos (tm_parsed_module tm)))
+    $ return result
 
 -- The supported languages and extensions
 languagesAndExts :: [T.Text]

src/Development/IDE/Core/Rules.hs

@@ -33,6 +33,7 @@ import Control.Monad.Trans.Class
 import Control.Monad.Trans.Maybe
 import Development.IDE.Core.Compile
 import Development.IDE.Core.Completions
+import Development.IDE.Core.Shake
 import Development.IDE.Types.Options
 import Development.IDE.Spans.Calculate
 import Development.IDE.Import.DependencyInformation
@@ -65,7 +66,6 @@ import GHC.Generics(Generic)
 
 import qualified Development.IDE.Spans.AtPoint as AtPoint
 import Development.IDE.Core.Service
-import Development.IDE.Core.Shake
 import Development.Shake.Classes
 
 -- | This is useful for rules to convert rules that can only produce errors or
@@ -287,7 +287,12 @@ typeCheckRule =
                   else uses_ TypeCheck (transitiveModuleDeps deps)
         setPriority priorityTypeCheck
         IdeOptions{ optDefer = defer} <- getIdeOptions
-        liftIO $ typecheckModule defer packageState tms pm
+        tcm <- liftIO $ typecheckModule defer packageState tms pm
+        -- Save last version if typechecking was successful
+        case tcm of
+            (_, Just r) -> updateLastTypecheckedModule file (tmrModule r) =<< getShakeExtras
+            _ -> return ()
+        return tcm
     where
         uses_th_qq dflags = xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
         addByteCode :: Linkable -> TcModuleResult -> TcModuleResult
@@ -309,10 +314,15 @@ produceCompletions :: Rules ()
 produceCompletions =
     define $ \ProduceCompletions file -> do
         deps <- use_ GetDependencies file
-        (tm : tms) <- uses_ TypeCheck (file: transitiveModuleDeps deps)
+        _ <- uses TypeCheck (file: transitiveModuleDeps deps)
         dflags <- hsc_dflags . hscEnv <$> use_ GhcSession file
-        cdata <- liftIO $ cacheDataProducer dflags (tmrModule tm) (map tmrModule tms)
-        return ([], Just cdata)
+        extras <- getShakeExtras
+        tm <- getLastTypecheckedModule file extras
+        tms <- getAllLastTypecheckedModules extras
+        case tm of
+            Just tm' -> do cdata <- liftIO $ cacheDataProducer dflags tm' tms
+                           return ([], Just cdata)
+            Nothing  -> return ([], Nothing)
 
 generateByteCodeRule :: Rules ()
 generateByteCodeRule =

src/Development/IDE/Core/Shake.hs

@@ -27,7 +27,7 @@ module Development.IDE.Core.Shake(
     use, useWithStale, useNoFile, uses, usesWithStale,
     use_, useNoFile_, uses_,
     define, defineEarlyCutoff, defineOnDisk, needOnDisk, needOnDisks, fingerprintToBS,
-    getDiagnostics, unsafeClearDiagnostics,
+    getDiagnostics, unsafeClearDiagnostics, getShakeExtras,
     IsIdeGlobal, addIdeGlobal, getIdeGlobalState, getIdeGlobalAction,
     garbageCollect,
     setPriority,
@@ -37,7 +37,10 @@ module Development.IDE.Core.Shake(
     FileVersion(..),
     Priority(..),
     updatePositionMapping,
-    OnDiskRule(..)
+    OnDiskRule(..),
+    getAllLastTypecheckedModules,
+    getLastTypecheckedModule,
+    updateLastTypecheckedModule
     ) where
 
 import           Development.Shake hiding (ShakeValue, doesFileExist)
@@ -83,6 +86,7 @@ import           GHC.Generics
 import           System.IO.Unsafe
 import           Numeric.Extra
 import Language.Haskell.LSP.Types
+import qualified GHC
 
 
 -- information we stash inside the shakeExtra field
@@ -99,6 +103,8 @@ data ShakeExtras = ShakeExtras
     ,positionMapping :: Var (Map NormalizedUri (Map TextDocumentVersion PositionMapping))
     -- ^ Map from a text document version to a PositionMapping that describes how to map
     -- positions in a version of that document to positions in the latest version
+    ,lastTypechecked :: Var (Map NormalizedUri GHC.TypecheckedModule)
+    -- ^ Map from files to the last correct version
     }
 
 getShakeExtras :: Action ShakeExtras
@@ -292,6 +298,7 @@ shakeOpen getLspId eventer logger shakeProfileDir (IdeReportProgress reportProgr
         publishedDiagnostics <- newVar mempty
         debouncer <- newDebouncer
         positionMapping <- newVar Map.empty
+        lastTypechecked <- newVar Map.empty
         pure ShakeExtras{..}
     (shakeDb, shakeClose) <-
         shakeOpenDatabase
@@ -683,6 +690,27 @@ publishDiagnosticsNotification uri diags =
     LSP.NotificationMessage "2.0" LSP.TextDocumentPublishDiagnostics $
     LSP.PublishDiagnosticsParams uri (List diags)
 
+getAllLastTypecheckedModules ::
+  ShakeExtras -> Action [GHC.TypecheckedModule]
+getAllLastTypecheckedModules ShakeExtras {lastTypechecked} = do
+    Map.elems <$> liftIO (readVar lastTypechecked)
+
+getLastTypecheckedModule ::
+  NormalizedFilePath -> ShakeExtras -> Action (Maybe GHC.TypecheckedModule)
+getLastTypecheckedModule fp ShakeExtras {lastTypechecked} = do
+    let uri = filePathToUri' fp
+    (Map.!? uri) <$> liftIO (readVar lastTypechecked)
+
+updateLastTypecheckedModule ::
+     NormalizedFilePath
+  -> GHC.TypecheckedModule
+  -> ShakeExtras
+  -> Action ()
+updateLastTypecheckedModule fp m ShakeExtras {lastTypechecked} = do
+    let uri = filePathToUri' fp
+    liftIO $ mask_ $ modifyVar_ lastTypechecked $ \lastTcs -> do
+        pure $! Map.insert uri m lastTcs
+
 newtype Priority = Priority Double
 
 setPriority :: Priority -> Action ()