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
   , documentContents
   , getDocumentEdit
   , getDocUri

+  , getVersionedDoc

   -- ** Symbols
   , getDocumentSymbols
   -- ** Diagnostics
   -- ** Symbols
   , getDocumentSymbols
   -- ** Diagnostics


@@ -76,6 +77,8 @@ module Language.Haskell.LSP.Test
   -- ** Code Actions
   , getAllCodeActions
   , executeCodeAction
   -- ** Code Actions
   , getAllCodeActions
   , executeCodeAction

+  -- ** Edits
+  , applyEdit

   ) where
 
 import Control.Applicative
   ) 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 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
 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
 
   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
 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
 
   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
 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)
 
           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
 
 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
 executeCodeAction :: CodeAction -> Session ()
 executeCodeAction action = do
   maybe (return ()) handleEdit $ action ^. edit


@@ -366,5 +379,45 @@ executeCodeAction action = do
 
   where handleEdit :: WorkspaceEdit -> Session ()
         handleEdit e =
 
   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)
           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 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)
 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
 
 
 updateState (ReqApplyWorkspaceEdit r) = do
 

+  oldVFS <- vfs <$> get
+

   allChangeParams <- case r ^. params . edit . documentChanges of
     Just (List cs) -> do
       mapM_ (checkIfNeedsOpened . (^. textDocument . uri)) cs
   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!"
 
         return $ concatMap (uncurry getChangeParams) (HashMap.toList cs)
       Nothing -> error "No changes!"
 

-  oldVFS <- vfs <$> get

   newVFS <- liftIO $ changeFromServerVFS oldVFS r
   modify (\s -> s { vfs = newVFS })
 
   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)
 
   -- 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
   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)
 
           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
 
 
         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
   - github: Bubba/haskell-lsp-client
     commit: b7cf14eb48837a73032e867dab90db1708220c66
   - github: Bubba/haskell-lsp

-    commit: 47176f14738451b36b061b2314a2acb05329fde4
+    commit: 0772972aec20df9413b6c3b4b4f0abfa6d4c1535

     subdirs:
       - .
       - ./haskell-lsp-types
     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
 
       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" $
 
     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
 
         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
 data ApplyOneParams = AOP
   { file      :: Uri
   , start_pos :: Position