ghcide 2.11.0.0 → 2.12.0.0

raw patch · 36 files changed

+661/−717 lines, 36 filesdep −hie-compatdep ~Diffdep ~hie-biosdep ~hiedbPVP ok

version bump matches the API change (PVP)

Dependencies removed: hie-compat

Dependency ranges changed: Diff, hie-bios, hiedb, hls-graph, hls-plugin-api

API changes (from Hackage documentation)

Files

• ghcide.cabal +7/−8
• session-loader/Development/IDE/Session.hs +24/−11
• src/Development/IDE/Core/Actions.hs +2/−1
• src/Development/IDE/Core/Compile.hs +98/−92
• src/Development/IDE/Core/FileStore.hs +30/−3
• src/Development/IDE/Core/OfInterest.hs +0/−1
• src/Development/IDE/Core/RuleTypes.hs +40/−2
• src/Development/IDE/Core/Rules.hs +48/−26
• src/Development/IDE/Core/Shake.hs +19/−0
• src/Development/IDE/GHC/CPP.hs +6/−15
• src/Development/IDE/GHC/Compat.hs +16/−71
• src/Development/IDE/GHC/Compat/Core.hs +1/−68
• src/Development/IDE/GHC/Compat/Driver.hs +0/−13
• src/Development/IDE/GHC/Compat/Env.hs +0/−8
• src/Development/IDE/GHC/Compat/Error.hs +74/−3
• src/Development/IDE/GHC/Compat/Iface.hs +1/−1
• src/Development/IDE/GHC/Compat/Logger.hs +1/−3
• src/Development/IDE/GHC/Compat/Outputable.hs +11/−24
• src/Development/IDE/GHC/Compat/Parser.hs +0/−4
• src/Development/IDE/GHC/CoreFile.hs +4/−153
• src/Development/IDE/GHC/Error.hs +0/−6
• src/Development/IDE/GHC/Orphans.hs +2/−41
• src/Development/IDE/GHC/Util.hs +64/−3
• src/Development/IDE/Import/DependencyInformation.hs +69/−10
• src/Development/IDE/Import/FindImports.hs +2/−14
• src/Development/IDE/LSP/LanguageServer.hs +33/−18
• src/Development/IDE/Main.hs +8/−9
• src/Development/IDE/Plugin/Completions.hs +4/−9
• src/Development/IDE/Plugin/Completions/Logic.hs +8/−37
• src/Development/IDE/Plugin/TypeLenses.hs +23/−10
• src/Development/IDE/Spans/AtPoint.hs +20/−3
• src/Development/IDE/Spans/Common.hs +7/−9
• src/Development/IDE/Spans/Documentation.hs +17/−9
• src/Development/IDE/Spans/LocalBindings.hs +6/−5
• src/Development/IDE/Types/Diagnostics.hs +10/−23
• src/Development/IDE/Types/Options.hs +6/−4

@@ -2,7 +2,7 @@ build-type:         Simple category:           Development name:               ghcide-version:            2.11.0.0+version:            2.12.0.0 license:            Apache-2.0 license-file:       LICENSE author:             Digital Asset and Ghcide contributors@@ -14,7 +14,7 @@   https://github.com/haskell/haskell-language-server/tree/master/ghcide#readme  bug-reports:        https://github.com/haskell/haskell-language-server/issues-tested-with:        GHC ==9.10.1 || ==9.8.2 || ==9.6.5 || ==9.4.8+tested-with:        GHC == {9.12.2, 9.10.1, 9.8.4, 9.6.7} extra-source-files:   CHANGELOG.md   README.md@@ -57,7 +57,7 @@     , deepseq     , dependent-map     , dependent-sum-    , Diff                         ^>=0.5+    , Diff                         ^>=0.5 || ^>=1.0.0     , directory     , dlist     , enummapset@@ -73,11 +73,10 @@     , Glob     , haddock-library              >=1.8      && <1.12     , hashable-    , hie-bios                     ^>=0.15.0-    , hie-compat                   ^>=0.3.0.0-    , hiedb                        ^>= 0.6.0.2-    , hls-graph                    == 2.11.0.0-    , hls-plugin-api               == 2.11.0.0+    , hie-bios                     ^>=0.17.0+    , hiedb                        ^>= 0.7.0.0+    , hls-graph                    == 2.12.0.0+    , hls-plugin-api               == 2.12.0.0     , implicit-hie                 >= 0.1.4.0 && < 0.1.5     , lens     , lens-aeson

@@ -67,6 +67,7 @@ import           Development.IDE.Types.Options import           GHC.ResponseFile import qualified HIE.Bios                            as HieBios+import qualified HIE.Bios.Cradle.Utils               as HieBios import           HIE.Bios.Environment                hiding (getCacheDir) import           HIE.Bios.Types                      hiding (Log) import qualified HIE.Bios.Types                      as HieBios@@ -223,7 +224,7 @@  -- | Bump this version number when making changes to the format of the data stored in hiedb hiedbDataVersion :: String-hiedbDataVersion = "1"+hiedbDataVersion = "2"  data CacheDirs = CacheDirs   { hiCacheDir, hieCacheDir, oCacheDir :: Maybe FilePath}@@ -451,6 +452,7 @@     IdeOptions{ optTesting = IdeTesting optTesting               , optCheckProject = getCheckProject               , optExtensions+              , optHaddockParse               } <- getIdeOptions          -- populate the knownTargetsVar with all the@@ -495,9 +497,9 @@         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+          dep_info <- getDependencyInfo (fmap toAbsolutePath deps)           -- Now lookup to see whether we are combining with an existing HscEnv           -- or making a new one. The lookup returns the HscEnv and a list of           -- information about other components loaded into the HscEnv@@ -798,7 +800,7 @@ -- Moved back to implementation in GHC. checkHomeUnitsClosed' ::  UnitEnv -> OS.Set UnitId -> [DriverMessages] checkHomeUnitsClosed' ue _ = checkHomeUnitsClosed ue-#elif MIN_VERSION_ghc(9,3,0)+#else -- This function checks the important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -- GHC had an implementation of this function, but it was horribly inefficient@@ -888,11 +890,7 @@             ideErrorWithSource                 (Just "cradle") (Just DiagnosticSeverity_Warning) _cfp                 (T.pack (Compat.printWithoutUniques (singleMessage err)))-#if MIN_VERSION_ghc(9,5,0)                 (Just (fmap GhcDriverMessage err))-#else-                Nothing-#endif         multi_errs = map closure_err_to_multi_err closure_errs         bad_units = OS.fromList $ concat $ do             x <- map errMsgDiagnostic closure_errs@@ -960,6 +958,8 @@   expectJust, called at compiler\\typecheck\\FamInst.hs:461:30 in ghc:FamInst ``` +and many more.+ To mitigate this, we set the cache directory for each component dependent on the components of the current `HscEnv`, additionally to the component options of the respective components.@@ -1111,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@@ -1146,7 +1147,10 @@       initMulti unitArgFiles =         forM unitArgFiles $ \f -> do           args <- liftIO $ expandResponse [f]-          initOne args+          -- The reponse files may contain arguments like "+RTS",+          -- and hie-bios doesn't expand the response files of @-unit@ arguments.+          -- Thus, we need to do the stripping here.+          initOne $ HieBios.removeRTS $ HieBios.removeVerbosityOpts args       initOne this_opts = do         (dflags', targets') <- addCmdOpts this_opts dflags         let dflags'' =@@ -1177,6 +1181,7 @@               dontWriteHieFiles $               setIgnoreInterfacePragmas $               setBytecodeLinkerOptions $+              enableOptHaddock haddockOpt $               disableOptimisation $               Compat.setUpTypedHoles $               makeDynFlagsAbsolute compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory@@ -1189,6 +1194,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 =

@@ -28,6 +28,7 @@ import qualified Development.IDE.Spans.AtPoint        as AtPoint import           Development.IDE.Types.HscEnvEq       (hscEnv) import           Development.IDE.Types.Location+import           GHC.Iface.Ext.Types                  (Identifier) import qualified HieDb import           Language.LSP.Protocol.Types          (DocumentHighlight (..),                                                        SymbolInformation (..),@@ -62,7 +63,7 @@    (hf, mapping) <- useWithStaleFastMT GetHieAst file   env <- hscEnv . fst <$> useWithStaleFastMT GhcSession file-  dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)+  dkMap <- lift $ maybe (DKMap mempty mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)    !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)   MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos'

@@ -39,79 +39,78 @@   , setNonHomeFCHook   ) where -import           Control.Concurrent.STM.Stats           hiding (orElse)-import           Control.DeepSeq                        (NFData (..), force,-                                                         rnf)-import           Control.Exception                      (evaluate)+import           Control.Concurrent.STM.Stats                 hiding (orElse)+import           Control.DeepSeq                              (NFData (..),+                                                               force, rnf)+import           Control.Exception                            (evaluate) import           Control.Exception.Safe-import           Control.Lens                           hiding (List, pre,-                                                         (<.>))+import           Control.Lens                                 hiding (List, pre,+                                                               (<.>)) import           Control.Monad.Extra import           Control.Monad.IO.Class import           Control.Monad.Trans.Except-import qualified Control.Monad.Trans.State.Strict       as S-import           Data.Aeson                             (toJSON)-import           Data.Bifunctor                         (first, second)+import qualified Control.Monad.Trans.State.Strict             as S+import           Data.Aeson                                   (toJSON)+import           Data.Bifunctor                               (first, second) import           Data.Binary-import qualified Data.ByteString                        as BS+import qualified Data.ByteString                              as BS import           Data.Coerce-import qualified Data.DList                             as DL+import qualified Data.DList                                   as DL import           Data.Functor import           Data.Generics.Aliases import           Data.Generics.Schemes-import qualified Data.HashMap.Strict                    as HashMap-import           Data.IntMap                            (IntMap)+import qualified Data.HashMap.Strict                          as HashMap+import           Data.IntMap                                  (IntMap) import           Data.IORef import           Data.List.Extra-import qualified Data.List.NonEmpty                     as NE-import qualified Data.Map.Strict                        as Map+import qualified Data.Map.Strict                              as Map import           Data.Maybe-import           Data.Proxy                             (Proxy (Proxy))-import qualified Data.Text                              as T-import           Data.Time                              (UTCTime (..), getCurrentTime)-import           Data.Tuple.Extra                       (dupe)+import           Data.Proxy                                   (Proxy (Proxy))+import qualified Data.Text                                    as T+import           Data.Time                                    (UTCTime (..))+import           Data.Tuple.Extra                             (dupe) import           Debug.Trace-import           Development.IDE.Core.FileStore         (resetInterfaceStore)+import           Development.IDE.Core.FileStore               (resetInterfaceStore) import           Development.IDE.Core.Preprocessor-import           Development.IDE.Core.ProgressReporting (progressUpdate)+import           Development.IDE.Core.ProgressReporting       (progressUpdate) import           Development.IDE.Core.RuleTypes import           Development.IDE.Core.Shake-import           Development.IDE.Core.Tracing           (withTrace)-import           Development.IDE.GHC.Compat             hiding (assert,-                                                         loadInterface,-                                                         parseHeader,-                                                         parseModule,-                                                         tcRnModule,-                                                         writeHieFile)-import qualified Development.IDE.GHC.Compat             as Compat-import qualified Development.IDE.GHC.Compat             as GHC-import qualified Development.IDE.GHC.Compat.Util        as Util+import           Development.IDE.Core.Tracing                 (withTrace)+import qualified Development.IDE.GHC.Compat                   as Compat+import qualified Development.IDE.GHC.Compat                   as GHC+import           Development.IDE.GHC.Compat.Driver            (hscTypecheckRenameWithDiagnostics)+import qualified Development.IDE.GHC.Compat.Util              as Util import           Development.IDE.GHC.CoreFile import           Development.IDE.GHC.Error-import           Development.IDE.GHC.Orphans            ()+import           Development.IDE.GHC.Orphans                  () import           Development.IDE.GHC.Util import           Development.IDE.GHC.Warnings+import           Development.IDE.Import.DependencyInformation import           Development.IDE.Types.Diagnostics import           Development.IDE.Types.Location import           Development.IDE.Types.Options-import           GHC                                    (ForeignHValue,-                                                         GetDocsFailure (..),-                                                         parsedSource, ModLocation (..))-import qualified GHC.LanguageExtensions                 as LangExt+import           GHC                                          (ForeignHValue,+                                                               GetDocsFailure (..),+                                                               ModLocation (..),+                                                               parsedSource)+import qualified GHC.LanguageExtensions                       as LangExt import           GHC.Serialized-import           HieDb                                  hiding (withHieDb)-import qualified Language.LSP.Protocol.Message          as LSP-import           Language.LSP.Protocol.Types            (DiagnosticTag (..))-import qualified Language.LSP.Server                    as LSP-import           Prelude                                hiding (mod)+import           HieDb                                        hiding (withHieDb)+import qualified Language.LSP.Protocol.Message                as LSP+import           Language.LSP.Protocol.Types                  (DiagnosticTag (..))+import qualified Language.LSP.Server                          as LSP+import           Prelude                                      hiding (mod) import           System.Directory import           System.FilePath-import           System.IO.Extra                        (fixIO,-                                                         newTempFileWithin)+import           System.IO.Extra                              (fixIO,+                                                               newTempFileWithin) -import qualified Data.Set                               as Set-import qualified GHC                                    as G-import qualified GHC.Runtime.Loader                as Loader+import qualified Data.Set                                     as Set+import qualified GHC                                          as G+import           GHC.Core.Lint.Interactive+import           GHC.Driver.Config.CoreToStg.Prep+import           GHC.Iface.Ext.Types                          (HieASTs)+import qualified GHC.Runtime.Loader                           as Loader import           GHC.Tc.Gen.Splice import           GHC.Types.Error import           GHC.Types.ForeignStubs@@ -120,25 +119,40 @@  -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] --#if MIN_VERSION_ghc(9,5,0)-import           GHC.Core.Lint.Interactive-import           GHC.Driver.Config.CoreToStg.Prep-#endif- #if MIN_VERSION_ghc(9,7,0)-import           Data.Foldable                          (toList)+import           Data.Foldable                                (toList) import           GHC.Unit.Module.Warnings #else-import           Development.IDE.Core.FileStore         (shareFilePath)+import           Development.IDE.Core.FileStore               (shareFilePath) #endif -import           Development.IDE.GHC.Compat.Driver (hscTypecheckRenameWithDiagnostics)+#if MIN_VERSION_ghc(9,10,0)+import           Development.IDE.GHC.Compat                   hiding (assert,+                                                               loadInterface,+                                                               parseHeader,+                                                               parseModule,+                                                               tcRnModule,+                                                               writeHieFile)+#else+import           Development.IDE.GHC.Compat                   hiding+                                                              (loadInterface,+                                                               parseHeader,+                                                               parseModule,+                                                               tcRnModule,+                                                               writeHieFile)+#endif -import Development.IDE.Import.DependencyInformation-import GHC.Driver.Env ( hsc_all_home_unit_ids )-import Development.IDE.Import.FindImports+#if MIN_VERSION_ghc(9,11,0)+import qualified Data.List.NonEmpty                           as NE+import           Data.Time                                    (getCurrentTime)+import           GHC.Driver.Env                               (hsc_all_home_unit_ids)+import           GHC.Iface.Ext.Types                          (NameEntityInfo)+#endif +#if MIN_VERSION_ghc(9,12,0)+import           Development.IDE.Import.FindImports+#endif+ --Simple constants to make sure the source is consistently named sourceTypecheck :: T.Text sourceTypecheck = "typecheck"@@ -176,7 +190,7 @@  data TypecheckHelpers   = TypecheckHelpers-  { getLinkables       :: [NormalizedFilePath] -> IO [LinkableResult] -- ^ hls-graph action to get linkables for files+  { getLinkables   :: [NormalizedFilePath] -> IO [LinkableResult] -- ^ hls-graph action to get linkables for files   , getModuleGraph :: IO DependencyInformation   } @@ -470,9 +484,7 @@         pure (details, guts)    let !partial_iface = force $ mkPartialIface session-#if MIN_VERSION_ghc(9,5,0)                                               (cg_binds guts)-#endif                                               details                                               ms #if MIN_VERSION_ghc(9,11,0)@@ -481,9 +493,7 @@                                               simplified_guts    final_iface' <- mkFullIface session partial_iface Nothing-#if MIN_VERSION_ghc(9,4,2)                     Nothing-#endif #if MIN_VERSION_ghc(9,11,0)                     NoStubs [] #endif@@ -524,17 +534,9 @@           mod = ms_mod ms           data_tycons = filter isDataTyCon tycons       CgGuts{cg_binds = unprep_binds'} <- coreFileToCgGuts session final_iface details core--#if MIN_VERSION_ghc(9,5,0)       cp_cfg <- initCorePrepConfig session-#endif-       let corePrep = corePrepPgm-#if MIN_VERSION_ghc(9,5,0)                        (hsc_logger session) cp_cfg (initCorePrepPgmConfig (hsc_dflags session) (interactiveInScope $ hsc_IC session))-#else-                       session-#endif                        mod (ms_location ms)        -- Run corePrep first as we want to test the final version of the program that will@@ -647,11 +649,7 @@                               (Just dot_o)                             $ hsc_dflags env'                           session' = hscSetFlags newFlags session-#if MIN_VERSION_ghc(9,4,2)                       (outputFilename, _mStub, _foreign_files, _cinfos, _stgcinfos) <- hscGenHardCode session' guts-#else-                      (outputFilename, _mStub, _foreign_files, _cinfos) <- hscGenHardCode session' guts-#endif                                 (ms_location summary)                                 fp                       obj <- compileFile session' driverNoStop (outputFilename, Just (As False))@@ -673,22 +671,31 @@ generateByteCode (CoreFileTime time) hscEnv summary guts = do     fmap (either (, Nothing) (second Just)) $           catchSrcErrors (hsc_dflags hscEnv) "bytecode" $ do+ #if MIN_VERSION_ghc(9,11,0)               (warnings, (_, bytecode)) <-+                withWarnings "bytecode" $ \_tweak -> do+                      let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv)+                          -- TODO: maybe settings ms_hspp_opts is unnecessary?+                          summary' = summary { ms_hspp_opts = hsc_dflags session }+                      hscInteractive session (mkCgInteractiveGuts guts)+                                (ms_location summary') #else               (warnings, (_, bytecode, sptEntries)) <--#endif                 withWarnings "bytecode" $ \_tweak -> do                       let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv)                           -- TODO: maybe settings ms_hspp_opts is unnecessary?                           summary' = summary { ms_hspp_opts = hsc_dflags session }                       hscInteractive session (mkCgInteractiveGuts guts)                                 (ms_location summary')+#endif+ #if MIN_VERSION_ghc(9,11,0)               let linkable = Linkable time (ms_mod summary) (pure $ BCOs bytecode) #else               let linkable = LM time (ms_mod summary) [BCOs bytecode sptEntries] #endif+               pure (map snd warnings, linkable)  demoteTypeErrorsToWarnings :: ParsedModule -> ParsedModule@@ -821,7 +828,7 @@     pure $ Just $ #if MIN_VERSION_ghc(9,11,0)       hie_asts (tcg_type_env ts)-#elif MIN_VERSION_ghc(9,3,0)+#else       hie_asts #endif   where@@ -966,12 +973,12 @@           )     ] - -- Merge the HPTs, module graphs and FinderCaches -- See Note [GhcSessionDeps] in Development.IDE.Core.Rules -- Add the current ModSummary to the graph, along with the -- HomeModInfo's of all direct dependencies (by induction hypothesis all -- transitive dependencies will be contained in envs)+#if MIN_VERSION_ghc(9,11,0) mergeEnvs :: HscEnv           -> ModuleGraph           -> DependencyInformation@@ -980,7 +987,6 @@           -> [HscEnv]           -> IO HscEnv mergeEnvs env mg dep_info ms extraMods envs = do-#if MIN_VERSION_ghc(9,11,0)     return $! loadModulesHome extraMods $       let newHug = foldl' mergeHUG (hsc_HUG env) (map hsc_HUG envs) in       (hscUpdateHUG (const newHug) env){@@ -1011,7 +1017,15 @@           | HsSrcFile <- mi_hsc_src (hm_iface a) = a           | otherwise = b -#elif MIN_VERSION_ghc(9,3,0)+#else+mergeEnvs :: HscEnv+          -> ModuleGraph+          -> DependencyInformation+          -> ModSummary+          -> [HomeModInfo]+          -> [HscEnv]+          -> IO HscEnv+mergeEnvs env mg _dep_info ms extraMods envs = do     let im  = Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms))         ifr = InstalledFound (ms_location ms) im         curFinderCache = Compat.extendInstalledModuleEnv Compat.emptyInstalledModuleEnv im ifr@@ -1173,11 +1187,7 @@        => DynFlags -- ^ flags to use        -> FilePath  -- ^ the filename (for source locations)        -> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported)-#if MIN_VERSION_ghc(9,5,0)        -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located (HsModule GhcPs))-#else-       -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located HsModule)-#endif parseHeader dflags filename contents = do    let loc  = mkRealSrcLoc (Util.mkFastString filename) 1 1    case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of@@ -1439,7 +1449,7 @@                    | not (mi_used_th iface) = emptyModuleEnv                    | otherwise = parseRuntimeDeps (md_anns details)              -- Peform the fine grained recompilation check for TH-             maybe_recomp <- checkLinkableDependencies session get_linkable_hashes get_module_graph runtime_deps+             maybe_recomp <- checkLinkableDependencies get_linkable_hashes get_module_graph runtime_deps              case maybe_recomp of                Just msg -> do_regenerate msg                Nothing@@ -1476,8 +1486,8 @@ -- the runtime dependencies of the module, to check if any of them are out of date -- Hopefully 'runtime_deps' will be empty if the module didn't actually use TH -- See Note [Recompilation avoidance in the presence of TH]-checkLinkableDependencies :: MonadIO m => HscEnv -> ([NormalizedFilePath] -> m [BS.ByteString]) -> m DependencyInformation -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired)-checkLinkableDependencies hsc_env get_linkable_hashes get_module_graph runtime_deps = do+checkLinkableDependencies :: MonadIO m => ([NormalizedFilePath] -> m [BS.ByteString]) -> m DependencyInformation -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired)+checkLinkableDependencies get_linkable_hashes get_module_graph runtime_deps = do   graph <- get_module_graph   let go (mod, hash) = (,hash) <$> lookupModuleFile mod graph       hs_files = mapM go (moduleEnvToList runtime_deps)@@ -1523,16 +1533,12 @@       -- Implicit binds aren't saved, so we need to regenerate them ourselves.   let _implicit_binds = concatMap getImplicitBinds tyCons -- only used if GHC < 9.6       tyCons = typeEnvTyCons (md_types details)-#if MIN_VERSION_ghc(9,5,0)   -- In GHC 9.6, the implicit binds are tidied and part of core_binds   pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty #if !MIN_VERSION_ghc(9,11,0)                 (emptyHpcInfo False) #endif                 Nothing []-#else-  pure $ CgGuts this_mod tyCons (_implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing []-#endif  coreFileToLinkable :: LinkableType -> HscEnv -> ModSummary -> ModIface -> ModDetails -> CoreFile -> UTCTime -> IO ([FileDiagnostic], Maybe HomeModInfo) coreFileToLinkable linkableType session ms iface details core_file t = do@@ -1637,7 +1643,7 @@   with negative if clauses coming before positive if clauses of the same   version. (If you think about which GHC version a clause activates for this   should make sense `!MIN_VERSION_GHC(9,0,0)` refers to 8.10 and lower which is-  a earlier version than `MIN_VERSION_GHC(9,0,0)` which refers to versions 9.0+  an earlier version than `MIN_VERSION_GHC(9,0,0)` which refers to versions 9.0   and later). In addition there should be a space before and after each CPP   clause. 

@@ -78,7 +78,6 @@ import           System.IO.Error import           System.IO.Unsafe - data Log   = LogCouldNotIdentifyReverseDeps !NormalizedFilePath   | LogTypeCheckingReverseDeps !NormalizedFilePath !(Maybe [NormalizedFilePath])@@ -147,6 +146,29 @@                         then return (Nothing, ([], Nothing))                         else return (Nothing, ([diag], Nothing)) ++getPhysicalModificationTimeRule :: Recorder (WithPriority Log) -> Rules ()+getPhysicalModificationTimeRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetPhysicalModificationTime file ->+    getPhysicalModificationTimeImpl file++getPhysicalModificationTimeImpl+  :: NormalizedFilePath+  -> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))+getPhysicalModificationTimeImpl file = do+    let file' = fromNormalizedFilePath file+    let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time))++    alwaysRerun++    liftIO $ fmap wrap (getModTime file')+        `catch` \(e :: IOException) -> do+            let err | isDoesNotExistError e = "File does not exist: " ++ file'+                    | otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e+                diag = ideErrorText file (T.pack err)+            if isDoesNotExistError e+                then return (Nothing, ([], Nothing))+                else return (Nothing, ([diag], Nothing))+ -- | Interface files cannot be watched, since they live outside the workspace. --   But interface files are private, in that only HLS writes them. --   So we implement watching ourselves, and bypass the need for alwaysRerun.@@ -170,7 +192,11 @@             case c of                 LSP.FileChangeType_Changed                     --  already checked elsewhere |  not $ HM.member nfp fois-                    -> atomically $ deleteValue (shakeExtras ideState) GetModificationTime nfp+                    ->+                      atomically $ do+                        ks <- deleteValue (shakeExtras ideState) GetModificationTime nfp+                        vs <- deleteValue (shakeExtras ideState) GetPhysicalModificationTime nfp+                        pure $ ks ++ vs                 _ -> pure []  @@ -233,6 +259,7 @@ fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules () fileStoreRules recorder isWatched = do     getModificationTimeRule recorder+    getPhysicalModificationTimeRule recorder     getFileContentsRule recorder     addWatchedFileRule recorder isWatched @@ -264,7 +291,7 @@  typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action () typecheckParentsAction recorder nfp = do-    revs <- transitiveReverseDependencies nfp <$> useNoFile_ GetModuleGraph+    revs <- transitiveReverseDependencies nfp <$> useWithSeparateFingerprintRule_ GetModuleGraphTransReverseDepsFingerprints GetModuleGraph nfp     case revs of       Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp       Just rs -> do

@@ -29,7 +29,6 @@ import           Control.Concurrent.STM.Stats             (atomically,                                                            modifyTVar') import           Data.Aeson                               (toJSON)-import qualified Data.Aeson                               as Aeson import qualified Data.ByteString                          as BS import           Data.Maybe                               (catMaybes) import           Development.IDE.Core.ProgressReporting

@@ -1,6 +1,7 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE DeriveAnyClass     #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs              #-} {-# LANGUAGE PatternSynonyms    #-}@@ -34,6 +35,9 @@ import           Development.IDE.Types.HscEnvEq               (HscEnvEq) import           Development.IDE.Types.KnownTargets import           GHC.Generics                                 (Generic)+import           GHC.Iface.Ext.Types                          (HieASTs,+                                                               TypeIndex)+import           GHC.Iface.Ext.Utils                          (RefMap)  import           Data.ByteString                              (ByteString) import           Data.Text.Utf16.Rope.Mixed                   (Rope)@@ -74,6 +78,12 @@  type instance RuleResult GetModuleGraph = DependencyInformation +-- | it only compute the fingerprint of the module graph for a file and its dependencies+-- we need this to trigger recompilation when the sub module graph for a file changes+type instance RuleResult GetModuleGraphTransDepsFingerprints = Fingerprint+type instance RuleResult GetModuleGraphTransReverseDepsFingerprints = Fingerprint+type instance RuleResult GetModuleGraphImmediateReverseDepsFingerprints = Fingerprint+ data GetKnownTargets = GetKnownTargets   deriving (Show, Generic, Eq, Ord) instance Hashable GetKnownTargets@@ -243,9 +253,15 @@ -- | A IntervalMap telling us what is in scope at each point type instance RuleResult GetBindings = Bindings -data DocAndTyThingMap = DKMap {getDocMap :: !DocMap, getTyThingMap :: !TyThingMap}+data DocAndTyThingMap = DKMap+    { getDocMap     :: !DocMap+    -- ^ Docs for declarations: functions, data types, instances, methods, etc+    , getTyThingMap :: !TyThingMap+    , getArgDocMap  :: !ArgDocMap+    -- ^ Docs for arguments, e.g., function arguments and method arguments+    } instance NFData DocAndTyThingMap where-    rnf (DKMap a b) = rwhnf a `seq` rwhnf b+    rnf (DKMap a b c) = rwhnf a `seq` rwhnf b `seq` rwhnf c  instance Show DocAndTyThingMap where     show = const "docmap"@@ -310,6 +326,13 @@  instance NFData   GetModificationTime +data GetPhysicalModificationTime = GetPhysicalModificationTime+    deriving (Generic, Show, Eq)+    deriving anyclass (Hashable, NFData)++-- | Get the modification time of a file on disk, ignoring any version in the VFS.+type instance RuleResult GetPhysicalModificationTime = FileVersion+ pattern GetModificationTime :: GetModificationTime pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True} @@ -416,6 +439,21 @@     deriving (Eq, Show, Generic) instance Hashable GetModuleGraph instance NFData   GetModuleGraph++data GetModuleGraphTransDepsFingerprints = GetModuleGraphTransDepsFingerprints+    deriving (Eq, Show, Generic)+instance Hashable GetModuleGraphTransDepsFingerprints+instance NFData   GetModuleGraphTransDepsFingerprints++data GetModuleGraphTransReverseDepsFingerprints = GetModuleGraphTransReverseDepsFingerprints+    deriving (Eq, Show, Generic)+instance Hashable GetModuleGraphTransReverseDepsFingerprints+instance NFData   GetModuleGraphTransReverseDepsFingerprints++data GetModuleGraphImmediateReverseDepsFingerprints = GetModuleGraphImmediateReverseDepsFingerprints+    deriving (Eq, Show, Generic)+instance Hashable GetModuleGraphImmediateReverseDepsFingerprints+instance NFData   GetModuleGraphImmediateReverseDepsFingerprints  data ReportImportCycles = ReportImportCycles     deriving (Eq, Show, Generic)

@@ -138,6 +138,8 @@ import           Development.IDE.Types.Location import           Development.IDE.Types.Options import qualified Development.IDE.Types.Shake                  as Shake+import           GHC.Iface.Ext.Types                          (HieASTs (..))+import           GHC.Iface.Ext.Utils                          (generateReferencesMap) import qualified GHC.LanguageExtensions                       as LangExt import           HIE.Bios.Ghc.Gap                             (hostIsDynamic) import qualified HieDb@@ -159,10 +161,10 @@                                                                usePropertyByPath) import           Ide.Types                                    (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser),                                                                PluginId)+import qualified Language.LSP.Protocol.Lens                   as JL import           Language.LSP.Protocol.Message                (SMethod (SMethod_CustomMethod, SMethod_WindowShowMessage)) import           Language.LSP.Protocol.Types                  (MessageType (MessageType_Info),                                                                ShowMessageParams (ShowMessageParams))-import qualified Language.LSP.Protocol.Lens                   as JL import           Language.LSP.Server                          (LspT) import qualified Language.LSP.Server                          as LSP import           Language.LSP.VFS@@ -174,8 +176,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@@ -183,6 +183,7 @@   | LogLoadingHieFileFail !FilePath !SomeException   | LogLoadingHieFileSuccess !FilePath   | LogTypecheckedFOI !NormalizedFilePath+  | LogDependencies !NormalizedFilePath [FilePath]   deriving Show  instance Pretty Log where@@ -207,6 +208,11 @@         <+> "the HLS version being used, the plugins enabled, and if possible the codebase and file which"         <+> "triggered this warning."       ]+    LogDependencies nfp deps ->+      vcat+         [ "Add dependency" <+> pretty (fromNormalizedFilePath nfp)+         , nest 2 $ pretty deps+         ]  templateHaskellInstructions :: T.Text templateHaskellInstructions = "https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html#static-binaries"@@ -262,12 +268,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}@@ -286,7 +290,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' }@@ -472,7 +476,7 @@ reportImportCyclesRule :: Recorder (WithPriority Log) -> Rules () reportImportCyclesRule recorder =     defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \ReportImportCycles file -> fmap (\errs -> if null errs then (Just "1",([], Just ())) else (Nothing, (errs, Nothing))) $ do-        DependencyInformation{..} <- useNoFile_ GetModuleGraph+        DependencyInformation{..} <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file         case pathToId depPathIdMap file of           -- The header of the file does not parse, so it can't be part of any import cycles.           Nothing -> pure []@@ -514,7 +518,7 @@   (currentSource, ver) <- liftIO $ case M.lookup (filePathToUri' file) vfsData of     Nothing -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file)     Just vf -> pure (virtualFileText vf, Just $ virtualFileVersion vf)-  let refmap = Compat.generateReferencesMap . Compat.getAsts . Compat.hie_asts $ res+  let refmap = generateReferencesMap . getAsts . Compat.hie_asts $ res       del = deltaFromDiff (T.decodeUtf8 $ Compat.hie_hs_src res) currentSource   pure (HAR (Compat.hie_module res) (Compat.hie_asts res) refmap mempty (HieFromDisk res),del,ver) @@ -542,8 +546,8 @@           liftIO $ writeAndIndexHieFile hsc se modSummary f exports asts source     _ -> pure [] -  let refmap = Compat.generateReferencesMap . Compat.getAsts <$> masts-      typemap = AtPoint.computeTypeReferences . Compat.getAsts <$> masts+  let refmap = generateReferencesMap . getAsts <$> masts+      typemap = AtPoint.computeTypeReferences . getAsts <$> masts   pure (diags <> diagsWrite, HAR (ms_mod $ tmrModSummary tmr) <$> masts <*> refmap <*> typemap <*> pure HieFresh)  getImportMapRule :: Recorder (WithPriority Log) -> Rules ()@@ -578,7 +582,7 @@  -- | Persistent rule to ensure that hover doesn't block on startup persistentDocMapRule :: Rules ()-persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty, idDelta, Nothing)+persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty mempty, idDelta, Nothing)  readHieFileForSrcFromDisk :: Recorder (WithPriority Log) -> NormalizedFilePath -> MaybeT IdeAction Compat.HieFile readHieFileForSrcFromDisk recorder file = do@@ -608,7 +612,7 @@     -- very expensive.     when (foi == NotFOI) $       logWith recorder Logger.Warning $ LogTypecheckedFOI file-    typeCheckRuleDefinition hsc pm+    typeCheckRuleDefinition hsc pm file  knownFilesRule :: Recorder (WithPriority Log) -> Rules () knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetKnownTargets -> do@@ -643,7 +647,10 @@       go (Just ms) _ = Just $ ModuleNode [] ms       go _ _ = Nothing       mg = mkModuleGraph mns-  pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg)+  let shallowFingers = IntMap.fromList $ foldr' (\(i, m) acc -> case m of+                                        Just x -> (getFilePathId i,msrFingerprint x):acc+                                        Nothing -> acc) [] $ zip _all_ids msrs+  pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg shallowFingers)  -- This is factored out so it can be directly called from the GetModIface -- rule. Directly calling this rule means that on the initial load we can@@ -652,14 +659,15 @@ typeCheckRuleDefinition     :: HscEnv     -> ParsedModule+    -> NormalizedFilePath     -> Action (IdeResult TcModuleResult)-typeCheckRuleDefinition hsc pm = do+typeCheckRuleDefinition hsc pm fp = do   IdeOptions { optDefer = defer } <- getIdeOptions    unlift <- askUnliftIO   let dets = TypecheckHelpers            { getLinkables = unliftIO unlift . uses_ GetLinkable-           , getModuleGraph = unliftIO unlift $ useNoFile_ GetModuleGraph+           , getModuleGraph = unliftIO unlift $ useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph fp            }   addUsageDependencies $ liftIO $     typecheckModule defer hsc dets pm@@ -713,7 +721,8 @@                 let nfp = toNormalizedFilePath' fp                 itExists <- getFileExists nfp                 when itExists $ void $ do-                  use_ GetModificationTime nfp+                  use_ GetPhysicalModificationTime nfp+        logWith recorder Logger.Info $ LogDependencies file deps         mapM_ addDependency deps          let cutoffHash = LBS.toStrict $ B.encode (hash (snd val))@@ -756,9 +765,10 @@             depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps             ifaces <- uses_ GetModIface deps             let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces+            de <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file             mg <- do               if fullModuleGraph-              then depModuleGraph <$> useNoFile_ GetModuleGraph+              then return $ depModuleGraph de               else do                 let mgs = map hsc_mod_graph depSessions                 -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph@@ -771,7 +781,6 @@                       nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs)                 liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes                 return $ mkModuleGraph module_graph_nodes-            de <- useNoFile_ GetModuleGraph             session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions              -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new@@ -801,7 +810,7 @@             , old_value = m_old             , get_file_version = use GetModificationTime_{missingFileDiagnostics = False}             , get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs-            , get_module_graph = useNoFile_ GetModuleGraph+            , get_module_graph = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f             , regenerate = regenerateHiFile session f ms             }       hsc_env' <- setFileCacheHook (hscEnv session)@@ -970,14 +979,14 @@     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             -- Invoke typechecking directly to update it without incurring a dependency             -- on the parsed module and the typecheck rules-            (diags', mtmr) <- typeCheckRuleDefinition hsc pm+            (diags', mtmr) <- typeCheckRuleDefinition hsc pm f             case mtmr of               Nothing -> pure (diags', Nothing)               Just tmr -> do@@ -1135,7 +1144,7 @@   | "boot" `isSuffixOf` fromNormalizedFilePath file =     pure (Just $ encodeLinkableType Nothing, Just Nothing) needsCompilationRule file = do-  graph <- useNoFile GetModuleGraph+  graph <- useWithSeparateFingerprintRule GetModuleGraphImmediateReverseDepsFingerprints GetModuleGraph file   res <- case graph of     -- Treat as False if some reverse dependency header fails to parse     Nothing -> pure Nothing@@ -1247,6 +1256,19 @@     persistentDocMapRule     persistentImportMapRule     getLinkableRule recorder+    defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransDepsFingerprints file -> do+        di <- useNoFile_ GetModuleGraph+        let finger = lookupFingerprint file di (depTransDepsFingerprints di)+        return (fingerprintToBS <$> finger, ([], finger))+    defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransReverseDepsFingerprints file -> do+        di <- useNoFile_ GetModuleGraph+        let finger = lookupFingerprint file di (depTransReverseDepsFingerprints di)+        return (fingerprintToBS <$> finger, ([], finger))+    defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphImmediateReverseDepsFingerprints file -> do+        di <- useNoFile_ GetModuleGraph+        let finger = lookupFingerprint file di (depImmediateReverseDepsFingerprints di)+        return (fingerprintToBS <$> finger, ([], finger))+  -- | Get HieFile for haskell file on NormalizedFilePath getHieFile :: NormalizedFilePath -> Action (Maybe HieFile)

@@ -31,6 +31,8 @@     shakeEnqueue,     newSession,     use, useNoFile, uses, useWithStaleFast, useWithStaleFast', delayedAction,+    useWithSeparateFingerprintRule,+    useWithSeparateFingerprintRule_,     FastResult(..),     use_, useNoFile_, uses_,     useWithStale, usesWithStale,@@ -1147,6 +1149,23 @@     -- return the most recent successfully computed value regardless of     -- whether the rule succeeded or not.     traverse (lastValue key) files++-- we use separate fingerprint rules to trigger the rebuild of the rule+useWithSeparateFingerprintRule+    :: (IdeRule k v, IdeRule k1 Fingerprint)+    => k1 -> k -> NormalizedFilePath -> Action (Maybe v)+useWithSeparateFingerprintRule fingerKey key file = do+    _ <- use fingerKey file+    useWithoutDependency key emptyFilePath++-- we use separate fingerprint rules to trigger the rebuild of the rule+useWithSeparateFingerprintRule_+    :: (IdeRule k v, IdeRule k1 Fingerprint)+    => k1 -> k -> NormalizedFilePath -> Action v+useWithSeparateFingerprintRule_ fingerKey key file = do+    useWithSeparateFingerprintRule fingerKey key file >>= \case+        Just v -> return v+        Nothing -> liftIO $ throwIO $ BadDependency (show key)  useWithoutDependency :: IdeRule k v     => k -> NormalizedFilePath -> Action (Maybe v)

@@ -19,17 +19,11 @@ import           Development.IDE.GHC.Compat.Util import           GHC import           GHC.Settings+import qualified GHC.SysTools.Cpp                as Pipeline  -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if !MIN_VERSION_ghc(9,5,0)-import qualified GHC.Driver.Pipeline.Execute     as Pipeline-#endif -#if MIN_VERSION_ghc(9,5,0)-import qualified GHC.SysTools.Cpp                as Pipeline-#endif- #if MIN_VERSION_ghc(9,10,2) import qualified GHC.SysTools.Tasks              as Pipeline #endif@@ -49,13 +43,12 @@  doCpp :: HscEnv -> FilePath -> FilePath -> IO () doCpp env input_fn output_fn =-        -- See GHC commit a2f53ac8d968723417baadfab5be36a020ea6850-        -- this function/Pipeline.doCpp previously had a raw parameter-        -- always set to True that corresponded to these settings--#if MIN_VERSION_ghc(9,5,0)+    -- See GHC commit a2f53ac8d968723417baadfab5be36a020ea6850+    -- this function/Pipeline.doCpp previously had a raw parameter+    -- always set to True that corresponded to these settings     let cpp_opts = Pipeline.CppOpts                  { cppLinePragmas = True+ #if MIN_VERSION_ghc(9,10,2)                  , sourceCodePreprocessor = Pipeline.SCPHsCpp #elif MIN_VERSION_ghc(9,10,0)@@ -63,10 +56,8 @@ #else                  , cppUseCc = False #endif+                  } in-#else-    let cpp_opts = True in-#endif      Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) cpp_opts input_fn output_fn 

@@ -45,8 +45,6 @@     readHieFile,     setHieDir,     dontWriteHieFiles,-    module Compat.HieTypes,-    module Compat.HieUtils,     -- * Compat modules     module Development.IDE.GHC.Compat.Core,     module Development.IDE.GHC.Compat.Env,@@ -102,9 +100,7 @@     Dependencies(dep_direct_mods),     NameCacheUpdater, -#if MIN_VERSION_ghc(9,5,0)     XModulePs(..),-#endif  #if !MIN_VERSION_ghc(9,7,0)     liftZonkM,@@ -114,14 +110,8 @@ #if MIN_VERSION_ghc(9,7,0)     tcInitTidyEnv, #endif-    ) where -import           Compat.HieAst                           (enrichHie)-import           Compat.HieBin-import           Compat.HieTypes                         hiding-                                                         (nodeAnnotations)-import qualified Compat.HieTypes                         as GHC (nodeAnnotations)-import           Compat.HieUtils+    ) where import           Control.Applicative                     ((<|>)) import qualified Data.ByteString                         as BS import           Data.Coerce                             (coerce)@@ -148,12 +138,18 @@ import           GHC.CoreToStg.Prep                      (corePrepPgm) import qualified GHC.CoreToStg.Prep                      as GHC import           GHC.Driver.Hooks                        (hscCompileCoreExprHook)+import           GHC.Iface.Ext.Types                     hiding+                                                         (nodeAnnotations)+import qualified GHC.Iface.Ext.Types                     as GHC (nodeAnnotations)+import           GHC.Iface.Ext.Utils  import           GHC.ByteCode.Asm                        (bcoFreeNames) import           GHC.Core import           GHC.Data.FastString import           GHC.Data.StringBuffer import           GHC.Driver.Session                      hiding (ExposePackage)+import           GHC.Iface.Ext.Ast                       (enrichHie)+import           GHC.Iface.Ext.Binary import           GHC.Iface.Make                          (mkIfaceExports) import           GHC.SysTools.Tasks                      (runPp, runUnlit) import           GHC.Types.Annotations                   (AnnTarget (ModuleTarget),@@ -167,8 +163,13 @@  import           GHC.Builtin.Uniques import           GHC.ByteCode.Types+import           GHC.Core.Lint.Interactive               (interactiveInScope) import           GHC.CoreToStg import           GHC.Data.Maybe+import           GHC.Driver.Config.Core.Lint.Interactive (lintInteractiveExpr)+import           GHC.Driver.Config.Core.Opt.Simplify     (initSimplifyExprOpts)+import           GHC.Driver.Config.CoreToStg             (initCoreToStgOpts)+import           GHC.Driver.Config.CoreToStg.Prep        (initCorePrepConfig) import           GHC.Driver.Config.Stg.Pipeline import           GHC.Driver.Env                          as Env import           GHC.Iface.Env@@ -188,18 +189,6 @@  -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if !MIN_VERSION_ghc(9,5,0)-import           GHC.Core.Lint                           (lintInteractiveExpr)-#endif--#if MIN_VERSION_ghc(9,5,0)-import           GHC.Core.Lint.Interactive               (interactiveInScope)-import           GHC.Driver.Config.Core.Lint.Interactive (lintInteractiveExpr)-import           GHC.Driver.Config.Core.Opt.Simplify     (initSimplifyExprOpts)-import           GHC.Driver.Config.CoreToStg             (initCoreToStgOpts)-import           GHC.Driver.Config.CoreToStg.Prep        (initCorePrepConfig)-#endif- #if MIN_VERSION_ghc(9,7,0) import           GHC.Tc.Zonk.TcType                      (tcInitTidyEnv) #endif@@ -230,11 +219,7 @@        binding for the stg2stg step) -}     let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel")                                 (mkPseudoUniqueE 0)-#if MIN_VERSION_ghc(9,5,0)                                 ManyTy-#else-                                Many-#endif                                 (exprType prepd_expr)     (stg_binds, prov_map, collected_ccs) <-        myCoreToStg logger@@ -258,27 +243,17 @@     let (stg_binds, denv, cost_centre_info)          = {-# SCC "Core2Stg" #-}            coreToStg-#if MIN_VERSION_ghc(9,5,0)              (initCoreToStgOpts dflags)-#else-             dflags-#endif              this_mod ml prepd_binds  #if MIN_VERSION_ghc(9,8,0)     (unzip -> (stg_binds2,_),_)-#elif MIN_VERSION_ghc(9,4,2)-    (stg_binds2,_) #else-    stg_binds2+    (stg_binds2,_) #endif         <- {-# SCC "Stg2Stg" #-}            stg2stg logger-#if MIN_VERSION_ghc(9,5,0)                    (interactiveInScope ictxt)-#else-                   ictxt-#endif                    (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds      return (stg_binds2, denv, cost_centre_info)@@ -293,42 +268,21 @@ getDependentMods = map (gwib_mod . snd) . S.toList . dep_direct_mods . mi_deps  simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr-#if MIN_VERSION_ghc(9,5,0) simplifyExpr _ env = GHC.simplifyExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) (ue_eps (Development.IDE.GHC.Compat.Env.hsc_unit_env env)) (initSimplifyExprOpts (hsc_dflags env) (hsc_IC env))-#else-simplifyExpr _ = GHC.simplifyExpr-#endif  corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr-#if MIN_VERSION_ghc(9,5,0) corePrepExpr _ env expr = do   cfg <- initCorePrepConfig env   GHC.corePrepExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) cfg expr-#else-corePrepExpr _ = GHC.corePrepExpr-#endif  renderMessages :: PsMessages -> (Bag WarnMsg, Bag ErrMsg) renderMessages msgs =-#if MIN_VERSION_ghc(9,5,0)   let renderMsgs extractor = (fmap . fmap) GhcPsMessage . getMessages $ extractor msgs   in (renderMsgs psWarnings, renderMsgs psErrors)-#else-  let renderMsgs extractor = (fmap . fmap) renderDiagnosticMessageWithHints . getMessages $ extractor msgs-  in (renderMsgs psWarnings, renderMsgs psErrors)-#endif -#if MIN_VERSION_ghc(9,5,0) pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope GhcMessage)) -> ParseResult a-#else-pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a-#endif pattern PFailedWithErrorMessages msgs-#if MIN_VERSION_ghc(9,5,0)      <- PFailed (const . fmap (fmap GhcPsMessage) . getMessages . getPsErrorMessages -> msgs)-#else-     <- PFailed (const . fmap (fmap renderDiagnosticMessageWithHints) . getMessages . getPsErrorMessages -> msgs)-#endif {-# COMPLETE POk, PFailedWithErrorMessages #-}  hieExportNames :: HieFile -> [(SrcSpan, Name)]@@ -453,8 +407,7 @@ generatedNodeInfo = Map.lookup GeneratedInfo . getSourcedNodeInfo . sourcedNodeInfo  data GhcVersion-  = GHC94-  | GHC96+  = GHC96   | GHC98   | GHC910   | GHC912@@ -470,10 +423,8 @@ ghcVersion = GHC910 #elif MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) ghcVersion = GHC98-#elif MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)+#else ghcVersion = GHC96-#elif MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)-ghcVersion = GHC94 #endif  simpleNodeInfoCompat :: FastStringCompat -> FastStringCompat -> NodeInfo a@@ -510,14 +461,8 @@  recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int recDotDot x =-#if MIN_VERSION_ghc(9,5,0)             unRecFieldsDotDot <$>-#endif             unLoc <$> rec_dotdot x -#if MIN_VERSION_ghc(9,5,0)-extract_cons (NewTypeCon x) = [x]+extract_cons (NewTypeCon x)      = [x] extract_cons (DataTypeCons _ xs) = xs-#else-extract_cons = id-#endif

@@ -225,6 +225,7 @@     SrcLoc.noSrcSpan,     SrcLoc.noSrcLoc,     SrcLoc.noLoc,+    SrcLoc.srcSpanToRealSrcSpan,     mapLoc,     -- * Finder     FindResult(..),@@ -374,27 +375,13 @@     module GHC.Unit.Finder.Types,     module GHC.Unit.Env,     module GHC.Driver.Phases,-#if !MIN_VERSION_ghc(9,4,0)-    pattern HsFieldBind,-    hfbAnn,-    hfbLHS,-    hfbRHS,-    hfbPun,-#endif-#if !MIN_VERSION_ghc_boot_th(9,4,1)-    Extension(.., NamedFieldPuns),-#else     Extension(..),-#endif     mkCgInteractiveGuts,     justBytecode,     justObjects,     emptyHomeModInfoLinkable,     homeModInfoByteCode,     homeModInfoObject,-#if !MIN_VERSION_ghc(9,5,0)-    field_label,-#endif     groupOrigin,     isVisibleFunArg, #if MIN_VERSION_ghc(9,8,0)@@ -629,21 +616,11 @@ #endif  isVisibleFunArg :: Development.IDE.GHC.Compat.Core.FunTyFlag -> Bool-#if __GLASGOW_HASKELL__ >= 906 isVisibleFunArg = TypesVar.isVisibleFunArg type FunTyFlag = TypesVar.FunTyFlag-#else-isVisibleFunArg VisArg = True-isVisibleFunArg _ = False-type FunTyFlag = TypesVar.AnonArgFlag-#endif pattern FunTy :: Development.IDE.GHC.Compat.Core.FunTyFlag -> Type -> Type -> Type pattern FunTy af arg res <- TyCoRep.FunTy {ft_af = af, ft_arg = arg, ft_res = res} ---- type HasSrcSpan x a = (GenLocated SrcSpan a ~ x)--- type HasSrcSpan x = () :: Constraint- class HasSrcSpan a where   getLoc :: a -> SrcSpan @@ -749,11 +726,7 @@  mkIfaceTc :: HscEnv -> GHC.SafeHaskellMode -> ModDetails -> ModSummary -> Maybe CoreProgram -> TcGblEnv -> IO ModIface mkIfaceTc hscEnv shm md _ms _mcp =-#if MIN_VERSION_ghc(9,5,0)   GHC.mkIfaceTc hscEnv shm md _ms _mcp -- mcp::Maybe CoreProgram is only used in GHC >= 9.6-#else-  GHC.mkIfaceTc hscEnv shm md _ms -- ms::ModSummary is only used in GHC >= 9.4-#endif  mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails mkBootModDetailsTc session = GHC.mkBootModDetailsTc@@ -767,50 +740,10 @@ driverNoStop :: StopPhase driverNoStop = NoStop --#if !MIN_VERSION_ghc(9,4,0)-pattern HsFieldBind :: XHsRecField id -> id -> arg -> Bool -> HsRecField' id arg-pattern HsFieldBind {hfbAnn, hfbLHS, hfbRHS, hfbPun} <- HsRecField hfbAnn (SrcLoc.unLoc -> hfbLHS) hfbRHS hfbPun where-  HsFieldBind ann lhs rhs pun = HsRecField ann (SrcLoc.noLoc lhs) rhs pun-#endif--#if !MIN_VERSION_ghc_boot_th(9,4,1)-pattern NamedFieldPuns :: Extension-pattern NamedFieldPuns = RecordPuns-#endif- groupOrigin :: MatchGroup GhcRn body -> Origin-#if MIN_VERSION_ghc(9,5,0) mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b mapLoc = fmap groupOrigin = mg_ext-#else-mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b-mapLoc = SrcLoc.mapLoc-groupOrigin = mg_origin-#endif---#if !MIN_VERSION_ghc(9,5,0)-mkCgInteractiveGuts :: CgGuts -> CgGuts-mkCgInteractiveGuts = id--emptyHomeModInfoLinkable :: Maybe Linkable-emptyHomeModInfoLinkable = Nothing--justBytecode :: Linkable -> Maybe Linkable-justBytecode = Just--justObjects :: Linkable -> Maybe Linkable-justObjects = Just--homeModInfoByteCode, homeModInfoObject :: HomeModInfo -> Maybe Linkable-homeModInfoByteCode = hm_linkable-homeModInfoObject = hm_linkable--field_label :: a -> a-field_label = id-#endif  mkSimpleTarget :: DynFlags -> FilePath -> Target mkSimpleTarget df fp = Target (TargetFile fp Nothing) True (homeUnitId_ df) Nothing

@@ -79,11 +79,7 @@             tc_result0 <- tcRnModule' mod_summary keep_rn' hpm             if hsc_src == HsigFile                 then-#if MIN_VERSION_ghc(9,5,0)                      do (iface, _) <- liftIO $ hscSimpleIface hsc_env Nothing tc_result0 mod_summary-#else-                     do (iface, _) <- liftIO $ hscSimpleIface hsc_env tc_result0 mod_summary-#endif                         ioMsgMaybe $ hoistTcRnMessage $                             tcRnMergeSignatures hsc_env hpm tc_result0 iface                 else return tc_result0@@ -135,7 +131,6 @@ -- ============================================================================ -- DO NOT EDIT - Refer to top of file -- ============================================================================-#if MIN_VERSION_ghc(9,5,0) hscSimpleIface :: HscEnv                -> Maybe CoreProgram                -> TcGblEnv@@ -143,13 +138,5 @@                -> IO (ModIface, ModDetails) hscSimpleIface hsc_env mb_core_program tc_result summary     = runHsc hsc_env $ hscSimpleIface' mb_core_program tc_result summary-#else-hscSimpleIface :: HscEnv-               -> TcGblEnv-               -> ModSummary-               -> IO (ModIface, ModDetails)-hscSimpleIface hsc_env tc_result summary-    = runHsc hsc_env $ hscSimpleIface' tc_result summary-#endif  #endif

@@ -105,22 +105,14 @@ setBytecodeLinkerOptions :: DynFlags -> DynFlags setBytecodeLinkerOptions df = df {     ghcLink   = LinkInMemory-#if MIN_VERSION_ghc(9,5,0)   , backend = noBackend-#else-  , backend = NoBackend-#endif   , ghcMode = CompManager     }  setInterpreterLinkerOptions :: DynFlags -> DynFlags setInterpreterLinkerOptions df = df {     ghcLink   = LinkInMemory-#if MIN_VERSION_ghc(9,5,0)    , backend = interpreterBackend-#else-  , backend = Interpreter-#endif   , ghcMode = CompManager     } 

@@ -8,6 +8,7 @@   -- * Error messages for the typechecking and renamer phase   TcRnMessage (..),   TcRnMessageDetailed (..),+  Hole(..),   stripTcRnMessageContext,   -- * Parsing error message   PsMessage(..),@@ -17,21 +18,52 @@   DriverMessage (..),   -- * General Diagnostics   Diagnostic(..),-  -- * Prisms for error selection+  -- * GHC Hints+  GhcHint (SuggestExtension),+  LanguageExtensionHint (..),+  -- * Prisms and lenses for error selection   _TcRnMessage,+  _TcRnMessageWithCtx,   _GhcPsMessage,   _GhcDsMessage,   _GhcDriverMessage,+  _ReportHoleError,+  _TcRnIllegalWildcardInType,+  _TcRnPartialTypeSignatures,+  _TcRnMissingSignature,+  _TcRnSolverReport,+  _TcRnMessageWithInfo,+  _TypeHole,+  _ConstraintHole,+  reportContextL,+  reportContentL,+  _MismatchMessage,+  _TypeEqMismatchActual,+  _TypeEqMismatchExpected,   ) where  import           Control.Lens+import           Development.IDE.GHC.Compat (Type) import           GHC.Driver.Errors.Types import           GHC.HsToCore.Errors.Types import           GHC.Tc.Errors.Types+import           GHC.Tc.Types.Constraint    (Hole (..), HoleSort) import           GHC.Types.Error -_TcRnMessage :: Prism' GhcMessage TcRnMessage-_TcRnMessage = prism' GhcTcRnMessage (\case+-- | Some 'TcRnMessage's are nested in other constructors for additional context.+-- For example, 'TcRnWithHsDocContext' and 'TcRnMessageWithInfo'.+-- However, in most occasions you don't need the additional context and you just want+-- the error message. @'_TcRnMessage'@ recursively unwraps these constructors,+-- until there are no more constructors with additional context.+--+-- Use @'_TcRnMessageWithCtx'@ if you need the additional context. You can always+-- strip it later using @'stripTcRnMessageContext'@.+--+_TcRnMessage :: Fold GhcMessage TcRnMessage+_TcRnMessage = _TcRnMessageWithCtx . to stripTcRnMessageContext++_TcRnMessageWithCtx :: Prism' GhcMessage TcRnMessage+_TcRnMessageWithCtx = prism' GhcTcRnMessage (\case   GhcTcRnMessage tcRnMsg -> Just tcRnMsg   _ -> Nothing) @@ -66,3 +98,42 @@  msgEnvelopeErrorL :: Lens' (MsgEnvelope e) e msgEnvelopeErrorL = lens errMsgDiagnostic (\envelope e -> envelope { errMsgDiagnostic = e } )++makePrisms ''TcRnMessage++makeLensesWith+    (lensRules & lensField .~ mappingNamer (pure . (++ "L")))+    ''SolverReportWithCtxt++makePrisms ''TcSolverReportMsg++makePrisms ''HoleSort++-- | Focus 'MismatchMsg' from 'TcSolverReportMsg'. Currently, 'MismatchMsg' can be+-- extracted from 'CannotUnifyVariable' and 'Mismatch' constructors.+_MismatchMessage :: Traversal' TcSolverReportMsg MismatchMsg+_MismatchMessage focus (Mismatch msg t a c) = (\msg' -> Mismatch msg' t a c) <$> focus msg+_MismatchMessage focus (CannotUnifyVariable msg a) = flip CannotUnifyVariable a <$> focus msg+_MismatchMessage _ report = pure report++-- | Focus 'teq_mismatch_expected' from 'TypeEqMismatch'.+_TypeEqMismatchExpected :: Traversal' MismatchMsg Type+#if MIN_VERSION_ghc(9,10,2)+_TypeEqMismatchExpected focus mismatch@(TypeEqMismatch _ _ _ expected _ _ _) =+    (\expected' -> mismatch { teq_mismatch_expected = expected' }) <$> focus expected+#else+_TypeEqMismatchExpected focus mismatch@(TypeEqMismatch _ _ _ _ expected _ _ _) =+    (\expected' -> mismatch { teq_mismatch_expected = expected' }) <$> focus expected+#endif+_TypeEqMismatchExpected _ mismatch = pure mismatch++-- | Focus 'teq_mismatch_actual' from 'TypeEqMismatch'.+_TypeEqMismatchActual :: Traversal' MismatchMsg Type+#if MIN_VERSION_ghc(9,10,2)+_TypeEqMismatchActual focus mismatch@(TypeEqMismatch _ _ _ _ actual _ _) =+    (\actual' -> mismatch { teq_mismatch_actual = actual' }) <$> focus actual+#else+_TypeEqMismatchActual focus mismatch@(TypeEqMismatch _ _ _ _ _ actual _ _) =+    (\actual' -> mismatch { teq_mismatch_expected = actual' }) <$> focus actual+#endif+_TypeEqMismatchActual _ mismatch = pure mismatch

@@ -23,7 +23,7 @@ writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO () #if MIN_VERSION_ghc(9,11,0) writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (targetProfile $ hsc_dflags env) (Iface.flagsToIfCompression $ hsc_dflags env) fp iface-#elif MIN_VERSION_ghc(9,3,0)+#else writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (targetProfile $ hsc_dflags env) fp iface #endif 

@@ -28,10 +28,8 @@ logActionCompat :: LogActionCompat -> LogAction #if MIN_VERSION_ghc(9,7,0) logActionCompat logAction logFlags (MCDiagnostic severity (ResolvedDiagnosticReason wr) _) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify-#elif MIN_VERSION_ghc(9,5,0)-logActionCompat logAction logFlags (MCDiagnostic severity wr _) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify #else-logActionCompat logAction logFlags (MCDiagnostic severity wr) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify+logActionCompat logAction logFlags (MCDiagnostic severity wr _) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify #endif logActionCompat logAction logFlags _cls loc = logAction logFlags Nothing Nothing loc alwaysQualify 

@@ -9,6 +9,7 @@     ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, punctuate,     printSDocQualifiedUnsafe,     printWithoutUniques,+    printWithoutUniquesOneLine,     mkPrintUnqualifiedDefault,     PrintUnqualified,     defaultUserStyle,@@ -16,19 +17,18 @@     -- * Parser errors     PsWarning,     PsError,-#if MIN_VERSION_ghc(9,5,0)     defaultDiagnosticOpts,     GhcMessage,     DriverMessage,     Messages,     initDiagOpts,     pprMessages,-#endif     DiagnosticReason(..),     renderDiagnosticMessageWithHints,     pprMsgEnvelopeBagWithLoc,     Error.getMessages,     renderWithContext,+    showSDocOneLine,     defaultSDocContext,     errMsgDiagnostic,     unDecorated,@@ -51,6 +51,7 @@ import           Data.Maybe import           GHC.Driver.Config.Diagnostic import           GHC.Driver.Env+import           GHC.Driver.Errors.Types      (DriverMessage, GhcMessage) import           GHC.Driver.Ppr import           GHC.Driver.Session import           GHC.Parser.Errors.Types@@ -66,25 +67,25 @@  -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if MIN_VERSION_ghc(9,5,0)-import           GHC.Driver.Errors.Types      (DriverMessage, GhcMessage)-#endif- #if MIN_VERSION_ghc(9,7,0) import           GHC.Types.Error              (defaultDiagnosticOpts) #endif -#if MIN_VERSION_ghc(9,5,0) type PrintUnqualified = NamePprCtx-#endif  -- | A compatible function to print `Outputable` instances -- without unique symbols. -- -- It print with a user-friendly style like: `a_a4ME` as `a`. printWithoutUniques :: Outputable a => a -> String-printWithoutUniques =-  renderWithContext (defaultSDocContext+printWithoutUniques = printWithoutUniques' renderWithContext++printWithoutUniquesOneLine :: Outputable a => a -> String+printWithoutUniquesOneLine = printWithoutUniques' showSDocOneLine++printWithoutUniques' :: Outputable a => (SDocContext -> SDoc -> String) -> a -> String+printWithoutUniques' showSDoc =+  showSDoc (defaultSDocContext     {       sdocStyle = defaultUserStyle     , sdocSuppressUniques = True@@ -118,33 +119,19 @@   -#if MIN_VERSION_ghc(9,5,0) type ErrMsg  = MsgEnvelope GhcMessage type WarnMsg  = MsgEnvelope GhcMessage-#else-type ErrMsg  = MsgEnvelope DecoratedSDoc-type WarnMsg  = MsgEnvelope DecoratedSDoc-#endif  mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified-#if MIN_VERSION_ghc(9,5,0) mkPrintUnqualifiedDefault env =   mkNamePprCtx ptc (hsc_unit_env env)     where       ptc = initPromotionTickContext (hsc_dflags env)-#else-mkPrintUnqualifiedDefault env =-  -- GHC 9.2 version-  -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified-  mkPrintUnqualified (hsc_unit_env env)-#endif  renderDiagnosticMessageWithHints :: forall a. Diagnostic a => a -> DecoratedSDoc renderDiagnosticMessageWithHints a = Error.unionDecoratedSDoc   (diagnosticMessage-#if MIN_VERSION_ghc(9,5,0)     (defaultDiagnosticOpts @a)-#endif     a) (mkDecorated $ map ppr $ diagnosticHints a)  mkWarnMsg :: DynFlags -> Maybe DiagnosticReason -> b -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc

@@ -49,11 +49,7 @@ initParserState =   Lexer.initParserState -#if MIN_VERSION_ghc(9,5,0) pattern HsParsedModule :: Located (HsModule GhcPs) -> [FilePath] -> GHC.HsParsedModule-#else-pattern HsParsedModule :: Located HsModule -> [FilePath] -> GHC.HsParsedModule-#endif pattern HsParsedModule     { hpm_module     , hpm_src_files

@@ -10,22 +10,17 @@   , readBinCoreFile   , writeBinCoreFile   , getImplicitBinds-  , occNamePrefixes) where+  ) where  import           Control.Monad-import           Control.Monad.IO.Class-import           Data.Foldable import           Data.IORef-import           Data.List                       (isPrefixOf) import           Data.Maybe-import qualified Data.Text                       as T import           Development.IDE.GHC.Compat import qualified Development.IDE.GHC.Compat.Util as Util import           GHC.Core import           GHC.CoreToIface import           GHC.Fingerprint import           GHC.Iface.Binary-import           GHC.Iface.Env #if MIN_VERSION_ghc(9,11,0) import qualified GHC.Iface.Load                  as Iface #endif@@ -43,38 +38,11 @@  data CoreFile   = CoreFile-  { cf_bindings   :: [TopIfaceBinding IfaceId]+  { cf_bindings   :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]   -- ^ The actual core file bindings, deserialized lazily   , cf_iface_hash :: !Fingerprint   } --- | Like IfaceBinding, but lets us serialize internal names as well-data TopIfaceBinding v-  = TopIfaceNonRec v IfaceExpr-  | TopIfaceRec    [(v, IfaceExpr)]-  deriving (Functor, Foldable, Traversable)---- | GHC doesn't export 'tcIdDetails', 'tcIfaceInfo', or 'tcIfaceType',--- but it does export 'tcIfaceDecl'--- so we use `IfaceDecl` as a container for all of these--- invariant: 'IfaceId' is always a 'IfaceId' constructor-type IfaceId = IfaceDecl--instance Binary (TopIfaceBinding IfaceId) where-  put_ bh (TopIfaceNonRec d e) = do-    putByte bh 0-    put_ bh d-    put_ bh e-  put_ bh (TopIfaceRec vs) = do-    putByte bh 1-    put_ bh vs-  get bh = do-    t <- getByte bh-    case t of-      0 -> TopIfaceNonRec <$> get bh <*> get bh-      1 -> TopIfaceRec <$> get bh-      _ -> error "Binary TopIfaceBinding"- instance Binary CoreFile where   put_ bh (CoreFile core fp) = lazyPut bh core >> put_ bh fp   get bh = CoreFile <$> lazyGet bh <*> get bh@@ -118,21 +86,8 @@   :: Fingerprint -- ^ Hash of the interface this was generated from   -> CgGuts   -> CoreFile-#if MIN_VERSION_ghc(9,5,0) -- In GHC 9.6, implicit binds are tidied and part of core binds-codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind1 cg_module) cg_binds) hash-#else-codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind1 cg_module) $ filter isNotImplictBind cg_binds) hash---- | Implicit binds can be generated from the interface and are not tidied,--- so we must filter them out-isNotImplictBind :: CoreBind -> Bool-isNotImplictBind bind = not . all isImplicitId $ bindBindings bind--bindBindings :: CoreBind -> [Var]-bindBindings (NonRec b _) = [b]-bindBindings (Rec bnds)   = map fst bnds-#endif+codeGutsToCoreFile hash CgGuts{..} = CoreFile (map toIfaceTopBind cg_binds) hash  getImplicitBinds :: TyCon -> [CoreBind] getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc@@ -156,111 +111,7 @@               Nothing -> error "get_dfn: no unfolding template"               Just x  -> x -toIfaceTopBndr1 :: Module -> Id -> IfaceId-toIfaceTopBndr1 mod identifier-  = IfaceId (mangleDeclName mod $ getName identifier)-            (toIfaceType (idType identifier))-            (toIfaceIdDetails (idDetails identifier))-            (toIfaceIdInfo (idInfo identifier))--toIfaceTopBind1 :: Module -> Bind Id -> TopIfaceBinding IfaceId-toIfaceTopBind1 mod (NonRec b r) = TopIfaceNonRec (toIfaceTopBndr1 mod b) (toIfaceExpr r)-toIfaceTopBind1 mod (Rec prs)    = TopIfaceRec [(toIfaceTopBndr1 mod b, toIfaceExpr r) | (b,r) <- prs]- typecheckCoreFile :: Module -> IORef TypeEnv -> CoreFile -> IfG CoreProgram typecheckCoreFile this_mod type_var (CoreFile prepd_binding _) =   initIfaceLcl this_mod (text "typecheckCoreFile") NotBoot $ do-    tcTopIfaceBindings1 type_var prepd_binding---- | Internal names can't be serialized, so we mange them--- to an external name and restore at deserialization time--- This is necessary because we rely on stuffing TopIfaceBindings into--- a IfaceId because we don't have access to 'tcIfaceType' etc..-mangleDeclName :: Module -> Name -> Name-mangleDeclName mod name-  | isExternalName name = name-  | otherwise = mkExternalName (nameUnique name) (mangleModule mod) (nameOccName name) (nameSrcSpan name)---- | Mangle the module name too to avoid conflicts-mangleModule :: Module -> Module-mangleModule mod = mkModule (moduleUnit mod) (mkModuleName $ "GHCIDEINTERNAL" ++ moduleNameString (moduleName mod))--isGhcideModule :: Module -> Bool-isGhcideModule mod = "GHCIDEINTERNAL" `isPrefixOf` (moduleNameString $ moduleName mod)---- Is this a fake external name that we need to make into an internal name?-isGhcideName :: Name -> Bool-isGhcideName = isGhcideModule . nameModule--tcTopIfaceBindings1 :: IORef TypeEnv -> [TopIfaceBinding IfaceId]-          -> IfL [CoreBind]-tcTopIfaceBindings1 ty_var ver_decls-   = do-     int <- mapM (traverse tcIfaceId) ver_decls-     let all_ids = concatMap toList int-     liftIO $ modifyIORef ty_var (flip extendTypeEnvList $ map AnId all_ids)-     extendIfaceIdEnv all_ids $ mapM tc_iface_bindings int--tcIfaceId :: IfaceId -> IfL Id-tcIfaceId = fmap getIfaceId . tcIfaceDecl False <=< unmangle_decl_name-  where-    unmangle_decl_name ifid@IfaceId{ ifName = name }-    -- Check if the name is mangled-      | isGhcideName name = do-        name' <- newIfaceName (mkVarOcc $ getOccString name)-        pure $ ifid{ ifName = name' }-      | otherwise = pure ifid-    unmangle_decl_name _ifid = error "tcIfaceId: got non IfaceId: "-    -- invariant: 'IfaceId' is always a 'IfaceId' constructor-    getIfaceId (AnId identifier) = identifier-    getIfaceId _                 = error "tcIfaceId: got non Id"--tc_iface_bindings :: TopIfaceBinding Id -> IfL CoreBind-tc_iface_bindings (TopIfaceNonRec v e) = do-  e' <- tcIfaceExpr e-  pure $ NonRec v e'-tc_iface_bindings (TopIfaceRec vs) = do-  vs' <- traverse (\(v, e) -> (v,) <$> tcIfaceExpr e) vs-  pure $ Rec vs'---- | Prefixes that can occur in a GHC OccName-occNamePrefixes :: [T.Text]-occNamePrefixes =-  [-    -- long ones-    "$con2tag_"-  , "$tag2con_"-  , "$maxtag_"--  -- four chars-  , "$sel:"-  , "$tc'"--  -- three chars-  , "$dm"-  , "$co"-  , "$tc"-  , "$cp"-  , "$fx"--  -- two chars-  , "$W"-  , "$w"-  , "$m"-  , "$b"-  , "$c"-  , "$d"-  , "$i"-  , "$s"-  , "$f"-  , "$r"-  , "C:"-  , "N:"-  , "D:"-  , "$p"-  , "$L"-  , "$f"-  , "$t"-  , "$c"-  , "$m"-  ]+    tcTopIfaceBindings type_var prepd_binding

@@ -78,15 +78,9 @@ -- The function signature changes based on the GHC version. -- While this is not desirable, it avoids more CPP statements in code -- that implements actual logic.-#if MIN_VERSION_ghc(9,5,0) diagFromGhcErrorMessages :: T.Text -> DynFlags -> Compat.Bag (MsgEnvelope GhcMessage) -> [FileDiagnostic] diagFromGhcErrorMessages sourceParser dflags errs =     diagFromErrMsgs sourceParser dflags errs-#else-diagFromGhcErrorMessages :: T.Text -> DynFlags -> Compat.Bag (MsgEnvelope Compat.DecoratedSDoc) -> [FileDiagnostic]-diagFromGhcErrorMessages sourceParser dflags errs =-    diagFromSDocErrMsgs sourceParser dflags errs-#endif  diagFromErrMsgs :: T.Text -> DynFlags -> Compat.Bag (MsgEnvelope GhcMessage) -> [FileDiagnostic] diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . Compat.bagToList

@@ -7,9 +7,7 @@ -- | Orphan instances for GHC. --   Note that the 'NFData' instances may not be law abiding. module Development.IDE.GHC.Orphans() where-import           Development.IDE.GHC.Compat        hiding-                                                   (DuplicateRecordFields,-                                                    FieldSelectors)+import           Development.IDE.GHC.Compat import           Development.IDE.GHC.Util  import           Control.DeepSeq@@ -24,19 +22,16 @@ import           GHC.Data.Bag import           GHC.Data.FastString import qualified GHC.Data.StringBuffer             as SB+import           GHC.Iface.Ext.Types import           GHC.Parser.Annotation-import           GHC.Types.FieldLabel              (DuplicateRecordFields (DuplicateRecordFields, NoDuplicateRecordFields),-                                                    FieldSelectors (FieldSelectors, NoFieldSelectors)) import           GHC.Types.PkgQual import           GHC.Types.SrcLoc  -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if MIN_VERSION_ghc(9,5,0) import           GHC.Unit.Home.ModInfo import           GHC.Unit.Module.Location          (ModLocation (..)) import           GHC.Unit.Module.WholeCoreBindings-#endif  -- Orphan instance for Shake.hs -- https://hub.darcs.net/ross/transformers/issue/86@@ -68,13 +63,10 @@   rnf (DotA f)           = rnf f   rnf (DotDLL f)         = rnf f   rnf (BCOs a b)         = seqCompiledByteCode a `seq` liftRnf rwhnf b-#if MIN_VERSION_ghc(9,5,0)   rnf (CoreBindings wcb) = rnf wcb   rnf (LoadedBCOs us)    = rnf us #endif-#endif -#if MIN_VERSION_ghc(9,5,0) instance NFData WholeCoreBindings where #if MIN_VERSION_ghc(9,11,0)   rnf (WholeCoreBindings bs m ml f) = rnf bs `seq` rnf m `seq` rnf ml `seq` rnf f@@ -88,7 +80,6 @@ #else     rnf (ModLocation mf f1 f2 f3 f4 f5) = rnf mf `seq` rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 #endif-#endif  instance Show PackageFlag where show = unpack . printOutputable instance Show InteractiveImport where show = unpack . printOutputable@@ -103,12 +94,6 @@ instance Show Module where     show = moduleNameString . moduleName --#if !MIN_VERSION_ghc(9,5,0)-instance (NFData l, NFData e) => NFData (GenLocated l e) where-    rnf (L l e) = rnf l `seq` rnf e-#endif- instance Show ModSummary where     show = show . ms_mod @@ -191,11 +176,6 @@ instance Show a => Show (Bag a) where     show = show . bagToList -#if !MIN_VERSION_ghc(9,5,0)-instance NFData HsDocString where-    rnf = rwhnf-#endif- instance Show ModGuts where     show _ = "modguts" instance NFData ModGuts where@@ -204,11 +184,7 @@ instance NFData (ImportDecl GhcPs) where     rnf = rwhnf -#if MIN_VERSION_ghc(9,5,0) instance (NFData (HsModule a)) where-#else-instance (NFData HsModule) where-#endif   rnf = rwhnf  instance Show OccName where show = unpack . printOutputable@@ -239,10 +215,8 @@ instance NFData NodeKey where   rnf = rwhnf -#if MIN_VERSION_ghc(9,5,0) instance NFData HomeModLinkable where   rnf = rwhnf-#endif  instance NFData (HsExpr (GhcPass Renamed)) where     rnf = rwhnf@@ -261,16 +235,3 @@  instance NFData (UniqFM Name [Name]) where   rnf (ufmToIntMap -> m) = rnf m--#if !MIN_VERSION_ghc(9,5,0)-instance NFData DuplicateRecordFields where-  rnf DuplicateRecordFields   = ()-  rnf NoDuplicateRecordFields = ()--instance NFData FieldSelectors where-  rnf FieldSelectors   = ()-  rnf NoFieldSelectors = ()--instance NFData FieldLabel where-  rnf (FieldLabel a b c d) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d-#endif

@@ -27,7 +27,9 @@     dontWriteHieFiles,     disableWarningsAsErrors,     printOutputable,-    getExtensions+    printOutputableOneLine,+    getExtensions,+    stripOccNamePrefix,     ) where  import           Control.Concurrent@@ -62,6 +64,7 @@ import           Ide.PluginUtils                   (unescape) import           System.FilePath +import           Data.Monoid                       (First (..)) import           GHC.Data.EnumSet import           GHC.Data.FastString import           GHC.Data.StringBuffer@@ -262,12 +265,70 @@ --   1. print with a user-friendly style: `a_a4ME` as `a`. --   2. unescape escape sequences of printable unicode characters within a pair of double quotes printOutputable :: Outputable a => a -> T.Text-printOutputable =+printOutputable = printOutputable' printWithoutUniques++printOutputableOneLine :: Outputable a => a -> T.Text+printOutputableOneLine = printOutputable' printWithoutUniquesOneLine++printOutputable' :: Outputable a => (a -> String) -> a -> T.Text+printOutputable' print =     -- IfaceTyLit from GHC.Iface.Type implements Outputable with 'show'.     -- Showing a String escapes non-ascii printable characters. We unescape it here.     -- More discussion at https://github.com/haskell/haskell-language-server/issues/3115.-    unescape . T.pack . printWithoutUniques+    unescape . T.pack . print {-# INLINE printOutputable #-}  getExtensions :: ParsedModule -> [Extension] getExtensions = toList . extensionFlags . ms_hspp_opts . pm_mod_summary++-- | When e.g. DuplicateRecordFields is enabled, compiler generates+-- names like "$sel:accessor:One" and "$sel:accessor:Two" to+-- disambiguate record selectors+-- https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation+stripOccNamePrefix :: T.Text -> T.Text+stripOccNamePrefix name = T.takeWhile (/=':') $ fromMaybe name $+    getFirst $ foldMap (First . (`T.stripPrefix` name))+    occNamePrefixes++-- | Prefixes that can occur in a GHC OccName+occNamePrefixes :: [T.Text]+occNamePrefixes =+  [+    -- long ones+    "$con2tag_"+  , "$tag2con_"+  , "$maxtag_"++  -- four chars+  , "$sel:"+  , "$tc'"++  -- three chars+  , "$dm"+  , "$co"+  , "$tc"+  , "$cp"+  , "$fx"++  -- two chars+  , "$W"+  , "$w"+  , "$m"+  , "$b"+  , "$c"+  , "$d"+  , "$i"+  , "$s"+  , "$f"+  , "$r"+  , "C:"+  , "N:"+  , "D:"+  , "$p"+  , "$L"+  , "$f"+  , "$t"+  , "$c"+  , "$m"+  ]+

@@ -29,6 +29,7 @@   , lookupModuleFile   , BootIdMap   , insertBootId+  , lookupFingerprint   ) where  import           Control.DeepSeq@@ -49,6 +50,8 @@ import           Data.Maybe import           Data.Tuple.Extra                   hiding (first, second) import           Development.IDE.GHC.Compat+import           Development.IDE.GHC.Compat.Util    (Fingerprint)+import qualified Development.IDE.GHC.Compat.Util    as Util import           Development.IDE.GHC.Orphans        () import           Development.IDE.Import.FindImports (ArtifactsLocation (..)) import           Development.IDE.Types.Diagnostics@@ -136,23 +139,35 @@  data DependencyInformation =   DependencyInformation-    { depErrorNodes        :: !(FilePathIdMap (NonEmpty NodeError))+    { depErrorNodes         :: !(FilePathIdMap (NonEmpty NodeError))     -- ^ Nodes that cannot be processed correctly.-    , depModules           :: !(FilePathIdMap ShowableModule)-    , depModuleDeps        :: !(FilePathIdMap FilePathIdSet)+    , depModules            :: !(FilePathIdMap ShowableModule)+    , depModuleDeps         :: !(FilePathIdMap FilePathIdSet)     -- ^ For a non-error node, this contains the set of module immediate dependencies     -- in the same package.-    , depReverseModuleDeps :: !(IntMap IntSet)+    , depReverseModuleDeps  :: !(IntMap IntSet)     -- ^ Contains a reverse mapping from a module to all those that immediately depend on it.-    , depPathIdMap         :: !PathIdMap+    , depPathIdMap          :: !PathIdMap     -- ^ Map from FilePath to FilePathId-    , depBootMap           :: !BootIdMap+    , depBootMap            :: !BootIdMap     -- ^ Map from hs-boot file to the corresponding hs file-    , depModuleFiles       :: !(ShowableModuleEnv FilePathId)+    , depModuleFiles        :: !(ShowableModuleEnv FilePathId)     -- ^ Map from Module to the corresponding non-boot hs file-    , depModuleGraph       :: !ModuleGraph+    , depModuleGraph        :: !ModuleGraph+    , depTransDepsFingerprints :: !(FilePathIdMap Fingerprint)+    -- ^ Map from Module to fingerprint of the transitive dependencies of the module.+    , depTransReverseDepsFingerprints :: !(FilePathIdMap Fingerprint)+    -- ^ Map from FilePathId to the fingerprint of the transitive reverse dependencies of the module.+    , depImmediateReverseDepsFingerprints :: !(FilePathIdMap Fingerprint)+    -- ^ Map from FilePathId to the fingerprint of the immediate reverse dependencies of the module.     } deriving (Show, Generic) +lookupFingerprint :: NormalizedFilePath -> DependencyInformation -> FilePathIdMap Fingerprint -> Maybe Fingerprint+lookupFingerprint fileId DependencyInformation {..} depFingerprintMap =+  do+    FilePathId cur_id <- lookupPathToId depPathIdMap fileId+    IntMap.lookup cur_id depFingerprintMap+ newtype ShowableModule =   ShowableModule {showableModule :: Module}   deriving NFData@@ -228,8 +243,8 @@    SuccessNode _ <> ErrorNode errs   = ErrorNode errs    SuccessNode a <> SuccessNode _    = SuccessNode a -processDependencyInformation :: RawDependencyInformation -> BootIdMap -> ModuleGraph -> DependencyInformation-processDependencyInformation RawDependencyInformation{..} rawBootMap mg =+processDependencyInformation :: RawDependencyInformation -> BootIdMap -> ModuleGraph -> FilePathIdMap Fingerprint -> DependencyInformation+processDependencyInformation RawDependencyInformation{..} rawBootMap mg shallowFingerMap =   DependencyInformation     { depErrorNodes = IntMap.fromList errorNodes     , depModuleDeps = moduleDeps@@ -239,6 +254,9 @@     , depBootMap = rawBootMap     , depModuleFiles = ShowableModuleEnv reverseModuleMap     , depModuleGraph = mg+    , depTransDepsFingerprints = buildTransDepsFingerprintMap moduleDeps shallowFingerMap+    , depTransReverseDepsFingerprints = buildTransDepsFingerprintMap reverseModuleDeps shallowFingerMap+    , depImmediateReverseDepsFingerprints = buildImmediateDepsFingerprintMap reverseModuleDeps shallowFingerMap     }   where resultGraph = buildResultGraph rawImports         (errorNodes, successNodes) = partitionNodeResults $ IntMap.toList resultGraph@@ -398,3 +416,44 @@  instance Show NamedModuleDep where   show NamedModuleDep{..} = show nmdFilePath+++buildImmediateDepsFingerprintMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint+buildImmediateDepsFingerprintMap modulesDeps shallowFingers =+  IntMap.fromList+    $ map+      ( \k ->+          ( k,+            Util.fingerprintFingerprints $+              map+                (shallowFingers IntMap.!)+                (k : IntSet.toList (IntMap.findWithDefault IntSet.empty k modulesDeps))+          )+      )+    $ IntMap.keys shallowFingers++-- | Build a map from file path to its full fingerprint.+-- The fingerprint is depend on both the fingerprints of the file and all its dependencies.+-- This is used to determine if a file has changed and needs to be reloaded.+buildTransDepsFingerprintMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint+buildTransDepsFingerprintMap modulesDeps shallowFingers = go keys IntMap.empty+  where+    keys = IntMap.keys shallowFingers+    go :: [IntSet.Key] -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint+    go keys acc =+      case keys of+        [] -> acc+        k : ks ->+          if IntMap.member k acc+            -- already in the map, so we can skip+            then go ks acc+            -- not in the map, so we need to add it+            else+              let -- get the dependencies of the current key+                  deps = IntSet.toList $ IntMap.findWithDefault IntSet.empty k modulesDeps+                  -- add fingerprints of the dependencies to the accumulator+                  depFingerprints = go deps acc+                  -- combine the fingerprints of the dependencies with the current key+                  combinedFingerprints = Util.fingerprintFingerprints $ shallowFingers IntMap.! k : map (depFingerprints IntMap.!) deps+               in -- add the combined fingerprints to the accumulator+                  go ks (IntMap.insert k combinedFingerprints depFingerprints)

@@ -145,9 +145,8 @@     dflags = hsc_dflags env     import_paths = mapMaybe (mkImportDirs env) comp_info     other_imports =-#if MIN_VERSION_ghc(9,4,0)-      -- On 9.4+ instead of bringing all the units into scope, only bring into scope the units-      -- this one depends on+      -- Instead of bringing all the units into scope, only bring into scope the units+      -- this one depends on.       -- This way if you have multiple units with the same module names, we won't get confused       -- For example if unit a imports module M from unit B, when there is also a module M in unit C,       -- and unit a only depends on unit b, without this logic there is the potential to get confused@@ -163,17 +162,6 @@     units = homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId_ dflags) ue     hpt_deps :: [UnitId]     hpt_deps = homeUnitDepends units-#else-      _import_paths'-#endif--      -- first try to find the module as a file. If we can't find it try to find it in the package-      -- database.-      -- Here the importPaths for the current modules are added to the front of the import paths from the other components.-      -- This is particularly important for Paths_* modules which get generated for every component but unless you use it in-      -- each component will end up being found in the wrong place and cause a multi-cradle match failure.-    _import_paths' = -- import_paths' is only used in GHC < 9.4-            import_paths      toModLocation uid file = liftIO $ do         loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file)

@@ -11,6 +11,7 @@     , Log(..)     , ThreadQueue     , runWithWorkerThreads+    , Setup (..)     ) where  import           Control.Concurrent.STM@@ -81,6 +82,17 @@     LogLspServer msg -> pretty msg     LogServerShutdownMessage -> "Received shutdown message" +data Setup config m a+  = MkSetup+  { doInitialize :: LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either (TResponseError Method_Initialize) (LSP.LanguageContextEnv config, a))+  -- ^ the callback invoked when the language server receives the 'Method_Initialize' request+  , staticHandlers :: LSP.Handlers m+  -- ^ the statically known handlers of the lsp server+  , interpretHandler :: (LanguageContextEnv config, a) -> m <~> IO+  -- ^ how to interpret @m@ to 'IO' and how to lift 'IO' into @m@+  , onExit :: [IO ()]+  -- ^ a list of 'IO' actions that clean up resources and must be run when the server shuts down+  }  runLanguageServer     :: forall config a m. (Show config)@@ -90,18 +102,16 @@     -> Handle -- output     -> config     -> (config -> Value -> Either T.Text config)-    -> (config -> m config ())-    -> (MVar ()-        -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either (TResponseError Method_Initialize) (LSP.LanguageContextEnv config, a)),-               LSP.Handlers (m config),-               (LanguageContextEnv config, a) -> m config <~> IO))+    -> (config -> m ())+    -> (MVar () -> IO (Setup config m a))     -> IO () runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigChange setup = do     -- This MVar becomes full when the server thread exits or we receive exit message from client.     -- LSP server will be canceled when it's full.     clientMsgVar <- newEmptyMVar -    (doInitialize, staticHandlers, interpretHandler) <- setup clientMsgVar+    MkSetup+      { doInitialize, staticHandlers, interpretHandler, onExit } <- setup clientMsgVar      let serverDefinition = LSP.ServerDefinition             { LSP.parseConfig = parseConfig@@ -115,28 +125,29 @@             , LSP.options = modifyOptions options             } -    let lspCologAction :: MonadIO m2 => Colog.LogAction m2 (Colog.WithSeverity LspServerLog)+    let lspCologAction :: forall io. MonadIO io => Colog.LogAction io (Colog.WithSeverity LspServerLog)         lspCologAction = toCologActionWithPrio (cmapWithPrio LogLspServer recorder) -    void $ untilMVar clientMsgVar $-          void $ LSP.runServerWithHandles+    let runServer =+          LSP.runServerWithHandles             lspCologAction             lspCologAction             inH             outH             serverDefinition +    untilMVar clientMsgVar $+        runServer `finally` sequence_ onExit+ setupLSP ::-     forall config err.+     forall config.      Recorder (WithPriority Log)   -> FilePath -- ^ root directory, see Note [Root Directory]   -> (FilePath -> IO FilePath) -- ^ Map root paths to the location of the hiedb for the project   -> LSP.Handlers (ServerM config)   -> (LSP.LanguageContextEnv config -> FilePath -> WithHieDb -> ThreadQueue -> IO IdeState)   -> MVar ()-  -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)),-         LSP.Handlers (ServerM config),-         (LanguageContextEnv config, IdeState) -> ServerM config <~> IO)+  -> IO (Setup config (ServerM config) IdeState) setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar = do   -- Send everything over a channel, since you need to wait until after initialise before   -- LspFuncs is available@@ -171,7 +182,7 @@           cancelled <- readTVar cancelledRequests           unless (reqId `Set.member` cancelled) retry -  let asyncHandlers = mconcat+  let staticHandlers = mconcat         [ userHandlers         , cancelHandler cancelRequest         , exitHandler exit@@ -184,9 +195,11 @@    let interpretHandler (env,  st) = LSP.Iso (LSP.runLspT env . flip (runReaderT . unServerM) (clientMsgChan,st)) liftIO -  pure (doInitialize, asyncHandlers, interpretHandler)+  let onExit = [stopReactorLoop, exit] +  pure MkSetup {doInitialize, staticHandlers, interpretHandler, onExit} + handleInit     :: Recorder (WithPriority Log)     -> FilePath -- ^ root directory, see Note [Root Directory]@@ -266,10 +279,12 @@             liftIO $ f hiedb (ThreadQueue threadQueue sessionRestartTQueue sessionLoaderTQueue)  -- | Runs the action until it ends or until the given MVar is put.+--   It is important, that the thread that puts the 'MVar' is not dropped before it puts the 'MVar' i.e. it should+--   occur as the final action in a 'finally' or 'bracket', because otherwise this thread will finish early (as soon+--   as the thread receives the BlockedIndefinitelyOnMVar exception) --   Rethrows any exceptions.-untilMVar :: MonadUnliftIO m => MVar () -> m () -> m ()-untilMVar mvar io = void $-    waitAnyCancel =<< traverse async [ io , readMVar mvar ]+untilMVar :: MonadUnliftIO m => MVar () -> m a -> m ()+untilMVar mvar io = race_ (readMVar mvar) io  cancelHandler :: (SomeLspId -> IO ()) -> LSP.Handlers (ServerM c) cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \TNotificationMessage{_params=CancelParams{_id}} ->

@@ -12,11 +12,9 @@ ) where  import           Control.Concurrent.Extra                 (withNumCapabilities)-import           Control.Concurrent.MVar                  (newEmptyMVar,+import           Control.Concurrent.MVar                  (MVar, newEmptyMVar,                                                            putMVar, tryReadMVar) import           Control.Concurrent.STM.Stats             (dumpSTMStats)-import           Control.Exception.Safe                   (SomeException,-                                                           displayException) import           Control.Monad.Extra                      (concatMapM, unless,                                                            when) import           Control.Monad.IO.Class                   (liftIO)@@ -320,9 +318,8 @@             ioT <- offsetTime             logWith recorder Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins) -            ideStateVar <- newEmptyMVar-            let getIdeState :: LSP.LanguageContextEnv Config -> FilePath -> WithHieDb -> Shake.ThreadQueue -> IO IdeState-                getIdeState env rootPath withHieDb threadQueue = do+            let getIdeState :: MVar IdeState -> LSP.LanguageContextEnv Config -> FilePath -> WithHieDb -> Shake.ThreadQueue -> IO IdeState+                getIdeState ideStateVar env rootPath withHieDb threadQueue = do                   t <- ioT                   logWith recorder Info $ LogLspStartDuration t                   sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions rootPath (tLoaderQueue threadQueue)@@ -355,9 +352,9 @@                   putMVar ideStateVar ide                   pure ide -            let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsProjectRoot argsGetHieDbLoc (pluginHandlers plugins) getIdeState+            let setup ideStateVar = setupLSP (cmapWithPrio LogLanguageServer recorder) argsProjectRoot argsGetHieDbLoc (pluginHandlers plugins) (getIdeState ideStateVar)                 -- See Note [Client configuration in Rules]-                onConfigChange cfg = do+                onConfigChange ideStateVar cfg = do                   -- TODO: this is nuts, we're converting back to JSON just to get a fingerprint                   let cfgObj = J.toJSON cfg                   mide <- liftIO $ tryReadMVar ideStateVar@@ -370,7 +367,9 @@                             modifyClientSettings ide (const $ Just cfgObj)                             return [toNoFileKey Rules.GetClientSettings] -            runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup+            do+                ideStateVar <- newEmptyMVar+                runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig (onConfigChange ideStateVar) (setup ideStateVar)             dumpSTMStats         Check argFiles -> do           let dir = argsProjectRoot

@@ -114,15 +114,10 @@ -- Drop any explicit imports in ImportDecl if not hidden dropListFromImportDecl :: LImportDecl GhcPs -> LImportDecl GhcPs dropListFromImportDecl iDecl = let-#if MIN_VERSION_ghc(9,5,0)     f d@ImportDecl {ideclImportList} = case ideclImportList of         Just (Exactly, _) -> d {ideclImportList=Nothing}-#else-    f d@ImportDecl {ideclHiding} = case ideclHiding of-        Just (False, _) -> d {ideclHiding=Nothing}-#endif         -- if hiding or Nothing just return d-        _               -> d+        _                 -> d     f x = x     in f <$> iDecl @@ -137,11 +132,11 @@     name <- liftIO $ lookupNameCache nc mod occ     mdkm <- liftIO $ runIdeAction "CompletionResolve.GetDocMap" (shakeExtras ide) $ useWithStaleFast GetDocMap file     let (dm,km) = case mdkm of-          Just (DKMap docMap tyThingMap, _) -> (docMap,tyThingMap)-          Nothing                           -> (mempty, mempty)+          Just (DKMap docMap tyThingMap _argDocMap, _) -> (docMap,tyThingMap)+          Nothing                                      -> (mempty, mempty)     doc <- case lookupNameEnv dm name of       Just doc -> pure $ spanDocToMarkdown doc-      Nothing -> liftIO $ spanDocToMarkdown <$> getDocumentationTryGhc (hscEnv sess) name+      Nothing -> liftIO $ spanDocToMarkdown . fst <$> getDocumentationTryGhc (hscEnv sess) name     typ <- case lookupNameEnv km name of       _ | not needType -> pure Nothing       Just ty -> pure (safeTyThingType ty)

@@ -37,24 +37,26 @@ import           Data.Function                            (on)  import qualified Data.HashSet                             as HashSet-import           Data.Monoid                              (First (..)) import           Data.Ord                                 (Down (Down)) import qualified Data.Set                                 as Set import           Development.IDE.Core.PositionMapping import           Development.IDE.GHC.Compat               hiding (isQual, ppr) import qualified Development.IDE.GHC.Compat               as GHC import           Development.IDE.GHC.Compat.Util-import           Development.IDE.GHC.CoreFile             (occNamePrefixes) import           Development.IDE.GHC.Error import           Development.IDE.GHC.Util import           Development.IDE.Plugin.Completions.Types import           Development.IDE.Spans.LocalBindings import           Development.IDE.Types.Exports import           Development.IDE.Types.Options+import           GHC.Iface.Ext.Types                      (HieAST,+                                                           NodeInfo (..))+import           GHC.Iface.Ext.Utils                      (nodeInfo) import           Ide.PluginUtils                          (mkLspCommand) import           Ide.Types                                (CommandId (..),                                                            IdePlugins (..),                                                            PluginId)+import           Language.Haskell.Syntax.Basic import qualified Language.LSP.Protocol.Lens               as L import           Language.LSP.Protocol.Types import qualified Language.LSP.VFS                         as VFS@@ -74,9 +76,6 @@  -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if MIN_VERSION_ghc(9,5,0)-import           Language.Haskell.Syntax.Basic-#endif  -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int@@ -138,42 +137,23 @@           | pos `isInsideSrcSpan` r = Just TypeContext         goInline _ = Nothing -#if MIN_VERSION_ghc(9,5,0)         importGo :: GHC.LImportDecl GhcPs -> Maybe Context         importGo (L (locA -> r) impDecl)           | pos `isInsideSrcSpan` r           = importInline importModuleName (fmap (fmap reLoc) $ ideclImportList impDecl)-#else-        importGo :: GHC.LImportDecl GhcPs -> Maybe Context-        importGo (L (locA -> r) impDecl)-          | pos `isInsideSrcSpan` r-          = importInline importModuleName (fmap (fmap reLoc) $ ideclHiding impDecl)-#endif           <|> Just (ImportContext importModuleName)            | otherwise = Nothing           where importModuleName = moduleNameString $ unLoc $ ideclName impDecl          -- importInline :: String -> Maybe (Bool,  GHC.Located [LIE GhcPs]) -> Maybe Context-#if MIN_VERSION_ghc(9,5,0)         importInline modName (Just (EverythingBut, L r _))           | pos `isInsideSrcSpan` r = Just $ ImportHidingContext modName           | otherwise = Nothing-#else-        importInline modName (Just (True, L r _))-          | pos `isInsideSrcSpan` r = Just $ ImportHidingContext modName-          | otherwise = Nothing-#endif -#if MIN_VERSION_ghc(9,5,0)         importInline modName (Just (Exactly, L r _))           | pos `isInsideSrcSpan` r = Just $ ImportListContext modName           | otherwise = Nothing-#else-        importInline modName (Just (False, L r _))-          | pos `isInsideSrcSpan` r = Just $ ImportListContext modName-          | otherwise = Nothing-#endif          importInline _ _ = Nothing @@ -261,7 +241,7 @@     compKind = occNameToComKind origName     isTypeCompl = isTcOcc origName     typeText = Nothing-    label = stripPrefix $ printOutputable origName+    label = stripOccNamePrefix $ printOutputable origName     insertText = case isInfix of             Nothing         -> label             Just LeftSide   -> label <> "`"@@ -801,17 +781,6 @@  -- --------------------------------------------------------------------- --- | Under certain circumstance GHC generates some extra stuff that we--- don't want in the autocompleted symbols-    {- When e.g. DuplicateRecordFields is enabled, compiler generates-    names like "$sel:accessor:One" and "$sel:accessor:Two" to disambiguate record selectors-    https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation-    -}--- TODO: Turn this into an alex lexer that discards prefixes as if they were whitespace.-stripPrefix :: T.Text -> T.Text-stripPrefix name = T.takeWhile (/=':') $ fromMaybe name $-  getFirst $ foldMap (First . (`T.stripPrefix` name)) occNamePrefixes- mkRecordSnippetCompItem :: Uri -> Maybe T.Text -> T.Text -> [T.Text] -> Provenance -> Maybe (LImportDecl GhcPs) -> CompItem mkRecordSnippetCompItem uri parent ctxStr compl importedFrom imp = r   where@@ -912,7 +881,9 @@           [] -> Nothing           (x:xs) -> do             let modParts = reverse $ filter (not .T.null) xs-                modName = T.intercalate "." modParts+                -- Must check the prefix is a valid module name, else record dot accesses treat+                -- the record name as a qualName for search and generated imports+                modName = if all (isUpper . T.head) modParts then T.intercalate "." modParts else ""             return $ PosPrefixInfo { fullLine = curLine, prefixScope = modName, prefixText = x, cursorPos = pos }  completionPrefixPos :: PosPrefixInfo -> Position

@@ -16,7 +16,7 @@  import           Control.Concurrent.STM.Stats         (atomically) import           Control.DeepSeq                      (rwhnf)-import           Control.Lens                         ((?~))+import           Control.Lens                         (to, (?~), (^?)) import           Control.Monad                        (mzero) import           Control.Monad.Extra                  (whenMaybe) import           Control.Monad.IO.Class               (MonadIO (liftIO))@@ -25,13 +25,17 @@ import qualified Data.Aeson.Types                     as A import           Data.List                            (find) import qualified Data.Map                             as Map-import           Data.Maybe                           (catMaybes, maybeToList)+import           Data.Maybe                           (catMaybes, isJust,+                                                       maybeToList) import qualified Data.Text                            as T import           Development.IDE                      (FileDiagnostic (..),                                                        GhcSession (..),                                                        HscEnvEq (hscEnv),                                                        RuleResult, Rules, Uri,-                                                       define, srcSpanToRange,+                                                       _SomeStructuredMessage,+                                                       define,+                                                       fdStructuredMessageL,+                                                       srcSpanToRange,                                                        usePropertyAction) import           Development.IDE.Core.Compile         (TcModuleResult (..)) import           Development.IDE.Core.PluginUtils@@ -45,6 +49,10 @@                                                        use) import qualified Development.IDE.Core.Shake           as Shake import           Development.IDE.GHC.Compat+import           Development.IDE.GHC.Compat.Error     (_TcRnMessage,+                                                       _TcRnMissingSignature,+                                                       msgEnvelopeErrorL,+                                                       stripTcRnMessageContext) import           Development.IDE.GHC.Util             (printName) import           Development.IDE.Graph.Classes import           Development.IDE.Types.Location       (Position (Position, _line),@@ -129,9 +137,9 @@           -- dummy type to make sure HLS resolves our lens           [ CodeLens _range Nothing (Just $ toJSON TypeLensesResolve)             | diag <- diags-            , let lspDiag@Diagnostic {_range} = fdLspDiagnostic diag+            , let Diagnostic {_range} = fdLspDiagnostic diag             , fdFilePath diag == nfp-            , isGlobalDiagnostic lspDiag]+            , isGlobalDiagnostic diag]         -- The second option is to generate lenses from the GlobalBindingTypeSig         -- rule. This is the only type that needs to have the range adjusted         -- with PositionMapping.@@ -200,7 +208,7 @@   pure $ InR Null  ---------------------------------------------------------------------------------suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> [(T.Text, TextEdit)]+suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> FileDiagnostic -> [(T.Text, TextEdit)] suggestSignature isQuickFix mGblSigs diag =   maybeToList (suggestGlobalSignature isQuickFix mGblSigs diag) @@ -208,14 +216,19 @@ -- works with a diagnostic, which then calls the secondary function with -- whatever pieces of the diagnostic it needs. This allows the resolve function, -- which no longer has the Diagnostic, to still call the secondary functions.-suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> Maybe (T.Text, TextEdit)-suggestGlobalSignature isQuickFix mGblSigs diag@Diagnostic{_range}+suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> FileDiagnostic -> Maybe (T.Text, TextEdit)+suggestGlobalSignature isQuickFix mGblSigs diag@FileDiagnostic {fdLspDiagnostic = Diagnostic {_range}}   | isGlobalDiagnostic diag =     suggestGlobalSignature' isQuickFix mGblSigs Nothing _range   | otherwise = Nothing -isGlobalDiagnostic :: Diagnostic -> Bool-isGlobalDiagnostic Diagnostic{_message} = _message =~ ("(Top-level binding|Pattern synonym) with no type signature" :: T.Text)+isGlobalDiagnostic :: FileDiagnostic -> Bool+isGlobalDiagnostic diag = diag ^? fdStructuredMessageL+                                  . _SomeStructuredMessage+                                  . msgEnvelopeErrorL+                                  .  _TcRnMessage+                                  . _TcRnMissingSignature+                                & isJust  -- If a PositionMapping is supplied, this function will call -- gblBindingTypeSigToEdit with it to create a TextEdit in the right location.

@@ -67,6 +67,23 @@ import qualified Data.Tree                            as T import           Data.Version                         (showVersion) import           Development.IDE.Types.Shake          (WithHieDb)+import           GHC.Iface.Ext.Types                  (EvVarSource (..),+                                                       HieAST (..),+                                                       HieASTs (..),+                                                       HieArgs (..),+                                                       HieType (..), Identifier,+                                                       IdentifierDetails (..),+                                                       NodeInfo (..), Scope,+                                                       Span)+import           GHC.Iface.Ext.Utils                  (EvidenceInfo (..),+                                                       RefMap, getEvidenceTree,+                                                       getScopeFromContext,+                                                       hieTypeToIface,+                                                       isEvidenceContext,+                                                       isEvidenceUse,+                                                       isOccurrence, nodeInfo,+                                                       recoverFullType,+                                                       selectSmallestContaining) import           HieDb                                hiding (pointCommand,                                                        withHieDb) import           System.Directory                     (doesFileExist)@@ -113,7 +130,7 @@  getNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name] getNamesAtPoint hf pos mapping =-  concat $ pointCommand hf posFile (rights . M.keys . getNodeIds)+  concat $ pointCommand hf posFile (rights . M.keys . getSourceNodeIds)     where       posFile = fromMaybe pos $ fromCurrentPosition mapping pos @@ -239,7 +256,7 @@   -> HscEnv   -> Position   -> IO (Maybe (Maybe Range, [T.Text]))-atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (DKMap dm km) env pos =+atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (DKMap dm km _am) env pos =     listToMaybe <$> sequence (pointCommand hf pos hoverInfo)   where     -- Hover info for values/data@@ -488,7 +505,7 @@ instanceLocationsAtPoint withHieDb lookupModule _ideOptions pos (HAR _ ast _rm _ _) =   let ns = concat $ pointCommand ast pos (M.keys . getNodeIds)       evTrees = mapMaybe (eitherToMaybe >=> getEvidenceTree _rm) ns-      evNs = concatMap (map (evidenceVar) . T.flatten) evTrees+      evNs = concatMap (map evidenceVar . T.flatten) evTrees    in fmap (nubOrd . concat) $ mapMaybeM         (nameToLocation withHieDb lookupModule)         evNs

@@ -13,6 +13,7 @@ , spanDocToMarkdownForTest , DocMap , TyThingMap+, ArgDocMap , srcSpanToMdLink ) where @@ -29,6 +30,7 @@ import           System.FilePath  import           Control.Lens+import           Data.IntMap                  (IntMap) import           Development.IDE.GHC.Compat import           Development.IDE.GHC.Orphans  () import qualified Language.LSP.Protocol.Lens   as JL@@ -36,13 +38,10 @@  type DocMap = NameEnv SpanDoc type TyThingMap = NameEnv TyThing+type ArgDocMap = NameEnv (IntMap SpanDoc)  -- | Shows IEWrappedName, without any modifier, qualifier or unique identifier.-#if MIN_VERSION_ghc(9,5,0) unqualIEWrapName :: IEWrappedName GhcPs -> T.Text-#else-unqualIEWrapName :: IEWrappedName RdrName -> T.Text-#endif unqualIEWrapName = printOutputable . rdrNameOcc . ieWrappedName  -- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs@@ -194,11 +193,10 @@ haddockToMarkdown (H.DocDefList things)   = '\n' : (unlines $ map (\(term, defn) -> "+ **" ++ haddockToMarkdown term ++ "**: " ++ haddockToMarkdown defn) things) --- we cannot render math by default-haddockToMarkdown (H.DocMathInline _)-  = "*cannot render inline math formula*"-haddockToMarkdown (H.DocMathDisplay _)-  = "\n\n*cannot render display math formula*\n\n"+haddockToMarkdown (H.DocMathInline s)+  = "`" ++ s ++ "`"+haddockToMarkdown (H.DocMathDisplay s)+  = "\n```latex\n" ++ s ++ "\n```\n"  -- TODO: render tables haddockToMarkdown (H.DocTable _t)

@@ -16,6 +16,7 @@ import           Control.Monad.IO.Class import           Data.Either import           Data.Foldable+import           Data.IntMap                     (IntMap) import           Data.List.Extra import qualified Data.Map                        as M import           Data.Maybe@@ -28,6 +29,7 @@ import           Development.IDE.GHC.Error import           Development.IDE.GHC.Util        (printOutputable) import           Development.IDE.Spans.Common+import           GHC.Iface.Ext.Utils             (RefMap) import           Language.LSP.Protocol.Types     (filePathToUri, getUri) import           Prelude                         hiding (mod) import           System.Directory@@ -41,21 +43,27 @@   -> IO DocAndTyThingMap mkDocMap env rm this_mod =   do-     (Just Docs{docs_decls = UniqMap this_docs}) <- extractDocs (hsc_dflags env) this_mod+     (Just Docs{docs_decls = UniqMap this_docs, docs_args = UniqMap this_arg_docs}) <- extractDocs (hsc_dflags env) this_mod      d <- foldrM getDocs (fmap (\(_, x) -> (map hsDocString x) `SpanDocString` SpanDocUris Nothing Nothing) this_docs) names      k <- foldrM getType (tcg_type_env this_mod) names-     pure $ DKMap d k+     a <- foldrM getArgDocs (fmap (\(_, m) -> fmap (\x -> [hsDocString x] `SpanDocString` SpanDocUris Nothing Nothing) m) this_arg_docs) names+     pure $ DKMap d k a   where     getDocs n nameMap       | maybe True (mod ==) $ nameModule_maybe n = pure nameMap -- we already have the docs in this_docs, or they do not exist       | otherwise = do-      doc <- getDocumentationTryGhc env n+      (doc, _argDoc) <- getDocumentationTryGhc env n       pure $ extendNameEnv nameMap n doc     getType n nameMap       | Nothing <- lookupNameEnv nameMap n       = do kind <- lookupKind env n            pure $ maybe nameMap (extendNameEnv nameMap n) kind       | otherwise = pure nameMap+    getArgDocs n nameMap+      | maybe True (mod ==) $ nameModule_maybe n = pure nameMap+      | otherwise = do+      (_doc, argDoc) <- getDocumentationTryGhc env n+      pure $ extendNameEnv nameMap n argDoc     names = rights $ S.toList idents     idents = M.keysSet rm     mod = tcg_mod this_mod@@ -64,23 +72,23 @@ lookupKind env =     fmap (fromRight Nothing) . catchSrcErrors (hsc_dflags env) "span" . lookupName env -getDocumentationTryGhc :: HscEnv -> Name -> IO SpanDoc+getDocumentationTryGhc :: HscEnv -> Name -> IO (SpanDoc, IntMap SpanDoc) getDocumentationTryGhc env n =-  (fromMaybe emptySpanDoc . listToMaybe <$> getDocumentationsTryGhc env [n])-    `catch` (\(_ :: IOEnvFailure) -> pure emptySpanDoc)+  (fromMaybe (emptySpanDoc, mempty) . listToMaybe <$> getDocumentationsTryGhc env [n])+    `catch` (\(_ :: IOEnvFailure) -> pure (emptySpanDoc, mempty)) -getDocumentationsTryGhc :: HscEnv -> [Name] -> IO [SpanDoc]+getDocumentationsTryGhc :: HscEnv -> [Name] -> IO [(SpanDoc, IntMap SpanDoc)] getDocumentationsTryGhc env names = do   resOr <- catchSrcErrors (hsc_dflags env) "docs" $ getDocsBatch env names   case resOr of       Left _    -> return []       Right res -> zipWithM unwrap res names   where-    unwrap (Right (Just docs, _)) n = SpanDocString (map hsDocString docs) <$> getUris n+    unwrap (Right (Just docs, argDocs)) n = (\uris -> (SpanDocString (map hsDocString docs) uris, fmap (\x -> SpanDocString [hsDocString x] uris) argDocs)) <$> getUris n     unwrap _ n                      = mkSpanDocText n      mkSpanDocText name =-      SpanDocText [] <$> getUris name+      (\uris -> (SpanDocText [] uris, mempty)) <$> getUris name      -- Get the uris to the documentation and source html pages if they exist     getUris name = do

@@ -17,15 +17,16 @@ import qualified Data.List                      as L import qualified Data.Map                       as M import qualified Data.Set                       as S+import           GHC.Iface.Ext.Types            (IdentifierDetails (..),+                                                 Scope (..))+import           GHC.Iface.Ext.Utils            (RefMap, getBindSiteFromContext,+                                                 getScopeFromContext)+ import           Development.IDE.GHC.Compat     (Name, NameEnv, RealSrcSpan,-                                                 RefMap, Scope (..), Type,-                                                 getBindSiteFromContext,-                                                 getScopeFromContext, identInfo,-                                                 identType, isSystemName,+                                                 Type, isSystemName,                                                  nonDetNameEnvElts,                                                  realSrcSpanEnd,                                                  realSrcSpanStart, unitNameEnv)- import           Development.IDE.GHC.Error import           Development.IDE.Types.Location 

@@ -24,9 +24,7 @@   ideErrorFromLspDiag,   showDiagnostics,   showDiagnosticsColored,-#if MIN_VERSION_ghc(9,5,0)   showGhcCode,-#endif   IdeResultNoDiagnosticsEarlyCutoff,   attachReason,   attachedReason) where@@ -45,17 +43,11 @@                                                  flagSpecName, wWarningFlags) import           Development.IDE.Types.Location import           GHC.Generics-#if MIN_VERSION_ghc(9,5,0) import           GHC.Types.Error                (DiagnosticCode (..),                                                  DiagnosticReason (..),                                                  diagnosticCode,                                                  diagnosticReason,                                                  errMsgDiagnostic)-#else-import           GHC.Types.Error                (DiagnosticReason (..),-                                                 diagnosticReason,-                                                 errMsgDiagnostic)-#endif import           Language.LSP.Diagnostics import           Language.LSP.Protocol.Lens     (data_) import           Language.LSP.Protocol.Types    as LSP@@ -110,30 +102,25 @@       fdLspDiagnostic =         lspDiag           & attachReason (fmap (diagnosticReason . errMsgDiagnostic) mbOrigMsg)-          & setGhcCode mbOrigMsg+          & attachDiagnosticCode ((diagnosticCode . errMsgDiagnostic) =<< mbOrigMsg)   in   FileDiagnostic {..} --- | Set the code of the 'LSP.Diagnostic' to the GHC diagnostic code which is linked+-- | Set the code of the 'LSP.Diagnostic' to the GHC diagnostic code, and include the link -- to https://errors.haskell.org/.-setGhcCode :: Maybe (MsgEnvelope GhcMessage) -> LSP.Diagnostic -> LSP.Diagnostic-#if MIN_VERSION_ghc(9,5,0)-setGhcCode mbOrigMsg diag =-  let mbGhcCode = do-          origMsg <- mbOrigMsg-          code <- diagnosticCode (errMsgDiagnostic origMsg)-          pure (InR (showGhcCode code))-  in-  diag { _code = mbGhcCode <|> _code diag }-#else-setGhcCode _ diag = diag-#endif+attachDiagnosticCode :: Maybe DiagnosticCode -> LSP.Diagnostic -> LSP.Diagnostic+attachDiagnosticCode Nothing diag = diag+attachDiagnosticCode (Just code) diag =+    let+        textualCode = showGhcCode code+        codeDesc = LSP.CodeDescription{ _href = Uri $ "https://errors.haskell.org/messages/" <> textualCode }+    in diag { _code = Just (InR textualCode), _codeDescription = Just codeDesc}  #if MIN_VERSION_ghc(9,9,0) -- DiagnosticCode only got a show instance in 9.10.1 showGhcCode :: DiagnosticCode -> T.Text showGhcCode = T.pack . show-#elif MIN_VERSION_ghc(9,5,0)+#else showGhcCode :: DiagnosticCode -> T.Text showGhcCode (DiagnosticCode prefix c) = T.pack $ prefix ++ "-" ++ printf "%05d" c #endif

@@ -68,10 +68,12 @@   , 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