Merge pull request bubba/lsp-test/#81 from banacorn/lspbubba/lsp-test/#267

Fix alanz/lspbubba/lsp-test/#267

Author: lukel97

lsp-test/cabal.project

@@ -3,3 +3,14 @@ packages: .
 flags: +DummyServer
 test-show-details: direct
 haddock-quickjump: True
+
+source-repository-package
+    type: git
+    location: https://github.com/banacorn/lsp.git
+    tag: 0556d22fc66f24bb526f671666183a86b485837e
+    subdir: lsp-types
+
+source-repository-package
+    type: git
+    location: https://github.com/banacorn/lsp.git
+    tag: 0556d22fc66f24bb526f671666183a86b485837e

lsp-test/src/Language/LSP/Test.hs

@@ -285,7 +285,7 @@ getDocumentEdit doc = do
   where
     checkDocumentChanges req =
       let changes = req ^. params . edit . documentChanges
-          maybeDocs = fmap (fmap (^. textDocument . uri)) changes
+          maybeDocs = fmap (fmap documentChangeUri) changes
       in case maybeDocs of
         Just docs -> (doc ^. uri) `elem` docs
         Nothing -> False
@@ -583,7 +583,7 @@ applyEdit doc edit = do
   let wEdit = if supportsDocChanges
       then
         let docEdit = TextDocumentEdit verDoc (List [edit])
-        in WorkspaceEdit Nothing (Just (List [docEdit]))
+        in WorkspaceEdit Nothing (Just (List [InL docEdit]))
       else
         let changes = HashMap.singleton (doc ^. uri) (List [edit])
         in WorkspaceEdit (Just changes) Nothing

lsp-test/src/Language/LSP/Test/Files.hs

@@ -11,7 +11,7 @@ module Language.LSP.Test.Files
 where
 
 import           Language.LSP.Types
-import           Language.LSP.Types.Lens
+import           Language.LSP.Types.Lens hiding (id)
 import           Control.Lens
 import qualified Data.HashMap.Strict           as HM
 import qualified Data.Text                     as T
@@ -75,9 +75,16 @@ mapUris f event =
 
     swapWorkspaceEdit :: WorkspaceEdit -> WorkspaceEdit
     swapWorkspaceEdit e =
-      let newDocChanges = fmap (fmap (swapUri textDocument)) $ e ^. documentChanges
+      let swapDocumentChangeUri :: DocumentChange -> DocumentChange
+          swapDocumentChangeUri (InL textDocEdit) = InL $ swapUri textDocument textDocEdit
+          swapDocumentChangeUri (InR (InL createFile)) = InR $ InL $ swapUri id createFile
+          -- for RenameFile, we swap `newUri`
+          swapDocumentChangeUri (InR (InR (InL renameFile))) = InR $ InR $ InL $ newUri .~ f (renameFile ^. newUri) $ renameFile
+          swapDocumentChangeUri (InR (InR (InR deleteFile))) = InR $ InR $ InR $ swapUri id deleteFile
+
+          newDocChanges = fmap (fmap swapDocumentChangeUri) $ e ^. documentChanges
           newChanges = fmap (swapKeys f) $ e ^. changes
-      in WorkspaceEdit newChanges newDocChanges
+       in WorkspaceEdit newChanges newDocChanges
 
     swapKeys :: (Uri -> Uri) -> HM.HashMap Uri b -> HM.HashMap Uri b
     swapKeys f = HM.foldlWithKey' (\acc k v -> HM.insert (f k) v acc) HM.empty

lsp-test/src/Language/LSP/Test/Session.hs

@@ -29,6 +29,7 @@ module Language.LSP.Test.Session
   , bumpTimeoutId
   , logMsg
   , LogMsgType(..)
+  , documentChangeUri
   )
 
 where
@@ -296,6 +297,14 @@ updateStateC = awaitForever $ \msg -> do
   updateState msg
   yield msg
 
+-- extract Uri out from DocumentChange
+-- didn't put this in `lsp-types` because TH was getting in the way
+documentChangeUri :: DocumentChange -> Uri
+documentChangeUri (InL x) = x ^. textDocument . uri
+documentChangeUri (InR (InL x)) = x ^. uri
+documentChangeUri (InR (InR (InL x))) = x ^. oldUri
+documentChangeUri (InR (InR (InR x))) = x ^. uri
+
 updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)
             => FromServerMessage -> m ()
 
@@ -323,8 +332,8 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do
   -- First, prefer the versioned documentChanges field
   allChangeParams <- case r ^. params . edit . documentChanges of
     Just (List cs) -> do
-      mapM_ (checkIfNeedsOpened . (^. textDocument . uri)) cs
-      return $ map getParams cs
+      mapM_ (checkIfNeedsOpened . documentChangeUri) cs
+      return $ mapMaybe getParamsFromDocumentChange cs
     -- Then fall back to the changes field
     Nothing -> case r ^. params . edit . changes of
       Just cs -> do
@@ -371,10 +380,16 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do
               let (newVFS,_) = openVFS (vfs s) msg
               return $ s { vfs = newVFS }
 
-        getParams (TextDocumentEdit docId (List edits)) =
+        getParamsFromTextDocumentEdit :: TextDocumentEdit -> DidChangeTextDocumentParams
+        getParamsFromTextDocumentEdit (TextDocumentEdit docId (List edits)) = 
           let changeEvents = map (\e -> TextDocumentContentChangeEvent (Just (e ^. range)) Nothing (e ^. newText)) edits
             in DidChangeTextDocumentParams docId (List changeEvents)
 
+        getParamsFromDocumentChange :: DocumentChange -> Maybe DidChangeTextDocumentParams
+        getParamsFromDocumentChange (InL textDocumentEdit) = Just $ getParamsFromTextDocumentEdit textDocumentEdit
+        getParamsFromDocumentChange _ = Nothing
+
+
         -- For a uri returns an infinite list of versions [n,n+1,n+2,...]
         -- where n is the current version
         textDocumentVersions uri = do
@@ -387,8 +402,8 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do
           vers <- textDocumentVersions uri
           pure $ map (\(v, e) -> TextDocumentEdit v (List [e])) $ zip vers edits
 
-        getChangeParams uri (List edits) =
-          map <$> pure getParams <*> textDocumentEdits uri (reverse edits)
+        getChangeParams uri (List edits) = do 
+          map <$> pure getParamsFromTextDocumentEdit <*> textDocumentEdits uri (reverse edits)
 
         mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
         mergeParams params = let events = concat (toList (map (toList . (^. contentChanges)) params))