Upgrade to new version of lsp libraries (#2494)

* Update to latest version of lsp libraries

* Compute completions on kick

This is not only for faster completions.
 It's also needed to have semi-fresh completions after editing.
This is specially important for the first completion request of a file - without this change there are no  completions available at all

* Emit LSP custom messages on kick start/finish

useful to synchonize on these events in tests

* Fix completions tests after haskell/lsp#376

* Restore cabal update with comments

* Use new lsp in stack 9.0.1

Co-authored-by: Pepe Iborra <[email protected]>
Co-authored-by: jneira <[email protected]>

fix merge failure

Author: michaelpj

.github/workflows/bench.yml

@@ -118,6 +118,9 @@ jobs:
               ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-
               ${{ env.cache-name }}-${{ runner.os }}-
 
+    # To ensure we get the lastest hackage index and not relying on haskell action logic
+    - run: cabal update
+
     # max-backjumps is increased as a temporary solution
     # for dependency resolution failure
     - run: cabal configure --enable-benchmarks --max-backjumps 12000

.github/workflows/caching.yml

@@ -182,6 +182,10 @@ jobs:
                 ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-
                 ${{ env.cache-name }}-${{ runner.os }}-
 
+      # To ensure we get the lastest hackage index and not relying on haskell action logic
+      - if: steps.compiled-deps.outputs.cache-hit != 'true'
+        run: cabal update
+
       - if: steps.compiled-deps.outputs.cache-hit != 'true' && runner.os == 'Linux' && matrix.ghc == '8.10.7'
         name: Download sources for bench
         #  Downloaded separately, to match the tested work/PR workflow guarantees

.github/workflows/test.yml

@@ -179,6 +179,10 @@ jobs:
                 ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-
                 ${{ env.cache-name }}-${{ runner.os }}-
 
+      # To ensure we get the lastest hackage index and not relying on haskell action logic
+      - if: steps.compiled-deps.outputs.cache-hit != 'true'
+        run: cabal update
+
       # repeating builds to workaround segfaults in windows and ghc-8.8.4
       - name: Build
         run: cabal build || cabal build || cabal build

cabal-ghc901.project

@@ -37,7 +37,7 @@ package *
 
 write-ghc-environment-files: never
 
-index-state: 2021-11-29T12:30:10Z
+index-state: 2021-12-29T12:30:08Z
 
 constraints:
   -- These plugins don't work on GHC9 yet

cabal-ghc921.project

@@ -36,7 +36,7 @@ package *
 
 write-ghc-environment-files: never
 
-index-state: 2021-11-29T12:30:10Z
+index-state: 2021-12-29T12:30:08Z
 
 constraints:
   -- These plugins doesn't work on GHC92 yet

cabal.project

@@ -40,7 +40,7 @@ package *
 
 write-ghc-environment-files: never
 
-index-state: 2021-11-29T12:30:10Z
+index-state: 2021-12-29T12:30:08Z
 
 constraints:
     hyphenation +embed

ghcide/bench/example/HLS

@@ -194,7 +194,7 @@ experiments =
             let edit :: TextDocumentContentChangeEvent =TextDocumentContentChangeEvent
                   { _range = Just Range {_start = bottom, _end = bottom}
                   , _rangeLength = Nothing, _text = t}
-                bottom = Position maxBoundUinteger 0
+                bottom = Position maxBound 0
                 t = T.unlines
                     [""
                     ,"holef :: [Int] -> [Int]"
@@ -213,7 +213,7 @@ experiments =
             flip allM docs $ \DocumentPositions{..} -> do
                 bottom <- pred . length . T.lines <$> documentContents doc
                 diags <- getCurrentDiagnostics doc
-                case requireDiagnostic diags (DsError, (bottom, 8), "Found hole", Nothing) of
+                case requireDiagnostic diags (DsError, (fromIntegral bottom, 8), "Found hole", Nothing) of
                     Nothing   -> pure True
                     Just _err -> pure False
         )
@@ -404,7 +404,7 @@ runBenchmarksFun dir allBenchmarks = do
           ++ ["--verbose" | verbose ?config]
           ++ ["--ot-memory-profiling" | Just _ <- [otMemoryProfiling ?config]]
     lspTestCaps =
-      fullCaps {_window = Just $ WindowClientCapabilities $ Just True}
+      fullCaps {_window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }
     conf =
       defaultConfig
         { logStdErr = verbose ?config,
@@ -585,7 +585,7 @@ setupDocumentContents config =
         doc <- openDoc m "haskell"
 
         -- Setup the special positions used by the experiments
-        lastLine <- length . T.lines <$> documentContents doc
+        lastLine <- fromIntegral . length . T.lines <$> documentContents doc
         changeDoc doc [TextDocumentContentChangeEvent
             { _range = Just (Range (Position lastLine 0) (Position lastLine 0))
             , _rangeLength = Nothing
@@ -638,9 +638,9 @@ searchSymbol doc@TextDocumentIdentifier{_uri} fileContents pos = do
             return res
   where
       loop pos
-        | _line pos >= lll =
+        | (fromIntegral $ _line pos) >= lll =
             return Nothing
-        | _character pos >= lengthOfLine (_line pos) =
+        | (fromIntegral $ _character pos) >= lengthOfLine (fromIntegral $ _line pos) =
             loop (nextLine pos)
         | otherwise = do
                 checks <- checkDefinitions pos &&^ checkCompletions pos
@@ -663,7 +663,3 @@ searchSymbol doc@TextDocumentIdentifier{_uri} fileContents pos = do
       checkCompletions pos =
         not . null <$> getCompletions doc pos
 
--- | We don't have a uinteger type yet. So hardcode the maxBound of uinteger, 2 ^ 31 - 1
--- as a constant.
-maxBoundUinteger :: Int
-maxBoundUinteger = 2147483647

ghcide/bench/lib/Experiments.hs

@@ -65,8 +65,8 @@ library
         lens,
         list-t,
         hiedb == 0.4.1.*,
-        lsp-types >= 1.3.0.1 && < 1.4,
-        lsp == 1.2.*,
+        lsp-types ^>= 1.4.0.0,
+        lsp ^>= 1.4.0.0 ,
         monoid-subclasses,
         mtl,
         network-uri,

ghcide/ghcide.cabal

@@ -564,6 +564,11 @@ indexHieFile se mod_summary srcPath !hash hf = do
         done <- readTVar indexCompleted
         remaining <- HashMap.size <$> readTVar indexPending
         pure (done, remaining)
+      let
+        progressFrac :: Double
+        progressFrac = fromIntegral done / fromIntegral (done + remaining)
+        progressPct :: LSP.UInt
+        progressPct = floor $ 100 * progressFrac
 
       whenJust (lspEnv se) $ \env -> whenJust tok $ \tok -> LSP.runLspT env $
         LSP.sendNotification LSP.SProgress $ LSP.ProgressParams tok $
@@ -572,7 +577,7 @@ indexHieFile se mod_summary srcPath !hash hf = do
                 Percentage -> LSP.WorkDoneProgressReportParams
                     { _cancellable = Nothing
                     , _message = Nothing
-                    , _percentage = Just (100 * fromIntegral done / fromIntegral (done + remaining) )
+                    , _percentage = Just progressPct
                     }
                 Explicit -> LSP.WorkDoneProgressReportParams
                     { _cancellable = Nothing

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

@@ -20,21 +20,26 @@ module Development.IDE.Core.OfInterest(
 import           Control.Concurrent.Strict
 import           Control.Monad
 import           Control.Monad.IO.Class
-import           Data.HashMap.Strict                    (HashMap)
-import qualified Data.HashMap.Strict                    as HashMap
-import qualified Data.Text                              as T
+import           Data.HashMap.Strict                      (HashMap)
+import qualified Data.HashMap.Strict                      as HashMap
+import qualified Data.Text                                as T
 import           Development.IDE.Graph
 
-import           Control.Concurrent.STM.Stats           (atomically,
-                                                         modifyTVar')
-import qualified Data.ByteString                        as BS
-import           Data.Maybe                             (catMaybes)
+import           Control.Concurrent.STM.Stats             (atomically,
+                                                           modifyTVar')
+import           Data.Aeson                               (toJSON)
+import qualified Data.ByteString                          as BS
+import           Data.Maybe                               (catMaybes)
 import           Development.IDE.Core.ProgressReporting
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake
+import           Development.IDE.Plugin.Completions.Types
 import           Development.IDE.Types.Exports
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Logger
+import           Development.IDE.Types.Options            (IdeTesting (..))
+import qualified Language.LSP.Server                      as LSP
+import qualified Language.LSP.Types                       as LSP
 
 newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
 instance IsIdeGlobal OfInterestVar
@@ -109,11 +114,21 @@ scheduleGarbageCollection state = do
 kick :: Action ()
 kick = do
     files <- HashMap.keys <$> getFilesOfInterestUntracked
-    ShakeExtras{exportsMap, progress} <- getShakeExtras
+    ShakeExtras{exportsMap, ideTesting = IdeTesting testing, lspEnv, progress} <- getShakeExtras
+    let signal msg = when testing $ liftIO $
+            mRunLspT lspEnv $
+                LSP.sendNotification (LSP.SCustomMethod msg) $
+                toJSON $ map fromNormalizedFilePath files
+
+    signal "kick/start"
     liftIO $ progressUpdate progress KickStarted
 
     -- Update the exports map
-    results <- uses GenerateCore files <* uses GetHieAst files
+    results <- uses GenerateCore files
+            <* uses GetHieAst files
+            -- needed to have non local completions on the first edit
+            -- when the first edit breaks the module header
+            <* uses NonLocalCompletions files
     let mguts = catMaybes results
     void $ liftIO $ atomically $ modifyTVar' exportsMap (updateExportsMapMg mguts)
 
@@ -124,3 +139,5 @@ kick = do
     when garbageCollectionScheduled $ do
         void garbageCollectDirtyKeys
         liftIO $ writeVar var False
+
+    signal "kick/done"

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

@@ -31,7 +31,8 @@ import           Data.List
 import qualified Data.Text           as T
 import qualified Data.Vector.Unboxed as V
 import           Language.LSP.Types  (Position (Position), Range (Range),
-                                      TextDocumentContentChangeEvent (TextDocumentContentChangeEvent))
+                                      TextDocumentContentChangeEvent (TextDocumentContentChangeEvent),
+                                      UInt)
 
 -- | Either an exact position, or the range of text that was substituted
 data PositionResult a
@@ -140,14 +141,17 @@ toCurrent (Range start@(Position startLine startColumn) end@(Position endLine en
     where
         lineDiff = linesNew - linesOld
         linesNew = T.count "\n" t
-        linesOld = endLine - startLine
+        linesOld = fromIntegral endLine - fromIntegral startLine
+        newEndColumn :: UInt
         newEndColumn
-          | linesNew == 0 = startColumn + T.length t
-          | otherwise = T.length $ T.takeWhileEnd (/= '\n') t
+          | linesNew == 0 = fromIntegral $ fromIntegral startColumn + T.length t
+          | otherwise = fromIntegral $ T.length $ T.takeWhileEnd (/= '\n') t
+        newColumn :: UInt
         newColumn
-          | line == endLine = column + newEndColumn - endColumn
+          | line == endLine = fromIntegral $ (fromIntegral column + newEndColumn) - fromIntegral endColumn
           | otherwise = column
-        newLine = line + lineDiff
+        newLine :: UInt
+        newLine = fromIntegral $ fromIntegral line + lineDiff
 
 fromCurrent :: Range -> T.Text -> Position -> PositionResult Position
 fromCurrent (Range start@(Position startLine startColumn) end@(Position endLine endColumn)) t (Position line column)
@@ -163,19 +167,23 @@ fromCurrent (Range start@(Position startLine startColumn) end@(Position endLine
     where
         lineDiff = linesNew - linesOld
         linesNew = T.count "\n" t
-        linesOld = endLine - startLine
-        newEndLine = endLine + lineDiff
+        linesOld = fromIntegral endLine - fromIntegral startLine
+        newEndLine :: UInt
+        newEndLine = fromIntegral $ fromIntegral endLine + lineDiff
+        newEndColumn :: UInt
         newEndColumn
-          | linesNew == 0 = startColumn + T.length t
-          | otherwise = T.length $ T.takeWhileEnd (/= '\n') t
+          | linesNew == 0 = fromIntegral $ fromIntegral startColumn + T.length t
+          | otherwise = fromIntegral $ T.length $ T.takeWhileEnd (/= '\n') t
+        newColumn :: UInt
         newColumn
-          | line == newEndLine = column - (newEndColumn - endColumn)
+          | line == newEndLine = fromIntegral $ (fromIntegral column + fromIntegral endColumn) - newEndColumn
           | otherwise = column
-        newLine = line - lineDiff
+        newLine :: UInt
+        newLine = fromIntegral $ fromIntegral line - lineDiff
 
 deltaFromDiff :: T.Text -> T.Text -> PositionDelta
 deltaFromDiff (T.lines -> old) (T.lines -> new) =
-    PositionDelta (lookupPos lnew o2nPrevs o2nNexts old2new) (lookupPos lold n2oPrevs n2oNexts new2old)
+    PositionDelta (lookupPos (fromIntegral lnew) o2nPrevs o2nNexts old2new) (lookupPos (fromIntegral lold) n2oPrevs n2oNexts new2old)
   where
     !lnew = length new
     !lold = length old
@@ -194,17 +202,16 @@ deltaFromDiff (T.lines -> old) (T.lines -> new) =
     f :: Int -> Int -> Int
     f !a !b = if b == -1 then a else b
 
-    lookupPos :: Int -> V.Vector Int -> V.Vector Int -> V.Vector Int -> Position -> PositionResult Position
+    lookupPos :: UInt -> V.Vector Int -> V.Vector Int -> V.Vector Int -> Position -> PositionResult Position
     lookupPos end prevs nexts xs (Position line col)
-      | line < 0            = PositionRange (Position 0   0) (Position 0   0)
-      | line >= V.length xs = PositionRange (Position end 0) (Position end 0)
-      | otherwise           = case V.unsafeIndex xs line of
+      | line >= fromIntegral (V.length xs) = PositionRange (Position end 0) (Position end 0)
+      | otherwise           = case V.unsafeIndex xs (fromIntegral line) of
           -1 ->
             -- look for the previous and next lines that mapped successfully
-            let !prev = 1 + V.unsafeIndex prevs line
-                !next = V.unsafeIndex nexts line
-              in PositionRange (Position prev 0) (Position next 0)
-          line' -> PositionExact (Position line' col)
+            let !prev = 1 + V.unsafeIndex prevs (fromIntegral line)
+                !next = V.unsafeIndex nexts (fromIntegral line)
+              in PositionRange (Position (fromIntegral prev) 0) (Position (fromIntegral next) 0)
+          line' -> PositionExact (Position (fromIntegral line') col)
 
     -- Construct a mapping between lines in the diff
     -- -1 for unsucessful mapping

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

@@ -152,13 +152,17 @@ delayedProgressReporting before after lspEnv optProgressStyle = do
                         }
                 loop _ _ | optProgressStyle == NoProgress =
                     forever $ liftIO $ threadDelay maxBound
-                loop id prev = do
+                loop id prevPct = do
                     done <- liftIO $ readTVarIO doneVar
                     todo <- liftIO $ readTVarIO todoVar
                     liftIO $ sleep after
                     if todo == 0 then loop id 0 else do
-                        let next = 100 * fromIntegral done / fromIntegral todo
-                        when (next /= prev) $
+                        let
+                            nextFrac :: Double
+                            nextFrac = fromIntegral done / fromIntegral todo
+                            nextPct :: UInt
+                            nextPct = floor $ 100 * nextFrac
+                        when (nextPct /= prevPct) $
                           LSP.sendNotification LSP.SProgress $
                           LSP.ProgressParams
                               { _token = id
@@ -171,11 +175,11 @@ delayedProgressReporting before after lspEnv optProgressStyle = do
                                   Percentage -> LSP.WorkDoneProgressReportParams
                                     { _cancellable = Nothing
                                     , _message = Nothing
-                                    , _percentage = Just next
+                                    , _percentage = Just nextPct
                                     }
                                   NoProgress -> error "unreachable"
                               }
-                        loop id next
+                        loop id nextPct
 
         updateStateForFile inProgress file = actionBracket (f succ) (const $ f pred) . const
             -- This functions are deliberately eta-expanded to avoid space leaks.

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

@@ -43,7 +43,8 @@ import           Development.IDE.Spans.Common
 import           Development.IDE.Spans.LocalBindings
 import           Development.IDE.Types.Diagnostics
 import           GHC.Serialized                               (Serialized)
-import           Language.LSP.Types                           (NormalizedFilePath)
+import           Language.LSP.Types                           (Int32,
+                                                               NormalizedFilePath)
 
 data LinkableType = ObjectLinkable | BCOLinkable
   deriving (Eq,Ord,Show, Generic)
@@ -290,13 +291,13 @@ pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}
 type instance RuleResult GetModificationTime = FileVersion
 
 data FileVersion
-    = VFSVersion !Int
+    = VFSVersion !Int32
     | ModificationTime !POSIXTime
     deriving (Show, Generic)
 
 instance NFData FileVersion
 
-vfsVersion :: FileVersion -> Maybe Int
+vfsVersion :: FileVersion -> Maybe Int32
 vfsVersion (VFSVersion i)     = Just i
 vfsVersion ModificationTime{} = Nothing
 

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

@@ -1178,7 +1178,7 @@ updateFileDiagnostics fp k ShakeExtras{logger, diagnostics, hiddenDiagnostics, p
                             logInfo logger $ showDiagnosticsColored $ map (fp,ShowDiag,) newDiags
                         Just env -> LSP.runLspT env $
                             LSP.sendNotification LSP.STextDocumentPublishDiagnostics $
-                            LSP.PublishDiagnosticsParams (fromNormalizedUri uri) ver (List newDiags)
+                            LSP.PublishDiagnosticsParams (fromNormalizedUri uri) (fmap fromIntegral ver) (List newDiags)
                  return action
 
 newtype Priority = Priority Double

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

@@ -79,7 +79,7 @@ realSrcSpanToRange real =
 
 realSrcLocToPosition :: RealSrcLoc -> Position
 realSrcLocToPosition real =
-  Position (srcLocLine real - 1) (srcLocCol real - 1)
+  Position (fromIntegral $ srcLocLine real - 1) (fromIntegral $ srcLocCol real - 1)
 
 -- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
 -- FIXME This may not be an _absolute_ file name, needs fixing.
@@ -111,7 +111,7 @@ rangeToRealSrcSpan nfp =
 
 positionToRealSrcLoc :: NormalizedFilePath -> Position -> RealSrcLoc
 positionToRealSrcLoc nfp (Position l c)=
-    Compat.mkRealSrcLoc (fromString $ fromNormalizedFilePath nfp) (l + 1) (c + 1)
+    Compat.mkRealSrcLoc (fromString $ fromNormalizedFilePath nfp) (fromIntegral $ l + 1) (fromIntegral $ c + 1)
 
 isInsideSrcSpan :: Position -> SrcSpan -> Bool
 p `isInsideSrcSpan` r = case srcSpanToRange r of