rpms
/
haskell-platform
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

backport 6280.patch to 2.9.1

This commit is contained in:
Jens Petersen 2023-04-11 13:34:08 +08:00
parent 88ad8b7915
commit 86537fd1d3
3 changed files with 135 additions and 196 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
6028-2.9.1.patch Normal file
View File

@ -0,0 +1,125 @@
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).

192
6028.patch
View File

@ -1,192 +0,0 @@
From f58b89550cba1f086287edec25f56b0f4adfa99b Mon Sep 17 00:00:00 2001
From: Mike Pilgrem <mpilgrem@users.noreply.github.com>
Date: Tue, 17 Jan 2023 00:20:42 +0000
Subject: [PATCH] Fix #5866 Replace duff `forgivingAbsence $ resolveFile ...`
---
src/Path/Extra.hs | 39 +++++++++++++++++++++++++++++++++++---
src/Stack/Build/Execute.hs | 13 ++++++++-----
src/Stack/ComponentFile.hs | 7 ++++---
src/Stack/Ghci.hs | 4 ++--
src/Stack/PackageFile.hs | 5 ++---
5 files changed, 52 insertions(+), 16 deletions(-)
diff --git a/src/Path/Extra.hs b/src/Path/Extra.hs
index 5f1069087..d6d15b937 100644
--- a/src/Path/Extra.hs
+++ b/src/Path/Extra.hs
@@ -14,21 +14,27 @@ module Path.Extra
, pathToLazyByteString
, pathToText
, tryGetModificationTime
+ , forgivingResolveFile
+ , forgivingResolveFile'
) where
import Data.Time ( UTCTime )
import Path
- ( Abs, Dir, File, Rel, parseAbsDir, parseAbsFile
- , toFilePath
+ ( Abs, Dir, File, PathException (..), Rel, parseAbsDir
+ , parseAbsFile, toFilePath
)
import Path.Internal ( Path (Path) )
-import Path.IO ( doesDirExist, doesFileExist, getModificationTime )
+import Path.IO
+ ( doesDirExist, doesFileExist, getCurrentDir
+ , getModificationTime
+ )
import RIO
import System.IO.Error ( isDoesNotExistError )
import qualified Data.ByteString.Char8 as BS
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.
@@ -123,3 +129,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 --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
index a57550b29..c500f3d28 100644
--- a/src/Stack/Build/Execute.hs
+++ b/src/Stack/Build/Execute.hs
@@ -76,11 +76,14 @@ import Path
, stripProperPrefix
)
import Path.CheckInstall ( warnInstallSearchPathIssues )
-import Path.Extra ( toFilePathNoTrailingSep, rejectMissingFile )
+import Path.Extra
+ ( forgivingResolveFile, rejectMissingFile
+ , toFilePathNoTrailingSep
+ )
import Path.IO
( copyFile, doesDirExist, doesFileExist, ensureDir
- , forgivingAbsence, ignoringAbsence, removeDirRecur
- , removeFile, renameDir, renameFile, resolveFile
+ , ignoringAbsence, removeDirRecur, removeFile, renameDir
+ , renameFile
)
import RIO.Process
( HasProcessContext, byteStringInput, doesExecutableExist
@@ -660,7 +663,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
@@ -2541,7 +2544,7 @@ mungeBuildOutput excludeTHLoading makeAbsolute pkgDir compilerVer = void $
if isValidSuffix y
then liftIO $
fmap (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 --git a/src/Stack/ComponentFile.hs b/src/Stack/ComponentFile.hs
index 8b5ad347d..d7dc6b6cf 100644
--- a/src/Stack/ComponentFile.hs
+++ b/src/Stack/ComponentFile.hs
@@ -43,11 +43,12 @@ import Path
, stripProperPrefix
)
import Path.Extra
- ( parseCollapsedAbsFile, rejectMissingDir, rejectMissingFile
+ ( forgivingResolveFile, parseCollapsedAbsFile
+ , rejectMissingDir, rejectMissingFile
)
import Path.IO
( doesDirExist, doesFileExist, forgivingAbsence
- , getCurrentDir, listDir, resolveDir, resolveFile
+ , getCurrentDir, listDir, resolveDir
)
import Stack.Constants
( haskellDefaultPreprocessorExts, haskellFileExts
@@ -294,7 +295,7 @@ parseHI hiPath = do
Iface.unList . Iface.dmods . Iface.deps
resolveFileDependency file = do
resolved <-
- liftIO (forgivingAbsence (resolveFile dir file)) >>=
+ liftIO (forgivingResolveFile dir file) >>=
rejectMissingFile
when (isNothing resolved) $
prettyWarnL
diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs
index 933c20dde..d0e2a22a3 100644
--- a/src/Stack/Ghci.hs
+++ b/src/Stack/Ghci.hs
@@ -30,7 +30,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 RIO.Process
( HasProcessContext, exec, proc, readProcess_
@@ -239,7 +239,7 @@ preprocessTargets buildOptsCLI sma rawTargets = do
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 --git a/src/Stack/PackageFile.hs b/src/Stack/PackageFile.hs
index 99cc62d1d..e5d5424c7 100644
--- a/src/Stack/PackageFile.hs
+++ b/src/Stack/PackageFile.hs
@@ -16,8 +16,7 @@ import Distribution.PackageDescription hiding ( FlagName )
import Distribution.Simple.Glob ( matchDirFileGlob )
import qualified Distribution.Types.UnqualComponentName as Cabal
import Path ( parent )
-import Path.Extra ( rejectMissingFile )
-import Path.IO ( forgivingAbsence, resolveFile )
+import Path.Extra ( forgivingResolveFile, rejectMissingFile )
import Stack.ComponentFile
( benchmarkFiles, executableFiles, libraryFiles
, resolveOrWarn, testFiles
@@ -37,7 +36,7 @@ resolveFileOrWarn :: FilePath.FilePath
-> 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 ::

14
haskell-platform.spec
View File

@ -23,7 +23,7 @@
Name: haskell-platform
Version: 2022.2
Release: 21%{?dist}
Release: 22%{?dist}
Summary: Standard Haskell distribution
License: BSD
@ -47,7 +47,8 @@ Source13: https://hackage.haskell.org/package/%{casatypes}/%{casatypes}.ta
Source20: stack-symlink-distro-ghc
# End cabal-rpm sources
# https://github.com/commercialhaskell/stack/issues/5866
Patch1: https://patch-diff.githubusercontent.com/raw/commercialhaskell/stack/pull/6028.patch
# https://github.com/commercialhaskell/stack/pull/6028
Patch1: 6028-2.9.1.patch
BuildRequires: ghc
BuildRequires: alex
@ -369,8 +370,10 @@ Stack is a cross-platform program for developing Haskell projects.
# Begin cabal-rpm setup:
%setup -q -c -a1 -a2 -a3 -a4 -a5 -a6 -a7 -a8 -a9 -a10 -a11 -a12 -a13
# End cabal-rpm setup
#%%patch1 -p0 -b .orig
(
cd %{stack}
%patch 1 -p1 -b .orig
)
%build
# Begin cabal-rpm build:
@ -409,6 +412,9 @@ install -p -m 644 %{SOURCE20} %{buildroot}%{_bindir}/stack-symlink-distro-ghc
%changelog
* Tue Apr 11 2023 Jens Petersen <petersen@redhat.com> - 2022.2-22
- backport fix for error: InvalidAbsFile "/usr/lib64/ghc-9.2.3/lib/../lib/x86_64-linux-ghc-9.2.3/rts-1.0.2/include/ghcversion.h" (#5866)
* Tue Feb 21 2023 Jens Petersen <petersen@redhat.com> - 2022.2-21
- update to stack 2.9.1
- https://hackage.haskell.org/package/stack-2.9.1/changelog