-type FileMap = Map.Map Uri Uri
-
-emptyFileMap :: FileMap
-emptyFileMap = Map.empty
-
-buildFileMap :: [Uri] -> FileMap -> IO FileMap
-buildFileMap uris oldMap = foldM createFile oldMap uris
- where
- createFile map uri =
- if Map.member uri map
- then return map
- else do
- let fp = fromMaybe (error "Couldn't convert file path")
- (uriToFilePath uri)
-
- -- Need to store in a directory inside tmp directory
- -- otherwise ghc-mod ends up creating one for us
- tmpDir <- (</> "lsp-test") <$> getTemporaryDirectory
- createDirectoryIfMissing False tmpDir
-
- (tmpFp, tmpH) <- openTempFile tmpDir (takeFileName fp)
-
- readFile fp >>= hPutStr tmpH
- 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 =
+swapFiles :: FilePath -> FilePath -> [B.ByteString] -> IO [B.ByteString]
+swapFiles recBaseDir relCurBaseDir msgs = do
+ curBaseDir <- (</> relCurBaseDir) <$> getCurrentDirectory
+ let transform uri =
+ let fp = fromMaybe (error "Couldn't transform uri") (uriToFilePath uri)
+ newFp = curBaseDir </> makeRelative recBaseDir fp
+ in filePathToUri newFp
+ newMsgs = map (mapUris transform) msgs :: [B.ByteString]
+
+ return newMsgs
+
+rootDir :: [B.ByteString] -> FilePath
+rootDir msgs = fromMaybe (error "Couldn't find root dir") $ do
+ req <- decode (head msgs) :: Maybe InitializeRequest
+ rootUri <- req ^. params .rootUri
+ uriToFilePath rootUri
+
+mapUris :: (Uri -> Uri) -> B.ByteString -> B.ByteString
+mapUris f msg =