mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
Wire up code actions
This commit is contained in:
parent
55cc0c25ea
commit
eb5f6e64cb
@ -10,6 +10,7 @@ flags:
|
||||
ghc-options: -Wall
|
||||
|
||||
dependencies:
|
||||
- IntervalMap
|
||||
- ListLike
|
||||
- aeson
|
||||
- aeson-pretty
|
||||
@ -75,6 +76,7 @@ dependencies:
|
||||
- unison-util-base32hex
|
||||
- unison-util-relation
|
||||
- unliftio
|
||||
- unordered-containers
|
||||
- vector
|
||||
- witherable
|
||||
- wai
|
||||
|
@ -23,6 +23,7 @@ import Unison.Codebase
|
||||
import Unison.Codebase.Branch (Branch)
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
import Unison.Codebase.Runtime (Runtime)
|
||||
import Unison.LSP.CodeAction (codeActionHandler)
|
||||
import qualified Unison.LSP.FileAnalysis as Analysis
|
||||
import Unison.LSP.Hover (hoverHandler)
|
||||
import Unison.LSP.NotificationHandlers as Notifications
|
||||
@ -114,6 +115,7 @@ lspRequestHandlers :: SMethodMap (ClientMessageHandler Lsp 'Request)
|
||||
lspRequestHandlers =
|
||||
mempty
|
||||
& SMM.insert STextDocumentHover (ClientMessageHandler hoverHandler)
|
||||
& SMM.insert STextDocumentCodeAction (ClientMessageHandler codeActionHandler)
|
||||
|
||||
-- & SMM.insert STextDocumentCompletion (ClientMessageHandler completionHandler)
|
||||
-- & SMM.insert SCodeLensResolve (ClientMessageHandler codeLensResolveHandler)
|
||||
|
23
unison-cli/src/Unison/LSP/CodeAction.hs
Normal file
23
unison-cli/src/Unison/LSP/CodeAction.hs
Normal file
@ -0,0 +1,23 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Unison.LSP.CodeAction where
|
||||
|
||||
import Control.Lens hiding (List)
|
||||
import qualified Data.IntervalMap as IM
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens
|
||||
import Unison.LSP.Conversions
|
||||
import Unison.LSP.FileAnalysis
|
||||
import Unison.LSP.Types
|
||||
import Unison.Prelude
|
||||
|
||||
-- | Computes code actions for a document.
|
||||
codeActionHandler :: RequestMessage 'TextDocumentCodeAction -> (Either ResponseError (ResponseResult 'TextDocumentCodeAction) -> Lsp ()) -> Lsp ()
|
||||
codeActionHandler m respond =
|
||||
respond . maybe (Right mempty) (Right . List . fmap InR) =<< runMaybeT do
|
||||
FileAnalysis {codeActions} <- MaybeT $ getFileAnalysis (m ^. params . textDocument . uri)
|
||||
let r = m ^. params . range
|
||||
let relevantActions = IM.intersecting codeActions (rangeToInterval r)
|
||||
pure $ fold relevantActions
|
30
unison-cli/src/Unison/LSP/Conversions.hs
Normal file
30
unison-cli/src/Unison/LSP/Conversions.hs
Normal file
@ -0,0 +1,30 @@
|
||||
module Unison.LSP.Conversions where
|
||||
|
||||
import qualified Data.IntervalMap.Interval as Interval
|
||||
import Language.LSP.Types
|
||||
import Unison.LSP.Orphans ()
|
||||
import qualified Unison.Lexer as Lex
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import qualified Unison.Parser.Ann as Ann
|
||||
import qualified Unison.Util.Range as Range
|
||||
|
||||
rangeToInterval :: Range -> Interval.Interval Position
|
||||
rangeToInterval (Range start end) =
|
||||
-- TODO: Double check whether LSP ranges are closed or partially closed
|
||||
Interval.IntervalCO start end
|
||||
|
||||
uToLspPos :: Lex.Pos -> Position
|
||||
uToLspPos uPos =
|
||||
Position
|
||||
{ _line = fromIntegral $ Lex.line uPos - 1, -- 1 indexed vs 0 indexed
|
||||
_character = fromIntegral $ Lex.column uPos - 1 -- 1 indexed vs 0 indexed
|
||||
}
|
||||
|
||||
uToLspRange :: Range.Range -> Range
|
||||
uToLspRange (Range.Range start end) = Range (uToLspPos start) (uToLspPos end)
|
||||
|
||||
annToRange :: Ann -> Maybe Range
|
||||
annToRange = \case
|
||||
Ann.Intrinsic -> Nothing
|
||||
Ann.External -> Nothing
|
||||
Ann.Ann start end -> Just $ Range (uToLspPos start) (uToLspPos end)
|
@ -1,136 +1,22 @@
|
||||
module Unison.LSP.Diagnostics where
|
||||
|
||||
import Data.Bifunctor (second)
|
||||
import qualified Data.Text as Text
|
||||
import Language.LSP.Types
|
||||
import qualified Unison.ABT as ABT
|
||||
import qualified Unison.Debug as Debug
|
||||
import Unison.LSP.Types
|
||||
import qualified Unison.LSP.Types as LSP
|
||||
import qualified Unison.Lexer as Lex
|
||||
import qualified Unison.Names.ResolutionResult as Names
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import qualified Unison.Parser.Ann as Ann
|
||||
import Unison.Prelude
|
||||
import Unison.PrettyPrintEnv (PrettyPrintEnv)
|
||||
import qualified Unison.PrettyPrintEnvDecl as PPE
|
||||
import qualified Unison.PrintError as PrintError
|
||||
import Unison.Result (Note)
|
||||
import qualified Unison.Result as Result
|
||||
import Unison.Symbol (Symbol)
|
||||
import qualified Unison.Typechecker.Context as Context
|
||||
import qualified Unison.Typechecker.TypeError as TypeError
|
||||
import qualified Unison.Util.Pretty as Pretty
|
||||
import qualified Unison.Util.Range as Range
|
||||
|
||||
annToRange :: Ann -> Maybe Range
|
||||
annToRange = \case
|
||||
Ann.Intrinsic -> Nothing
|
||||
Ann.External -> Nothing
|
||||
Ann.Ann start end -> Just $ Range (uToLspPos start) (uToLspPos end)
|
||||
|
||||
uToLspPos :: Lex.Pos -> Position
|
||||
uToLspPos uPos =
|
||||
Position
|
||||
{ _line = fromIntegral $ Lex.line uPos - 1, -- 1 indexed vs 0 indexed
|
||||
_character = fromIntegral $ Lex.column uPos - 1 -- 1 indexed vs 0 indexed
|
||||
}
|
||||
|
||||
uToLspRange :: Range.Range -> Range
|
||||
uToLspRange (Range.Range start end) = Range (uToLspPos start) (uToLspPos end)
|
||||
|
||||
infoDiagnostics :: FileAnalysis -> Lsp [Diagnostic]
|
||||
infoDiagnostics FileAnalysis {fileUri, lexedSource = (srcText, _lexed), notes} = do
|
||||
ppe <- LSP.globalPPE
|
||||
pure $ noteDiagnostics fileUri (PPE.suffixifiedPPE ppe) (Text.unpack srcText) notes
|
||||
|
||||
noteDiagnostics :: Foldable f => Uri -> PrettyPrintEnv -> String -> f (Note Symbol Ann) -> [Diagnostic]
|
||||
noteDiagnostics fileUri ppe src notes = do
|
||||
flip foldMap notes \note -> case note of
|
||||
Result.TypeError {} -> noteDiagnostic note
|
||||
Result.NameResolutionFailures {} -> noteDiagnostic note
|
||||
Result.Parsing err -> do
|
||||
(errMsg, ranges) <- PrintError.renderParseErrors src err
|
||||
let txtMsg = Text.pack $ Pretty.toPlain 80 errMsg
|
||||
range <- ranges
|
||||
pure $ mkDiagnostic fileUri (uToLspRange range) DsError txtMsg []
|
||||
Result.UnknownSymbol {} -> noteDiagnostic note
|
||||
Result.TypeInfo {} -> []
|
||||
Result.CompilerBug {} -> noteDiagnostic note
|
||||
where
|
||||
noteDiagnostic note =
|
||||
let msg = Text.pack $ Pretty.toPlain 80 $ PrintError.printNoteWithSource ppe src note
|
||||
ranges = noteRanges note
|
||||
in do
|
||||
(range, references) <- ranges
|
||||
pure $ mkDiagnostic fileUri range DsError msg references
|
||||
|
||||
-- | Returns a list of ranges where this note should be marked in the document,
|
||||
-- as well as a list of 'related' ranges the note might refer to, and their relevance.
|
||||
--
|
||||
-- E.g. a name conflict note might mark each conflicted name, and contain references to the
|
||||
-- other conflicted name locations.
|
||||
noteRanges :: Note Symbol Ann -> [(Range, [(Text, Range)])]
|
||||
noteRanges = \case
|
||||
Result.UnknownSymbol _sym loc -> singleRange loc
|
||||
-- TODO: This should have an error extractor
|
||||
Result.TypeError (Context.ErrorNote {cause = Context.PatternArityMismatch loc _ _}) -> singleRange loc
|
||||
Result.TypeError errNote -> do
|
||||
let typeErr = TypeError.typeErrorFromNote errNote
|
||||
case typeErr of
|
||||
TypeError.Mismatch {mismatchSite} -> singleRange $ ABT.annotation mismatchSite
|
||||
TypeError.BooleanMismatch {mismatchSite} -> singleRange $ ABT.annotation mismatchSite
|
||||
TypeError.ExistentialMismatch {mismatchSite} -> singleRange $ ABT.annotation mismatchSite
|
||||
TypeError.FunctionApplication {f} -> singleRange $ ABT.annotation f
|
||||
TypeError.NotFunctionApplication {f} -> singleRange $ ABT.annotation f
|
||||
TypeError.AbilityCheckFailure {abilityCheckFailureSite} -> singleRange abilityCheckFailureSite
|
||||
TypeError.UnguardedLetRecCycle {cycleLocs} -> do
|
||||
let ranges :: [Range]
|
||||
ranges = cycleLocs >>= aToR
|
||||
(range, cycleRanges) <- withNeighbours ranges
|
||||
pure (range, ("cycle",) <$> cycleRanges)
|
||||
TypeError.UnknownType {typeSite} -> singleRange typeSite
|
||||
TypeError.UnknownTerm {termSite} -> singleRange termSite
|
||||
TypeError.DuplicateDefinitions {defns} -> do
|
||||
(_v, locs) <- toList defns
|
||||
(r, rs) <- withNeighbours (locs >>= aToR)
|
||||
pure (r, ("duplicate definition",) <$> rs)
|
||||
TypeError.Other e -> do
|
||||
Debug.debugM Debug.LSP "No Diagnostic configured for type error: " e
|
||||
empty
|
||||
Result.TypeInfo {} -> []
|
||||
Result.CompilerBug e -> do
|
||||
Debug.debugM Debug.LSP "No Diagnostic configured for compiler error: " e
|
||||
empty
|
||||
Result.Parsing {} ->
|
||||
-- Parse notes are handled manually in noteDiagnostics
|
||||
todoAnnotation
|
||||
Result.NameResolutionFailures {} -> todoAnnotation
|
||||
where
|
||||
todoAnnotation = []
|
||||
singleRange :: Ann -> [(Range, [a])]
|
||||
singleRange ann = do
|
||||
r <- aToR ann
|
||||
pure (r, [])
|
||||
|
||||
aToR :: Ann -> [Range]
|
||||
aToR = maybeToList . annToRange
|
||||
-- >>> withNeighbours [1, 2, 3, 4]
|
||||
-- [(1,[2,3,4]),(2,[1,3,4]),(3,[1,2,4]),(4,[1,2,3])]
|
||||
withNeighbours :: [a] -> [(a, [a])]
|
||||
withNeighbours [] = []
|
||||
withNeighbours (a : as) = (a, as) : (second (a :) <$> withNeighbours as)
|
||||
|
||||
reportDiagnostics ::
|
||||
Foldable f =>
|
||||
Uri ->
|
||||
Maybe FileVersion ->
|
||||
-- | Note, it's important to still send an empty list of diagnostics if there aren't any
|
||||
-- because it clears existing diagnostics in the editor
|
||||
[Diagnostic] ->
|
||||
f Diagnostic ->
|
||||
Lsp ()
|
||||
reportDiagnostics docUri fileVersion diags = do
|
||||
let jsonRPC = "" -- TODO: what's this for?
|
||||
let params = PublishDiagnosticsParams {_uri = docUri, _version = fromIntegral <$> fileVersion, _diagnostics = List diags}
|
||||
let params = PublishDiagnosticsParams {_uri = docUri, _version = fromIntegral <$> fileVersion, _diagnostics = List . toList $ diags}
|
||||
sendNotification (NotificationMessage jsonRPC STextDocumentPublishDiagnostics params)
|
||||
|
||||
data UnisonDiagnostic = UnisonDiagnostic Range UnisonDiagnosticInfo
|
||||
|
@ -4,41 +4,79 @@ module Unison.LSP.FileAnalysis where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.Reader
|
||||
( asks,
|
||||
)
|
||||
import qualified Crypto.Random as Random
|
||||
import Data.Bifunctor (second)
|
||||
import Data.Foldable
|
||||
import Data.IntervalMap.Lazy (IntervalMap)
|
||||
import qualified Data.IntervalMap.Lazy as IM
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text as Text
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens (HasUri (uri))
|
||||
( Diagnostic,
|
||||
DiagnosticSeverity (DsError),
|
||||
Position,
|
||||
Range,
|
||||
TextDocumentIdentifier (TextDocumentIdentifier),
|
||||
Uri (getUri),
|
||||
)
|
||||
import Language.LSP.Types.Lens (HasRange (range), HasUri (uri))
|
||||
import qualified Unison.ABT as ABT
|
||||
import Unison.Codebase.Editor.HandleCommand (typecheckCommand)
|
||||
import qualified Unison.Debug as Debug
|
||||
import Unison.LSP.Conversions
|
||||
import Unison.LSP.Diagnostics
|
||||
( mkDiagnostic,
|
||||
reportDiagnostics,
|
||||
)
|
||||
import Unison.LSP.Orphans ()
|
||||
import Unison.LSP.Types
|
||||
import qualified Unison.LSP.Types as LSP
|
||||
import qualified Unison.LSP.VFS as VFS
|
||||
import qualified Unison.Lexer as L
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.PrettyPrintEnv (PrettyPrintEnv)
|
||||
import qualified Unison.PrettyPrintEnvDecl as PPE
|
||||
import qualified Unison.PrintError as PrintError
|
||||
import Unison.Result (Note)
|
||||
import qualified Unison.Result as Result
|
||||
import Unison.Symbol (Symbol)
|
||||
import qualified Unison.Typechecker.Context as Context
|
||||
import qualified Unison.Typechecker.TypeError as TypeError
|
||||
import qualified Unison.UnisonFile as UF
|
||||
import UnliftIO
|
||||
import qualified Unison.Util.Pretty as Pretty
|
||||
import UnliftIO (atomically, modifyTVar', readTVar, readTVarIO, writeTVar)
|
||||
import Witherable (forMaybe)
|
||||
|
||||
-- | Lex, parse, and typecheck a file.
|
||||
analyseFile :: HasUri d Uri => d -> Lsp (Maybe FileAnalysis)
|
||||
analyseFile doc = runMaybeT $ do
|
||||
checkFile :: HasUri d Uri => d -> Lsp (Maybe FileAnalysis)
|
||||
checkFile doc = runMaybeT $ do
|
||||
let fileUri = doc ^. uri
|
||||
(fileVersion, contents) <- MaybeT (VFS.getFileContents doc)
|
||||
parseNames <- lift getParseNames
|
||||
let sourceName = getUri $ doc ^. uri
|
||||
let lexedSource = (contents, L.lexer (Text.unpack sourceName) (Text.unpack contents))
|
||||
let lexedSource@(srcText, _) = (contents, L.lexer (Text.unpack sourceName) (Text.unpack contents))
|
||||
let ambientAbilities = []
|
||||
cb <- asks codebase
|
||||
drg <- liftIO Random.getSystemDRG
|
||||
r <- (liftIO $ typecheckCommand cb ambientAbilities parseNames sourceName lexedSource drg)
|
||||
let Result.Result notes mayResult = r
|
||||
case mayResult of
|
||||
Nothing -> pure $ FileAnalysis {parsedFile = Nothing, typecheckedFile = Nothing, ..}
|
||||
Just (Left uf) -> pure $ FileAnalysis {parsedFile = Just uf, typecheckedFile = Nothing, ..}
|
||||
Just (Right tf) -> pure $ FileAnalysis {parsedFile = Just (UF.discardTypes tf), typecheckedFile = Just tf, ..}
|
||||
let (parsedFile, typecheckedFile) = case mayResult of
|
||||
Nothing -> (Nothing, Nothing)
|
||||
Just (Left uf) -> (Just uf, Nothing)
|
||||
Just (Right tf) -> (Just $ UF.discardTypes tf, Just tf)
|
||||
(diagnostics, codeActions) <- lift $ analyseFile fileUri srcText notes
|
||||
let diagnosticRanges =
|
||||
diagnostics
|
||||
& fmap (\d -> (d ^. range, d))
|
||||
& toRangeMap
|
||||
let codeActionRanges =
|
||||
codeActions
|
||||
& foldMap (\(RangedCodeAction {_codeActionRanges, _codeAction}) -> (,_codeAction) <$> _codeActionRanges)
|
||||
& toRangeMap
|
||||
pure $ FileAnalysis {diagnostics = diagnosticRanges, codeActions = codeActionRanges, ..}
|
||||
|
||||
fileAnalysisWorker :: Lsp ()
|
||||
fileAnalysisWorker = forever do
|
||||
@ -53,11 +91,114 @@ fileAnalysisWorker = forever do
|
||||
pure dirty
|
||||
freshlyCheckedFiles <-
|
||||
Map.fromList <$> forMaybe (toList dirtyFileIDs) \docUri -> runMaybeT do
|
||||
fileInfo <- MaybeT (analyseFile $ TextDocumentIdentifier docUri)
|
||||
fileInfo <- MaybeT (checkFile $ TextDocumentIdentifier docUri)
|
||||
pure (docUri, fileInfo)
|
||||
Debug.debugM Debug.LSP "Typechecked " freshlyCheckedFiles
|
||||
-- Overwrite any files we successfully checked
|
||||
atomically $ modifyTVar' checkedFilesV (`Map.union` freshlyCheckedFiles)
|
||||
for freshlyCheckedFiles \info -> do
|
||||
diagnostics <- infoDiagnostics info
|
||||
reportDiagnostics (fileUri info) (Just $ fileVersion info) $ diagnostics
|
||||
for freshlyCheckedFiles \(FileAnalysis {fileUri, fileVersion, diagnostics}) -> do
|
||||
reportDiagnostics fileUri (Just fileVersion) $ fold diagnostics
|
||||
|
||||
analyseFile :: Foldable f => Uri -> Text -> f (Note Symbol Ann) -> Lsp ([Diagnostic], [RangedCodeAction])
|
||||
analyseFile fileUri srcText notes = do
|
||||
ppe <- LSP.globalPPE
|
||||
pure $ noteDiagnostics fileUri (PPE.suffixifiedPPE ppe) (Text.unpack srcText) notes
|
||||
|
||||
noteDiagnostics :: Foldable f => Uri -> PrettyPrintEnv -> String -> f (Note Symbol Ann) -> ([Diagnostic], [RangedCodeAction])
|
||||
noteDiagnostics fileUri ppe src notes = do
|
||||
flip foldMap notes \note -> case note of
|
||||
Result.TypeError (Context.ErrorNote {cause}) ->
|
||||
let diags = noteDiagnostic note
|
||||
codeActions = case cause of
|
||||
Context.UnknownTerm _ _ suggestions _ -> do
|
||||
Context.Suggestion {suggestionName, suggestionType = _, suggestionMatch = _} <- suggestions
|
||||
let ranges = (diags ^.. folded . range)
|
||||
let rca = rangedCodeAction ("Use " <> suggestionName) diags ranges
|
||||
pure $ includeEdits fileUri suggestionName ranges rca
|
||||
_ -> []
|
||||
in (diags, codeActions)
|
||||
Result.NameResolutionFailures {} -> (noteDiagnostic note, [])
|
||||
Result.Parsing err ->
|
||||
let diags = do
|
||||
(errMsg, ranges) <- PrintError.renderParseErrors src err
|
||||
let txtMsg = Text.pack $ Pretty.toPlain 80 errMsg
|
||||
range <- ranges
|
||||
pure $ mkDiagnostic fileUri (uToLspRange range) DsError txtMsg []
|
||||
in (diags, [])
|
||||
Result.UnknownSymbol {} -> (noteDiagnostic note, [])
|
||||
Result.TypeInfo {} -> ([], [])
|
||||
Result.CompilerBug {} -> (noteDiagnostic note, [])
|
||||
where
|
||||
noteDiagnostic :: Note Symbol Ann -> [Diagnostic]
|
||||
noteDiagnostic note =
|
||||
let msg = Text.pack $ Pretty.toPlain 80 $ PrintError.printNoteWithSource ppe src note
|
||||
ranges = noteRanges note
|
||||
in do
|
||||
(range, references) <- ranges
|
||||
pure $ mkDiagnostic fileUri range DsError msg references
|
||||
|
||||
-- | Returns a list of ranges where this note should be marked in the document,
|
||||
-- as well as a list of 'related' ranges the note might refer to, and their relevance.
|
||||
--
|
||||
-- E.g. a name conflict note might mark each conflicted name, and contain references to the
|
||||
-- other conflicted name locations.
|
||||
noteRanges :: Note Symbol Ann -> [(Range, [(Text, Range)])]
|
||||
noteRanges = \case
|
||||
Result.UnknownSymbol _sym loc -> singleRange loc
|
||||
-- TODO: This should have an error extractor
|
||||
Result.TypeError (Context.ErrorNote {cause = Context.PatternArityMismatch loc _ _}) -> singleRange loc
|
||||
Result.TypeError errNote -> do
|
||||
let typeErr = TypeError.typeErrorFromNote errNote
|
||||
case typeErr of
|
||||
TypeError.Mismatch {mismatchSite} -> singleRange $ ABT.annotation mismatchSite
|
||||
TypeError.BooleanMismatch {mismatchSite} -> singleRange $ ABT.annotation mismatchSite
|
||||
TypeError.ExistentialMismatch {mismatchSite} -> singleRange $ ABT.annotation mismatchSite
|
||||
TypeError.FunctionApplication {f} -> singleRange $ ABT.annotation f
|
||||
TypeError.NotFunctionApplication {f} -> singleRange $ ABT.annotation f
|
||||
TypeError.AbilityCheckFailure {abilityCheckFailureSite} -> singleRange abilityCheckFailureSite
|
||||
TypeError.UnguardedLetRecCycle {cycleLocs} -> do
|
||||
let ranges :: [Range]
|
||||
ranges = cycleLocs >>= aToR
|
||||
(range, cycleRanges) <- withNeighbours ranges
|
||||
pure (range, ("cycle",) <$> cycleRanges)
|
||||
TypeError.UnknownType {typeSite} -> singleRange typeSite
|
||||
TypeError.UnknownTerm {termSite} -> singleRange termSite
|
||||
TypeError.DuplicateDefinitions {defns} -> do
|
||||
(_v, locs) <- toList defns
|
||||
(r, rs) <- withNeighbours (locs >>= aToR)
|
||||
pure (r, ("duplicate definition",) <$> rs)
|
||||
TypeError.Other e -> do
|
||||
Debug.debugM Debug.LSP "No Diagnostic configured for type error: " e
|
||||
empty
|
||||
Result.TypeInfo {} -> []
|
||||
Result.CompilerBug e -> do
|
||||
Debug.debugM Debug.LSP "No Diagnostic configured for compiler error: " e
|
||||
empty
|
||||
Result.Parsing {} ->
|
||||
-- Parse notes are handled manually in noteDiagnostics
|
||||
todoAnnotation
|
||||
Result.NameResolutionFailures {} -> todoAnnotation
|
||||
where
|
||||
todoAnnotation = []
|
||||
singleRange :: Ann -> [(Range, [a])]
|
||||
singleRange ann = do
|
||||
r <- aToR ann
|
||||
pure (r, [])
|
||||
|
||||
aToR :: Ann -> [Range]
|
||||
aToR = maybeToList . annToRange
|
||||
-- >>> withNeighbours [1, 2, 3, 4]
|
||||
-- [(1,[2,3,4]),(2,[1,3,4]),(3,[1,2,4]),(4,[1,2,3])]
|
||||
withNeighbours :: [a] -> [(a, [a])]
|
||||
withNeighbours [] = []
|
||||
withNeighbours (a : as) = (a, as) : (second (a :) <$> withNeighbours as)
|
||||
|
||||
toRangeMap :: (Foldable f) => f (Range, a) -> IntervalMap Position [a]
|
||||
toRangeMap vs =
|
||||
IM.fromListWith (<>) (toList vs <&> \(r, a) -> (rangeToInterval r, [a]))
|
||||
|
||||
getFileAnalysis :: Uri -> Lsp (Maybe FileAnalysis)
|
||||
getFileAnalysis uri = do
|
||||
checkedFilesV <- asks checkedFilesVar
|
||||
checkedFiles <- readTVarIO checkedFilesV
|
||||
pure $ Map.lookup uri checkedFiles
|
||||
|
@ -5,9 +5,11 @@
|
||||
module Unison.LSP.Types where
|
||||
|
||||
import Colog.Core
|
||||
import Control.Lens
|
||||
import Control.Lens hiding (List)
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.Reader
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.IntervalMap.Lazy (IntervalMap)
|
||||
import qualified Ki
|
||||
import qualified Language.LSP.Logging as LSP
|
||||
import Language.LSP.Server
|
||||
@ -70,7 +72,9 @@ data FileAnalysis = FileAnalysis
|
||||
lexedSource :: LexedSource,
|
||||
parsedFile :: Maybe (UF.UnisonFile Symbol Ann),
|
||||
typecheckedFile :: Maybe (UF.TypecheckedUnisonFile Symbol Ann),
|
||||
notes :: Seq (Note Symbol Ann)
|
||||
notes :: Seq (Note Symbol Ann),
|
||||
diagnostics :: IntervalMap Position [Diagnostic],
|
||||
codeActions :: IntervalMap Position [CodeAction]
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
@ -90,3 +94,41 @@ sendNotification :: forall (m :: Method 'FromServer 'Notification). (Message m ~
|
||||
sendNotification notif = do
|
||||
sendServerMessage <- asks (resSendMessage . lspContext)
|
||||
liftIO $ sendServerMessage $ FromServerMess (notif ^. method) (notif)
|
||||
|
||||
data RangedCodeAction = RangedCodeAction
|
||||
{ -- All the ranges the code action applies
|
||||
_codeActionRanges :: [Range],
|
||||
_codeAction :: CodeAction
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance HasCodeAction RangedCodeAction CodeAction where
|
||||
codeAction = lens _codeAction (\rca ca -> rca {_codeAction = ca})
|
||||
|
||||
rangedCodeAction :: Text -> [Diagnostic] -> [Range] -> RangedCodeAction
|
||||
rangedCodeAction title diags ranges =
|
||||
RangedCodeAction ranges $
|
||||
CodeAction
|
||||
{ _title = title,
|
||||
_kind = Nothing,
|
||||
_diagnostics = Just . List $ diags,
|
||||
_isPreferred = Nothing,
|
||||
_disabled = Nothing,
|
||||
_edit = Nothing,
|
||||
_command = Nothing,
|
||||
_xdata = Nothing
|
||||
}
|
||||
|
||||
-- | Provided ranges must not intersect.
|
||||
includeEdits :: Uri -> Text -> [Range] -> RangedCodeAction -> RangedCodeAction
|
||||
includeEdits uri replacement ranges rca =
|
||||
let edits = do
|
||||
r <- ranges
|
||||
pure $ TextEdit r replacement
|
||||
workspaceEdit =
|
||||
WorkspaceEdit
|
||||
{ _changes = Just $ HM.singleton uri (List edits),
|
||||
_documentChanges = Nothing,
|
||||
_changeAnnotations = Nothing
|
||||
}
|
||||
in rca & codeAction . edit ?~ workspaceEdit
|
||||
|
@ -61,8 +61,10 @@ library
|
||||
Unison.CommandLine.OutputMessages
|
||||
Unison.CommandLine.Welcome
|
||||
Unison.LSP
|
||||
Unison.LSP.CodeAction
|
||||
Unison.LSP.CodeLens
|
||||
Unison.LSP.Completion
|
||||
Unison.LSP.Conversions
|
||||
Unison.LSP.Diagnostics
|
||||
Unison.LSP.FileAnalysis
|
||||
Unison.LSP.Hover
|
||||
@ -104,7 +106,8 @@ library
|
||||
ViewPatterns
|
||||
ghc-options: -Wall
|
||||
build-depends:
|
||||
ListLike
|
||||
IntervalMap
|
||||
, ListLike
|
||||
, aeson
|
||||
, aeson-pretty
|
||||
, async
|
||||
@ -168,6 +171,7 @@ library
|
||||
, unison-util-base32hex
|
||||
, unison-util-relation
|
||||
, unliftio
|
||||
, unordered-containers
|
||||
, vector
|
||||
, wai
|
||||
, warp
|
||||
@ -214,7 +218,8 @@ executable cli-integration-tests
|
||||
build-tools:
|
||||
unison
|
||||
build-depends:
|
||||
ListLike
|
||||
IntervalMap
|
||||
, ListLike
|
||||
, aeson
|
||||
, aeson-pretty
|
||||
, async
|
||||
@ -282,6 +287,7 @@ executable cli-integration-tests
|
||||
, unison-util-base32hex
|
||||
, unison-util-relation
|
||||
, unliftio
|
||||
, unordered-containers
|
||||
, vector
|
||||
, wai
|
||||
, warp
|
||||
@ -321,7 +327,8 @@ executable transcripts
|
||||
ViewPatterns
|
||||
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -v0
|
||||
build-depends:
|
||||
ListLike
|
||||
IntervalMap
|
||||
, ListLike
|
||||
, aeson
|
||||
, aeson-pretty
|
||||
, async
|
||||
@ -390,6 +397,7 @@ executable transcripts
|
||||
, unison-util-base32hex
|
||||
, unison-util-relation
|
||||
, unliftio
|
||||
, unordered-containers
|
||||
, vector
|
||||
, wai
|
||||
, warp
|
||||
@ -433,7 +441,8 @@ executable unison
|
||||
ViewPatterns
|
||||
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-I0 -optP-Wno-nonportable-include-path
|
||||
build-depends:
|
||||
ListLike
|
||||
IntervalMap
|
||||
, ListLike
|
||||
, aeson
|
||||
, aeson-pretty
|
||||
, async
|
||||
@ -503,6 +512,7 @@ executable unison
|
||||
, unison-util-base32hex
|
||||
, unison-util-relation
|
||||
, unliftio
|
||||
, unordered-containers
|
||||
, vector
|
||||
, wai
|
||||
, warp
|
||||
@ -550,7 +560,8 @@ test-suite cli-tests
|
||||
ViewPatterns
|
||||
ghc-options: -Wall
|
||||
build-depends:
|
||||
ListLike
|
||||
IntervalMap
|
||||
, ListLike
|
||||
, aeson
|
||||
, aeson-pretty
|
||||
, async
|
||||
@ -619,6 +630,7 @@ test-suite cli-tests
|
||||
, unison-util-base32hex
|
||||
, unison-util-relation
|
||||
, unliftio
|
||||
, unordered-containers
|
||||
, vector
|
||||
, wai
|
||||
, warp
|
||||
|
Loading…
Reference in New Issue
Block a user