hie-bios 0.13.1 → 0.14.0

raw patch · 16 files changed

+185/−381 lines, 16 filesdep ~basedep ~extradep ~filepathPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, extra, filepath, ghc, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• exe/Main.hs +3/−2
• hie-bios.cabal +9/−9
• src/HIE/Bios/Cradle.hs +69/−36
• src/HIE/Bios/Environment.hs +1/−1
• src/HIE/Bios/Flags.hs +3/−3
• src/HIE/Bios/Ghc/Api.hs +1/−9
• src/HIE/Bios/Ghc/Check.hs +3/−3
• src/HIE/Bios/Ghc/Doc.hs +4/−6
• src/HIE/Bios/Ghc/Gap.hs +14/−237
• src/HIE/Bios/Ghc/Load.hs +9/−8
• src/HIE/Bios/Ghc/Logger.hs +6/−44
• src/HIE/Bios/Internal/Debug.hs +1/−1
• src/HIE/Bios/Types.hs +48/−10
• tests/BiosTests.hs +7/−11
• tests/Utils.hs +1/−1

@@ -1,5 +1,11 @@ # ChangeLog hie-bios +## 2024-04-22 - 0.14.0++* Add Loading Style option to 'runAction' [#433](https://github.com/haskell/hie-bios/pull/433)+* Cleanup CPP for GHCs < 9.2, fix most GHC warnings [#429](https://github.com/haskell/hie-bios/pull/429)+* Update GHC versions in CI, drop ghcs not supported by hls [#428](https://github.com/haskell/hie-bios/pull/428)+ ## 2023-11-14 - 0.13.1  * Add CI support for GHC 9.8.1 [#419](https://github.com/haskell/hie-bios/pull/419)

@@ -6,7 +6,7 @@ import Control.Monad ( forM ) import qualified Colog.Core as L import Data.Version (showVersion)-import Data.Text.Prettyprint.Doc+import Prettyprinter import Options.Applicative import System.Directory (getCurrentDirectory) import System.IO (stdout, hSetEncoding, utf8)@@ -16,6 +16,7 @@ import HIE.Bios.Ghc.Check import HIE.Bios.Ghc.Gap as Gap import HIE.Bios.Internal.Debug+import HIE.Bios.Types (LoadStyle(LoadFile)) import Paths_hie_bios  ----------------------------------------------------------------@@ -84,7 +85,7 @@         [] -> error "too few arguments"         _ -> do           res <- forM files $ \fp -> do-                  res <- getCompilerOptions fp [] cradle+                  res <- getCompilerOptions fp LoadFile cradle                   case res of                       CradleFail (CradleError _deps _ex err) ->                         return $ "Failed to show flags for \""

@@ -1,6 +1,6 @@ Cabal-Version:          2.2 Name:                   hie-bios-Version:                0.13.1+Version:                0.14.0 Author:                 Matthew Pickering <matthewtpickering@gmail.com> Maintainer:             Matthew Pickering <matthewtpickering@gmail.com> License:                BSD-3-Clause@@ -12,8 +12,8 @@ Category:               Development Build-Type:             Simple -- No glob syntax until GHC 8.6 because of stack-Extra-Source-Files:     ChangeLog.md-                        README.md+extra-doc-files:        ChangeLog.md+Extra-Source-Files:     README.md                         wrappers/cabal                         wrappers/cabal.hs                         tests/configs/*.yaml@@ -139,7 +139,7 @@                         tests/projects/stack-with-yaml/stack-with-yaml.cabal                         tests/projects/stack-with-yaml/src/Lib.hs -tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.6 || ==9.6.2 || ==9.8.1+tested-with: GHC ==9.2.8 || ==9.4.8 || ==9.6.4 || ==9.8.2  Library   Default-Language:     Haskell2010@@ -163,7 +163,7 @@   Other-Modules:        Paths_hie_bios   autogen-modules:      Paths_hie_bios   Build-Depends:-                        base                 >= 4.14 && < 5,+                        base                 >= 4.16 && < 5,                         aeson                >= 1.4.4 && < 2.3,                         base16-bytestring    >= 0.1.1 && < 1.1,                         bytestring           >= 0.10.8 && < 0.13,@@ -172,11 +172,11 @@                         exceptions           ^>= 0.10,                         cryptohash-sha1      >= 0.11.100 && < 0.12,                         directory            >= 1.3.0 && < 1.4,-                        filepath             >= 1.4.1 && < 1.5,-                        time                 >= 1.8.0 && < 1.13,+                        filepath             >= 1.4.1 && < 1.6,+                        time                 >= 1.8.0 && < 1.14,                         extra                >= 1.6.14 && < 1.8,                         prettyprinter        ^>= 1.6 || ^>= 1.7.0,-                        ghc                  >= 8.10.1 && < 9.9,+                        ghc                  >= 9.2.1 && < 9.9,                         transformers         >= 0.5.2 && < 0.7,                         temporary            >= 1.2 && < 1.4,                         template-haskell,@@ -195,7 +195,7 @@   Other-Modules:        Paths_hie_bios   GHC-Options:          -Wall   HS-Source-Dirs:       exe-  Build-Depends:        base >= 4.9 && < 5+  Build-Depends:        base >= 4.16 && < 5                       , co-log-core                       , directory                       , filepath

@@ -25,7 +25,6 @@     , makeCradleResult     -- | Cradle project configuration types     , CradleProjectConfig(..)-    ,   ) where  import Control.Applicative ((<|>), optional)@@ -285,8 +284,8 @@     notNoneType _ = True  -resolveCradleAction :: LogAction IO (WithSeverity Log) ->  (b -> CradleAction a) -> ResolvedCradles b -> FilePath -> ResolvedCradle b -> CradleAction a-resolveCradleAction l buildCustomCradle cs root cradle =+resolveCradleAction :: Show a => LogAction IO (WithSeverity Log) -> (b -> CradleAction a) -> ResolvedCradles b -> FilePath -> ResolvedCradle b -> CradleAction a+resolveCradleAction l buildCustomCradle cs root cradle = addLoadStyleLogToCradleAction $   case concreteCradle cradle of     ConcreteCabal t -> cabalCradle l cs root (cabalComponent t) (projectConfigFromMaybe root (cabalProjectFile t))     ConcreteStack t -> stackCradle l root (stackComponent t) (projectConfigFromMaybe root (stackYaml t))@@ -294,6 +293,13 @@     ConcreteDirect xs -> directCradle l root xs     ConcreteNone -> noneCradle     ConcreteOther a -> buildCustomCradle a+  where+    -- Add a log message to each loading operation.+    addLoadStyleLogToCradleAction crdlAct = crdlAct+      { runCradle = \fp ls -> do+          l <& LogRequestedCradleLoadStyle (T.pack $ show $ actionName crdlAct) ls `WithSeverity` Debug+          runCradle crdlAct fp ls+      }  resolveCradleTree :: FilePath -> CradleConfig a -> [ResolvedCradle a] resolveCradleTree root (CradleConfig confDeps confTree) = go root confDeps confTree@@ -459,7 +465,8 @@ directCradle l wdir args   = CradleAction       { actionName = Types.Direct-      , runCradle = \_ _ ->+      , runCradle = \_ loadStyle -> do+          logCradleHasNoSupportForLoadWithContext l loadStyle "direct"           return (CradleSuccess (ComponentOptions (args ++ argDynamic) wdir []))       , runGhcCmd = runGhcCmdOnPath l wdir       }@@ -481,7 +488,7 @@ biosWorkDir :: FilePath -> MaybeT IO FilePath biosWorkDir = findFileUpwards (".hie-bios" ==) -biosDepsAction :: LogAction IO (WithSeverity Log) -> FilePath -> Maybe Callable -> FilePath -> [FilePath] -> IO [FilePath]+biosDepsAction :: LogAction IO (WithSeverity Log) -> FilePath -> Maybe Callable -> FilePath -> LoadStyle -> IO [FilePath] biosDepsAction l wdir (Just biosDepsCall) fp _prevs = do   biosDeps' <- callableToProcess biosDepsCall (Just fp) -- TODO multi pass the previous files too   (ex, sout, serr, [(_, args)]) <- readProcessWithOutputs [hie_bios_output] l wdir biosDeps'@@ -496,16 +503,17 @@   -> Maybe Callable   -> LogAction IO (WithSeverity Log)   -> FilePath-  -> [FilePath]+  -> LoadStyle   -> IO (CradleLoadResult ComponentOptions)-biosAction wdir bios bios_deps l fp fps = do+biosAction wdir bios bios_deps l fp loadStyle = do+  logCradleHasNoSupportForLoadWithContext l loadStyle "bios"   bios' <- callableToProcess bios (Just fp) -- TODO pass all the files instead of listToMaybe   (ex, _stdo, std, [(_, res),(_, mb_deps)]) <-     readProcessWithOutputs [hie_bios_output, hie_bios_deps] l wdir bios'    deps <- case mb_deps of     Just x  -> return x-    Nothing -> biosDepsAction l wdir bios_deps fp fps+    Nothing -> biosDepsAction l wdir bios_deps fp loadStyle         -- Output from the program should be written to the output file and         -- delimited by newlines.         -- Execute the bios action and add dependencies of the cradle.@@ -780,7 +788,6 @@   where     projectFileArgs = projectFileProcessArgs cabalProject - cabalAction   :: ResolvedCradles a   -> FilePath@@ -788,34 +795,49 @@   -> LogAction IO (WithSeverity Log)   -> CradleProjectConfig   -> FilePath-  -> [FilePath]+  -> LoadStyle   -> CradleLoadResultT IO ComponentOptions-cabalAction (ResolvedCradles root cs vs) workDir mc l projectFile fp fps = do+cabalAction (ResolvedCradles root cs vs) workDir mc l projectFile fp loadStyle = do   cabal_version <- liftIO $ runCachedIO $ cabalVersion vs   ghc_version   <- liftIO $ runCachedIO $ ghcVersion vs+  -- determine which load style is supported by this cabal cradle.+  determinedLoadStyle <- case (cabal_version, ghc_version) of+    (Just cabal, Just ghc)+      -- Multi-component supported from cabal-install 3.11+      -- and ghc 9.4+      | LoadWithContext _ <- loadStyle ->+          if ghc >= makeVersion [9,4] && cabal >= makeVersion [3,11]+            then pure loadStyle+            else do+              liftIO $ l <& WithSeverity+                (LogLoadWithContextUnsupported "cabal"+                  $ Just "cabal or ghc version is too old. We require `cabal >= 3.11` and `ghc >= 9.4`"+                )+                Warning+              pure LoadFile+    _ -> pure LoadFile++  let cabalArgs = case determinedLoadStyle of+        LoadFile -> [fromMaybe (fixTargetPath fp) mc]+        LoadWithContext fps -> concat+          [ [ "--keep-temp-files"+            , "--enable-multi-repl"+            , fromMaybe (fixTargetPath fp) mc+            ]+          , [fromMaybe (fixTargetPath old_fp) old_mc+            | old_fp <- fps+            -- Lookup the component for the old file+            , Just (ResolvedCradle{concreteCradle = ConcreteCabal ct}) <- [selectCradle prefix old_fp cs]+            -- Only include this file if the old component is in the same project+            , (projectConfigFromMaybe root (cabalProjectFile ct)) == projectFile+            , let old_mc = cabalComponent ct+            ]+          ]++  liftIO $ l <& LogComputedCradleLoadStyle "cabal" determinedLoadStyle `WithSeverity` Info+   let     cabalCommand = "v2-repl"-    cabalArgs = case (cabal_version, ghc_version) of-      (Just cabal, Just ghc)-        -- Multi-component supported from cabal-install 3.11-        -- and ghc 9.4-        | ghc   >= makeVersion [9,4]-        , cabal >= makeVersion [3,11]-        -> case fps of-          [] -> [fromMaybe (fixTargetPath fp) mc]-          -- Start a multi-component session with all the old files-          _ -> "--keep-temp-files"-             : "--enable-multi-repl"-             : [fromMaybe (fixTargetPath fp) mc]-            ++ [fromMaybe (fixTargetPath old_fp) old_mc-               | old_fp <- fps-               -- Lookup the component for the old file-               , Just (ResolvedCradle{concreteCradle = ConcreteCabal ct}) <- [selectCradle prefix old_fp cs]-               -- Only include this file if the old component is in the same project-               , (projectConfigFromMaybe root (cabalProjectFile ct)) == projectFile-               , let old_mc = cabalComponent ct-               ]-      _ -> [fromMaybe (fixTargetPath fp) mc]    cabalProc <- cabalProcess l projectFile workDir cabalCommand cabalArgs `modCradleError` \err -> do       deps <- cabalCradleDependencies projectFile workDir workDir@@ -844,8 +866,7 @@       -- Best effort. Assume the working directory is the       -- root of the component, so we are right in trivial cases at least.       deps <- liftIO $ cabalCradleDependencies projectFile workDir workDir-      throwCE (CradleError deps ex $-                (["Failed to parse result of calling cabal" ] <> errorDetails))+      throwCE (CradleError deps ex $ ["Failed to parse result of calling cabal" ] <> errorDetails)     Just (componentDir, final_args) -> do       deps <- liftIO $ cabalCradleDependencies projectFile workDir componentDir       CradleLoadResultT $ pure $ makeCradleResult (ex, stde, componentDir, final_args) deps@@ -964,9 +985,10 @@   -> CradleProjectConfig   -> LogAction IO (WithSeverity Log)   -> FilePath-  -> [FilePath]+  -> LoadStyle   -> IO (CradleLoadResult ComponentOptions)-stackAction workDir mc syaml l _fp _fps = do+stackAction workDir mc syaml l _fp loadStyle = do+  logCradleHasNoSupportForLoadWithContext l loadStyle "stack"   let ghcProcArgs = ("stack", stackYamlProcessArgs syaml <> ["exec", "ghc", "--"])   -- Same wrapper works as with cabal   wrapper_fp <- withGhcWrapperTool l ghcProcArgs workDir@@ -1235,3 +1257,14 @@     Nothing -> throwCE $       CradleError [] ExitSuccess $         ["Couldn't execute " <> cmdString] <> prettyProcessEnv createdProcess++-- | Log that the cradle has no supported for loading with context, if and only if+-- 'LoadWithContext' was requested.+logCradleHasNoSupportForLoadWithContext :: Applicative m => LogAction m (WithSeverity Log) -> LoadStyle -> T.Text -> m ()+logCradleHasNoSupportForLoadWithContext l (LoadWithContext _) crdlName =+  l <& WithSeverity+        (LogLoadWithContextUnsupported crdlName+          $ Just $ crdlName <> " doesn't support loading multiple components at once"+        )+        Info+logCradleHasNoSupportForLoadWithContext _ _ _ = pure ()

@@ -150,7 +150,7 @@   let leftovers = map G.unLoc leftovers' ++ additionalTargets    let (df3, srcs, _objs) = Gap.parseTargetFiles df2 leftovers-  ts <- mapM (uncurry (\f phase -> Gap.guessTarget f (Just $ Gap.homeUnitId_ df3) phase) ) srcs+  ts <- mapM (\(f, phase) -> Gap.guessTarget f (Just $ Gap.homeUnitId_ df3) phase) srcs   return (df3, ts)  -- | Make filepaths in the given 'DynFlags' absolute.

@@ -8,9 +8,9 @@ -- file or GHC session according to the provided 'Cradle'. getCompilerOptions   :: FilePath -- ^ The file we are loading it because of-  -> [FilePath] -- ^ previous files we might want to include in the build+  -> LoadStyle -- ^ previous files we might want to include in the build   -> Cradle a   -> IO (CradleLoadResult ComponentOptions)-getCompilerOptions fp fps cradle = do+getCompilerOptions fp loadStyle cradle = do   (cradleLogger cradle) <& LogProcessOutput "invoking build tool to determine build flags (this may take some time depending on the cache)" `WithSeverity` Info-  runCradle (cradleOptsProg cradle) fp fps+  runCradle (cradleOptsProg cradle) fp loadStyle

@@ -11,15 +11,7 @@  import GHC (LoadHowMuch(..), DynFlags, GhcMonad) import qualified GHC as G--#if __GLASGOW_HASKELL__ >= 900 import qualified GHC.Driver.Main as G-import qualified GHC.Driver.Make as G-#else-import qualified HscMain as G-import qualified GhcMake as G-#endif- import qualified HIE.Bios.Ghc.Gap as Gap import Control.Monad (void) import Control.Monad.IO.Class@@ -47,7 +39,7 @@   -> Cradle a  -- ^ The cradle we want to load   -> m (CradleLoadResult (m G.SuccessFlag, ComponentOptions)) -- ^ Whether we actually loaded the cradle or not. initializeFlagsWithCradleWithMessage msg fp cradle =-    fmap (initSessionWithMessage msg) <$> liftIO (getCompilerOptions fp [] cradle)+    fmap (initSessionWithMessage msg) <$> liftIO (getCompilerOptions fp LoadFile cradle)  -- | Actually perform the initialisation of the session. Initialising the session corresponds to -- parsing the command line flags, setting the targets for the session and then attempting to load

@@ -14,7 +14,7 @@ import Control.Exception import Control.Monad.IO.Class import Colog.Core (LogAction (..), WithSeverity (..), Severity (..), (<&), cmap)-import Data.Text.Prettyprint.Doc+import Prettyprinter  import HIE.Bios.Ghc.Api import HIE.Bios.Ghc.Logger@@ -44,12 +44,12 @@             -> [FilePath]  -- ^ The target files.             -> IO String checkSyntax _           _      []    = return ""-checkSyntax checkLogger cradle files = do+checkSyntax checkLogger cradle files@(file:_) = do     libDirRes <- getRuntimeGhcLibDir cradle     handleRes libDirRes $ \libDir ->       G.runGhcT (Just libDir) $ do         liftIO $ checkLogger <& LogCradle cradle `WithSeverity` Info-        res <- initializeFlagsWithCradle (head files) cradle+        res <- initializeFlagsWithCradle file cradle         handleRes res $ \(ini, _) -> do           _sf <- ini           either id id <$> check checkLogger files

@@ -12,16 +12,14 @@ import GHC.Utils.Outputable #endif -#if __GLASGOW_HASKELL__ >= 900 import GHC.Driver.Session (initSDocContext)-import GHC.Utils.Outputable (PprStyle, SDoc, runSDoc, neverQualify, ) import GHC.Utils.Ppr  (Mode(..), Doc, Style(..), renderStyle, style)-#else-import Outputable (PprStyle, SDoc, runSDoc, neverQualify, initSDocContext)-import Pretty (Mode(..), Doc, Style(..), renderStyle, style)-#endif  import HIE.Bios.Ghc.Gap (makeUserStyle, pageMode, oneLineMode)++#if __GLASGOW_HASKELL__ < 905+import GHC.Utils.Outputable (PprStyle, SDoc, runSDoc, neverQualify, )+#endif  #if __GLASGOW_HASKELL__ >= 905 getPrintUnqual :: Monad m => m NamePprCtx

@@ -60,35 +60,9 @@ import GHC import qualified GHC as G -#if __GLASGOW_HASKELL__ >= 810 && __GLASGOW_HASKELL__ < 900-import Data.List-import System.FilePath--import DynFlags (LogAction, WarningFlag, updOptLevel, Way(WayDyn), updateWays, addWay', getDynFlags)-import qualified DynFlags as G-import qualified Exception as G--import Outputable (PprStyle, Depth(AllTheWay), mkUserStyle)-import HscMain (getHscEnv, batchMsg)-import HscTypes (Hsc, HscEnv(..))-import qualified HscTypes as G-import qualified EnumSet as E (EnumSet, empty)-import qualified Pretty as Ppr-import qualified TcRnTypes as Tc-import Hooks (Hooks(hscFrontendHook))-import qualified CmdLineParser as CmdLine-import DriverPhases as G-import Util as G-import qualified GhcMonad as G--import qualified DynamicLoading (initializePlugins)-import qualified Plugins (plugins)-#endif ---------------------------------------------------------------- ---------------------------------------------------------------- -#if __GLASGOW_HASKELL__ >= 902-import GHC.Driver.CmdLine as CmdLine import GHC.Driver.Env as G import GHC.Driver.Session as G import GHC.Driver.Hooks@@ -99,61 +73,28 @@ import qualified GHC.Platform.Ways as Platform import qualified GHC.Runtime.Loader as DynamicLoading (initializePlugins) import qualified GHC.Tc.Types as Tc- import GHC.Utils.Logger import GHC.Utils.Outputable import qualified GHC.Utils.Ppr as Ppr-#elif __GLASGOW_HASKELL__ >= 900-import Data.List-import System.FilePath--import GHC.Core.Multiplicity (irrelevantMult)-import GHC.Data.EnumSet as E-import GHC.Driver.CmdLine as CmdLine-import GHC.Driver.Types as G-import GHC.Driver.Session as G-import GHC.Driver.Hooks-import GHC.Driver.Main-import GHC.Driver.Monad as G-import GHC.Driver.Phases as G-import GHC.Utils.Misc as G-import qualified GHC.Driver.Plugins as Plugins-import GHC.Driver.Ways (Way(WayDyn))-import qualified GHC.Driver.Ways as Platform-import qualified GHC.Runtime.Loader as DynamicLoading (initializePlugins)-import qualified GHC.Tc.Types as Tc+import qualified GHC.Driver.Make as G -import GHC.Utils.Outputable-import qualified GHC.Utils.Ppr as Ppr-#endif-#if __GLASGOW_HASKELL__ >= 900+#if __GLASGOW_HASKELL__ > 903 import GHC.Unit.Types (UnitId) #endif--#if __GLASGOW_HASKELL__ >= 900+#if __GLASGOW_HASKELL__ < 904 import qualified GHC.Driver.Main as G-import qualified GHC.Driver.Make as G-#else-import qualified HscMain as G-import qualified GhcMake as G #endif- #if __GLASGOW_HASKELL__ >= 907 import GHC.Types.Error (mkUnknownDiagnostic, Messages) import GHC.Driver.Errors.Types (DriverMessage) #endif+#if __GLASGOW_HASKELL__ < 907+import GHC.Driver.CmdLine as CmdLine+#endif  ghcVersion :: String ghcVersion = VERSION_ghc -#if __GLASGOW_HASKELL__ <= 810-homeUnitId_ :: a -> ()-homeUnitId_ = const ()-#elif __GLASGOW_HASKELL__ <= 901-homeUnitId_ :: DynFlags -> UnitId-homeUnitId_ = homeUnitId-#endif- #if __GLASGOW_HASKELL__ >= 907 load' :: GhcMonad m => Maybe G.ModIfaceCache -> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag load' mhmi_cache how_much = G.load' mhmi_cache how_much mkUnknownDiagnostic@@ -165,23 +106,12 @@ load' _ a b c = G.load' a b c #endif -#if __GLASGOW_HASKELL__ >= 900 bracket :: E.MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b bracket =   E.bracket-#else-bracket :: G.ExceptionMonad m => m a -> (a -> m c) -> (a -> m b) -> m b-bracket =-  G.gbracket-#endif -#if __GLASGOW_HASKELL__ >= 900 handle :: (E.MonadCatch m, E.Exception e) => (e -> m a) -> m a -> m a handle = E.handle-#else-handle :: (G.ExceptionMonad m, E.Exception e) => (e -> m a) -> m a -> m a-handle = G.ghandle-#endif  catch :: (E.MonadCatch m, E.Exception e) => m a -> (e -> m a) -> m a catch =@@ -190,21 +120,15 @@ ----------------------------------------------------------------  pattern RealSrcSpan :: G.RealSrcSpan -> G.SrcSpan-#if __GLASGOW_HASKELL__ >= 900 pattern RealSrcSpan t <- G.RealSrcSpan t _-#else-pattern RealSrcSpan t <- G.RealSrcSpan t-#endif  ----------------------------------------------------------------  setNoCode :: DynFlags -> DynFlags #if __GLASGOW_HASKELL__ >= 905 setNoCode d = d { G.backend = G.noBackend }-#elif __GLASGOW_HASKELL__ >= 901-setNoCode d = d { G.backend = G.NoBackend } #else-setNoCode d = d { G.hscTarget = G.HscNothing }+setNoCode d = d { G.backend = G.NoBackend } #endif  ----------------------------------------------------------------@@ -213,14 +137,9 @@ set_hsc_dflags dflags hsc_env = hsc_env { G.hsc_dflags = dflags }  overPkgDbRef :: (FilePath -> FilePath) -> G.PackageDBFlag -> G.PackageDBFlag-overPkgDbRef f (G.PackageDB pkgConfRef) = G.PackageDB-              $ case pkgConfRef of-#if __GLASGOW_HASKELL__ >= 900-                G.PkgDbPath fp -> G.PkgDbPath (f fp)-#else-                G.PkgConfFile fp -> G.PkgConfFile (f fp)-#endif-                conf -> conf+overPkgDbRef f (G.PackageDB pkgConfRef) = G.PackageDB $ case pkgConfRef of+    G.PkgDbPath fp -> G.PkgDbPath (f fp)+    conf -> conf overPkgDbRef _f db = db  ----------------------------------------------------------------@@ -240,14 +159,10 @@ #else makeUserStyle :: DynFlags -> PrintUnqualified -> PprStyle #endif-#if __GLASGOW_HASKELL__ >= 900 makeUserStyle _dflags style = mkUserStyle style AllTheWay-#elif __GLASGOW_HASKELL__ >= 804-makeUserStyle dflags style = mkUserStyle dflags style AllTheWay-#endif  -----------------------------------------------------------------#if __GLASGOW_HASKELL__ >= 810+ getModSummaries :: ModuleGraph -> [ModSummary] getModSummaries = mgModSummaries @@ -256,46 +171,34 @@  fixInfo :: (a, b, c, d, e) -> (a, b, c, d) fixInfo (t,f,cs,fs,_) = (t,f,cs,fs)-#endif  ----------------------------------------------------------------  mapOverIncludePaths :: (FilePath -> FilePath) -> DynFlags -> DynFlags mapOverIncludePaths f df = df   { includePaths =-#if __GLASGOW_HASKELL__ >= 810       G.IncludeSpecs           (map f $ G.includePathsQuote  (includePaths df))           (map f $ G.includePathsGlobal (includePaths df)) #if MIN_VERSION_GLASGOW_HASKELL(9,0,2,0)           (map f $ G.includePathsQuoteImplicit (includePaths df)) #endif-#endif   }  ----------------------------------------------------------------  unsetLogAction :: GhcMonad m => m () unsetLogAction = do-#if __GLASGOW_HASKELL__ >= 902     hsc_env <- getSession     logger <- liftIO $ initLogger     let env = hsc_env { hsc_logger = pushLogHook (const noopLogger) logger }     setSession env-#else-    setLogAction noopLogger-#if __GLASGOW_HASKELL__ < 806-        (\_df -> return ())-#endif-#endif  noopLogger :: LogAction #if __GLASGOW_HASKELL__ >= 903 noopLogger = (\_wr _s _ss _m -> return ())-#elif __GLASGOW_HASKELL__ >= 900-noopLogger = (\_df _wr _s _ss _m -> return ()) #else-noopLogger = (\_df _wr _s _ss _pp _m -> return ())+noopLogger = (\_df _wr _s _ss _m -> return ()) #endif  -- --------------------------------------------------------@@ -304,11 +207,7 @@  pageMode :: Ppr.Mode pageMode =-#if __GLASGOW_HASKELL__ >= 902   Ppr.PageMode True-#else-  Ppr.PageMode-#endif  oneLineMode :: Ppr.Mode oneLineMode = Ppr.OneLineMode@@ -320,39 +219,20 @@ numLoadedPlugins :: HscEnv -> Int #if __GLASGOW_HASKELL__ >= 903 numLoadedPlugins = length . Plugins.pluginsWithArgs . hsc_plugins-#elif __GLASGOW_HASKELL__ >= 902-numLoadedPlugins = length . Plugins.plugins-#elif __GLASGOW_HASKELL__ >= 808-numLoadedPlugins = length . Plugins.plugins . hsc_dflags #else--- Plugins are loaded just as they are used-numLoadedPlugins _ = 0+numLoadedPlugins = length . Plugins.plugins #endif  initializePluginsForModSummary :: HscEnv -> ModSummary -> IO (Int, [G.ModuleName], ModSummary) initializePluginsForModSummary hsc_env' mod_summary = do-#if __GLASGOW_HASKELL__ >= 902   hsc_env <- DynamicLoading.initializePlugins hsc_env'   pure ( numLoadedPlugins hsc_env        , pluginModNames $ hsc_dflags hsc_env        , mod_summary        )-#elif __GLASGOW_HASKELL__ >= 808-  let dynFlags' = G.ms_hspp_opts mod_summary-  dynFlags <- DynamicLoading.initializePlugins hsc_env' dynFlags'-  pure ( numLoadedPlugins $ set_hsc_dflags dynFlags hsc_env'-       , G.pluginModNames dynFlags-       , mod_summary { G.ms_hspp_opts = dynFlags }-       )-#else-  -- In earlier versions of GHC plugins are just loaded before they are used.-  return (numLoadedPlugins hsc_env', G.pluginModNames $ hsc_dflags hsc_env', mod_summary)-#endif - setFrontEndHooks :: Maybe (ModSummary -> G.Hsc Tc.FrontendResult) -> HscEnv -> HscEnv setFrontEndHooks frontendHook env =-#if __GLASGOW_HASKELL__ >= 902   env     { hsc_hooks = hooks         { hscFrontendHook = frontendHook@@ -360,30 +240,10 @@     }   where     hooks = hsc_hooks env-#else-  env-    { G.hsc_dflags = flags-        { G.hooks = oldhooks-            { hscFrontendHook = frontendHook-            }-        }-    }-  where-    flags = hsc_dflags env-    oldhooks = G.hooks flags-#endif -#if __GLASGOW_HASKELL__ < 902-type Logger = ()-#endif- getLogger :: HscEnv -> Logger getLogger =-#if __GLASGOW_HASKELL__ >= 902     hsc_logger-#else-    const ()-#endif  gopt_set :: DynFlags -> G.GeneralFlag -> DynFlags gopt_set = G.gopt_set@@ -396,11 +256,9 @@     else       id -#if __GLASGOW_HASKELL__ >= 900 updateWays :: DynFlags -> DynFlags updateWays = id -#if __GLASGOW_HASKELL__ >= 902 -- Copied from GHC, do we need that? addWay' :: Way -> DynFlags -> DynFlags addWay' w dflags0 =@@ -411,8 +269,6 @@        dflags3 = foldr unSetGeneralFlag' dflags2                        (Platform.wayUnsetGeneralFlags platform w)    in dflags3-#endif-#endif  parseDynamicFlags :: MonadIO m     => Logger@@ -424,94 +280,15 @@ #else           , [CmdLine.Warn]) #endif-#if __GLASGOW_HASKELL__ >= 902 parseDynamicFlags = G.parseDynamicFlags-#else-parseDynamicFlags _ = G.parseDynamicFlags-#endif + parseTargetFiles :: DynFlags -> [String] -> (DynFlags, [(String, Maybe G.Phase)], [String])-#if __GLASGOW_HASKELL__ >= 902 parseTargetFiles = G.parseTargetFiles-#else-parseTargetFiles dflags0 fileish_args =-  let-     -- To simplify the handling of filepaths, we normalise all filepaths right-     -- away. Note the asymmetry of FilePath.normalise:-     --    Linux:   p/q -> p/q; p\q -> p\q-     --    Windows: p/q -> p\q; p\q -> p\q-     -- #12674: Filenames starting with a hypen get normalised from ./-foo.hs-     -- to -foo.hs. We have to re-prepend the current directory.-    normalise_hyp fp-        | strt_dot_sl && "-" `isPrefixOf` nfp = cur_dir ++ nfp-        | otherwise                           = nfp-        where-#if defined(mingw32_HOST_OS)-          strt_dot_sl = "./" `isPrefixOf` fp || ".\\" `isPrefixOf` fp-#else-          strt_dot_sl = "./" `isPrefixOf` fp-#endif-          cur_dir = '.' : [pathSeparator]-          nfp = normalise fp-    normal_fileish_paths = map normalise_hyp fileish_args -    (srcs, objs) = partition_args normal_fileish_paths [] []-    df1 = dflags0 { G.ldInputs = map (G.FileOption "") objs ++ G.ldInputs dflags0 }-  in-    (df1, srcs, objs)-#endif---#if __GLASGOW_HASKELL__ < 902-partition_args :: [String] -> [(String, Maybe G.Phase)] -> [String]-               -> ([(String, Maybe G.Phase)], [String])--- partition_args, along with some of the other code in this file,--- was copied from ghc/Main.hs--- -------------------------------------------------------------------------------- Splitting arguments into source files and object files.  This is where we--- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source--- file indicating the phase specified by the -x option in force, if any.-partition_args [] srcs objs = (reverse srcs, reverse objs)-partition_args ("-x":suff:args) srcs objs-  | "none" <- suff      = partition_args args srcs objs-  | G.StopLn <- phase     = partition_args args srcs (slurp ++ objs)-  | otherwise           = partition_args rest (these_srcs ++ srcs) objs-        where phase = G.startPhase suff-              (slurp,rest) = break (== "-x") args-              these_srcs = zip slurp (repeat (Just phase))-partition_args (arg:args) srcs objs-  | looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs-  | otherwise               = partition_args args srcs (arg:objs)--    {--      We split out the object files (.o, .dll) and add them-      to ldInputs for use by the linker.-      The following things should be considered compilation manager inputs:-       - haskell source files (strings ending in .hs, .lhs or other-         haskellish extension),-       - module names (not forgetting hierarchical module names),-       - things beginning with '-' are flags that were not recognised by-         the flag parser, and we want them to generate errors later in-         checkOptions, so we class them as source files (#5921)-       - and finally we consider everything without an extension to be-         a comp manager input, as shorthand for a .hs or .lhs filename.-      Everything else is considered to be a linker object, and passed-      straight through to the linker.-    -}-looks_like_an_input :: String -> Bool-looks_like_an_input m =  G.isSourceFilename m-                      || G.looksLikeModuleName m-                      || "-" `isPrefixOf` m-                      || not (hasExtension m)-#endif- -- -------------------------------------------------------- -- Platform constants -- --------------------------------------------------------  hostIsDynamic :: Bool-#if __GLASGOW_HASKELL__ >= 900 hostIsDynamic = Platform.hostIsDynamic-#else-hostIsDynamic = G.dynamicGhc-#endif

@@ -10,23 +10,22 @@ import Control.Monad.IO.Class  import Data.List-import Data.Time.Clock-import Data.Text.Prettyprint.Doc++import Prettyprinter import Data.IORef  import GHC import qualified GHC as G -#if __GLASGOW_HASKELL__ >= 900 import qualified GHC.Driver.Main as G-import qualified GHC.Driver.Make as G-#else-import qualified GhcMake as G-import qualified HscMain as G-#endif  import qualified HIE.Bios.Ghc.Gap as Gap+#if __GLASGOW_HASKELL__ > 903 import GHC.Fingerprint+#endif+#if __GLASGOW_HASKELL__ < 903+import Data.Time.Clock+#endif  data Log =   LogLoaded FilePath FilePath@@ -119,7 +118,9 @@ -- fool the recompilation checker so that we can get the typechecked modules updateTime :: MonadIO m => [Target] -> ModuleGraph -> m ModuleGraph updateTime ts graph = liftIO $ do+#if __GLASGOW_HASKELL__ < 903   cur_time <- getCurrentTime+#endif   let go ms         | any (msTargetIs ms) ts = #if __GLASGOW_HASKELL__ >= 903

@@ -8,28 +8,12 @@ import qualified GHC as G import Control.Monad.IO.Class -#if __GLASGOW_HASKELL__ >= 902 import GHC.Data.Bag import GHC.Data.FastString (unpackFS) import GHC.Driver.Session (dopt, DumpFlag(Opt_D_dump_splices)) import GHC.Types.SourceError import GHC.Utils.Error import GHC.Utils.Logger-#elif __GLASGOW_HASKELL__ >= 900-import GHC.Data.Bag-import GHC.Data.FastString (unpackFS)-import GHC.Driver.Session (dopt, DumpFlag(Opt_D_dump_splices), LogAction)-import GHC.Driver.Types (SourceError, srcErrorMessages)-import GHC.Utils.Error-import GHC.Utils.Outputable (SDoc)-#else-import Bag (Bag, bagToList)-import DynFlags (LogAction, dopt, DumpFlag(Opt_D_dump_splices))-import ErrUtils-import FastString (unpackFS)-import HscTypes (SourceError, srcErrorMessages)-import Outputable (SDoc)-#endif  import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef) import Data.Maybe (fromMaybe)@@ -61,18 +45,15 @@     return $! unlines (b [])  appendLogRef :: DynFlags -> Gap.PprStyle -> LogRef -> LogAction-appendLogRef df style (LogRef ref)+appendLogRef df style (LogRef ref) _ #if __GLASGOW_HASKELL__ < 903-    _ _ sev src+    _ sev #elif __GLASGOW_HASKELL__ < 905-    _ (MCDiagnostic sev _) src+    (MCDiagnostic sev _) #else-    _ (MCDiagnostic sev _ _) src-#endif-#if __GLASGOW_HASKELL__ < 900-  _style+    (MCDiagnostic sev _ _) #endif-  msg = do+  src msg = do         let !l = ppMsg src sev df style msg         modifyIORef ref (\b -> b . (l:)) @@ -88,18 +69,12 @@     logref <- liftIO newLogRef     dflags <- getSessionDynFlags     style <- getStyle dflags-#if __GLASGOW_HASKELL__ >= 902     G.pushLogHookM (const $ appendLogRef dflags style logref)     let setLogger _ df = df-#else-    let setLogger logref_ df = df { log_action =  appendLogRef df style logref_ }-#endif     r <- withDynFlags (setLogger logref . setDF) $ do       body       liftIO $ Right <$> readAndClearLogRef logref-#if __GLASGOW_HASKELL__ >= 902     G.popLogHookM-#endif     pure r  @@ -135,7 +110,7 @@      msg = pprLocMsgEnvelope err #endif      -- fixme-#elif __GLASGOW_HASKELL__ >= 902+#else errBagToStrList :: DynFlags -> Gap.PprStyle -> Bag (MsgEnvelope DecoratedSDoc) -> [String] errBagToStrList dflag style = map (ppErrMsg dflag style) . reverse . bagToList @@ -146,19 +121,6 @@      spn = errMsgSpan err      msg = pprLocMsgEnvelope err      -- fixme-#else-errBagToStrList :: DynFlags -> Gap.PprStyle -> Bag ErrMsg -> [String]-errBagToStrList dflag style = map (ppErrMsg dflag style) . reverse . bagToList--------------------------------------------------------------------ppErrMsg :: DynFlags -> Gap.PprStyle -> ErrMsg -> String-ppErrMsg dflag style err = ppMsg spn SevError dflag style msg -- ++ ext-   where-     spn = errMsgSpan err-     msg = pprLocErrMsg err-     -- fixme---     ext = showPage dflag style (pprLocErrMsg $ errMsgReason err) #endif  ppMsg :: SrcSpan -> G.Severity-> DynFlags -> Gap.PprStyle -> SDoc -> String

@@ -30,7 +30,7 @@           -> IO String debugInfo fp cradle = unlines <$> do     let logger = cradleLogger cradle-    res <- getCompilerOptions fp [] cradle+    res <- getCompilerOptions fp LoadFile cradle     canonFp <- canonicalizePath fp     conf <- findConfig canonFp     crdl <- findCradle' logger canonFp

@@ -13,9 +13,10 @@ #if MIN_VERSION_base(4,9,0) import qualified Control.Monad.Fail as Fail #endif-import Data.Text.Prettyprint.Doc-import System.Process.Extra (CreateProcess (env, cmdspec), CmdSpec (..))-import Data.Maybe (fromMaybe)+import           Data.Maybe (fromMaybe)+import qualified Data.Text as T+import           Prettyprinter+import           System.Process.Extra (CreateProcess (env, cmdspec), CmdSpec (..))  ---------------------------------------------------------------- -- Environment variables used by hie-bios.@@ -90,19 +91,22 @@   | Other a   deriving (Show, Eq, Ord, Functor) -data Log -  = LogAny String+data Log+  = LogAny !T.Text   | LogProcessOutput String   | LogCreateProcessRun CreateProcess   | LogProcessRun FilePath [FilePath]-  deriving Show+  | LogRequestedCradleLoadStyle !T.Text !LoadStyle+  | LogComputedCradleLoadStyle !T.Text !LoadStyle+  | LogLoadWithContextUnsupported !T.Text !(Maybe T.Text)+  deriving (Show)  instance Pretty Log where   pretty (LogAny s) = pretty s   pretty (LogProcessOutput s) = pretty s   pretty (LogProcessRun fp args) = pretty fp <+> pretty (unwords args)-  pretty (LogCreateProcessRun cp) =   -    vcat $ +  pretty (LogCreateProcessRun cp) =+    vcat $       [ case cmdspec cp of           ShellCommand sh -> pretty sh           RawCommand cmd args -> pretty cmd <+> pretty (unwords args)@@ -116,11 +120,45 @@           ]     where       envText = map (indent 2 . pretty) $ prettyProcessEnv cp+  pretty (LogRequestedCradleLoadStyle crdlName ls) =+    "Requested to load" <+> pretty crdlName <+> "cradle" <+> case ls of+      LoadFile -> "using single file mode"+      LoadWithContext fps -> "using all files (multi-components):" <> line <> indent 4 (pretty fps)+  pretty (LogComputedCradleLoadStyle crdlName ls) =+    "Load" <+> pretty crdlName <+> "cradle" <+> case ls of+      LoadFile -> "using single file"+      LoadWithContext _ -> "using all files (multi-components)" +  pretty (LogLoadWithContextUnsupported crdlName mReason) =+    pretty crdlName <+> "cradle doesn't support loading using all files (multi-components)" <>+      case mReason of+        Nothing -> "."+        Just reason -> ", because:" <+> pretty reason <> "."+      <+> "Falling back loading to single file mode."++-- | The 'LoadStyle' instructs a cradle on how to load a given file target.+data LoadStyle+  = LoadFile+  -- ^ Instruct the cradle to load the given file target.+  --+  -- What this entails depends on the cradle. For example, the 'cabal' cradle+  -- will configure the whole component the file target belongs to, and produce+  -- component options to load the component, which is the minimal unit of code in cabal repl.+  -- A 'default' cradle, on the other hand, will only load the given filepath.+  | LoadWithContext [FilePath]+  -- ^ Give a cradle additional context for loading a file target.+  --+  -- The context instructs the cradle to load the file target, while also loading+  -- the given filepaths.+  -- This is useful for cradles that support loading multiple code units at once,+  -- e.g. cabal cradles can use the 'multi-repl' feature to set up a multiple home unit+  -- session in GHC.+  deriving (Show, Eq, Ord)+ data CradleAction a = CradleAction {                         actionName    :: ActionName a                       -- ^ Name of the action.-                      , runCradle     :: FilePath -> [FilePath] -> IO (CradleLoadResult ComponentOptions)+                      , runCradle     :: FilePath -> LoadStyle -> IO (CradleLoadResult ComponentOptions)                       -- ^ Options to compile the given file with.                       , runGhcCmd     :: [String] -> IO (CradleLoadResult String)                       -- ^ Executes the @ghc@ binary that is usually used to@@ -183,7 +221,7 @@  instance Monad m => Monad (CradleLoadResultT m) where   {-# INLINE return #-}-  return = CradleLoadResultT . return . CradleSuccess+  return = pure   {-# INLINE (>>=) #-}   x >>= f = CradleLoadResultT $ do     val <- runCradleResultT x

@@ -350,18 +350,14 @@  stackYamlResolver :: String stackYamlResolver =-#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,6,2,0)))-  "nightly-2023-11-13" -- GHC 9.6.3-#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,4,4,0)))-  "lts-21.20" -- GHC 9.4.7-#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,2,7,0)))+#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)))+  "nightly-2024-02-26" -- GHC 9.8.1+#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)))+  "lts-22.12" -- GHC 9.6.4+#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)))+  "lts-21.25" -- GHC 9.4.8+#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)))   "lts-20.26" -- GHC 9.2.8-#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,2,1,0)))-  "lts-20.11" -- GHC 9.2.5-#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,0,1,0)))-  "lts-19.33" -- GHC 9.0.2-#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,10,7,0)))-  "lts-18.28" -- GHC 8.10.7 #endif  -- ------------------------------------------------------------------

@@ -269,7 +269,7 @@   a_fp <- normFile fp   crd <- askCradle   step $ "Initialise flags for: " <> fp-  clr <- liftIO $ getCompilerOptions a_fp [] crd+  clr <- liftIO $ getCompilerOptions a_fp LoadFile crd   setLoadResult clr  loadRuntimeGhcLibDir :: TestM ()