diff -up stack-2.9.1/src/Path/Extra.hs.orig stack-2.9.1/src/Path/Extra.hs
--- stack-2.9.1/src/Path/Extra.hs.orig 2023-04-11 10:23:31.337973989 +0800
+++ stack-2.9.1/src/Path/Extra.hs 2023-04-11 10:27:20.925638798 +0800
@@ -15,6 +15,8 @@ module Path.Extra
,pathToLazyByteString
,pathToText
,tryGetModificationTime
+ ,forgivingResolveFile
+ ,forgivingResolveFile'
) where
import Data.Time (UTCTime)
@@ -27,6 +29,7 @@ import qualified Data.ByteString.Char8 a
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 @@ pathToText = T.pack . toFilePath
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 -up stack-2.9.1/src/Stack/Build/Execute.hs.orig stack-2.9.1/src/Stack/Build/Execute.hs
--- stack-2.9.1/src/Stack/Build/Execute.hs.orig 2023-04-11 10:23:31.338973998 +0800
+++ stack-2.9.1/src/Stack/Build/Execute.hs 2023-04-11 10:31:07.314541963 +0800
@@ -63,7 +63,10 @@ import Distribution.Verbosity
import Distribution.Version (mkVersion)
import Path
import Path.CheckInstall
-import Path.Extra (toFilePathNoTrailingSep, rejectMissingFile)
+import Path.Extra
+ ( forgivingResolveFile, rejectMissingFile
+ , toFilePathNoTrailingSep
+ )
import Path.IO hiding (findExecutable, makeAbsolute, withSystemTempDir)
import qualified RIO
import Stack.Build.Cache
@@ -535,7 +538,7 @@ copyExecutables exes = do
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
@@ -2156,7 +2159,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) -> return Nothing
else return Nothing
case mabs of
diff -up stack-2.9.1/src/Stack/Ghci.hs.orig stack-2.9.1/src/Stack/Ghci.hs
--- stack-2.9.1/src/Stack/Ghci.hs.orig 2023-04-11 10:23:31.338973998 +0800
+++ stack-2.9.1/src/Stack/Ghci.hs 2023-04-11 10:35:16.376070265 +0800
@@ -29,7 +29,7 @@ import qualified Data.Text.Lazy as TL
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 qualified RIO
import RIO.PrettyPrint
@@ -213,7 +213,7 @@ preprocessTargets buildOptsCLI sma rawTa
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 -> return path
--- stack-2.9.1/src/Stack/Package.hs 2022-09-19 18:33:27.000000000 +0800
+++ stack-2.9.1/src/Stack/Package.hs 2023-04-11 12:03:27.145182761 +0800
@@ -1120,7 +1120,7 @@
let moduleNames = fmap (fromString . T.unpack . decodeUtf8Lenient . fst) .
Iface.unList . Iface.dmods . Iface.deps
resolveFileDependency file = do
- resolved <- liftIO (forgivingAbsence (resolveFile dir file)) >>= rejectMissingFile
+ resolved <- liftIO (forgivingResolveFile dir file) >>= rejectMissingFile
when (isNothing resolved) $
prettyWarnL
[ flow "Dependent file listed in:"
@@ -1326,7 +1326,7 @@
resolveFileOrWarn :: FilePath.FilePath
-> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn = resolveOrWarn "File" f
- where f p x = liftIO (forgivingAbsence (resolveFile p x)) >>= rejectMissingFile
+ where f p x = liftIO (forgivingResolveFile p x) >>= rejectMissingFile
-- | Resolve the directory, if it can't be resolved, warn for the user
-- (purely to be helpful).