From 849da926846cfbb5655ff85a0b7cb3d958fbd49e Mon Sep 17 00:00:00 2001
From: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>
Date: Fri, 3 Jan 2020 15:22:59 +0100
Subject: [PATCH] Fix performance regression introduced by filepath
 normalisation

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 #298
---
 src/Development/IDE/Types/Location.hs | 40 ++++++++++++++++++++++++++-
 1 file changed, 39 insertions(+), 1 deletion(-)

diff --git a/src/Development/IDE/Types/Location.hs b/src/Development/IDE/Types/Location.hs
index da39acead..b16e51a3e 100644
--- a/src/Development/IDE/Types/Location.hs
+++ b/src/Development/IDE/Types/Location.hs
@@ -29,7 +29,12 @@ import Data.Binary
 import Data.Maybe as Maybe
 import Data.Hashable
 import Data.String
+import qualified Data.Text as T
+import Network.URI
 import System.FilePath
+import qualified System.FilePath.Posix as FPP
+import qualified System.FilePath.Windows as FPW
+import System.Info.Extra
 import qualified Language.Haskell.LSP.Types as LSP
 import Language.Haskell.LSP.Types as LSP (
     filePathToUri
@@ -65,7 +70,40 @@ uriToFilePath' uri
     | otherwise = LSP.uriToFilePath uri
 
 filePathToUri' :: NormalizedFilePath -> NormalizedUri
-filePathToUri' = toNormalizedUri . filePathToUri . fromNormalizedFilePath
+filePathToUri' (NormalizedFilePath fp) = toNormalizedUri $ Uri $ T.pack $ LSP.fileScheme <> "//" <> platformAdjustToUriPath fp
+  where
+    -- The definitions below are variants of the corresponding functions in Language.Haskell.LSP.Types.Uri that assume that
+    -- the filepath has already been normalised. This is necessary since normalising the filepath has a nontrivial cost.
+
+    toNormalizedUri :: Uri -> NormalizedUri
+    toNormalizedUri (Uri t) =
+      NormalizedUri $ T.pack $ escapeURIString isUnescapedInURI $ unEscapeString $ T.unpack t
+
+    platformAdjustToUriPath :: FilePath -> String
+    platformAdjustToUriPath srcPath
+      | isWindows = '/' : escapedPath
+      | otherwise = escapedPath
+      where
+        (splitDirectories, splitDrive)
+          | isWindows =
+              (FPW.splitDirectories, FPW.splitDrive)
+          | otherwise =
+              (FPP.splitDirectories, FPP.splitDrive)
+        escapedPath =
+            case splitDrive srcPath of
+                (drv, rest) ->
+                    convertDrive drv `FPP.joinDrive`
+                    FPP.joinPath (map (escapeURIString unescaped) $ splitDirectories rest)
+        -- splitDirectories does not remove the path separator after the drive so
+        -- we do a final replacement of \ to /
+        convertDrive drv
+          | isWindows && FPW.hasTrailingPathSeparator drv =
+              FPP.addTrailingPathSeparator (init drv)
+          | otherwise = drv
+        unescaped c
+          | isWindows = isUnreserved c || c `elem` [':', '\\', '/']
+          | otherwise = isUnreserved c || c == '/'
+
 
 
 fromUri :: LSP.NormalizedUri -> NormalizedFilePath