, documentContents
, getDocumentEdit
, getDocUri
+ , getVersionedDoc
-- ** Symbols
, getDocumentSymbols
-- ** Diagnostics
-- ** Code Actions
, getAllCodeActions
, executeCodeAction
+ -- ** Edits
+ , applyEdit
) where
import Control.Applicative
import Data.Maybe
import Language.Haskell.LSP.Types hiding (id, capabilities, message)
import qualified Language.Haskell.LSP.Types as LSP
+import qualified Language.Haskell.LSP.Types.Capabilities as LSP
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Test.Compat
let fp = rootDir context </> file
return $ filePathToUri fp
+-- | Waits for diagnostics to be published and returns them.
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics = do
diagsNot <- skipManyTill anyMessage message :: Session PublishDiagnosticsNotification
let (Just (List symbols)) = mRes
return symbols
+-- | Returns all the code actions in a document by
+-- querying the code actions at each of the current
+-- diagnostics' positions.
getAllCodeActions :: TextDocumentIdentifier -> Session [CommandOrCodeAction]
getAllCodeActions doc = do
curDiags <- fromMaybe [] . Map.lookup (doc ^. uri) . curDiagnostics <$> get
let Just (List cmdOrCAs) = mRes
in return (acc ++ cmdOrCAs)
+-- | Executes a command.
executeCommand :: Command -> Session ()
executeCommand cmd = do
let args = decode $ encode $ fromJust $ cmd ^. arguments
execParams = ExecuteCommandParams (cmd ^. command) args
sendRequest_ WorkspaceExecuteCommand execParams
+-- | Executes a code action.
+-- Matching with the specification, if a code action
+-- contains both an edit and a command, the edit will
+-- be applied first.
executeCodeAction :: CodeAction -> Session ()
executeCodeAction action = do
maybe (return ()) handleEdit $ action ^. edit
where handleEdit :: WorkspaceEdit -> Session ()
handleEdit e =
+ -- Its ok to pass in dummy parameters here as they aren't used
let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams e)
in updateState (ReqApplyWorkspaceEdit req)
+
+-- | Adds the current version to the document, as tracked by the session.
+getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
+getVersionedDoc (TextDocumentIdentifier uri) = do
+ fs <- vfs <$> get
+ let ver =
+ case fs Map.!? uri of
+ Just (VirtualFile v _) -> Just v
+ _ -> Nothing
+ return (VersionedTextDocumentIdentifier uri ver)
+
+-- | Applys an edit to the document and returns the updated document version.
+applyEdit :: TextEdit -> TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
+applyEdit edit doc = do
+
+ verDoc <- getVersionedDoc doc
+
+ caps <- asks (capabilities . config)
+
+ let supportsDocChanges = fromMaybe False $ do
+ let LSP.ClientCapabilities mWorkspace _ _ = caps
+ LSP.WorkspaceClientCapabilities _ mEdit _ _ _ _ <- mWorkspace
+ LSP.WorkspaceEditClientCapabilities mDocChanges <- mEdit
+ mDocChanges
+
+ let wEdit = if supportsDocChanges
+ then
+ let docEdit = TextDocumentEdit verDoc (List [edit])
+ in WorkspaceEdit Nothing (Just (List [docEdit]))
+ else
+ let changes = HashMap.singleton (doc ^. uri) (List [edit])
+ in WorkspaceEdit (Just changes) Nothing
+
+ let req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
+ updateState (ReqApplyWorkspaceEdit req)
+
+ -- version may have changed
+ getVersionedDoc doc
+
import qualified Data.Text.IO as T
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe
+import Data.Function
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.TH.ClientCapabilities
import Language.Haskell.LSP.Types hiding (error)
updateState (ReqApplyWorkspaceEdit r) = do
+ oldVFS <- vfs <$> get
+
allChangeParams <- case r ^. params . edit . documentChanges of
Just (List cs) -> do
mapM_ (checkIfNeedsOpened . (^. textDocument . uri)) cs
return $ concatMap (uncurry getChangeParams) (HashMap.toList cs)
Nothing -> error "No changes!"
- oldVFS <- vfs <$> get
newVFS <- liftIO $ changeFromServerVFS oldVFS r
modify (\s -> s { vfs = newVFS })
-- TODO: Don't do this when replaying a session
forM_ mergedParams (sendMessage . NotificationMessage "2.0" TextDocumentDidChange)
+ -- Update VFS to new document versions
+ let sortedVersions = map (sortBy (compare `on` (^. textDocument . version))) groupedParams
+ latestVersions = map ((^. textDocument) . last) sortedVersions
+ bumpedVersions = map (version . _Just +~ 1) latestVersions
+
+ forM_ bumpedVersions $ \(VersionedTextDocumentIdentifier uri v) ->
+ modify $ \s ->
+ let oldVFS = vfs s
+ update (VirtualFile oldV t) = VirtualFile (fromMaybe oldV v) t
+ newVFS = Map.adjust update uri oldVFS
+ in s { vfs = newVFS }
+
where checkIfNeedsOpened uri = do
oldVFS <- vfs <$> get
ctx <- ask
let changeEvents = map (\e -> TextDocumentContentChangeEvent (Just (e ^. range)) Nothing (e ^. newText)) edits
in DidChangeTextDocumentParams docId (List changeEvents)
- textDocumentVersions uri = map (VersionedTextDocumentIdentifier uri) [0..]
+ textDocumentVersions uri = map (VersionedTextDocumentIdentifier uri . Just) [0..]
textDocumentEdits uri edits = map (\(v, e) -> TextDocumentEdit v (List [e])) $ zip (textDocumentVersions uri) edits
- github: Bubba/haskell-lsp-client
commit: b7cf14eb48837a73032e867dab90db1708220c66
- github: Bubba/haskell-lsp
- commit: 47176f14738451b36b061b2314a2acb05329fde4
+ commit: 0772972aec20df9413b6c3b4b4f0abfa6d4c1535
subdirs:
- .
- ./haskell-lsp-types
rsp <- initializeResponse
liftIO $ rsp ^. result `shouldNotBe` Nothing
- it "can register specific capabilities" $ do
- let caps = def { _workspace = Just workspaceCaps }
- workspaceCaps = def { _didChangeConfiguration = Just configCaps }
- configCaps = DidChangeConfigurationClientCapabilities (Just True)
- conf = def { capabilities = caps }
- runSessionWithConfig conf "hie --lsp" "test/data/renamePass" $ return ()
+ it "can register specific capabilities" $
+ runSessionWithConfig (def { capabilities = didChangeCaps })
+ "hie --lsp" "test/data/renamePass" $ return ()
describe "withTimeout" $ do
it "times out" $
mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4)
mainSymbol ^. containerName `shouldBe` Nothing
+ describe "applyEdit" $ do
+ it "increments the version" $ runSessionWithConfig (def { capabilities = docChangesCaps }) "hie --lsp" "test/data/renamePass" $ do
+ doc <- openDoc "Desktop/simple.hs" "haskell"
+ VersionedTextDocumentIdentifier _ (Just oldVersion) <- getVersionedDoc doc
+ let edit = TextEdit (Range (Position 1 1) (Position 1 3)) "foo"
+ VersionedTextDocumentIdentifier _ (Just newVersion) <- applyEdit edit doc
+ liftIO $ newVersion `shouldBe` oldVersion + 1
+ it "changes the document contents" $ runSession "hie --lsp" "test/data/renamePass" $ do
+ doc <- openDoc "Desktop/simple.hs" "haskell"
+ let edit = TextEdit (Range (Position 0 0) (Position 0 2)) "foo"
+ applyEdit edit doc
+ contents <- documentContents doc
+ liftIO $ contents `shouldSatisfy` T.isPrefixOf "foodule"
+
+
+didChangeCaps :: ClientCapabilities
+didChangeCaps = def { _workspace = Just workspaceCaps }
+ where
+ workspaceCaps = def { _didChangeConfiguration = Just configCaps }
+ configCaps = DidChangeConfigurationClientCapabilities (Just True)
+
+docChangesCaps :: ClientCapabilities
+docChangesCaps = def { _workspace = Just workspaceCaps }
+ where
+ workspaceCaps = def { _workspaceEdit = Just editCaps }
+ editCaps = WorkspaceEditClientCapabilities (Just True)
+
data ApplyOneParams = AOP
{ file :: Uri
, start_pos :: Position