Skip to content

Commit

Permalink
rename
Browse files Browse the repository at this point in the history
  • Loading branch information
soulomoon committed Oct 25, 2024
1 parent 84384d1 commit 51e80b1
Showing 1 changed file with 3 additions and 76 deletions.
79 changes: 3 additions & 76 deletions ghcide/session-loader/Development/IDE/Session.hs
Original file line number Diff line number Diff line change
Expand Up @@ -520,7 +520,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
packageSetup (hieYaml, cfps, opts, libDir) = do
-- Parse DynFlags for the newly discovered component
hscEnv <- emptyHscEnv ideNc libDir
newTargetDfs <- evalGhcEnv hscEnv $ setOptions' cfps opts (hsc_dflags hscEnv) rootDir
newTargetDfs <- evalGhcEnv hscEnv $ setOptions cfps opts (hsc_dflags hscEnv) rootDir
let deps = componentDependencies opts ++ maybeToList hieYaml
dep_info <- getDependencyInfo deps
-- Now lookup to see whether we are combining with an existing HscEnv
Expand Down Expand Up @@ -1184,13 +1184,13 @@ addUnit unit_str = liftEwM $ do
putCmdLineState (unit_str : units)

-- | Throws if package flags are unsatisfiable
setOptions' :: GhcMonad m
setOptions :: GhcMonad m
=> [NormalizedFilePath]
-> ComponentOptions
-> DynFlags
-> FilePath -- ^ root dir, see Note [Root Directory]
-> m (NonEmpty (DynFlags, [GHC.Target]))
setOptions' cfps (ComponentOptions theOpts compRoot _) dflags rootDir = do
setOptions cfps (ComponentOptions theOpts compRoot _) dflags rootDir = do
((theOpts',_errs,_warns),units) <- processCmdLineP unit_flags [] (map noLoc theOpts)
case NE.nonEmpty units of
Just us -> initMulti us
Expand Down Expand Up @@ -1257,79 +1257,6 @@ setOptions' cfps (ComponentOptions theOpts compRoot _) dflags rootDir = do
dflags''
return (dflags''', targets)

-- | Throws if package flags are unsatisfiable
setOptions :: GhcMonad m
=> NormalizedFilePath
-> ComponentOptions
-> DynFlags
-> FilePath -- ^ root dir, see Note [Root Directory]
-> m (NonEmpty (DynFlags, [GHC.Target]))
setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do
((theOpts',_errs,_warns),units) <- processCmdLineP unit_flags [] (map noLoc theOpts)
case NE.nonEmpty units of
Just us -> initMulti us
Nothing -> do
(df, targets) <- initOne (map unLoc theOpts')
-- 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.
--
-- When we have a singleComponent 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.
-- It is difficult to know which component to add our file to in
-- 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
let abs_fp = toAbsolute rootDir (fromNormalizedFilePath cfp)
let special_target = Compat.mkSimpleTarget df abs_fp
pure $ (df, special_target : targets) :| []
where
initMulti unitArgFiles =
forM unitArgFiles $ \f -> do
args <- liftIO $ expandResponse [f]
initOne args
initOne this_opts = do
(dflags', targets') <- addCmdOpts this_opts dflags
let dflags'' =
case unitIdString (homeUnitId_ dflags') of
-- cabal uses main for the unit id of all executable packages
-- This makes multi-component sessions confused about what
-- options to use for that component.
-- Solution: hash the options and use that as part of the unit id
-- This works because there won't be any dependencies on the
-- executable unit.
"main" ->
let hash = B.unpack $ B16.encode $ H.finalize $ H.updates H.init (map B.pack this_opts)
hashed_uid = Compat.toUnitId (Compat.stringToUnit ("main-"++hash))
in setHomeUnitId_ hashed_uid dflags'
_ -> dflags'

let targets = makeTargetsAbsolute root targets'
root = case workingDirectory dflags'' of
Nothing -> compRoot
Just wdir -> compRoot </> wdir
let dflags''' =
setWorkingDirectory root $
disableWarningsAsErrors $
-- disabled, generated directly by ghcide instead
flip gopt_unset Opt_WriteInterface $
-- disabled, generated directly by ghcide instead
-- also, it can confuse the interface stale check
dontWriteHieFiles $
setIgnoreInterfacePragmas $
setBytecodeLinkerOptions $
disableOptimisation $
Compat.setUpTypedHoles $
makeDynFlagsAbsolute compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory
dflags''
return (dflags''', targets)

setIgnoreInterfacePragmas :: DynFlags -> DynFlags
setIgnoreInterfacePragmas df =
Expand Down

0 comments on commit 51e80b1

Please sign in to comment.