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.

Author: cocreature

exe/Main.hs

@@ -46,7 +46,7 @@ import System.Exit
 import Paths_ghcide
 import Development.GitRev
 import Development.Shake (Action, action)
-import qualified Data.Set as Set
+import qualified Data.HashSet as HashSet
 import qualified Data.Map.Strict as Map
 
 import GHC hiding (def)
@@ -142,7 +142,7 @@ main = do
         ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) noopDebouncer options vfs
 
         putStrLn "\nStep 6/6: Type checking the files"
-        setFilesOfInterest ide $ Set.fromList $ map toNormalizedFilePath files
+        setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath files
         results <- runActionSync ide $ uses TypeCheck $ map toNormalizedFilePath files
         let (worked, failed) = partition fst $ zip (map isJust results) files
         when (failed /= []) $
@@ -170,7 +170,7 @@ expandFiles = concatMapM $ \x -> do
 kick :: Action ()
 kick = do
     files <- getFilesOfInterest
-    void $ uses TypeCheck $ Set.toList files
+    void $ uses TypeCheck $ HashSet.toList files
 
 -- | Print an LSP event.
 showEvent :: Lock -> FromServerMessage -> IO ()

ghcide.cabal

@@ -60,7 +60,7 @@ library
         text,
         time,
         transformers,
-        unordered-containers,
+        unordered-containers >= 0.2.10.0,
         utf8-string,
         hslogger
     if flag(ghc-lib)
@@ -144,7 +144,7 @@ library
 executable ghcide-test-preprocessor
     default-language: Haskell2010
     hs-source-dirs: test/preprocessor
-    ghc-options: -Wall
+    ghc-options: -Wall -Wno-name-shadowing
     main-is: Main.hs
     build-depends:
         base == 4.*
@@ -181,7 +181,8 @@ executable ghcide
         ghcide,
         optparse-applicative,
         shake,
-        text
+        text,
+        unordered-containers
     other-modules:
         Arguments
         Paths_ghcide

src/Development/IDE/Core/FileExists.hs

@@ -14,8 +14,8 @@ import           Control.Monad.Extra
 import qualified Data.Aeson                    as A
 import           Data.Binary
 import qualified Data.ByteString               as BS
-import           Data.Map.Strict                ( Map )
-import qualified Data.Map.Strict               as Map
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
 import           Data.Maybe
 import qualified Data.Text                     as T
 import           Development.IDE.Core.FileStore
@@ -30,7 +30,7 @@ import           Language.Haskell.LSP.Types.Capabilities
 import qualified System.Directory as Dir
 
 -- | A map for tracking the file existence
-type FileExistsMap = (Map NormalizedFilePath Bool)
+type FileExistsMap = (HashMap NormalizedFilePath Bool)
 
 -- | A wrapper around a mutable 'FileExistsMap'
 newtype FileExistsMapVar = FileExistsMapVar (Var FileExistsMap)
@@ -53,12 +53,12 @@ modifyFileExistsAction f = do
 modifyFileExists :: IdeState -> [(NormalizedFilePath, Bool)] -> IO ()
 modifyFileExists state changes = do
   FileExistsMapVar var <- getIdeGlobalState state
-  changesMap           <- evaluate $ Map.fromList changes
+  changesMap           <- evaluate $ HashMap.fromList changes
 
   -- Masked to ensure that the previous values are flushed together with the map update
   mask $ \_ -> do
     -- update the map
-    modifyVar_ var $ evaluate . Map.union changesMap
+    modifyVar_ var $ evaluate . HashMap.union changesMap
     -- flush previous values
     mapM_ (deleteValue state GetFileExists . fst) changes
 
@@ -102,7 +102,7 @@ fileExistsRulesFast getLspId vfs = do
   addIdeGlobal . FileExistsMapVar =<< liftIO (newVar [])
   defineEarlyCutoff $ \GetFileExists file -> do
     fileExistsMap <- getFileExistsMapUntracked
-    let mbFilesWatched = Map.lookup file fileExistsMap
+    let mbFilesWatched = HashMap.lookup file fileExistsMap
     case mbFilesWatched of
       Just fv -> pure (summarizeExists fv, ([], Just fv))
       Nothing -> do
@@ -113,7 +113,7 @@ fileExistsRulesFast getLspId vfs = do
         -- taking the FileExistsMap lock to prevent race conditions
         -- that would lead to multiple listeners for the same path
         modifyFileExistsAction $ \x -> do
-          case Map.insertLookupWithKey (\_ x _ -> x) file exist x of
+          case HashMap.alterF (,Just exist) file x of
             (Nothing, x') -> do
             -- if the listener addition fails, we never recover. This is a bug.
               addListener eventer file

src/Development/IDE/Core/OfInterest.hs

@@ -19,8 +19,8 @@ import GHC.Generics
 import Data.Typeable
 import qualified Data.ByteString.UTF8 as BS
 import Control.Exception
-import Data.Set (Set)
-import qualified Data.Set as Set
+import Data.HashSet (HashSet)
+import qualified Data.HashSet as HashSet
 import qualified Data.Text as T
 import Data.Tuple.Extra
 import Data.Functor
@@ -31,10 +31,10 @@ import Development.IDE.Types.Logger
 import Development.IDE.Core.Shake
 
 
-newtype OfInterestVar = OfInterestVar (Var (Set NormalizedFilePath))
+newtype OfInterestVar = OfInterestVar (Var (HashSet NormalizedFilePath))
 instance IsIdeGlobal OfInterestVar
 
-type instance RuleResult GetFilesOfInterest = Set NormalizedFilePath
+type instance RuleResult GetFilesOfInterest = HashSet NormalizedFilePath
 
 data GetFilesOfInterest = GetFilesOfInterest
     deriving (Eq, Show, Typeable, Generic)
@@ -46,15 +46,15 @@ instance Binary   GetFilesOfInterest
 -- | The rule that initialises the files of interest state.
 ofInterestRules :: Rules ()
 ofInterestRules = do
-    addIdeGlobal . OfInterestVar =<< liftIO (newVar Set.empty)
+    addIdeGlobal . OfInterestVar =<< liftIO (newVar HashSet.empty)
     defineEarlyCutoff $ \GetFilesOfInterest _file -> assert (null $ fromNormalizedFilePath _file) $ do
         alwaysRerun
         filesOfInterest <- getFilesOfInterestUntracked
         pure (Just $ BS.fromString $ show filesOfInterest, ([], Just filesOfInterest))
 
 
 -- | Get the files that are open in the IDE.
-getFilesOfInterest :: Action (Set NormalizedFilePath)
+getFilesOfInterest :: Action (HashSet NormalizedFilePath)
 getFilesOfInterest = useNoFile_ GetFilesOfInterest
 
 
@@ -64,19 +64,19 @@ getFilesOfInterest = useNoFile_ GetFilesOfInterest
 
 -- | Set the files-of-interest - not usually necessary or advisable.
 --   The LSP client will keep this information up to date.
-setFilesOfInterest :: IdeState -> Set NormalizedFilePath -> IO ()
+setFilesOfInterest :: IdeState -> HashSet NormalizedFilePath -> IO ()
 setFilesOfInterest state files = modifyFilesOfInterest state (const files)
 
-getFilesOfInterestUntracked :: Action (Set NormalizedFilePath)
+getFilesOfInterestUntracked :: Action (HashSet NormalizedFilePath)
 getFilesOfInterestUntracked = do
     OfInterestVar var <- getIdeGlobalAction
     liftIO $ readVar var
 
 -- | Modify the files-of-interest - not usually necessary or advisable.
 --   The LSP client will keep this information up to date.
-modifyFilesOfInterest :: IdeState -> (Set NormalizedFilePath -> Set NormalizedFilePath) -> IO ()
+modifyFilesOfInterest :: IdeState -> (HashSet NormalizedFilePath -> HashSet NormalizedFilePath) -> IO ()
 modifyFilesOfInterest state f = do
     OfInterestVar var <- getIdeGlobalState state
     files <- modifyVar var $ pure . dupe . f
-    logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show $ Set.toList files)
+    logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show $ HashSet.toList files)
     void $ shakeRun state []

src/Development/IDE/Core/Shake.hs

@@ -49,7 +49,6 @@ import           Development.Shake.Classes
 import           Development.Shake.Rule
 import qualified Data.HashMap.Strict as HMap
 import qualified Data.Map.Strict as Map
-import qualified Data.Map.Merge.Strict as Map
 import qualified Data.ByteString.Char8 as BS
 import           Data.Dynamic
 import           Data.Maybe
@@ -95,13 +94,13 @@ data ShakeExtras = ShakeExtras
     ,state :: Var Values
     ,diagnostics :: Var DiagnosticStore
     ,hiddenDiagnostics :: Var DiagnosticStore
-    ,publishedDiagnostics :: Var (Map NormalizedUri [Diagnostic])
+    ,publishedDiagnostics :: Var (HMap.HashMap NormalizedUri [Diagnostic])
     -- ^ This represents the set of diagnostics that we have published.
     -- Due to debouncing not every change might get published.
-    ,positionMapping :: Var (Map NormalizedUri (Map TextDocumentVersion PositionMapping))
+    ,positionMapping :: Var (HMap.HashMap NormalizedUri (Map TextDocumentVersion PositionMapping))
     -- ^ Map from a text document version to a PositionMapping that describes how to map
     -- positions in a version of that document to positions in the latest version
-    ,inProgress :: Var (Map NormalizedFilePath Int)
+    ,inProgress :: Var (HMap.HashMap NormalizedFilePath Int)
     -- ^ How many rules are running for each file
     }
 
@@ -200,14 +199,14 @@ valueVersion = \case
     Failed -> Nothing
 
 mappingForVersion
-    :: Map NormalizedUri (Map TextDocumentVersion PositionMapping)
+    :: HMap.HashMap NormalizedUri (Map TextDocumentVersion PositionMapping)
     -> NormalizedFilePath
     -> TextDocumentVersion
     -> PositionMapping
 mappingForVersion allMappings file ver =
     fromMaybe idMapping $
     Map.lookup ver =<<
-    Map.lookup (filePathToUri' file) allMappings
+    HMap.lookup (filePathToUri' file) allMappings
 
 type IdeRule k v =
   ( Shake.RuleResult k ~ v
@@ -301,14 +300,14 @@ shakeOpen :: IO LSP.LspId
           -> Rules ()
           -> IO IdeState
 shakeOpen getLspId eventer logger debouncer shakeProfileDir (IdeReportProgress reportProgress) opts rules = do
-    inProgress <- newVar Map.empty
+    inProgress <- newVar HMap.empty
     shakeExtras <- do
         globals <- newVar HMap.empty
         state <- newVar HMap.empty
         diagnostics <- newVar mempty
         hiddenDiagnostics <- newVar mempty
         publishedDiagnostics <- newVar mempty
-        positionMapping <- newVar Map.empty
+        positionMapping <- newVar HMap.empty
         pure ShakeExtras{..}
     (shakeDb, shakeClose) <-
         shakeOpenDatabase
@@ -323,7 +322,7 @@ shakeOpen getLspId eventer logger debouncer shakeProfileDir (IdeReportProgress r
     shakeDb <- shakeDb
     return IdeState{..}
 
-lspShakeProgress :: Show a => IO LSP.LspId -> (LSP.FromServerMessage -> IO ()) -> Var (Map a Int) -> IO ()
+lspShakeProgress :: Hashable a => IO LSP.LspId -> (LSP.FromServerMessage -> IO ()) -> Var (HMap.HashMap a Int) -> IO ()
 lspShakeProgress getLspId sendMsg inProgress = do
     -- first sleep a bit, so we only show progress messages if it's going to take
     -- 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
         loop id prev = do
             sleep sample
             current <- readVar inProgress
-            let done = length $ filter (== 0) $ Map.elems current
-            let todo = Map.size current
+            let done = length $ filter (== 0) $ HMap.elems current
+            let todo = HMap.size current
             let next = Just $ T.pack $ show done <> "/" <> show todo
             when (next /= prev) $
                 sendMsg $ LSP.NotWorkDoneProgressReport $ LSP.fmServerWorkDoneProgressReportNotification
@@ -452,9 +451,9 @@ garbageCollect keep = do
                return $! dupe values
            modifyVar_ diagnostics $ \diags -> return $! filterDiagnostics keep diags
            modifyVar_ hiddenDiagnostics $ \hdiags -> return $! filterDiagnostics keep hdiags
-           modifyVar_ publishedDiagnostics $ \diags -> return $! Map.filterWithKey (\uri _ -> keep (fromUri uri)) diags
+           modifyVar_ publishedDiagnostics $ \diags -> return $! HMap.filterWithKey (\uri _ -> keep (fromUri uri)) diags
            let versionsForFile =
-                   Map.fromListWith Set.union $
+                   HMap.fromListWith Set.union $
                    mapMaybe (\((file, _key), v) -> (filePathToUri' file,) . Set.singleton <$> valueVersion v) $
                    HMap.toList newState
            modifyVar_ positionMapping $ \mappings -> return $! filterVersionMap versionsForFile mappings
@@ -534,9 +533,9 @@ usesWithStale key files = do
     mapM (uncurry lastValue) (zip files values)
 
 
-withProgress :: Ord a => Var (Map a Int) -> a -> Action b -> Action b
+withProgress :: (Eq a, Hashable a) => Var (HMap.HashMap a Int) -> a -> Action b -> Action b
 withProgress var file = actionBracket (f succ) (const $ f pred) . const
-    where f shift = modifyVar_ var $ return . Map.alter (Just . shift . fromMaybe 0) file
+    where f shift = modifyVar_ var $ return . HMap.alter (Just . shift . fromMaybe 0) file
 
 
 defineEarlyCutoff
@@ -724,10 +723,10 @@ updateFileDiagnostics fp k ShakeExtras{diagnostics, hiddenDiagnostics, published
         let delay = if null newDiags then 0.1 else 0
         registerEvent debouncer delay uri $ do
              mask_ $ modifyVar_ publishedDiagnostics $ \published -> do
-                 let lastPublish = Map.findWithDefault [] uri published
+                 let lastPublish = HMap.lookupDefault [] uri published
                  when (lastPublish /= newDiags) $
                      eventer $ publishDiagnosticsNotification (fromNormalizedUri uri) newDiags
-                 pure $! Map.insert uri newDiags published
+                 pure $! HMap.insert uri newDiags published
 
 publishDiagnosticsNotification :: Uri -> [Diagnostic] -> LSP.FromServerMessage
 publishDiagnosticsNotification uri diags =
@@ -818,19 +817,18 @@ filterDiagnostics keep =
     HMap.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath) $ uriToFilePath' $ fromNormalizedUri uri)
 
 filterVersionMap
-    :: Map NormalizedUri (Set.Set TextDocumentVersion)
-    -> Map NormalizedUri (Map TextDocumentVersion a)
-    -> Map NormalizedUri (Map TextDocumentVersion a)
+    :: HMap.HashMap NormalizedUri (Set.Set TextDocumentVersion)
+    -> HMap.HashMap NormalizedUri (Map TextDocumentVersion a)
+    -> HMap.HashMap NormalizedUri (Map TextDocumentVersion a)
 filterVersionMap =
-    Map.merge Map.dropMissing Map.dropMissing $
-    Map.zipWithMatched $ \_ versionsToKeep versionMap -> Map.restrictKeys versionMap versionsToKeep
+    HMap.intersectionWith $ \versionsToKeep versionMap -> Map.restrictKeys versionMap versionsToKeep
 
 updatePositionMapping :: IdeState -> VersionedTextDocumentIdentifier -> List TextDocumentContentChangeEvent -> IO ()
 updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} changes = do
     modifyVar_ positionMapping $ \allMappings -> do
         let uri = toNormalizedUri _uri
-        let mappingForUri = Map.findWithDefault Map.empty uri allMappings
+        let mappingForUri = HMap.lookupDefault Map.empty uri allMappings
         let updatedMapping =
                 Map.insert _version idMapping $
                 Map.map (\oldMapping -> foldl' applyChange oldMapping changes) mappingForUri
-        pure $! Map.insert uri updatedMapping allMappings
+        pure $! HMap.insert uri updatedMapping allMappings

src/Development/IDE/Import/DependencyInformation.hs

@@ -29,15 +29,15 @@ import Data.List
 import Development.IDE.GHC.Orphans()
 import Data.Either
 import Data.Graph
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HMS
 import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.IntMap (IntMap)
 import qualified Data.IntMap.Strict as IntMap
 import qualified Data.IntMap.Lazy as IntMapLazy
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as IntSet
-import Data.Map (Map)
-import qualified Data.Map.Strict as MS
 import Data.Maybe
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -68,32 +68,32 @@ newtype FilePathId = FilePathId { getFilePathId :: Int }
 
 data PathIdMap = PathIdMap
   { idToPathMap :: !(IntMap NormalizedFilePath)
-  , pathToIdMap :: !(Map NormalizedFilePath FilePathId)
+  , pathToIdMap :: !(HashMap NormalizedFilePath FilePathId)
   }
   deriving (Show, Generic)
 
 instance NFData PathIdMap
 
 emptyPathIdMap :: PathIdMap
-emptyPathIdMap = PathIdMap IntMap.empty MS.empty
+emptyPathIdMap = PathIdMap IntMap.empty HMS.empty
 
 getPathId :: NormalizedFilePath -> PathIdMap -> (FilePathId, PathIdMap)
 getPathId path m@PathIdMap{..} =
-    case MS.lookup path pathToIdMap of
+    case HMS.lookup path pathToIdMap of
         Nothing ->
-            let !newId = FilePathId $ MS.size pathToIdMap
+            let !newId = FilePathId $ HMS.size pathToIdMap
             in (newId, insertPathId path newId m)
         Just id -> (id, m)
 
 insertPathId :: NormalizedFilePath -> FilePathId -> PathIdMap -> PathIdMap
 insertPathId path id PathIdMap{..} =
-    PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (MS.insert path id pathToIdMap)
+    PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (HMS.insert path id pathToIdMap)
 
 insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation
 insertImport (FilePathId k) v rawDepInfo = rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) }
 
 pathToId :: PathIdMap -> NormalizedFilePath -> FilePathId
-pathToId PathIdMap{pathToIdMap} path = pathToIdMap MS.! path
+pathToId PathIdMap{pathToIdMap} path = pathToIdMap HMS.! path
 
 idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath
 idToPath PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id

src/Development/IDE/LSP/Notifications.hs

@@ -20,7 +20,7 @@ import           Development.IDE.Types.Logger
 import           Control.Monad.Extra
 import           Data.Foldable                    as F
 import           Data.Maybe
-import qualified Data.Set                         as S
+import qualified Data.HashSet                     as S
 import qualified Data.Text                        as Text
 
 import           Development.IDE.Core.FileStore   (setSomethingModified)
@@ -69,4 +69,4 @@ setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x
             logInfo (ideLogger ide) $ "Files created or deleted: " <> msg
             modifyFileExists ide events
             setSomethingModified ide
-    }
+    }

stack84.yaml

@@ -19,6 +19,7 @@ extra-deps:
 - regex-tdfa-1.3.1.0
 - parser-combinators-1.2.1
 - haddock-library-1.8.0
+- unordered-containers-0.2.10.0
 nix:
   packages: [zlib]
 allow-newer: true