+ where
+ --TODO: Handle all other URLs 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 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
+ fromServerMsg x = x
+
+ 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
+
+ swapUri :: HasUri b Uri => Lens' a b -> a -> a
+ swapUri lens x =
+ let newUri = f (x ^. lens . uri)
+ in (lens . uri) .~ newUri $ x
+
+ -- | Transforms rootUri/rootPath.
+ transformInit :: InitializeParams -> InitializeParams
+ transformInit x =
+ let newRootUri = fmap f (x ^. rootUri)
+ newRootPath = do
+ fp <- T.unpack <$> x ^. rootPath
+ let uri = filePathToUri fp
+ T.pack <$> uriToFilePath (f uri)
+ in (rootUri .~ newRootUri) $ (rootPath .~ newRootPath) x