- return $ Map.insert fp tmpFp map
-
-swapFile :: (HasUri a Uri) => FileMap -> a -> a
-swapFile m msg = fromMaybe msg $ do
- let oldUri = msg ^. uri
- oldFp <- uriToFilePath oldUri
- newFp <- Map.lookup oldFp m
- let newUri = filePathToUri newFp
- return $ uri .~ newUri $ msg
-
-loadSwappedFiles :: FileMap -> Handle -> IO ([B.ByteString], FileMap)
-loadSwappedFiles map h = do
- fileMapVar <- newMVar map
- msgsVar <- newMVar []
- nullH <- openFile "/dev/null" WriteMode
- Control.runWithHandles h
- nullH
- (const $ Right (), const $ return Nothing)
- (handlers msgsVar fileMapVar)
- def
- Nothing
- Nothing
- newMap <- readMVar fileMapVar
- msgs <- reverse <$> readMVar msgsVar
- return (msgs, newMap)
-
-handlers :: MVar [B.ByteString] -> MVar FileMap -> Handlers
-handlers msgs fileMap = Handlers
- {
- -- Requests
- hoverHandler = Just put
- , completionHandler = Just put
- , completionResolveHandler = Just put
- , signatureHelpHandler = Just put
- , definitionHandler = Just put
- , referencesHandler = Just put
- , documentHighlightHandler = Just put
- , documentSymbolHandler = Just $ swapUri (params . textDocument)
- , workspaceSymbolHandler = Just put
- , codeActionHandler = Just put
- , codeLensHandler = Just put
- , codeLensResolveHandler = Just put
- , documentFormattingHandler = Just put
- , documentRangeFormattingHandler = Just put
- , documentTypeFormattingHandler = Just put
- , renameHandler = Just $ swapUri (params . textDocument)
- , documentLinkHandler = Just $ swapUri (params . textDocument)
- , documentLinkResolveHandler = Just put
- , executeCommandHandler = Just put
- , initializeRequestHandler = Just put
- -- Notifications
- , didChangeConfigurationParamsHandler = Just put
- , didOpenTextDocumentNotificationHandler = Just $ swapUri (params . textDocument)
- , didChangeTextDocumentNotificationHandler = Just $ swapUri (params . textDocument)
- , didCloseTextDocumentNotificationHandler = Just $ swapUri (params . textDocument)
- , didSaveTextDocumentNotificationHandler = Just $ swapUri (params . textDocument)
- , willSaveWaitUntilTextDocHandler = Just put
- , didChangeWatchedFilesNotificationHandler = Just put
- , initializedHandler = Just put
- , willSaveTextDocumentNotificationHandler = Just $ swapUri (params . textDocument)
- , cancelNotificationHandler = Just put
- , exitNotificationHandler = Just put
- -- Responses
- , responseHandler = Just put
- }
- where
- swapUri f msg = do
- modifyMVar_ fileMap (buildFiles [msg])
- map <- readMVar fileMap
- put $ swapFile map $ msg ^. f
+ tmpUri <- filePathToUri <$> canonicalizePath tmpFp
+ return $ Map.insert uri tmpUri map
+
+swapFiles :: FileMap -> Handle -> IO ([B.ByteString], FileMap)
+swapFiles fileMap h = do
+ msgs <- getAllMessages h
+
+ let oldUris = Set.unions $ map extractUris msgs
+
+ newMap <- buildFileMap (Set.elems oldUris) fileMap
+
+ let newMsgs = map (swapUris newMap) msgs
+
+ return (newMsgs, newMap)
+
+extractUris :: B.ByteString -> Set.Set Uri
+extractUris msgs =
+ case decode msgs :: Maybe Object of
+ Just obj -> HashMap.foldlWithKey' gather Set.empty obj
+ Nothing -> error "nooo"
+ where gather :: Set.Set Uri -> T.Text -> Value -> Set.Set Uri
+ gather uris "uri" (String s) = Set.insert (Uri s) uris
+ gather uris _ (Object o) = HashMap.foldlWithKey' gather uris o
+ gather uris _ _ = uris
+
+swapUris :: FileMap -> B.ByteString -> B.ByteString
+swapUris fileMap msg =
+ case decode msg :: Maybe Object of
+ Just obj -> encode $ HashMap.mapWithKey f obj
+ Nothing -> error "Couldn't decode message"
+
+ where f :: T.Text -> Value -> Value
+ f "uri" (String uri) = String $ swap uri
+ f "changes" (Object obj) = Object $
+ HashMap.foldlWithKey' (\acc k v -> HashMap.insert (swap k) v acc)
+ HashMap.empty
+ obj
+ f _ x = g x
+
+ g :: Value -> Value
+ g (Array arr) = Array $ fmap g arr
+ g (Object obj) = Object $ HashMap.mapWithKey f obj
+ g x = x