@@ -10,15 +10,15 @@ module Development.IDE.Types.Location
1010 , Position(..)
1111 , showPosition
1212 , Range(..)
13− , Uri(..)
14− , NormalizedUri
13+ , LSP.Uri(..)
14+ , LSP.NormalizedUri
1515 , LSP.toNormalizedUri
1616 , LSP.fromNormalizedUri
17− , NormalizedFilePath
17+ , LSP.NormalizedFilePath
1818 , fromUri
19− , toNormalizedFilePath
20− , fromNormalizedFilePath
21− , filePathToUri
19+ , emptyFilePath
20+ , toNormalizedFilePath'
21+ , LSP.fromNormalizedFilePath
2222 , filePathToUri'
2323 , uriToFilePath'
2424 , readSrcSpan
@@ -26,135 +26,40 @@ module Development.IDE.Types.Location
2626
2727import Control.Applicative
2828import Language.Haskell.LSP.Types (Location(..), Range(..), Position(..))
29−import Control.DeepSeq
3029import Control.Monad
31−import Data.Binary
32−import Data.Maybe as Maybe
33−import Data.Hashable
30+import Data.Hashable (Hashable(hash))
3431import Data.String
35−import qualified Data.Text as T
3632import FastString
37−import Network.URI
38−import System.FilePath
39−import qualified System.FilePath.Posix as FPP
40−import qualified System.FilePath.Windows as FPW
41−import System.Info.Extra
4233import qualified Language.Haskell.LSP.Types as LSP
43−import Language.Haskell.LSP.Types as LSP (
44− filePathToUri
45− , NormalizedUri(..)
46− , Uri(..)
47− , toNormalizedUri
48− , fromNormalizedUri
49− )
5034import SrcLoc as GHC
5135import Text.ParserCombinators.ReadP as ReadP
52−import GHC.Generics
36+import Data.Maybe (fromMaybe)
5337
54−
55−-- | Newtype wrapper around FilePath that always has normalized slashes.
56−-- The NormalizedUri and hash of the FilePath are cached to avoided
57−-- repeated normalisation when we need to compute them (which is a lot).
58−--
59−-- This is one of the most performance critical parts of ghcide, do not
60−-- modify it without profiling.
61−data NormalizedFilePath = NormalizedFilePath NormalizedUriWrapper !Int !FilePath
62− deriving (Generic, Eq, Ord)
63−
64−instance NFData NormalizedFilePath where
65−instance Binary NormalizedFilePath where
66− put (NormalizedFilePath _ _ fp) = put fp
67− get = do
68− v <- Data.Binary.get :: Get FilePath
69− return (toNormalizedFilePath v)
70−
71−
72−instance Show NormalizedFilePath where
73− show (NormalizedFilePath _ _ fp) = "NormalizedFilePath " ++ show fp
74−
75−instance Hashable NormalizedFilePath where
76− hash (NormalizedFilePath _ h _) = h
77−
78−-- Just to define NFData and Binary
79−newtype NormalizedUriWrapper =
80− NormalizedUriWrapper { unwrapNormalizedFilePath :: NormalizedUri }
81− deriving (Show, Generic, Eq, Ord)
82−
83−instance NFData NormalizedUriWrapper where
84− rnf = rwhnf
85−
86−
87−instance Hashable NormalizedUriWrapper where
88−
89−instance IsString NormalizedFilePath where
90− fromString = toNormalizedFilePath
91−
92−toNormalizedFilePath :: FilePath -> NormalizedFilePath
38+toNormalizedFilePath' :: FilePath -> LSP.NormalizedFilePath
9339-- We want to keep empty paths instead of normalising them to "."
94−toNormalizedFilePath "" = NormalizedFilePath (NormalizedUriWrapper emptyPathUri) (hash ("" :: String)) ""
95−toNormalizedFilePath fp =
96− let nfp = normalise fp
97− in NormalizedFilePath (NormalizedUriWrapper $ filePathToUriInternal' nfp) (hash nfp) nfp
40+toNormalizedFilePath' "" = emptyFilePath
41+toNormalizedFilePath' fp = LSP.toNormalizedFilePath fp
9842
99−fromNormalizedFilePath :: NormalizedFilePath -> FilePath
100−fromNormalizedFilePath (NormalizedFilePath _ _ fp) = fp
43+emptyFilePath :: LSP.NormalizedFilePath
44+emptyFilePath = LSP.NormalizedFilePath emptyPathUri ""
10145
10246-- | We use an empty string as a filepath when we don’t have a file.
10347-- However, haskell-lsp doesn’t support that in uriToFilePath and given
10448-- that it is not a valid filepath it does not make sense to upstream a fix.
10549-- So we have our own wrapper here that supports empty filepaths.
106−uriToFilePath' :: Uri -> Maybe FilePath
50+uriToFilePath' :: LSP.Uri -> Maybe FilePath
10751uriToFilePath' uri
108− | uri == fromNormalizedUri emptyPathUri = Just ""
52+ | uri == LSP.fromNormalizedUri emptyPathUri = Just ""
10953 | otherwise = LSP.uriToFilePath uri
11054
111−emptyPathUri :: NormalizedUri
112−emptyPathUri = filePathToUriInternal' ""
113−
114−filePathToUri' :: NormalizedFilePath -> NormalizedUri
115−filePathToUri' (NormalizedFilePath (NormalizedUriWrapper u) _ _) = u
55+emptyPathUri :: LSP.NormalizedUri
56+emptyPathUri = LSP.NormalizedUri (hash ("" :: String)) ""
11657
117−filePathToUriInternal' :: FilePath -> NormalizedUri
118−filePathToUriInternal' fp = toNormalizedUri $ Uri $ T.pack $ LSP.fileScheme <> "//" <> platformAdjustToUriPath fp
119− where
120− -- The definitions below are variants of the corresponding functions in Language.Haskell.LSP.Types.Uri that assume that
121− -- the filepath has already been normalised. This is necessary since normalising the filepath has a nontrivial cost.
122−
123− toNormalizedUri :: Uri -> NormalizedUri
124− toNormalizedUri (Uri t) =
125− let fp = T.pack $ escapeURIString isUnescapedInURI $ unEscapeString $ T.unpack t
126− in NormalizedUri (hash fp) fp
127−
128− platformAdjustToUriPath :: FilePath -> String
129− platformAdjustToUriPath srcPath
130− | isWindows = '/' : escapedPath
131− | otherwise = escapedPath
132− where
133− (splitDirectories, splitDrive)
134− | isWindows =
135− (FPW.splitDirectories, FPW.splitDrive)
136− | otherwise =
137− (FPP.splitDirectories, FPP.splitDrive)
138− escapedPath =
139− case splitDrive srcPath of
140− (drv, rest) ->
141− convertDrive drv `FPP.joinDrive`
142− FPP.joinPath (map (escapeURIString unescaped) $ splitDirectories rest)
143− -- splitDirectories does not remove the path separator after the drive so
144− -- we do a final replacement of \ to /
145− convertDrive drv
146− | isWindows && FPW.hasTrailingPathSeparator drv =
147− FPP.addTrailingPathSeparator (init drv)
148− | otherwise = drv
149− unescaped c
150− | isWindows = isUnreserved c || c `elem` [':', '\\', '/']
151− | otherwise = isUnreserved c || c == '/'
152−
153−
154−
155−fromUri :: LSP.NormalizedUri -> NormalizedFilePath
156−fromUri = toNormalizedFilePath . fromMaybe noFilePath . uriToFilePath' . fromNormalizedUri
58+filePathToUri' :: LSP.NormalizedFilePath -> LSP.NormalizedUri
59+filePathToUri' = LSP.normalizedFilePathToUri
15760
61+fromUri :: LSP.NormalizedUri -> LSP.NormalizedFilePath
62+fromUri = fromMaybe (toNormalizedFilePath' noFilePath) . LSP.uriToNormalizedFilePath
15863
15964noFilePath :: FilePath
16065noFilePath = "<unknown>"