packages feed

ghcide 1.9.1.0 → 1.10.0.0

raw patch · 34 files changed

+757/−233 lines, 34 filesdep −hsloggerdep ~hie-biosdep ~hiedbdep ~prettyprinterPVP ok

version bump matches the API change (PVP)

Dependencies removed: hslogger

Dependency ranges changed: hie-bios, hiedb, prettyprinter

API changes (from Hackage documentation)

- Development.IDE: priorityToHsLoggerPriority :: Priority -> Priority
- Development.IDE.GHC.Compat.Outputable: mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified
- Development.IDE.Types.Logger: priorityToHsLoggerPriority :: Priority -> Priority
+ Development.IDE: GHC96 :: GhcVersion
+ Development.IDE: makeDefaultHandleRecorder :: MonadIO m => Maybe [LoggingColumn] -> Lock -> Handle -> m (Recorder (WithPriority (Doc a)))
+ Development.IDE.Core.Actions: lookupMod :: HieDbWriter -> FilePath -> ModuleName -> Unit -> Bool -> MaybeT IdeAction Uri
+ Development.IDE.Core.Rules: currentLinkables :: Action (ModuleEnv UTCTime)
+ Development.IDE.Core.Shake: instance GHC.Base.Semigroup (m a) => GHC.Base.Semigroup (Control.Monad.Trans.Reader.ReaderT r m a)
+ Development.IDE.Core.Shake: instance GHC.Base.Semigroup a => GHC.Base.Semigroup (Development.IDE.Core.Shake.IdeAction a)
+ Development.IDE.GHC.Compat: GHC96 :: GhcVersion
+ Development.IDE.GHC.Compat: extract_cons :: a -> a
+ Development.IDE.GHC.Compat: loadModulesHome :: [HomeModInfo] -> HscEnv -> HscEnv
+ Development.IDE.GHC.Compat: recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int
+ Development.IDE.GHC.Compat.Core: emptyHomeModInfoLinkable :: Maybe Linkable
+ Development.IDE.GHC.Compat.Core: field_label :: a -> a
+ Development.IDE.GHC.Compat.Core: homeModInfoByteCode :: HomeModInfo -> Maybe Linkable
+ Development.IDE.GHC.Compat.Core: homeModInfoObject :: HomeModInfo -> Maybe Linkable
+ Development.IDE.GHC.Compat.Core: justBytecode :: Linkable -> Maybe Linkable
+ Development.IDE.GHC.Compat.Core: justObjects :: Linkable -> Maybe Linkable
+ Development.IDE.GHC.Compat.Core: mkCgInteractiveGuts :: CgGuts -> CgGuts
+ Development.IDE.GHC.Compat.Outputable: SourceError :: ErrorMessages -> SourceError
+ Development.IDE.GHC.Compat.Outputable: newtype SourceError
+ Development.IDE.GHC.Compat.Outputable: textDoc :: String -> SDoc
+ Development.IDE.GHC.CoreFile: occNamePrefixes :: [Text]
+ Development.IDE.Spans.AtPoint: nameToLocation :: MonadIO m => WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])
+ Development.IDE.Spans.AtPoint: type LookupModule m = FilePath -> ModuleName -> Unit -> Bool -> MaybeT m Uri
+ Development.IDE.Types.Logger: makeDefaultHandleRecorder :: MonadIO m => Maybe [LoggingColumn] -> Lock -> Handle -> m (Recorder (WithPriority (Doc a)))
- Development.IDE: makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> Priority -> m (Recorder (WithPriority (Doc a)))
+ Development.IDE: makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> m (Recorder (WithPriority (Doc a)))
- Development.IDE: withDefaultRecorder :: MonadUnliftIO m => Maybe FilePath -> Maybe [LoggingColumn] -> Priority -> (Recorder (WithPriority (Doc d)) -> m a) -> m a
+ Development.IDE: withDefaultRecorder :: MonadUnliftIO m => Maybe FilePath -> Maybe [LoggingColumn] -> (Recorder (WithPriority (Doc d)) -> m a) -> m a
- Development.IDE.Types.Logger: makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> Priority -> m (Recorder (WithPriority (Doc a)))
+ Development.IDE.Types.Logger: makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> m (Recorder (WithPriority (Doc a)))
- Development.IDE.Types.Logger: withDefaultRecorder :: MonadUnliftIO m => Maybe FilePath -> Maybe [LoggingColumn] -> Priority -> (Recorder (WithPriority (Doc d)) -> m a) -> m a
+ Development.IDE.Types.Logger: withDefaultRecorder :: MonadUnliftIO m => Maybe FilePath -> Maybe [LoggingColumn] -> (Recorder (WithPriority (Doc d)) -> m a) -> m a

Files

exe/Main.hs view
@@ -77,7 +77,7 @@     -- stderr recorder just for plugin cli commands     pluginCliRecorder <-       cmapWithPrio pretty-      <$> makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) Info+      <$> makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn])      let hlsPlugins = pluginDescToIdePlugins (GhcIde.descriptors (cmapWithPrio LogGhcIde pluginCliRecorder))     -- WARNING: If you write to stdout before runLanguageServer@@ -94,7 +94,7 @@      let minPriority = if argsVerbose then Debug else Info -    docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) minPriority+    docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn])      (lspLogRecorder, cb1) <- Logger.withBacklog Logger.lspClientLogRecorder     (lspMessageRecorder, cb2) <- Logger.withBacklog Logger.lspClientMessageRecorder
ghcide.cabal view
@@ -2,7 +2,7 @@ build-type:         Simple category:           Development name:               ghcide-version:            1.9.1.0+version:            1.10.0.0 license:            Apache-2.0 license-file:       LICENSE author:             Digital Asset and Ghcide contributors@@ -68,14 +68,14 @@         hls-plugin-api ^>= 1.6,         lens,         list-t,-        hiedb == 0.4.2.*,+        hiedb == 0.4.3.*,         lsp-types ^>= 1.6.0.0,         lsp ^>= 1.6.0.0 ,         mtl,         optparse-applicative,         parallel,         prettyprinter-ansi-terminal,-        prettyprinter >= 1.6,+        prettyprinter >= 1.7,         random,         regex-tdfa >= 1.3.1.0,         text-rope,@@ -91,7 +91,6 @@         transformers,         unordered-containers >= 0.2.10.0,         vector,-        hslogger,         Diff ^>=0.4.0,         vector,         opentelemetry >=0.6.1,@@ -103,7 +102,7 @@         ghc-check >=0.5.0.8,         ghc-paths,         cryptohash-sha1 >=0.11.100 && <0.12,-        hie-bios ^>= 0.11.0,+        hie-bios == 0.12.0,         -- implicit-hie 0.1.3.0 introduced an unexpected behavioral change.         -- https://github.com/Avi-D-coder/implicit-hie/issues/50         -- to make sure ghcide behaves in a desirable way, we put implicit-hie
session-loader/Development/IDE/Session.hs view
@@ -262,7 +262,7 @@   let log = logWith recorder   hieYaml <- findCradle def rootDir   cradle <- loadCradle def hieYaml rootDir-  libDirRes <- getRuntimeGhcLibDir cradle+  libDirRes <- getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio LogHieBios recorder)) cradle   case libDirRes of       CradleSuccess libdir -> pure $ Just $ LibDir libdir       CradleFail err -> do@@ -725,7 +725,7 @@     case cradleRes of         CradleSuccess r -> do             -- Now get the GHC lib dir-            libDirRes <- getRuntimeGhcLibDir cradle+            libDirRes <- getRuntimeGhcLibDir logger cradle             case libDirRes of                 -- This is the successful path                 CradleSuccess libDir -> pure (Right (r, libDir))
src/Development/IDE/Core/Actions.hs view
@@ -10,6 +10,7 @@ , useNoFileE , usesE , workspaceSymbols+, lookupMod ) where  import           Control.Monad.Reader
src/Development/IDE/Core/Compile.hs view
@@ -36,6 +36,7 @@   , TypecheckHelpers(..)   ) where +import           Control.Monad.IO.Class import           Control.Concurrent.Extra import           Control.Concurrent.STM.Stats      hiding (orElse) import           Control.DeepSeq                   (NFData (..), force, liftRnf,@@ -133,6 +134,11 @@ import qualified GHC.Types.Error                   as Error #endif +#if MIN_VERSION_ghc(9,5,0)+import GHC.Driver.Config.CoreToStg.Prep+import GHC.Core.Lint.Interactive+#endif+ -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'. parseModule     :: IdeOptions@@ -467,7 +473,11 @@       tcGblEnv = tmrTypechecked tcm   details <- makeSimpleDetails hsc_env_tmp tcGblEnv   sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv-  iface' <- mkIfaceTc hsc_env_tmp sf details ms tcGblEnv+  iface' <- mkIfaceTc hsc_env_tmp sf details ms+#if MIN_VERSION_ghc(9,5,0)+                      Nothing+#endif+                      tcGblEnv   let iface = iface' { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface]   pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing @@ -482,20 +492,19 @@       ms = pm_mod_summary $ tmrParsed tcm       tcGblEnv = tmrTypechecked tcm -  (details, mguts) <--    if mg_hsc_src simplified_guts == HsBootFile-    then do-        details <- mkBootModDetailsTc session tcGblEnv-        pure (details, Nothing)-    else do+  (details, guts) <- do         -- write core file         -- give variables unique OccNames         tidy_opts <- initTidyOpts session         (guts, details) <- tidyProgram tidy_opts simplified_guts-        pure (details, Just guts)+        pure (details, guts)  #if MIN_VERSION_ghc(9,0,1)-  let !partial_iface = force $ mkPartialIface session details+  let !partial_iface = force $ mkPartialIface session+#if MIN_VERSION_ghc(9,5,0)+                                              (cg_binds guts)+#endif+                                              details #if MIN_VERSION_ghc(9,3,0)                                               ms #endif@@ -513,9 +522,7 @@   let final_iface = final_iface' {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface]    -- Write the core file now-  core_file <- case mguts of-    Nothing -> pure Nothing -- no guts, likely boot file-    Just guts -> do+  core_file <- do         let core_fp  = ml_core_file $ ms_location ms             core_file = codeGutsToCoreFile iface_hash guts             iface_hash = getModuleHash final_iface@@ -538,13 +545,23 @@     Just (core, _) | optVerifyCoreFile -> do       let core_fp = ml_core_file $ ms_location ms       traceIO $ "Verifying " ++ core_fp-      let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = case mguts of-            Nothing -> error "invariant optVerifyCoreFile: guts must exist if linkable exists"-            Just g -> g+      let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = guts           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       -- get translated to STG/Bytecode #if MIN_VERSION_ghc(9,3,0)@@ -552,13 +569,13 @@ #else       (prepd_binds , _) #endif-        <- corePrepPgm session mod (ms_location ms) unprep_binds data_tycons+        <- corePrep unprep_binds data_tycons #if MIN_VERSION_ghc(9,3,0)       prepd_binds' #else       (prepd_binds', _) #endif-        <- corePrepPgm session mod (ms_location ms) unprep_binds' data_tycons+        <- corePrep unprep_binds' data_tycons       let binds  = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds           binds' = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds' @@ -683,7 +700,7 @@                       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 guts+                      hscInteractive session (mkCgInteractiveGuts guts)                                 (ms_location summary')               let unlinked = BCOs bytecode sptEntries               let linkable = LM time (ms_mod summary) [unlinked]@@ -1008,28 +1025,6 @@     . (("Error during " ++ T.unpack source) ++) . show @SomeException     ] --- | Load modules, quickly. Input doesn't need to be desugared.--- A module must be loaded before dependent modules can be typechecked.--- This variant of loadModuleHome will *never* cause recompilation, it just--- modifies the session.--- The order modules are loaded is important when there are hs-boot files.--- In particular you should make sure to load the .hs version of a file after the--- .hs-boot version.-loadModulesHome-    :: [HomeModInfo]-    -> HscEnv-    -> HscEnv-loadModulesHome mod_infos e =-#if MIN_VERSION_ghc(9,3,0)-  hscUpdateHUG (\hug -> foldl' (flip addHomeModInfoToHug) hug mod_infos) (e { hsc_type_env_vars = emptyKnotVars })-#else-  let !new_modules = addListToHpt (hsc_HPT e) [(mod_name x, x) | x <- mod_infos]-  in e { hsc_HPT = new_modules-       , hsc_type_env_var = Nothing-       }-    where-      mod_name = moduleName . mi_module . hm_iface-#endif  -- Merge the HPTs, module graphs and FinderCaches -- See Note [GhcSessionDeps] in Development.IDE.Core.Rules@@ -1242,7 +1237,9 @@        => 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,0,1)+#if MIN_VERSION_ghc(9,5,0)+       -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs))+#elif MIN_VERSION_ghc(9,0,1)        -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule)) #else        -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs))@@ -1574,13 +1571,13 @@ mkDetailsFromIface :: HscEnv -> ModIface -> IO ModDetails mkDetailsFromIface session iface = do   fixIO $ \details -> do-    let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details Nothing)) session+    let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details emptyHomeModInfoLinkable)) session     initIfaceLoad hsc' (typecheckIface iface)  coreFileToCgGuts :: HscEnv -> ModIface -> ModDetails -> CoreFile -> IO CgGuts coreFileToCgGuts session iface details core_file = do   let act hpt = addToHpt hpt (moduleName this_mod)-                             (HomeModInfo iface details Nothing)+                             (HomeModInfo iface details emptyHomeModInfoLinkable)       this_mod = mi_module iface   types_var <- newIORef (md_types details)   let hsc_env' = hscUpdateHPT act (session {@@ -1594,7 +1591,10 @@       -- Implicit binds aren't saved, so we need to regenerate them ourselves.   let implicit_binds = concatMap getImplicitBinds tyCons       tyCons = typeEnvTyCons (md_types details)-#if MIN_VERSION_ghc(9,3,0)+#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 (emptyHpcInfo False) Nothing []+#elif MIN_VERSION_ghc(9,3,0)   pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] #else   pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) NoStubs [] [] (emptyHpcInfo False) Nothing []@@ -1604,9 +1604,9 @@ coreFileToLinkable linkableType session ms iface details core_file t = do   cgi_guts <- coreFileToCgGuts session iface details core_file   (warns, lb) <- case linkableType of-    BCOLinkable    -> generateByteCode (CoreFileTime t) session ms cgi_guts-    ObjectLinkable -> generateObjectCode session ms cgi_guts-  pure (warns, HomeModInfo iface details . Just <$> lb)+    BCOLinkable    -> fmap (maybe emptyHomeModInfoLinkable justBytecode) <$> generateByteCode (CoreFileTime t) session ms cgi_guts+    ObjectLinkable -> fmap (maybe emptyHomeModInfoLinkable justObjects) <$> generateObjectCode session ms cgi_guts+  pure (warns, Just $ HomeModInfo iface details lb) -- TODO wz1000 handle emptyHomeModInfoLinkable  -- | Non-interactive, batch version of 'InteractiveEval.getDocs'. --   The interactive paths create problems in ghc-lib builds
src/Development/IDE/Core/Preprocessor.hs view
@@ -204,7 +204,7 @@             -- Happy case, file is not modified, so run CPP on it in-place             -- which also makes things like relative #include files work             -- and means location information is correct-            doCpp env1 True filename out+            doCpp env1 filename out             liftIO $ Util.hGetStringBuffer out          Just contents -> do@@ -218,7 +218,7 @@             let inp = dir </> "___GHCIDE_MAGIC___"             withBinaryFile inp WriteMode $ \h ->                 hPutStringBuffer h contents-            doCpp env2 True inp out+            doCpp env2 inp out              -- Fix up the filename in lines like:             -- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___"
src/Development/IDE/Core/Rules.hs view
@@ -57,11 +57,13 @@     typeCheckRuleDefinition,     getRebuildCount,     getSourceFileSource,+    currentLinkables,     GhcSessionDepsConfig(..),     Log(..),     DisplayTHWarning(..),     ) where +import           Control.Applicative import           Control.Concurrent.Async                     (concurrently) import           Control.Concurrent.Strict import           Control.DeepSeq@@ -160,6 +162,9 @@ import GHC.Unit.Module.Graph import GHC.Unit.Env #endif+#if MIN_VERSION_ghc(9,5,0)+import GHC.Unit.Home.ModInfo+#endif  data Log   = LogShake Shake.Log@@ -775,7 +780,7 @@              depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps             ifaces <- uses_ GetModIface deps-            let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails Nothing) ifaces+            let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces #if MIN_VERSION_ghc(9,3,0)             -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph             -- also points to all the direct descendants of the current module. To get the keys for the descendants@@ -1099,10 +1104,10 @@               else pure Nothing             case mobj_time of               Just obj_t-                | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (Just $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file]))+                | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file]))               _ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) ms hirModIface hirModDetails bin_core (error "object doesn't have time")         -- Record the linkable so we know not to unload it, and unload old versions-        whenJust (hm_linkable =<< hmi) $ \(LM time mod _) -> do+        whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) $ \(LM time mod _) -> do             compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction             liftIO $ modifyVar compiledLinkables $ \old -> do               let !to_keep = extendModuleEnv old mod time
src/Development/IDE/Core/Shake.hs view
@@ -307,13 +307,17 @@  getShakeExtras :: Action ShakeExtras getShakeExtras = do+    -- Will fail the action with a pattern match failure, but be caught     Just x <- getShakeExtra @ShakeExtras     return x  getShakeExtrasRules :: Rules ShakeExtras getShakeExtrasRules = do-    Just x <- getShakeExtraRules @ShakeExtras-    return x+    mExtras <- getShakeExtraRules @ShakeExtras+    case mExtras of+      Just x  -> return x+      -- This will actually crash HLS+      Nothing -> liftIO $ fail "missing ShakeExtras"  -- | Returns the client configuration, creating a build dependency. --   You should always use this function when accessing client configuration@@ -978,7 +982,10 @@ -- -- Run via 'runIdeAction'. newtype IdeAction a = IdeAction { runIdeActionT  :: (ReaderT ShakeExtras IO) a }-    deriving newtype (MonadReader ShakeExtras, MonadIO, Functor, Applicative, Monad)+    deriving newtype (MonadReader ShakeExtras, MonadIO, Functor, Applicative, Monad, Semigroup)++-- https://hub.darcs.net/ross/transformers/issue/86+deriving instance (Semigroup (m a)) => Semigroup (ReaderT r m a)  runIdeAction :: String -> ShakeExtras -> IdeAction a -> IO a runIdeAction _herald s i = runReaderT (runIdeActionT i) s
src/Development/IDE/GHC/CPP.hs view
@@ -15,6 +15,7 @@ module Development.IDE.GHC.CPP(doCpp, addOptP) where +import           Control.Monad import           Development.IDE.GHC.Compat      as Compat import           Development.IDE.GHC.Compat.Util import           GHC@@ -26,6 +27,11 @@ import qualified DriverPipeline                  as Pipeline import           ToolSettings #endif++#if MIN_VERSION_ghc(9,5,0)+import qualified GHC.SysTools.Cpp                as Pipeline+#endif+ #if MIN_VERSION_ghc(9,3,0) import qualified GHC.Driver.Pipeline.Execute     as Pipeline #endif@@ -39,11 +45,24 @@     fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss     alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) } -doCpp :: HscEnv -> Bool -> FilePath -> FilePath -> IO ()-doCpp env raw input_fn output_fn =-#if MIN_VERSION_ghc (9,2,0)-    Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) raw input_fn output_fn+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)+    let cpp_opts = Pipeline.CppOpts+                 { cppUseCc = False+                 , cppLinePragmas = True+                 } in #else-    Pipeline.doCpp (hsc_dflags env) raw input_fn output_fn+    let cpp_opts = True in+#endif++#if MIN_VERSION_ghc(9,2,0)+    Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) cpp_opts input_fn output_fn+#else+    Pipeline.doCpp (hsc_dflags env) cpp_opts input_fn output_fn #endif 
src/Development/IDE/GHC/Compat.hs view
@@ -104,6 +104,7 @@     icInteractiveModule,     HomePackageTable,     lookupHpt,+    loadModulesHome, #if MIN_VERSION_ghc(9,3,0)     Dependencies(dep_direct_mods), #else@@ -134,6 +135,11 @@     coreExprToBCOs,     linkExpr, #endif+    extract_cons,+    recDotDot,+#if MIN_VERSION_ghc(9,5,0)+    XModulePs(..),+#endif     ) where  import           Data.Bifunctor@@ -156,7 +162,15 @@   #if MIN_VERSION_ghc(9,0,0)+#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)+#else import           GHC.Core.Lint                         (lintInteractiveExpr)+#endif import qualified GHC.Core.Opt.Pipeline                 as GHC import           GHC.Core.Tidy                         (tidyExpr) import           GHC.CoreToStg.Prep                    (corePrepPgm)@@ -309,7 +323,11 @@        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@@ -342,7 +360,13 @@             this_mod ml prepd_binds = do     let (stg_binds, denv, cost_centre_info)          = {-# SCC "Core2Stg" #-}-           coreToStg dflags this_mod ml prepd_binds+           coreToStg+#if MIN_VERSION_ghc(9,5,0)+             (initCoreToStgOpts dflags)+#else+             dflags+#endif+             this_mod ml prepd_binds  #if MIN_VERSION_ghc(9,4,2)     (stg_binds2,_)@@ -351,8 +375,14 @@ #endif         <- {-# SCC "Stg2Stg" #-} #if MIN_VERSION_ghc(9,3,0)-           stg2stg logger ictxt (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds+           stg2stg logger+#if MIN_VERSION_ghc(9,5,0)+                   (interactiveInScope ictxt) #else+                   ictxt+#endif+                   (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds+#else            stg2stg logger dflags ictxt this_mod stg_binds #endif @@ -379,10 +409,21 @@  simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr #if MIN_VERSION_ghc(9,0,0)+#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 exp = do+  cfg <- initCorePrepConfig env+  GHC.corePrepExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) cfg exp+#else corePrepExpr _ = GHC.corePrepExpr+#endif+ #else simplifyExpr df _ = GHC.simplifyExpr df #endif@@ -574,13 +615,16 @@   | GHC90   | GHC92   | GHC94+  | GHC96   deriving (Eq, Ord, Show)  ghcVersionStr :: String ghcVersionStr = VERSION_ghc  ghcVersion :: GhcVersion-#if MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)+#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)+ghcVersion = GHC96+#elif MIN_VERSION_GLASGOW_HASKELL(9,4,0,0) ghcVersion = GHC94 #elif MIN_VERSION_GLASGOW_HASKELL(9,2,0,0) ghcVersion = GHC92@@ -652,4 +696,41 @@     (line_end, col_end)     = max (srcSpanEndLine span1, srcSpanEndCol span1)                                   (srcSpanEndLine span2, srcSpanEndCol span2)     file = srcSpanFile span1+#endif++-- | Load modules, quickly. Input doesn't need to be desugared.+-- A module must be loaded before dependent modules can be typechecked.+-- This variant of loadModuleHome will *never* cause recompilation, it just+-- modifies the session.+-- The order modules are loaded is important when there are hs-boot files.+-- In particular you should make sure to load the .hs version of a file after the+-- .hs-boot version.+loadModulesHome+    :: [HomeModInfo]+    -> HscEnv+    -> HscEnv+loadModulesHome mod_infos e =+#if MIN_VERSION_ghc(9,3,0)+  hscUpdateHUG (\hug -> foldl' (flip addHomeModInfoToHug) hug mod_infos) (e { hsc_type_env_vars = emptyKnotVars })+#else+  let !new_modules = addListToHpt (hsc_HPT e) [(mod_name x, x) | x <- mod_infos]+  in e { hsc_HPT = new_modules+       , hsc_type_env_var = Nothing+       }+    where+      mod_name = moduleName . mi_module . hm_iface+#endif++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 (DataTypeCons _ xs) = xs+#else+extract_cons = id #endif
src/Development/IDE/GHC/Compat/Core.hs view
@@ -263,7 +263,7 @@     SrcLoc.noSrcSpan,     SrcLoc.noSrcLoc,     SrcLoc.noLoc,-    SrcLoc.mapLoc,+    mapLoc,     -- * Finder     FindResult(..),     mkHomeModLocation,@@ -447,6 +447,7 @@     -- * Syntax re-exports #if MIN_VERSION_ghc(9,0,0)     module GHC.Hs,+    module GHC.Hs.Binds,     module GHC.Parser,     module GHC.Parser.Header,     module GHC.Parser.Lexer,@@ -486,6 +487,15 @@     Extension(..), #endif     UniqFM,+    mkCgInteractiveGuts,+    justBytecode,+    justObjects,+    emptyHomeModInfoLinkable,+    homeModInfoByteCode,+    homeModInfoObject,+# if !MIN_VERSION_ghc(9,5,0)+    field_label,+#endif     ) where  import qualified GHC@@ -786,6 +796,7 @@ -- (until the CPP extension is actually needed). import GHC.LanguageExtensions.Type hiding (Cpp) +import           GHC.Hs.Binds  mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation #if MIN_VERSION_ghc(9,3,0)@@ -872,7 +883,7 @@ pattern FunTy :: Type -> Type -> Type pattern FunTy arg res <- TyCoRep.FunTy {ft_arg = arg, ft_res = res} -#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(8,10,0) -- type HasSrcSpan x a = (GenLocated SrcSpan a ~ x) -- type HasSrcSpan x = () :: Constraint @@ -1180,4 +1191,35 @@ type UniqFM = UniqFM.UniqFM #else type UniqFM k = UniqFM.UniqFM+#endif++#if MIN_VERSION_ghc(9,5,0)+mkVisFunTys = mkScaledFunctionTys+mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b+mapLoc = fmap+#else+mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b+mapLoc = SrcLoc.mapLoc+#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
src/Development/IDE/GHC/Compat/Env.hs view
@@ -82,7 +82,11 @@ #endif import           GHC.Driver.Hooks     (Hooks) import           GHC.Driver.Session   hiding (mkHomeModule)+#if __GLASGOW_HASKELL__ >= 905+import           Language.Haskell.Syntax.Module.Name+#else import           GHC.Unit.Module.Name+#endif import           GHC.Unit.Types       (Module, Unit, UnitId, mkModule) #else import           DynFlags@@ -230,7 +234,9 @@ setBytecodeLinkerOptions :: DynFlags -> DynFlags setBytecodeLinkerOptions df = df {     ghcLink   = LinkInMemory-#if MIN_VERSION_ghc(9,2,0)+#if MIN_VERSION_ghc(9,5,0)+  , backend = noBackend+#elif MIN_VERSION_ghc(9,2,0)   , backend = NoBackend #else   , hscTarget = HscNothing@@ -241,7 +247,9 @@ setInterpreterLinkerOptions :: DynFlags -> DynFlags setInterpreterLinkerOptions df = df {     ghcLink   = LinkInMemory-#if MIN_VERSION_ghc(9,2,0)+#if MIN_VERSION_ghc(9,5,0)+   , backend = interpreterBackend+#elif MIN_VERSION_ghc(9,2,0)   , backend = Interpreter #else   , hscTarget = HscInterpreted
src/Development/IDE/GHC/Compat/Logger.hs view
@@ -49,7 +49,11 @@  -- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test. logActionCompat :: LogActionCompat -> LogAction+#if 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+#endif logActionCompat logAction logFlags _cls loc = logAction logFlags Nothing Nothing loc alwaysQualify  #else
src/Development/IDE/GHC/Compat/Outputable.hs view
@@ -9,7 +9,6 @@     ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, punctuate,     printSDocQualifiedUnsafe,     printWithoutUniques,-    mkPrintUnqualified,     mkPrintUnqualifiedDefault,     PrintUnqualified(..),     defaultUserStyle,@@ -17,9 +16,20 @@     -- * Parser errors     PsWarning,     PsError,+#if MIN_VERSION_ghc(9,5,0)+    defaultDiagnosticOpts,+    GhcMessage,+#endif #if MIN_VERSION_ghc(9,3,0)     DiagnosticReason(..),     renderDiagnosticMessageWithHints,+    pprMsgEnvelopeBagWithLoc,+    Error.getMessages,+    renderWithContext,+    defaultSDocContext,+    errMsgDiagnostic,+    unDecorated,+    diagnosticMessage, #else     pprWarning,     pprError,@@ -29,12 +39,14 @@     MsgEnvelope,     ErrMsg,     WarnMsg,+    SourceError(..),     errMsgSpan,     errMsgSeverity,     formatErrorWithQual,     mkWarnMsg,     mkSrcErr,     srcErrorMessages,+    textDoc,     ) where  @@ -80,12 +92,19 @@ import qualified Outputable                      as Out import           SrcLoc #endif+#if MIN_VERSION_ghc(9,5,0)+import           GHC.Driver.Errors.Types         (GhcMessage)+#endif #if MIN_VERSION_ghc(9,3,0) import           Data.Maybe import           GHC.Driver.Config.Diagnostic import           GHC.Utils.Logger #endif +#if MIN_VERSION_ghc(9,5,0)+type PrintUnqualified = NamePprCtx+#endif+ -- | A compatible function to print `Outputable` instances -- without unique symbols. --@@ -203,7 +222,11 @@  mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualifiedDefault env =-#if MIN_VERSION_ghc(9,2,0)+#if MIN_VERSION_ghc(9,5,0)+  mkNamePprCtx ptc (hsc_unit_env env)+    where+      ptc = initPromotionTickContext (hsc_dflags env)+#elif MIN_VERSION_ghc(9,2,0)   -- GHC 9.2 version   -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified   mkPrintUnqualified (hsc_unit_env env)@@ -212,9 +235,14 @@ #endif  #if MIN_VERSION_ghc(9,3,0)-renderDiagnosticMessageWithHints :: Diagnostic a => a -> DecoratedSDoc-renderDiagnosticMessageWithHints a = Error.unionDecoratedSDoc (diagnosticMessage a) (mkDecorated $ map ppr $ diagnosticHints a)+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)+#endif  #if MIN_VERSION_ghc(9,3,0) mkWarnMsg :: DynFlags -> Maybe DiagnosticReason -> b -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc@@ -235,3 +263,6 @@ #else defaultUserStyle = Out.defaultUserStyle unsafeGlobalDynFlags #endif++textDoc :: String -> SDoc+textDoc = text
src/Development/IDE/GHC/Compat/Parser.hs view
@@ -120,7 +120,11 @@ #endif  #if MIN_VERSION_ghc(9,2,0)+#if MIN_VERSION_ghc(9,5,0)+pattern HsParsedModule :: Located (HsModule GhcPs) -> [FilePath] -> ApiAnns -> GHC.HsParsedModule+#else pattern HsParsedModule :: Located HsModule -> [FilePath] -> ApiAnns -> GHC.HsParsedModule+#endif pattern HsParsedModule     { hpm_module     , hpm_src_files
src/Development/IDE/GHC/Compat/Units.hs view
@@ -99,6 +99,7 @@  import           Development.IDE.GHC.Compat.Core import           Development.IDE.GHC.Compat.Env+import           Development.IDE.GHC.Compat.Outputable #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) import           Data.Map                        (Map) #endif@@ -400,7 +401,7 @@ #endif     isInplace p = Right p -showSDocForUser' :: HscEnv -> GHC.PrintUnqualified -> SDoc -> String+showSDocForUser' :: HscEnv -> PrintUnqualified -> SDoc -> String #if MIN_VERSION_ghc(9,2,0) showSDocForUser' env = showSDocForUser (hsc_dflags env) (unitState env) #else
src/Development/IDE/GHC/Compat/Util.hs view
@@ -24,9 +24,7 @@     LBooleanFormula,     BooleanFormula(..),     -- * OverridingBool-#if !MIN_VERSION_ghc(9,3,0)     OverridingBool(..),-#endif     -- * Maybes     MaybeErr(..),     orElse,@@ -103,6 +101,11 @@ import           Unique import           Util #endif++#if MIN_VERSION_ghc(9,3,0)+import           GHC.Data.Bool+#endif+  #if !MIN_VERSION_ghc(9,0,0) type MonadCatch = Exception.ExceptionMonad
src/Development/IDE/GHC/CoreFile.hs view
@@ -10,7 +10,8 @@   , typecheckCoreFile   , readBinCoreFile   , writeBinCoreFile-  , getImplicitBinds) where+  , getImplicitBinds+  , occNamePrefixes) where  import           Control.Monad import           Control.Monad.IO.Class@@ -18,6 +19,7 @@ import           Data.IORef import           Data.List                       (isPrefixOf) import           Data.Maybe+import qualified Data.Text as T import           GHC.Fingerprint  import           Development.IDE.GHC.Compat@@ -134,8 +136,12 @@   :: Fingerprint -- ^ Hash of the interface this was generated from   -> CgGuts   -> CoreFile-codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind cg_module) $ filter isNotImplictBind cg_binds) hash-+#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+#endif -- | Implicit binds can be generated from the interface and are not tidied, -- so we must filter them out isNotImplictBind :: CoreBind -> Bool@@ -163,21 +169,21 @@ get_defn :: Id -> CoreBind get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id)) -toIfaceTopBndr :: Module -> Id -> IfaceId-toIfaceTopBndr mod id+toIfaceTopBndr1 :: Module -> Id -> IfaceId+toIfaceTopBndr1 mod id   = IfaceId (mangleDeclName mod $ getName id)             (toIfaceType (idType id))             (toIfaceIdDetails (idDetails id))             (toIfaceIdInfo (idInfo id)) -toIfaceTopBind :: Module -> Bind Id -> TopIfaceBinding IfaceId-toIfaceTopBind mod (NonRec b r) = TopIfaceNonRec (toIfaceTopBndr mod b) (toIfaceExpr r)-toIfaceTopBind mod (Rec prs)    = TopIfaceRec [(toIfaceTopBndr mod b, toIfaceExpr r) | (b,r) <- prs]+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-    tcTopIfaceBindings type_var prepd_binding+    tcTopIfaceBindings1 type_var prepd_binding  -- | Internal names can't be serialized, so we mange them -- to an external name and restore at deserialization time@@ -199,9 +205,9 @@ isGhcideName :: Name -> Bool isGhcideName = isGhcideModule . nameModule -tcTopIfaceBindings :: IORef TypeEnv -> [TopIfaceBinding IfaceId]+tcTopIfaceBindings1 :: IORef TypeEnv -> [TopIfaceBinding IfaceId]           -> IfL [CoreBind]-tcTopIfaceBindings ty_var ver_decls+tcTopIfaceBindings1 ty_var ver_decls    = do      int <- mapM (traverse $ tcIfaceId) ver_decls      let all_ids = concatMap toList int@@ -228,3 +234,45 @@ tc_iface_bindings (TopIfaceRec vs) = do   vs' <- traverse (\(v, e) -> (,) <$> pure 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"+  ]
src/Development/IDE/GHC/Orphans.hs view
@@ -46,6 +46,9 @@ #if MIN_VERSION_ghc(9,3,0) import           GHC.Types.PkgQual #endif+#if MIN_VERSION_ghc(9,5,0)+import           GHC.Unit.Home.ModInfo+#endif  -- Orphan instances for types from the GHC API. instance Show CoreModule where show = unpack . printOutputable@@ -92,8 +95,10 @@ instance Outputable a => Show (GenLocated SrcSpan a) where show = unpack . printOutputable #endif +#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@@ -184,8 +189,10 @@ 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"@@ -195,7 +202,9 @@ instance NFData (ImportDecl GhcPs) where     rnf = rwhnf -#if MIN_VERSION_ghc(9,0,1)+#if MIN_VERSION_ghc(9,5,0)+instance (NFData (HsModule a)) where+#elif MIN_VERSION_ghc(9,0,1) instance (NFData HsModule) where #else instance (NFData (HsModule a)) where@@ -220,5 +229,10 @@   rnf = rwhnf  instance NFData NodeKey where+  rnf = rwhnf+#endif++#if MIN_VERSION_ghc(9,5,0)+instance NFData HomeModLinkable where   rnf = rwhnf #endif
src/Development/IDE/LSP/Outline.hs view
@@ -11,6 +11,7 @@  import           Control.Monad.IO.Class import           Data.Functor+import           Data.Foldable                  (toList) import           Data.Generics                  hiding (Prefix) import           Data.Maybe import qualified Data.Text                      as T@@ -30,7 +31,7 @@                                                  TextDocumentIdentifier (TextDocumentIdentifier),                                                  type (|?) (InL), uriToFilePath) #if MIN_VERSION_ghc(9,2,0)-import Data.List.NonEmpty (nonEmpty, toList)+import Data.List.NonEmpty (nonEmpty) #endif  moduleOutline@@ -111,7 +112,7 @@ #if MIN_VERSION_ghc(9,2,0)             , _children       = List . toList <$> nonEmpty childs             }-        | con <- dd_cons+        | con <- extract_cons dd_cons         , let (cs, flds) = hsConDeclsBinders con         , let childs = mapMaybe cvtFld flds         , L (locA -> RealSrcSpan l' _) n <- cs@@ -291,7 +292,7 @@            -- remove only the first occurrence of any seen field in order to            -- avoid circumventing detection of duplicate fields (#9156)            ConDeclGADT { con_names = names, con_g_args = args }-             -> (names, flds)+             -> (toList names, flds)              where                 flds = get_flds_gadt args @@ -318,3 +319,5 @@              -> ([LFieldOcc GhcPs])     get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds) #endif++
src/Development/IDE/Plugin/Completions.hs view
@@ -106,8 +106,13 @@ -- 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     f x = x
src/Development/IDE/Plugin/Completions/Logic.hs view
@@ -41,6 +41,7 @@ import           Development.IDE.GHC.Compat               hiding (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@@ -74,6 +75,10 @@  import           Development.IDE.Spans.AtPoint            (pointCommand) +#if MIN_VERSION_ghc(9,5,0)+import Language.Haskell.Syntax.Basic+#endif+ -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int chunkSize = 1000@@ -137,17 +142,29 @@         importGo :: GHC.LImportDecl GhcPs -> Maybe Context         importGo (L (locA -> r) impDecl)           | pos `isInsideSrcSpan` r+#if MIN_VERSION_ghc(9,5,0)+          = importInline importModuleName (fmap (fmap reLoc) $ ideclImportList impDecl)+#else           = 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+        -- importInline :: String -> Maybe (Bool,  GHC.Located [LIE GhcPs]) -> Maybe Context+#if MIN_VERSION_ghc(9,5,0)+        importInline modName (Just (EverythingBut, L r _))+#else         importInline modName (Just (True, L r _))+#endif           | pos `isInsideSrcSpan` r = Just $ ImportHidingContext modName           | otherwise = Nothing+#if MIN_VERSION_ghc(9,5,0)+        importInline modName (Just (Exactly, L r _))+#else         importInline modName (Just (False, L r _))+#endif           | pos `isInsideSrcSpan` r = Just $ ImportListContext modName           | otherwise = Nothing         importInline _ _ = Nothing@@ -383,7 +400,7 @@                   | isDataConName n                   , Just flds <- Map.lookup parent fieldMap                   , not (null flds) ->-                    [mkRecordSnippetCompItem uri mbParent (printOutputable originName) (map (T.pack . unpackFS) flds) (ImportedFrom mn) imp']+                    [mkRecordSnippetCompItem uri mbParent (printOutputable originName) (map (T.pack . unpackFS . field_label) flds) (ImportedFrom mn) imp']                 _ -> []          in mkNameCompItem uri mbParent originName (ImportedFrom mn) Nothing imp' (nameModule_maybe n)@@ -466,7 +483,7 @@     where         result = [mkRecordSnippetCompItem uri (Just $ printOutputable $ unLoc tcdLName)                         (printOutputable . unLoc $ con_name) field_labels mn Nothing-                 | ConDeclH98{..} <- unLoc <$> dd_cons tcdDataDefn+                 | ConDeclH98{..} <- unLoc <$> (extract_cons $ dd_cons tcdDataDefn)                  , Just  con_details <- [getFlds con_args]                  , let field_names = concatMap extract con_details                  , let field_labels = printOutputable <$> field_names@@ -767,50 +784,7 @@ -- 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)) prefixes---- | Prefixes that can occur in a GHC OccName-prefixes :: [T.Text]-prefixes =-  [-    -- 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"-  ]-+  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
src/Development/IDE/Spans/AtPoint.hs view
@@ -20,6 +20,8 @@   , getNamesAtPoint   , toCurrentLocation   , rowToLoc+  , nameToLocation+  , LookupModule   ) where  import           Development.IDE.GHC.Error@@ -225,10 +227,19 @@         wrapHaskell x = "\n```haskell\n"<>x<>"\n```\n"         info = nodeInfoH kind ast         names = M.assocs $ nodeIdentifiers info+        -- Check for evidence bindings+        isInternal :: (Identifier, IdentifierDetails a) -> Bool+        isInternal (Right _, dets) =+#if MIN_VERSION_ghc(9,0,1)+          any isEvidenceContext $ identInfo dets+#else+          False+#endif+        isInternal (Left _, _) = False+        filteredNames = filter (not . isInternal) names         types = nodeType info-         prettyNames :: [T.Text]-        prettyNames = map prettyName names+        prettyNames = map prettyName filteredNames         prettyName (Right n, dets) = T.unlines $           wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind))           : maybeToList (pretty (definedAt n) (prettyPackageName n))
src/Development/IDE/Spans/Common.hs view
@@ -34,7 +34,11 @@ type KindMap = NameEnv TyThing  -- | 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
src/Development/IDE/Types/Exports.hs view
@@ -51,9 +51,9 @@ instance Show ExportsMap where   show (ExportsMap occs mods) =     unwords [ "ExportsMap { getExportsMap ="-            , printWithoutUniques $ mapOccEnv (text . show) occs+            , printWithoutUniques $ mapOccEnv (textDoc . show) occs             , "getModuleExportsMap ="-            , printWithoutUniques $ mapUFM (text . show) mods+            , printWithoutUniques $ mapUFM (textDoc . show) mods             , "}"             ] 
src/Development/IDE/Types/Logger.hs view
@@ -19,7 +19,7 @@   , cfilter   , withDefaultRecorder   , makeDefaultStderrRecorder-  , priorityToHsLoggerPriority+  , makeDefaultHandleRecorder   , LoggingColumn(..)   , cmapWithPrio   , withBacklog@@ -39,8 +39,7 @@                                                         readTVarIO,                                                         writeTBQueue, writeTVar) import           Control.Exception                     (IOException)-import           Control.Monad                         (forM_, unless, when,-                                                        (>=>))+import           Control.Monad                         (unless, when, (>=>)) import           Control.Monad.IO.Class                (MonadIO (liftIO)) import           Data.Foldable                         (for_) import           Data.Functor.Contravariant            (Contravariant (contramap))@@ -76,12 +75,7 @@ import           System.IO                             (Handle,                                                         IOMode (AppendMode),                                                         hClose, hFlush,-                                                        hSetEncoding, openFile,-                                                        stderr, utf8)-import qualified System.Log.Formatter                  as HSL-import qualified System.Log.Handler                    as HSL-import qualified System.Log.Handler.Simple             as HSL-import qualified System.Log.Logger                     as HsLogger+                                                        openFile, stderr) import           UnliftIO                              (MonadUnliftIO,                                                         displayException,                                                         finally, try)@@ -170,31 +164,24 @@   Recorder     { logger_ = \text -> liftIO $ Text.hPutStrLn handle text *> hFlush handle } --- | Priority is actually for hslogger compatibility-makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> Priority -> m (Recorder (WithPriority (Doc a)))-makeDefaultStderrRecorder columns minPriority = do+makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> m (Recorder (WithPriority (Doc a)))+makeDefaultStderrRecorder columns = do   lock <- liftIO newLock-  makeDefaultHandleRecorder columns minPriority lock stderr+  makeDefaultHandleRecorder columns lock stderr  -- | If no path given then use stderr, otherwise use file.--- Kinda complicated because we also need to setup `hslogger` for--- `hie-bios` log compatibility reasons. If `hie-bios` can be set to use our--- logger instead or if `hie-bios` doesn't use `hslogger` then `hslogger` can--- be removed completely. See `setupHsLogger` comment. withDefaultRecorder   :: MonadUnliftIO m   => Maybe FilePath   -- ^ Log file path. `Nothing` uses stderr   -> Maybe [LoggingColumn]   -- ^ logging columns to display. `Nothing` uses `defaultLoggingColumns`-  -> Priority-  -- ^ min priority for hslogger compatibility   -> (Recorder (WithPriority (Doc d)) -> m a)   -- ^ action given a recorder   -> m a-withDefaultRecorder path columns minPriority action = do+withDefaultRecorder path columns action = do   lock <- liftIO newLock-  let makeHandleRecorder = makeDefaultHandleRecorder columns minPriority lock+  let makeHandleRecorder = makeDefaultHandleRecorder columns lock   case path of     Nothing -> do       recorder <- makeHandleRecorder stderr@@ -216,64 +203,19 @@   :: MonadIO m   => Maybe [LoggingColumn]   -- ^ built-in logging columns to display. Nothing uses the default-  -> Priority-  -- ^ min priority for hslogger compatibility   -> Lock   -- ^ lock to take when outputting to handle   -> Handle   -- ^ handle to output to   -> m (Recorder (WithPriority (Doc a)))-makeDefaultHandleRecorder columns minPriority lock handle = do+makeDefaultHandleRecorder columns lock handle = do   let Recorder{ logger_ } = textHandleRecorder handle   let threadSafeRecorder = Recorder { logger_ = \msg -> liftIO $ withLock lock (logger_ msg) }   let loggingColumns = fromMaybe defaultLoggingColumns columns   let textWithPriorityRecorder = cmapIO (textWithPriorityToText loggingColumns) threadSafeRecorder-  -- see `setupHsLogger` comment-  liftIO $ setupHsLogger lock handle ["hls", "hie-bios"] (priorityToHsLoggerPriority minPriority)   pure (cmap docToText textWithPriorityRecorder)   where     docToText = fmap (renderStrict . layoutPretty defaultLayoutOptions)--priorityToHsLoggerPriority :: Priority -> HsLogger.Priority-priorityToHsLoggerPriority = \case-  Debug   -> HsLogger.DEBUG-  Info    -> HsLogger.INFO-  Warning -> HsLogger.WARNING-  Error   -> HsLogger.ERROR---- | The purpose of setting up `hslogger` at all is that `hie-bios` uses--- `hslogger` to output compilation logs. The easiest way to merge these logs--- with our log output is to setup an `hslogger` that uses the same handle--- and same lock as our loggers. That way the output from our loggers and--- `hie-bios` don't interleave strangely.--- It may be possible to have `hie-bios` use our logger by decorating the--- `Cradle.cradleOptsProg.runCradle` we get in the Cradle from--- `HieBios.findCradle`, but I remember trying that and something not good--- happened. I'd have to try it again to remember if that was a real issue.--- Once that is figured out or `hie-bios` doesn't use `hslogger`, then all--- references to `hslogger` can be removed entirely.-setupHsLogger :: Lock -> Handle -> [String] -> HsLogger.Priority -> IO ()-setupHsLogger lock handle extraLogNames level = do-  hSetEncoding handle utf8--  logH <- HSL.streamHandler handle level--  let logHandle  = logH-        { HSL.writeFunc = \a s -> withLock lock $ HSL.writeFunc logH a s }-      logFormatter  = HSL.tfLogFormatter logDateFormat logFormat-      logHandler = HSL.setFormatter logHandle logFormatter--  HsLogger.updateGlobalLogger HsLogger.rootLoggerName $ HsLogger.setHandlers ([] :: [HSL.GenericHandler Handle])-  HsLogger.updateGlobalLogger "haskell-lsp" $ HsLogger.setHandlers [logHandler]-  HsLogger.updateGlobalLogger "haskell-lsp" $ HsLogger.setLevel level--  -- Also route the additional log names to the same log-  forM_ extraLogNames $ \logName -> do-    HsLogger.updateGlobalLogger logName $ HsLogger.setHandlers [logHandler]-    HsLogger.updateGlobalLogger logName $ HsLogger.setLevel level-  where-    logFormat = "$time [$tid] $prio $loggername:\t$msg"-    logDateFormat = "%Y-%m-%d %H:%M:%S%Q"  data LoggingColumn   = TimeColumn
test/data/hover/GotoHover.hs view
@@ -64,3 +64,7 @@  hole2 :: a -> Maybe a hole2 = _++-- A comment above a type defnition with a deriving clause+data Example = Example+  deriving (Eq)
test/data/multi/a/a.cabal view
@@ -4,6 +4,6 @@ cabal-version: >= 1.2  library-  build-depends: base, async+  build-depends: base, async >= 2.0   exposed-modules: A   hs-source-dirs: .
test/data/multi/cabal.project view
@@ -1,1 +1,3 @@ packages: a b c++allow-newer: base
+ test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/a-1.0.0/build/autogen/Paths_a.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoRebindableSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -w #-}+module Paths_a (+    version,+    getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,+    getDataFileName, getSysconfDir+  ) where+++import qualified Control.Exception as Exception+import qualified Data.List as List+import Data.Version (Version(..))+import System.Environment (getEnv)+import Prelude+++#if defined(VERSION_base)++#if MIN_VERSION_base(4,0,0)+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#else+catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a+#endif++#else+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#endif+catchIO = Exception.catch++version :: Version+version = Version [1,0,0] []++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+  dir <- getDataDir+  return (dir `joinFileName` name)++getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath++++bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath+bindir     = "/home/zubin/.cabal/bin"+libdir     = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0-inplace"+dynlibdir  = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623"+datadir    = "/home/zubin/.cabal/share/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0"+libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0"+sysconfdir = "/home/zubin/.cabal/etc"++getBinDir     = catchIO (getEnv "a_bindir")     (\_ -> return bindir)+getLibDir     = catchIO (getEnv "a_libdir")     (\_ -> return libdir)+getDynLibDir  = catchIO (getEnv "a_dynlibdir")  (\_ -> return dynlibdir)+getDataDir    = catchIO (getEnv "a_datadir")    (\_ -> return datadir)+getLibexecDir = catchIO (getEnv "a_libexecdir") (\_ -> return libexecdir)+getSysconfDir = catchIO (getEnv "a_sysconfdir") (\_ -> return sysconfdir)+++++joinFileName :: String -> String -> FilePath+joinFileName ""  fname = fname+joinFileName "." fname = fname+joinFileName dir ""    = dir+joinFileName dir fname+  | isPathSeparator (List.last dir) = dir ++ fname+  | otherwise                       = dir ++ pathSeparator : fname++pathSeparator :: Char+pathSeparator = '/'++isPathSeparator :: Char -> Bool+isPathSeparator c = c == '/'
+ test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/a-1.0.0/t/a-test/build/a-test/autogen/Paths_a.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoRebindableSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -w #-}+module Paths_a (+    version,+    getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,+    getDataFileName, getSysconfDir+  ) where+++import qualified Control.Exception as Exception+import qualified Data.List as List+import Data.Version (Version(..))+import System.Environment (getEnv)+import Prelude+++#if defined(VERSION_base)++#if MIN_VERSION_base(4,0,0)+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#else+catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a+#endif++#else+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#endif+catchIO = Exception.catch++version :: Version+version = Version [1,0,0] []++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+  dir <- getDataDir+  return (dir `joinFileName` name)++getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath++++bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath+bindir     = "/home/zubin/.cabal/bin"+libdir     = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0-inplace-a-test"+dynlibdir  = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623"+datadir    = "/home/zubin/.cabal/share/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0"+libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0"+sysconfdir = "/home/zubin/.cabal/etc"++getBinDir     = catchIO (getEnv "a_bindir")     (\_ -> return bindir)+getLibDir     = catchIO (getEnv "a_libdir")     (\_ -> return libdir)+getDynLibDir  = catchIO (getEnv "a_dynlibdir")  (\_ -> return dynlibdir)+getDataDir    = catchIO (getEnv "a_datadir")    (\_ -> return datadir)+getLibexecDir = catchIO (getEnv "a_libexecdir") (\_ -> return libexecdir)+getSysconfDir = catchIO (getEnv "a_sysconfdir") (\_ -> return sysconfdir)+++++joinFileName :: String -> String -> FilePath+joinFileName ""  fname = fname+joinFileName "." fname = fname+joinFileName dir ""    = dir+joinFileName dir fname+  | isPathSeparator (List.last dir) = dir ++ fname+  | otherwise                       = dir ++ pathSeparator : fname++pathSeparator :: Char+pathSeparator = '/'++isPathSeparator :: Char -> Bool+isPathSeparator c = c == '/'
+ test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/b-1.0.0/build/autogen/Paths_b.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoRebindableSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -w #-}+module Paths_b (+    version,+    getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,+    getDataFileName, getSysconfDir+  ) where+++import qualified Control.Exception as Exception+import qualified Data.List as List+import Data.Version (Version(..))+import System.Environment (getEnv)+import Prelude+++#if defined(VERSION_base)++#if MIN_VERSION_base(4,0,0)+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#else+catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a+#endif++#else+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#endif+catchIO = Exception.catch++version :: Version+version = Version [1,0,0] []++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+  dir <- getDataDir+  return (dir `joinFileName` name)++getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath++++bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath+bindir     = "/home/zubin/.cabal/bin"+libdir     = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623/b-1.0.0-inplace"+dynlibdir  = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623"+datadir    = "/home/zubin/.cabal/share/x86_64-linux-ghc-9.4.0.20220623/b-1.0.0"+libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-9.4.0.20220623/b-1.0.0"+sysconfdir = "/home/zubin/.cabal/etc"++getBinDir     = catchIO (getEnv "b_bindir")     (\_ -> return bindir)+getLibDir     = catchIO (getEnv "b_libdir")     (\_ -> return libdir)+getDynLibDir  = catchIO (getEnv "b_dynlibdir")  (\_ -> return dynlibdir)+getDataDir    = catchIO (getEnv "b_datadir")    (\_ -> return datadir)+getLibexecDir = catchIO (getEnv "b_libexecdir") (\_ -> return libexecdir)+getSysconfDir = catchIO (getEnv "b_sysconfdir") (\_ -> return sysconfdir)+++++joinFileName :: String -> String -> FilePath+joinFileName ""  fname = fname+joinFileName "." fname = fname+joinFileName dir ""    = dir+joinFileName dir fname+  | isPathSeparator (List.last dir) = dir ++ fname+  | otherwise                       = dir ++ pathSeparator : fname++pathSeparator :: Char+pathSeparator = '/'++isPathSeparator :: Char -> Bool+isPathSeparator c = c == '/'
+ test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/c-1.0.0/build/autogen/Paths_c.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoRebindableSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -w #-}+module Paths_c (+    version,+    getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,+    getDataFileName, getSysconfDir+  ) where+++import qualified Control.Exception as Exception+import qualified Data.List as List+import Data.Version (Version(..))+import System.Environment (getEnv)+import Prelude+++#if defined(VERSION_base)++#if MIN_VERSION_base(4,0,0)+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#else+catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a+#endif++#else+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#endif+catchIO = Exception.catch++version :: Version+version = Version [1,0,0] []++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+  dir <- getDataDir+  return (dir `joinFileName` name)++getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath++++bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath+bindir     = "/home/zubin/.cabal/bin"+libdir     = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623/c-1.0.0-inplace"+dynlibdir  = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623"+datadir    = "/home/zubin/.cabal/share/x86_64-linux-ghc-9.4.0.20220623/c-1.0.0"+libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-9.4.0.20220623/c-1.0.0"+sysconfdir = "/home/zubin/.cabal/etc"++getBinDir     = catchIO (getEnv "c_bindir")     (\_ -> return bindir)+getLibDir     = catchIO (getEnv "c_libdir")     (\_ -> return libdir)+getDynLibDir  = catchIO (getEnv "c_dynlibdir")  (\_ -> return dynlibdir)+getDataDir    = catchIO (getEnv "c_datadir")    (\_ -> return datadir)+getLibexecDir = catchIO (getEnv "c_libexecdir") (\_ -> return libexecdir)+getSysconfDir = catchIO (getEnv "c_sysconfdir") (\_ -> return sysconfdir)+++++joinFileName :: String -> String -> FilePath+joinFileName ""  fname = fname+joinFileName "." fname = fname+joinFileName dir ""    = dir+joinFileName dir fname+  | isPathSeparator (List.last dir) = dir ++ fname+  | otherwise                       = dir ++ pathSeparator : fname++pathSeparator :: Char+pathSeparator = '/'++isPathSeparator :: Char -> Bool+isPathSeparator c = c == '/'
test/exe/Main.hs view
@@ -200,7 +200,7 @@  main :: IO () main = do-  docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) Debug+  docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn])    let docWithFilteredPriorityRecorder@Recorder{ logger_ } =         docWithPriorityRecorder@@ -596,13 +596,19 @@       expectDiagnostics         [ ( "Main.hs"           , [(DsError, (6, 9),-                if ghcVersion >= GHC94-                then "Variable not in scope: map" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130-                else "Not in scope: \8216ThisList.map\8217")+                if ghcVersion >= GHC96 then+                  "Variable not in scope: ThisList.map"+                else if ghcVersion >= GHC94 then+                  "Variable not in scope: map" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130+                else+                  "Not in scope: \8216ThisList.map\8217")             ,(DsError, (7, 9),-                if ghcVersion >= GHC94-                then "Variable not in scope: x" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130-                else "Not in scope: \8216BaseList.x\8217")+                if ghcVersion >= GHC96 then+                  "Variable not in scope: BaseList.x"+                else if ghcVersion >= GHC94 then+                  "Variable not in scope: x" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130+                else+                  "Not in scope: \8216BaseList.x\8217")             ]           )         ]@@ -950,7 +956,7 @@         , ("head = 233", "head :: Integer")         , ("rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")", "rank2Test :: (forall a. a -> a) -> (Int, " <> listOfChar <> ")")         , ("symbolKindTest = Proxy @\"qwq\"", "symbolKindTest :: Proxy \"qwq\"")-        , ("promotedKindTest = Proxy @Nothing", "promotedKindTest :: Proxy 'Nothing")+        , ("promotedKindTest = Proxy @Nothing", if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing")         , ("typeOperatorTest = Refl", if ghcVersion >= GHC92 then "typeOperatorTest :: forall {k} {a :: k}. a :~: a" else "typeOperatorTest :: a :~: a")         , ("notInScopeTest = mkCharType", "notInScopeTest :: String -> Data.Data.DataType")         ]@@ -1026,6 +1032,7 @@             ExpectRange  expectedRange -> checkHoverRange expectedRange rangeInHover msg             ExpectHoverRange expectedRange -> checkHoverRange expectedRange rangeInHover msg             ExpectHoverText snippets -> liftIO $ traverse_ (`assertFoundIn` msg) snippets+            ExpectHoverExcludeText snippets -> liftIO $ traverse_ (`assertNotFoundIn` msg) snippets             ExpectHoverTextRegex re -> liftIO $ assertBool ("Regex not found in " <> T.unpack msg) (msg =~ re :: Bool)             ExpectNoHover -> liftIO $ assertFailure $ "Expected no hover but got " <> show hover             _ -> pure () -- all other expectations not relevant to hover@@ -1054,6 +1061,11 @@     (T.unpack $ "failed to find: `" <> part <> "` in hover message:\n" <> whole)     (part `T.isInfixOf` whole) +  assertNotFoundIn :: T.Text -> T.Text -> Assertion+  assertNotFoundIn part whole = assertBool+    (T.unpack $ "found unexpected: `" <> part <> "` in hover message:\n" <> whole)+    (not . T.isInfixOf part $ whole)+   sourceFilePath = T.unpack sourceFileName   sourceFileName = "GotoHover.hs" @@ -1130,6 +1142,7 @@   imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3]   reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 (if ghcVersion >= GHC94 then 5 else 0) 3 (if ghcVersion >= GHC94 then 8 else 14)]   thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]]+  cmtL68 = Position 67  0  ;  lackOfdEq = [ExpectHoverExcludeText ["$dEq"]]   in   mkFindTests   --      def    hover  look       expect@@ -1173,6 +1186,7 @@   , test  no     broken chrL36     litC          "literal Char in hover info      #1016"   , test  no     broken txtL8      litT          "literal Text in hover info      #1016"   , test  no     broken lstL43     litL          "literal List in hover info      #1016"+  , test  yes    yes    cmtL68     lackOfdEq     "no Core symbols                 #3280"   , if ghcVersion >= GHC90 then         test  no     yes    docL41     constr        "type constraint in hover info   #1012"     else@@ -1234,6 +1248,7 @@    -- Error: cabal: Failed to build ghc-typelits-natnormalise-0.7.7 (which is   -- required by plugin-1.0.0). See the build log above for details.+  ignoreFor (BrokenForGHC [GHC96]) "fragile, frequently times out" $   ignoreFor (BrokenSpecific Windows [GHC94]) "ghc-typelist-natnormalise fails to build on GHC 9.4.2 for windows only" $   testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do     _ <- openDoc (dir </> "KnownNat.hs") "haskell"@@ -1768,7 +1783,7 @@       []   ]   where-    brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC810, GHC90, GHC92, GHC94]) "Windows has strange things in scope for some reason"+    brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC810, GHC90, GHC92, GHC94, GHC96]) "Windows has strange things in scope for some reason"  otherCompletionTests :: [TestTree] otherCompletionTests = [@@ -2000,7 +2015,7 @@         , "bar = fo"         ]       test doc (Position 2 8) "foo" Nothing ["*Defined at line 2, column 1 in this module*\n"]-  , testSession "local single line doc without '\\n'" $ do+  , testSession "local single line doc without newline" $ do       doc <- createDoc "A.hs" "haskell" $ T.unlines         [ "module A where"         , "-- |docdoc"@@ -2008,7 +2023,7 @@         , "bar = fo"         ]       test doc (Position 3 8) "foo" Nothing ["*Defined at line 3, column 1 in this module*\n* * *\n\n\ndocdoc\n"]-  , testSession "local multi line doc with '\\n'" $ do+  , testSession "local multi line doc with newline" $ do       doc <- createDoc "A.hs" "haskell" $ T.unlines         [ "module A where"         , "-- | abcabc"@@ -2017,7 +2032,7 @@         , "bar = fo"         ]       test doc (Position 4 8) "foo" Nothing ["*Defined at line 4, column 1 in this module*\n* * *\n\n\nabcabc\n"]-  , testSession "local multi line doc without '\\n'" $ do+  , testSession "local multi line doc without newline" $ do       doc <- createDoc "A.hs" "haskell" $ T.unlines         [ "module A where"         , "-- |     abcabc"@@ -2057,10 +2072,10 @@       test doc (Position 1 7) "id" (Just $ T.length expected) [expected]   ]   where-    brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92, GHC94]) "Completion doc doesn't support ghc9"+    brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92, GHC94, GHC96]) "Completion doc doesn't support ghc9"     brokenForWinGhc9 = knownBrokenFor (BrokenSpecific Windows [GHC90, GHC92]) "Extern doc doesn't support Windows for ghc9.2"     -- https://gitlab.haskell.org/ghc/ghc/-/issues/20903-    brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92, GHC94]) "Extern doc doesn't support MacOS for ghc9"+    brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92, GHC94, GHC96]) "Extern doc doesn't support MacOS for ghc9"     test doc pos label mn expected = do       _ <- waitForDiagnostics       compls <- getCompletions doc pos@@ -2108,7 +2123,7 @@             , DocumentHighlight (R 6 10 6 13) (Just HkRead)             , DocumentHighlight (R 7 12 7 15) (Just HkRead)             ]-  , knownBrokenForGhcVersions [GHC90, GHC92, GHC94] "Ghc9 highlights the constructor and not just this field" $+  , knownBrokenForGhcVersions [GHC90, GHC92, GHC94, GHC96] "Ghc9 highlights the constructor and not just this field" $         testSessionWait "record" $ do         doc <- createDoc "A.hs" "haskell" recsource         _ <- waitForDiagnostics@@ -2339,7 +2354,7 @@     ignoreFor (BrokenSpecific Windows [GHC810]) "tests are unreliable in windows for ghc 8.10"  ignoreForGHC92Plus :: String -> TestTree -> TestTree-ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94])+ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94, GHC96])  knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers)@@ -2390,6 +2405,7 @@ --  | ExpectDefRange Range -- Only gotoDef should report this range   | ExpectHoverRange Range -- Only hover should report this range   | ExpectHoverText [T.Text] -- the hover message must contain these snippets+  | ExpectHoverExcludeText [T.Text] -- the hover message must _not_ contain these snippets   | ExpectHoverTextRegex T.Text -- the hover message must match this pattern   | ExpectExternFail -- definition lookup in other file expected to fail   | ExpectNoDefinitions