cabal-rpm 0.11 → 0.11.1
raw patch · 12 files changed
+289/−162 lines, 12 files
Files
- ChangeLog +9/−0
- cabal-rpm.cabal +1/−1
- src/Commands/Depends.hs +2/−2
- src/Commands/Install.hs +6/−4
- src/Commands/Refresh.hs +22/−9
- src/Commands/RpmBuild.hs +2/−2
- src/Commands/Spec.hs +98/−37
- src/Commands/Update.hs +10/−10
- src/Dependencies.hs +3/−3
- src/Options.hs +4/−0
- src/PackageUtils.hs +95/−28
- src/SysCmd.hs +37/−66
ChangeLog view
@@ -1,3 +1,12 @@+* 0.11.1 (2017-03-13)+- support building meta (compat) packages+- invocation of optional stackage-query to update to LTS now works+- initial --subpackage support for %{subpkgs} of missing deps:+ including downloading, but update is not properly implemented yet+- new %{pkgver} macro+- (+-+) absorbs extra space+- update no longer resets release for %{subpkgs}+ * 0.11 (2017-01-27) - refresh command now reads the cabal-rpm version header in the spec file and installs that version of cabal-rpm under ~/.cblrpm/ and uses it to make patch
cabal-rpm.cabal view
@@ -1,5 +1,5 @@ Name: cabal-rpm-Version: 0.11+Version: 0.11.1 Synopsis: RPM packaging tool for Haskell Cabal-based packages Description: This package provides a RPM packaging tool for Haskell Cabal-based packages.
src/Commands/Depends.hs view
@@ -19,8 +19,8 @@ import Dependencies (dependencies, missingPackages, packageDependencies) import Options (quiet)-import PackageUtils (PackageData (..), prepare, stripPkgDevel)-import SysCmd (repoquery, (+-+))+import PackageUtils (PackageData (..), prepare, repoquery, stripPkgDevel)+import SysCmd ((+-+)) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else
src/Commands/Install.hs view
@@ -20,14 +20,15 @@ import Commands.RpmBuild (rpmBuild) import Dependencies (missingPackages, notInstalled) import Options (RpmFlags (..))-import PackageUtils (PackageData (..), RpmStage (..), stripPkgDevel)-import SysCmd (cmd, cmd_, pkgInstall, rpmInstall, (+-+))+import PackageUtils (PackageData (..), pkgInstall, rpmInstall, RpmStage (..), stripPkgDevel)+import SysCmd (cmd, cmd_, (+-+)) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else import Control.Applicative ((<$>)) #endif-import Control.Monad (unless, when)+import Control.Monad (filterM, unless, when)+import System.Directory (doesFileExist) import System.FilePath ((</>)) install :: PackageData -> RpmFlags -> IO ()@@ -45,7 +46,8 @@ rpmdir <- cmd "rpm" ["--eval", "%{_rpmdir}"] rpms <- (map (\ p -> rpmdir </> arch </> p ++ ".rpm") . lines) <$> cmd "rpmspec" ["-q", spec]- rpmInstall rpms+ -- metapkgs don't have base package+ filterM doesFileExist rpms >>= rpmInstall installMissing :: String -> IO () installMissing pkg = do
src/Commands/Refresh.hs view
@@ -15,22 +15,25 @@ refresh ) where +import Paths_cabal_rpm (version) import Commands.Spec (createSpecFile) import FileUtils (withTempDirectory) import Options (RpmFlags (..))-import PackageUtils (PackageData (..), removePrefix)-import SysCmd (cmd_, optionalProgram, shell, (+-+))+import PackageUtils (PackageData (..), isGitDir, patchSpec, removePrefix)+import SysCmd (cmd, cmd_, grep_, notNull, optionalProgram) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else import Control.Applicative ((<$>)) #endif-import Control.Monad (unless)+import Control.Monad (unless, when) import Data.List (isPrefixOf)+import Data.Version (showVersion) import Distribution.Simple.Utils (die) import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist,- setCurrentDirectory)+ getCurrentDirectory, setCurrentDirectory) import System.Environment (getEnv)+--import System.Exit (exitSuccess) import System.FilePath ((</>)) refresh :: PackageData -> RpmFlags -> IO ()@@ -38,14 +41,24 @@ case specFilename pkgdata of Nothing -> die "No (unique) .spec file in directory." Just spec -> do+ gitDir <- getCurrentDirectory >>= isGitDir+ rwGit <- if gitDir then grep_ "url = ssh://" ".git/config" else return False+ when rwGit $ do+ local <- cmd "git" ["diff"]+ when (notNull local) $+ putStrLn "Working dir contain local changes!"+ -- exitSuccess first <- head . lines <$> readFile spec- if "# generated by cabal-rpm-" `isPrefixOf` first- then do- let cblrpmver = removePrefix "# generated by cabal-rpm-" first+ do+ let cblrpmver =+ if "# generated by cabal-rpm-" `isPrefixOf` first+ then removePrefix "# generated by cabal-rpm-" first+ else "0.9.11"+ when (cblrpmver == showVersion version) $+ error "Packaging is up to date" oldspec <- createOldSpec cblrpmver spec newspec <- createSpecFile pkgdata flags Nothing- shell $ "diff -u2 -I \"- spec file generated by cabal-rpm\" -I \"Fedora Haskell SIG <haskell@lists.fedoraproject.org>\"" +-+ oldspec +-+ newspec +-+ "| sed -e 's/.cblrpm//' | patch" +-+ "|| :"- else putStrLn $ "No cabal-rpm header line in" +-+ spec+ patchSpec Nothing oldspec newspec -- setCurrentDirectory cwd -- when rwGit $ -- cmd_ "git" ["commit", "-a", "-m", "update to" +-+ newver]
src/Commands/RpmBuild.hs view
@@ -23,8 +23,8 @@ import Dependencies (missingPackages) import Options (RpmFlags (..)) import PackageUtils (copyTarball, isScmDir, PackageData (..), packageName,- packageVersion, rpmbuild, RpmStage (..))-import SysCmd (cmd, pkgInstall, (+-+))+ packageVersion, rpmbuild, pkgInstall, RpmStage (..))+import SysCmd (cmd, (+-+)) --import Control.Exception (bracket) import Control.Monad (unless, void, when)
src/Commands/Spec.hs view
@@ -20,23 +20,24 @@ createSpecFile, createSpecFile_ ) where -import Dependencies (notInstalled, packageDependencies, showDep,- testsuiteDependencies)+import Dependencies (notInstalled, missingPackages, packageDependencies,+ showDep, testsuiteDependencies) import Distro (Distro(..), detectDistro) import Options (RpmFlags (..))-import PackageUtils (getPkgName, isScmDir, PackageData (..),- packageName, packageVersion)-import SysCmd ((+-+))+import PackageUtils (copyTarball, getPkgName, isScmDir, latestPackage,+ nameVersion, PackageData (..), packageName,+ packageVersion, stripPkgDevel)+import SysCmd ((+-+), notNull) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else import Control.Applicative ((<$>)) #endif-import Control.Monad (filterM, unless, void, when)+import Control.Monad (filterM, unless, void, when, (>=>)) import Data.Char (toLower, toUpper) import Data.List (groupBy, intercalate, intersect, isPrefixOf, isSuffixOf, sort, (\\))-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, fromJust) import Data.Time.Clock (getCurrentTime) import Data.Time.Format (formatTime) import Data.Version (showVersion)@@ -47,7 +48,7 @@ import Distribution.PackageDescription (BuildInfo (..), PackageDescription (..), Executable (..), FlagName (..),- exeName, hasExes, hasLibs)+ Library (..), exeName, hasExes, hasLibs) --import Distribution.Version (VersionRange, foldVersionRange') @@ -112,10 +113,10 @@ h <- openFile specFile' WriteMode let putHdr hdr val = hPutStrLn h (hdr ++ ":" ++ padding hdr ++ val) padding hdr = replicate (14 - length hdr) ' ' ++ " "+ putHdrComment hdr val = putHdr ('#':hdr) (' ':val) putNewline = hPutStrLn h "" sectionNewline = putNewline >> putNewline put = hPutStrLn h- putDef v s = put $ "%global" +-+ v +-+ s ghcPkg = if binlib then "-n ghc-%{name}" else "" ghcPkgDevel = if binlib then "-n ghc-%{name}-devel" else "devel" @@ -170,9 +171,23 @@ _ -> c: filterSymbols cs filterSymbols [] = [] when hasLib $ do- putDef "pkg_name" name+ put $ "%global pkg_name" +-+ name+ put "%global pkgver %{pkg_name}-%{version}" putNewline + let pkgver = if hasLib then "%{pkgver}" else pkg_name ++ "-%{version}"++ -- FIXME sort by build order+ missing <- if rpmSubpackage flags then missingPackages pkgDesc else return []+ subpackages <-+ mapM ((getsubpkgMacro >=>+ \(m,pv) -> put ("%global" +-+ m +-+ pv) >> return ("%{" ++ m ++ "}"))+ . stripPkgDevel) missing+ let hasSubpkgs = notNull subpackages+ when hasSubpkgs $ do+ put $ "%global subpkgs" +-+ unwords subpackages+ putNewline+ unless (null testsuiteDeps) $ do put $ "%bcond_" ++ (if null missTestDeps then "without" else "with") +-+ "tests" putNewline@@ -181,7 +196,7 @@ -- let lCsources = concatMap (cSources . libBuildInfo) $ maybeToList $ library pkgDesc -- when (null $ eCsources ++ lCsources) $ do -- put "# no useful debuginfo for Haskell packages without C sources"- -- putDef "debug_package" "%{nil}"+ -- put $ "%global debug_package" +-+ "%{nil}" -- putNewline defRelease <- defaultRelease cabalPath distro@@ -190,6 +205,8 @@ revision = show $ maybe (0::Int) read (lookup "x-revision" (customFieldsPD pkgDesc)) putHdr "Name" (if binlib then "%{pkg_name}" else basename) putHdr "Version" version+ when hasSubpkgs $+ put "# can only be reset when all subpkgs bumped" putHdr "Release" $ release ++ (if distro == SUSE then [] else "%{?dist}") putHdr "Summary" summary case distro of@@ -199,25 +216,26 @@ _ -> return () putNewline putHdr "License" $ (showLicense distro . license) pkgDesc- putHdr "Url" $ "https://hackage.haskell.org/package/" ++ pkg_name- putHdr "Source0" $ "https://hackage.haskell.org/package/" ++ pkg_name ++ "-%{version}/" ++ pkg_name ++ "-%{version}.tar.gz"+ putHdr "Url" $ "https://hackage.haskell.org/package" </> pkg_name+ putHdr "Source0" $ sourceUrl pkgver+ mapM_ (\ (n,p) -> putHdr ("Source" ++ n) (sourceUrl p)) $ number subpackages when (revision /= "0") $ if distro == SUSE- then putHdr "Source1" $ "https://hackage.haskell.org/package/" ++ pkg_name ++ "-%{version}/revision/" ++ revision ++ ".cabal#/" ++ pkg_name ++ ".cabal"+ then putHdr "Source1" $ "https://hackage.haskell.org/package" </> pkgver </> "revision" </> revision ++ ".cabal#" </> pkg_name ++ ".cabal" else putStrLn "Warning: this is a revised .cabal file" case distro of Fedora -> return () _ -> putHdr "BuildRoot" "%{_tmppath}/%{name}-%{version}-build" putNewline putHdr "BuildRequires" "ghc-Cabal-devel"- putHdr "BuildRequires" "ghc-rpm-macros"+ putHdr "BuildRequires" $ "ghc-rpm-macros" ++ (if hasSubpkgs then "-extra" else "") let isa = if distro == SUSE then "" else "%{?_isa}" let alldeps = sort $ deps ++ tools ++ map (++ isa) clibs ++ pkgcfgs let extraTestDeps = sort $ testsuiteDeps \\ deps unless (null $ alldeps ++ extraTestDeps) $ do put "# Begin cabal-rpm deps:"- mapM_ (putHdr "BuildRequires") alldeps+ mapM_ (\ d -> (if d `elem` missing then putHdrComment else putHdr) "BuildRequires" d) alldeps -- for ghc < 7.8 when (distro `notElem` [Fedora, SUSE] && any (\ d -> d `elem` map showDep ["template-haskell", "hamlet"]) deps) $@@ -236,8 +254,11 @@ let wrapGenDesc = wordwrap (79 - max 0 (length pkgname - length pkg_name)) + let exposesModules =+ hasLib && (notNull . exposedModules . fromJust . library) pkgDesc+ when hasLib $ do- when binlib $ do+ when (binlib && exposesModules) $ do put $ "%package" +-+ ghcPkg putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library" case distro of@@ -259,23 +280,38 @@ putHdr "Requires" "ghc-compiler = %{ghc_version}" putHdr "Requires(post)" "ghc-compiler = %{ghc_version}" putHdr "Requires(postun)" "ghc-compiler = %{ghc_version}"- putHdr "Requires" $ (if binlib then "ghc-%{name}" else "%{name}") ++ isa +-+ "= %{version}-%{release}"+ when exposesModules $+ putHdr "Requires" $ (if binlib then "ghc-%{name}" else "%{name}") ++ isa +-+ "= %{version}-%{release}" unless (null $ clibs ++ pkgcfgs) $ do put "# Begin cabal-rpm deps:"- mapM_ (putHdr "Requires") $ sort $ map (++ isa) clibs ++ pkgcfgs ++ ["pkgconfig" | distro == SUSE, not $ null pkgcfgs]+ mapM_ (putHdr "Requires") $ sort $ map (++ isa) clibs ++ pkgcfgs ++ ["pkgconfig" | distro == SUSE, notNull pkgcfgs] put "# End cabal-rpm deps" putNewline put $ "%description" +-+ ghcPkgDevel put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "library development files."+ -- previous line ends in an extra newline putNewline + when hasSubpkgs $ do+ put "%global main_version %{version}"+ putNewline+ put "%if %{defined ghclibdir}"+ mapM_ (\p -> put $ "%ghc_lib_subpackage" +-+ p) subpackages+ put "%endif"+ putNewline+ put "%global version %{main_version}"+ sectionNewline+ put "%prep"- put $ "%setup -q" ++ (if pkgname /= name then " -n %{pkg_name}-%{version}" else "")+ put $ "%setup -q" ++ (if pkgname /= name then " -n" +-+ pkgver else "") +-++ (if hasSubpkgs then unwords (map (("-a" ++) . fst) $ number subpackages) else "") when (distro == SUSE && revision /= "0") $ put $ "cp -p %{SOURCE1}" +-+ pkg_name ++ ".cabal" sectionNewline put "%build"+ when hasSubpkgs $+ put "%ghc_libs_build %{subpkgs}" when (distro == SUSE && rpmConfigurationsFlags flags /= []) $ do let cabalFlags = [ "-f" ++ (if b then "" else "-") ++ n | (FlagName n, b) <- rpmConfigurationsFlags flags ] put $ "%define cabal_configure_options " ++ unwords cabalFlags@@ -284,11 +320,12 @@ sectionNewline put "%install"+ when hasSubpkgs $+ put "%ghc_libs_install %{subpkgs}" put $ "%ghc_" ++ pkgType ++ "_install" - when selfdep $ do- putNewline- put $ "%ghc_fix_rpath" +-+ "%{pkg_name}-%{version}"+ when selfdep $+ put $ "%ghc_fix_rpath" +-+ pkgver let licensefiles = #if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,20,0)@@ -301,15 +338,22 @@ docs <- sort <$> findDocs cabalPath licensefiles let datafiles = dataFiles pkgDesc dupdocs = docs `intersect` datafiles+ datafiles' = datafiles \\ dupdocs unless (null dupdocs) $ do putNewline putStrLn $ "Warning: doc files found in datadir:" +-+ unwords dupdocs unless (distro == SUSE) $- put $ "rm %{buildroot}%{_datadir}/" ++ pkg_name ++ "-%{version}/" +++ put $ "rm %{buildroot}%{_datadir}" </> pkgver </> case length dupdocs of 1 -> head dupdocs _ -> "{" ++ intercalate "," dupdocs ++ "}" + when (hasLib && not exposesModules) $+ put "mv %{buildroot}%{_ghcdocdir}{,-devel}"++ when selfdep $+ put "mv %{buildroot}%{_ghcdocdir}/{,ghc-}%{name}"+ sectionNewline unless (null testsuiteDeps) $ do@@ -337,29 +381,32 @@ mapM_ (\ l -> put $ license_macro +-+ l) licensefiles unless (null docs) $ put $ "%doc" +-+ unwords docs- mapM_ (\ p -> put $ "%{_bindir}/" ++ (if p == name then "%{name}" else p)) execs- unless (null datafiles) $- put $ "%{_datadir}/" ++ pkg_name ++ "-%{version}"+ mapM_ (\ p -> put $ "%{_bindir}" </> (if p == name then "%{name}" else p)) execs+ when (notNull datafiles' && not selfdep) $+ put $ "%{_datadir}" </> pkgver sectionNewline 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"- put $ "%files" +-+ ghcPkg +-+ baseFiles- when (distro /= Fedora) $ put "%defattr(-,root,root,-)"- mapM_ (\ l -> put $ license_macro +-+ l) licensefiles- when (distro == SUSE && not binlib) $- mapM_ (\ p -> put $ "%{_bindir}/" ++ (if p == name then "%{pkg_name}" else p)) execs- unless (null datafiles || binlib) $- put $ "%{_datadir}/" ++ pkg_name ++ "-%{version}"- sectionNewline+ when exposesModules $ do+ put $ "%files" +-+ ghcPkg +-+ baseFiles+ when (distro /= Fedora) $ put "%defattr(-,root,root,-)"+ mapM_ (\ l -> put $ license_macro +-+ l) licensefiles+ when (distro == SUSE && not binlib) $+ mapM_ (\ p -> put $ "%{_bindir}" </> (if p == name then "%{pkg_name}" else p)) execs+ when (notNull datafiles' && (selfdep || not binlib)) $+ put $ "%{_datadir}" </> pkgver+ sectionNewline put $ "%files" +-+ ghcPkgDevel +-+ develFiles when (distro /= Fedora) $ put "%defattr(-,root,root,-)"+ unless exposesModules $+ mapM_ (\ l -> put $ license_macro +-+ l) licensefiles unless (null docs) $ put $ "%doc" +-+ unwords docs when (distro /= SUSE && not binlib) $- mapM_ (\ p -> put $ "%{_bindir}/" ++ (if p == name then "%{pkg_name}" else p)) execs+ mapM_ (\ p -> put $ "%{_bindir}" </> (if p == name then "%{pkg_name}" else p)) execs sectionNewline put "%changelog"@@ -433,6 +480,9 @@ showLicense _ UnspecifiedLicense = "Unspecified license!" #endif +sourceUrl :: String -> String+sourceUrl pv = "https://hackage.haskell.org/package" </> pv </> pv ++ ".tar.gz"+ -- http://rosettacode.org/wiki/Word_wrap#Haskell wordwrap :: Int -> String -> String wordwrap maxlen = wrap_ 0 False . words@@ -454,4 +504,15 @@ -- from http://stackoverflow.com/questions/930675/functional-paragraphs -- using split would be: map unlines . (Data.List.Split.splitWhen null) paragraphs :: [String] -> [String]- paragraphs = map (unlines . filter (not . null)) . groupBy (const $ not . null)+ paragraphs = map (unlines . filter notNull) . groupBy (const notNull)++getsubpkgMacro :: String -> IO (String, String)+getsubpkgMacro pkg = do+ let name = filter (/= '-') pkg+ pkgver <- latestPackage pkg+ let (n,v) = nameVersion pkgver+ copyTarball n v False "."+ return (name, pkgver)++number :: [a] -> [(String,a)]+number = zip (map show [(1::Int)..])
src/Commands/Update.hs view
@@ -21,13 +21,14 @@ import FileUtils (withTempDirectory) import Options (RpmFlags (..)) import PackageUtils (PackageData (..), bringTarball, isGitDir, latestPackage,- packageName, packageVersion, prepare, removePrefix)-import SysCmd (cmd_, cmdBool, cmdIgnoreErr, (+-+))+ packageName, packageVersion, patchSpec, prepare,+ removePrefix)+import SysCmd (cmd_, grep_, (+-+)) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else import Control.Applicative ((<$>)) #endif-import Control.Monad (when)+import Control.Monad (unless, when) import Distribution.PackageDescription (PackageDescription (..)) import Distribution.Simple.Utils (die) import Data.Maybe (fromMaybe)@@ -47,24 +48,23 @@ Just pv -> return pv Nothing -> latestPackage name if current == latest- then error $ current +-+ "is already latest version."+ then putStrLn $ current +-+ "is already latest version." else do bringTarball latest gitDir <- getCurrentDirectory >>= isGitDir- rwGit <- if gitDir then cmdBool "grep -q 'url = ssh://' .git/config" else return False+ rwGit <- if gitDir then grep_ "url = ssh://" ".git/config" else return False when rwGit $ cmd_ "fedpkg" ["new-sources", latest ++ ".tar.gz"] withTempDirectory $ \cwd -> do curspec <- createSpecVersion current spec newspec <- createSpecVersion latest spec- patch <- cmdIgnoreErr "diff" ["-u2", "-I - spec file generated by cabal-rpm", "-I Fedora Haskell SIG <haskell@lists.fedoraproject.org>", curspec, newspec] ""- putStrLn patch- out <- cmdIgnoreErr "patch" ["-d", cwd, "-p1" ] patch- putStrLn out+ patchSpec (Just cwd) curspec newspec setCurrentDirectory cwd distro <- fromMaybe detectDistro (return <$> rpmDistribution flags) let suffix = if distro == SUSE then "" else "%{?dist}"- cmd_ "sed" ["-i", "-e s/^\\(Release: \\).*/\\10" ++ suffix ++ "/", spec]+ subpkg <- grep_ "%{subpkgs}" spec+ unless (subpkg || rpmSubpackage flags) $+ cmd_ "sed" ["-i", "-e s/^\\(Release: \\).*/\\10" ++ suffix ++ "/", spec] let newver = removePrefix (name ++ "-") latest if distro == SUSE then cmd_ "sed" ["-i", "-e s/^\\(Version: \\).*/\\1" ++ newver ++ "/", spec]
src/Dependencies.hs view
@@ -24,8 +24,8 @@ testsuiteDependencies ) where -import PackageUtils (packageName)-import SysCmd (cmd, cmdBool, repoquery, (+-+))+import PackageUtils (packageName, repoquery)+import SysCmd (cmd, cmdBool, (+-+)) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else@@ -152,7 +152,7 @@ notInstalled :: String -> IO Bool notInstalled dep =- fmap not $ cmdBool $ "rpm -q --whatprovides" +-+ shellQuote dep+ not <$> cmdBool "rpm" ["-q", "--whatprovides", shellQuote dep] where shellQuote :: String -> String shellQuote (c:cs) = (if c `elem` "()" then (['\\', c] ++) else (c:)) (shellQuote cs)
src/Options.hs view
@@ -49,6 +49,7 @@ , rpmHelp :: Bool , rpmBinary :: Bool , rpmStrict :: Bool+ , rpmSubpackage :: Bool , rpmRelease :: Maybe String , rpmCompilerId :: Maybe CompilerId , rpmDistribution :: Maybe Distro@@ -64,6 +65,7 @@ , rpmHelp = False , rpmBinary = False , rpmStrict = False+ , rpmSubpackage = False , rpmRelease = Nothing , rpmCompilerId = Nothing , rpmDistribution = Nothing@@ -84,6 +86,8 @@ "Overwrite existing spec file." , Option "" ["strict"] (NoArg (\x -> x { rpmStrict = True })) "Fail rather than produce an incomplete spec file."+ , Option "" ["subpackage"] (NoArg (\x -> x { rpmSubpackage = True }))+ "Subpackage missing dependencies." , Option "V" ["version"] (NoArg (\x -> x { rpmVersion = True })) "Show version number" , Option "f" ["flags"] (ReqArg (\flags x -> x { rpmConfigurationsFlags = rpmConfigurationsFlags x ++ flagList flags }) "FLAGS")
src/PackageUtils.hs view
@@ -20,12 +20,17 @@ isGitDir, isScmDir, latestPackage,+ nameVersion, PackageData (..), packageName, packageVersion,+ patchSpec,+ pkgInstall, prepare, removePrefix,+ repoquery, rpmbuild,+ rpmInstall, RpmStage (..), simplePackageDescription, stripPkgDevel@@ -34,7 +39,8 @@ import FileUtils (filesWithExtension, fileWithExtension, getDirectoryContents_, mktempdir) import Options (RpmFlags (..))-import SysCmd (cmd, cmd_, cmdSilent, (+-+), optionalProgram)+import SysCmd (cmd, cmd_, cmdIgnoreErr, cmdMaybe, cmdSilent, (+-+),+ notNull, optionalProgram, requireProgram, sudo, trySystem) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else@@ -43,8 +49,8 @@ import Control.Monad (filterM, unless, when) import Data.Char (isDigit)-import Data.List (isPrefixOf, stripPrefix)-import Data.Maybe (fromMaybe, isJust)+import Data.List (isPrefixOf, stripPrefix, (\\))+import Data.Maybe (fromMaybe, isJust, fromJust) import Data.Version (showVersion) import Distribution.Compiler@@ -57,20 +63,26 @@ import Distribution.Simple.Compiler ( #if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,22,0)- compilerInfo+ compilerInfo #else- Compiler (..)+ Compiler (..) #endif- )+ ) import Distribution.Simple.Configure ( #if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,18,0)- configCompilerEx+ configCompilerEx #else- configCompiler+ configCompiler #endif- )+ ) import Distribution.Simple.Program (defaultProgramConfiguration)-import Distribution.Simple.Utils (die, findPackageDesc)+import Distribution.Simple.Utils (die+#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,20,0)+ , tryFindPackageDesc+#else+ , findPackageDesc+#endif+ ) import Distribution.System (Platform (..), buildArch, buildOS) @@ -81,6 +93,7 @@ import System.FilePath ((</>), (<.>), takeBaseName, takeFileName) import System.Posix.Files (accessTime, fileMode, getFileStatus, modificationTime, setFileMode)+import System.Posix.User (getEffectiveUserID) -- returns path to .cabal file and possibly tmpdir to be removed --findCabalFile :: Verbosity -> FilePath -> IO (FilePath, Maybe FilePath)@@ -124,15 +137,10 @@ Left e -> die $ "finalize failed: " ++ show e Right (pd, _) -> return pd -findPackageDesc' :: FilePath -> IO FilePath #if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,20,0)-findPackageDesc' pth = do- res <- findPackageDesc pth- case res of- Left err -> error err- Right cbl -> return cbl #else-findPackageDesc' = findPackageDesc+tryFindPackageDesc :: FilePath -> IO FilePath+tryFindPackageDesc = findPackageDesc #endif cabalFromSpec :: FilePath -> IO (FilePath, Maybe FilePath)@@ -147,13 +155,13 @@ when (specTime > dirTime) $ do bringTarball namever rpmbuild Prep True Nothing specFile- cabal <- findPackageDesc' namever+ cabal <- tryFindPackageDesc namever return (cabal, Nothing) else do tmpdir <- mktempdir bringTarball namever rpmbuild Prep True (Just tmpdir) specFile- cabal <- findPackageDesc' $ tmpdir </> namever+ cabal <- tryFindPackageDesc $ tmpdir </> namever return (cabal, Just tmpdir) bringTarball :: FilePath -> IO ()@@ -217,14 +225,14 @@ isdir <- doesDirectoryExist pkgver if isdir then do- pth <- findPackageDesc' pkgver+ pth <- tryFindPackageDesc pkgver return (pth, Nothing) else do cwd <- getCurrentDirectory tmpdir <- mktempdir setCurrentDirectory tmpdir cmd_ "cabal" ["unpack", "-v0", pkgver]- pth <- findPackageDesc' pkgver+ pth <- tryFindPackageDesc pkgver setCurrentDirectory cwd return (tmpdir </> pth, Just tmpdir) @@ -257,13 +265,11 @@ haveStackage <- optionalProgram "stackage" if haveStackage then do- let stream = "nightly"- out <- cmd "stackage" ["list", stream, pkg]- if null out- then return Nothing- else do- putStrLn $ out +-+ "in Stackage" +-+ stream- return $ Just out+ let stream = "lts"+ mpkg <- cmdMaybe "stackage" ["list", stream, pkg]+ when (isJust mpkg) $+ putStrLn $ fromJust mpkg +-+ "in Stackage" +-+ stream+ return mpkg else return Nothing packageName :: PackageIdentifier -> String@@ -400,3 +406,64 @@ (cabal, mtmp) <- tryUnpack pkgmver pkgDesc <- simplePackageDescription cabal flags return $ PackageData Nothing cabal pkgDesc mtmp++patchSpec :: Maybe FilePath -> FilePath -> FilePath -> IO ()+patchSpec mdir oldspec newspec = do+ diff <- cmdIgnoreErr "diff" ["-u2", "-I", "- spec file generated by cabal-rpm", "-I", "Fedora Haskell SIG <haskell@lists.fedoraproject.org>", oldspec, newspec] "" >>= cmdIgnoreErr "sed" ["-e", "s/.cblrpm//"]+ putStrLn diff+ out <- cmdIgnoreErr "patch" opts diff+ putStrLn out+ where+ opts = maybe [] (\ d -> ["-d", d, "-p1" ]) mdir++packageManager :: IO String+packageManager = do+ havednf <- optionalProgram "dnf"+ if havednf+ then return "dnf"+ else requireProgram "yum" >> return "yum"++repoquery :: [String] -> String -> IO String+repoquery args key = do+ havednf <- optionalProgram "dnf"+ let (prog, subcmd) = if havednf then ("dnf", ["repoquery", "-q"]) else ("repoquery", [])+ cmd prog (subcmd ++ args ++ [key])++pkgInstall :: [String] -> Bool -> IO ()+pkgInstall [] _ = return ()+pkgInstall pkgs hard = do+ pkginstaller <- packageManager+ putStrLn $ "Running repoquery" +-+ unwords pkgs+ repopkgs <- filter (/= "") <$> mapM (repoquery ["--qf", "%{name}"]) pkgs+ let missing = pkgs \\ repopkgs+ if notNull missing && hard+ then error $ unwords missing +-+ "not available."+ else do+ unless (null missing) $ do+ putStrLn "Unavailable dependencies:"+ mapM_ putStrLn missing+ unless (null repopkgs) $ do+ putStrLn "Uninstalled dependencies:"+ mapM_ putStrLn repopkgs+ uid <- getEffectiveUserID+ maybeSudo <-+ if uid == 0+ then return Nothing+ else do+ havesudo <- optionalProgram "sudo"+ return $ if havesudo then Just "sudo" else Nothing+ let args = map showPkg repopkgs+ putStrLn $ "Running:" +-+ fromMaybe "" maybeSudo +-+ pkginstaller +-+ "install" +-+ unwords args+ let exec = if hard then cmd_ else trySystem+ fedora <- cmd "rpm" ["--eval", "%fedora"]+ let nogpgcheck = ["--nogpgcheck" | fedora `elem` ["22", "23"]]+ exec (fromMaybe pkginstaller maybeSudo) $ maybe [] (const pkginstaller) maybeSudo : "install" : args ++ nogpgcheck+ where+ showPkg :: String -> String+ showPkg p = if '(' `elem` p then show p else p++rpmInstall :: [String] -> IO ()+rpmInstall rpms = do+ pkginstaller <- packageManager+ let (inst, arg) = if pkginstaller == "dnf" then ("dnf", "install") else ("yum", "localinstall")+ sudo inst $ ["-y", arg] ++ rpms
src/SysCmd.hs view
@@ -19,12 +19,13 @@ cmd_, cmdBool, cmdIgnoreErr,+ cmdMaybe, cmdQuiet, cmdSilent,+ grep_,+ notNull, optionalProgram,- pkgInstall,- repoquery,- rpmInstall,+ requireProgram, trySystem, shell, sudo,@@ -34,9 +35,8 @@ #else import Control.Applicative ((<$>)) #endif-import Control.Monad (unless, void, when)-import Data.List ((\\))-import Data.Maybe (fromMaybe, isJust, isNothing)+import Control.Monad (void, when)+import Data.Maybe (isJust, isNothing) #if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,18,0) import Distribution.Simple.Program.Find (defaultProgramSearchPath,@@ -47,8 +47,7 @@ #endif import Distribution.Verbosity (normal) -import System.Posix.User (getEffectiveUserID)-import System.Process (readProcess, readProcessWithExitCode, system, rawSystem)+import System.Process (readProcess, readProcessWithExitCode, rawSystem) import System.Exit (ExitCode(..)) findProgram :: FilePath -> IO (Maybe FilePath)@@ -104,21 +103,21 @@ shell c = cmd_ "sh" ["-c", c] sudo :: String -> [String] -> IO ()-sudo c as = do+sudo c args = do requireProgram "sudo" requireProgram c- putStrLn $ "sudo" +-+ c +-+ unwords as- cmd_ "sudo" (c:as)+ 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 -> IO Bool-cmdBool c = do- requireProgram $ head $ words c- ret <- system $ c +-+ ">/dev/null"+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@@ -133,6 +132,21 @@ (_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]+ removeTrailingNewline :: String -> String removeTrailingNewline "" = "" removeTrailingNewline str =@@ -144,56 +158,13 @@ (+-+) :: String -> String -> String "" +-+ s = s s +-+ "" = s+s +-+ t | last s == ' ' = s ++ t+ | head t == ' ' = s ++ t s +-+ t = s ++ " " ++ t -packageManager :: IO String-packageManager = do- havednf <- optionalProgram "dnf"- if havednf- then return "dnf"- else requireProgram "yum" >> return "yum"--repoquery :: [String] -> String -> IO String-repoquery args key = do- havednf <- optionalProgram "dnf"- let (prog, subcmd) = if havednf then ("dnf", ["repoquery", "-q"]) else ("repoquery", [])- cmd prog (subcmd ++ args ++ [key])--pkgInstall :: [String] -> Bool -> IO ()-pkgInstall [] _ = return ()-pkgInstall pkgs hard = do- pkginstaller <- packageManager- putStrLn $ "Running repoquery" +-+ unwords pkgs- repopkgs <- filter (/= "") <$> mapM (repoquery ["--qf", "%{name}"]) pkgs- let missing = pkgs \\ repopkgs- if not (null missing) && hard- then error $ unwords missing +-+ "not available."- else do- unless (null missing) $ do- putStrLn "Unavailable dependencies:"- mapM_ putStrLn missing- unless (null repopkgs) $ do- putStrLn "Uninstalled dependencies:"- mapM_ putStrLn repopkgs- uid <- getEffectiveUserID- maybeSudo <-- if uid == 0- then return Nothing- else do- havesudo <- optionalProgram "sudo"- return $ if havesudo then Just "sudo" else Nothing- let args = map showPkg repopkgs- putStrLn $ "Running:" +-+ fromMaybe "" maybeSudo +-+ pkginstaller +-+ "install" +-+ unwords args- let exec = if hard then cmd_ else trySystem- fedora <- cmd "rpm" ["--eval", "%fedora"]- let nogpgcheck = ["--nogpgcheck" | fedora `elem` ["22", "23"]]- exec (fromMaybe pkginstaller maybeSudo) $ maybe [] (const pkginstaller) maybeSudo : "install" : args ++ nogpgcheck--showPkg :: String -> String-showPkg p = if '(' `elem` p then show p else p--rpmInstall :: [String] -> IO ()-rpmInstall rpms = do- pkginstaller <- packageManager- let (inst, arg) = if pkginstaller == "dnf" then ("dnf", "install") else ("yum", "localinstall")- sudo inst $ ["-y", arg] ++ rpms+#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2))+notNull :: Foldable t => t a -> Bool+#else+notNull :: [a] -> Bool+#endif+notNull = not . null