From 5940164bef0240b43e0a03922207e4b277ea23f6 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Wed, 15 Dec 2021 16:25:34 +0000 Subject: [PATCH 1/6] Update to latest version of lsp libraries --- cabal-ghc901.project | 2 +- cabal-ghc921.project | 2 +- cabal.project | 2 +- ghcide/bench/example/HLS | 1 - ghcide/bench/lib/Experiments.hs | 16 ++--- ghcide/ghcide.cabal | 4 +- ghcide/src/Development/IDE/Core/Compile.hs | 7 +- .../Development/IDE/Core/PositionMapping.hs | 49 +++++++------ .../Development/IDE/Core/ProgressReporting.hs | 14 ++-- ghcide/src/Development/IDE/Core/RuleTypes.hs | 7 +- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- ghcide/src/Development/IDE/GHC/Error.hs | 4 +- ghcide/src/Development/IDE/LSP/Outline.hs | 8 +-- .../src/Development/IDE/Plugin/CodeAction.hs | 12 ++-- .../IDE/Plugin/Completions/Logic.hs | 8 +-- .../src/Development/IDE/Plugin/TypeLenses.hs | 2 +- ghcide/src/Development/IDE/Spans/AtPoint.hs | 18 ++--- ghcide/src/Development/IDE/Spans/Pragmas.hs | 8 +-- .../src/Development/IDE/Types/Diagnostics.hs | 2 +- ghcide/test/exe/Main.hs | 69 +++++++++---------- .../src/Development/IDE/Test/Diagnostic.hs | 2 +- hls-plugin-api/hls-plugin-api.cabal | 2 +- hls-plugin-api/src/Ide/PluginUtils.hs | 20 +++--- hls-plugin-api/src/Ide/Types.hs | 4 +- hls-test-utils/hls-test-utils.cabal | 4 +- hls-test-utils/src/Test/Hls/Util.hs | 2 +- .../test/Main.hs | 4 +- .../src/Ide/Plugin/Brittany.hs | 66 ++++++++++-------- .../src/Ide/Plugin/CallHierarchy/Internal.hs | 6 +- .../hls-call-hierarchy-plugin/test/Main.hs | 2 +- .../src/Ide/Plugin/Eval/Code.hs | 11 +-- .../src/Ide/Plugin/Eval/CodeLens.hs | 4 +- .../src/Ide/Plugin/Eval/Parse/Comments.hs | 11 +-- .../hls-explicit-imports-plugin/test/Main.hs | 4 +- .../src/Ide/Plugin/Fourmolu.hs | 4 +- .../hls-haddock-comments-plugin/test/Main.hs | 4 +- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 12 ++-- plugins/hls-hlint-plugin/test/Main.hs | 4 +- .../src/Ide/Plugin/Ormolu.hs | 4 +- .../src/Ide/Plugin/Pragmas.hs | 2 +- plugins/hls-pragmas-plugin/test/Main.hs | 2 +- .../src/Ide/Plugin/QualifyImportedNames.hs | 2 +- .../test/Main.hs | 4 +- .../hls-refine-imports-plugin/test/Main.hs | 4 +- plugins/hls-splice-plugin/test/Main.hs | 4 +- .../hls-tactics-plugin/src/Wingman/Range.hs | 5 +- plugins/hls-tactics-plugin/test/Utils.hs | 4 +- stack-8.10.6.yaml | 6 +- stack-8.10.7.yaml | 6 +- stack-8.6.5.yaml | 8 ++- stack-8.8.4.yaml | 6 +- stack.yaml | 6 +- test/functional/Progress.hs | 2 +- test/functional/TypeDefinition.hs | 2 +- 54 files changed, 243 insertions(+), 227 deletions(-) delete mode 100644 ghcide/bench/example/HLS diff --git a/cabal-ghc901.project b/cabal-ghc901.project index c536524a45..f813020ae7 100644 --- a/cabal-ghc901.project +++ b/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 diff --git a/cabal-ghc921.project b/cabal-ghc921.project index fa7ced63d0..fe534c783c 100644 --- a/cabal-ghc921.project +++ b/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 diff --git a/cabal.project b/cabal.project index ffc53d8fae..01730a4d87 100644 --- a/cabal.project +++ b/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 diff --git a/ghcide/bench/example/HLS b/ghcide/bench/example/HLS deleted file mode 100644 index f95f775b78..0000000000 --- a/ghcide/bench/example/HLS +++ /dev/null @@ -1 +0,0 @@ -../../.. diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs index 3aeed09e66..d12c051aee 100644 --- a/ghcide/bench/lib/Experiments.hs +++ b/ghcide/bench/lib/Experiments.hs @@ -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 diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index e4095e239d..0728f0388b 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -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, diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 7b002f08fa..caf1035c01 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -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 diff --git a/ghcide/src/Development/IDE/Core/PositionMapping.hs b/ghcide/src/Development/IDE/Core/PositionMapping.hs index bd4ae9dc69..8ba2b11457 100644 --- a/ghcide/src/Development/IDE/Core/PositionMapping.hs +++ b/ghcide/src/Development/IDE/Core/PositionMapping.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 diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs index 79236aa2fa..7bb6e11944 100644 --- a/ghcide/src/Development/IDE/Core/ProgressReporting.hs +++ b/ghcide/src/Development/IDE/Core/ProgressReporting.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. diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index fb4738c83e..5b14d9b4e8 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.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 diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 0dda58478e..cd8ba904d4 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1176,7 +1176,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 diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs index 6abb3917a4..74a72148c8 100644 --- a/ghcide/src/Development/IDE/GHC/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Error.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 diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 82bdc573cd..1056e5dbc4 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -46,13 +46,7 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif (defDocumentSymbol l :: DocumentSymbol) { _name = pprText m , _kind = SkFile - , _range = Range (Position 0 0) (Position 2147483647 0) -- _ltop is 0 0 0 0 - -- In the lsp spec from 3.16 Position takes a uinteger, - -- where uinteger is 0 - 2^31 - 1. lsp-types currently has the type of line - -- as Int. So instead of using `maxBound :: Int` we hardcode the maxBound of - -- uinteger. 2 ^ 31 - 1 == 2147483647 - -- Check this issue for tracking https://github.com/haskell/lsp/issues/354 - -- the change in lsp-types. + , _range = Range (Position 0 0) (Position maxBound 0) -- _ltop is 0 0 0 0 } _ -> Nothing importSymbols = maybe [] pure $ diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index acd76150ed..cfcba318f8 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -71,6 +71,7 @@ import Language.LSP.Types (CodeAction ( SMethod (STextDocumentCodeAction), TextDocumentIdentifier (TextDocumentIdentifier), TextEdit (TextEdit), + UInt, WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), type (|?) (InR), uriToFilePath) @@ -1095,8 +1096,8 @@ suggestInstanceConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing | otherwise = Nothing - readPositionNumber :: T.Text -> Int - readPositionNumber = T.unpack >>> read + readPositionNumber :: T.Text -> UInt + readPositionNumber = T.unpack >>> read @Integer >>> fromIntegral actionTitle :: T.Text -> T.Text actionTitle constraint = "Add `" <> constraint @@ -1305,9 +1306,10 @@ newImportToEdit (unNewImport -> imp) ps fileContents -- * otherwise inserted one line after the last file-header pragma newImportInsertRange :: ParsedSource -> T.Text -> Maybe (Range, Int) newImportInsertRange (L _ HsModule {..}) fileContents - | Just (uncurry Position -> insertPos, col) <- case hsmodImports of + | Just ((l, c), col) <- case hsmodImports of [] -> findPositionNoImports hsmodName hsmodExports fileContents _ -> findPositionFromImportsOrModuleDecl hsmodImports last True + , let insertPos = Position (fromIntegral l) (fromIntegral c) = Just (Range insertPos insertPos, col) | otherwise = Nothing @@ -1505,7 +1507,7 @@ extendToWholeLineIfPossible contents range@Range{..} = in if extend then Range _start (Position (_line _end + 1) 0) else range splitTextAtPosition :: Position -> T.Text -> (T.Text, T.Text) -splitTextAtPosition (Position row col) x +splitTextAtPosition (Position (fromIntegral -> row) (fromIntegral -> col)) x | (preRow, mid:postRow) <- splitAt row $ T.splitOn "\n" x , (preCol, postCol) <- T.splitAt col mid = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow) @@ -1513,7 +1515,7 @@ splitTextAtPosition (Position row col) x -- | Returns [start .. end[ textInRange :: Range -> T.Text -> T.Text -textInRange (Range (Position startRow startCol) (Position endRow endCol)) text = +textInRange (Range (Position (fromIntegral -> startRow) (fromIntegral -> startCol)) (Position (fromIntegral -> endRow) (fromIntegral -> endCol))) text = case compare startRow endRow of LT -> let (linesInRangeBeforeEndLine, endLineAndFurtherLines) = splitAt (endRow - startRow) linesBeginningWithStartLine diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index ebf52a0cc1..3d9caccfa7 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -696,8 +696,8 @@ uniqueCompl candidate unique = -- --------------------------------------------------------------------- hasTrailingBacktick :: T.Text -> Position -> Bool -hasTrailingBacktick line Position { _character } - | T.length line > _character = (line `T.index` _character) == '`' +hasTrailingBacktick line Position { _character=(fromIntegral -> c) } + | T.length line > c = (line `T.index` c) == '`' | otherwise = False isUsedAsInfix :: T.Text -> T.Text -> T.Text -> Position -> Maybe Backtick @@ -710,7 +710,7 @@ isUsedAsInfix line prefixMod prefixText pos hasClosingBacktick = hasTrailingBacktick line pos openingBacktick :: T.Text -> T.Text -> T.Text -> Position -> Bool -openingBacktick line prefixModule prefixText Position { _character } +openingBacktick line prefixModule prefixText Position { _character=(fromIntegral -> c) } | backtickIndex < 0 || backtickIndex > T.length line = False | otherwise = (line `T.index` backtickIndex) == '`' where @@ -723,7 +723,7 @@ openingBacktick line prefixModule prefixText Position { _character } else T.length prefixModule + 1 {- Because of "." -} in -- Points to the first letter of either the module or prefix text - _character - (prefixLength + moduleLength) - 1 + c - (prefixLength + moduleLength) - 1 -- --------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index b29be7ab03..127afe57d0 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -174,7 +174,7 @@ suggestLocalSignature isQuickFix mTmr mBindings Diagnostic{_message, _range = _r , startOfLine <- Position (_line _start) startCharacter , beforeLine <- Range startOfLine startOfLine , title <- if isQuickFix then "add signature: " <> signature else signature - , action <- TextEdit beforeLine $ signature <> "\n" <> T.replicate startCharacter " " = + , action <- TextEdit beforeLine $ signature <> "\n" <> T.replicate (fromIntegral startCharacter) " " = [(title, [action])] | otherwise = [] diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 36bdd58303..c3f883b87f 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -135,8 +135,8 @@ rowToLoc :: Res RefRow -> Maybe Location rowToLoc (row:.info) = flip Location range <$> mfile where range = Range start end - start = Position (refSLine row - 1) (refSCol row -1) - end = Position (refELine row - 1) (refECol row -1) + start = Position (fromIntegral $ refSLine row - 1) (fromIntegral $ refSCol row -1) + end = Position (fromIntegral $ refELine row - 1) (fromIntegral $ refECol row -1) mfile = case modInfoSrcFile info of Just f -> Just $ toUri f Nothing -> Nothing @@ -147,8 +147,8 @@ typeRowToLoc (row:.info) = do pure $ Location (toUri file) range where range = Range start end - start = Position (typeRefSLine row - 1) (typeRefSCol row -1) - end = Position (typeRefELine row - 1) (typeRefECol row -1) + start = Position (fromIntegral $ typeRefSLine row - 1) (fromIntegral $ typeRefSCol row -1) + end = Position (fromIntegral $ typeRefELine row - 1) (fromIntegral $ typeRefECol row -1) documentHighlight :: Monad m @@ -359,8 +359,8 @@ nameToLocation hiedb lookupModule name = runMaybeT $ defRowToLocation :: Monad m => LookupModule m -> Res DefRow -> MaybeT m Location defRowToLocation lookupModule (row:.info) = do - let start = Position (defSLine row - 1) (defSCol row - 1) - end = Position (defELine row - 1) (defECol row - 1) + let start = Position (fromIntegral $ defSLine row - 1) (fromIntegral $ defSCol row - 1) + end = Position (fromIntegral $ defELine row - 1) (fromIntegral $ defECol row - 1) range = Range start end file <- case modInfoSrcFile info of Just src -> pure $ toUri src @@ -382,8 +382,8 @@ defRowToSymbolInfo (DefRow{..}:.(modInfoSrcFile -> Just srcFile)) loc = Location file range file = fromNormalizedUri . filePathToUri' . toNormalizedFilePath' $ srcFile range = Range start end - start = Position (defSLine - 1) (defSCol - 1) - end = Position (defELine - 1) (defECol - 1) + start = Position (fromIntegral $ defSLine - 1) (fromIntegral $ defSCol - 1) + end = Position (fromIntegral $ defELine - 1) (fromIntegral $ defECol - 1) defRowToSymbolInfo _ = Nothing pointCommand :: HieASTs t -> Position -> (HieAST t -> a) -> [a] @@ -403,7 +403,7 @@ pointCommand hf pos k = Nothing -> Nothing Just ast' -> Just $ k ast' where - sloc fs = mkRealSrcLoc fs (line+1) (cha+1) + sloc fs = mkRealSrcLoc fs (fromIntegral $ line+1) (fromIntegral $ cha+1) sp fs = mkRealSrcSpan (sloc fs) (sloc fs) line = _line pos cha = _character pos diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index 132e1e460b..1ce7eb88bb 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -85,7 +85,7 @@ updateLineSplitTextEdits tokenRange tokenString prevLineSplitTextEdits , let currInsertRange = prevInsertRange , let currInsertText = Text.init prevInsertText - <> Text.replicate (startCol - prevDeleteEndCol) " " + <> Text.replicate (fromIntegral $ startCol - prevDeleteEndCol) " " <> Text.pack (List.take newLineCol tokenString) <> "\n" , let currInsertTextEdit = LSP.TextEdit currInsertRange currInsertText @@ -96,7 +96,7 @@ updateLineSplitTextEdits tokenRange tokenString prevLineSplitTextEdits = LineSplitTextEdits currInsertTextEdit currDeleteTextEdit | otherwise , let LSP.Range startPos _ = tokenRange - , let deleteTextEdit = LSP.TextEdit (LSP.Range startPos startPos{ LSP._character = startCol + newLineCol }) "" + , let deleteTextEdit = LSP.TextEdit (LSP.Range startPos startPos{ LSP._character = startCol + fromIntegral newLineCol }) "" , let insertPosition = LSP.Position (startLine + 1) 0 , let insertRange = LSP.Range insertPosition insertPosition , let insertText = Text.pack (List.take newLineCol tokenString) <> "\n" @@ -117,7 +117,7 @@ updateParserState token range prevParserState , lastPragmaLine } <- prevParserState , let defaultParserState = prevParserState { isLastTokenHash = False } - , let LSP.Range (LSP.Position startLine _) (LSP.Position endLine _) = range + , let LSP.Range (LSP.Position (fromIntegral -> startLine) _) (LSP.Position (fromIntegral -> endLine) _) = range = case prevMode of ModeInitial -> case token of @@ -235,7 +235,7 @@ updateParserState token range prevParserState , let LSP.TextEdit deleteRange _ = lineSplitDeleteTextEdit , let LSP.Range _ deleteEndPosition = deleteRange , let LSP.Position deleteEndLine _ = deleteEndPosition - = deleteEndLine == line + = fromIntegral deleteEndLine == line | otherwise = False lexUntilNextLineIncl :: P (Located Token) diff --git a/ghcide/src/Development/IDE/Types/Diagnostics.hs b/ghcide/src/Development/IDE/Types/Diagnostics.hs index 77c8ae5c6f..1420995be7 100644 --- a/ghcide/src/Development/IDE/Types/Diagnostics.hs +++ b/ghcide/src/Development/IDE/Types/Diagnostics.hs @@ -92,7 +92,7 @@ type FileDiagnostic = (NormalizedFilePath, ShowDiagnostic, Diagnostic) prettyRange :: Range -> Doc Terminal.AnsiStyle prettyRange Range{..} = f _start <> "-" <> f _end - where f Position{..} = pretty (_line+1) <> colon <> pretty (_character+1) + where f Position{..} = pretty (show $ _line+1) <> colon <> pretty (show $ _character+1) stringParagraphs :: T.Text -> Doc a stringParagraphs = vcat . map (fillSep . map pretty . T.words) . T.lines diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 6a366ebbdd..f51d61a31f 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -89,7 +89,7 @@ import Test.QuickCheck -- import Test.QuickCheck.Instances () import Control.Concurrent (threadDelay) import Control.Concurrent.Async -import Control.Lens ((^.)) +import Control.Lens ((^.), to) import Control.Monad.Extra (whenJust) import Data.IORef import Data.IORef.Extra (atomicModifyIORef_) @@ -1991,8 +1991,8 @@ suggestImportTests = testGroup "suggest import actions" _diags <- waitForDiagnostics -- there isn't a good way to wait until the whole project is checked atm when waitForCheckProject $ liftIO $ sleep 0.5 - let defLine = length imps + 1 - range = Range (Position defLine 0) (Position defLine maxBoundUinteger) + let defLine = fromIntegral $ length imps + 1 + range = Range (Position defLine 0) (Position defLine maxBound) actions <- getCodeActions doc range if wanted then do @@ -2305,7 +2305,7 @@ suggestHideShadowTests = doc <- createDoc "A.hs" "haskell" $ T.unlines (header <> origin) void waitForDiagnostics waitForProgressDone - cas <- getCodeActions doc (Range (Position (line1 + length header) col1) (Position (line2 + length header) col2)) + cas <- getCodeActions doc (Range (Position (fromIntegral $ line1 + length header) col1) (Position (fromIntegral $ line2 + length header) col2)) void $ k [x | x@(InR ca) <- cas, "Hide" `T.isPrefixOf` (ca ^. L.title)] contentAfter <- documentContents doc liftIO $ contentAfter @?= T.unlines (header <> expected) @@ -2740,7 +2740,7 @@ fillTypedHoleTests = let let expectedCode = sourceCode newA newB newC doc <- createDoc "Testing.hs" "haskell" originalCode _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 9 0) (Position 9 maxBoundUinteger)) + actionsOrCommands <- getCodeActions doc (Range (Position 9 0) (Position 9 maxBound)) chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands executeCodeAction chosenAction modifiedCode <- documentContents doc @@ -2781,7 +2781,7 @@ fillTypedHoleTests = let , "ioToSome = " <> x ] doc <- createDoc "Test.hs" "haskell" $ mkDoc "_toException" _ <- waitForDiagnostics - actions <- getCodeActions doc (Range (Position 3 0) (Position 3 maxBoundUinteger)) + actions <- getCodeActions doc (Range (Position 3 0) (Position 3 maxBound)) chosen <- liftIO $ pickActionWithTitle "replace _toException with E.toException" actions executeCodeAction chosen modifiedCode <- documentContents doc @@ -3276,7 +3276,7 @@ addSigActionTests = let let expectedCode = after' def sig doc <- createDoc "Sigs.hs" "haskell" originalCode _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 5 1) (Position 5 maxBoundUinteger)) + actionsOrCommands <- getCodeActions doc (Range (Position 5 1) (Position 5 maxBound)) chosenAction <- liftIO $ pickActionWithTitle ("add signature: " <> sig) actionsOrCommands executeCodeAction chosenAction modifiedCode <- documentContents doc @@ -4091,9 +4091,9 @@ cppTests = "foo = 42" ] -- The error locations differ depending on which C-preprocessor is used. - -- Some give the column number and others don't (hence -1). Assert either + -- Some give the column number and others don't (hence maxBound == -1 unsigned). Assert either -- of them. - (run $ expectError content (2, -1)) + (run $ expectError content (2, maxBound)) `catch` ( \e -> do let _ = e :: HUnitFailure run $ expectError content (2, 1) @@ -5185,7 +5185,7 @@ outlineTests = testGroup SkFile Nothing Nothing - (R 0 0 maxBoundUinteger 0) + (R 0 0 maxBound 0) loc (Just $ List cc) classSymbol name loc cc = DocumentSymbol name @@ -5197,7 +5197,7 @@ outlineTests = testGroup loc (Just $ List cc) -pattern R :: Int -> Int -> Int -> Int -> Range +pattern R :: UInt -> UInt -> UInt -> UInt -> Range pattern R x y x' y' = Range (Position x y) (Position x' y') xfail :: TestTree -> String -> TestTree @@ -5238,10 +5238,10 @@ data Expect -- | ExpectExtern -- TODO: as above, but expected to succeed: need some more info in here, once we have some working examples deriving Eq -mkR :: Int -> Int -> Int -> Int -> Expect +mkR :: UInt -> UInt -> UInt -> UInt -> Expect mkR startLine startColumn endLine endColumn = ExpectRange $ mkRange startLine startColumn endLine endColumn -mkL :: Uri -> Int -> Int -> Int -> Int -> Expect +mkL :: Uri -> UInt -> UInt -> UInt -> UInt -> Expect mkL uri startLine startColumn endLine endColumn = ExpectLocation $ Location uri $ mkRange startLine startColumn endLine endColumn haddockTests :: TestTree @@ -5928,14 +5928,14 @@ referenceTest name loc includeDeclaration expected = where docs = map fst3 expected -type SymbolLocation = (FilePath, Int, Int) +type SymbolLocation = (FilePath, UInt, UInt) expectSameLocations :: [Location] -> [SymbolLocation] -> Assertion expectSameLocations actual expected = do let actual' = Set.map (\location -> (location ^. L.uri - , location ^. L.range . L.start . L.line - , location ^. L.range . L.start . L.character)) + , location ^. L.range . L.start . L.line . to fromIntegral + , location ^. L.range . L.start . L.character . to fromIntegral)) $ Set.fromList actual expected' <- Set.fromList <$> (forM expected $ \(file, l, c) -> do @@ -5981,7 +5981,7 @@ pickActionWithTitle title actions = do , title == actionTitle ] -mkRange :: Int -> Int -> Int -> Int -> Range +mkRange :: UInt -> UInt -> UInt -> UInt -> Range mkRange a b c d = Range (Position a b) (Position c d) run :: Session a -> IO a @@ -6050,7 +6050,7 @@ getConfigFromEnv = do convertVal _ = True lspTestCaps :: ClientCapabilities -lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities $ Just True } +lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing } openTestDataDoc :: FilePath -> Session TextDocumentIdentifier openTestDataDoc path = do @@ -6382,24 +6382,28 @@ genRope = Rope.fromText . getPrintableText <$> arbitrary genPosition :: Rope -> Gen Position genPosition r = do - row <- choose (0, max 0 $ rows - 1) + let rows = Rope.rows r + row <- choose (0, max 0 $ rows - 1) `suchThat` inBounds @UInt let columns = Rope.columns (nthLine row r) - column <- choose (0, max 0 $ columns - 1) - pure $ Position row column - where rows = Rope.rows r + column <- choose (0, max 0 $ columns - 1) `suchThat` inBounds @UInt + pure $ Position (fromIntegral row) (fromIntegral column) genRange :: Rope -> Gen Range genRange r = do + let rows = Rope.rows r startPos@(Position startLine startColumn) <- genPosition r - let maxLineDiff = max 0 $ rows - 1 - startLine - endLine <- choose (startLine, startLine + maxLineDiff) - let columns = Rope.columns (nthLine endLine r) + let maxLineDiff = max 0 $ rows - 1 - fromIntegral startLine + endLine <- choose (fromIntegral startLine, fromIntegral startLine + maxLineDiff) `suchThat` inBounds @UInt + let columns = Rope.columns (nthLine (fromIntegral endLine) r) endColumn <- - if startLine == endLine - then choose (startColumn, columns) + if fromIntegral startLine == endLine + then choose (fromIntegral startColumn, columns) else choose (0, max 0 $ columns - 1) - pure $ Range startPos (Position endLine endColumn) - where rows = Rope.rows r + `suchThat` inBounds @UInt + pure $ Range startPos (Position (fromIntegral endLine) (fromIntegral endColumn)) + +inBounds :: forall b a . (Integral a, Integral b, Bounded b) => a -> Bool +inBounds a = let i = toInteger a in i <= toInteger (maxBound @b) && i >= toInteger (minBound @b) -- | Get the ith line of a rope, starting from 0. Trailing newline not included. nthLine :: Int -> Rope -> Rope @@ -6438,11 +6442,6 @@ listOfChar | ghcVersion >= GHC90 = "String" | otherwise = "[Char]" -- | Ghc 9 doesn't include the $-sign in TH warnings like earlier versions did -thDollarIdx :: Int +thDollarIdx :: UInt thDollarIdx | ghcVersion >= GHC90 = 1 | otherwise = 0 - --- | We don't have a uinteger type yet. So hardcode the maxBound of uinteger, 2 ^ 31 - 1 --- as a constant. -maxBoundUinteger :: Int -maxBoundUinteger = 2147483647 diff --git a/ghcide/test/src/Development/IDE/Test/Diagnostic.hs b/ghcide/test/src/Development/IDE/Test/Diagnostic.hs index 2a1b812f7e..8bf8bc1e9f 100644 --- a/ghcide/test/src/Development/IDE/Test/Diagnostic.hs +++ b/ghcide/test/src/Development/IDE/Test/Diagnostic.hs @@ -7,7 +7,7 @@ import Language.LSP.Types import Language.LSP.Types.Lens as Lsp -- | (0-based line number, 0-based column number) -type Cursor = (Int, Int) +type Cursor = (UInt, UInt) cursorPosition :: Cursor -> Position cursorPosition (line, col) = Position line col diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index a8670669f0..12c66bc3cd 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -49,7 +49,7 @@ library , hls-graph >=1.4 && < 1.6 , hslogger , lens - , lsp ^>=1.2.0.1 + , lsp ^>=1.4.0.0 , opentelemetry , optparse-applicative , process diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index ae9a7d93f9..4b679f3343 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -107,15 +107,15 @@ diffTextEdit fText f2Text withDeletions = J.List r -} diffOperationToTextEdit (Deletion (LineRange (sl, el) _) _) = J.TextEdit range "" where - range = J.Range (J.Position (sl - 1) 0) - (J.Position el 0) + range = J.Range (J.Position (fromIntegral $ sl - 1) 0) + (J.Position (fromIntegral el) 0) diffOperationToTextEdit (Addition fm l) = J.TextEdit range nt -- fm has a range wrt to the changed file, which starts in the current file at l + 1 -- So the range has to be shifted to start at l + 1 where - range = J.Range (J.Position l 0) - (J.Position l 0) + range = J.Range (J.Position (fromIntegral l) 0) + (J.Position (fromIntegral l) 0) nt = T.pack $ unlines $ lrContents fm @@ -123,10 +123,10 @@ diffTextEdit fText f2Text withDeletions = J.List r where sl = fst $ lrNumbers fm sc = 0 - s = J.Position (sl - 1) sc -- Note: zero-based lines + s = J.Position (fromIntegral $ sl - 1) sc -- Note: zero-based lines el = snd $ lrNumbers fm - ec = length $ last $ lrContents fm - e = J.Position (el - 1) ec -- Note: zero-based lines + ec = fromIntegral $ length $ last $ lrContents fm + e = J.Position (fromIntegral $ el - 1) ec -- Note: zero-based lines -- | A pure version of 'diffText' for testing @@ -145,7 +145,7 @@ diffText' supports (f,fText) f2Text withDeletions = clientSupportsDocumentChanges :: ClientCapabilities -> Bool clientSupportsDocumentChanges caps = - let ClientCapabilities mwCaps _ _ _ = caps + let ClientCapabilities mwCaps _ _ _ _ = caps supports = do wCaps <- mwCaps WorkspaceEditClientCapabilities mDc _ _ _ _ <- _workspaceEdit wCaps @@ -197,7 +197,7 @@ usePropertyLsp kn pId p = do extractRange :: Range -> T.Text -> T.Text extractRange (Range (Position sl _) (Position el _)) s = newS - where focusLines = take (el-sl+1) $ drop sl $ T.lines s + where focusLines = take (fromIntegral $ el-sl+1) $ drop (fromIntegral sl) $ T.lines s newS = T.unlines focusLines -- | Gets the range that covers the entire text @@ -212,7 +212,7 @@ fullRange s = Range startPos endPos the line ending character(s) then use an end position denoting the start of the next line" -} - lastLine = length $ T.lines s + lastLine = fromIntegral $ length $ T.lines s subRange :: Range -> Range -> Bool subRange smallRange range = diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index ce184905d3..4d655cee0c 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -178,7 +178,7 @@ class HasTracing (MessageParams m) => PluginMethod m where instance PluginMethod TextDocumentCodeAction where pluginEnabled _ = pluginEnabledConfig plcCodeActionsOn - combineResponses _method _config (ClientCapabilities _ textDocCaps _ _) (CodeActionParams _ _ _ _ context) resps = + combineResponses _method _config (ClientCapabilities _ textDocCaps _ _ _) (CodeActionParams _ _ _ _ context) resps = fmap compat $ List $ filter wasRequested $ (\(List x) -> x) $ sconcat resps where @@ -224,7 +224,7 @@ instance PluginMethod TextDocumentHover where instance PluginMethod TextDocumentDocumentSymbol where pluginEnabled _ = pluginEnabledConfig plcSymbolsOn - combineResponses _ _ (ClientCapabilities _ tdc _ _) params xs = res + combineResponses _ _ (ClientCapabilities _ tdc _ _ _) params xs = res where uri' = params ^. textDocument . uri supportsHierarchy = Just True == (tdc >>= _documentSymbol >>= _hierarchicalDocumentSymbolSupport) diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal index 51d1fea93a..5eb4c7cfaa 100644 --- a/hls-test-utils/hls-test-utils.cabal +++ b/hls-test-utils/hls-test-utils.cabal @@ -47,9 +47,9 @@ library , hspec <2.8 , hspec-core , lens - , lsp ^>=1.2 + , lsp ^>=1.4 , lsp-test ^>=0.14 - , lsp-types >=1.2 && <1.4 + , lsp-types ^>=1.4 , tasty , tasty-expected-failure , tasty-golden diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index 9add1ca02f..57df6cd2da 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -433,7 +433,7 @@ failIfSessionTimeout action = action `catch` errorHandler -- | To locate a symbol, we provide a path to the file from the HLS root -- directory, the line number, and the column number. (0 indexed.) -type SymbolLocation = (FilePath, Int, Int) +type SymbolLocation = (FilePath, UInt, UInt) expectSameLocations :: [Location] -> [SymbolLocation] -> Assertion actual `expectSameLocations` expected = do diff --git a/plugins/hls-alternate-number-format-plugin/test/Main.hs b/plugins/hls-alternate-number-format-plugin/test/Main.hs index ad19324bcb..cda83db6b7 100644 --- a/plugins/hls-alternate-number-format-plugin/test/Main.hs +++ b/plugins/hls-alternate-number-format-plugin/test/Main.hs @@ -133,8 +133,8 @@ codeActionTitle' CodeAction{_title} = _title pointRange :: Int -> Int -> Range pointRange - (subtract 1 -> line) - (subtract 1 -> col) = + (subtract 1 -> fromIntegral -> line) + (subtract 1 -> fromIntegral -> col) = Range (Position line col) (Position line $ col + 1) contains :: [CodeAction] -> Text -> Bool diff --git a/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs b/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs index 91d46d844b..692f83b67c 100644 --- a/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs +++ b/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs @@ -1,48 +1,54 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE LambdaCase #-} module Ide.Plugin.Brittany where -import Control.Exception (bracket_) +import Control.Exception (bracket_) import Control.Lens import Control.Monad.IO.Class -import Control.Monad.Trans.Maybe (MaybeT, runMaybeT) -import Data.Maybe (mapMaybe, maybeToList, fromMaybe) +import Control.Monad.Trans.Maybe (MaybeT, + runMaybeT) +import Data.Maybe (fromMaybe, + mapMaybe, + maybeToList) import Data.Semigroup -import Data.Text (Text) -import qualified Data.Text as T -import Development.IDE hiding (pluginHandlers) -import qualified Development.IDE.GHC.Compat as GHC hiding (Cpp) -import qualified DynFlags as D -import qualified EnumSet as S +import Data.Text (Text) +import qualified Data.Text as T +import Development.IDE hiding + (pluginHandlers) +import qualified Development.IDE.GHC.Compat as GHC hiding + (Cpp) +import qualified DynFlags as D +import qualified EnumSet as S import GHC.LanguageExtensions.Type import Ide.PluginUtils import Ide.Types import Language.Haskell.Brittany -import Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J -import System.Environment (setEnv, unsetEnv) +import Language.LSP.Types as J +import qualified Language.LSP.Types.Lens as J +import System.Environment (setEnv, + unsetEnv) import System.FilePath -- These imports are for the temporary pPrintText & can be removed when -- issue #2005 is resolved -import Language.Haskell.Brittany.Internal.Config.Types +import Control.Monad.Trans.Class (lift) +import qualified Control.Monad.Trans.Except as ExceptT +import Data.CZipWith +import qualified Data.List as List +import qualified Data.Text as Text +import qualified Data.Text.Lazy as TextL +import qualified GHC +import qualified GHC.LanguageExtensions.Type as GHC import Language.Haskell.Brittany.Internal +import Language.Haskell.Brittany.Internal.Config +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Obfuscation import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Utils -import Language.Haskell.Brittany.Internal.Obfuscation -import Language.Haskell.Brittany.Internal.Config -import Data.CZipWith -import Control.Monad.Trans.Class (lift) -import qualified Control.Monad.Trans.Except as ExceptT -import qualified Data.List as List -import qualified Data.Text as Text -import qualified Language.Haskell.GHC.ExactPrint as ExactPrint -import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint -import qualified Data.Text.Lazy as TextL -import qualified GHC -import qualified GHC.LanguageExtensions.Type as GHC +import qualified Language.Haskell.GHC.ExactPrint as ExactPrint +import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint descriptor :: PluginId -> PluginDescriptor IdeState @@ -80,7 +86,7 @@ formatText -> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany. formatText df confFile opts text = liftIO $ runBrittany tabSize df confFile text - where tabSize = opts ^. J.tabSize + where tabSize = fromIntegral $ opts ^. J.tabSize -- | Recursively search in every directory of the given filepath for brittany.yaml. -- If no such file has been found, return Nothing. @@ -261,6 +267,6 @@ pPrintText config text = isError :: BrittanyError -> Bool isError = \case - LayoutWarning{} -> False + LayoutWarning{} -> False ErrorUnknownNode{} -> False - _ -> True + _ -> True diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs index e54c7721ab..d4998f88b9 100644 --- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs +++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs @@ -234,9 +234,9 @@ outgoingCalls state pluginId param = do mkCallHierarchyCall :: (CallHierarchyItem -> List Range -> a) -> Vertex -> Action (Maybe a) mkCallHierarchyCall mk v@Vertex{..} = do - let pos = Position (sl - 1) (sc - 1) + let pos = Position (fromIntegral $ sl - 1) (fromIntegral $ sc - 1) nfp = toNormalizedFilePath' hieSrc - range = mkRange (casl - 1) (casc - 1) (cael - 1) (caec - 1) + range = mkRange (fromIntegral $ casl - 1) (fromIntegral $ casc - 1) (fromIntegral $ cael - 1) (fromIntegral $ caec - 1) prepareCallHierarchyItem nfp pos >>= \case @@ -246,7 +246,7 @@ mkCallHierarchyCall mk v@Vertex{..} = do liftIO (Q.getSymbolPosition hiedb v) >>= \case (x:_) -> - prepareCallHierarchyItem nfp (Position (psl x - 1) (psc x - 1)) >>= + prepareCallHierarchyItem nfp (Position (fromIntegral $ psl x - 1) (fromIntegral $ psc x - 1)) >>= \case Just [item] -> pure $ Just $ mk item (List [range]) _ -> pure Nothing diff --git a/plugins/hls-call-hierarchy-plugin/test/Main.hs b/plugins/hls-call-hierarchy-plugin/test/Main.hs index 69abadcc3d..6a5edcf6ff 100644 --- a/plugins/hls-call-hierarchy-plugin/test/Main.hs +++ b/plugins/hls-call-hierarchy-plugin/test/Main.hs @@ -528,7 +528,7 @@ testDataDir :: FilePath testDataDir = "test" "testdata" mkPrepareCallHierarchyParam :: TextDocumentIdentifier -> Int -> Int -> CallHierarchyPrepareParams -mkPrepareCallHierarchyParam doc x y = CallHierarchyPrepareParams doc (Position x y) Nothing +mkPrepareCallHierarchyParam doc x y = CallHierarchyPrepareParams doc (Position (fromIntegral x) (fromIntegral y)) Nothing mkIncomingCallsParam :: CallHierarchyItem -> CallHierarchyIncomingCallsParams mkIncomingCallsParam = CallHierarchyIncomingCallsParams Nothing Nothing diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs index be013e2dc2..0c23908b81 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wwarn -fno-warn-orphans #-} @@ -27,7 +28,7 @@ import System.IO.Extra (newTempFile, readFile') testRanges :: Test -> (Range, Range) testRanges tst = let startLine = testRange tst ^. start.line - (exprLines, resultLines) = testLenghts tst + (fromIntegral -> exprLines, fromIntegral -> resultLines) = testLengths tst resLine = startLine + exprLines in ( Range (Position startLine 0) @@ -63,15 +64,15 @@ testCheck (section, test) out | null (testOutput test) || sectionLanguage section == Plain = out | otherwise = showDiffs $ getDiff (map T.pack $ testOutput test) out -testLenghts :: Test -> (Int, Int) -testLenghts (Example e r _) = (NE.length e, length r) -testLenghts (Property _ r _) = (1, length r) +testLengths :: Test -> (Int, Int) +testLengths (Example e r _) = (NE.length e, length r) +testLengths (Property _ r _) = (1, length r) -- |A one-line Haskell statement type Statement = Loc String asStatements :: Test -> [Statement] -asStatements lt = locate $ Located (testRange lt ^. start.line) (asStmts lt) +asStatements lt = locate $ Located (fromIntegral $ testRange lt ^. start.line) (asStmts lt) asStmts :: Test -> [Txt] asStmts (Example e _ _) = NE.toList e diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 2a7f998018..4981349c82 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -326,8 +326,8 @@ addFinalReturn mdlText edits finalReturn :: Text -> TextEdit finalReturn txt = let ls = T.lines txt - l = length ls -1 - c = T.length . last $ ls + l = fromIntegral $ length ls -1 + c = fromIntegral $ T.length . last $ ls p = Position l c in TextEdit (Range p p) "\n" diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs index 2489fb2ab6..0e55f605a7 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs @@ -36,8 +36,9 @@ import Data.Void (Void) import Development.IDE (Position, Range (Range)) import Development.IDE.Types.Location (Position (..)) -import GHC.Generics +import GHC.Generics hiding (to, UInt) import Ide.Plugin.Eval.Types +import Language.LSP.Types (UInt) import Language.LSP.Types.Lens (character, end, line, start) import Text.Megaparsec @@ -329,13 +330,13 @@ positionToSourcePos :: Position -> SourcePos positionToSourcePos pos = P.SourcePos { sourceName = "" - , sourceLine = P.mkPos $ 1 + pos ^. line - , sourceColumn = P.mkPos $ 1 + pos ^. character + , sourceLine = P.mkPos $ fromIntegral $ 1 + pos ^. line + , sourceColumn = P.mkPos $ fromIntegral $ 1 + pos ^. character } sourcePosToPosition :: SourcePos -> Position sourcePosToPosition SourcePos {..} = - Position (unPos sourceLine - 1) (unPos sourceColumn - 1) + Position (fromIntegral $ unPos sourceLine - 1) (fromIntegral $ unPos sourceColumn - 1) -- * Line Group Parser @@ -550,7 +551,7 @@ Two adjacent tokens are considered to be contiguous if >>> contiguousGroupOn id [(1,2),(2,2),(3,4),(4,4),(5,4),(7,0),(8,0)] [(1,2) :| [(2,2)],(3,4) :| [(4,4),(5,4)],(7,0) :| [(8,0)]] -} -contiguousGroupOn :: (a -> (Int, Int)) -> [a] -> [NonEmpty a] +contiguousGroupOn :: (a -> (UInt, UInt)) -> [a] -> [NonEmpty a] contiguousGroupOn toLineCol = foldr step [] where step a [] = [pure a] diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index f944e23c62..3bf8b57fec 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -84,6 +84,6 @@ testDataDir = "test" "testdata" pointRange :: Int -> Int -> Range pointRange - (subtract 1 -> line) - (subtract 1 -> col) = + (subtract 1 -> fromIntegral -> line) + (subtract 1 -> fromIntegral -> col) = Range (Position line col) (Position line $ col + 1) diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index e38ed0028c..6f8a32553a 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -79,12 +79,12 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable where fp' = fromNormalizedFilePath fp title = "Formatting " <> T.pack (takeFileName fp') - lspPrinterOpts = mempty{poIndentation = Just $ fo ^. tabSize} + lspPrinterOpts = mempty{poIndentation = Just $ fromIntegral $ fo ^. tabSize} region = case typ of FormatText -> RegionIndices Nothing Nothing FormatRange (Range (Position sl _) (Position el _)) -> - RegionIndices (Just $ sl + 1) (Just $ el + 1) + RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1) convertDynFlags :: DynFlags -> IO [DynOption] convertDynFlags df = diff --git a/plugins/hls-haddock-comments-plugin/test/Main.hs b/plugins/hls-haddock-comments-plugin/test/Main.hs index 2cfddadffc..3eadb93416 100644 --- a/plugins/hls-haddock-comments-plugin/test/Main.hs +++ b/plugins/hls-haddock-comments-plugin/test/Main.hs @@ -35,7 +35,7 @@ tests = expectedNothing "StaleRecord" Record 3 12 ] -goldenWithHaddockComments :: FilePath -> GenCommentsType -> Int -> Int -> TestTree +goldenWithHaddockComments :: FilePath -> GenCommentsType -> UInt -> UInt -> TestTree goldenWithHaddockComments fp (toTitle -> expectedTitle) l c = goldenWithHaskellDoc haddockCommentsPlugin (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do actions <- getCodeActions doc (Range (Position l c) (Position l $ succ c)) @@ -43,7 +43,7 @@ goldenWithHaddockComments fp (toTitle -> expectedTitle) l c = Just (InR x) -> executeCodeAction x _ -> liftIO $ assertFailure "Unable to find CodeAction" -expectedNothing :: FilePath -> GenCommentsType -> Int -> Int -> TestTree +expectedNothing :: FilePath -> GenCommentsType -> UInt -> UInt -> TestTree expectedNothing fp (toTitle -> expectedTitle) l c = testCase fp $ runSessionWithServer haddockCommentsPlugin testDataDir $ do doc <- openDoc (fp <.> "hs") "haskell" diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 27a5846f4d..f04e5d474c 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -228,11 +228,11 @@ rules plugin = do srcSpanToRange :: SrcSpan -> LSP.Range srcSpanToRange (RealSrcSpan span _) = Range { _start = LSP.Position { - _line = srcSpanStartLine span - 1 - , _character = srcSpanStartCol span - 1} + _line = fromIntegral $ srcSpanStartLine span - 1 + , _character = fromIntegral $ srcSpanStartCol span - 1} , _end = LSP.Position { - _line = srcSpanEndLine span - 1 - , _character = srcSpanEndCol span - 1} + _line = fromIntegral $ srcSpanEndLine span - 1 + , _character = fromIntegral $ srcSpanEndCol span - 1} } srcSpanToRange (UnhelpfulSpan _) = noRange @@ -431,7 +431,7 @@ mkSuppressHintTextEdits :: DynFlags -> T.Text -> T.Text -> [LSP.TextEdit] mkSuppressHintTextEdits dynFlags fileContents hint = let NextPragmaInfo{ nextPragmaLine, lineSplitTextEdits } = getNextPragmaInfo dynFlags (Just fileContents) - nextPragmaLinePosition = Position nextPragmaLine 0 + nextPragmaLinePosition = Position (fromIntegral nextPragmaLine) 0 nextPragmaRange = Range nextPragmaLinePosition nextPragmaLinePosition wnoUnrecognisedPragmasText = if wopt Opt_WarnUnrecognisedPragmas dynFlags @@ -574,7 +574,7 @@ applyHint ide nfp mhint = filterIdeas (OneHint (Position l c) title) ideas = let title' = T.unpack title ideaPos = (srcSpanStartLine &&& srcSpanStartCol) . toRealSrcSpan . ideaSpan - in filter (\i -> ideaHint i == title' && ideaPos i == (l+1, c+1)) ideas + in filter (\i -> ideaHint i == title' && ideaPos i == (fromIntegral $ l+1, fromIntegral $ c+1)) ideas toRealSrcSpan (RealSrcSpan real _) = real toRealSrcSpan (UnhelpfulSpan x) = error $ "No real source span: " ++ show x diff --git a/plugins/hls-hlint-plugin/test/Main.hs b/plugins/hls-hlint-plugin/test/Main.hs index acb46947e6..86bbfad319 100644 --- a/plugins/hls-hlint-plugin/test/Main.hs +++ b/plugins/hls-hlint-plugin/test/Main.hs @@ -361,8 +361,8 @@ makePoint line column pointToRange :: Point -> Range pointToRange Point {..} - | line <- subtract 1 line - , column <- subtract 1 column = + | line <- fromIntegral $ subtract 1 line + , column <- fromIntegral $ subtract 1 column = Range (Position line column) (Position line $ column + 1) getCodeActionTitle :: (Command |? CodeAction) -> Maybe T.Text diff --git a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs index d1a465eb64..5ef89f0f77 100644 --- a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs +++ b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs @@ -11,7 +11,7 @@ import Control.Exception (try) import Control.Monad.IO.Class (liftIO) import qualified Data.Text as T import Development.IDE hiding (pluginHandlers) -import Development.IDE.GHC.Compat (moduleNameString, hsc_dflags) +import Development.IDE.GHC.Compat (hsc_dflags, moduleNameString) import qualified Development.IDE.GHC.Compat as D import qualified Development.IDE.GHC.Compat.Util as S import GHC.LanguageExtensions.Type @@ -50,7 +50,7 @@ provider ideState typ contents fp _ = withIndefiniteProgress title Cancellable $ case typ of FormatText -> ret <$> fmt contents (mkConf fileOpts fullRegion) FormatRange (Range (Position sl _) (Position el _)) -> - ret <$> fmt contents (mkConf fileOpts (rangeRegion sl el)) + ret <$> fmt contents (mkConf fileOpts (rangeRegion (fromIntegral sl) (fromIntegral el))) where title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp) diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index 9a411901df..8d3fdb2147 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -104,7 +104,7 @@ pragmaEditToAction uri Pragmas.NextPragmaInfo{ nextPragmaLine, lineSplitTextEdit where render (OptGHC x) = "{-# OPTIONS_GHC -Wno-" <> x <> " #-}\n" render (LangExt x) = "{-# LANGUAGE " <> x <> " #-}\n" - pragmaInsertPosition = Position nextPragmaLine 0 + pragmaInsertPosition = Position (fromIntegral nextPragmaLine) 0 pragmaInsertRange = Range pragmaInsertPosition pragmaInsertPosition -- workaround the fact that for some reason lsp-test applies text -- edits in reverse order than lsp (tried in both coc.nvim and vscode) diff --git a/plugins/hls-pragmas-plugin/test/Main.hs b/plugins/hls-pragmas-plugin/test/Main.hs index 4c7965a340..7d9da73b99 100644 --- a/plugins/hls-pragmas-plugin/test/Main.hs +++ b/plugins/hls-pragmas-plugin/test/Main.hs @@ -111,7 +111,7 @@ completionTests = , completionTest "completes No- language extensions" "Completion.hs" "NoOverload" "NoOverloadedStrings" Nothing Nothing Nothing [0, 13, 0, 31, 0, 23] ] -completionTest :: String -> String -> T.Text -> T.Text -> Maybe InsertTextFormat -> Maybe T.Text -> Maybe T.Text -> [Int] -> TestTree +completionTest :: String -> String -> T.Text -> T.Text -> Maybe InsertTextFormat -> Maybe T.Text -> Maybe T.Text -> [UInt] -> TestTree completionTest testComment fileName te' label textFormat insertText detail [a, b, c, d, x, y] = testCase testComment $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc fileName "haskell" diff --git a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs index 2aa31fcf5b..5c5a570156 100644 --- a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs +++ b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs @@ -167,7 +167,7 @@ realSrcSpanToIdentifierSpan realSrcSpan identifierSpanToRange :: IdentifierSpan -> Range identifierSpanToRange (IdentifierSpan line startCol endCol) = - Range (Position line startCol) (Position line endCol) + Range (Position (fromIntegral line) (fromIntegral startCol)) (Position (fromIntegral line) (fromIntegral endCol)) data UsedIdentifier = UsedIdentifier { usedIdentifierName :: !Name, diff --git a/plugins/hls-qualify-imported-names-plugin/test/Main.hs b/plugins/hls-qualify-imported-names-plugin/test/Main.hs index ac1c50a2cd..3f118ecc46 100644 --- a/plugins/hls-qualify-imported-names-plugin/test/Main.hs +++ b/plugins/hls-qualify-imported-names-plugin/test/Main.hs @@ -140,7 +140,7 @@ goldenWithQualifyImportedNames testName path = pointToRange :: Point -> Range pointToRange Point {..} - | line <- subtract 1 line - , column <- subtract 1 column = + | line <- fromIntegral $ subtract 1 line + , column <- fromIntegral $ subtract 1 column = Range (Position line column) (Position line $ column + 1) diff --git a/plugins/hls-refine-imports-plugin/test/Main.hs b/plugins/hls-refine-imports-plugin/test/Main.hs index 90c294cc24..18b021b29d 100644 --- a/plugins/hls-refine-imports-plugin/test/Main.hs +++ b/plugins/hls-refine-imports-plugin/test/Main.hs @@ -74,6 +74,6 @@ testDataDir = "test" "testdata" pointRange :: Int -> Int -> Range pointRange - (subtract 1 -> line) - (subtract 1 -> col) = + (subtract 1 -> fromIntegral -> line) + (subtract 1 -> fromIntegral -> col) = Range (Position line col) (Position line $ col + 1) diff --git a/plugins/hls-splice-plugin/test/Main.hs b/plugins/hls-splice-plugin/test/Main.hs index 9c44535530..a33d3b4211 100644 --- a/plugins/hls-splice-plugin/test/Main.hs +++ b/plugins/hls-splice-plugin/test/Main.hs @@ -83,7 +83,7 @@ goldenTestWithEdit fp tc line col = theRange = Range { _start = Position 0 0 - , _end = Position (length lns + 1) 1 + , _end = Position (fromIntegral $ length lns + 1) 1 } waitForAllProgressDone -- cradle waitForAllProgressDone @@ -104,7 +104,7 @@ testDataDir :: FilePath testDataDir = "test" "testdata" pointRange :: Int -> Int -> Range -pointRange (subtract 1 -> line) (subtract 1 -> col) = +pointRange (subtract 1 -> fromIntegral -> line) (subtract 1 -> fromIntegral -> col) = Range (Position line col) (Position line $ col + 1) -- | Get the title of a code action. diff --git a/plugins/hls-tactics-plugin/src/Wingman/Range.hs b/plugins/hls-tactics-plugin/src/Wingman/Range.hs index b7ae845663..ec61efc27f 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Range.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Range.hs @@ -19,6 +19,5 @@ rangeToSrcSpan file range = RealSrcSpan (rangeToRealSrcSpan file range) Nothing rangeToRealSrcSpan :: String -> Range -> RealSrcSpan rangeToRealSrcSpan file (Range (Position startLn startCh) (Position endLn endCh)) = mkRealSrcSpan - (mkRealSrcLoc (FS.fsLit file) (startLn + 1) (startCh + 1)) - (mkRealSrcLoc (FS.fsLit file) (endLn + 1) (endCh + 1)) - + (mkRealSrcLoc (FS.fsLit file) (fromIntegral $ startLn + 1) (fromIntegral $ startCh + 1)) + (mkRealSrcLoc (FS.fsLit file) (fromIntegral $ endLn + 1) (fromIntegral $ endCh + 1)) diff --git a/plugins/hls-tactics-plugin/test/Utils.hs b/plugins/hls-tactics-plugin/test/Utils.hs index 98dfea147b..fa516193da 100644 --- a/plugins/hls-tactics-plugin/test/Utils.hs +++ b/plugins/hls-tactics-plugin/test/Utils.hs @@ -42,8 +42,8 @@ plugin = Tactic.descriptor "tactics" -- NB: These coordinates are in "file space", ie, 1-indexed. pointRange :: Int -> Int -> Range pointRange - (subtract 1 -> line) - (subtract 1 -> col) = + (subtract 1 -> fromIntegral -> line) + (subtract 1 -> fromIntegral -> col) = Range (Position line col) (Position line $ col + 1) diff --git a/stack-8.10.6.yaml b/stack-8.10.6.yaml index ea66f0028e..6680b2d2bb 100644 --- a/stack-8.10.6.yaml +++ b/stack-8.10.6.yaml @@ -44,9 +44,9 @@ extra-deps: - hiedb-0.4.1.0 - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - - lsp-1.2.0.1@sha256:5b37d26fcbf037434e257e953c08513d4cb125ed784d4611038905c72dc0f58c,5431 - - lsp-test-0.14.0.1@sha256:efce2ddec4183390341db7667e63936954c654a14d809ad7b61e4010a2fde97e,4739 - - lsp-types-1.3.0.1@sha256:1dc41eb358345c1927fb8f285e7d951869623fe5b695fbbecf2fe6a3cee9fcfd,4646 + - lsp-1.4.0.0 + - lsp-test-0.14.0.2 + - lsp-types-1.4.0.0 - monad-dijkstra-0.1.1.3@sha256:d2fc098d7c122555e726830a12ae0423ac187f89de9228f32e56e2f6fc2238e1,1900 - optparse-applicative-0.15.1.0@sha256:29ff6146aabf54d46c4c8788e8d1eadaea27c94f6d360c690c5f6c93dac4b07e,4810 - refinery-0.4.0.0@sha256:fe3a43add8ff1db5cfffee7e7694c86128b1dfe62c541f26e25a8eadf9585610,1663 diff --git a/stack-8.10.7.yaml b/stack-8.10.7.yaml index cac325463c..7a0683c453 100644 --- a/stack-8.10.7.yaml +++ b/stack-8.10.7.yaml @@ -45,9 +45,9 @@ extra-deps: - hiedb-0.4.1.0 - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - - lsp-1.2.0.1@sha256:5b37d26fcbf037434e257e953c08513d4cb125ed784d4611038905c72dc0f58c,5431 - - lsp-test-0.14.0.1@sha256:efce2ddec4183390341db7667e63936954c654a14d809ad7b61e4010a2fde97e,4739 - - lsp-types-1.3.0.1@sha256:1dc41eb358345c1927fb8f285e7d951869623fe5b695fbbecf2fe6a3cee9fcfd,4646 + - lsp-1.4.0.0 + - lsp-test-0.14.0.2 + - lsp-types-1.4.0.0 - monad-dijkstra-0.1.1.3@sha256:d2fc098d7c122555e726830a12ae0423ac187f89de9228f32e56e2f6fc2238e1,1900 - optparse-applicative-0.15.1.0@sha256:29ff6146aabf54d46c4c8788e8d1eadaea27c94f6d360c690c5f6c93dac4b07e,4810 - refinery-0.4.0.0@sha256:fe3a43add8ff1db5cfffee7e7694c86128b1dfe62c541f26e25a8eadf9585610,1663 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index bf6c913636..4635ba7fb4 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -103,9 +103,11 @@ extra-deps: - some-1.0.1@sha256:26e5bab7276f48b25ea8660d3fd1166c0f20fd497dac879a40f408e23211f93e,2055 - unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082 - resourcet-1.2.3 - - lsp-1.2.0.1 - - lsp-types-1.3.0.1 - - lsp-test-0.14.0.1 + - lsp-1.4.0.0 + - lsp-test-0.14.0.2 + - lsp-types-1.4.0.0 + - mod-0.1.2.2 + - semirings-0.6 - stm-containers-1.1.0.4 - stm-hamt-1.2.0.6@sha256:fba86ccb4b45c5706c19b0e1315ba63dcac3b5d71de945ec001ba921fae80061,3972 - primitive-extras-0.10.1 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 0954312fab..6cb159ed00 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -79,9 +79,9 @@ extra-deps: - constraints-extras-0.3.0.2@sha256:013b8d0392582c6ca068e226718a4fe8be8e22321cc0634f6115505bf377ad26,1853 - some-1.0.1@sha256:26e5bab7276f48b25ea8660d3fd1166c0f20fd497dac879a40f408e23211f93e,2055 - unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082 - - lsp-1.2.0.1 - - lsp-types-1.3.0.1 - - lsp-test-0.14.0.1 + - lsp-1.4.0.0 + - lsp-test-0.14.0.2 + - lsp-types-1.4.0.0 - stm-containers-1.1.0.4 - stm-hamt-1.2.0.6@sha256:fba86ccb4b45c5706c19b0e1315ba63dcac3b5d71de945ec001ba921fae80061,3972 - primitive-extras-0.10.1 diff --git a/stack.yaml b/stack.yaml index cac325463c..7a0683c453 100644 --- a/stack.yaml +++ b/stack.yaml @@ -45,9 +45,9 @@ extra-deps: - hiedb-0.4.1.0 - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - - lsp-1.2.0.1@sha256:5b37d26fcbf037434e257e953c08513d4cb125ed784d4611038905c72dc0f58c,5431 - - lsp-test-0.14.0.1@sha256:efce2ddec4183390341db7667e63936954c654a14d809ad7b61e4010a2fde97e,4739 - - lsp-types-1.3.0.1@sha256:1dc41eb358345c1927fb8f285e7d951869623fe5b695fbbecf2fe6a3cee9fcfd,4646 + - lsp-1.4.0.0 + - lsp-test-0.14.0.2 + - lsp-types-1.4.0.0 - monad-dijkstra-0.1.1.3@sha256:d2fc098d7c122555e726830a12ae0423ac187f89de9228f32e56e2f6fc2238e1,1900 - optparse-applicative-0.15.1.0@sha256:29ff6146aabf54d46c4c8788e8d1eadaea27c94f6d360c690c5f6c93dac4b07e,4810 - refinery-0.4.0.0@sha256:fe3a43add8ff1db5cfffee7e7694c86128b1dfe62c541f26e25a8eadf9585610,1663 diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs index 344eb4a98f..0f6e4fe9fb 100644 --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -57,7 +57,7 @@ formatLspConfig :: Value -> Value formatLspConfig provider = object ["haskell" .= object ["formattingProvider" .= (provider :: Value)]] progressCaps :: ClientCapabilities -progressCaps = fullCaps{_window = Just (WindowClientCapabilities (Just True))} +progressCaps = fullCaps{_window = Just (WindowClientCapabilities (Just True) Nothing Nothing)} data CollectedProgressNotification = CreateM WorkDoneProgressCreateParams diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs index 1bba39440b..96f4ab91f0 100644 --- a/test/functional/TypeDefinition.hs +++ b/test/functional/TypeDefinition.hs @@ -37,7 +37,7 @@ getTypeDefinitionTest (symbolFile, symbolLine, symbolCol) definitionLocations = InL defs <- getTypeDefinitions doc $ Position symbolLine symbolCol liftIO $ defs `expectSameLocations` map (first3 (definitionsPath )) definitionLocations -getTypeDefinitionTest' :: Int -> Int -> Int -> Int -> Assertion +getTypeDefinitionTest' :: UInt -> UInt -> UInt -> UInt -> Assertion getTypeDefinitionTest' symbolLine symbolCol definitionLine definitionCol = getTypeDefinitionTest ("src/Lib.hs", symbolLine, symbolCol) [("src/Lib.hs", definitionLine, definitionCol)] From e4c25b4bc615dc85f8aef5f569828d717e5e6280 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 18 Dec 2021 19:18:21 +0000 Subject: [PATCH 2/6] 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 --- ghcide/src/Development/IDE/Core/OfInterest.hs | 21 ++++++++++++------- .../src/Development/IDE/Plugin/Completions.hs | 18 ---------------- .../IDE/Plugin/Completions/Types.hs | 18 ++++++++++++++++ 3 files changed, 31 insertions(+), 26 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index 5034c45483..bf69af7100 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/ghcide/src/Development/IDE/Core/OfInterest.hs @@ -20,18 +20,19 @@ 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 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 @@ -113,7 +114,11 @@ kick = do 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) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index ea8a025197..0d54ec0f92 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -3,8 +3,6 @@ module Development.IDE.Plugin.Completions ( descriptor - , LocalCompletions(..) - , NonLocalCompletions(..) ) where import Control.Concurrent.Async (concurrently) @@ -29,7 +27,6 @@ import Development.IDE.GHC.ExactPrint (Annotated (annsA) astA) import Development.IDE.GHC.Util (prettyPrint) import Development.IDE.Graph -import Development.IDE.Graph.Classes import Development.IDE.Plugin.CodeAction (newImport, newImportToEdit) import Development.IDE.Plugin.CodeAction.ExactPrint @@ -41,7 +38,6 @@ import Development.IDE.Types.HscEnvEq (HscEnvEq (envPack import qualified Development.IDE.Types.KnownTargets as KT import Development.IDE.Types.Location import GHC.Exts (fromList, toList) -import GHC.Generics import Ide.Plugin.Config (Config) import Ide.Types import qualified Language.LSP.Server as LSP @@ -98,20 +94,6 @@ dropListFromImportDecl iDecl = let f x = x in f <$> iDecl --- | Produce completions info for a file -type instance RuleResult LocalCompletions = CachedCompletions -type instance RuleResult NonLocalCompletions = CachedCompletions - -data LocalCompletions = LocalCompletions - deriving (Eq, Show, Typeable, Generic) -instance Hashable LocalCompletions -instance NFData LocalCompletions - -data NonLocalCompletions = NonLocalCompletions - deriving (Eq, Show, Typeable, Generic) -instance Hashable NonLocalCompletions -instance NFData NonLocalCompletions - -- | Generate code actions. getCompletionsLSP :: IdeState diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 510d30ac05..127ba369b3 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE TypeFamilies #-} module Development.IDE.Plugin.Completions.Types ( module Development.IDE.Plugin.Completions.Types ) where @@ -11,8 +12,11 @@ import qualified Data.Map as Map import qualified Data.Text as T import Data.Aeson (FromJSON, ToJSON) +import Data.Hashable (Hashable) import Data.Text (Text) +import Data.Typeable (Typeable) import Development.IDE.GHC.Compat +import Development.IDE.Graph (RuleResult) import Development.IDE.Spans.Common import GHC.Generics (Generic) import Ide.Plugin.Config (Config) @@ -23,6 +27,20 @@ import Ide.Types (PluginId) import Language.LSP.Server (MonadLsp) import Language.LSP.Types (CompletionItemKind (..), Uri) +-- | Produce completions info for a file +type instance RuleResult LocalCompletions = CachedCompletions +type instance RuleResult NonLocalCompletions = CachedCompletions + +data LocalCompletions = LocalCompletions + deriving (Eq, Show, Typeable, Generic) +instance Hashable LocalCompletions +instance NFData LocalCompletions + +data NonLocalCompletions = NonLocalCompletions + deriving (Eq, Show, Typeable, Generic) +instance Hashable NonLocalCompletions +instance NFData NonLocalCompletions + -- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs data Backtick = Surrounded | LeftSide From 6f43acb9ff45157d5a35313b6af920dc34c46494 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 18 Dec 2021 19:52:35 +0000 Subject: [PATCH 3/6] Emit LSP custom messages on kick start/finish useful to synchonize on these events in tests --- ghcide/src/Development/IDE/Core/OfInterest.hs | 14 ++++++++- hls-test-utils/src/Test/Hls.hs | 30 +++++++++++++++++-- 2 files changed, 40 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index bf69af7100..8f31856098 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/ghcide/src/Development/IDE/Core/OfInterest.hs @@ -27,6 +27,7 @@ import Development.IDE.Graph 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 @@ -36,6 +37,9 @@ 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 @@ -110,7 +114,13 @@ 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 @@ -129,3 +139,5 @@ kick = do when garbageCollectionScheduled $ do void garbageCollectDirtyKeys liftIO $ writeVar var False + + signal "kick/done" diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 1b1fdc1c6b..b525551f8c 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -28,16 +28,21 @@ module Test.Hls waitForTypecheck, waitForAction, sendConfigurationChanged, - getLastBuildKeys) + getLastBuildKeys, + waitForKickDone, + waitForKickStart, + ) where import Control.Applicative.Combinators import Control.Concurrent.Async (async, cancel, wait) import Control.Concurrent.Extra import Control.Exception.Base -import Control.Monad (unless, void) +import Control.Monad (guard, unless, void) import Control.Monad.IO.Class -import Data.Aeson (Value (Null), toJSON) +import Data.Aeson (Result (Success), + Value (Null), fromJSON, + toJSON) import qualified Data.Aeson as A import Data.ByteString.Lazy (ByteString) import Data.Default (def) @@ -247,3 +252,22 @@ getLastBuildKeys = callTestPlugin GetBuildKeysBuilt sendConfigurationChanged :: Value -> Session () sendConfigurationChanged config = sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams config) + +waitForKickDone :: Session () +waitForKickDone = void $ skipManyTill anyMessage nonTrivialKickDone + +waitForKickStart :: Session () +waitForKickStart = void $ skipManyTill anyMessage nonTrivialKickStart + +nonTrivialKickDone :: Session () +nonTrivialKickDone = kick "done" >>= guard . not . null + +nonTrivialKickStart :: Session () +nonTrivialKickStart = kick "start" >>= guard . not . null + +kick :: T.Text -> Session [FilePath] +kick msg = do + NotMess NotificationMessage{_params} <- customNotification $ "kick/" <> msg + case fromJSON _params of + Success x -> return x + other -> error $ "Failed to parse kick/done details: " <> show other From 1d94ed5971e291f3c6eb939295d018819817a170 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 18 Dec 2021 20:24:36 +0000 Subject: [PATCH 4/6] Fix completions tests after https://github.com/haskell/lsp/pull/376 --- test/functional/Completion.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 05d02e09f2..5b5052f1ac 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -46,10 +46,10 @@ tests = testGroup "completions" [ resolved ^. insertTextFormat @?= Just Snippet resolved ^. insertText @?= Just "putStrLn ${1:String}" - , testCase "completes imports" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + , testCase "completes imports" $ runSession (hlsCommand <> " --test") fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" - _ <- waitForDiagnostics + waitForKickDone let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M" _ <- applyEdit doc te @@ -61,10 +61,10 @@ tests = testGroup "completions" [ item ^. detail @?= Just "Data.Maybe" item ^. kind @?= Just CiModule - , testCase "completes qualified imports" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + , testCase "completes qualified imports" $ runSession (hlsCommand <> " --test") fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" - _ <- waitForDiagnostics + _ <- waitForKickDone let te = TextEdit (Range (Position 2 17) (Position 2 25)) "Data.L" _ <- applyEdit doc te From 35c8ef5c1e6ac31b229a504a817b503733a068b1 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 28 Dec 2021 21:59:44 +0100 Subject: [PATCH 5/6] Restore cabal update with comments --- .github/workflows/bench.yml | 3 +++ .github/workflows/caching.yml | 4 ++++ .github/workflows/test.yml | 4 ++++ 3 files changed, 11 insertions(+) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index e3185c56de..fceb47178a 100644 --- a/.github/workflows/bench.yml +++ b/.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 diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index 0f91111971..0cfc530dd7 100644 --- a/.github/workflows/caching.yml +++ b/.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 diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 6d52f515ea..953503ee85 100644 --- a/.github/workflows/test.yml +++ b/.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 From 26b89d8fa424bcb68d4793357b0fa3b3ee2a7d82 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 28 Dec 2021 22:05:44 +0100 Subject: [PATCH 6/6] Use new lsp in stack 9.0.1 --- stack-9.0.1.yaml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml index cd76d240e3..5a744f6128 100644 --- a/stack-9.0.1.yaml +++ b/stack-9.0.1.yaml @@ -45,9 +45,9 @@ extra-deps: - implicit-hie-cradle-0.3.0.5 - monad-dijkstra-0.1.1.3 - retrie-1.1.0.0 -- lsp-1.2.0.1 -- lsp-types-1.3.0.1 -- lsp-test-0.14.0.1 +- lsp-1.4.0.0 +- lsp-test-0.14.0.2 +- lsp-types-1.4.0.0 # shake-bench dependencies - Chart-1.9.3