diff -ur stack-2.9.3.1/src/Path/Extra.hs stack-2.9.3.1.new/src/Path/Extra.hs
--- stack-2.9.3.1/src/Path/Extra.hs 2023-06-22 18:40:54.000000000 +0800
+++ stack-2.9.3.1.new/src/Path/Extra.hs 2023-08-08 13:55:22.550467487 +0800
@@ -15,6 +15,8 @@
, pathToLazyByteString
, pathToText
, tryGetModificationTime
+ ,forgivingResolveFile
+ ,forgivingResolveFile'
) where
import Data.Time ( UTCTime )
@@ -27,6 +29,7 @@
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
+import qualified System.Directory as D
import qualified System.FilePath as FP
-- | Convert to FilePath but don't add a trailing slash.
@@ -121,3 +124,30 @@
tryGetModificationTime :: MonadIO m => Path Abs File -> m (Either () UTCTime)
tryGetModificationTime = liftIO . tryJust (guard . isDoesNotExistError) . getModificationTime
+
+-- | 'Path.IO.resolveFile' (@path-io@ package) throws 'InvalidAbsFile' (@path@
+-- package) if the file does not exist; this function yields 'Nothing'.
+forgivingResolveFile ::
+ MonadIO m
+ => Path Abs Dir
+ -- ^ Base directory
+ -> FilePath
+ -- ^ Path to resolve
+ -> m (Maybe (Path Abs File))
+forgivingResolveFile b p = liftIO $
+ D.canonicalizePath (toFilePath b FP.</> p) >>= \cp ->
+ catch
+ (Just <$> parseAbsFile cp)
+ ( \e -> case e of
+ InvalidAbsFile _ -> pure Nothing
+ _ -> throwIO e
+ )
+
+-- | 'Path.IO.resolveFile'' (@path-io@ package) throws 'InvalidAbsFile' (@path@
+-- package) if the file does not exist; this function yields 'Nothing'.
+forgivingResolveFile' ::
+ MonadIO m
+ => FilePath
+ -- ^ Path to resolve
+ -> m (Maybe (Path Abs File))
+forgivingResolveFile' p = getCurrentDir >>= flip forgivingResolveFile p
diff -ur stack-2.9.3.1/src/Stack/Build/Execute.hs stack-2.9.3.1.new/src/Stack/Build/Execute.hs
--- stack-2.9.3.1/src/Stack/Build/Execute.hs 2023-06-22 18:40:54.000000000 +0800
+++ stack-2.9.3.1.new/src/Stack/Build/Execute.hs 2023-08-08 13:57:36.831258806 +0800
@@ -66,6 +66,10 @@
import Path
import Path.CheckInstall
import Path.Extra ( toFilePathNoTrailingSep, rejectMissingFile )
+import Path.Extra
+ ( forgivingResolveFile, rejectMissingFile
+ , toFilePathNoTrailingSep
+ )
import Path.IO
hiding ( findExecutable, makeAbsolute, withSystemTempDir )
import RIO.Process
@@ -548,7 +552,7 @@
case loc of
Snap -> snapBin
Local -> localBin
- mfp <- liftIO $ forgivingAbsence (resolveFile bindir $ T.unpack name ++ ext)
+ mfp <- liftIO $ forgivingResolveFile bindir (T.unpack name ++ ext)
>>= rejectMissingFile
case mfp of
Nothing -> do
@@ -2195,7 +2199,7 @@
mabs <-
if isValidSuffix y
then liftIO $ liftM (fmap ((T.takeWhile isSpace x <>) . T.pack . toFilePath)) $
- forgivingAbsence (resolveFile pkgDir (T.unpack $ T.dropWhile isSpace x)) `catch`
+ forgivingResolveFile pkgDir (T.unpack $ T.dropWhile isSpace x) `catch`
\(_ :: PathException) -> pure Nothing
else pure Nothing
case mabs of
diff -ur stack-2.9.3.1/src/Stack/ComponentFile.hs stack-2.9.3.1.new/src/Stack/ComponentFile.hs
--- stack-2.9.3.1/src/Stack/ComponentFile.hs 2023-06-22 18:40:54.000000000 +0800
+++ stack-2.9.3.1.new/src/Stack/ComponentFile.hs 2023-08-08 14:04:52.914859026 +0800
@@ -283,8 +283,8 @@
Iface.unList . Iface.dmods . Iface.deps
resolveFileDependency file = do
resolved <-
- liftIO (forgivingAbsence (resolveFile dir file)) >>=
- rejectMissingFile
+ liftIO (forgivingResolveFile dir file) >>=
+ rejectMissingFile
when (isNothing resolved) $
prettyWarnL
[ flow "Dependent file listed in:"
diff -ur stack-2.9.3.1/src/Stack/Ghci.hs stack-2.9.3.1.new/src/Stack/Ghci.hs
--- stack-2.9.3.1/src/Stack/Ghci.hs 2023-06-22 18:40:54.000000000 +0800
+++ stack-2.9.3.1.new/src/Stack/Ghci.hs 2023-08-08 13:58:43.393651047 +0800
@@ -29,7 +29,7 @@
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Distribution.PackageDescription as C
import Path
-import Path.Extra ( toFilePathNoTrailingSep )
+import Path.Extra (forgivingResolveFile', toFilePathNoTrailingSep)
import Path.IO hiding ( withSystemTempDir )
import RIO.Process
( HasProcessContext, exec, proc, readProcess_
@@ -225,7 +225,7 @@
then do
fileTargets <- forM fileTargetsRaw $ \fp0 -> do
let fp = T.unpack fp0
- mpath <- liftIO $ forgivingAbsence (resolveFile' fp)
+ mpath <- liftIO $ forgivingResolveFile' fp
case mpath of
Nothing -> throwM (MissingFileTarget fp)
Just path -> pure path
diff -ur stack-2.9.3.1/src/Stack/PackageFile.hs stack-2.9.3.1.new/src/Stack/PackageFile.hs
--- stack-2.9.3.1/src/Stack/PackageFile.hs 2023-06-22 18:40:54.000000000 +0800
+++ stack-2.9.3.1.new/src/Stack/PackageFile.hs 2023-08-08 14:06:21.163396729 +0800
@@ -34,7 +34,7 @@
-> RIO GetPackageFileContext (Maybe (Path Abs File))
resolveFileOrWarn = resolveOrWarn "File" f
where
- f p x = liftIO (forgivingAbsence (resolveFile p x)) >>= rejectMissingFile
+ f p x = liftIO (forgivingResolveFile p x) >>= rejectMissingFile
-- | Get all files referenced by the package.
packageDescModulesAndFiles