Avoid unnecessary recompilation due to -haddock (#4596)

* Avoid unnecessary recompilation due to -haddock

Due to unprincipled adding and removing the `-haddock` flag during
compilation and recompilation checking, we were performing more work
than necessary.
We avoid this by compiling everything with `-haddock` by default. This
is safe nowadays, we have essentially been doing this for many releases,
and know this is fine.
For the occasion where we actually want to parse without the `-haddock`
flag, we keep explicitly disabling it.

We enable `-haddock` flag during session loading, since we already
perform a number of DynFlags tweaks.
This behaviour is dependent on the `OptHaddockParse` opton, which can,
currently, only be modified at compile-time.

* Fix windows test failure

---------

Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>

Author: fendor

ghcide-test/exe/FindDefinitionAndHoverTests.hs

@@ -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"
   ]

ghcide/session-loader/Development/IDE/Session.hs

@@ -452,6 +452,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
     IdeOptions{ optTesting = IdeTesting optTesting
               , optCheckProject = getCheckProject
               , optExtensions
+              , optHaddockParse
               } <- getIdeOptions
 
         -- populate the knownTargetsVar with all the
@@ -496,7 +497,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
         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
@@ -1110,12 +1111,13 @@ addUnit unit_str = liftEwM $ do
 
 -- | 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 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do
               dontWriteHieFiles $
               setIgnoreInterfacePragmas $
               setBytecodeLinkerOptions $
+              enableOptHaddock haddockOpt $
               disableOptimisation $
               Compat.setUpTypedHoles $
               makeDynFlagsAbsolute compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory
@@ -1192,6 +1195,14 @@ setIgnoreInterfacePragmas df =
 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

ghcide/src/Development/IDE/Core/Rules.hs

@@ -260,12 +260,10 @@ getParsedModuleRule recorder =
     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 @@ getParsedModuleWithCommentsRule recorder =
     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' }
@@ -972,8 +970,8 @@ regenerateHiFile sess f ms compNeeded = do
     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

ghcide/src/Development/IDE/Types/Options.hs

@@ -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