-
-
Notifications
You must be signed in to change notification settings - Fork 14.2k
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Add cabal-paths patch for ghc 9.2.x #184041
Closed
sloane-shark
wants to merge
7
commits into
NixOS:master
from
sloane-shark:fix/ghc923-cabal-paths-patch
Closed
Changes from all commits
Commits
Show all changes
7 commits
Select commit
Hold shift + click to select a range
4d78cbe
Add cabal-paths patch for ghc 9.2.4
sloane-shark 20a0022
Mark regex-rure broken on aarch64-darwin
sloane-shark 032209f
Be less specific about versions
sloane-shark 081de9e
Add patch to 9.2.5
sloane-shark b154d3d
Remove unused inherits
sloane-shark 63a4969
Fix patch
sloane-shark 80218f1
Review feedback
sloane-shark File filter
Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,278 @@ | ||
| diff --git a/Cabal/src/Distribution/Simple/Build/PathsModule.hs b/Cabal/src/Distribution/Simple/Build/PathsModule.hs | ||
| index b2be7e1a8..bf218dbc1 100644 | ||
| --- a/Cabal/src/Distribution/Simple/Build/PathsModule.hs | ||
| +++ b/Cabal/src/Distribution/Simple/Build/PathsModule.hs | ||
| @@ -25,16 +25,21 @@ import Distribution.Package | ||
| import Distribution.PackageDescription | ||
| import Distribution.Simple.Compiler | ||
| import Distribution.Simple.LocalBuildInfo | ||
| -import Distribution.Simple.Utils (shortRelativePath) | ||
| +import Distribution.Simple.Utils (shortRelativePath, unintersperse) | ||
| import Distribution.System | ||
| import Distribution.Version | ||
|
|
||
| import qualified Distribution.Simple.Build.PathsModule.Z as Z | ||
|
|
||
| +import System.FilePath ( pathSeparator ) | ||
| + | ||
| -- ------------------------------------------------------------ | ||
| -- * Building Paths_<pkg>.hs | ||
| -- ------------------------------------------------------------ | ||
|
|
||
| +splitPath :: FilePath -> [ String ] | ||
| +splitPath = unintersperse pathSeparator | ||
| + | ||
| generatePathsModule :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String | ||
| generatePathsModule pkg_descr lbi clbi = Z.render Z.Z | ||
| { Z.zPackageName = packageName pkg_descr | ||
| @@ -56,8 +61,41 @@ generatePathsModule pkg_descr lbi clbi = Z.render Z.Z | ||
| , Z.zDatadir = zDatadir | ||
| , Z.zLibexecdir = zLibexecdir | ||
| , Z.zSysconfdir = zSysconfdir | ||
| + | ||
| + , Z.zAbsBody = absBody | ||
| + , Z.zWarnPragma = warnPragma | ||
| + , Z.zImportList = importList | ||
| + , Z.zShouldEmitDataDir = shouldEmitDataDir | ||
| } | ||
| where | ||
| + dirs = [ (flat_libdir, "LibDir") | ||
| + , (flat_dynlibdir, "DynLibDir") | ||
| + , (flat_datadir, "DataDir") | ||
| + , (flat_libexecdir, "LibexecDir") | ||
| + , (flat_sysconfdir, "SysconfDir") ]; | ||
| + shouldEmitPath p | ||
| + | (splitPath flat_prefix) `isPrefixOf` (splitPath flat_bindir) = True | ||
| + | (splitPath flat_prefix) `isPrefixOf` (splitPath p) = False | ||
| + | otherwise = True | ||
| + shouldEmitDataDir = shouldEmitPath flat_datadir | ||
| + nixEmitPathFn (path, name) = let | ||
| + varName = toLower <$> name | ||
| + fnName = "get"++name | ||
| + in if shouldEmitPath path then | ||
| + varName ++ " :: FilePath\n"++ | ||
| + varName ++ " = " ++ show path ++ | ||
| + "\n" ++ fnName ++ " :: IO FilePath" ++ | ||
| + "\n" ++ fnName ++ " = " ++ mkGetEnvOr varName ("return " ++ varName)++"\n" | ||
| + else "" | ||
| + mkGetEnvOr var expr = "catchIO (getEnv \""++var'++"\") (\\_ -> "++expr++")" | ||
| + where var' = pkgPathEnvVar pkg_descr var | ||
| + absBody = intercalate "\n" $ nixEmitPathFn <$> dirs | ||
| + warnPragma = case filter (not . shouldEmitPath . fst) dirs of | ||
| + [] -> "" | ||
| + omittedDirs -> "{-# WARNING \"The functions: "++omittedFns++" Have been omitted by the Nix build system.\" #-}" | ||
| + where omittedFns = intercalate ", " $ map snd omittedDirs | ||
| + importList = intercalate ", " $ ("get" ++) . snd <$> filter (shouldEmitPath . fst) dirs | ||
| + | ||
| supports_cpp = supports_language_pragma | ||
| supports_rebindable_syntax = ghc_newer_than (mkVersion [7,0,1]) | ||
| supports_language_pragma = ghc_newer_than (mkVersion [6,6,1]) | ||
| diff --git a/Cabal/src/Distribution/Simple/Build/PathsModule/Z.hs b/Cabal/src/Distribution/Simple/Build/PathsModule/Z.hs | ||
| index 6488ea061..b2b2c0e19 100644 | ||
| --- a/Cabal/src/Distribution/Simple/Build/PathsModule/Z.hs | ||
| +++ b/Cabal/src/Distribution/Simple/Build/PathsModule/Z.hs | ||
| @@ -19,7 +19,11 @@ data Z | ||
| zLibexecdir :: FilePath, | ||
| zSysconfdir :: FilePath, | ||
| zNot :: (Bool -> Bool), | ||
| - zManglePkgName :: (PackageName -> String)} | ||
| + zManglePkgName :: (PackageName -> String), | ||
| + zShouldEmitDataDir :: Bool, | ||
| + zAbsBody :: String, | ||
| + zWarnPragma :: String, | ||
| + zImportList :: String} | ||
| deriving Generic | ||
| render :: Z -> String | ||
| render z_root = execWriter $ do | ||
| @@ -45,10 +49,23 @@ render z_root = execWriter $ do | ||
| tell "{-# OPTIONS_GHC -w #-}\n" | ||
| tell "module Paths_" | ||
| tell (zManglePkgName z_root (zPackageName z_root)) | ||
| + tell " " | ||
| + tell (zWarnPragma z_root) | ||
| tell " (\n" | ||
| - tell " version,\n" | ||
| - tell " getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,\n" | ||
| - tell " getDataFileName, getSysconfDir\n" | ||
| + tell " version, getBinDir,\n" | ||
| + tell " " | ||
| + if (zShouldEmitDataDir z_root) | ||
| + then do | ||
| + tell "\n" | ||
| + tell " getDataFileName,\n" | ||
| + tell " " | ||
| + return () | ||
| + else do | ||
| + return () | ||
| + tell "\n" | ||
| + tell " " | ||
| + tell (zImportList z_root) | ||
| + tell "\n" | ||
| tell " ) where\n" | ||
| tell "\n" | ||
| if (zNot z_root (zAbsolute z_root)) | ||
| @@ -97,12 +114,15 @@ render z_root = execWriter $ do | ||
| tell (zVersionDigits z_root) | ||
| tell " []\n" | ||
| tell "\n" | ||
| - tell "getDataFileName :: FilePath -> IO FilePath\n" | ||
| - tell "getDataFileName name = do\n" | ||
| - tell " dir <- getDataDir\n" | ||
| - tell " return (dir `joinFileName` name)\n" | ||
| - tell "\n" | ||
| - tell "getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath\n" | ||
| + if (zShouldEmitDataDir z_root) | ||
| + then do | ||
| + tell "getDataFileName :: FilePath -> IO FilePath\n" | ||
| + tell "getDataFileName name = do\n" | ||
| + tell " dir <- getDataDir\n" | ||
| + tell " return (dir `joinFileName` name)\n" | ||
| + return () | ||
| + else do | ||
| + return () | ||
| tell "\n" | ||
| let | ||
| z_var0_function_defs = do | ||
| @@ -130,6 +150,8 @@ render z_root = execWriter $ do | ||
| tell "\n" | ||
| if (zRelocatable z_root) | ||
| then do | ||
| + tell "\n" | ||
| + tell "getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath\n" | ||
| tell "\n" | ||
| tell "getPrefixDirReloc :: FilePath -> IO FilePath\n" | ||
| tell "getPrefixDirReloc dirRel = do\n" | ||
| @@ -177,44 +199,17 @@ render z_root = execWriter $ do | ||
| if (zAbsolute z_root) | ||
| then do | ||
| tell "\n" | ||
| - tell "bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath\n" | ||
| + tell "bindir :: FilePath\n" | ||
| tell "bindir = " | ||
| tell (zBindir z_root) | ||
| tell "\n" | ||
| - tell "libdir = " | ||
| - tell (zLibdir z_root) | ||
| - tell "\n" | ||
| - tell "dynlibdir = " | ||
| - tell (zDynlibdir z_root) | ||
| - tell "\n" | ||
| - tell "datadir = " | ||
| - tell (zDatadir z_root) | ||
| - tell "\n" | ||
| - tell "libexecdir = " | ||
| - tell (zLibexecdir z_root) | ||
| - tell "\n" | ||
| - tell "sysconfdir = " | ||
| - tell (zSysconfdir z_root) | ||
| - tell "\n" | ||
| tell "\n" | ||
| + tell "getBinDir :: IO FilePath\n" | ||
| tell "getBinDir = catchIO (getEnv \"" | ||
| tell (zManglePkgName z_root (zPackageName z_root)) | ||
| tell "_bindir\") (\\_ -> return bindir)\n" | ||
| - tell "getLibDir = catchIO (getEnv \"" | ||
| - tell (zManglePkgName z_root (zPackageName z_root)) | ||
| - tell "_libdir\") (\\_ -> return libdir)\n" | ||
| - tell "getDynLibDir = catchIO (getEnv \"" | ||
| - tell (zManglePkgName z_root (zPackageName z_root)) | ||
| - tell "_dynlibdir\") (\\_ -> return dynlibdir)\n" | ||
| - tell "getDataDir = catchIO (getEnv \"" | ||
| - tell (zManglePkgName z_root (zPackageName z_root)) | ||
| - tell "_datadir\") (\\_ -> return datadir)\n" | ||
| - tell "getLibexecDir = catchIO (getEnv \"" | ||
| - tell (zManglePkgName z_root (zPackageName z_root)) | ||
| - tell "_libexecdir\") (\\_ -> return libexecdir)\n" | ||
| - tell "getSysconfDir = catchIO (getEnv \"" | ||
| - tell (zManglePkgName z_root (zPackageName z_root)) | ||
| - tell "_sysconfdir\") (\\_ -> return sysconfdir)\n" | ||
| + tell (zAbsBody z_root) | ||
| + tell "\n" | ||
| tell "\n" | ||
| return () | ||
| else do | ||
| diff --git a/cabal-dev-scripts/src/GenPathsModule.hs b/cabal-dev-scripts/src/GenPathsModule.hs | ||
| index e4b930635..b69a73191 100644 | ||
| --- a/cabal-dev-scripts/src/GenPathsModule.hs | ||
| +++ b/cabal-dev-scripts/src/GenPathsModule.hs | ||
| @@ -43,6 +43,11 @@ $(capture "decls" [d| | ||
|
|
||
| , zNot :: Bool -> Bool | ||
| , zManglePkgName :: PackageName -> String | ||
| + | ||
| + , zShouldEmitDataDir :: Bool | ||
| + , zAbsBody :: String | ||
| + , zWarnPragma :: String | ||
| + , zImportList :: String | ||
| } | ||
| deriving (Generic) | ||
| |]) | ||
| diff --git a/templates/Paths_pkg.template.hs b/templates/Paths_pkg.template.hs | ||
| index 6bc6b7875..f5489bea8 100644 | ||
| --- a/templates/Paths_pkg.template.hs | ||
| +++ b/templates/Paths_pkg.template.hs | ||
| @@ -9,10 +9,12 @@ | ||
| {% endif %} | ||
| {-# OPTIONS_GHC -fno-warn-missing-import-lists #-} | ||
| {-# OPTIONS_GHC -w #-} | ||
| -module Paths_{{ manglePkgName packageName }} ( | ||
| - version, | ||
| - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, | ||
| - getDataFileName, getSysconfDir | ||
| +module Paths_{{ manglePkgName packageName }} {{ warnPragma }} ( | ||
| + version, getBinDir, | ||
| + {% if shouldEmitDataDir %} | ||
| + getDataFileName, | ||
| + {% endif %} | ||
| + {{ importList }} | ||
| ) where | ||
|
|
||
| {% if not absolute %} | ||
| @@ -51,12 +53,12 @@ catchIO = Exception.catch | ||
| version :: Version | ||
| version = Version {{ versionDigits }} [] | ||
|
|
||
| +{% if shouldEmitDataDir %} | ||
| getDataFileName :: FilePath -> IO FilePath | ||
| getDataFileName name = do | ||
| dir <- getDataDir | ||
| return (dir `joinFileName` name) | ||
| - | ||
| -getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath | ||
| +{% endif %} | ||
|
|
||
| {% defblock function_defs %} | ||
| minusFileName :: FilePath -> String -> FilePath | ||
| @@ -85,6 +87,8 @@ splitFileName p = (reverse (path2++drive), reverse fname) | ||
|
|
||
| {% if relocatable %} | ||
|
|
||
| +getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath | ||
| + | ||
| getPrefixDirReloc :: FilePath -> IO FilePath | ||
| getPrefixDirReloc dirRel = do | ||
| exePath <- getExecutablePath | ||
| @@ -102,20 +106,12 @@ getSysconfDir = catchIO (getEnv "{{ manglePkgName packageName }}_sysconfdir") (\ | ||
|
|
||
| {% elif absolute %} | ||
|
|
||
| -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath | ||
| +bindir :: FilePath | ||
| bindir = {{ bindir }} | ||
| -libdir = {{ libdir }} | ||
| -dynlibdir = {{ dynlibdir }} | ||
| -datadir = {{ datadir }} | ||
| -libexecdir = {{ libexecdir }} | ||
| -sysconfdir = {{ sysconfdir }} | ||
|
|
||
| +getBinDir :: IO FilePath | ||
| getBinDir = catchIO (getEnv "{{ manglePkgName packageName }}_bindir") (\_ -> return bindir) | ||
| -getLibDir = catchIO (getEnv "{{ manglePkgName packageName }}_libdir") (\_ -> return libdir) | ||
| -getDynLibDir = catchIO (getEnv "{{ manglePkgName packageName }}_dynlibdir") (\_ -> return dynlibdir) | ||
| -getDataDir = catchIO (getEnv "{{ manglePkgName packageName }}_datadir") (\_ -> return datadir) | ||
| -getLibexecDir = catchIO (getEnv "{{ manglePkgName packageName }}_libexecdir") (\_ -> return libexecdir) | ||
| -getSysconfDir = catchIO (getEnv "{{ manglePkgName packageName }}_sysconfdir") (\_ -> return sysconfdir) | ||
| +{{ absBody }} | ||
|
|
||
| {% elif isWindows %} | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Why do we split before comparing the prefix? That should not be necessary.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
this was copied verbatim from
cabal-paths.patchwhich has the same logic. i agree it doesn't make much sense.do you think we can compare e.g.
flat_prefixandflat_bindirdirectly, since they are just strings? or should we still splitflat_bindirby path separator to account for any funny paths?or