where
import Language.Haskell.LSP.Capture
-import Language.Haskell.LSP.Types hiding ( error )
+import Language.Haskell.LSP.Types
+import Language.Haskell.LSP.Types.Lens 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
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