@@ -585,21 +585,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
585585 let new_cache = newComponentCache recorder optExtensions hieYaml _cfp hscEnv
586586 all_target_details <- new_cache old_deps new_deps
587587
588- this_dep_info <- getDependencyInfo $ maybeToList hieYaml
589- let (all_targets, this_flags_map, this_options)
590- = case HM. lookup _cfp flags_map' of
591- Just this -> (all_targets', flags_map', this)
592- Nothing -> (this_target_details : all_targets', HM. insert _cfp this_flags flags_map', this_flags)
593- where all_targets' = concat all_target_details
594- flags_map' = HM. fromList (concatMap toFlagsMap all_targets')
595- this_target_details = TargetDetails (TargetFile _cfp) this_error_env this_dep_info [_cfp]
596- this_flags = (this_error_env, this_dep_info)
597- this_error_env = ([this_error], Nothing )
598- this_error = ideErrorWithSource (Just " cradle" Just DiagnosticSeverity_Error ) _cfp
599- $ T. unlines
600- [ " No cradle target found. Is this file listed in the targets of your cradle?"
601- , " If you are using a .cabal file, please ensure that this module is listed in either the exposed-modules or other-modules section"
602- ]
588+ let all_targets = concatMap fst all_target_details
589+
590+ let this_flags_map = HM. fromList (concatMap toFlagsMap all_targets)
603591
604592 void $ modifyVar' fileToFlags $
605593 Map. insert hieYaml this_flags_map
@@ -627,7 +615,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
627615 let ! exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces
628616 liftIO $ atomically $ modifyTVar' (exportsMap shakeExtras) (exportsMap' <> )
629617
630- return $ second Map. keys this_options
618+ return $ second Map. keys $ this_flags_map HM. ! _cfp
631619
632620 let consultCradle :: Maybe FilePath -> FilePath -> IO IdeResult HscEnvEq , [FilePath
633621 consultCradle hieYaml cfp = do
@@ -647,17 +635,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
647635 -- Display a user friendly progress message here: They probably don't know what a cradle is
648636 let progMsg = " Setting up " <> T. pack (takeBaseName (cradleRootDir cradle))
649637 <> " (for " <> T. pack lfp <> " )"
650- mRunLspT lspEnv $ sendNotification (SMethod_CustomMethod (Proxy @ " ghcide/cradle/eopts/before"
651638 eopts <- mRunLspTCallback lspEnv (\ act -> withIndefiniteProgress progMsg Nothing NotCancellable (const act)) $
652639 withTrace " Load cradle" $ \ addTag -> do
653640 addTag " file"
654641 old_files <- readIORef cradle_files
655642 res <- cradleToOptsAndLibDir recorder cradle cfp old_files
656643 addTag " result" show res)
657644 return res
658- mRunLspT lspEnv $ sendNotification ( SMethod_CustomMethod ( Proxy @ " ghcide/cradle/eopts/after " )) (toJSON cfp)
645+
659646 logWith recorder Debug $ LogSessionLoadingResult eopts
660- mRunLspT lspEnv $ sendNotification (SMethod_CustomMethod (Proxy @ " ghcide/cradle/eopts/afterLog" show $ pretty (LogSessionLoadingResult eopts)))
661647 case eopts of
662648 -- The cradle gave us some options so get to work turning them
663649 -- into and HscEnv.
@@ -824,7 +810,7 @@ newComponentCache
824810 -> HscEnv -- ^ An empty HscEnv
825811 -> [ComponentInfo ] -- ^ New components to be loaded
826812 -> [ComponentInfo ] -- ^ old, already existing components
827- -> IO TargetDetails ] ]
813+ -> IO ( [TargetDetails ], ( IdeResult HscEnvEq , DependencyInfo )) ]
828814newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do
829815 let cis = Map. unionWith unionCIs (mkMap new_cis) (mkMap old_cis)
830816 -- When we have multiple components with the same uid,
@@ -896,13 +882,14 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do
896882 henv <- createHscEnvEq thisEnv (zip uids dfs)
897883 let targetEnv = (if isBad ci then multi_errs else [] , Just henv)
898884 targetDepends = componentDependencyInfo ci
899- logWith recorder Debug $ LogNewComponentCache (targetEnv, targetDepends)
885+ res = ( targetEnv, targetDepends)
886+ logWith recorder Debug $ LogNewComponentCache res
900887 evaluate $ liftRnf rwhnf $ componentTargets ci
901888
902889 let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends
903890 ctargets <- concatMapM mk (componentTargets ci)
904891
905- return (L. nubOrdOn targetTarget ctargets)
892+ return (L. nubOrdOn targetTarget ctargets, res )
906893
907894{- Note [Avoiding bad interface files]
908895~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1094,20 +1081,15 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
10941081 -- A special target for the file which caused this wonderful
10951082 -- component to be created. In case the cradle doesn't list all the targets for
10961083 -- the component, in which case things will be horribly broken anyway.
1097- --
1098- -- When we have a single component that is caused to be loaded due to a
1099- -- file, we assume the file is part of that component. This is useful
1100- -- for bare GHC sessions, such as many of the ones used in the testsuite
1084+ -- Otherwise, we will immediately attempt to reload this module which
1085+ -- causes an infinite loop and high CPU usage.
11011086 --
11021087 -- We don't do this when we have multiple components, because each
11031088 -- component better list all targets or there will be anarchy.
11041089 -- It is difficult to know which component to add our file to in
11051090 -- that case.
11061091 -- Multi unit arguments are likely to come from cabal, which
11071092 -- does list all targets.
1108- --
1109- -- If we don't end up with a target for the current file in the end, then
1110- -- we will report it as an error for that file
11111093 abs_fp <- liftIO $ makeAbsolute (fromNormalizedFilePath cfp)
11121094 let special_target = Compat. mkSimpleTarget df abs_fp
11131095 pure $ (df, special_target : targets) :| []
0 commit comments