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.

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

Merged
merged 3 commits into from
Jul 22, 2025
Merged
Changes from all commits
Commits
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
Original file line number Diff line number Diff line change
@@ -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 < 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 < 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-"]]
@@ -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"
]
17 changes: 14 additions & 3 deletions ghcide/session-loader/Development/IDE/Session.hs
Original file line number Diff line number Diff line change
@@ -452,6 +452,7 @@
IdeOptions{ optTesting = IdeTesting optTesting
, optCheckProject = getCheckProject
, optExtensions
, optHaddockParse
} <- getIdeOptions

-- populate the knownTargetsVar with all the
@@ -496,7 +497,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
@@ -628,7 +629,7 @@
[] -> error $ "GHC version could not be parsed: " <> version
((runTime, _):_)
| compileTime == runTime -> do
atomicModifyIORef' cradle_files (\xs -> (cfp:xs,()))

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

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
@@ -895,7 +896,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 899 in ghcide/session-loader/Development/IDE/Session.hs

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
@@ -1110,12 +1111,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
@@ -1179,6 +1181,7 @@
dontWriteHieFiles $
setIgnoreInterfacePragmas $
setBytecodeLinkerOptions $
enableOptHaddock haddockOpt $
disableOptimisation $
Compat.setUpTypedHoles $
makeDynFlagsAbsolute compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory
@@ -1192,6 +1195,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
14 changes: 6 additions & 8 deletions ghcide/src/Development/IDE/Core/Rules.hs
Original file line number Diff line number Diff line change
@@ -260,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}
@@ -284,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' }
@@ -802,7 +800,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 803 in ghcide/src/Development/IDE/Core/Rules.hs

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 = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f
, regenerate = regenerateHiFile session f ms
}
@@ -972,8 +970,8 @@
hsc <- setFileCacheHook (hscEnv sess)
opt <- getIdeOptions

-- Embed haddocks in the interface file
(diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f (withOptHaddock ms)
-- By default, we parse with `-haddock` unless 'OptHaddockParse' is overwritten.
(diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f ms
case mb_pm of
Nothing -> return (diags, Nothing)
Just pm -> do
10 changes: 6 additions & 4 deletions ghcide/src/Development/IDE/Types/Options.hs
Original file line number Diff line number Diff line change
@@ -68,10 +68,12 @@ data IdeOptions = IdeOptions
, optCheckParents :: IO CheckParents
-- ^ 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.
-- ^ Whether to parse modules with '-haddock' by default.
-- If 'HaddockParse' is given, we parse local haskell modules with the
-- '-haddock' flag enables.
-- If a plugin requires the parsed sources *without* '-haddock', it needs
-- to use rules that explicitly disable the '-haddock' flag.
-- See call sites of 'withoutOptHaddock' for rules that parse without '-haddock'.
, optModifyDynFlags :: Config -> DynFlagsModifications
-- ^ Will be called right after setting up a new cradle,
-- allowing to customize the Ghc options used

Unchanged files with check annotations Beta

Just fileDiags -> do
pure $ Just $ filter diagRangeOverlaps fileDiags
where
diagRangeOverlaps = \fileDiag ->

Check warning on line 219 in ghcide/src/Development/IDE/Core/PluginUtils.hs

GitHub Actions / Hlint check run

Warning in activeDiagnosticsInRangeMT in module Development.IDE.Core.PluginUtils: Redundant lambda ▫︎ Found: "diagRangeOverlaps\n = \\ fileDiag\n -> rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)" ▫︎ Perhaps: "diagRangeOverlaps fileDiag\n = rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)"
rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)
-- | Just like 'activeDiagnosticsInRangeMT'. See the docs of 'activeDiagnosticsInRangeMT' for details.
import Data.Time (UTCTime (..))
import Data.Tuple.Extra (dupe)
import Debug.Trace
import Development.IDE.Core.FileStore (resetInterfaceStore)

Check warning on line 73 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run

Warning in module Development.IDE.Core.Compile: Use fewer imports ▫︎ Found: "import Development.IDE.Core.FileStore ( resetInterfaceStore )\nimport Development.IDE.Core.FileStore ( shareFilePath )\n" ▫︎ Perhaps: "import Development.IDE.Core.FileStore\n ( resetInterfaceStore, shareFilePath )\n"
import Development.IDE.Core.Preprocessor
import Development.IDE.Core.ProgressReporting (progressUpdate)
import Development.IDE.Core.RuleTypes
tcs = tcg_tcs ts :: [TyCon]
hie_asts = GHC.enrichHie all_binds (tmrRenamed tcm) top_ev_binds insts tcs
pure $ Just $

Check warning on line 826 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run

Suggestion in generateHieAsts in module Development.IDE.Core.Compile: Redundant $ ▫︎ Found: "Just $ hie_asts" ▫︎ Perhaps: "Just hie_asts"
#if MIN_VERSION_ghc(9,11,0)
hie_asts (tcg_type_env ts)
#else
convImport (L _ i) = (
(ideclPkgQual i)

Check warning on line 1106 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run

Suggestion in getModSummaryFromImports in module Development.IDE.Core.Compile: Redundant bracket ▫︎ Found: "((ideclPkgQual i), reLoc $ ideclName i)" ▫︎ Perhaps: "(ideclPkgQual i, reLoc $ ideclName i)"
, reLoc $ ideclName i)
msrImports = implicit_imports ++ imps
{-# LANGUAGE DeriveAnyClass #-}

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

GitHub Actions / Hlint check run

Warning in module Development.IDE.Session.Diagnostics: Use module export list ▫︎ Found: "module Development.IDE.Session.Diagnostics where" ▫︎ Perhaps: "module Development.IDE.Session.Diagnostics (\n module Development.IDE.Session.Diagnostics\n ) where" ▫︎ Note: an explicit list is usually better
module Development.IDE.Session.Diagnostics where
import Control.Applicative
surround start s end = do
guard (listToMaybe s == Just start)
guard (listToMaybe (reverse s) == Just end)
pure $ drop 1 $ take (length s - 1) s

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

GitHub Actions / Hlint check run

Warning in parseMultiCradleErr in module Development.IDE.Session.Diagnostics: Use drop1 ▫︎ Found: "drop 1" ▫︎ Perhaps: "drop1"
multiCradleErrMessage :: MultiCradleErr -> [String]
multiCradleErrMessage e =
{-# LANGUAGE CPP #-}

Check warning on line 1 in exe/Wrapper.hs

GitHub Actions / Hlint check run

Warning in module Main: Use module export list ▫︎ Found: "module Main where" ▫︎ Perhaps: "module Main (\n module Main\n ) where" ▫︎ Note: an explicit list is usually better
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}