126 lines
5.7 KiB
Diff
126 lines
5.7 KiB
Diff
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).
|