diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 48af221f9b..e6d1a6696b 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -585,9 +585,21 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do let new_cache = newComponentCache recorder optExtensions hieYaml _cfp hscEnv all_target_details <- new_cache old_deps new_deps - let all_targets = concatMap fst all_target_details - - let this_flags_map = HM.fromList (concatMap toFlagsMap all_targets) + this_dep_info <- getDependencyInfo $ maybeToList hieYaml + let (all_targets, this_flags_map, this_options) + = case HM.lookup _cfp flags_map' of + Just this -> (all_targets', flags_map', this) + Nothing -> (this_target_details : all_targets', HM.insert _cfp this_flags flags_map', this_flags) + where all_targets' = concat all_target_details + flags_map' = HM.fromList (concatMap toFlagsMap all_targets') + this_target_details = TargetDetails (TargetFile _cfp) this_error_env this_dep_info [_cfp] + this_flags = (this_error_env, this_dep_info) + this_error_env = ([this_error], Nothing) + this_error = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) _cfp + $ T.unlines + [ "No cradle target found. Is this file listed in the targets of your cradle?" + , "If you are using a .cabal file, please ensure that this module is listed in either the exposed-modules or other-modules section" + ] void $ modifyVar' fileToFlags $ Map.insert hieYaml this_flags_map @@ -615,7 +627,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces liftIO $ atomically $ modifyTVar' (exportsMap shakeExtras) (exportsMap' <>) - return $ second Map.keys $ this_flags_map HM.! _cfp + return $ second Map.keys this_options let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath]) consultCradle hieYaml cfp = do @@ -810,7 +822,7 @@ newComponentCache -> HscEnv -- ^ An empty HscEnv -> [ComponentInfo] -- ^ New components to be loaded -> [ComponentInfo] -- ^ old, already existing components - -> IO [ ([TargetDetails], (IdeResult HscEnvEq, DependencyInfo))] + -> IO [ [TargetDetails] ] newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do let cis = Map.unionWith unionCIs (mkMap new_cis) (mkMap old_cis) -- When we have multiple components with the same uid, @@ -882,14 +894,13 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do henv <- createHscEnvEq thisEnv (zip uids dfs) let targetEnv = (if isBad ci then multi_errs else [], Just henv) targetDepends = componentDependencyInfo ci - res = ( targetEnv, targetDepends) - logWith recorder Debug $ LogNewComponentCache res + logWith recorder Debug $ LogNewComponentCache (targetEnv, targetDepends) evaluate $ liftRnf rwhnf $ componentTargets ci let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends ctargets <- concatMapM mk (componentTargets ci) - return (L.nubOrdOn targetTarget ctargets, res) + return (L.nubOrdOn targetTarget ctargets) {- Note [Avoiding bad interface files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1081,8 +1092,10 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do -- A special target for the file which caused this wonderful -- component to be created. In case the cradle doesn't list all the targets for -- the component, in which case things will be horribly broken anyway. - -- Otherwise, we will immediately attempt to reload this module which - -- causes an infinite loop and high CPU usage. + -- + -- When we have a single component that is caused to be loaded due to a + -- file, we assume the file is part of that component. This is useful + -- for bare GHC sessions, such as many of the ones used in the testsuite -- -- We don't do this when we have multiple components, because each -- component better list all targets or there will be anarchy. @@ -1090,6 +1103,9 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do -- that case. -- Multi unit arguments are likely to come from cabal, which -- does list all targets. + -- + -- If we don't end up with a target for the current file in the end, then + -- we will report it as an error for that file abs_fp <- liftIO $ makeAbsolute (fromNormalizedFilePath cfp) let special_target = Compat.mkSimpleTarget df abs_fp pure $ (df, special_target : targets) :| []