[Git][ghc/ghc][wip/torsten.schmits/modlocation-ospath] use OsPath in ModLocation
Torsten Schmits (@torsten.schmits)
gitlab at gitlab.haskell.org
Fri Apr 12 16:56:48 UTC 2024
Torsten Schmits pushed to branch wip/torsten.schmits/modlocation-ospath at Glasgow Haskell Compiler / GHC
Commits:
bba242d9 by Torsten Schmits at 2024-04-12T18:56:30+02:00
use OsPath in ModLocation
submodule change: haddock
- - - - -
17 changed files:
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/GHC/Utils/Misc.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- utils/haddock
Changes:
=====================================
compiler/GHC/Driver/Backpack.hs
=====================================
@@ -771,7 +771,7 @@ summariseRequirement pn mod_name = do
let fopts = initFinderOpts dflags
let PackageName pn_fs = pn
- let location = mkHomeModLocation2 fopts mod_name
+ location <- liftIO $ mkHomeModLocation2 fopts mod_name
(unpackFS pn_fs </> moduleNameSlashes mod_name) "hsig"
env <- getBkpEnv
@@ -854,7 +854,7 @@ hsModuleToModSummary home_keys pn hsc_src modname
-- To add insult to injury, we don't even actually use
-- these filenames to figure out where the hi files go.
-- A travesty!
- let location0 = mkHomeModLocation2 fopts modname
+ location0 <- liftIO $ mkHomeModLocation2 fopts modname
(unpackFS unit_fs </>
moduleNameSlashes modname)
(case hsc_src of
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -279,6 +279,8 @@ import Control.Monad
import Data.IORef
import System.FilePath as FilePath
import System.Directory
+import qualified System.Directory.OsPath as OsPath
+import qualified System.OsPath as OsPath
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
@@ -611,7 +613,7 @@ extract_renamed_stuff mod_summary tc_result = do
-- I assume this fromJust is safe because `-fwrite-hie-file`
-- enables the option which keeps the renamed source.
hieFile <- mkHieFile mod_summary tc_result (fromJust rn_info)
- let out_file = ml_hie_file $ ms_location mod_summary
+ out_file <- liftIO $ msHieFilePath mod_summary
liftIO $ writeHieFile out_file hieFile
liftIO $ putDumpFileMaybe logger Opt_D_dump_hie "HIE AST" FormatHaskell (ppr $ hie_asts hieFile)
@@ -937,7 +939,9 @@ checkObjects dflags mb_old_linkable summary = do
Just old_linkable
| isObjectLinkable old_linkable, linkableTime old_linkable == obj_date
-> return $ UpToDateItem old_linkable
- _ -> UpToDateItem <$> findObjectLinkable this_mod obj_fn obj_date
+ _ -> do
+ file <- OsPath.decodeFS obj_fn
+ UpToDateItem <$> findObjectLinkable this_mod file obj_date
_ -> return $ outOfDateItemBecause MissingObjectFile Nothing
-- | Check to see if we can reuse the old linkable, by this point we will
@@ -1202,12 +1206,13 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
write_iface dflags' iface =
let !iface_name = if dynamicNow dflags' then ml_dyn_hi_file mod_location else ml_hi_file mod_location
profile = targetProfile dflags'
- in
- {-# SCC "writeIface" #-}
- withTiming logger
- (text "WriteIface"<+>brackets (text iface_name))
- (const ())
- (writeIface logger profile iface_name iface)
+ in do
+ path <- OsPath.decodeFS iface_name
+ {-# SCC "writeIface" #-}
+ withTiming logger
+ (text "WriteIface"<+>brackets (text path))
+ (const ())
+ (writeIface logger profile path iface)
if (write_interface || force_write_interface) then do
@@ -1262,8 +1267,9 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
-- existence just in case, so that we don't accidentally create empty
-- .hie files.
let hie_file = ml_hie_file mod_location
- whenM (doesFileExist hie_file) $
- GHC.Utils.Touch.touch hie_file
+ whenM (OsPath.doesFileExist hie_file) $ do
+ path <- OsPath.decodeFS hie_file
+ GHC.Utils.Touch.touch path
else
-- See Note [Strictness in ModIface]
forceModIface iface
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -123,6 +123,7 @@ import Data.List (sortOn)
import Data.Bifunctor (first)
import System.Directory
import System.FilePath
+import qualified System.OsPath as OsPath
import System.IO ( fixIO )
import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )
@@ -1830,7 +1831,9 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph =
tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf
let dyn_tn = tn -<.> dynsuf
addFilesToClean tmpfs dynLife [dyn_tn]
- return (tn, dyn_tn)
+ tn_os <- OsPath.encodeFS tn
+ dyn_tn_os <- OsPath.encodeFS dyn_tn
+ return (tn_os, dyn_tn_os)
-- We don't want to create .o or .hi files unless we have been asked
-- to by the user. But we need them, so we patch their locations in
-- the ModSummary with temporary files.
@@ -2037,7 +2040,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
let fopts = initFinderOpts (hsc_dflags hsc_env)
-- Make a ModLocation for this file
- let location = mkHomeModLocation fopts pi_mod_name src_fn
+ location <- liftIO (mkHomeModLocation fopts pi_mod_name src_fn)
-- Tell the Finder cache where it is, so that subsequent calls
-- to findModule will find it, even if it's not on any search path
=====================================
compiler/GHC/Driver/MakeFile.hs
=====================================
@@ -223,10 +223,10 @@ processDeps dflags _ _ _ _ (AcyclicSCC (InstantiationNode _uid node))
processDeps _dflags _ _ _ _ (AcyclicSCC (LinkNode {})) = return ()
processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ node))
- = do { let extra_suffixes = depSuffixes dflags
+ = do { obj_file <- msObjFilePath node
+ ; let extra_suffixes = depSuffixes dflags
include_pkg_deps = depIncludePkgDeps dflags
src_file = msHsFilePath node
- obj_file = msObjFilePath node
obj_files = insertSuffixes obj_file extra_suffixes
do_imp loc is_boot pkg_qual imp_mod
@@ -251,8 +251,8 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ node))
-- add dependency between objects and their corresponding .hi-boot
-- files if the module has a corresponding .hs-boot file (#14482)
; when (isBootSummary node == IsBoot) $ do
- let hi_boot = msHiFilePath node
- let obj = removeBootSuffix (msObjFilePath node)
+ hi_boot <- msHiFilePath node
+ let obj = removeBootSuffix obj_file
forM_ extra_suffixes $ \suff -> do
let way_obj = insertSuffixes obj [suff]
let way_hi_boot = insertSuffixes hi_boot [suff]
@@ -297,7 +297,9 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
Found loc _
-- Home package: just depend on the .hi or hi-boot file
| isJust (ml_hs_file loc) || include_pkg_deps
- -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
+ -> do
+ hi_file <- mlHiFilePath loc
+ return (Just (addBootSuffix_maybe is_boot hi_file))
-- Not in this package: we don't need a dependency
| otherwise
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -229,12 +229,12 @@ compileOne' mHscMessage
debugTraceMsg logger 2 (text "compile: input file" <+> text input_fnpp)
- unless (gopt Opt_KeepHiFiles lcl_dflags) $
- addFilesToClean tmpfs TFL_CurrentModule $
- [ml_hi_file $ ms_location summary]
- unless (gopt Opt_KeepOFiles lcl_dflags) $
- addFilesToClean tmpfs TFL_GhcSession $
- [ml_obj_file $ ms_location summary]
+ unless (gopt Opt_KeepHiFiles lcl_dflags) $ do
+ file <- msHiFilePath summary
+ addFilesToClean tmpfs TFL_CurrentModule [file]
+ unless (gopt Opt_KeepOFiles lcl_dflags) $ do
+ file <- msObjFilePath summary
+ addFilesToClean tmpfs TFL_GhcSession [file]
-- Initialise plugins here for any plugins enabled locally for a module.
plugin_hsc_env <- initializePlugins hsc_env
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -48,6 +48,7 @@ import GHC.SysTools
import GHC.SysTools.Cpp
import System.Directory
import System.FilePath
+import qualified System.OsPath as OsPath
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Unit.Info
@@ -526,8 +527,8 @@ runHscBackendPhase :: PipeEnv
runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
let dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
- o_file = if dynamicNow dflags then ml_dyn_obj_file location else ml_obj_file location -- The real object file
next_phase = hscPostBackendPhase src_flavour (backend dflags)
+ o_file <- if dynamicNow dflags then mlDynObjFilePath location else mlObjFilePath location -- The real object file
case result of
HscUpdate iface ->
if | not (backendGeneratesCode (backend dflags)) ->
@@ -759,7 +760,7 @@ mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO Mod
mkOneShotModLocation pipe_env dflags src_flavour mod_name = do
let PipeEnv{ src_basename=basename,
src_suffix=suff } = pipe_env
- let location1 = mkHomeModLocation2 fopts mod_name basename suff
+ location1 <- mkHomeModLocation2 fopts mod_name basename suff
-- Boot-ify it if necessary
let location2
@@ -770,12 +771,12 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do
-- Take -ohi into account if present
-- This can't be done in mkHomeModuleLocation because
-- it only applies to the module being compiles
- let ohi = outputHi dflags
- location3 | Just fn <- ohi = location2{ ml_hi_file = fn }
+ ohi <- traverse OsPath.encodeFS (outputHi dflags)
+ let location3 | Just fn <- ohi = location2{ ml_hi_file = fn }
| otherwise = location2
- let dynohi = dynOutputHi dflags
- location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn }
+ dynohi <- traverse OsPath.encodeFS (dynOutputHi dflags)
+ let location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn }
| otherwise = location3
-- Take -o into account if present
@@ -784,10 +785,11 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do
-- the object file for one module.)
-- Note the nasty duplication with the same computation in compileFile
-- above
- let expl_o_file = outputFile_ dflags
- expl_dyn_o_file = dynOutputFile_ dflags
- location5 | Just ofile <- expl_o_file
- , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file
+ expl_o_file <- traverse OsPath.encodeFS (outputFile_ dflags)
+ expl_dyn_o_file <- traverse OsPath.encodeFS (dynOutputFile_ dflags)
+ o_suf <- OsPath.encodeFS (dynObjectSuf_ dflags)
+ let location5 | Just ofile <- expl_o_file
+ , let dyn_ofile = fromMaybe (ofile OsPath.-<.> o_suf) expl_dyn_o_file
, isNoLink (ghcLink dflags)
= location4 { ml_obj_file = ofile
, ml_dyn_obj_file = dyn_ofile }
@@ -867,8 +869,8 @@ getOutputFilename logger tmpfs stop_phase output basename dflags next_phase mayb
-- 1. If we are generating object files for a .hs file, then return the odir as the ModLocation
-- will have been modified to point to the accurate locations
| StopLn <- next_phase, Just loc <- maybe_location =
- return $ if dynamicNow dflags then ml_dyn_obj_file loc
- else ml_obj_file loc
+ OsPath.decodeFS $ if dynamicNow dflags then ml_dyn_obj_file loc
+ else ml_obj_file loc
-- 2. If output style is persistent then
| is_last_phase, Persistent <- output = persistent_fn
-- 3. Specific file is only set when outputFile is set by -o
=====================================
compiler/GHC/Iface/Errors/Ppr.hs
=====================================
@@ -351,8 +351,8 @@ hiModuleNameMismatchWarn requested_mod read_mod
dynamicHashMismatchError :: Module -> ModLocation -> SDoc
dynamicHashMismatchError wanted_mod loc =
vcat [ text "Dynamic hash doesn't match for" <+> quotes (ppr wanted_mod)
- , text "Normal interface file from" <+> text (ml_hi_file loc)
- , text "Dynamic interface file from" <+> text (ml_dyn_hi_file loc)
+ , text "Normal interface file from" <+> text (mlHiFilePathLenient loc)
+ , text "Dynamic interface file from" <+> text (mlDynHiFilePathLenient loc)
, text "You probably need to recompile" <+> quotes (ppr wanted_mod) ]
homeModError :: InstalledModule -> ModLocation -> SDoc
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -114,6 +114,7 @@ import Control.Monad
import Data.Map ( toList )
import System.FilePath
import System.Directory
+import qualified System.OsPath as OsPath
import GHC.Driver.Env.KnotVars
import GHC.Iface.Errors.Types
@@ -893,7 +894,8 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
, not (isOneShot (ghcMode dflags))
-> return (Failed (HomeModError mod loc))
_ -> do
- r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
+ file <- OsPath.decodeFS (ml_hi_file loc)
+ r <- read_file logger name_cache unit_state dflags wanted_mod file
case r of
Failed err
-> return (Failed $ BadIfaceFile err)
@@ -928,7 +930,8 @@ load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags
-> Module -> ModIface -> ModLocation
-> IO (MaybeErr MissingInterfaceError ())
load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
- read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
+ file <- OsPath.decodeFS (ml_dyn_hi_file loc)
+ read_file logger name_cache unit_state dflags wanted_mod file >>= \case
Succeeded (dynIface, _)
| mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface)
-> return (Succeeded ())
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -287,7 +287,7 @@ check_old_iface hsc_env mod_summary maybe_iface
trace_if logger (text "We already have the old interface for" <+>
ppr (ms_mod mod_summary))
return maybe_iface
- Nothing -> loadIface dflags (msHiFilePath mod_summary)
+ Nothing -> loadIface dflags =<< liftIO (msHiFilePath mod_summary)
loadIface read_dflags iface_path = do
let ncu = hsc_NC hsc_env
@@ -312,7 +312,8 @@ check_old_iface hsc_env mod_summary maybe_iface
res <- recomp_check
case res of
UpToDateItem _ -> do
- maybe_dyn_iface <- liftIO $ loadIface (setDynamicNow dflags) (msDynHiFilePath mod_summary)
+ path <- liftIO $ msDynHiFilePath mod_summary
+ maybe_dyn_iface <- liftIO $ loadIface (setDynamicNow dflags) path
case maybe_dyn_iface of
Nothing -> return $ outOfDateItemBecause MissingDynHiFile Nothing
Just dyn_iface | mi_iface_hash (mi_final_exts dyn_iface)
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -60,19 +60,22 @@ import GHC.Linker.Types
import GHC.Types.PkgQual
import GHC.Fingerprint
-import Data.IORef
-import System.Directory
-import System.FilePath
-import Control.Monad
-import Data.Time
-import qualified Data.Map as M
import GHC.Driver.Env
( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env) )
import GHC.Driver.Config.Finder
+
+import Control.Monad
+import Data.IORef
+import qualified Data.Map as M
import qualified Data.Set as Set
+import Data.Time
+import Data.Traversable (for)
+import System.FilePath
+import qualified System.Directory.OsPath as OsPath
+import System.OsPath (OsPath)
+import qualified System.OsPath as OsPath
type FileExt = String -- Filename extension
-type BaseName = String -- Basename of file
-- -----------------------------------------------------------------------------
-- The Finder
@@ -390,7 +393,6 @@ findHomePackageModule fc fopts home_unit mod_name = do
fr_suggestions = []
}
-
-- | Implements the search for a module name in the home package only. Calling
-- this function directly is usually *not* what you want; currently, it's used
-- as a building block for the following operations:
@@ -408,55 +410,56 @@ findHomePackageModule fc fopts home_unit mod_name = do
-- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to
-- call this.)
findInstalledHomeModule :: FinderCache -> FinderOpts -> UnitId -> ModuleName -> IO InstalledFindResult
-findInstalledHomeModule fc fopts home_unit mod_name = do
- homeSearchCache fc home_unit mod_name $
- let
- maybe_working_dir = finder_workingDirectory fopts
- home_path = case maybe_working_dir of
- Nothing -> finder_importPaths fopts
- Just fp -> augmentImports fp (finder_importPaths fopts)
- hi_dir_path =
- case finder_hiDir fopts of
- Just hiDir -> case maybe_working_dir of
- Nothing -> [hiDir]
- Just fp -> [fp </> hiDir]
+findInstalledHomeModule fc fopts home_unit mod_name =
+ homeSearchCache fc home_unit mod_name $ do
+ maybe_working_dir <- traverse OsPath.encodeFS (finder_workingDirectory fopts)
+ import_paths <- traverse OsPath.encodeFS (finder_importPaths fopts)
+ let
+ home_path = case maybe_working_dir of
+ Nothing -> import_paths
+ Just fp -> augmentImports fp import_paths
+ hiDir <- traverse OsPath.encodeFS (finder_hiDir fopts)
+ hisuf <- OsPath.encodeFS (finder_hiSuf fopts)
+ let
+ hi_dir_path = case hiDir of
+ Just hd -> case maybe_working_dir of
+ Nothing -> [hd]
+ Just fp -> [fp OsPath.</> hd]
Nothing -> home_path
- hisuf = finder_hiSuf fopts
- mod = mkModule home_unit mod_name
-
- source_exts =
- [ ("hs", mkHomeModLocationSearched fopts mod_name "hs")
- , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs")
- , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig")
- , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig")
- ]
-
- -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that
- -- when hiDir field is set in dflags, we know to look there (see #16500)
- hi_exts = [ (hisuf, mkHomeModHiOnlyLocation fopts mod_name)
- , (addBootSuffix hisuf, mkHomeModHiOnlyLocation fopts mod_name)
- ]
-
- -- In compilation manager modes, we look for source files in the home
- -- package because we can compile these automatically. In one-shot
- -- compilation mode we look for .hi and .hi-boot files only.
- (search_dirs, exts)
- | finder_lookupHomeInterfaces fopts = (hi_dir_path, hi_exts)
- | otherwise = (home_path, source_exts)
- in
-
- -- special case for GHC.Prim; we won't find it in the filesystem.
- -- This is important only when compiling the base package (where GHC.Prim
- -- is a home module).
- if mod `installedModuleEq` gHC_PRIM
- then return (InstalledFound (error "GHC.Prim ModLocation") mod)
- else searchPathExts search_dirs mod exts
+
+ source_exts <- for ["hs", "lhs", "hsig", "lhsig"] $ \ ext -> do
+ ext' <- OsPath.encodeFS ext
+ pure (ext', mkHomeModLocationSearched fopts mod_name ext)
+
+ let
+ mod = mkModule home_unit mod_name
+
+ -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that
+ -- when hiDir field is set in dflags, we know to look there (see #16500)
+ hi_exts =
+ [ (hisuf, mkHomeModHiOnlyLocation fopts mod_name)
+ , (addBootSuffixOsPath hisuf, mkHomeModHiOnlyLocation fopts mod_name)
+ ]
+
+ -- In compilation manager modes, we look for source files in the home
+ -- package because we can compile these automatically. In one-shot
+ -- compilation mode we look for .hi and .hi-boot files only.
+ (search_dirs, exts)
+ | finder_lookupHomeInterfaces fopts = (hi_dir_path, hi_exts)
+ | otherwise = (home_path, source_exts)
+
+ -- special case for GHC.Prim; we won't find it in the filesystem.
+ -- This is important only when compiling the base package (where GHC.Prim
+ -- is a home module).
+ if mod `installedModuleEq` gHC_PRIM
+ then return (InstalledFound (error "GHC.Prim ModLocation") mod)
+ else searchPathExts search_dirs mod exts
-- | Prepend the working directory to the search path.
-augmentImports :: FilePath -> [FilePath] -> [FilePath]
+augmentImports :: OsPath -> [OsPath] -> [OsPath]
augmentImports _work_dir [] = []
-augmentImports work_dir (fp:fps) | isAbsolute fp = fp : augmentImports work_dir fps
- | otherwise = (work_dir </> fp) : augmentImports work_dir fps
+augmentImports work_dir (fp:fps) | OsPath.isAbsolute fp = fp : augmentImports work_dir fps
+ | otherwise = (work_dir OsPath.</> fp) : augmentImports work_dir fps
-- | Search for a module in external packages only.
findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModule -> IO InstalledFindResult
@@ -482,70 +485,75 @@ findPackageModule_ fc fopts mod pkg_conf = do
-- special case for GHC.Prim; we won't find it in the filesystem.
if mod `installedModuleEq` gHC_PRIM
then return (InstalledFound (error "GHC.Prim ModLocation") mod)
- else
+ else do
let
tag = waysBuildTag (finder_ways fopts)
-- hi-suffix for packages depends on the build tag.
- package_hisuf | null tag = "hi"
- | otherwise = tag ++ "_hi"
-
- package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi"
+ package_hisuf <- OsPath.encodeFS $ if null tag then "hi" else tag ++ "_hi"
+ package_dynhisuf <- OsPath.encodeFS $
+ waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi"
+ let
mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf
-
- import_dirs = map ST.unpack $ unitImportDirs pkg_conf
-- we never look for a .hi-boot file in an external package;
-- .hi-boot files only make sense for the home package.
- in
+ import_dirs <- traverse (OsPath.encodeFS . ST.unpack) $ unitImportDirs pkg_conf
case import_dirs of
- [one] | finder_bypassHiFileCheck fopts ->
+ [one] | finder_bypassHiFileCheck fopts -> do
-- there's only one place that this .hi file can be, so
-- don't bother looking for it.
- let basename = moduleNameSlashes (moduleName mod)
- loc = mk_hi_loc one basename
- in return $ InstalledFound loc mod
+ basename <- OsPath.encodeFS (moduleNameSlashes (moduleName mod))
+ loc <- mk_hi_loc one basename
+ return $ InstalledFound loc mod
_otherwise ->
searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
-- -----------------------------------------------------------------------------
-- General path searching
-searchPathExts :: [FilePath] -- paths to search
+searchPathExts :: [OsPath] -- paths to search
-> InstalledModule -- module name
-> [ (
- FileExt, -- suffix
- FilePath -> BaseName -> ModLocation -- action
+ OsPath, -- suffix
+ OsPath -> OsPath -> IO ModLocation -- action
)
]
-> IO InstalledFindResult
-searchPathExts paths mod exts = search to_search
- where
- basename = moduleNameSlashes (moduleName mod)
-
- to_search :: [(FilePath, ModLocation)]
+searchPathExts paths mod exts = do
+ basename <- OsPath.encodeFS (moduleNameSlashes (moduleName mod))
+ dot <- OsPath.encodeFS "."
+ let
+ to_search :: [(OsPath, IO ModLocation)]
to_search = [ (file, fn path basename)
| path <- paths,
(ext,fn) <- exts,
- let base | path == "." = basename
- | otherwise = path </> basename
- file = base <.> ext
+ let base | path == dot = basename
+ | otherwise = path OsPath.</> basename
+ file = base OsPath.<.> ext
]
- search [] = return (InstalledNotFound (map fst to_search) (Just (moduleUnit mod)))
+ search [] = do
+ fps <- traverse (OsPath.decodeFS . fst) to_search
+ return (InstalledNotFound fps (Just (moduleUnit mod)))
- search ((file, loc) : rest) = do
- b <- doesFileExist file
+ search ((file, getLoc) : rest) = do
+ b <- OsPath.doesFileExist file
if b
- then return $ InstalledFound loc mod
+ then do
+ loc <- getLoc
+ return $ InstalledFound loc mod
else search rest
+ search to_search
+ where
+
mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt
- -> FilePath -> BaseName -> ModLocation
-mkHomeModLocationSearched fopts mod suff path basename =
- mkHomeModLocation2 fopts mod (path </> basename) suff
+ -> OsPath -> OsPath -> IO ModLocation
+mkHomeModLocationSearched fopts mod ext path basename = do
+ mkHomeModLocationOsPath fopts mod (path OsPath.</> basename) ext
-- -----------------------------------------------------------------------------
@@ -581,7 +589,7 @@ mkHomeModLocationSearched fopts mod suff path basename =
-- ext
-- The filename extension of the source file (usually "hs" or "lhs").
-mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation
+mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> IO ModLocation
mkHomeModLocation dflags mod src_filename =
let (basename,extension) = splitExtension src_filename
in mkHomeModLocation2 dflags mod basename extension
@@ -590,129 +598,108 @@ mkHomeModLocation2 :: FinderOpts
-> ModuleName
-> FilePath -- Of source module, without suffix
-> String -- Suffix
- -> ModLocation
-mkHomeModLocation2 fopts mod src_basename ext =
- let mod_basename = moduleNameSlashes mod
-
- obj_fn = mkObjPath fopts src_basename mod_basename
- dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename
- hi_fn = mkHiPath fopts src_basename mod_basename
- dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename
- hie_fn = mkHiePath fopts src_basename mod_basename
-
- in (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
- ml_hi_file = hi_fn,
- ml_dyn_hi_file = dyn_hi_fn,
- ml_obj_file = obj_fn,
- ml_dyn_obj_file = dyn_obj_fn,
- ml_hie_file = hie_fn })
+ -> IO ModLocation
+mkHomeModLocation2 fopts mod src_basename ext = do
+ src_basename_os <- OsPath.encodeFS src_basename
+ mkHomeModLocationOsPath fopts mod src_basename_os ext
+
+mkHomeModLocationOsPath :: FinderOpts
+ -> ModuleName
+ -> OsPath -- Of source module, without suffix
+ -> FileExt
+ -> IO ModLocation
+mkHomeModLocationOsPath fopts mod src_basename ext = do
+ mod_basename <- OsPath.encodeFS (moduleNameSlashes mod)
+ obj_fn <- mkObjPath fopts src_basename mod_basename
+ dyn_obj_fn <- mkDynObjPath fopts src_basename mod_basename
+ hi_fn <- mkHiPath fopts src_basename mod_basename
+ dyn_hi_fn <- mkDynHiPath fopts src_basename mod_basename
+ hie_fn <- mkHiePath fopts src_basename mod_basename
+ original <- OsPath.decodeFS src_basename
+ pure ModLocation {
+ ml_hs_file = Just (original <.> ext),
+ ml_hi_file = hi_fn,
+ ml_dyn_hi_file = dyn_hi_fn,
+ ml_obj_file = obj_fn,
+ ml_dyn_obj_file = dyn_obj_fn,
+ ml_hie_file = hie_fn
+ }
mkHomeModHiOnlyLocation :: FinderOpts
-> ModuleName
- -> FilePath
- -> BaseName
- -> ModLocation
-mkHomeModHiOnlyLocation fopts mod path basename =
- let loc = mkHomeModLocation2 fopts mod (path </> basename) ""
- in loc { ml_hs_file = Nothing }
+ -> OsPath
+ -> OsPath
+ -> IO ModLocation
+mkHomeModHiOnlyLocation fopts mod path basename = do
+ loc <- mkHomeModLocationOsPath fopts mod (path OsPath.</> basename) ""
+ pure loc { ml_hs_file = Nothing }
-- This function is used to make a ModLocation for a package module. Hence why
-- we explicitly pass in the interface file suffixes.
-mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String
- -> ModLocation
-mkHiOnlyModLocation fopts hisuf dynhisuf path basename
- = let full_basename = path </> basename
- obj_fn = mkObjPath fopts full_basename basename
- dyn_obj_fn = mkDynObjPath fopts full_basename basename
- hie_fn = mkHiePath fopts full_basename basename
- in ModLocation{ ml_hs_file = Nothing,
- ml_hi_file = full_basename <.> hisuf,
- -- Remove the .hi-boot suffix from
- -- hi_file, if it had one. We always
- -- want the name of the real .hi file
- -- in the ml_hi_file field.
- ml_dyn_obj_file = dyn_obj_fn,
- -- MP: TODO
- ml_dyn_hi_file = full_basename <.> dynhisuf,
- ml_obj_file = obj_fn,
- ml_hie_file = hie_fn
- }
+mkHiOnlyModLocation :: FinderOpts -> OsPath -> OsPath -> OsPath -> OsPath
+ -> IO ModLocation
+mkHiOnlyModLocation fopts hisuf dynhisuf path basename = do
+ let full_basename = path OsPath.</> basename
+ obj_fn <- mkObjPath fopts full_basename basename
+ dyn_obj_fn <- mkDynObjPath fopts full_basename basename
+ hie_fn <- mkHiePath fopts full_basename basename
+ pure ModLocation {
+ ml_hs_file = Nothing,
+ ml_hi_file = full_basename OsPath.<.> hisuf,
+ -- Remove the .hi-boot suffix from
+ -- hi_file, if it had one. We always
+ -- want the name of the real .hi file
+ -- in the ml_hi_file field.
+ ml_dyn_obj_file = dyn_obj_fn,
+ -- MP: TODO
+ ml_dyn_hi_file = full_basename OsPath.<.> dynhisuf,
+ ml_obj_file = obj_fn,
+ ml_hie_file = hie_fn
+ }
+
+mk_path
+ :: (FinderOpts -> Maybe FilePath)
+ -> (FinderOpts -> FilePath)
+ -> FinderOpts
+ -> OsPath -- the filename of the source file, minus the extension
+ -> OsPath -- the module name with dots replaced by slashes
+ -> IO OsPath
+mk_path get_suf_dir get_suf fopts basename mod_basename = do
+ suf <- OsPath.encodeFS (get_suf fopts)
+ suf_dir <- traverse OsPath.encodeFS (get_suf_dir fopts)
+ let
+ obj_basename
+ | Just dir <- suf_dir
+ = dir OsPath.</> mod_basename
+ | otherwise
+ = basename
+ pure (obj_basename OsPath.<.> suf)
-- | Constructs the filename of a .o file for a given source file.
-- Does /not/ check whether the .o file exists
-mkObjPath
- :: FinderOpts
- -> FilePath -- the filename of the source file, minus the extension
- -> String -- the module name with dots replaced by slashes
- -> FilePath
-mkObjPath fopts basename mod_basename = obj_basename <.> osuf
- where
- odir = finder_objectDir fopts
- osuf = finder_objectSuf fopts
-
- obj_basename | Just dir <- odir = dir </> mod_basename
- | otherwise = basename
+mkObjPath :: FinderOpts -> OsPath -> OsPath -> IO OsPath
+mkObjPath = mk_path finder_objectDir finder_objectSuf
-- | Constructs the filename of a .dyn_o file for a given source file.
-- Does /not/ check whether the .dyn_o file exists
-mkDynObjPath
- :: FinderOpts
- -> FilePath -- the filename of the source file, minus the extension
- -> String -- the module name with dots replaced by slashes
- -> FilePath
-mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf
- where
- odir = finder_objectDir fopts
- dynosuf = finder_dynObjectSuf fopts
-
- obj_basename | Just dir <- odir = dir </> mod_basename
- | otherwise = basename
+mkDynObjPath :: FinderOpts -> OsPath -> OsPath -> IO OsPath
+mkDynObjPath = mk_path finder_objectDir finder_dynObjectSuf
-- | Constructs the filename of a .hi file for a given source file.
-- Does /not/ check whether the .hi file exists
-mkHiPath
- :: FinderOpts
- -> FilePath -- the filename of the source file, minus the extension
- -> String -- the module name with dots replaced by slashes
- -> FilePath
-mkHiPath fopts basename mod_basename = hi_basename <.> hisuf
- where
- hidir = finder_hiDir fopts
- hisuf = finder_hiSuf fopts
-
- hi_basename | Just dir <- hidir = dir </> mod_basename
- | otherwise = basename
+mkHiPath :: FinderOpts -> OsPath -> OsPath -> IO OsPath
+mkHiPath = mk_path finder_hiDir finder_hiSuf
-- | Constructs the filename of a .dyn_hi file for a given source file.
-- Does /not/ check whether the .dyn_hi file exists
-mkDynHiPath
- :: FinderOpts
- -> FilePath -- the filename of the source file, minus the extension
- -> String -- the module name with dots replaced by slashes
- -> FilePath
-mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf
- where
- hidir = finder_hiDir fopts
- dynhisuf = finder_dynHiSuf fopts
-
- hi_basename | Just dir <- hidir = dir </> mod_basename
- | otherwise = basename
+mkDynHiPath :: FinderOpts -> OsPath -> OsPath -> IO OsPath
+mkDynHiPath = mk_path finder_hiDir finder_dynHiSuf
-- | Constructs the filename of a .hie file for a given source file.
-- Does /not/ check whether the .hie file exists
-mkHiePath
- :: FinderOpts
- -> FilePath -- the filename of the source file, minus the extension
- -> String -- the module name with dots replaced by slashes
- -> FilePath
-mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf
- where
- hiedir = finder_hieDir fopts
- hiesuf = finder_hieSuf fopts
-
- hie_basename | Just dir <- hiedir = dir </> mod_basename
- | otherwise = basename
+mkHiePath :: FinderOpts -> OsPath -> OsPath -> IO OsPath
+mkHiePath = mk_path finder_hieDir finder_hieSuf
@@ -750,11 +737,13 @@ mkStubPaths fopts mod location
findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
findObjectLinkableMaybe mod locn
- = do let obj_fn = ml_obj_file locn
- maybe_obj_time <- modificationTimeIfExists obj_fn
+ = do let obj_op = ml_obj_file locn
+ maybe_obj_time <- modificationTimeIfExists obj_op
case maybe_obj_time of
Nothing -> return Nothing
- Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
+ Just obj_time -> do
+ obj_fn <- OsPath.decodeFS obj_op
+ liftM Just (findObjectLinkable mod obj_fn obj_time)
-- Make an object linkable when we know the object file exists, and we know
-- its modification time.
=====================================
compiler/GHC/Unit/Module/Graph.hs
=====================================
@@ -284,8 +284,8 @@ showModMsg dflags recomp (ModuleNode _ mod_summary) =
op = normalise
mod_str = moduleNameString (moduleName (ms_mod mod_summary)) ++
hscSourceString (ms_hsc_src mod_summary)
- dyn_file = op $ msDynObjFilePath mod_summary
- obj_file = op $ msObjFilePath mod_summary
+ dyn_file = op $ msDynObjFilePathLenient mod_summary
+ obj_file = op $ msObjFilePathLenient mod_summary
files = [ obj_file ]
++ [ dyn_file | gopt Opt_BuildDynamicToo dflags ]
++ [ "interpreted" | gopt Opt_ByteCodeAndObjectCode dflags ]
=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -2,17 +2,32 @@
module GHC.Unit.Module.Location
( ModLocation(..)
, addBootSuffix
+ , addBootSuffixOsPath
, addBootSuffix_maybe
, addBootSuffixLocn_maybe
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
+ , mlHiFilePath
+ , mlDynHiFilePath
+ , mlObjFilePath
+ , mlDynObjFilePath
+ , mlHieFilePath
+ , mlHiFilePathLenient
+ , mlDynHiFilePathLenient
+ , mlObjFilePathLenient
+ , mlDynObjFilePathLenient
+ , mlHieFilePathLenient
)
where
+import GHC.Data.Maybe (expectJust)
import GHC.Prelude
import GHC.Unit.Types
import GHC.Utils.Outputable
+import System.OsPath (OsPath)
+import qualified System.OsPath as OsPath
+import qualified Data.Semigroup as Semigroup
-- | Module Location
--
@@ -43,26 +58,26 @@ data ModLocation
-- ^ The source file, if we have one. Package modules
-- probably don't have source files.
- ml_hi_file :: FilePath,
+ ml_hi_file :: OsPath,
-- ^ Where the .hi file is, whether or not it exists
-- yet. Always of form foo.hi, even if there is an
-- hi-boot file (we add the -boot suffix later)
- ml_dyn_hi_file :: FilePath,
+ ml_dyn_hi_file :: OsPath,
-- ^ Where the .dyn_hi file is, whether or not it exists
-- yet.
- ml_obj_file :: FilePath,
+ ml_obj_file :: OsPath,
-- ^ Where the .o file is, whether or not it exists yet.
-- (might not exist either because the module hasn't
-- been compiled yet, or because it is part of a
-- unit with a .a file)
- ml_dyn_obj_file :: FilePath,
+ ml_dyn_obj_file :: OsPath,
-- ^ Where the .dy file is, whether or not it exists
-- yet.
- ml_hie_file :: FilePath
+ ml_hie_file :: OsPath
-- ^ Where the .hie file is, whether or not it exists
-- yet.
} deriving Show
@@ -74,6 +89,13 @@ instance Outputable ModLocation where
addBootSuffix :: FilePath -> FilePath
addBootSuffix path = path ++ "-boot"
+bootSuffixOsPath :: OsPath
+bootSuffixOsPath = expectJust "bootSuffixOsPath" (OsPath.encodeUtf "-boot")
+{-# noinline bootSuffixOsPath #-}
+
+addBootSuffixOsPath :: OsPath -> OsPath
+addBootSuffixOsPath path = path Semigroup.<> bootSuffixOsPath
+
-- | Remove the @-boot@ suffix to .hs, .hi and .o files
removeBootSuffix :: FilePath -> FilePath
removeBootSuffix "-boot" = []
@@ -96,21 +118,38 @@ addBootSuffixLocn_maybe is_boot locn = case is_boot of
addBootSuffixLocn :: ModLocation -> ModLocation
addBootSuffixLocn locn
= locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
- , ml_hi_file = addBootSuffix (ml_hi_file locn)
- , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn)
- , ml_obj_file = addBootSuffix (ml_obj_file locn)
- , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn)
- , ml_hie_file = addBootSuffix (ml_hie_file locn) }
+ , ml_hi_file = addBootSuffixOsPath (ml_hi_file locn)
+ , ml_dyn_hi_file = addBootSuffixOsPath (ml_dyn_hi_file locn)
+ , ml_obj_file = addBootSuffixOsPath (ml_obj_file locn)
+ , ml_dyn_obj_file = addBootSuffixOsPath (ml_dyn_obj_file locn)
+ , ml_hie_file = addBootSuffixOsPath (ml_hie_file locn) }
-- | Add the @-boot@ suffix to all output file paths associated with the
-- module, not including the input file itself
addBootSuffixLocnOut :: ModLocation -> ModLocation
addBootSuffixLocnOut locn
- = locn { ml_hi_file = addBootSuffix (ml_hi_file locn)
- , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn)
- , ml_obj_file = addBootSuffix (ml_obj_file locn)
- , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn)
- , ml_hie_file = addBootSuffix (ml_hie_file locn)
+ = locn { ml_hi_file = addBootSuffixOsPath (ml_hi_file locn)
+ , ml_dyn_hi_file = addBootSuffixOsPath (ml_dyn_hi_file locn)
+ , ml_obj_file = addBootSuffixOsPath (ml_obj_file locn)
+ , ml_dyn_obj_file = addBootSuffixOsPath (ml_dyn_obj_file locn)
+ , ml_hie_file = addBootSuffixOsPath (ml_hie_file locn)
}
-
+toFilePathLenient :: OsPath -> FilePath
+toFilePathLenient = fmap OsPath.toChar . OsPath.unpack
+
+mlHiFilePath, mlDynHiFilePath, mlObjFilePath, mlDynObjFilePath,
+ mlHieFilePath :: ModLocation -> IO FilePath
+mlHiFilePath ml = OsPath.decodeFS (ml_hi_file ml)
+mlDynHiFilePath ml = OsPath.decodeFS (ml_dyn_hi_file ml)
+mlObjFilePath ml = OsPath.decodeFS (ml_obj_file ml)
+mlDynObjFilePath ml = OsPath.decodeFS (ml_dyn_obj_file ml)
+mlHieFilePath ml = OsPath.decodeFS (ml_hie_file ml)
+
+mlHiFilePathLenient, mlDynHiFilePathLenient, mlObjFilePathLenient,
+ mlDynObjFilePathLenient, mlHieFilePathLenient :: ModLocation -> FilePath
+mlHiFilePathLenient ml = toFilePathLenient (ml_hi_file ml)
+mlDynHiFilePathLenient ml = toFilePathLenient (ml_dyn_hi_file ml)
+mlObjFilePathLenient ml = toFilePathLenient (ml_obj_file ml)
+mlDynObjFilePathLenient ml = toFilePathLenient (ml_dyn_obj_file ml)
+mlHieFilePathLenient ml = toFilePathLenient (ml_hie_file ml)
=====================================
compiler/GHC/Unit/Module/ModSummary.hs
=====================================
@@ -17,6 +17,12 @@ module GHC.Unit.Module.ModSummary
, msHsFilePath
, msObjFilePath
, msDynObjFilePath
+ , msHieFilePath
+ , msHiFilePathLenient
+ , msDynHiFilePathLenient
+ , msObjFilePathLenient
+ , msDynObjFilePathLenient
+ , msHieFilePathLenient
, msDeps
, isBootSummary
, findTarget
@@ -139,12 +145,24 @@ ms_home_imps = home_imps . ms_imps
-- The ModLocation is stable over successive up-sweeps in GHCi, wheres
-- the ms_hs_hash and imports can, of course, change
-msHsFilePath, msDynHiFilePath, msHiFilePath, msObjFilePath, msDynObjFilePath :: ModSummary -> FilePath
-msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms))
-msHiFilePath ms = ml_hi_file (ms_location ms)
-msDynHiFilePath ms = ml_dyn_hi_file (ms_location ms)
-msObjFilePath ms = ml_obj_file (ms_location ms)
-msDynObjFilePath ms = ml_dyn_obj_file (ms_location ms)
+msHsFilePath :: ModSummary -> FilePath
+msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms))
+
+msHiFilePath, msDynHiFilePath, msObjFilePath, msDynObjFilePath,
+ msHieFilePath :: ModSummary -> IO FilePath
+msHiFilePath ms = mlHiFilePath (ms_location ms)
+msDynHiFilePath ms = mlDynHiFilePath (ms_location ms)
+msObjFilePath ms = mlObjFilePath (ms_location ms)
+msDynObjFilePath ms = mlDynObjFilePath (ms_location ms)
+msHieFilePath ms = mlHieFilePath (ms_location ms)
+
+msHiFilePathLenient, msDynHiFilePathLenient, msObjFilePathLenient,
+ msDynObjFilePathLenient, msHieFilePathLenient :: ModSummary -> FilePath
+msHiFilePathLenient ms = mlHiFilePathLenient (ms_location ms)
+msDynHiFilePathLenient ms = mlDynHiFilePathLenient (ms_location ms)
+msObjFilePathLenient ms = mlObjFilePathLenient (ms_location ms)
+msDynObjFilePathLenient ms = mlDynObjFilePathLenient (ms_location ms)
+msHieFilePathLenient ms = mlHieFilePathLenient (ms_location ms)
-- | Did this 'ModSummary' originate from a hs-boot file?
isBootSummary :: ModSummary -> IsBootInterface
=====================================
compiler/GHC/Utils/Misc.hs
=====================================
@@ -134,6 +134,8 @@ import Control.Monad.IO.Class ( MonadIO, liftIO )
import System.IO.Error as IO ( isDoesNotExistError )
import System.Directory ( doesDirectoryExist, getModificationTime, renameFile )
import System.FilePath
+import System.OsPath (OsPath)
+import qualified System.Directory.OsPath as OsPath
import Data.Bifunctor ( first, second )
import Data.Char ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit, toUpper
@@ -1230,9 +1232,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
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -2334,7 +2334,7 @@ modulesLoadedMsg ok mods load_type = do
pure $ if is_interpreted
then ppr (GHC.ms_mod mod)
else ppr (GHC.ms_mod mod)
- <+> parens (text $ normalise $ msObjFilePath mod)
+ <+> parens (text $ normalise $ msObjFilePathLenient mod)
-- Fix #9887
-- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors
=====================================
ghc/GHCi/UI/Info.hs
=====================================
@@ -48,6 +48,7 @@ import GHC.Utils.Outputable
import GHC.Types.SrcLoc
import GHC.Types.Var
import qualified GHC.Data.Strict as Strict
+import GHC.Unit.Module.ModSummary (msObjFilePath)
-- | Info about a module. This information is generated every time a
-- module is loaded.
@@ -288,8 +289,8 @@ collectInfo ms loaded = do
cacheInvalid name = case M.lookup name ms of
Nothing -> return True
Just mi -> do
- let fp = srcFilePath (modinfoSummary mi)
- last' = modinfoLastUpdate mi
+ let last' = modinfoLastUpdate mi
+ fp <- srcFilePath (modinfoSummary mi)
current <- getModificationTime fp
exists <- doesFileExist fp
if exists
@@ -299,12 +300,13 @@ collectInfo ms loaded = do
-- | Get the source file path from a ModSummary.
-- If the .hs file is missing, and the .o file exists,
-- we return the .o file path.
-srcFilePath :: ModSummary -> FilePath
-srcFilePath modSum = fromMaybe obj_fp src_fp
- where
- src_fp = ml_hs_file ms_loc
- obj_fp = ml_obj_file ms_loc
- ms_loc = ms_location modSum
+srcFilePath :: ModSummary -> IO FilePath
+srcFilePath modSum = do
+ obj_fp <- msObjFilePath modSum
+ pure (fromMaybe obj_fp src_fp)
+ where
+ src_fp = ml_hs_file ms_loc
+ ms_loc = ms_location modSum
-- | Get info about the module: summary, types, etc.
getModInfo :: (GhcMonad m) => ModuleName -> m ModInfo
@@ -319,7 +321,7 @@ getModInfo name = do
-- NB: this has already been deeply forced; no need to do that again.
-- See test case T15369 and Note [Forcing GREInfo] in GHC.Types.GREInfo.
Nothing -> Strict.Nothing
- ts <- liftIO $ getModificationTime $ srcFilePath m
+ ts <- liftIO $ getModificationTime =<< srcFilePath m
return $
ModInfo
{ modinfoSummary = m
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe
+Subproject commit cd2f4bbb194dca5dd0246e771c999f22b6f0cdf1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bba242d983714edb20e4c70b494ec4dd82ff4129
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bba242d983714edb20e4c70b494ec4dd82ff4129
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240412/0fd0ce4e/attachment-0001.html>
More information about the ghc-commits
mailing list