Skip to content

Avoid unnecessary recompilation due to -haddock #4596

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Avoid unnecessary recompilation due to -haddock #4596

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
d9b168a
Avoid unnecessary recompilation due to -haddock
fendor May 20, 2025
2606976
Fix windows test failure
fendor May 23, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 4 additions & 3 deletions ghcide-test/exe/FindDefinitionAndHoverTests.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -187,7 +187,8 @@ tests = let
holeL65 = Position 65 8 ; hleInfo2 = [ExpectHoverText ["_ :: a -> Maybe a"]]
cccL17 = Position 17 16 ; docLink = [ExpectHoverTextRegex "\\*Defined in 'GHC.Types'\\* \\*\\(ghc-prim-[0-9.]+\\)\\*\n\n"]
imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3]
reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], if ghcVersion >= GHC94 && ghcVersion < GHC910 then mkL bar 3 5 3 8 else mkL bar 3 0 3 14]
reexported = Position 55 14
reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], if ghcVersion >= GHC94 && ghcVersion < GHC910 || not isWindows then mkL bar 3 5 3 8 else mkL bar 3 0 3 14]
thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]]
cmtL68 = Position 67 0 ; lackOfdEq = [ExpectHoverExcludeText ["$dEq"]]
import310 = Position 3 10; pkgTxt = [ExpectHoverText ["Data.Text\n\ntext-"]]
Expand Down Expand Up @@ -237,9 +238,9 @@ tests = let
, testM yes yes imported importedSig "Imported symbol"
, if isWindows then
-- Flaky on Windows: https://github.com/haskell/haskell-language-server/issues/2997
testM no yes reexported reexportedSig "Imported symbol (reexported)"
testM no yes reexported reexportedSig "Imported symbol reexported"
else
testM yes yes reexported reexportedSig "Imported symbol (reexported)"
testM yes yes reexported reexportedSig "Imported symbol reexported"
, test no yes thLocL57 thLoc "TH Splice Hover"
, test yes yes import310 pkgTxt "show package name and its version"
]
Expand Down
17 changes: 14 additions & 3 deletions ghcide/session-loader/Development/IDE/Session.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -451,6 +451,7 @@
IdeOptions{ optTesting = IdeTesting optTesting
, optCheckProject = getCheckProject
, optExtensions
, optHaddockParse
} <- getIdeOptions

-- populate the knownTargetsVar with all the
Expand Down Expand Up @@ -495,7 +496,7 @@
packageSetup (hieYaml, cfp, opts, libDir) = do
-- Parse DynFlags for the newly discovered component
hscEnv <- emptyHscEnv ideNc libDir
newTargetDfs <- evalGhcEnv hscEnv $ setOptions cfp opts (hsc_dflags hscEnv) rootDir
newTargetDfs <- evalGhcEnv hscEnv $ setOptions optHaddockParse cfp 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 @@ -627,7 +628,7 @@
[] -> error $ "GHC version could not be parsed: " <> version
((runTime, _):_)
| compileTime == runTime -> do
atomicModifyIORef' cradle_files (\xs -> (cfp:xs,()))

Check warning on line 631 in ghcide/session-loader/Development/IDE/Session.hs

View workflow job for this annotation

GitHub Actions / Hlint check run 

Warning in loadSessionWithOptions in module Development.IDE.Session: Use atomicModifyIORef'_ ▫︎ Found: "atomicModifyIORef' cradle_files (\\ xs -> (cfp : xs, ()))" ▫︎ Perhaps: "atomicModifyIORef'_ cradle_files ((:) cfp)"
session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
| otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[])
-- Failure case, either a cradle error or the none cradle
Expand Down Expand Up @@ -898,7 +899,7 @@
x <- map errMsgDiagnostic closure_errs
DriverHomePackagesNotClosed us <- pure x
pure us
isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units

Check warning on line 902 in ghcide/session-loader/Development/IDE/Session.hs

View workflow job for this annotation

GitHub Actions / Hlint check run 

Suggestion in newComponentCache in module Development.IDE.Session: Redundant bracket ▫︎ Found: "(homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units" ▫︎ Perhaps: "homeUnitId_ (componentDynFlags ci) `OS.member` bad_units"
-- Whenever we spin up a session on Linux, dynamically load libm.so.6
-- in. We need this in case the binary is statically linked, in which
-- case the interactive session will fail when trying to load
Expand Down Expand Up @@ -1111,12 +1112,13 @@

-- | Throws if package flags are unsatisfiable
setOptions :: GhcMonad m
=> NormalizedFilePath
=> OptHaddockParse
-> NormalizedFilePath
-> ComponentOptions
-> DynFlags
-> FilePath -- ^ root dir, see Note [Root Directory]
-> m (NonEmpty (DynFlags, [GHC.Target]))
setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do
setOptions haddockOpt 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
Expand Down Expand Up @@ -1177,6 +1179,7 @@
dontWriteHieFiles $
setIgnoreInterfacePragmas $
setBytecodeLinkerOptions $
enableOptHaddock haddockOpt $
disableOptimisation $
Compat.setUpTypedHoles $
makeDynFlagsAbsolute compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory
Expand All @@ -1190,6 +1193,14 @@
disableOptimisation :: DynFlags -> DynFlags
disableOptimisation df = updOptLevel 0 df

-- | We always compile with '-haddock' unless explicitly disabled.
--
-- This avoids inconsistencies when doing recompilation checking which was
-- observed in https://github.com/haskell/haskell-language-server/issues/4511
enableOptHaddock :: OptHaddockParse -> DynFlags -> DynFlags
enableOptHaddock HaddockParse d = gopt_set d Opt_Haddock
enableOptHaddock NoHaddockParse d = d

setHiDir :: FilePath -> DynFlags -> DynFlags
setHiDir f d =
-- override user settings to avoid conflicts leading to recompilation
Expand Down
14 changes: 5 additions & 9 deletions ghcide/src/Development/IDE/Core/Rules.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -174,8 +174,6 @@
import qualified Data.IntMap as IM
import GHC.Fingerprint

import GHC.Driver.Env (hsc_all_home_unit_ids)

data Log
= LogShake Shake.Log
| LogReindexingHieFile !NormalizedFilePath
Expand Down Expand Up @@ -262,12 +260,10 @@
let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' }
reset_ms pm = pm { pm_mod_summary = ms' }

-- We still parse with Haddocks whether Opt_Haddock is True or False to collect information
-- but we no longer need to parse with and without Haddocks separately for above GHC90.
liftIO $ (fmap.fmap.fmap) reset_ms $ getParsedModuleDefinition hsc opt file (withOptHaddock ms)
liftIO $ (fmap.fmap.fmap) reset_ms $ getParsedModuleDefinition hsc opt file ms

withOptHaddock :: ModSummary -> ModSummary
withOptHaddock = withOption Opt_Haddock
withoutOptHaddock :: ModSummary -> ModSummary
withoutOptHaddock = withoutOption Opt_Haddock

withOption :: GeneralFlag -> ModSummary -> ModSummary
withOption opt ms = ms{ms_hspp_opts= gopt_set (ms_hspp_opts ms) opt}
Expand All @@ -286,7 +282,7 @@
ModSummaryResult{msrModSummary = ms, msrHscEnv = hsc} <- use_ GetModSummary file
opt <- getIdeOptions

let ms' = withoutOption Opt_Haddock $ withOption Opt_KeepRawTokenStream ms
let ms' = withoutOptHaddock $ withOption Opt_KeepRawTokenStream ms
modify_dflags <- getModifyDynFlags dynFlagsModifyParser
let ms'' = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' }
reset_ms pm = pm { pm_mod_summary = ms' }
Expand Down Expand Up @@ -800,7 +796,7 @@
{ source_version = ver
, old_value = m_old
, get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
, get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs

Check warning on line 799 in ghcide/src/Development/IDE/Core/Rules.hs

View workflow job for this annotation

GitHub Actions / Hlint check run 

Suggestion in getModIfaceFromDiskRule in module Development.IDE.Core.Rules: Use fmap ▫︎ Found: "\\ fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs" ▫︎ Perhaps: "fmap (map (snd . fromJust . hirCoreFp)) . uses_ GetModIface"
, get_module_graph = useNoFile_ GetModuleGraph
, regenerate = regenerateHiFile session f ms
}
Expand Down Expand Up @@ -971,7 +967,7 @@
opt <- getIdeOptions

-- Embed haddocks in the interface file
(diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f (withOptHaddock ms)
(diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f ms
case mb_pm of
Nothing -> return (diags, Nothing)
Just pm -> do
Expand Down Expand Up @@ -1093,7 +1089,7 @@
-- thus bump its modification time, forcing this rule to be rerun every time.
exists <- liftIO $ doesFileExist obj_file
mobj_time <- liftIO $
if exists

Check warning on line 1092 in ghcide/src/Development/IDE/Core/Rules.hs

View workflow job for this annotation

GitHub Actions / Hlint check run 

Warning in getLinkableRule in module Development.IDE.Core.Rules: Use whenMaybe ▫︎ Found: "if exists then Just <$> getModTime obj_file else pure Nothing" ▫︎ Perhaps: "whenMaybe exists (getModTime obj_file)"
then Just <$> getModTime obj_file
else pure Nothing
case mobj_time of
Expand Down
4 changes: 1 addition & 3 deletions ghcide/src/Development/IDE/Types/Options.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -69,9 +69,7 @@ data IdeOptions = IdeOptions
-- ^ When to typecheck reverse dependencies of a file
, optHaddockParse :: OptHaddockParse
-- ^ Whether to return result of parsing module with Opt_Haddock.
-- Otherwise, return the result of parsing without Opt_Haddock, so
-- that the parsed module contains the result of Opt_KeepRawTokenStream,
-- which might be necessary for hlint.
-- Otherwise, return the result of parsing without Opt_Haddock.
, optModifyDynFlags :: Config -> DynFlagsModifications
-- ^ Will be called right after setting up a new cradle,
-- allowing to customize the Ghc options used
Expand Down
Loading