4e89d45 · ghcide · git.iko.soy

git.iko.soy/ghcide

Use HashMap/HashSet for maps indexed by Normalized{FilePath,Uri} (#420)

Now that we have optimized Hashable instances for these, it makes sense to use this consistently.

commit4e89d4574d538d663bd37f074ef6ef973d14a0f1 authorMoritz Kiefer <moritz.kiefer@purelyfunctional.org> dateTue 11 Feb 2020, 10:09 (7 years ago) parent5a65da1

8 files changed+57−57

compare with master

unifiedsplit

exe/Main.hs+3−3 ghcide.cabal+4−3 src/Development/IDE/Core/FileExists.hs+7−7 src/Development/IDE/Core/OfInterest.hs+10−10 src/Development/IDE/Core/Shake.hs+22−24 src/Development/IDE/Import/DependencyInformation.hs+8−8 src/Development/IDE/LSP/Notifications.hs+2−2 stack84.yaml+1

exe/Main.hs+3−3

@@ -46,7 +46,7 @@ import System.Exit

4646import Paths_ghcide

4747import Development.GitRev

4848import Development.Shake (Action, action)

49−import qualified Data.Set as Set

49+import qualified Data.HashSet as HashSet

5050import qualified Data.Map.Strict as Map

5151

5252import GHC hiding (def)

@@ -142,7 +142,7 @@ main = do

142142 ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) noopDebouncer options vfs

143143

144144 putStrLn "\nStep 6/6: Type checking the files"

145− setFilesOfInterest ide $ Set.fromList $ map toNormalizedFilePath files

145+ setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath files

146146 results <- runActionSync ide $ uses TypeCheck $ map toNormalizedFilePath files

147147 let (worked, failed) = partition fst $ zip (map isJust results) files

148148 when (failed /= []) $

@@ -170,7 +170,7 @@ expandFiles = concatMapM $ \x -> do

170170kick :: Action ()

171171kick = do

172172 files <- getFilesOfInterest

173− void $ uses TypeCheck $ Set.toList files

173+ void $ uses TypeCheck $ HashSet.toList files

174174

175175-- | Print an LSP event.

176176showEvent :: Lock -> FromServerMessage -> IO ()

ghcide.cabal+4−3

@@ -60,7 +60,7 @@ library

6060 text,

6161 time,

6262 transformers,

63− unordered-containers,

63+ unordered-containers >= 0.2.10.0,

6464 utf8-string,

6565 hslogger

6666 if flag(ghc-lib)

@@ -144,7 +144,7 @@ library

144144executable ghcide-test-preprocessor

145145 default-language: Haskell2010

146146 hs-source-dirs: test/preprocessor

147− ghc-options: -Wall

147+ ghc-options: -Wall -Wno-name-shadowing

148148 main-is: Main.hs

149149 build-depends:

150150 base == 4.*

@@ -181,7 +181,8 @@ executable ghcide

181181 ghcide,

182182 optparse-applicative,

183183 shake,

184− text

184+ text,

185+ unordered-containers

185186 other-modules:

186187 Arguments

187188 Paths_ghcide

src/Development/IDE/Core/FileExists.hs+7−7

@@ -14,8 +14,8 @@ import Control.Monad.Extra

1414import qualified Data.Aeson as A

1515import Data.Binary

1616import qualified Data.ByteString as BS

17−import Data.Map.Strict ( Map )

18−import qualified Data.Map.Strict as Map

17+import Data.HashMap.Strict (HashMap)

18+import qualified Data.HashMap.Strict as HashMap

1919import Data.Maybe

2020import qualified Data.Text as T

2121import Development.IDE.Core.FileStore

@@ -30,7 +30,7 @@ import Language.Haskell.LSP.Types.Capabilities

3030import qualified System.Directory as Dir

3131

3232-- | A map for tracking the file existence

33−type FileExistsMap = (Map NormalizedFilePath Bool)

33+type FileExistsMap = (HashMap NormalizedFilePath Bool)

3434

3535-- | A wrapper around a mutable 'FileExistsMap'

3636newtype FileExistsMapVar = FileExistsMapVar (Var FileExistsMap)

@@ -53,12 +53,12 @@ modifyFileExistsAction f = do

5353modifyFileExists :: IdeState -> [(NormalizedFilePath, Bool)] -> IO ()

5454modifyFileExists state changes = do

5555 FileExistsMapVar var <- getIdeGlobalState state

56− changesMap <- evaluate $ Map.fromList changes

56+ changesMap <- evaluate $ HashMap.fromList changes

5757

5858 -- Masked to ensure that the previous values are flushed together with the map update

5959 mask $ \_ -> do

6060 -- update the map

61− modifyVar_ var $ evaluate . Map.union changesMap

61+ modifyVar_ var $ evaluate . HashMap.union changesMap

6262 -- flush previous values

6363 mapM_ (deleteValue state GetFileExists . fst) changes

6464

@@ -102,7 +102,7 @@ fileExistsRulesFast getLspId vfs = do

102102 addIdeGlobal . FileExistsMapVar =<< liftIO (newVar [])

103103 defineEarlyCutoff $ \GetFileExists file -> do

104104 fileExistsMap <- getFileExistsMapUntracked

105− let mbFilesWatched = Map.lookup file fileExistsMap

105+ let mbFilesWatched = HashMap.lookup file fileExistsMap

106106 case mbFilesWatched of

107107 Just fv -> pure (summarizeExists fv, ([], Just fv))

108108 Nothing -> do

@@ -113,7 +113,7 @@ fileExistsRulesFast getLspId vfs = do

113113 -- taking the FileExistsMap lock to prevent race conditions

114114 -- that would lead to multiple listeners for the same path

115115 modifyFileExistsAction $ \x -> do

116− case Map.insertLookupWithKey (\_ x _ -> x) file exist x of

116+ case HashMap.alterF (,Just exist) file x of

117117 (Nothing, x') -> do

118118 -- if the listener addition fails, we never recover. This is a bug.

119119 addListener eventer file

src/Development/IDE/Core/OfInterest.hs+10−10

@@ -19,8 +19,8 @@ import GHC.Generics

1919import Data.Typeable

2020import qualified Data.ByteString.UTF8 as BS

2121import Control.Exception

22−import Data.Set (Set)

23−import qualified Data.Set as Set

22+import Data.HashSet (HashSet)

23+import qualified Data.HashSet as HashSet

2424import qualified Data.Text as T

2525import Data.Tuple.Extra

2626import Data.Functor

@@ -31,10 +31,10 @@ import Development.IDE.Types.Logger

3131import Development.IDE.Core.Shake

3232

3333

34−newtype OfInterestVar = OfInterestVar (Var (Set NormalizedFilePath))

34+newtype OfInterestVar = OfInterestVar (Var (HashSet NormalizedFilePath))

3535instance IsIdeGlobal OfInterestVar

3636

37−type instance RuleResult GetFilesOfInterest = Set NormalizedFilePath

37+type instance RuleResult GetFilesOfInterest = HashSet NormalizedFilePath

3838

3939data GetFilesOfInterest = GetFilesOfInterest

4040 deriving (Eq, Show, Typeable, Generic)

@@ -46,7 +46,7 @@ instance Binary GetFilesOfInterest

4646-- | The rule that initialises the files of interest state.

4747ofInterestRules :: Rules ()

4848ofInterestRules = do

49− addIdeGlobal . OfInterestVar =<< liftIO (newVar Set.empty)

49+ addIdeGlobal . OfInterestVar =<< liftIO (newVar HashSet.empty)

5050 defineEarlyCutoff $ \GetFilesOfInterest _file -> assert (null $ fromNormalizedFilePath _file) $ do

5151 alwaysRerun

5252 filesOfInterest <- getFilesOfInterestUntracked

@@ -54,7 +54,7 @@ ofInterestRules = do

5454

5555

5656-- | Get the files that are open in the IDE.

57−getFilesOfInterest :: Action (Set NormalizedFilePath)

57+getFilesOfInterest :: Action (HashSet NormalizedFilePath)

5858getFilesOfInterest = useNoFile_ GetFilesOfInterest

5959

6060

@@ -64,19 +64,19 @@ getFilesOfInterest = useNoFile_ GetFilesOfInterest

6464

6565-- | Set the files-of-interest - not usually necessary or advisable.

6666-- The LSP client will keep this information up to date.

67−setFilesOfInterest :: IdeState -> Set NormalizedFilePath -> IO ()

67+setFilesOfInterest :: IdeState -> HashSet NormalizedFilePath -> IO ()

6868setFilesOfInterest state files = modifyFilesOfInterest state (const files)

6969

70−getFilesOfInterestUntracked :: Action (Set NormalizedFilePath)

70+getFilesOfInterestUntracked :: Action (HashSet NormalizedFilePath)

7171getFilesOfInterestUntracked = do

7272 OfInterestVar var <- getIdeGlobalAction

7373 liftIO $ readVar var

7474

7575-- | Modify the files-of-interest - not usually necessary or advisable.

7676-- 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 ()

7878modifyFilesOfInterest state f = do

7979 OfInterestVar var <- getIdeGlobalState state

8080 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)

8282 void $ shakeRun state []

src/Development/IDE/Core/Shake.hs+22−24

@@ -49,7 +49,6 @@ import Development.Shake.Classes

4949import Development.Shake.Rule

5050import qualified Data.HashMap.Strict as HMap

5151import qualified Data.Map.Strict as Map

52−import qualified Data.Map.Merge.Strict as Map

5352import qualified Data.ByteString.Char8 as BS

5453import Data.Dynamic

5554import Data.Maybe

@@ -95,13 +94,13 @@ data ShakeExtras = ShakeExtras

9594 ,state :: Var Values

9695 ,diagnostics :: Var DiagnosticStore

9796 ,hiddenDiagnostics :: Var DiagnosticStore

98− ,publishedDiagnostics :: Var (Map NormalizedUri [Diagnostic])

97+ ,publishedDiagnostics :: Var (HMap.HashMap NormalizedUri [Diagnostic])

9998 -- ^ This represents the set of diagnostics that we have published.

10099 -- 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))

102101 -- ^ Map from a text document version to a PositionMapping that describes how to map

103102 -- 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)

105104 -- ^ How many rules are running for each file

106105 }

107106

@@ -200,14 +199,14 @@ valueVersion = \case

200199 Failed -> Nothing

201200

202201mappingForVersion

203− :: Map NormalizedUri (Map TextDocumentVersion PositionMapping)

202+ :: HMap.HashMap NormalizedUri (Map TextDocumentVersion PositionMapping)

204203 -> NormalizedFilePath

205204 -> TextDocumentVersion

206205 -> PositionMapping

207206mappingForVersion allMappings file ver =

208207 fromMaybe idMapping $

209208 Map.lookup ver =<<

210− Map.lookup (filePathToUri' file) allMappings

209+ HMap.lookup (filePathToUri' file) allMappings

211210

212211type IdeRule k v =

213212 ( Shake.RuleResult k ~ v

@@ -301,14 +300,14 @@ shakeOpen :: IO LSP.LspId

301300 -> Rules ()

302301 -> IO IdeState

303302shakeOpen getLspId eventer logger debouncer shakeProfileDir (IdeReportProgress reportProgress) opts rules = do

304− inProgress <- newVar Map.empty

303+ inProgress <- newVar HMap.empty

305304 shakeExtras <- do

306305 globals <- newVar HMap.empty

307306 state <- newVar HMap.empty

308307 diagnostics <- newVar mempty

309308 hiddenDiagnostics <- newVar mempty

310309 publishedDiagnostics <- newVar mempty

311− positionMapping <- newVar Map.empty

310+ positionMapping <- newVar HMap.empty

312311 pure ShakeExtras{..}

313312 (shakeDb, shakeClose) <-

314313 shakeOpenDatabase

@@ -323,7 +322,7 @@ shakeOpen getLspId eventer logger debouncer shakeProfileDir (IdeReportProgress r

323322 shakeDb <- shakeDb

324323 return IdeState{..}

325324

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 ()

327326lspShakeProgress getLspId sendMsg inProgress = do

328327 -- first sleep a bit, so we only show progress messages if it's going to take

329328 -- 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

356355 loop id prev = do

357356 sleep sample

358357 current <- readVar inProgress

359− let done = length $ filter (== 0) $ Map.elems current

360− let todo = Map.size current

358+ let done = length $ filter (== 0) $ HMap.elems current

359+ let todo = HMap.size current

361360 let next = Just $ T.pack $ show done <> "/" <> show todo

362361 when (next /= prev) $

363362 sendMsg $ LSP.NotWorkDoneProgressReport $ LSP.fmServerWorkDoneProgressReportNotification

@@ -452,9 +451,9 @@ garbageCollect keep = do

452451 return $! dupe values

453452 modifyVar_ diagnostics $ \diags -> return $! filterDiagnostics keep diags

454453 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

456455 let versionsForFile =

457− Map.fromListWith Set.union $

456+ HMap.fromListWith Set.union $

458457 mapMaybe (\((file, _key), v) -> (filePathToUri' file,) . Set.singleton <$> valueVersion v) $

459458 HMap.toList newState

460459 modifyVar_ positionMapping $ \mappings -> return $! filterVersionMap versionsForFile mappings

@@ -534,9 +533,9 @@ usesWithStale key files = do

534533 mapM (uncurry lastValue) (zip files values)

535534

536535

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

538537withProgress 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

540539

541540

542541defineEarlyCutoff

@@ -724,10 +723,10 @@ updateFileDiagnostics fp k ShakeExtras{diagnostics, hiddenDiagnostics, published

724723 let delay = if null newDiags then 0.1 else 0

725724 registerEvent debouncer delay uri $ do

726725 mask_ $ modifyVar_ publishedDiagnostics $ \published -> do

727− let lastPublish = Map.findWithDefault [] uri published

726+ let lastPublish = HMap.lookupDefault [] uri published

728727 when (lastPublish /= newDiags) $

729728 eventer $ publishDiagnosticsNotification (fromNormalizedUri uri) newDiags

730− pure $! Map.insert uri newDiags published

729+ pure $! HMap.insert uri newDiags published

731730

732731publishDiagnosticsNotification :: Uri -> [Diagnostic] -> LSP.FromServerMessage

733732publishDiagnosticsNotification uri diags =

@@ -818,19 +817,18 @@ filterDiagnostics keep =

818817 HMap.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath) $ uriToFilePath' $ fromNormalizedUri uri)

819818

820819filterVersionMap

821− :: Map NormalizedUri (Set.Set TextDocumentVersion)

822− -> Map NormalizedUri (Map TextDocumentVersion a)

823− -> Map NormalizedUri (Map TextDocumentVersion a)

820+ :: HMap.HashMap NormalizedUri (Set.Set TextDocumentVersion)

821+ -> HMap.HashMap NormalizedUri (Map TextDocumentVersion a)

822+ -> HMap.HashMap NormalizedUri (Map TextDocumentVersion a)

824823filterVersionMap =

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

827825

828826updatePositionMapping :: IdeState -> VersionedTextDocumentIdentifier -> List TextDocumentContentChangeEvent -> IO ()

829827updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} changes = do

830828 modifyVar_ positionMapping $ \allMappings -> do

831829 let uri = toNormalizedUri _uri

832− let mappingForUri = Map.findWithDefault Map.empty uri allMappings

830+ let mappingForUri = HMap.lookupDefault Map.empty uri allMappings

833831 let updatedMapping =

834832 Map.insert _version idMapping $

835833 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

2929import Development.IDE.GHC.Orphans()

3030import Data.Either

3131import Data.Graph

32+import Data.HashMap.Strict (HashMap)

33+import qualified Data.HashMap.Strict as HMS

3234import Data.List.NonEmpty (NonEmpty(..), nonEmpty)

3335import qualified Data.List.NonEmpty as NonEmpty

3436import Data.IntMap (IntMap)

@@ -36,8 +38,6 @@ import qualified Data.IntMap.Strict as IntMap

3638import qualified Data.IntMap.Lazy as IntMapLazy

3739import Data.IntSet (IntSet)

3840import qualified Data.IntSet as IntSet

39−import Data.Map (Map)

40−import qualified Data.Map.Strict as MS

4141import Data.Maybe

4242import Data.Set (Set)

4343import qualified Data.Set as Set

@@ -68,32 +68,32 @@ newtype FilePathId = FilePathId { getFilePathId :: Int }

6868

6969data PathIdMap = PathIdMap

7070 { idToPathMap :: !(IntMap NormalizedFilePath)

71− , pathToIdMap :: !(Map NormalizedFilePath FilePathId)

71+ , pathToIdMap :: !(HashMap NormalizedFilePath FilePathId)

7272 }

7373 deriving (Show, Generic)

7474

7575instance NFData PathIdMap

7676

7777emptyPathIdMap :: PathIdMap

78−emptyPathIdMap = PathIdMap IntMap.empty MS.empty

78+emptyPathIdMap = PathIdMap IntMap.empty HMS.empty

7979

8080getPathId :: NormalizedFilePath -> PathIdMap -> (FilePathId, PathIdMap)

8181getPathId path m@PathIdMap{..} =

82− case MS.lookup path pathToIdMap of

82+ case HMS.lookup path pathToIdMap of

8383 Nothing ->

84− let !newId = FilePathId $ MS.size pathToIdMap

84+ let !newId = FilePathId $ HMS.size pathToIdMap

8585 in (newId, insertPathId path newId m)

8686 Just id -> (id, m)

8787

8888insertPathId :: NormalizedFilePath -> FilePathId -> PathIdMap -> PathIdMap

8989insertPathId 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)

9191

9292insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation

9393insertImport (FilePathId k) v rawDepInfo = rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) }

9494

9595pathToId :: PathIdMap -> NormalizedFilePath -> FilePathId

96−pathToId PathIdMap{pathToIdMap} path = pathToIdMap MS.! path

96+pathToId PathIdMap{pathToIdMap} path = pathToIdMap HMS.! path

9797

9898idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath

9999idToPath PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id

src/Development/IDE/LSP/Notifications.hs+2−2

@@ -20,7 +20,7 @@ import Development.IDE.Types.Logger

2020import Control.Monad.Extra

2121import Data.Foldable as F

2222import Data.Maybe

23−import qualified Data.Set as S

23+import qualified Data.HashSet as S

2424import qualified Data.Text as Text

2525

2626import Development.IDE.Core.FileStore (setSomethingModified)

@@ -69,4 +69,4 @@ setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x

6969 logInfo (ideLogger ide) $ "Files created or deleted: " <> msg

7070 modifyFileExists ide events

7171 setSomethingModified ide

72− }

72+ }

stack84.yaml+1

@@ -19,6 +19,7 @@ extra-deps:

1919- regex-tdfa-1.3.1.0

2020- parser-combinators-1.2.1

2121- haddock-library-1.8.0

22+- unordered-containers-0.2.10.0

2223nix:

2324 packages: [zlib]

2425allow-newer: true