Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8347aad7 by Ben Gamari at 2025-11-29T08:41:12-05:00 gitlab-ci: Run ghcup-metadata jobs on OpenCape runners This significantly reduces our egress traffic and makes the jobs significantly faster. - - - - - fb6f9099 by Matthew Pickering at 2025-11-29T08:41:13-05:00 Use 'OsPath' in getModificationTimeIfExists This part of the compiler is quite hot during recompilation checking in particular since the filepaths will be translated to a string. It is better to use the 'OsPath' native function, which turns out to be easy to do. - - - - - 87667775 by Georgios Karachalias at 2025-11-29T08:41:21-05:00 Use OsPath in PkgDbRef and UnitDatabase, not FilePath - - - - - 14 changed files: - .gitlab-ci.yml - compiler/GHC/Data/OsPath.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Utils/Misc.hs - compiler/GHC/Utils/Outputable.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1184,6 +1184,10 @@ project-version: image: nixos/nix:2.25.2 dependencies: null tags: + # N.B. we use the OpenCape runners here since this job involves a significant + # amount of artifact fetching. This is much more efficient on these runners + # as they are near the GitLab box. + - opencape - x86_64-linux variables: BUILD_FLAVOUR: default ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -11,6 +11,15 @@ module GHC.Data.OsPath -- * Common utility functions , (</>) , (<.>) + , splitSearchPath + , isRelative + , dropTrailingPathSeparator + , takeDirectory + , isSuffixOf + , doesDirectoryExist + , doesFileExist + , getDirectoryContents + , createDirectoryIfMissing ) where @@ -20,6 +29,8 @@ import GHC.Utils.Misc (HasCallStack) import GHC.Utils.Panic (panic) import System.OsPath +import System.OsString (isSuffixOf) +import System.Directory.OsPath (doesDirectoryExist, doesFileExist, getDirectoryContents, createDirectoryIfMissing) import System.Directory.Internal (os) -- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed. ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -441,7 +441,7 @@ addUnit u = do Nothing -> panic "addUnit: called too early" Just dbs -> let newdb = UnitDatabase - { unitDatabasePath = "(in memory " ++ showSDoc dflags0 (ppr (unitId u)) ++ ")" + { unitDatabasePath = unsafeEncodeUtf $ "(in memory " ++ showSDoc dflags0 (ppr (unitId u)) ++ ")" , unitDatabaseUnits = [u] } in return (dbs ++ [newdb]) -- added at the end because ordering matters @@ -789,8 +789,8 @@ summariseRequirement pn mod_name = do env <- getBkpEnv src_hash <- liftIO $ getFileHash (bkp_filename env) - hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location) - hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location) + hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file_ospath location) + hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file_ospath location) let loc = srcLocSpan (mkSrcLoc (mkFastString (bkp_filename env)) 1 1) let fc = hsc_FC hsc_env @@ -875,8 +875,8 @@ hsModuleToModSummary home_keys pn hsc_src modname HsSrcFile -> os "hs") hsc_src -- This duplicates a pile of logic in GHC.Driver.Make - hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location) - hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location) + hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file_ospath location) + hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file_ospath location) -- Also copied from 'getImports' let (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -38,7 +38,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Driver.Ppr import GHC.Driver.Backend -import GHC.Data.OsPath +import GHC.Data.OsPath qualified as OsPath import qualified GHC.Data.ShortText as ST import GHC.Data.Stream ( liftIO ) import qualified GHC.Data.Stream as Stream @@ -61,8 +61,6 @@ import GHC.Types.ForeignStubs import GHC.Types.Unique.DSM import GHC.Types.Unique.Supply ( UniqueTag(..) ) -import System.Directory -import System.FilePath import System.IO import Data.Set (Set) import qualified Data.Set as Set @@ -321,10 +319,9 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs stub_h_file_exists <- case mkStubPaths (initFinderOpts dflags) (moduleName mod) location of Nothing -> pure False - Just path -> do - let stub_h = unsafeDecodeUtf path - createDirectoryIfMissing True (takeDirectory stub_h) - outputForeignStubs_help stub_h stub_h_output_w + Just stub_h -> do + OsPath.createDirectoryIfMissing True (OsPath.takeDirectory stub_h) + outputForeignStubs_help (OsPath.unsafeDecodeUtf stub_h) stub_h_output_w ("#include <HsFFI.h>\n" ++ cplusplus_hdr) cplusplus_ftr putDumpFileMaybe logger Opt_D_dump_foreign ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -1265,7 +1265,7 @@ checkSummaryHash | ms_hs_hash old_summary == src_hash && not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do -- update the object-file timestamp - obj_timestamp <- modificationTimeIfExists (ml_obj_file location) + obj_timestamp <- modificationTimeIfExists (ml_obj_file_ospath location) -- We have to repopulate the Finder's cache for file targets -- because the file might not even be on the regular search path @@ -1277,8 +1277,8 @@ checkSummaryHash hsc_src = ms_hsc_src old_summary addModuleToFinder fc mod location hsc_src - hi_timestamp <- modificationTimeIfExists (ml_hi_file location) - hie_timestamp <- modificationTimeIfExists (ml_hie_file location) + hi_timestamp <- modificationTimeIfExists (ml_hi_file_ospath location) + hie_timestamp <- modificationTimeIfExists (ml_hie_file_ospath location) return $ Right ( old_summary @@ -1482,11 +1482,11 @@ data MakeNewModSummary makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary makeNewModSummary hsc_env MakeNewModSummary{..} = do let PreprocessedImports{..} = nms_preimps - obj_timestamp <- modificationTimeIfExists (ml_obj_file nms_location) - dyn_obj_timestamp <- modificationTimeIfExists (ml_dyn_obj_file nms_location) - hi_timestamp <- modificationTimeIfExists (ml_hi_file nms_location) - hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location) - bytecode_timestamp <- modificationTimeIfExists (ml_bytecode_file nms_location) + obj_timestamp <- modificationTimeIfExists (ml_obj_file_ospath nms_location) + dyn_obj_timestamp <- modificationTimeIfExists (ml_dyn_obj_file_ospath nms_location) + hi_timestamp <- modificationTimeIfExists (ml_hi_file_ospath nms_location) + hie_timestamp <- modificationTimeIfExists (ml_hie_file_ospath nms_location) + bytecode_timestamp <- modificationTimeIfExists (ml_bytecode_file_ospath nms_location) extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name (implicit_sigs, _inst_deps) <- implicitRequirementsShallow (hscSetActiveUnitId (moduleUnitId nms_mod) hsc_env) pi_theimps ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -101,6 +101,7 @@ import GHC.Core.Unfold import GHC.Data.Bool import GHC.Data.EnumSet (EnumSet) import GHC.Data.Maybe +import GHC.Data.OsPath ( OsPath ) import GHC.Builtin.Names ( mAIN_NAME ) import GHC.Driver.Backend import GHC.Driver.Flags @@ -953,7 +954,7 @@ setDynamicNow dflags0 = data PkgDbRef = GlobalPkgDb | UserPkgDb - | PkgDbPath FilePath + | PkgDbPath OsPath deriving Eq ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1091,7 +1091,7 @@ loadIfaceByteCode hsc_env iface location type_env = linkable $ pure $ DotGBC bco linkable parts = do - if_time <- modificationTimeIfExists (ml_hi_file location) + if_time <- modificationTimeIfExists (ml_hi_file_ospath location) time <- maybe getCurrentTime pure if_time return $! Linkable time (mi_module iface) parts @@ -1112,7 +1112,7 @@ loadIfaceByteCodeLazy hsc_env iface location type_env = linkable $ NE.singleton (DotGBC bco) linkable parts = do - if_time <- modificationTimeIfExists (ml_hi_file location) + if_time <- modificationTimeIfExists (ml_hi_file_ospath location) time <- maybe getCurrentTime pure if_time return $!Linkable time (mi_module iface) parts @@ -2240,7 +2240,7 @@ generateAndWriteByteCodeLinkable hsc_env cgguts mod_location = do -- Either, get the same time as the .gbc file if it exists, or just the current time. -- It's important the time of the linkable matches the time of the .gbc file for recompilation -- checking. - bco_time <- maybe getCurrentTime pure =<< modificationTimeIfExists (ml_bytecode_file mod_location) + bco_time <- maybe getCurrentTime pure =<< modificationTimeIfExists (ml_bytecode_file_ospath mod_location) return $ mkModuleByteCodeLinkable bco_time bco_object mkModuleByteCode :: HscEnv -> Module -> ModLocation -> CgInteractiveGuts -> IO ModuleByteCode ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -730,17 +730,17 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do -- the object file for one module.) -- Note the nasty duplication with the same computation in compileFile above location <- mkOneShotModLocation pipe_env dflags src_flavour mod_name - let o_file = ml_obj_file location -- The real object file - hi_file = ml_hi_file location - hie_file = ml_hie_file location - dyn_o_file = ml_dyn_obj_file location + let o_file = ml_obj_file_ospath location -- The real object file + hi_file = ml_hi_file_ospath location + hie_file = ml_hie_file_ospath location + dyn_o_file = ml_dyn_obj_file_ospath location src_hash <- getFileHash (basename <.> suff) hi_date <- modificationTimeIfExists hi_file hie_date <- modificationTimeIfExists hie_file o_mod <- modificationTimeIfExists o_file dyn_o_mod <- modificationTimeIfExists dyn_o_file - bytecode_date <- modificationTimeIfExists (ml_bytecode_file location) + bytecode_date <- modificationTimeIfExists (ml_bytecode_file_ospath location) -- Tell the finder cache about this module mod <- do ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -300,6 +300,8 @@ import qualified Data.Set as Set import GHC.Types.Unique.Set import Data.Word import System.FilePath +import qualified GHC.Data.OsPath as OsPath + import Text.ParserCombinators.ReadP hiding (char) import Text.ParserCombinators.ReadP as R @@ -2071,7 +2073,7 @@ package_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))] package_flags_deps = [ ------- Packages ---------------------------------------------------- make_ord_flag defFlag "package-db" - (HasArg (addPkgDbRef . PkgDbPath)) + (HasArg (addPkgDbRef . PkgDbPath . OsPath.unsafeEncodeUtf)) , make_ord_flag defFlag "clear-package-db" (NoArg clearPkgDb) , make_ord_flag defFlag "no-global-package-db" (NoArg removeGlobalPkgDb) , make_ord_flag defFlag "no-user-package-db" (NoArg removeUserPkgDb) @@ -2081,7 +2083,7 @@ package_flags_deps = [ (NoArg (addPkgDbRef UserPkgDb)) -- backwards compat with GHC<=7.4 : , make_dep_flag defFlag "package-conf" - (HasArg $ addPkgDbRef . PkgDbPath) "Use -package-db instead" + (HasArg $ addPkgDbRef . PkgDbPath . OsPath.unsafeEncodeUtf) "Use -package-db instead" , make_dep_flag defFlag "no-user-package-conf" (NoArg removeUserPkgDb) "Use -no-user-package-db instead" , make_ord_flag defGhcFlag "package-name" (HasArg $ \name -> @@ -3307,7 +3309,7 @@ parseEnvFile :: FilePath -> String -> DynP () parseEnvFile envfile = mapM_ parseEntry . lines where parseEntry str = case words str of - ("package-db": _) -> addPkgDbRef (PkgDbPath (envdir </> db)) + ("package-db": _) -> addPkgDbRef (PkgDbPath (OsPath.unsafeEncodeUtf (envdir </> db))) -- relative package dbs are interpreted relative to the env file where envdir = takeDirectory envfile db = drop 11 str ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -658,8 +658,9 @@ findWholeCoreBindings hsc_env mod = do findBytecodeLinkableMaybe :: HscEnv -> Module -> ModLocation -> IO (Maybe Linkable) findBytecodeLinkableMaybe hsc_env mod locn = do - let bytecode_fn = ml_bytecode_file locn - maybe_bytecode_time <- modificationTimeIfExists bytecode_fn + let bytecode_fn = ml_bytecode_file locn + bytecode_fn_os = ml_bytecode_file_ospath locn + maybe_bytecode_time <- modificationTimeIfExists bytecode_fn_os case maybe_bytecode_time of Nothing -> return Nothing Just bytecode_time -> do ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -63,7 +63,6 @@ import GHC.Types.SourceFile import GHC.Fingerprint import Data.IORef -import System.Directory.OsPath import Control.Applicative ((<|>)) import Control.Monad import Data.Time @@ -826,7 +825,7 @@ mkStubPaths fopts mod location = do findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable) findObjectLinkableMaybe mod locn = do let obj_fn = ml_obj_file locn - maybe_obj_time <- modificationTimeIfExists obj_fn + maybe_obj_time <- modificationTimeIfExists (ml_obj_file_ospath locn) case maybe_obj_time of Nothing -> return Nothing Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time) ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -101,6 +101,8 @@ import GHC.Data.Maybe import System.Environment ( getEnv ) import GHC.Data.FastString +import GHC.Data.OsPath ( OsPath ) +import qualified GHC.Data.OsPath as OsPath import qualified GHC.Data.ShortText as ST import GHC.Utils.Logger import GHC.Utils.Error @@ -111,7 +113,7 @@ import System.FilePath as FilePath import Control.Monad import Data.Graph (stronglyConnComp, SCC(..)) import Data.Char ( toUpper ) -import Data.List ( intersperse, partition, sortBy, isSuffixOf, sortOn ) +import Data.List ( intersperse, partition, sortBy, sortOn ) import Data.Set (Set) import Data.Monoid (First(..)) import qualified Data.Semigroup as Semigroup @@ -407,7 +409,7 @@ initUnitConfig dflags cached_dbs home_units = where offsetPackageDb :: Maybe FilePath -> PackageDBFlag -> PackageDBFlag - offsetPackageDb (Just offset) (PackageDB (PkgDbPath p)) | isRelative p = PackageDB (PkgDbPath (offset </> p)) + offsetPackageDb (Just offset) (PackageDB (PkgDbPath p)) | OsPath.isRelative p = PackageDB (PkgDbPath (OsPath.unsafeEncodeUtf offset OsPath.</> p)) offsetPackageDb _ p = p @@ -502,12 +504,12 @@ emptyUnitState = UnitState { -- | Unit database data UnitDatabase unit = UnitDatabase - { unitDatabasePath :: FilePath + { unitDatabasePath :: OsPath , unitDatabaseUnits :: [GenUnitInfo unit] } instance Outputable u => Outputable (UnitDatabase u) where - ppr (UnitDatabase fp _u) = text "DB:" <+> text fp + ppr (UnitDatabase fp _u) = text "DB:" <+> ppr fp type UnitInfoMap = UniqMap UnitId UnitInfo @@ -722,9 +724,9 @@ getUnitDbRefs cfg = do Left _ -> system_conf_refs Right path | Just (xs, x) <- snocView path, isSearchPathSeparator x - -> map PkgDbPath (splitSearchPath xs) ++ system_conf_refs + -> map PkgDbPath (OsPath.splitSearchPath (OsPath.unsafeEncodeUtf xs)) ++ system_conf_refs | otherwise - -> map PkgDbPath (splitSearchPath path) + -> map PkgDbPath (OsPath.splitSearchPath (OsPath.unsafeEncodeUtf path)) -- Apply the package DB-related flags from the command line to get the -- final list of package DBs. @@ -753,24 +755,24 @@ getUnitDbRefs cfg = do -- NB: This logic is reimplemented in Cabal, so if you change it, -- make sure you update Cabal. (Or, better yet, dump it in the -- compiler info so Cabal can use the info.) -resolveUnitDatabase :: UnitConfig -> PkgDbRef -> IO (Maybe FilePath) -resolveUnitDatabase cfg GlobalPkgDb = return $ Just (unitConfigGlobalDB cfg) +resolveUnitDatabase :: UnitConfig -> PkgDbRef -> IO (Maybe OsPath) +resolveUnitDatabase cfg GlobalPkgDb = return $ Just $ OsPath.unsafeEncodeUtf $ unitConfigGlobalDB cfg resolveUnitDatabase cfg UserPkgDb = runMaybeT $ do dir <- versionedAppDir (unitConfigProgramName cfg) (unitConfigPlatformArchOS cfg) let pkgconf = dir </> unitConfigDBName cfg exist <- tryMaybeT $ doesDirectoryExist pkgconf - if exist then return pkgconf else mzero + if exist then return (OsPath.unsafeEncodeUtf pkgconf) else mzero resolveUnitDatabase _ (PkgDbPath name) = return $ Just name -readUnitDatabase :: Logger -> UnitConfig -> FilePath -> IO (UnitDatabase UnitId) +readUnitDatabase :: Logger -> UnitConfig -> OsPath -> IO (UnitDatabase UnitId) readUnitDatabase logger cfg conf_file = do - isdir <- doesDirectoryExist conf_file + isdir <- OsPath.doesDirectoryExist conf_file proto_pkg_configs <- if isdir then readDirStyleUnitInfo conf_file else do - isfile <- doesFileExist conf_file + isfile <- OsPath.doesFileExist conf_file if isfile then do mpkgs <- tryReadOldFileStyleUnitInfo @@ -778,48 +780,49 @@ readUnitDatabase logger cfg conf_file = do Just pkgs -> return pkgs Nothing -> throwGhcExceptionIO $ InstallationError $ "ghc no longer supports single-file style package " ++ - "databases (" ++ conf_file ++ + "databases (" ++ show conf_file ++ ") use 'ghc-pkg init' to create the database with " ++ "the correct format." else throwGhcExceptionIO $ InstallationError $ - "can't find a package database at " ++ conf_file + "can't find a package database at " ++ show conf_file let -- Fix #16360: remove trailing slash from conf_file before calculating pkgroot - conf_file' = dropTrailingPathSeparator conf_file - top_dir = unitConfigGHCDir cfg - pkgroot = takeDirectory conf_file' + conf_file' = OsPath.dropTrailingPathSeparator conf_file + top_dir = OsPath.unsafeEncodeUtf (unitConfigGHCDir cfg) + pkgroot = OsPath.takeDirectory conf_file' pkg_configs1 = map (mungeUnitInfo top_dir pkgroot . mapUnitInfo (\(UnitKey x) -> UnitId x) . mkUnitKeyInfo) proto_pkg_configs -- return $ UnitDatabase conf_file' pkg_configs1 where + readDirStyleUnitInfo :: OsPath -> IO [DbUnitInfo] readDirStyleUnitInfo conf_dir = do - let filename = conf_dir </> "package.cache" - cache_exists <- doesFileExist filename + let filename = conf_dir OsPath.</> (OsPath.unsafeEncodeUtf "package.cache") + cache_exists <- OsPath.doesFileExist filename if cache_exists then do - debugTraceMsg logger 2 $ text "Using binary package database:" <+> text filename - readPackageDbForGhc filename + debugTraceMsg logger 2 $ text "Using binary package database:" <+> ppr filename + readPackageDbForGhc (OsPath.unsafeDecodeUtf filename) else do -- If there is no package.cache file, we check if the database is not -- empty by inspecting if the directory contains any .conf file. If it -- does, something is wrong and we fail. Otherwise we assume that the -- database is empty. debugTraceMsg logger 2 $ text "There is no package.cache in" - <+> text conf_dir + <+> ppr conf_dir <> text ", checking if the database is empty" - db_empty <- all (not . isSuffixOf ".conf") - <$> getDirectoryContents conf_dir + db_empty <- all (not . OsPath.isSuffixOf (OsPath.unsafeEncodeUtf ".conf")) + <$> OsPath.getDirectoryContents conf_dir if db_empty then do debugTraceMsg logger 3 $ text "There are no .conf files in" - <+> text conf_dir <> text ", treating" + <+> ppr conf_dir <> text ", treating" <+> text "package database as empty" return [] else throwGhcExceptionIO $ InstallationError $ - "there is no package.cache in " ++ conf_dir ++ + "there is no package.cache in " ++ show conf_dir ++ " even though package database is not empty" @@ -832,13 +835,13 @@ readUnitDatabase logger cfg conf_file = do -- assumes it's a file and tries to overwrite with 'writeFile'. -- ghc-pkg also cooperates with this workaround. tryReadOldFileStyleUnitInfo = do - content <- readFile conf_file `catchIO` \_ -> return "" + content <- readFile (OsPath.unsafeDecodeUtf conf_file) `catchIO` \_ -> return "" if take 2 content == "[]" then do - let conf_dir = conf_file <.> "d" - direxists <- doesDirectoryExist conf_dir + let conf_dir = conf_file OsPath.<.> OsPath.unsafeEncodeUtf "d" + direxists <- OsPath.doesDirectoryExist conf_dir if direxists - then do debugTraceMsg logger 2 (text "Ignoring old file-style db and trying:" <+> text conf_dir) + then do debugTraceMsg logger 2 (text "Ignoring old file-style db and trying:" <+> ppr conf_dir) liftM Just (readDirStyleUnitInfo conf_dir) else return (Just []) -- ghc-pkg will create it when it's updated else return Nothing @@ -848,11 +851,11 @@ distrustAllUnits pkgs = map distrust pkgs where distrust pkg = pkg{ unitIsTrusted = False } -mungeUnitInfo :: FilePath -> FilePath +mungeUnitInfo :: OsPath -> OsPath -> UnitInfo -> UnitInfo mungeUnitInfo top_dir pkgroot = mungeDynLibFields - . mungeUnitInfoPaths (ST.pack top_dir) (ST.pack pkgroot) + . mungeUnitInfoPaths (ST.pack (OsPath.unsafeDecodeUtf top_dir)) (ST.pack (OsPath.unsafeDecodeUtf pkgroot)) mungeDynLibFields :: UnitInfo -> UnitInfo mungeDynLibFields pkg = @@ -1373,7 +1376,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] where merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ - text "loading package database" <+> text db_path + text "loading package database" <+> ppr db_path forM_ (Set.toList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -137,6 +137,8 @@ import Control.Monad ( guard ) import Control.Monad.IO.Class ( MonadIO, liftIO ) import System.IO.Error as IO ( isDoesNotExistError ) import System.Directory ( doesDirectoryExist, getModificationTime, renameFile ) +import qualified System.Directory.OsPath as OsPath +import System.OsPath (OsPath) import System.FilePath import Data.Bifunctor ( first, second ) @@ -1248,9 +1250,9 @@ getModificationUTCTime = getModificationTime -- -------------------------------------------------------------- -- check existence & modification time at the same time -modificationTimeIfExists :: FilePath -> IO (Maybe UTCTime) +modificationTimeIfExists :: OsPath -> IO (Maybe UTCTime) modificationTimeIfExists f = - (do t <- getModificationUTCTime f; return (Just t)) + (do t <- OsPath.getModificationTime f; return (Just t)) `catchIO` \e -> if isDoesNotExistError e then return Nothing else ioError e ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -149,6 +149,7 @@ import Data.String import Data.Word import System.IO ( Handle ) import System.FilePath +import System.OsPath (OsPath, decodeUtf) import Text.Printf import Numeric (showFFloat) import Numeric.Natural (Natural) @@ -1101,6 +1102,8 @@ instance Outputable Extension where instance Outputable ModuleName where ppr = pprModuleName +instance Outputable OsPath where + ppr p = text $ either show id (decodeUtf p) pprModuleName :: IsLine doc => ModuleName -> doc pprModuleName (ModuleName nm) = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80858c56b5a61321ff4ca4ffb397fa5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80858c56b5a61321ff4ca4ffb397fa5... You're receiving this email because of your account on gitlab.haskell.org.