@@ -49,22 +49,55 @@ import Language.Haskell.LSP.Types as LSP (
4949 )
5050import SrcLoc as GHC
5151import Text.ParserCombinators.ReadP as ReadP
52+import GHC.Generics
5253
5354
5455-- | Newtype wrapper around FilePath that always has normalized slashes.
55−newtype NormalizedFilePath = NormalizedFilePath FilePath
56− deriving (Eq, Ord, Show, Hashable, NFData, Binary)
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
5788
5889instance IsString NormalizedFilePath where
5990 fromString = toNormalizedFilePath
6091
6192toNormalizedFilePath :: FilePath -> NormalizedFilePath
6293-- We want to keep empty paths instead of normalising them to "."
63−toNormalizedFilePath "" = NormalizedFilePath ""
64−toNormalizedFilePath fp = NormalizedFilePath $ normalise fp
94+toNormalizedFilePath "" = NormalizedFilePath (NormalizedUriWrapper emptyPathUri) (hash ("" :: String)) ""
95+toNormalizedFilePath fp =
96+ let nfp = normalise fp
97+ in NormalizedFilePath (NormalizedUriWrapper $ filePathToUriInternal' nfp) (hash nfp) nfp
6598
6699fromNormalizedFilePath :: NormalizedFilePath -> FilePath
67−fromNormalizedFilePath (NormalizedFilePath fp) = fp
100+fromNormalizedFilePath (NormalizedFilePath _ _ fp) = fp
68101
69102-- | We use an empty string as a filepath when we don’t have a file.
70103-- However, haskell-lsp doesn’t support that in uriToFilePath and given
@@ -76,10 +109,13 @@ uriToFilePath' uri
76109 | otherwise = LSP.uriToFilePath uri
77110
78111emptyPathUri :: NormalizedUri
79−emptyPathUri = filePathToUri' ""
112+emptyPathUri = filePathToUriInternal' ""
80113
81114filePathToUri' :: NormalizedFilePath -> NormalizedUri
82−filePathToUri' (NormalizedFilePath fp) = toNormalizedUri $ Uri $ T.pack $ LSP.fileScheme <> "//" <> platformAdjustToUriPath fp
115+filePathToUri' (NormalizedFilePath (NormalizedUriWrapper u) _ _) = u
116+
117+filePathToUriInternal' :: FilePath -> NormalizedUri
118+filePathToUriInternal' fp = toNormalizedUri $ Uri $ T.pack $ LSP.fileScheme <> "//" <> platformAdjustToUriPath fp
83119 where
84120 -- The definitions below are variants of the corresponding functions in Language.Haskell.LSP.Types.Uri that assume that
85121 -- the filepath has already been normalised. This is necessary since normalising the filepath has a nontrivial cost.