Skip to content

Commit 09d68cc

Browse files
michaelpjdrsooch
michaelpj
authored and
drsooch
committed
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
1 parent 71ecd2c commit 09d68cc

File tree

63 files changed

+332
-264
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

63 files changed

+332
-264
lines changed

‎.github/workflows/bench.yml

+3
Original file line numberDiff line numberDiff line change
@@ -118,6 +118,9 @@ jobs:
118118
${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-
119119
${{ env.cache-name }}-${{ runner.os }}-
120120
121+
# To ensure we get the lastest hackage index and not relying on haskell action logic
122+
- run: cabal update
123+
121124
# max-backjumps is increased as a temporary solution
122125
# for dependency resolution failure
123126
- run: cabal configure --enable-benchmarks --max-backjumps 12000

‎.github/workflows/caching.yml

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

‎.github/workflows/test.yml

+4
Original file line numberDiff line numberDiff line change
@@ -179,6 +179,10 @@ jobs:
179179
${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-
180180
${{ env.cache-name }}-${{ runner.os }}-
181181
182+
# To ensure we get the lastest hackage index and not relying on haskell action logic
183+
- if: steps.compiled-deps.outputs.cache-hit != 'true'
184+
run: cabal update
185+
182186
# repeating builds to workaround segfaults in windows and ghc-8.8.4
183187
- name: Build
184188
run: cabal build || cabal build || cabal build

‎cabal-ghc901.project

+1-1
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ package *
3737

3838
write-ghc-environment-files: never
3939

40-
index-state: 2021-11-29T12:30:10Z
40+
index-state: 2021-12-29T12:30:08Z
4141

4242
constraints:
4343
-- These plugins don't work on GHC9 yet

‎cabal-ghc921.project

+1-1
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ package *
3636

3737
write-ghc-environment-files: never
3838

39-
index-state: 2021-11-29T12:30:10Z
39+
index-state: 2021-12-29T12:30:08Z
4040

4141
constraints:
4242
-- These plugins doesn't work on GHC92 yet

‎cabal.project

+1-1
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,7 @@ package *
4040

4141
write-ghc-environment-files: never
4242

43-
index-state: 2021-11-29T12:30:10Z
43+
index-state: 2021-12-29T12:30:08Z
4444

4545
constraints:
4646
hyphenation +embed

‎ghcide/bench/example/HLS

-1
This file was deleted.

‎ghcide/bench/lib/Experiments.hs

+6-10
Original file line numberDiff line numberDiff line change
@@ -194,7 +194,7 @@ experiments =
194194
let edit :: TextDocumentContentChangeEvent =TextDocumentContentChangeEvent
195195
{ _range = Just Range {_start = bottom, _end = bottom}
196196
, _rangeLength = Nothing, _text = t}
197-
bottom = Position maxBoundUinteger 0
197+
bottom = Position maxBound 0
198198
t = T.unlines
199199
[""
200200
,"holef :: [Int] -> [Int]"
@@ -213,7 +213,7 @@ experiments =
213213
flip allM docs $ \DocumentPositions{..} -> do
214214
bottom <- pred . length . T.lines <$> documentContents doc
215215
diags <- getCurrentDiagnostics doc
216-
case requireDiagnostic diags (DsError, (bottom, 8), "Found hole", Nothing) of
216+
case requireDiagnostic diags (DsError, (fromIntegral bottom, 8), "Found hole", Nothing) of
217217
Nothing -> pure True
218218
Just _err -> pure False
219219
)
@@ -404,7 +404,7 @@ runBenchmarksFun dir allBenchmarks = do
404404
++ ["--verbose" | verbose ?config]
405405
++ ["--ot-memory-profiling" | Just _ <- [otMemoryProfiling ?config]]
406406
lspTestCaps =
407-
fullCaps {_window = Just $ WindowClientCapabilities $ Just True}
407+
fullCaps {_window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }
408408
conf =
409409
defaultConfig
410410
{ logStdErr = verbose ?config,
@@ -585,7 +585,7 @@ setupDocumentContents config =
585585
doc <- openDoc m "haskell"
586586

587587
-- Setup the special positions used by the experiments
588-
lastLine <- length . T.lines <$> documentContents doc
588+
lastLine <- fromIntegral . length . T.lines <$> documentContents doc
589589
changeDoc doc [TextDocumentContentChangeEvent
590590
{ _range = Just (Range (Position lastLine 0) (Position lastLine 0))
591591
, _rangeLength = Nothing
@@ -638,9 +638,9 @@ searchSymbol doc@TextDocumentIdentifier{_uri} fileContents pos = do
638638
return res
639639
where
640640
loop pos
641-
| _line pos >= lll =
641+
| (fromIntegral $ _line pos) >= lll =
642642
return Nothing
643-
| _character pos >= lengthOfLine (_line pos) =
643+
| (fromIntegral $ _character pos) >= lengthOfLine (fromIntegral $ _line pos) =
644644
loop (nextLine pos)
645645
| otherwise = do
646646
checks <- checkDefinitions pos &&^ checkCompletions pos
@@ -663,7 +663,3 @@ searchSymbol doc@TextDocumentIdentifier{_uri} fileContents pos = do
663663
checkCompletions pos =
664664
not . null <$> getCompletions doc pos
665665

666-
-- | We don't have a uinteger type yet. So hardcode the maxBound of uinteger, 2 ^ 31 - 1
667-
-- as a constant.
668-
maxBoundUinteger :: Int
669-
maxBoundUinteger = 2147483647

‎ghcide/ghcide.cabal

+2-2
Original file line numberDiff line numberDiff line change
@@ -65,8 +65,8 @@ library
6565
lens,
6666
list-t,
6767
hiedb == 0.4.1.*,
68-
lsp-types >= 1.3.0.1 && < 1.4,
69-
lsp == 1.2.*,
68+
lsp-types ^>= 1.4.0.0,
69+
lsp ^>= 1.4.0.0 ,
7070
monoid-subclasses,
7171
mtl,
7272
network-uri,

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

+6-1
Original file line numberDiff line numberDiff line change
@@ -564,6 +564,11 @@ indexHieFile se mod_summary srcPath !hash hf = do
564564
done <- readTVar indexCompleted
565565
remaining <- HashMap.size <$> readTVar indexPending
566566
pure (done, remaining)
567+
let
568+
progressFrac :: Double
569+
progressFrac = fromIntegral done / fromIntegral (done + remaining)
570+
progressPct :: LSP.UInt
571+
progressPct = floor $ 100 * progressFrac
567572

568573
whenJust (lspEnv se) $ \env -> whenJust tok $ \tok -> LSP.runLspT env $
569574
LSP.sendNotification LSP.SProgress $ LSP.ProgressParams tok $
@@ -572,7 +577,7 @@ indexHieFile se mod_summary srcPath !hash hf = do
572577
Percentage -> LSP.WorkDoneProgressReportParams
573578
{ _cancellable = Nothing
574579
, _message = Nothing
575-
, _percentage = Just (100 * fromIntegral done / fromIntegral (done + remaining) )
580+
, _percentage = Just progressPct
576581
}
577582
Explicit -> LSP.WorkDoneProgressReportParams
578583
{ _cancellable = Nothing

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

+26-9
Original file line numberDiff line numberDiff line change
@@ -20,21 +20,26 @@ module Development.IDE.Core.OfInterest(
2020
import Control.Concurrent.Strict
2121
import Control.Monad
2222
import Control.Monad.IO.Class
23-
import Data.HashMap.Strict (HashMap)
24-
import qualified Data.HashMap.Strict as HashMap
25-
import qualified Data.Text as T
23+
import Data.HashMap.Strict (HashMap)
24+
import qualified Data.HashMap.Strict as HashMap
25+
import qualified Data.Text as T
2626
import Development.IDE.Graph
2727

28-
import Control.Concurrent.STM.Stats (atomically,
29-
modifyTVar')
30-
import qualified Data.ByteString as BS
31-
import Data.Maybe (catMaybes)
28+
import Control.Concurrent.STM.Stats (atomically,
29+
modifyTVar')
30+
import Data.Aeson (toJSON)
31+
import qualified Data.ByteString as BS
32+
import Data.Maybe (catMaybes)
3233
import Development.IDE.Core.ProgressReporting
3334
import Development.IDE.Core.RuleTypes
3435
import Development.IDE.Core.Shake
36+
import Development.IDE.Plugin.Completions.Types
3537
import Development.IDE.Types.Exports
3638
import Development.IDE.Types.Location
3739
import Development.IDE.Types.Logger
40+
import Development.IDE.Types.Options (IdeTesting (..))
41+
import qualified Language.LSP.Server as LSP
42+
import qualified Language.LSP.Types as LSP
3843

3944
newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
4045
instance IsIdeGlobal OfInterestVar
@@ -109,11 +114,21 @@ scheduleGarbageCollection state = do
109114
kick :: Action ()
110115
kick = do
111116
files <- HashMap.keys <$> getFilesOfInterestUntracked
112-
ShakeExtras{exportsMap, progress} <- getShakeExtras
117+
ShakeExtras{exportsMap, ideTesting = IdeTesting testing, lspEnv, progress} <- getShakeExtras
118+
let signal msg = when testing $ liftIO $
119+
mRunLspT lspEnv $
120+
LSP.sendNotification (LSP.SCustomMethod msg) $
121+
toJSON $ map fromNormalizedFilePath files
122+
123+
signal "kick/start"
113124
liftIO $ progressUpdate progress KickStarted
114125

115126
-- Update the exports map
116-
results <- uses GenerateCore files <* uses GetHieAst files
127+
results <- uses GenerateCore files
128+
<* uses GetHieAst files
129+
-- needed to have non local completions on the first edit
130+
-- when the first edit breaks the module header
131+
<* uses NonLocalCompletions files
117132
let mguts = catMaybes results
118133
void $ liftIO $ atomically $ modifyTVar' exportsMap (updateExportsMapMg mguts)
119134

@@ -124,3 +139,5 @@ kick = do
124139
when garbageCollectionScheduled $ do
125140
void garbageCollectDirtyKeys
126141
liftIO $ writeVar var False
142+
143+
signal "kick/done"

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

+28-21
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,8 @@ import Data.List
3131
import qualified Data.Text as T
3232
import qualified Data.Vector.Unboxed as V
3333
import Language.LSP.Types (Position (Position), Range (Range),
34-
TextDocumentContentChangeEvent (TextDocumentContentChangeEvent))
34+
TextDocumentContentChangeEvent (TextDocumentContentChangeEvent),
35+
UInt)
3536

3637
-- | Either an exact position, or the range of text that was substituted
3738
data PositionResult a
@@ -140,14 +141,17 @@ toCurrent (Range start@(Position startLine startColumn) end@(Position endLine en
140141
where
141142
lineDiff = linesNew - linesOld
142143
linesNew = T.count "\n" t
143-
linesOld = endLine - startLine
144+
linesOld = fromIntegral endLine - fromIntegral startLine
145+
newEndColumn :: UInt
144146
newEndColumn
145-
| linesNew == 0 = startColumn + T.length t
146-
| otherwise = T.length $ T.takeWhileEnd (/= '\n') t
147+
| linesNew == 0 = fromIntegral $ fromIntegral startColumn + T.length t
148+
| otherwise = fromIntegral $ T.length $ T.takeWhileEnd (/= '\n') t
149+
newColumn :: UInt
147150
newColumn
148-
| line == endLine = column + newEndColumn - endColumn
151+
| line == endLine = fromIntegral $ (fromIntegral column + newEndColumn) - fromIntegral endColumn
149152
| otherwise = column
150-
newLine = line + lineDiff
153+
newLine :: UInt
154+
newLine = fromIntegral $ fromIntegral line + lineDiff
151155

152156
fromCurrent :: Range -> T.Text -> Position -> PositionResult Position
153157
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
163167
where
164168
lineDiff = linesNew - linesOld
165169
linesNew = T.count "\n" t
166-
linesOld = endLine - startLine
167-
newEndLine = endLine + lineDiff
170+
linesOld = fromIntegral endLine - fromIntegral startLine
171+
newEndLine :: UInt
172+
newEndLine = fromIntegral $ fromIntegral endLine + lineDiff
173+
newEndColumn :: UInt
168174
newEndColumn
169-
| linesNew == 0 = startColumn + T.length t
170-
| otherwise = T.length $ T.takeWhileEnd (/= '\n') t
175+
| linesNew == 0 = fromIntegral $ fromIntegral startColumn + T.length t
176+
| otherwise = fromIntegral $ T.length $ T.takeWhileEnd (/= '\n') t
177+
newColumn :: UInt
171178
newColumn
172-
| line == newEndLine = column - (newEndColumn - endColumn)
179+
| line == newEndLine = fromIntegral $ (fromIntegral column + fromIntegral endColumn) - newEndColumn
173180
| otherwise = column
174-
newLine = line - lineDiff
181+
newLine :: UInt
182+
newLine = fromIntegral $ fromIntegral line - lineDiff
175183

176184
deltaFromDiff :: T.Text -> T.Text -> PositionDelta
177185
deltaFromDiff (T.lines -> old) (T.lines -> new) =
178-
PositionDelta (lookupPos lnew o2nPrevs o2nNexts old2new) (lookupPos lold n2oPrevs n2oNexts new2old)
186+
PositionDelta (lookupPos (fromIntegral lnew) o2nPrevs o2nNexts old2new) (lookupPos (fromIntegral lold) n2oPrevs n2oNexts new2old)
179187
where
180188
!lnew = length new
181189
!lold = length old
@@ -194,17 +202,16 @@ deltaFromDiff (T.lines -> old) (T.lines -> new) =
194202
f :: Int -> Int -> Int
195203
f !a !b = if b == -1 then a else b
196204

197-
lookupPos :: Int -> V.Vector Int -> V.Vector Int -> V.Vector Int -> Position -> PositionResult Position
205+
lookupPos :: UInt -> V.Vector Int -> V.Vector Int -> V.Vector Int -> Position -> PositionResult Position
198206
lookupPos end prevs nexts xs (Position line col)
199-
| line < 0 = PositionRange (Position 0 0) (Position 0 0)
200-
| line >= V.length xs = PositionRange (Position end 0) (Position end 0)
201-
| otherwise = case V.unsafeIndex xs line of
207+
| line >= fromIntegral (V.length xs) = PositionRange (Position end 0) (Position end 0)
208+
| otherwise = case V.unsafeIndex xs (fromIntegral line) of
202209
-1 ->
203210
-- look for the previous and next lines that mapped successfully
204-
let !prev = 1 + V.unsafeIndex prevs line
205-
!next = V.unsafeIndex nexts line
206-
in PositionRange (Position prev 0) (Position next 0)
207-
line' -> PositionExact (Position line' col)
211+
let !prev = 1 + V.unsafeIndex prevs (fromIntegral line)
212+
!next = V.unsafeIndex nexts (fromIntegral line)
213+
in PositionRange (Position (fromIntegral prev) 0) (Position (fromIntegral next) 0)
214+
line' -> PositionExact (Position (fromIntegral line') col)
208215

209216
-- Construct a mapping between lines in the diff
210217
-- -1 for unsucessful mapping

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

+9-5
Original file line numberDiff line numberDiff line change
@@ -152,13 +152,17 @@ delayedProgressReporting before after lspEnv optProgressStyle = do
152152
}
153153
loop _ _ | optProgressStyle == NoProgress =
154154
forever $ liftIO $ threadDelay maxBound
155-
loop id prev = do
155+
loop id prevPct = do
156156
done <- liftIO $ readTVarIO doneVar
157157
todo <- liftIO $ readTVarIO todoVar
158158
liftIO $ sleep after
159159
if todo == 0 then loop id 0 else do
160-
let next = 100 * fromIntegral done / fromIntegral todo
161-
when (next /= prev) $
160+
let
161+
nextFrac :: Double
162+
nextFrac = fromIntegral done / fromIntegral todo
163+
nextPct :: UInt
164+
nextPct = floor $ 100 * nextFrac
165+
when (nextPct /= prevPct) $
162166
LSP.sendNotification LSP.SProgress $
163167
LSP.ProgressParams
164168
{ _token = id
@@ -171,11 +175,11 @@ delayedProgressReporting before after lspEnv optProgressStyle = do
171175
Percentage -> LSP.WorkDoneProgressReportParams
172176
{ _cancellable = Nothing
173177
, _message = Nothing
174-
, _percentage = Just next
178+
, _percentage = Just nextPct
175179
}
176180
NoProgress -> error "unreachable"
177181
}
178-
loop id next
182+
loop id nextPct
179183

180184
updateStateForFile inProgress file = actionBracket (f succ) (const $ f pred) . const
181185
-- This functions are deliberately eta-expanded to avoid space leaks.

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

+4-3
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,8 @@ import Development.IDE.Spans.Common
4343
import Development.IDE.Spans.LocalBindings
4444
import Development.IDE.Types.Diagnostics
4545
import GHC.Serialized (Serialized)
46-
import Language.LSP.Types (NormalizedFilePath)
46+
import Language.LSP.Types (Int32,
47+
NormalizedFilePath)
4748

4849
data LinkableType = ObjectLinkable | BCOLinkable
4950
deriving (Eq,Ord,Show, Generic)
@@ -290,13 +291,13 @@ pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}
290291
type instance RuleResult GetModificationTime = FileVersion
291292

292293
data FileVersion
293-
= VFSVersion !Int
294+
= VFSVersion !Int32
294295
| ModificationTime !POSIXTime
295296
deriving (Show, Generic)
296297

297298
instance NFData FileVersion
298299

299-
vfsVersion :: FileVersion -> Maybe Int
300+
vfsVersion :: FileVersion -> Maybe Int32
300301
vfsVersion (VFSVersion i) = Just i
301302
vfsVersion ModificationTime{} = Nothing
302303

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -1178,7 +1178,7 @@ updateFileDiagnostics fp k ShakeExtras{logger, diagnostics, hiddenDiagnostics, p
11781178
logInfo logger $ showDiagnosticsColored $ map (fp,ShowDiag,) newDiags
11791179
Just env -> LSP.runLspT env $
11801180
LSP.sendNotification LSP.STextDocumentPublishDiagnostics $
1181-
LSP.PublishDiagnosticsParams (fromNormalizedUri uri) ver (List newDiags)
1181+
LSP.PublishDiagnosticsParams (fromNormalizedUri uri) (fmap fromIntegral ver) (List newDiags)
11821182
return action
11831183

11841184
newtype Priority = Priority Double

‎ghcide/src/Development/IDE/GHC/Error.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -79,7 +79,7 @@ realSrcSpanToRange real =
7979

8080
realSrcLocToPosition :: RealSrcLoc -> Position
8181
realSrcLocToPosition real =
82-
Position (srcLocLine real - 1) (srcLocCol real - 1)
82+
Position (fromIntegral $ srcLocLine real - 1) (fromIntegral $ srcLocCol real - 1)
8383

8484
-- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
8585
-- FIXME This may not be an _absolute_ file name, needs fixing.
@@ -111,7 +111,7 @@ rangeToRealSrcSpan nfp =
111111

112112
positionToRealSrcLoc :: NormalizedFilePath -> Position -> RealSrcLoc
113113
positionToRealSrcLoc nfp (Position l c)=
114-
Compat.mkRealSrcLoc (fromString $ fromNormalizedFilePath nfp) (l + 1) (c + 1)
114+
Compat.mkRealSrcLoc (fromString $ fromNormalizedFilePath nfp) (fromIntegral $ l + 1) (fromIntegral $ c + 1)
115115

116116
isInsideSrcSpan :: Position -> SrcSpan -> Bool
117117
p `isInsideSrcSpan` r = case srcSpanToRange r of

0 commit comments

Comments
 (0)