Skip to content

Commit 7a573a5

Browse files
authored
Fix performance regression introduced by filepath normalisation (haskell/ghcide#303)
We already normalise filepaths in NormalizedFilePath. haskell-lsp changed things such that the conversion from Uri to NormalizedUri normalises the filepath again which caused a significant slowdown in GetFileExists. We already have a wrapper for converting from NormalizedFilePath to NormalizedUri so this PR changes this wrapper to inline the definition without the additional layer of normalisation. fixes haskell/ghcide#298
1 parent 139dbfa commit 7a573a5

File tree

1 file changed

+39
-1
lines changed

1 file changed

+39
-1
lines changed

ghcide/src/Development/IDE/Types/Location.hs

+39-1
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,12 @@ import Data.Binary
2929
import Data.Maybe as Maybe
3030
import Data.Hashable
3131
import Data.String
32+
import qualified Data.Text as T
33+
import Network.URI
3234
import System.FilePath
35+
import qualified System.FilePath.Posix as FPP
36+
import qualified System.FilePath.Windows as FPW
37+
import System.Info.Extra
3338
import qualified Language.Haskell.LSP.Types as LSP
3439
import Language.Haskell.LSP.Types as LSP (
3540
filePathToUri
@@ -65,7 +70,40 @@ uriToFilePath' uri
6570
| otherwise = LSP.uriToFilePath uri
6671

6772
filePathToUri' :: NormalizedFilePath -> NormalizedUri
68-
filePathToUri' = toNormalizedUri . filePathToUri . fromNormalizedFilePath
73+
filePathToUri' (NormalizedFilePath fp) = toNormalizedUri $ Uri $ T.pack $ LSP.fileScheme <> "//" <> platformAdjustToUriPath fp
74+
where
75+
-- The definitions below are variants of the corresponding functions in Language.Haskell.LSP.Types.Uri that assume that
76+
-- the filepath has already been normalised. This is necessary since normalising the filepath has a nontrivial cost.
77+
78+
toNormalizedUri :: Uri -> NormalizedUri
79+
toNormalizedUri (Uri t) =
80+
NormalizedUri $ T.pack $ escapeURIString isUnescapedInURI $ unEscapeString $ T.unpack t
81+
82+
platformAdjustToUriPath :: FilePath -> String
83+
platformAdjustToUriPath srcPath
84+
| isWindows = '/' : escapedPath
85+
| otherwise = escapedPath
86+
where
87+
(splitDirectories, splitDrive)
88+
| isWindows =
89+
(FPW.splitDirectories, FPW.splitDrive)
90+
| otherwise =
91+
(FPP.splitDirectories, FPP.splitDrive)
92+
escapedPath =
93+
case splitDrive srcPath of
94+
(drv, rest) ->
95+
convertDrive drv `FPP.joinDrive`
96+
FPP.joinPath (map (escapeURIString unescaped) $ splitDirectories rest)
97+
-- splitDirectories does not remove the path separator after the drive so
98+
-- we do a final replacement of \ to /
99+
convertDrive drv
100+
| isWindows && FPW.hasTrailingPathSeparator drv =
101+
FPP.addTrailingPathSeparator (init drv)
102+
| otherwise = drv
103+
unescaped c
104+
| isWindows = isUnreserved c || c `elem` [':', '\\', '/']
105+
| otherwise = isUnreserved c || c == '/'
106+
69107

70108

71109
fromUri :: LSP.NormalizedUri -> NormalizedFilePath

0 commit comments

Comments
 (0)