X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FFiles.hs;h=733a94c160ea94634ef34fc0230ca6f65f4bfe80;hb=4c5ad9975b44f2a0482d98c1e67f2de78e7dd0ca;hp=9f78ec1855a4c356da81846a0d2f9184992a293a;hpb=2560f39d64911bc247fa479868052545dca4f827;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Files.hs b/src/Language/Haskell/LSP/Test/Files.hs index 9f78ec1..733a94c 100644 --- a/src/Language/Haskell/LSP/Test/Files.hs +++ b/src/Language/Haskell/LSP/Test/Files.hs @@ -11,8 +11,6 @@ import Language.Haskell.LSP.Capture import Language.Haskell.LSP.Types hiding ( error ) import Language.Haskell.LSP.Messages import Control.Lens -import Data.Aeson -import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.HashMap.Strict as HM import qualified Data.Text as T import Data.Maybe @@ -46,23 +44,42 @@ mapUris f event = FromServer t msg -> FromServer t (fromServerMsg msg) where + --TODO: Handle all other URIs that might need swapped fromClientMsg (NotDidOpenTextDocument n) = NotDidOpenTextDocument $ swapUri (params . textDocument) n fromClientMsg (NotDidChangeTextDocument n) = NotDidChangeTextDocument $ swapUri (params . textDocument) n fromClientMsg (NotWillSaveTextDocument n) = NotWillSaveTextDocument $ swapUri (params . textDocument) n fromClientMsg (NotDidSaveTextDocument n) = NotDidSaveTextDocument $ swapUri (params . textDocument) n fromClientMsg (NotDidCloseTextDocument n) = NotDidCloseTextDocument $ swapUri (params . textDocument) n - fromClientMsg (ReqInitialize r) = ReqInitialize $ params .~ (transformInit (r ^. params)) $ r + fromClientMsg (ReqInitialize r) = ReqInitialize $ params .~ transformInit (r ^. params) $ r + fromClientMsg (ReqDocumentSymbols r) = ReqDocumentSymbols $ swapUri (params . textDocument) r + fromClientMsg (ReqRename r) = ReqRename $ swapUri (params . textDocument) r fromClientMsg x = x fromServerMsg :: FromServerMessage -> FromServerMessage fromServerMsg (ReqApplyWorkspaceEdit r) = - let newDocChanges = fmap (fmap (swapUri textDocument)) $ r ^. params . edit . documentChanges - r1 = (params . edit . documentChanges) .~ newDocChanges $ r - newChanges = fmap (swapKeys f) $ r1 ^. params . edit . changes - r2 = (params . edit . changes) .~ newChanges $ r1 - in ReqApplyWorkspaceEdit r2 + ReqApplyWorkspaceEdit $ params . edit .~ swapWorkspaceEdit (r ^. params . edit) $ r + + fromServerMsg (NotPublishDiagnostics n) = NotPublishDiagnostics $ swapUri params n + + fromServerMsg (RspDocumentSymbols r) = + let newSymbols = case r ^. result of + Just (DSSymbolInformation si) -> Just (DSSymbolInformation (fmap (swapUri location) si)) + x -> x + in RspDocumentSymbols $ result .~ newSymbols $ r + + fromServerMsg (RspRename r) = + let oldResult = r ^. result :: Maybe WorkspaceEdit + newResult = fmap swapWorkspaceEdit oldResult + in RspRename $ result .~ newResult $ r + fromServerMsg x = x + swapWorkspaceEdit :: WorkspaceEdit -> WorkspaceEdit + swapWorkspaceEdit e = + let newDocChanges = fmap (fmap (swapUri textDocument)) $ e ^. documentChanges + newChanges = fmap (swapKeys f) $ e ^. changes + 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