- mapValue :: (Uri -> Uri) -> Value -> Value
- mapValue f x = case parse parseJSON x :: Result VersionedTextDocumentIdentifier of
- Success doc -> transform doc
- Error _ -> case parse parseJSON x :: Result TextDocumentIdentifier of
- Success doc -> transform doc
- Error _ -> case parse parseJSON x :: Result InitializeParams of
- Success params -> transformInit params
- Error _ -> case parse parseJSON x :: Result Object of
- Success obj -> Object $ HashMap.map (mapValue f) obj
- Error _ -> x
-
- -- parsing with just JSON
- -- mapValueWithKey :: (Uri -> Uri) -> T.Text -> Value -> Value
- -- mapValueWithKey f "uri" (String s) = fromMaybe (error "Couldn't convert uri") $ do
- -- let uri = filePathToUri $ T.unpack s
- -- String <$> (fmap T.pack (uriToFilePath $ f uri))
- -- mapValueWithKey f _ (Array xs) = Array $ fmap (mapValue f) xs
- -- mapValueWithKey f _ (Object x) = Object $ HashMap.mapWithKey (mapValueWithKey f) x
-
- transform x = toJSON $ x & uri .~ f (x ^. uri)
-
- -- transform rootUri/rootPath
- transformInit :: InitializeParams -> Value
+ --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 (ReqDocumentSymbols r) = ReqDocumentSymbols $ swapUri (params . textDocument) r
+ fromClientMsg (ReqRename r) = ReqRename $ swapUri (params . textDocument) r
+ fromClientMsg x = x
+
+ fromServerMsg :: FromServerMessage -> FromServerMessage
+ fromServerMsg (ReqApplyWorkspaceEdit r) =
+ ReqApplyWorkspaceEdit $ params . edit .~ swapWorkspaceEdit (r ^. params . edit) $ r
+
+ fromServerMsg (NotPublishDiagnostics n) = NotPublishDiagnostics $ swapUri params n
+
+ fromServerMsg (RspDocumentSymbols r) =
+ let swapUri' (DSSymbolInformation si) = DSSymbolInformation (swapUri location <$> si)
+ swapUri' (DSDocumentSymbols dss) = DSDocumentSymbols dss -- no file locations here
+ in RspDocumentSymbols $ r & result %~ (fmap swapUri')
+
+ fromServerMsg (RspRename r) = RspRename $ r & result %~ (fmap swapWorkspaceEdit)
+
+ 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
+
+ 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