mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-09-17 11:47:09 +03:00
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 https://github.com/haskell/lsp/pull/376 * Restore cabal update with comments * Use new lsp in stack 9.0.1 Co-authored-by: Pepe Iborra <pepeiborra@gmail.com> Co-authored-by: jneira <atreyu.bbb@gmail.com>
This commit is contained in:
Michael Peyton Jones
GitHub
parent
2fa5994803
commit
7518a3a7eb
3
.github/workflows/bench.yml
vendored
3
.github/workflows/bench.yml
vendored
@ -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
|
||||
|
||||
4
.github/workflows/caching.yml
vendored
4
.github/workflows/caching.yml
vendored
@ -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
|
||||
|
||||
4
.github/workflows/test.yml
vendored
4
.github/workflows/test.yml
vendored
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -1 +0,0 @@
|
||||
../../..
|
||||
@ -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
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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
|
||||
|
||||
@ -20,21 +20,26 @@ module Development.IDE.Core.OfInterest(
|
||||
import Control.Concurrent.Strict
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import qualified Data.Text as T
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import qualified Data.Text as T
|
||||
import Development.IDE.Graph
|
||||
|
||||
import Control.Concurrent.STM.Stats (atomically,
|
||||
modifyTVar')
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Maybe (catMaybes)
|
||||
import Control.Concurrent.STM.Stats (atomically,
|
||||
modifyTVar')
|
||||
import Data.Aeson (toJSON)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Maybe (catMaybes)
|
||||
import Development.IDE.Core.ProgressReporting
|
||||
import Development.IDE.Core.RuleTypes
|
||||
import Development.IDE.Core.Shake
|
||||
import Development.IDE.Plugin.Completions.Types
|
||||
import Development.IDE.Types.Exports
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Logger
|
||||
import Development.IDE.Types.Options (IdeTesting (..))
|
||||
import qualified Language.LSP.Server as LSP
|
||||
import qualified Language.LSP.Types as LSP
|
||||
|
||||
newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
|
||||
instance IsIdeGlobal OfInterestVar
|
||||
@ -109,11 +114,21 @@ scheduleGarbageCollection state = do
|
||||
kick :: Action ()
|
||||
kick = do
|
||||
files <- HashMap.keys <$> getFilesOfInterestUntracked
|
||||
ShakeExtras{exportsMap, progress} <- getShakeExtras
|
||||
ShakeExtras{exportsMap, ideTesting = IdeTesting testing, lspEnv, progress} <- getShakeExtras
|
||||
let signal msg = when testing $ liftIO $
|
||||
mRunLspT lspEnv $
|
||||
LSP.sendNotification (LSP.SCustomMethod msg) $
|
||||
toJSON $ map fromNormalizedFilePath files
|
||||
|
||||
signal "kick/start"
|
||||
liftIO $ progressUpdate progress KickStarted
|
||||
|
||||
-- Update the exports map
|
||||
results <- uses GenerateCore files <* uses GetHieAst files
|
||||
results <- uses GenerateCore files
|
||||
<* uses GetHieAst files
|
||||
-- needed to have non local completions on the first edit
|
||||
-- when the first edit breaks the module header
|
||||
<* uses NonLocalCompletions files
|
||||
let mguts = catMaybes results
|
||||
void $ liftIO $ atomically $ modifyTVar' exportsMap (updateExportsMapMg mguts)
|
||||
|
||||
@ -124,3 +139,5 @@ kick = do
|
||||
when garbageCollectionScheduled $ do
|
||||
void garbageCollectDirtyKeys
|
||||
liftIO $ writeVar var False
|
||||
|
||||
signal "kick/done"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -1178,7 +1178,7 @@ updateFileDiagnostics fp k ShakeExtras{logger, diagnostics, hiddenDiagnostics, p
|
||||
logInfo logger $ showDiagnosticsColored $ map (fp,ShowDiag,) newDiags
|
||||
Just env -> LSP.runLspT env $
|
||||
LSP.sendNotification LSP.STextDocumentPublishDiagnostics $
|
||||
LSP.PublishDiagnosticsParams (fromNormalizedUri uri) ver (List newDiags)
|
||||
LSP.PublishDiagnosticsParams (fromNormalizedUri uri) (fmap fromIntegral ver) (List newDiags)
|
||||
return action
|
||||
|
||||
newtype Priority = Priority Double
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 $
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 = []
|
||||
|
||||
|
||||
@ -137,8 +137,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
|
||||
@ -149,8 +149,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
|
||||
@ -361,8 +361,8 @@ nameToLocation withHieDb 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
|
||||
@ -384,8 +384,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]
|
||||
@ -405,7 +405,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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -89,7 +89,7 @@ import System.Process.Extra (CreateProcess (cwd),
|
||||
import Test.QuickCheck
|
||||
-- import Test.QuickCheck.Instances ()
|
||||
import Control.Concurrent.Async
|
||||
import Control.Lens ((^.))
|
||||
import Control.Lens ((^.), to)
|
||||
import Control.Monad.Extra (whenJust)
|
||||
import Data.IORef
|
||||
import Data.IORef.Extra (atomicModifyIORef_)
|
||||
@ -1993,8 +1993,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
|
||||
@ -2307,7 +2307,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)
|
||||
@ -2742,7 +2742,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
|
||||
@ -2783,7 +2783,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
|
||||
@ -3278,7 +3278,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
|
||||
@ -4093,9 +4093,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)
|
||||
@ -5187,7 +5187,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
|
||||
@ -5199,7 +5199,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
|
||||
@ -5240,10 +5240,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
|
||||
@ -5930,14 +5930,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
|
||||
@ -5983,7 +5983,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
|
||||
@ -6052,7 +6052,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
|
||||
@ -6384,24 +6384,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
|
||||
@ -6440,11 +6444,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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 =
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 (withHieDb (`Q.getSymbolPosition` 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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
|
||||
@ -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 = "<block comment>"
|
||||
, 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]
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 =
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user