From 982c4ee684bf2d0be38a8709433b69110a10a91c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 18 Mar 2021 15:30:31 +0000 Subject: [PATCH] Avoid duplicating known targets and import paths (#1590) --- ghcide/session-loader/Development/IDE/Session.hs | 5 +++-- ghcide/src/Development/IDE/Types/HscEnvEq.hs | 10 ++++++---- ghcide/src/Development/IDE/Types/KnownTargets.hs | 4 ++-- 3 files changed, 11 insertions(+), 8 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 9f023bb947..0b9386ec70 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -83,6 +83,7 @@ import Packages import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TQueue +import qualified Data.HashSet as Set import Database.SQLite.Simple import HIE.Bios.Cradle (yamlConfig) import HieDb.Create @@ -247,10 +248,10 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do found <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations return (targetTarget, found) modifyVarIO' knownTargetsVar $ traverseHashed $ \known -> do - let known' = HM.unionWith (<>) known $ HM.fromList knownTargets + let known' = HM.unionWith (<>) known $ HM.fromList $ map (second Set.fromList) knownTargets when (known /= known') $ logDebug logger $ "Known files updated: " <> - T.pack(show $ (HM.map . map) fromNormalizedFilePath known') + T.pack(show $ (HM.map . Set.map) fromNormalizedFilePath known') pure known' -- Create a new HscEnv from a hieYaml root and a set of options diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index 2395fc08e6..38338f4b49 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -18,6 +18,8 @@ import Control.Exception (evaluate, mask, throwIO) import Control.Monad.Extra (eitherM, join, mapMaybeM) import Control.Monad.IO.Class import Data.Either (fromRight) +import Data.Set (Set) +import qualified Data.Set as Set import Data.Unique import Development.IDE.GHC.Compat import Development.IDE.GHC.Error (catchSrcErrors) @@ -48,7 +50,7 @@ data HscEnvEq = HscEnvEq -- ^ In memory components for this HscEnv -- This is only used at the moment for the import dirs in -- the DynFlags - , envImportPaths :: Maybe [String] + , envImportPaths :: Maybe (Set FilePath) -- ^ If Just, import dirs originally configured in this env -- If Nothing, the env import dirs are unaltered , envPackageExports :: IO ExportsMap @@ -69,9 +71,9 @@ newHscEnvEq cradlePath hscEnv0 deps = do importPathsCanon <- mapM canonicalizePath $ relativeToCradle <$> importPaths (hsc_dflags hscEnv0) - newHscEnvEqWithImportPaths (Just importPathsCanon) hscEnv deps + newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) hscEnv deps -newHscEnvEqWithImportPaths :: Maybe [String] -> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq +newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do let dflags = hsc_dflags hscEnv @@ -121,7 +123,7 @@ newHscEnvEqPreserveImportPaths = newHscEnvEqWithImportPaths Nothing hscEnvWithImportPaths :: HscEnvEq -> HscEnv hscEnvWithImportPaths HscEnvEq{..} | Just imps <- envImportPaths - = hscEnv{hsc_dflags = (hsc_dflags hscEnv){importPaths = imps}} + = hscEnv{hsc_dflags = (hsc_dflags hscEnv){importPaths = Set.toList imps}} | otherwise = hscEnv diff --git a/ghcide/src/Development/IDE/Types/KnownTargets.hs b/ghcide/src/Development/IDE/Types/KnownTargets.hs index 86cc887260..7ec2e493a5 100644 --- a/ghcide/src/Development/IDE/Types/KnownTargets.hs +++ b/ghcide/src/Development/IDE/Types/KnownTargets.hs @@ -14,11 +14,11 @@ import Development.IDE.Types.Location import GHC.Generics -- | A mapping of module name to known files -type KnownTargets = HashMap Target [NormalizedFilePath] +type KnownTargets = HashMap Target (HashSet NormalizedFilePath) data Target = TargetModule ModuleName | TargetFile NormalizedFilePath deriving ( Eq, Generic, Show ) deriving anyclass (Hashable, NFData) toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath -toKnownFiles = HSet.fromList . concat . HMap.elems +toKnownFiles = HSet.unions . HMap.elems