Add applyEdit and getVersionedDoc helpers

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index eda3cd2f2925bd34fdef4014482d4c8eef2a6133..4b0226ca98588977c4456832fcb754d25c665953 100644 (file)
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -66,6 +66,7 @@ module Language.Haskell.LSP.Test
   , documentContents
   , getDocumentEdit
   , getDocUri
+  , getVersionedDoc
   -- ** Symbols
   , getDocumentSymbols
   -- ** Diagnostics
@@ -76,6 +77,8 @@ module Language.Haskell.LSP.Test
   -- ** Code Actions
   , getAllCodeActions
   , executeCodeAction
+  -- ** Edits
+  , applyEdit
   ) where
 
 import Control.Applicative
@@ -94,6 +97,7 @@ import qualified Data.Map as Map
 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
@@ -313,6 +317,7 @@ getDocUri file = do
   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
@@ -335,6 +340,9 @@ getDocumentSymbols doc = do
   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
@@ -353,12 +361,17 @@ getAllCodeActions doc = do
           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
@@ -366,5 +379,45 @@ executeCodeAction action = do
 
   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
+  

diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index 10f63b245fb0e5bf93f7b6a9f0d54ec0b27837c1..8e297dea2527800bb63dc300e58d2fe2f7d739cd 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -44,6 +44,7 @@ import qualified Data.Text as T
 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)
@@ -205,6 +206,8 @@ updateState (NotPublishDiagnostics n) = do
 
 updateState (ReqApplyWorkspaceEdit r) = do
 
+  oldVFS <- vfs <$> get
+
   allChangeParams <- case r ^. params . edit . documentChanges of
     Just (List cs) -> do
       mapM_ (checkIfNeedsOpened . (^. textDocument . uri)) cs
@@ -215,7 +218,6 @@ updateState (ReqApplyWorkspaceEdit r) = do
         return $ concatMap (uncurry getChangeParams) (HashMap.toList cs)
       Nothing -> error "No changes!"
 
-  oldVFS <- vfs <$> get
   newVFS <- liftIO $ changeFromServerVFS oldVFS r
   modify (\s -> s { vfs = newVFS })
 
@@ -225,6 +227,18 @@ updateState (ReqApplyWorkspaceEdit r) = do
   -- 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
@@ -245,7 +259,7 @@ updateState (ReqApplyWorkspaceEdit r) = do
           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
 

diff --git a/stack.yaml b/stack.yaml
index adf9f08d4d87f5d87b74e2e94dbc62d08f35b0d3..b53edf85be9c3e6681093a92ec17233fb44d7a48 100644 (file)
--- a/stack.yaml
+++ b/stack.yaml
@@ -6,7 +6,7 @@ extra-deps:
   - github: Bubba/haskell-lsp-client
     commit: b7cf14eb48837a73032e867dab90db1708220c66
   - github: Bubba/haskell-lsp
-    commit: 47176f14738451b36b061b2314a2acb05329fde4
+    commit: 0772972aec20df9413b6c3b4b4f0abfa6d4c1535
     subdirs:
       - .
       - ./haskell-lsp-types

diff --git a/test/Test.hs b/test/Test.hs
index 90be1e2eee7243f821661b3350637d224caebec8..b5abae51f5fab1ad553ab31aa3a0dc96cdf84644 100644 (file)
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -33,12 +33,9 @@ main = hspec $ do
       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" $
@@ -202,6 +199,33 @@ main = hspec $ do
         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