Skip to content

Commit

Permalink
Avoid duplicating known targets and import paths (#1590)
Browse files Browse the repository at this point in the history
  • Loading branch information
pepeiborra committed Mar 18, 2021
1 parent 3f2ea7c commit 982c4ee
Show file tree
Hide file tree
Showing 3 changed files with 11 additions and 8 deletions.
5 changes: 3 additions & 2 deletions ghcide/session-loader/Development/IDE/Session.hs
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
10 changes: 6 additions & 4 deletions ghcide/src/Development/IDE/Types/HscEnvEq.hs
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down
4 changes: 2 additions & 2 deletions ghcide/src/Development/IDE/Types/KnownTargets.hs
Expand Up @@ -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

0 comments on commit 982c4ee

Please sign in to comment.