git.iko.soy/ghcide
on master help sign in
Use HashMap/HashSet for maps indexed by Normalized{FilePath,Uri} (#420)
4e89d45Moritz Kiefer
exe/Main.hs+3−3
compare with master
unifiedsplit
@@ -46,7 +46,7 @@ import System.Exit
46import Paths_ghcide
46import Paths_ghcide
47import Development.GitRev
47import Development.GitRev
48import Development.Shake (Action, action)
48import Development.Shake (Action, action)
49−import qualified Data.Set as Set
49+import qualified Data.HashSet as HashSet
50import qualified Data.Map.Strict as Map
50import qualified Data.Map.Strict as Map
51
51
52import GHC hiding (def)
52import GHC hiding (def)
@@ -142,7 +142,7 @@ main = do
142 ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) noopDebouncer options vfs
142 ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) noopDebouncer options vfs
143
143
144 putStrLn "\nStep 6/6: Type checking the files"
144 putStrLn "\nStep 6/6: Type checking the files"
145− setFilesOfInterest ide $ Set.fromList $ map toNormalizedFilePath files
145+ setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath files
146 results <- runActionSync ide $ uses TypeCheck $ map toNormalizedFilePath files
146 results <- runActionSync ide $ uses TypeCheck $ map toNormalizedFilePath files
147 let (worked, failed) = partition fst $ zip (map isJust results) files
147 let (worked, failed) = partition fst $ zip (map isJust results) files
148 when (failed /= []) $
148 when (failed /= []) $
@@ -170,7 +170,7 @@ expandFiles = concatMapM $ \x -> do
170kick :: Action ()
170kick :: Action ()
171kick = do
171kick = do
172 files <- getFilesOfInterest
172 files <- getFilesOfInterest
173− void $ uses TypeCheck $ Set.toList files
173+ void $ uses TypeCheck $ HashSet.toList files
174
174
175-- | Print an LSP event.
175-- | Print an LSP event.
176showEvent :: Lock -> FromServerMessage -> IO ()
176showEvent :: Lock -> FromServerMessage -> IO ()
ghcide.cabal+4−3
@@ -60,7 +60,7 @@ library
60 text,
60 text,
61 time,
61 time,
62 transformers,
62 transformers,
63− unordered-containers,
63+ unordered-containers >= 0.2.10.0,
64 utf8-string,
64 utf8-string,
65 hslogger
65 hslogger
66 if flag(ghc-lib)
66 if flag(ghc-lib)
@@ -144,7 +144,7 @@ library
144executable ghcide-test-preprocessor
144executable ghcide-test-preprocessor
145 default-language: Haskell2010
145 default-language: Haskell2010
146 hs-source-dirs: test/preprocessor
146 hs-source-dirs: test/preprocessor
147− ghc-options: -Wall
147+ ghc-options: -Wall -Wno-name-shadowing
148 main-is: Main.hs
148 main-is: Main.hs
149 build-depends:
149 build-depends:
150 base == 4.*
150 base == 4.*
@@ -181,7 +181,8 @@ executable ghcide
181 ghcide,
181 ghcide,
182 optparse-applicative,
182 optparse-applicative,
183 shake,
183 shake,
184− text
184+ text,
185+ unordered-containers
185 other-modules:
186 other-modules:
186 Arguments
187 Arguments
187 Paths_ghcide
188 Paths_ghcide
src/Development/IDE/Core/FileExists.hs+7−7
@@ -14,8 +14,8 @@ import Control.Monad.Extra
14import qualified Data.Aeson as A
14import qualified Data.Aeson as A
15import Data.Binary
15import Data.Binary
16import qualified Data.ByteString as BS
16import qualified Data.ByteString as BS
17−import Data.Map.Strict ( Map )
17+import Data.HashMap.Strict (HashMap)
18−import qualified Data.Map.Strict as Map
18+import qualified Data.HashMap.Strict as HashMap
19import Data.Maybe
19import Data.Maybe
20import qualified Data.Text as T
20import qualified Data.Text as T
21import Development.IDE.Core.FileStore
21import Development.IDE.Core.FileStore
@@ -30,7 +30,7 @@ import Language.Haskell.LSP.Types.Capabilities
30import qualified System.Directory as Dir
30import qualified System.Directory as Dir
31
31
32-- | A map for tracking the file existence
32-- | A map for tracking the file existence
33−type FileExistsMap = (Map NormalizedFilePath Bool)
33+type FileExistsMap = (HashMap NormalizedFilePath Bool)
34
34
35-- | A wrapper around a mutable 'FileExistsMap'
35-- | A wrapper around a mutable 'FileExistsMap'
36newtype FileExistsMapVar = FileExistsMapVar (Var FileExistsMap)
36newtype FileExistsMapVar = FileExistsMapVar (Var FileExistsMap)
@@ -53,12 +53,12 @@ modifyFileExistsAction f = do
53modifyFileExists :: IdeState -> [(NormalizedFilePath, Bool)] -> IO ()
53modifyFileExists :: IdeState -> [(NormalizedFilePath, Bool)] -> IO ()
54modifyFileExists state changes = do
54modifyFileExists state changes = do
55 FileExistsMapVar var <- getIdeGlobalState state
55 FileExistsMapVar var <- getIdeGlobalState state
56− changesMap <- evaluate $ Map.fromList changes
56+ changesMap <- evaluate $ HashMap.fromList changes
57
57
58 -- Masked to ensure that the previous values are flushed together with the map update
58 -- Masked to ensure that the previous values are flushed together with the map update
59 mask $ \_ -> do
59 mask $ \_ -> do
60 -- update the map
60 -- update the map
61− modifyVar_ var $ evaluate . Map.union changesMap
61+ modifyVar_ var $ evaluate . HashMap.union changesMap
62 -- flush previous values
62 -- flush previous values
63 mapM_ (deleteValue state GetFileExists . fst) changes
63 mapM_ (deleteValue state GetFileExists . fst) changes
64
64
@@ -102,7 +102,7 @@ fileExistsRulesFast getLspId vfs = do
102 addIdeGlobal . FileExistsMapVar =<< liftIO (newVar [])
102 addIdeGlobal . FileExistsMapVar =<< liftIO (newVar [])
103 defineEarlyCutoff $ \GetFileExists file -> do
103 defineEarlyCutoff $ \GetFileExists file -> do
104 fileExistsMap <- getFileExistsMapUntracked
104 fileExistsMap <- getFileExistsMapUntracked
105− let mbFilesWatched = Map.lookup file fileExistsMap
105+ let mbFilesWatched = HashMap.lookup file fileExistsMap
106 case mbFilesWatched of
106 case mbFilesWatched of
107 Just fv -> pure (summarizeExists fv, ([], Just fv))
107 Just fv -> pure (summarizeExists fv, ([], Just fv))
108 Nothing -> do
108 Nothing -> do
@@ -113,7 +113,7 @@ fileExistsRulesFast getLspId vfs = do
113 -- taking the FileExistsMap lock to prevent race conditions
113 -- taking the FileExistsMap lock to prevent race conditions
114 -- that would lead to multiple listeners for the same path
114 -- that would lead to multiple listeners for the same path
115 modifyFileExistsAction $ \x -> do
115 modifyFileExistsAction $ \x -> do
116− case Map.insertLookupWithKey (\_ x _ -> x) file exist x of
116+ case HashMap.alterF (,Just exist) file x of
117 (Nothing, x') -> do
117 (Nothing, x') -> do
118 -- if the listener addition fails, we never recover. This is a bug.
118 -- if the listener addition fails, we never recover. This is a bug.
119 addListener eventer file
119 addListener eventer file
src/Development/IDE/Core/OfInterest.hs+10−10
@@ -19,8 +19,8 @@ import GHC.Generics
19import Data.Typeable
19import Data.Typeable
20import qualified Data.ByteString.UTF8 as BS
20import qualified Data.ByteString.UTF8 as BS
21import Control.Exception
21import Control.Exception
22−import Data.Set (Set)
22+import Data.HashSet (HashSet)
23−import qualified Data.Set as Set
23+import qualified Data.HashSet as HashSet
24import qualified Data.Text as T
24import qualified Data.Text as T
25import Data.Tuple.Extra
25import Data.Tuple.Extra
26import Data.Functor
26import Data.Functor
@@ -31,10 +31,10 @@ import Development.IDE.Types.Logger
31import Development.IDE.Core.Shake
31import Development.IDE.Core.Shake
32
32
33
33
34−newtype OfInterestVar = OfInterestVar (Var (Set NormalizedFilePath))
34+newtype OfInterestVar = OfInterestVar (Var (HashSet NormalizedFilePath))
35instance IsIdeGlobal OfInterestVar
35instance IsIdeGlobal OfInterestVar
36
36
37−type instance RuleResult GetFilesOfInterest = Set NormalizedFilePath
37+type instance RuleResult GetFilesOfInterest = HashSet NormalizedFilePath
38
38
39data GetFilesOfInterest = GetFilesOfInterest
39data GetFilesOfInterest = GetFilesOfInterest
40 deriving (Eq, Show, Typeable, Generic)
40 deriving (Eq, Show, Typeable, Generic)
@@ -46,7 +46,7 @@ instance Binary GetFilesOfInterest
46-- | The rule that initialises the files of interest state.
46-- | The rule that initialises the files of interest state.
47ofInterestRules :: Rules ()
47ofInterestRules :: Rules ()
48ofInterestRules = do
48ofInterestRules = do
49− addIdeGlobal . OfInterestVar =<< liftIO (newVar Set.empty)
49+ addIdeGlobal . OfInterestVar =<< liftIO (newVar HashSet.empty)
50 defineEarlyCutoff $ \GetFilesOfInterest _file -> assert (null $ fromNormalizedFilePath _file) $ do
50 defineEarlyCutoff $ \GetFilesOfInterest _file -> assert (null $ fromNormalizedFilePath _file) $ do
51 alwaysRerun
51 alwaysRerun
52 filesOfInterest <- getFilesOfInterestUntracked
52 filesOfInterest <- getFilesOfInterestUntracked
@@ -54,7 +54,7 @@ ofInterestRules = do
54
54
55
55
56-- | Get the files that are open in the IDE.
56-- | Get the files that are open in the IDE.
57−getFilesOfInterest :: Action (Set NormalizedFilePath)
57+getFilesOfInterest :: Action (HashSet NormalizedFilePath)
58getFilesOfInterest = useNoFile_ GetFilesOfInterest
58getFilesOfInterest = useNoFile_ GetFilesOfInterest
59
59
60
60
@@ -64,19 +64,19 @@ getFilesOfInterest = useNoFile_ GetFilesOfInterest
64
64
65-- | Set the files-of-interest - not usually necessary or advisable.
65-- | Set the files-of-interest - not usually necessary or advisable.
66-- The LSP client will keep this information up to date.
66-- The LSP client will keep this information up to date.
67−setFilesOfInterest :: IdeState -> Set NormalizedFilePath -> IO ()
67+setFilesOfInterest :: IdeState -> HashSet NormalizedFilePath -> IO ()
68setFilesOfInterest state files = modifyFilesOfInterest state (const files)
68setFilesOfInterest state files = modifyFilesOfInterest state (const files)
69
69
70−getFilesOfInterestUntracked :: Action (Set NormalizedFilePath)
70+getFilesOfInterestUntracked :: Action (HashSet NormalizedFilePath)
71getFilesOfInterestUntracked = do
71getFilesOfInterestUntracked = do
72 OfInterestVar var <- getIdeGlobalAction
72 OfInterestVar var <- getIdeGlobalAction
73 liftIO $ readVar var
73 liftIO $ readVar var
74
74
75-- | Modify the files-of-interest - not usually necessary or advisable.
75-- | Modify the files-of-interest - not usually necessary or advisable.
76-- The LSP client will keep this information up to date.
76-- The LSP client will keep this information up to date.
77−modifyFilesOfInterest :: IdeState -> (Set NormalizedFilePath -> Set NormalizedFilePath) -> IO ()
77+modifyFilesOfInterest :: IdeState -> (HashSet NormalizedFilePath -> HashSet NormalizedFilePath) -> IO ()
78modifyFilesOfInterest state f = do
78modifyFilesOfInterest state f = do
79 OfInterestVar var <- getIdeGlobalState state
79 OfInterestVar var <- getIdeGlobalState state
80 files <- modifyVar var $ pure . dupe . f
80 files <- modifyVar var $ pure . dupe . f
81− logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show $ Set.toList files)
81+ logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show $ HashSet.toList files)
82 void $ shakeRun state []
82 void $ shakeRun state []
src/Development/IDE/Core/Shake.hs+22−24
@@ -49,7 +49,6 @@ import Development.Shake.Classes
49import Development.Shake.Rule
49import Development.Shake.Rule
50import qualified Data.HashMap.Strict as HMap
50import qualified Data.HashMap.Strict as HMap
51import qualified Data.Map.Strict as Map
51import qualified Data.Map.Strict as Map
52−import qualified Data.Map.Merge.Strict as Map
53import qualified Data.ByteString.Char8 as BS
52import qualified Data.ByteString.Char8 as BS
54import Data.Dynamic
53import Data.Dynamic
55import Data.Maybe
54import Data.Maybe
@@ -95,13 +94,13 @@ data ShakeExtras = ShakeExtras
95 ,state :: Var Values
94 ,state :: Var Values
96 ,diagnostics :: Var DiagnosticStore
95 ,diagnostics :: Var DiagnosticStore
97 ,hiddenDiagnostics :: Var DiagnosticStore
96 ,hiddenDiagnostics :: Var DiagnosticStore
98− ,publishedDiagnostics :: Var (Map NormalizedUri [Diagnostic])
97+ ,publishedDiagnostics :: Var (HMap.HashMap NormalizedUri [Diagnostic])
99 -- ^ This represents the set of diagnostics that we have published.
98 -- ^ This represents the set of diagnostics that we have published.
100 -- Due to debouncing not every change might get published.
99 -- Due to debouncing not every change might get published.
101− ,positionMapping :: Var (Map NormalizedUri (Map TextDocumentVersion PositionMapping))
100+ ,positionMapping :: Var (HMap.HashMap NormalizedUri (Map TextDocumentVersion PositionMapping))
102 -- ^ Map from a text document version to a PositionMapping that describes how to map
101 -- ^ Map from a text document version to a PositionMapping that describes how to map
103 -- positions in a version of that document to positions in the latest version
102 -- positions in a version of that document to positions in the latest version
104− ,inProgress :: Var (Map NormalizedFilePath Int)
103+ ,inProgress :: Var (HMap.HashMap NormalizedFilePath Int)
105 -- ^ How many rules are running for each file
104 -- ^ How many rules are running for each file
106 }
105 }
107
106
@@ -200,14 +199,14 @@ valueVersion = \case
200 Failed -> Nothing
199 Failed -> Nothing
201
200
202mappingForVersion
201mappingForVersion
203− :: Map NormalizedUri (Map TextDocumentVersion PositionMapping)
202+ :: HMap.HashMap NormalizedUri (Map TextDocumentVersion PositionMapping)
204 -> NormalizedFilePath
203 -> NormalizedFilePath
205 -> TextDocumentVersion
204 -> TextDocumentVersion
206 -> PositionMapping
205 -> PositionMapping
207mappingForVersion allMappings file ver =
206mappingForVersion allMappings file ver =
208 fromMaybe idMapping $
207 fromMaybe idMapping $
209 Map.lookup ver =<<
208 Map.lookup ver =<<
210− Map.lookup (filePathToUri' file) allMappings
209+ HMap.lookup (filePathToUri' file) allMappings
211
210
212type IdeRule k v =
211type IdeRule k v =
213 ( Shake.RuleResult k ~ v
212 ( Shake.RuleResult k ~ v
@@ -301,14 +300,14 @@ shakeOpen :: IO LSP.LspId
301 -> Rules ()
300 -> Rules ()
302 -> IO IdeState
301 -> IO IdeState
303shakeOpen getLspId eventer logger debouncer shakeProfileDir (IdeReportProgress reportProgress) opts rules = do
302shakeOpen getLspId eventer logger debouncer shakeProfileDir (IdeReportProgress reportProgress) opts rules = do
304− inProgress <- newVar Map.empty
303+ inProgress <- newVar HMap.empty
305 shakeExtras <- do
304 shakeExtras <- do
306 globals <- newVar HMap.empty
305 globals <- newVar HMap.empty
307 state <- newVar HMap.empty
306 state <- newVar HMap.empty
308 diagnostics <- newVar mempty
307 diagnostics <- newVar mempty
309 hiddenDiagnostics <- newVar mempty
308 hiddenDiagnostics <- newVar mempty
310 publishedDiagnostics <- newVar mempty
309 publishedDiagnostics <- newVar mempty
311− positionMapping <- newVar Map.empty
310+ positionMapping <- newVar HMap.empty
312 pure ShakeExtras{..}
311 pure ShakeExtras{..}
313 (shakeDb, shakeClose) <-
312 (shakeDb, shakeClose) <-
314 shakeOpenDatabase
313 shakeOpenDatabase
@@ -323,7 +322,7 @@ shakeOpen getLspId eventer logger debouncer shakeProfileDir (IdeReportProgress r
323 shakeDb <- shakeDb
322 shakeDb <- shakeDb
324 return IdeState{..}
323 return IdeState{..}
325
324
326−lspShakeProgress :: Show a => IO LSP.LspId -> (LSP.FromServerMessage -> IO ()) -> Var (Map a Int) -> IO ()
325+lspShakeProgress :: Hashable a => IO LSP.LspId -> (LSP.FromServerMessage -> IO ()) -> Var (HMap.HashMap a Int) -> IO ()
327lspShakeProgress getLspId sendMsg inProgress = do
326lspShakeProgress getLspId sendMsg inProgress = do
328 -- first sleep a bit, so we only show progress messages if it's going to take
327 -- first sleep a bit, so we only show progress messages if it's going to take
329 -- a "noticable amount of time" (we often expect a thread kill to arrive before the sleep finishes)
328 -- a "noticable amount of time" (we often expect a thread kill to arrive before the sleep finishes)
@@ -356,8 +355,8 @@ lspShakeProgress getLspId sendMsg inProgress = do
356 loop id prev = do
355 loop id prev = do
357 sleep sample
356 sleep sample
358 current <- readVar inProgress
357 current <- readVar inProgress
359− let done = length $ filter (== 0) $ Map.elems current
358+ let done = length $ filter (== 0) $ HMap.elems current
360− let todo = Map.size current
359+ let todo = HMap.size current
361 let next = Just $ T.pack $ show done <> "/" <> show todo
360 let next = Just $ T.pack $ show done <> "/" <> show todo
362 when (next /= prev) $
361 when (next /= prev) $
363 sendMsg $ LSP.NotWorkDoneProgressReport $ LSP.fmServerWorkDoneProgressReportNotification
362 sendMsg $ LSP.NotWorkDoneProgressReport $ LSP.fmServerWorkDoneProgressReportNotification
@@ -452,9 +451,9 @@ garbageCollect keep = do
452 return $! dupe values
451 return $! dupe values
453 modifyVar_ diagnostics $ \diags -> return $! filterDiagnostics keep diags
452 modifyVar_ diagnostics $ \diags -> return $! filterDiagnostics keep diags
454 modifyVar_ hiddenDiagnostics $ \hdiags -> return $! filterDiagnostics keep hdiags
453 modifyVar_ hiddenDiagnostics $ \hdiags -> return $! filterDiagnostics keep hdiags
455− modifyVar_ publishedDiagnostics $ \diags -> return $! Map.filterWithKey (\uri _ -> keep (fromUri uri)) diags
454+ modifyVar_ publishedDiagnostics $ \diags -> return $! HMap.filterWithKey (\uri _ -> keep (fromUri uri)) diags
456 let versionsForFile =
455 let versionsForFile =
457− Map.fromListWith Set.union $
456+ HMap.fromListWith Set.union $
458 mapMaybe (\((file, _key), v) -> (filePathToUri' file,) . Set.singleton <$> valueVersion v) $
457 mapMaybe (\((file, _key), v) -> (filePathToUri' file,) . Set.singleton <$> valueVersion v) $
459 HMap.toList newState
458 HMap.toList newState
460 modifyVar_ positionMapping $ \mappings -> return $! filterVersionMap versionsForFile mappings
459 modifyVar_ positionMapping $ \mappings -> return $! filterVersionMap versionsForFile mappings
@@ -534,9 +533,9 @@ usesWithStale key files = do
534 mapM (uncurry lastValue) (zip files values)
533 mapM (uncurry lastValue) (zip files values)
535
534
536
535
537−withProgress :: Ord a => Var (Map a Int) -> a -> Action b -> Action b
536+withProgress :: (Eq a, Hashable a) => Var (HMap.HashMap a Int) -> a -> Action b -> Action b
538withProgress var file = actionBracket (f succ) (const $ f pred) . const
537withProgress var file = actionBracket (f succ) (const $ f pred) . const
539− where f shift = modifyVar_ var $ return . Map.alter (Just . shift . fromMaybe 0) file
538+ where f shift = modifyVar_ var $ return . HMap.alter (Just . shift . fromMaybe 0) file
540
539
541
540
542defineEarlyCutoff
541defineEarlyCutoff
@@ -724,10 +723,10 @@ updateFileDiagnostics fp k ShakeExtras{diagnostics, hiddenDiagnostics, published
724 let delay = if null newDiags then 0.1 else 0
723 let delay = if null newDiags then 0.1 else 0
725 registerEvent debouncer delay uri $ do
724 registerEvent debouncer delay uri $ do
726 mask_ $ modifyVar_ publishedDiagnostics $ \published -> do
725 mask_ $ modifyVar_ publishedDiagnostics $ \published -> do
727− let lastPublish = Map.findWithDefault [] uri published
726+ let lastPublish = HMap.lookupDefault [] uri published
728 when (lastPublish /= newDiags) $
727 when (lastPublish /= newDiags) $
729 eventer $ publishDiagnosticsNotification (fromNormalizedUri uri) newDiags
728 eventer $ publishDiagnosticsNotification (fromNormalizedUri uri) newDiags
730− pure $! Map.insert uri newDiags published
729+ pure $! HMap.insert uri newDiags published
731
730
732publishDiagnosticsNotification :: Uri -> [Diagnostic] -> LSP.FromServerMessage
731publishDiagnosticsNotification :: Uri -> [Diagnostic] -> LSP.FromServerMessage
733publishDiagnosticsNotification uri diags =
732publishDiagnosticsNotification uri diags =
@@ -818,19 +817,18 @@ filterDiagnostics keep =
818 HMap.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath) $ uriToFilePath' $ fromNormalizedUri uri)
817 HMap.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath) $ uriToFilePath' $ fromNormalizedUri uri)
819
818
820filterVersionMap
819filterVersionMap
821− :: Map NormalizedUri (Set.Set TextDocumentVersion)
820+ :: HMap.HashMap NormalizedUri (Set.Set TextDocumentVersion)
822− -> Map NormalizedUri (Map TextDocumentVersion a)
821+ -> HMap.HashMap NormalizedUri (Map TextDocumentVersion a)
823− -> Map NormalizedUri (Map TextDocumentVersion a)
822+ -> HMap.HashMap NormalizedUri (Map TextDocumentVersion a)
824filterVersionMap =
823filterVersionMap =
825− Map.merge Map.dropMissing Map.dropMissing $
826− Map.zipWithMatched $ \_ versionsToKeep versionMap -> Map.restrictKeys versionMap versionsToKeep
824+ HMap.intersectionWith $ \versionsToKeep versionMap -> Map.restrictKeys versionMap versionsToKeep
827
825
828updatePositionMapping :: IdeState -> VersionedTextDocumentIdentifier -> List TextDocumentContentChangeEvent -> IO ()
826updatePositionMapping :: IdeState -> VersionedTextDocumentIdentifier -> List TextDocumentContentChangeEvent -> IO ()
829updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} changes = do
827updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} changes = do
830 modifyVar_ positionMapping $ \allMappings -> do
828 modifyVar_ positionMapping $ \allMappings -> do
831 let uri = toNormalizedUri _uri
829 let uri = toNormalizedUri _uri
832− let mappingForUri = Map.findWithDefault Map.empty uri allMappings
830+ let mappingForUri = HMap.lookupDefault Map.empty uri allMappings
833 let updatedMapping =
831 let updatedMapping =
834 Map.insert _version idMapping $
832 Map.insert _version idMapping $
835 Map.map (\oldMapping -> foldl' applyChange oldMapping changes) mappingForUri
833 Map.map (\oldMapping -> foldl' applyChange oldMapping changes) mappingForUri
836− pure $! Map.insert uri updatedMapping allMappings
834+ pure $! HMap.insert uri updatedMapping allMappings
src/Development/IDE/Import/DependencyInformation.hs+8−8
@@ -29,6 +29,8 @@ import Data.List
29import Development.IDE.GHC.Orphans()
29import Development.IDE.GHC.Orphans()
30import Data.Either
30import Data.Either
31import Data.Graph
31import Data.Graph
32+import Data.HashMap.Strict (HashMap)
33+import qualified Data.HashMap.Strict as HMS
32import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
34import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
33import qualified Data.List.NonEmpty as NonEmpty
35import qualified Data.List.NonEmpty as NonEmpty
34import Data.IntMap (IntMap)
36import Data.IntMap (IntMap)
@@ -36,8 +38,6 @@ import qualified Data.IntMap.Strict as IntMap
36import qualified Data.IntMap.Lazy as IntMapLazy
38import qualified Data.IntMap.Lazy as IntMapLazy
37import Data.IntSet (IntSet)
39import Data.IntSet (IntSet)
38import qualified Data.IntSet as IntSet
40import qualified Data.IntSet as IntSet
39−import Data.Map (Map)
40−import qualified Data.Map.Strict as MS
41import Data.Maybe
41import Data.Maybe
42import Data.Set (Set)
42import Data.Set (Set)
43import qualified Data.Set as Set
43import qualified Data.Set as Set
@@ -68,32 +68,32 @@ newtype FilePathId = FilePathId { getFilePathId :: Int }
68
68
69data PathIdMap = PathIdMap
69data PathIdMap = PathIdMap
70 { idToPathMap :: !(IntMap NormalizedFilePath)
70 { idToPathMap :: !(IntMap NormalizedFilePath)
71− , pathToIdMap :: !(Map NormalizedFilePath FilePathId)
71+ , pathToIdMap :: !(HashMap NormalizedFilePath FilePathId)
72 }
72 }
73 deriving (Show, Generic)
73 deriving (Show, Generic)
74
74
75instance NFData PathIdMap
75instance NFData PathIdMap
76
76
77emptyPathIdMap :: PathIdMap
77emptyPathIdMap :: PathIdMap
78−emptyPathIdMap = PathIdMap IntMap.empty MS.empty
78+emptyPathIdMap = PathIdMap IntMap.empty HMS.empty
79
79
80getPathId :: NormalizedFilePath -> PathIdMap -> (FilePathId, PathIdMap)
80getPathId :: NormalizedFilePath -> PathIdMap -> (FilePathId, PathIdMap)
81getPathId path m@PathIdMap{..} =
81getPathId path m@PathIdMap{..} =
82− case MS.lookup path pathToIdMap of
82+ case HMS.lookup path pathToIdMap of
83 Nothing ->
83 Nothing ->
84− let !newId = FilePathId $ MS.size pathToIdMap
84+ let !newId = FilePathId $ HMS.size pathToIdMap
85 in (newId, insertPathId path newId m)
85 in (newId, insertPathId path newId m)
86 Just id -> (id, m)
86 Just id -> (id, m)
87
87
88insertPathId :: NormalizedFilePath -> FilePathId -> PathIdMap -> PathIdMap
88insertPathId :: NormalizedFilePath -> FilePathId -> PathIdMap -> PathIdMap
89insertPathId path id PathIdMap{..} =
89insertPathId path id PathIdMap{..} =
90− PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (MS.insert path id pathToIdMap)
90+ PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (HMS.insert path id pathToIdMap)
91
91
92insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation
92insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation
93insertImport (FilePathId k) v rawDepInfo = rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) }
93insertImport (FilePathId k) v rawDepInfo = rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) }
94
94
95pathToId :: PathIdMap -> NormalizedFilePath -> FilePathId
95pathToId :: PathIdMap -> NormalizedFilePath -> FilePathId
96−pathToId PathIdMap{pathToIdMap} path = pathToIdMap MS.! path
96+pathToId PathIdMap{pathToIdMap} path = pathToIdMap HMS.! path
97
97
98idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath
98idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath
99idToPath PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id
99idToPath PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id
src/Development/IDE/LSP/Notifications.hs+2−2
@@ -20,7 +20,7 @@ import Development.IDE.Types.Logger
20import Control.Monad.Extra
20import Control.Monad.Extra
21import Data.Foldable as F
21import Data.Foldable as F
22import Data.Maybe
22import Data.Maybe
23−import qualified Data.Set as S
23+import qualified Data.HashSet as S
24import qualified Data.Text as Text
24import qualified Data.Text as Text
25
25
26import Development.IDE.Core.FileStore (setSomethingModified)
26import Development.IDE.Core.FileStore (setSomethingModified)
@@ -69,4 +69,4 @@ setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x
69 logInfo (ideLogger ide) $ "Files created or deleted: " <> msg
69 logInfo (ideLogger ide) $ "Files created or deleted: " <> msg
70 modifyFileExists ide events
70 modifyFileExists ide events
71 setSomethingModified ide
71 setSomethingModified ide
72− }
72+ }
stack84.yaml+1
@@ -19,6 +19,7 @@ extra-deps:
19- regex-tdfa-1.3.1.0
19- regex-tdfa-1.3.1.0
20- parser-combinators-1.2.1
20- parser-combinators-1.2.1
21- haddock-library-1.8.0
21- haddock-library-1.8.0
22+- unordered-containers-0.2.10.0
22nix:
23nix:
23 packages: [zlib]
24 packages: [zlib]
24allow-newer: true
25allow-newer: true