diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +* 0.12.6 (2018-10-20) +- update: remove old revised .cabal +- convert revised .cabal file to unix format +- spec: support haskell-gi libraries +- most of SysCmd moved to simple-cmd library (new dep) +- can now download multiple source files +- use line-buffering for stdout +- always do cabal update +- support ghc_without_dynamic for static executables +- build with Cabal-2.4 (ghc-8.6) + * 0.12.5 (2018-07-29) - update: more careful now with fuzz 1 -- handle revised to non-revised diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,75 @@ +* add Begin/End comments on Source's, %setup and %files lists to improve update + +## Misc +* run "cabal update" if package-version not found + +- unify hackage and package deps into a common data structure + with pkgShow and depShow to render strings + * add RpmPackage and use Dependency + +# Commands +- fetch +- aliases for missingdeps +- allow cmd abbreviations? + +## Options +- command-based flags and help (optparse-applicative?) + +## spec/packaging +- filter or blockformat literate code in description ("> ...") +- sort devel packages ignoring -devel suffix? +* common subpackage for binlib packages +- include README.* +- handle datafiles more automatically + - clean away READMEs etc +? include version ranges in BRs +? use repoquery for missing testdeps +* --static binary package +- support tarballs again +* filter dummy pkgs like fail, bytestring-builder and mtl-compat +- handle ghc-lzma -> lzma! +- --releasever option (for repoquery) +- --without-tests +- --no-revision + +## version ranges +- warn about missing dependencies/versions + +## standalone +- packaging of lib stacks into one deployable rpm +* support creating and building standalone package including its missing deps + - phase 1: cabal sandbox + - phase 2: embed src tarballs of missing deps? + +## local +- --no-network +- llvm flag +- running "cabal-rpm local pkg-ver" in pkg/ with existing pkg.spec when newer pkg exists builds old pkg +- use rpmspec + dnf/yum-builddep if needed to install deps not in .cabal + +## install + +## update +- warm about new missing deps +- reverse deps and rebuilds +* update subpkg sources +- update and git add revised .cabal +- sort sources + +## depends +- dependency graphs or sorted recursive deps +- reverse dependencies +- using repoquery for uninstalled missingdeps +- use rpmspec when available? (Centos5/6 too old) +- use su -c when no sudo ?? + - any way to know if user is sudoer? + +## koji/buildsys +- support mock builds +- copr support? +- scratch builds + +## diff +- filter %changelog +- ignore whitespace option +- diff two versions diff --git a/cabal-rpm.cabal b/cabal-rpm.cabal --- a/cabal-rpm.cabal +++ b/cabal-rpm.cabal @@ -1,5 +1,5 @@ Name: cabal-rpm -Version: 0.12.5 +Version: 0.12.6 Synopsis: RPM packaging tool for Haskell Cabal-based packages Description: This package provides a RPM packaging tool for Haskell Cabal-based packages. @@ -22,7 +22,7 @@ 2012-2018 Jens Petersen Category: Distribution Build-type: Simple -Extra-source-files: README.md ChangeLog man/cabal-rpm.1.md man/cabal-rpm.1 +Extra-source-files: README.md ChangeLog TODO man/cabal-rpm.1.md man/cabal-rpm.1 Cabal-version: >=1.6 Tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, @@ -37,7 +37,7 @@ Default: False Flag https - Description: Use http to query Stackage (ghc >= 7.10) + Description: Use http to query Stackage (ghc >= 8.0) Default: True Executable cabal-rpm @@ -47,6 +47,7 @@ directory, filepath, process, + simple-cmd >= 0.1.1, unix if flag(old-locale) Build-Depends: old-locale >= 1 && < 1.1, diff --git a/src/Commands/Depends.hs b/src/Commands/Depends.hs --- a/src/Commands/Depends.hs +++ b/src/Commands/Depends.hs @@ -20,7 +20,7 @@ import Dependencies (dependencies, missingPackages, packageDependencies) import Options (quiet) import PackageUtils (PackageData (..), prepare, repoquery, stripPkgDevel) -import SysCmd ((+-+)) +import SimpleCmd ((+-+)) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else diff --git a/src/Commands/Diff.hs b/src/Commands/Diff.hs --- a/src/Commands/Diff.hs +++ b/src/Commands/Diff.hs @@ -21,7 +21,8 @@ import FileUtils (mktempdir, withCurrentDirectory) import Options (RpmFlags (..)) import PackageUtils (PackageData (..), prepare) -import SysCmd ((+-+), die, shell) +import SimpleCmd ((+-+), shell_) +import SysCmd (die) import Data.Maybe (isNothing) @@ -39,5 +40,5 @@ else withCurrentDirectory tmpdir $ prepare flags mpkg False speccblrpm <- createSpecFile pd flags (Just tmpdir) diffcmd <- getEnvDefault "CBLRPM_DIFF" "diff -u" - shell $ diffcmd +-+ spec +-+ speccblrpm +-+ "| sed -e s%" ++ speccblrpm ++ "%" ++ spec <.> "cblrpm" ++ "%" + shell_ $ diffcmd +-+ spec +-+ speccblrpm +-+ "| sed -e s%" ++ speccblrpm ++ "%" ++ spec <.> "cblrpm" ++ "%" removeDirectoryRecursive tmpdir diff --git a/src/Commands/Install.hs b/src/Commands/Install.hs --- a/src/Commands/Install.hs +++ b/src/Commands/Install.hs @@ -21,15 +21,16 @@ import Dependencies (missingPackages, notInstalled, pkgInstallMissing) import Options (RpmFlags (..)) import PackageUtils (PackageData (..), rpmInstall, RpmStage (..), stripPkgDevel) -import SysCmd (cmd, cmd_, rpmEval, (+-+)) +import SimpleCmd (cmd_, (+-+)) +import SimpleCmd.Rpm (rpmspec) +import SysCmd (rpmEval) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else import Control.Applicative ((<$>)) #endif -import Control.Monad (filterM, unless, when) -import System.Directory (doesFileExist) -import System.FilePath ((), (<.>)) +import Control.Monad (unless, when) +import System.FilePath (()) install :: PackageData -> RpmFlags -> IO () install pkgdata flags = do @@ -40,12 +41,8 @@ putStrLn $ "Missing:" +-+ unwords stillMissing mapM_ cblrpmInstallMissing stillMissing spec <- rpmBuild pkgdata flags Binary - arch <- cmd "arch" [] rpmdir <- rpmEval "%{_rpmdir}" - rpms <- map (\ p -> rpmdir arch p <.> "rpm") . lines <$> - cmd "rpmspec" ["-q", spec] - -- metapkgs don't have base package - filterM doesFileExist rpms >>= rpmInstall + rpmspec [] (fmap ( "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm") rpmdir) spec >>= rpmInstall cblrpmInstallMissing :: String -> IO () cblrpmInstallMissing pkg = do diff --git a/src/Commands/Refresh.hs b/src/Commands/Refresh.hs --- a/src/Commands/Refresh.hs +++ b/src/Commands/Refresh.hs @@ -20,8 +20,10 @@ import FileUtils (withTempDirectory) import Options (RpmFlags (..)) import PackageUtils (PackageData (..), cabal_, patchSpec, - removePrefix, rwGitDir) -import SysCmd (cmd, cmd_, die, grep_, optionalProgram) + removePrefix) +import SimpleCmd (cmd, cmd_, grep_) +import SimpleCmd.Git (rwGitDir) +import SysCmd (die, optionalProgram) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else @@ -31,7 +33,7 @@ import Data.List (isPrefixOf) import Data.Version (showVersion) import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, - setCurrentDirectory) + renameFile, setCurrentDirectory) import System.Environment (getEnv) --import System.Exit (exitSuccess) import System.FilePath ((), (<.>)) @@ -70,7 +72,7 @@ cblrpmVersion subpkg crVer let backup = spec <.> "cblrpm" backup' = backup ++ "-" ++ crVer - cmd_ "mv" [backup, backup'] + renameFile backup backup' return backup' cblrpmVersion :: Bool -> String -> IO () diff --git a/src/Commands/RpmBuild.hs b/src/Commands/RpmBuild.hs --- a/src/Commands/RpmBuild.hs +++ b/src/Commands/RpmBuild.hs @@ -24,7 +24,7 @@ import Options (RpmFlags (..)) import PackageUtils (bringTarball, PackageData (..), packageName, packageVersion, rpmbuild, RpmStage (..)) -import SysCmd ((+-+)) +import SimpleCmd ((+-+)) --import Control.Exception (bracket) import Control.Monad (unless, void, when) @@ -59,7 +59,7 @@ unless (stage == BuildDep) $ do let version = packageVersion pkg - bringTarball (name ++ "-" ++ version) True + bringTarball (name ++ "-" ++ version) True specFile rpmbuild stage False Nothing specFile return specFile diff --git a/src/Commands/Spec.hs b/src/Commands/Spec.hs --- a/src/Commands/Spec.hs +++ b/src/Commands/Spec.hs @@ -27,9 +27,16 @@ import PackageUtils (bringTarball, getPkgName, latestPackage, PackageData (..), packageName, packageVersion, stripPkgDevel) -import SysCmd ((+-+)) +import SimpleCmd ((+-+)) +import SysCmd (rpmMacroDefined) import Control.Monad (filterM, unless, void, when, (>=>)) + +#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) +#else +import Control.Applicative ((<$>)) +#endif + import Data.Char (toUpper) import Data.List (groupBy, intercalate, intersect, isPrefixOf, nub, sort, (\\)) @@ -112,9 +119,11 @@ hasExecPkg = binlib || (hasExec && not hasLib) -- run commands before opening file to prevent empty file on error -- maybe shell commands should be in a monad or something - (deps, tools, clibs, pkgcfgs, selfdep) <- packageDependencies (rpmStrict flags) pkgDesc + (deps, tools, clibs, pkgcfgs, hasSelfdep) <- packageDependencies (rpmStrict flags) pkgDesc + selfdep <- if not hasSelfdep + then return False + else not <$> rpmMacroDefined "ghc_without_dynamic" let testsuiteDeps = testsuiteDependencies pkgDesc name - missTestDeps <- filterM notInstalled testsuiteDeps specAlreadyExists <- doesFileExist specFile let specFile' = specFile ++ if not (rpmForce flags) && specAlreadyExists then ".cblrpm" else "" @@ -199,7 +208,7 @@ miss <- if rpmSubpackage flags || rpmMissing flags then missingPackages pkgDesc else return [] return $ nub (subs ++ miss) subpkgs <- if rpmSubpackage flags then - mapM ((getsubpkgMacro flags >=> + mapM ((getsubpkgMacro flags specFile >=> \(m,pv) -> put ("%global" +-+ m +-+ pv) >> return ("%{" ++ m ++ "}")) . stripPkgDevel) missing else return [] @@ -209,6 +218,7 @@ putNewline unless (null testsuiteDeps) $ do + missTestDeps <- filterM notInstalled testsuiteDeps put $ "%bcond_" ++ (if null missTestDeps then "without" else "with") +-+ "tests" putNewline @@ -268,11 +278,12 @@ let wrapGenDesc = wordwrap (79 - max 0 (length pkgname - length pkg_name)) - let exposesModules = - hasLib && (notNull . exposedModules . fromJust . library) pkgDesc + -- haskell-gi generates lib source files at configure time + let hasModules = + hasLib && ((notNull . exposedModules . fromJust . library) pkgDesc || "ghc-haskell-gi-devel" `elem` deps) when hasLib $ do - when (binlib && exposesModules) $ do + when (binlib && hasModules) $ do put $ "%package" +-+ ghcPkg putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library" case distro of @@ -291,7 +302,7 @@ _ -> return () unless (distro == SUSE) $ putHdr "Provides" $ (if binlib then "ghc-%{name}" else "%{name}") ++ "-static = %{version}-%{release}" - when exposesModules $ + when hasModules $ putHdr "Provides" $ (if binlib then "ghc-%{name}" else "%{name}") ++ "-doc" +-+ "= %{version}-%{release}" put "%if %{defined ghc_version}" putHdr "Requires" "ghc-compiler = %{ghc_version}" @@ -299,7 +310,7 @@ putHdr "Requires(postun)" "ghc-compiler = %{ghc_version}" put "%endif" let isa = if distro == SUSE then "" else "%{?_isa}" - when exposesModules $ + when hasModules $ putHdr "Requires" $ (if binlib then "ghc-%{name}" else "%{name}") ++ isa +-+ "= %{version}-%{release}" unless (null $ clibs ++ pkgcfgs) $ do put "# Begin cabal-rpm deps:" @@ -335,7 +346,7 @@ let cabalFlags = [ "-f" ++ (if b then "" else "-") ++ unFlagName n | (n, b) <- rpmConfigurationsFlags flags ] put $ "%define cabal_configure_options " ++ unwords cabalFlags let pkgType = if hasLib then "lib" else "bin" - if hasLib && not exposesModules + if hasLib && not hasModules then put $ "%ghc_" ++ pkgType ++ "_build_without_haddock" else put $ "%ghc_" ++ pkgType ++ "_build" sectionNewline @@ -360,9 +371,10 @@ 1 -> head dupdocs _ -> "{" ++ intercalate "," dupdocs ++ "}" - when (hasLib && not exposesModules) $ + when (hasLib && not hasModules) $ put "mv %{buildroot}%{_ghcdocdir}{,-devel}" + -- can really be dropped for static executables when (selfdep && binlib) $ put "mv %{buildroot}%{_ghclicensedir}/{,ghc-}%{name}" @@ -403,7 +415,7 @@ when hasLib $ do let baseFiles = if binlib then "-f ghc-%{name}.files" else "-f %{name}.files" develFiles = if binlib then "-f ghc-%{name}-devel.files" else "-f %{name}-devel.files" - when exposesModules $ do + when hasModules $ do put $ "%files" +-+ ghcPkg +-+ baseFiles when (distro /= Fedora) $ put "%defattr(-,root,root,-)" mapM_ (\ l -> put $ license_macro +-+ l) licensefiles @@ -414,7 +426,7 @@ sectionNewline put $ "%files" +-+ ghcPkgDevel +-+ develFiles when (distro /= Fedora) $ put "%defattr(-,root,root,-)" - unless exposesModules $ + unless hasModules $ mapM_ (\ l -> put $ license_macro +-+ l) licensefiles unless (null docs) $ put $ "%doc" +-+ unwords docs @@ -506,12 +518,12 @@ paragraphs :: [String] -> [String] paragraphs = map (unlines . filter notNull) . groupBy (const notNull) -getsubpkgMacro :: RpmFlags -> String -> IO (String, String) -getsubpkgMacro flags pkg = do - let name = filter (/= '-') pkg +getsubpkgMacro :: RpmFlags -> FilePath -> String -> IO (String, String) +getsubpkgMacro flags spec pkg = do + let macro = filter (/= '-') pkg pkgver <- latestPackage (rpmStream flags) pkg - bringTarball pkgver False - return (name, pkgver) + bringTarball pkgver False spec + return (macro, pkgver) number :: [a] -> [(String,a)] number = zip (map show [(1::Int)..]) diff --git a/src/Commands/Update.hs b/src/Commands/Update.hs --- a/src/Commands/Update.hs +++ b/src/Commands/Update.hs @@ -23,8 +23,10 @@ import PackageUtils (PackageData (..), bringTarball, editSpecField, getRevisedCabal, getSpecField, latestPackage, packageName, packageVersion, patchSpec, prepare, readVersion, - removePrefix, removeSuffix, rwGitDir) -import SysCmd (cmd_, die, grep_, shell, (+-+)) + removePrefix, removeSuffix) +import SimpleCmd (cmd_, grep_, shell_, (+-+)) +import SimpleCmd.Git (rwGitDir) +import SysCmd (die) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else import Control.Applicative ((<$>)) @@ -32,7 +34,7 @@ import Control.Monad (unless, when) import Data.Maybe (isJust) import Distribution.PackageDescription (PackageDescription (..)) -import System.Directory (createDirectory, setCurrentDirectory) +import System.Directory (createDirectory, renameFile, setCurrentDirectory) import System.FilePath ((), (<.>)) update :: PackageData -> RpmFlags -> Maybe String -> IO () @@ -60,9 +62,8 @@ unless updated $ putStrLn "Package is already latest version." when (not revised || updated) $ do - rwGit <- rwGitDir when updated $ - bringTarball latest False + bringTarball latest False spec withTempDirectory $ \cwd -> do let specfile = cwd spec subpkg <- grep_ "%{subpkgs}" specfile @@ -86,6 +87,7 @@ unless subpkg $ editSpecField "Release" ("0" ++ suffix) specfile cmd_ "rpmdev-bumpspec" ["-c", "update to" +-+ newver, specfile] + rwGit <- rwGitDir when rwGit $ do setCurrentDirectory cwd when subpkg $ do @@ -93,10 +95,12 @@ cmd_ "sed" ["-i", "/" ++ current <.> "tar.gz" ++ "/d", "sources.cblrpm"] cmd_ "fedpkg" ["new-sources", latest <.> "tar.gz"] when subpkg $ do - shell $ "cat sources >>" +-+ "sources.cblrpm" - cmd_ "mv" ["-f", "sources.cblrpm", "sources"] + shell_ $ "cat sources >>" +-+ "sources.cblrpm" + renameFile "sources.cblrpm" "sources" when newrevised $ cmd_ "git" ["add", latest <.> "cabal"] + when revised $ + cmd_ "git" ["rm", current <.> "cabal"] cmd_ "git" ["commit", "-a", "-m", "update to" +-+ newver] where createSpecVersion :: String -> String -> Bool -> Bool -> IO (FilePath, Bool) diff --git a/src/Dependencies.hs b/src/Dependencies.hs --- a/src/Dependencies.hs +++ b/src/Dependencies.hs @@ -27,7 +27,9 @@ ) where import PackageUtils (PackageData(..), packageName, packageManager, repoquery) -import SysCmd (cmd, cmd_, cmdBool, optionalProgram, rpmEval, trySystem, (+-+)) +import SimpleCmd (cmd, cmd_, cmdBool, (+-+)) +import SimpleCmd.Rpm (rpmspec) +import SysCmd (optionalProgram, rpmEval, trySystem) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else @@ -52,10 +54,12 @@ #if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,0,0) import Distribution.Types.LegacyExeDependency (LegacyExeDependency (..)) import Distribution.Types.PkgconfigDependency (PkgconfigDependency (..)) -#else #endif import Distribution.PackageDescription (PackageDescription (..), +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,4,0) + allBuildDepends, +#endif allBuildInfo, BuildInfo (..), TestSuite (..), @@ -72,16 +76,29 @@ excludedPkgs :: String -> Bool excludedPkgs = flip notElem ["Cabal", "base", "ghc-prim", "integer-gmp"] +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,4,0) +#else +allBuildDepends :: PackageDescription -> [Dependency] +allBuildDepends = buildDepends +#endif + -- returns list of deps and whether package is self-dependent buildDependencies :: PackageDescription -> String -> ([String], Bool) buildDependencies pkgDesc self = - let deps = nub $ map depName (buildDepends pkgDesc) -#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,24,0) - ++ (maybe [] (map depName . setupDepends) (setupBuildInfo pkgDesc)) -#endif + let deps = nub $ map depName (allBuildDepends pkgDesc) + ++ setupDependencies pkgDesc in (filter excludedPkgs (delete self deps), self `elem` deps && hasExes pkgDesc) +setupDependencies :: PackageDescription -- ^pkg description + -> [String] -- ^depends +setupDependencies pkgDesc = +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,24,0) + maybe [] (map depName . setupDepends) (setupBuildInfo pkgDesc) +#else + [] +#endif + #if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,22,0) #else unPackageName :: PackageName -> String @@ -191,7 +208,7 @@ notInstalled :: String -> IO Bool notInstalled dep = - not <$> cmdBool "rpm" ["-q", "--whatprovides", shellQuote dep] + not <$> cmdBool "rpm" ["-q", "--quiet", "--whatprovides", shellQuote dep] where shellQuote :: String -> String shellQuote (c:cs) = (if c `elem` "()" then (['\\', c] ++) else (c:)) (shellQuote cs) @@ -210,7 +227,7 @@ subPackages :: Maybe FilePath -> PackageDescription -> IO [String] subPackages mspec pkgDesc = do - develSubpkgs <- filter ("-devel" `isSuffixOf`) . lines <$> maybe (return "") (\ f -> cmd "rpmspec" ["-q", "--qf", "%{name}\n", f]) mspec + develSubpkgs <- filter ("-devel" `isSuffixOf`) <$> maybe (return []) (rpmspec [] (Just "%{name}")) mspec let self = packageName $ package pkgDesc return $ delete (showDep self) develSubpkgs @@ -251,4 +268,3 @@ where showPkg :: String -> String showPkg p = if '(' `elem` p then show p else p - diff --git a/src/Distro.hs b/src/Distro.hs --- a/src/Distro.hs +++ b/src/Distro.hs @@ -17,20 +17,20 @@ readDistroName, Distro(..)) where -import SysCmd (rpmEval) -import Data.Maybe (fromMaybe) +import SysCmd (rpmEval, rpmMacroDefined) +import Data.Maybe (fromMaybe, isNothing) import Data.Char (toLower) data Distro = Fedora | RHEL5 | SUSE deriving (Show, Eq) detectDistro :: IO Distro detectDistro = do - suseVersion <- rpmEval "%{?suse_version}" - if null suseVersion then do + suse <- rpmMacroDefined "suse_version" + if suse then return SUSE + else do dist <- rpmEval "%{?dist}" -- RHEL5 does not have macros.dist - return $ if null dist || dist == ".el5" then RHEL5 else Fedora - else return SUSE + return $ if isNothing dist || dist == Just ".el5" then RHEL5 else Fedora parseDistroName :: String -> Maybe Distro parseDistroName x = lookup (map toLower x) known diff --git a/src/FileUtils.hs b/src/FileUtils.hs --- a/src/FileUtils.hs +++ b/src/FileUtils.hs @@ -23,7 +23,7 @@ withCurrentDirectory, withTempDirectory) where -import SysCmd (cmd) +import SimpleCmd (cmd) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -28,9 +28,11 @@ import PackageUtils (prepare, RpmStage (..)) import System.Environment (getArgs) +import System.IO (BufferMode(LineBuffering), hSetBuffering, stdout) main :: IO () main = do + hSetBuffering stdout LineBuffering (opts, cmd, mpkg) <- getArgs >>= parseArgs pkgdata <- prepare opts mpkg True case cmd of diff --git a/src/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -47,7 +47,7 @@ import Distro (Distro(..), readDistroName) import Paths_cabal_rpm (version) -import SysCmd ((+-+)) +import SimpleCmd ((+-+)) data RpmFlags = RpmFlags { rpmConfigurationsFlags :: [(FlagName, Bool)] @@ -74,7 +74,7 @@ , rpmBinary = False , rpmStrict = False , rpmSubpackage = False - , rpmStream = "lts" + , rpmStream = defaultStream , rpmMissing = False , rpmRelease = Nothing , rpmCompilerId = Nothing @@ -83,6 +83,9 @@ , rpmVersion = False } +defaultStream :: String +defaultStream = "lts" + quiet :: RpmFlags quiet = emptyRpmFlags {rpmVerbosity = silent} @@ -94,8 +97,8 @@ "Force Haskell package name to be base package name" , Option "" ["force"] (NoArg (\x -> x { rpmForce = True })) "Overwrite existing spec file." - , Option "s" ["stream"] (ReqArg (\s x -> x { rpmStream = s }) "STREAM") - "Stackage stream (default 'lts') or 'hackage' used to get package version." + , Option "s" ["stream"] (ReqArg (\s x -> x { rpmStream = s }) "STREAM") $ + "Stackage stream (default '" ++ defaultStream ++ "') or 'hackage' used to get package version." , Option "" ["missing"] (NoArg (\x -> x { rpmMissing = True })) "Comment out missing BuildRequires packages." , Option "" ["strict"] (NoArg (\x -> x { rpmStrict = True })) diff --git a/src/PackageUtils.hs b/src/PackageUtils.hs --- a/src/PackageUtils.hs +++ b/src/PackageUtils.hs @@ -35,16 +35,16 @@ rpmbuild, rpmInstall, RpmStage (..), - rwGitDir, stripPkgDevel ) where import FileUtils (filesWithExtension, fileWithExtension, getDirectoryContents_, mktempdir, withTempDirectory) import Options (RpmFlags (..)) -import SysCmd (cmd, cmd_, cmdIgnoreErr, cmdSilent, die, egrep_, grep_, - optionalProgram, requireProgram, rpmEval, sudo, (+-+)) - +import SimpleCmd (cmd, cmd_, cmdIgnoreErr, cmdLines, cmdSilent, grep_, sudo, + (+-+)) +import SimpleCmd.Git (isGitDir, grepGitConfig) +import SysCmd (die, optionalProgram, requireProgram, rpmEval) import Stackage (latestStackage) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) @@ -55,15 +55,23 @@ import Data.Char (isDigit, toLower) import Data.List (groupBy, isPrefixOf, isSuffixOf, sort, stripPrefix) -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromJust, fromMaybe, isJust) import Data.Version ( #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) Version, - makeVersion + makeVersion, #else - Version(..) + Version(..), #endif +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,0,0) +#else + showVersion +#endif ) +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,0,0) +import Distribution.Version (showVersion) +#else +#endif import Distribution.Compiler import Distribution.Package (PackageIdentifier (..), @@ -119,18 +127,12 @@ findPackageDesc #endif ) - import Distribution.System (Platform (..), buildArch, buildOS) -#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,0,0) -import Distribution.Version (showVersion) -#else -import Data.Version (showVersion) -#endif import System.Directory (copyFile, createDirectoryIfMissing,doesDirectoryExist, doesFileExist, getCurrentDirectory, getDirectoryContents, removeDirectoryRecursive, - setCurrentDirectory) + renameFile, setCurrentDirectory) import System.Environment (getEnv) import System.FilePath ((), (<.>), dropFileName, takeBaseName, takeFileName) import System.Posix.Files (accessTime, fileMode, getFileStatus, @@ -222,56 +224,68 @@ cabalFromSpec :: FilePath -> Bool -> IO (FilePath, Maybe FilePath) cabalFromSpec specFile revise = do -- no rpmspec command in RHEL 5 and 6 - namever <- removePrefix "ghc-" . head . lines <$> cmd "rpm" ["-q", "--qf", "%{name}-%{version}\n", "--specfile", specFile] + namever <- removePrefix "ghc-" . head <$> cmdLines "rpm" ["-q", "--qf", "%{name}-%{version}\n", "--specfile", specFile] dExists <- doesDirectoryExist namever if dExists then do specTime <- modificationTime <$> getFileStatus specFile dirTime <- accessTime <$> getFileStatus namever when (specTime > dirTime) $ do - bringTarball namever revise + bringTarball namever revise specFile rpmbuild Prep True Nothing specFile cabalfile <- tryFindPackageDesc namever return (cabalfile, Nothing) else do tmpdir <- mktempdir - bringTarball namever revise + bringTarball namever revise specFile rpmbuild Prep True (Just tmpdir) specFile cabalfile <- tryFindPackageDesc $ tmpdir namever return (cabalfile, Just tmpdir) -bringTarball :: FilePath -> Bool -> IO () -bringTarball nv revise = do +bringTarball :: FilePath -> Bool -> FilePath -> IO () +bringTarball nv revise spec = do + havespec <- doesFileExist spec + sources <- if havespec + then map sourceFieldFile <$> cmdLines "spectool" ["-S", spec] + else return [tarfile] srcdir <- getSourceDir - fExists <- doesFileExist $ srcdir tarfile - unless fExists $ do - pkggit <- egrep_ "\\(pkgs\\|src\\)." ".git/config" - if pkggit - then do + allExist <- and <$> mapM (doesFileExist . (srcdir )) sources + unless allExist $ do + pkggit <- grepGitConfig "\\(pkgs\\|src\\)." + when pkggit $ do srcnv <- grep_ tarfile "sources" - if srcnv - then cmd_ "fedpkg" ["sources"] - else copyTarball False srcdir - else copyTarball False srcdir - -- FIXME could also use "spectool -g -S NAME.spec" + when srcnv $ + cmd_ "fedpkg" ["sources"] + when havespec $ + cmd_ "spectool" ["-g", "-S", "-C", srcdir, spec] + -- why not versioned? + haveLocalCabal <- doesFileExist $ srcdir nv <.> "cabal" + when (not haveLocalCabal && revise) $ + getRevisedCabal nv + mapM_ (copyTarball False srcdir) sources where tarfile = nv <.> "tar.gz" - copyTarball :: Bool -> FilePath -> IO () - copyTarball ranFetch dir = do - let dest = dir tarfile - cabalUpdate - home <- getEnv "HOME" - let cacheparent = home ".cabal" "packages" - (n,v) = nameVersion nv - haveLocalCabal <- doesFileExist $ dir nv <.> "cabal" - when (not haveLocalCabal && revise) $ - getRevisedCabal nv + sourceFieldFile :: String -> FilePath + sourceFieldFile field = + if null field then + -- should be impossible + error "Empty source field!" + else (takeFileName . last . words) field + + copyTarball :: Bool -> FilePath -> FilePath -> IO () + copyTarball ranFetch dir file = do + let dest = dir file already <- doesFileExist dest + home <- getEnv "HOME" unless already $ do + let cacheparent = home ".cabal" "packages" + havecache <- doesDirectoryExist cacheparent + unless havecache cabalUpdate remotes <- getDirectoryContents_ cacheparent - let tarpath = n v tarfile + let (n,v) = nameVersion nv + tarpath = n v tarfile paths = map (\ repo -> cacheparent repo tarpath) remotes -- if more than one tarball, should maybe warn if they are different tarballs <- filterM doesFileExist paths @@ -280,7 +294,7 @@ then error $ "No" +-+ tarfile +-+ "found" else do cabal_ "fetch" ["-v0", "--no-dependencies", nv] - copyTarball True dir + copyTarball True dir file else do createDirectoryIfMissing True dir copyFile (head tarballs) dest @@ -291,9 +305,9 @@ getSourceDir :: IO FilePath getSourceDir = do + git <- isGitDir "." cwd <- getCurrentDirectory - git <- isGitDir cwd - if git then return cwd else rpmEval "%{_sourcedir}" + if git then return cwd else fromJust <$> rpmEval "%{_sourcedir}" getRevisedCabal :: String -> IO () getRevisedCabal nv = do @@ -303,8 +317,9 @@ withTempDirectory $ \ _ -> do cmd_ "wget" ["--quiet", "https://hackage.haskell.org/package" nv file] revised <- grep_ "x-revision" file - when revised $ - cmd_ "mv" [file, dir nv <.> "cabal"] + when revised $ do + cmd_ "dos2unix" ["--keepdate", file] + renameFile file $ dir nv <.> "cabal" nameVersion :: String -> (String, String) nameVersion nv = @@ -324,7 +339,7 @@ Prep -> "p" BuildDep -> "_" cwd <- getCurrentDirectory - gitDir <- isGitDir cwd + gitDir <- isGitDir "." let rpmdirs_override = [ "--define="++ mcr +-+ cwd | mcr <- ["_rpmdir", "_srcrpmdir", "_sourcedir"], gitDir] @@ -349,17 +364,12 @@ stripPkgDevel = removeSuffix "-devel" . removePrefix "ghc-" cabalUpdate :: IO () -cabalUpdate = do - home <- getEnv "HOME" - let cacheparent = home ".cabal" "packages" - pkgsdir <- doesDirectoryExist cacheparent - unless pkgsdir $ - cmd_ "cabal" ["update"] +cabalUpdate = cmd_ "cabal" ["update"] cabal :: String -> [String] -> IO [String] cabal c args = do cabalUpdate - lines <$> cmd "cabal" (c:args) + cmdLines "cabal" (c:args) cabal_ :: String -> [String] -> IO () cabal_ c args = do @@ -418,14 +428,6 @@ packageVersion :: PackageIdentifier -> String packageVersion = showVersion . pkgVersion -isGitDir :: FilePath -> IO Bool -isGitDir dir = doesDirectoryExist (dir ".git") - -rwGitDir :: IO Bool -rwGitDir = do - gitDir <- getCurrentDirectory >>= isGitDir - if gitDir then grep_ "url = ssh://" ".git/config" else return False - getPkgName :: Maybe FilePath -> PackageDescription -> Bool -> IO (String, Bool) getPkgName (Just spec) pkgDesc binary = do let name = packageName $ package pkgDesc @@ -540,6 +542,7 @@ cmd prog (subcmd ++ args ++ [key]) rpmInstall :: [String] -> IO () +rpmInstall [] = return () rpmInstall rpms = do pkginstaller <- packageManager let (inst, arg) = if pkginstaller == "dnf" then ("dnf", "install") else ("yum", "localinstall") diff --git a/src/Stackage.hs b/src/Stackage.hs --- a/src/Stackage.hs +++ b/src/Stackage.hs @@ -30,13 +30,14 @@ import Network.HTTP.Client import Network.HTTP.Client.TLS import System.FilePath (takeFileName) -import SysCmd ((+-+)) +import SimpleCmd ((+-+)) #else #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else import Control.Applicative ((<$>)) #endif -import SysCmd ((+-+), cmdMaybe, optionalProgram) +import SimpleCmd ((+-+), cmdMaybe) +import SysCmd (optionalProgram) #endif stackageList :: String -> String -> IO (Maybe String) diff --git a/src/SysCmd.hs b/src/SysCmd.hs --- a/src/SysCmd.hs +++ b/src/SysCmd.hs @@ -15,23 +15,12 @@ -- (at your option) any later version. module SysCmd ( - cmd, - cmd_, - cmdBool, - cmdIgnoreErr, - cmdMaybe, - cmdQuiet, - cmdSilent, die, - egrep_, - grep_, optionalProgram, requireProgram, rpmEval, - trySystem, - shell, - sudo, - (+-+)) where + rpmMacroDefined, + trySystem) where #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else @@ -53,9 +42,10 @@ #endif import Distribution.Verbosity (normal) -import System.Process (readProcess, readProcessWithExitCode, rawSystem) -import System.Exit (ExitCode(..)) +import System.Process (rawSystem) +import SimpleCmd (cmd) + #if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,0,0) die :: String -> IO a die = dieNoVerbosity @@ -81,101 +71,17 @@ optionalProgram c = isJust <$> findProgram c -cmd_ :: String -> [String] -> IO () -cmd_ c args = do - requireProgram c --- putStrLn $ "cmd_:" +-+ c +-+ unwords args - ret <- rawSystem c args - case ret of - ExitSuccess -> return () - ExitFailure n -> die ("\"" ++ c +-+ unwords args ++ "\"" +-+ "failed with status" +-+ show n) - --- hide stderr -cmdQuiet :: String -> [String] -> IO String -cmdQuiet c args = do - requireProgram c - (ret, out, err) <- readProcessWithExitCode c args "" - case ret of - ExitSuccess -> return $ removeTrailingNewline out - ExitFailure n -> die ("\"" ++ c +-+ unwords args ++ "\"" +-+ "failed with status" +-+ show n ++ "\n" ++ err) - --- hide stdout -cmdSilent :: String -> [String] -> IO () -cmdSilent c args = do - requireProgram c --- putStrLn $ "cmd_:" +-+ c +-+ unwords args - (ret, _, err) <- readProcessWithExitCode c args "" - case ret of - ExitSuccess -> return () - ExitFailure n -> die ("\"" ++ c +-+ unwords args ++ "\"" +-+ "failed with status" +-+ show n ++ "\n" ++ err) - -shell :: String -> IO () -shell c = cmd_ "sh" ["-c", c] - -sudo :: String -> [String] -> IO () -sudo c args = do - requireProgram "sudo" - requireProgram c - putStrLn $ "sudo" +-+ c +-+ unwords args - cmd_ "sudo" (c:args) - trySystem :: String -> [String] -> IO () trySystem c args = do requireProgram c void $ rawSystem c args -cmdBool :: String -> [String] -> IO Bool -cmdBool c args = do - requireProgram c - (ret, _out, _err) <- readProcessWithExitCode c args "" - case ret of - ExitSuccess -> return True - ExitFailure _ -> return False - -cmd :: FilePath -> [String] -> IO String -cmd c args = do - requireProgram c - removeTrailingNewline <$> readProcess c args "" - -cmdIgnoreErr :: FilePath -> [String] -> String -> IO String -cmdIgnoreErr c args input = do - (_exit, out, _err) <- readProcessWithExitCode c args input - return out - -cmdMaybe :: String -> [String] -> IO (Maybe String) -cmdMaybe c args = do - (ret, out, _err) <- readProcessWithExitCode c args "" - case ret of - ExitSuccess -> return $ Just $ removeTrailingNewline out - ExitFailure _ -> return Nothing - --- grep :: String -> FilePath -> IO [String] --- grep pat file = --- lines <$> cmd "grep" [pat, file] - -grep_ :: String -> FilePath -> IO Bool -grep_ pat file = - cmdBool "grep" ["-q", pat, file] - -egrep_ :: String -> FilePath -> IO Bool -egrep_ pat file = - cmdBool "grep" ["-q", "-e", pat, file] - -removeTrailingNewline :: String -> String -removeTrailingNewline "" = "" -removeTrailingNewline str = - if last str == '\n' - then init str - else str - -infixr 4 +-+ -(+-+) :: String -> String -> String -"" +-+ s = s -s +-+ "" = s -s +-+ t | last s == ' ' = s ++ t - | head t == ' ' = s ++ t -s +-+ t = s ++ " " ++ t +-- can't live in PackageUtils due to circular dep with Distro +rpmEval :: String -> IO (Maybe String) +rpmEval s = do + res <- cmd "rpm" ["--eval", s] + return $ if null res || res == s then Nothing else Just res -rpmEval :: String -> IO String -rpmEval s = - cmd "rpm" ["--eval", s] +rpmMacroDefined :: String -> IO Bool +rpmMacroDefined macro = + isJust <$> rpmEval ("%{?" ++ macro ++ "}")