@@ -29,7 +29,12 @@ import Data.Binary
2929import Data.Maybe as Maybe
3030import Data.Hashable
3131import Data.String
32+import qualified Data.Text as T
33+import Network.URI
3234import System.FilePath
35+import qualified System.FilePath.Posix as FPP
36+import qualified System.FilePath.Windows as FPW
37+import System.Info.Extra
3338import qualified Language.Haskell.LSP.Types as LSP
3439import Language.Haskell.LSP.Types as LSP (
3540 filePathToUri
@@ -65,7 +70,40 @@ uriToFilePath' uri
6570 | otherwise = LSP.uriToFilePath uri
6671
6772filePathToUri' :: 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
71109fromUri :: LSP.NormalizedUri -> NormalizedFilePath