cabal-rpm 0.8.11 → 0.9
raw patch · 13 files changed
+843/−595 lines, 13 filesdep ~Cabal
Dependency ranges changed: Cabal
Files
- ChangeLog +21/−0
- cabal-rpm.cabal +4/−4
- src/Commands/Depends.hs +20/−22
- src/Commands/Diff.hs +8/−15
- src/Commands/Install.hs +34/−13
- src/Commands/RpmBuild.hs +41/−87
- src/Commands/Spec.hs +315/−240
- src/Dependencies.hs +41/−12
- src/FileUtils.hs +8/−5
- src/Main.hs +27/−41
- src/PackageUtils.hs +194/−61
- src/Setup.hs +45/−50
- src/SysCmd.hs +85/−45
ChangeLog view
@@ -1,3 +1,19 @@+* 0.9 (2014-07-17)+- reworked initial logic to make better use of existing spec files,+ and prep source tree properly+- default to Library packaging instead of BinLib:+ override with --binary which replaces --library+- prep src for version in existing spec file when building+- 'install' command now does local recursive rpmbuilding+- try "rpm -qf" and then rpmquery to resolve clib devel depends+- support SUSE packaging (thanks Jan Matějka)+- support RHEL5 packaging+- support Cabal-1.20+- improve output for 'depends' command+- no duplicate clibs deps+- include "cblrpm" in tempdir names+- use current dir name as a last guess of package name+ * 0.8.11 (2014-05-17) - build command renamed again from "rpm" to "local" (like fedpkg) - use .spec file to determine pkg-ver when no .cabal file around@@ -157,3 +173,8 @@ * 0.5.1 and earlier (2007-2008) released by Bryan O'Sullivan - should work with ghc-6.8+++# Local Variables:+# mode: text+# End:
cabal-rpm.cabal view
@@ -1,5 +1,5 @@ Name: cabal-rpm-Version: 0.8.11+Version: 0.9 Synopsis: RPM packaging tool for Haskell Cabal-based packages Description: This package generates RPM packages from Haskell Cabal packages.@@ -14,7 +14,7 @@ . * cblrpm builddep: yum install depends .- * cblrpm install: yum install depends and then cabal install+ * cblrpm install: yum install or rpmbuild depends and package . * cblrpm depends: list hackage dependencies .@@ -27,7 +27,7 @@ Bug-reports: https://github.com/juhp/cabal-rpm/issues License: GPL-3 License-file: COPYING-Author: Bryan O'Sullivan <bos@serpentine.com>, Jens Petersen <juhp@community.haskell.org>+Author: Jens Petersen <juhp@community.haskell.org>, Bryan O'Sullivan <bos@serpentine.com> Maintainer: Jens Petersen <petersen@fedoraproject.org> Copyright: 2007-2008 Bryan O'Sullivan <bos@serpentine.com>, 2012-2014 Jens Petersen <petersen@fedoraproject.org>@@ -43,7 +43,7 @@ Executable cblrpm Main-is: Main.hs Build-depends: base < 5,- Cabal > 1.10 && < 1.19,+ Cabal > 1.10 && < 1.21, directory, filepath, old-locale,
src/Commands/Depends.hs view
@@ -14,33 +14,31 @@ module Commands.Depends ( depends,- missingDeps,- requires+ Depends (..) ) where import Dependencies (dependencies, packageDependencies )-import PackageUtils (missingPackages, packageName)+import PackageUtils (missingPackages, PackageData (..), packageName) import Data.List (sort) import Distribution.PackageDescription (PackageDescription (..)) -depends :: PackageDescription -> IO ()-depends pkgDesc = do- let pkg = package pkgDesc- name = packageName pkg- (deps, tools, clibs, pkgcfgs, _) <- dependencies pkgDesc name- mapM_ putStrLn $ deps ++ tools ++ clibs ++ pkgcfgs--requires :: PackageDescription -> IO ()-requires pkgDesc = do- let pkg = package pkgDesc- name = packageName pkg- (deps, tools, clibs, pkgcfgs, _) <- packageDependencies pkgDesc name- mapM_ putStrLn $ sort $ deps ++ tools ++ clibs ++ pkgcfgs+data Depends = Depends | Requires | Missing -missingDeps :: PackageDescription -> IO ()-missingDeps pkgDesc = do- let pkg = package pkgDesc- name = packageName pkg- missing <- missingPackages pkgDesc name- mapM_ putStrLn missing+depends :: PackageData -> Depends -> IO ()+depends pkgdata action = do+ let pkgDesc = packageDesc pkgdata+ pkg = package pkgDesc+ name = packageName pkg+ case action of+ Depends -> do+ (deps, tools, clibs, pkgcfgs, _) <- dependencies pkgDesc name+ let clibs' = map (\ lib -> "lib" ++ lib ++ ".so") clibs+ let pkgcfgs' = map (++ ".pc") pkgcfgs+ mapM_ putStrLn $ deps ++ tools ++ clibs' ++ pkgcfgs'+ Requires -> do+ (deps, tools, clibs, pkgcfgs, _) <- packageDependencies pkgDesc name+ mapM_ putStrLn $ sort $ deps ++ tools ++ clibs ++ pkgcfgs+ Missing -> do+ missing <- missingPackages pkgDesc name+ mapM_ putStrLn missing
src/Commands/Diff.hs view
@@ -18,28 +18,21 @@ ) where import Commands.Spec (createSpecFile)-import FileUtils (fileWithExtension, mktempdir)+import FileUtils (mktempdir)+import PackageUtils (PackageData (..)) import Setup (RpmFlags (..))-import SysCmd ((+-+), trySystem)+import SysCmd ((+-+), shell) -import Control.Applicative ((<$>))-import Data.Maybe (fromJust)-import Distribution.PackageDescription (PackageDescription (..)) import Distribution.Simple.Utils (die) import System.Directory (removeDirectoryRecursive) -diff :: FilePath -- ^cabal path- -> PackageDescription -- ^pkg description- -> RpmFlags -- ^rpm flags- -> IO ()-diff cabalPath pkgDesc flags = do- mspcfile <- fileWithExtension "." ".spec"- case mspcfile of+diff :: PackageData -> RpmFlags -> IO ()+diff pkgFiles flags =+ case specFilename pkgFiles of Nothing -> die "No (unique) .spec file in directory." Just spec -> do tmpdir <- mktempdir- createSpecFile cabalPath pkgDesc flags (Just tmpdir)- speccblrpm <- fromJust <$> fileWithExtension tmpdir ".spec"- trySystem $ "diff" +-+ "-u" +-+ spec +-+ speccblrpm +-+ "| sed -e s%" ++ speccblrpm ++ "%" ++ spec ++ ".cblrpm" ++ "%"+ speccblrpm <- createSpecFile pkgFiles flags (Just tmpdir)+ shell $ "diff" +-+ "-u" +-+ spec +-+ speccblrpm +-+ "| sed -e s%" ++ speccblrpm ++ "%" ++ spec ++ ".cblrpm" ++ "%" removeDirectoryRecursive tmpdir
src/Commands/Install.hs view
@@ -17,19 +17,40 @@ install ) where -import PackageUtils (missingPackages, packageName)-import SysCmd (runSystem, yumInstall)+import Commands.RpmBuild (rpmBuild)+import PackageUtils (missingPackages, notInstalled, PackageData (..),+ packageName, removePrefix, removeSuffix, RpmStage (..))+import Setup (RpmFlags (..))+import SysCmd (cmd, cmd_, sudo, yumInstall, (+-+)) +import Control.Applicative ((<$>))+import Control.Monad (when) import Distribution.PackageDescription (PackageDescription (..))-import System.Directory (setCurrentDirectory)-import System.FilePath (takeDirectory)+--import System.Directory (getCurrentDirectory, setCurrentDirectory)+--import System.FilePath (takeDirectory)+import System.FilePath ((</>)) -install :: FilePath -> PackageDescription -> IO ()-install cabalPath pkgDesc = do- let pkg = package pkgDesc- name = packageName pkg- missing <- missingPackages pkgDesc name- yumInstall missing False- let pkgDir = takeDirectory cabalPath- setCurrentDirectory pkgDir- runSystem "cabal install"+install :: PackageData -> RpmFlags -> IO ()+install pkgdata flags = do+ let pkgDesc = packageDesc pkgdata+ pkg = package pkgDesc+ name = packageName pkg+ missing <- missingPackages pkgDesc name+ yumInstall missing False+ stillMissing <- missingPackages pkgDesc name+ putStrLn $ "Missing:" +-+ unwords stillMissing+ mapM_ installMissing stillMissing+-- let pkgDir = takeDirectory cabalPath+ spec <- rpmBuild pkgdata flags Binary+ arch <- cmd "arch" []+ rpms <- (map (\ p -> arch </> p ++ ".rpm") . lines) <$>+ cmd "rpmspec" ["-q", spec]+ sudo "yum" $ ["-y", "localinstall"] ++ rpms++installMissing :: String -> IO ()+installMissing pkg = do+ noInstall <- notInstalled pkg+ when noInstall $ do+ let dep = removeSuffix "-devel" $ removePrefix "ghc-" pkg+ putStrLn $ "Running cblrpm install" +-+ dep+ cmd_ "cblrpm" ["install", dep]
src/Commands/RpmBuild.hs view
@@ -16,27 +16,25 @@ -- (at your option) any later version. module Commands.RpmBuild (- rpmBuild, RpmStage (..)+ rpmBuild, rpmBuild_ ) where import Commands.Spec (createSpecFile)-import FileUtils (fileWithExtension, getDirectoryContents_)-import PackageUtils (isScmDir, missingPackages, packageName, packageVersion)+import PackageUtils (copyTarball, isScmDir, missingPackages,+ PackageData (..), packageName, packageVersion, rpmbuild,+ RpmStage (..)) import Setup (RpmFlags (..))-import SysCmd (runSystem, yumInstall, (+-+))+import SysCmd (yumInstall, (+-+)) --import Control.Exception (bracket)-import Control.Monad (filterM, unless, when)+import Control.Monad (unless, void, when) -import Distribution.PackageDescription (PackageDescription (..),- hasExes)+import Distribution.PackageDescription (PackageDescription (..)) --import Distribution.Version (VersionRange, foldVersionRange') -import System.Directory (copyFile, doesFileExist, getCurrentDirectory)-import System.Environment (getEnv)-import System.FilePath (takeDirectory, (</>))-import System.Posix.Files (setFileMode, getFileStatus, fileMode)+import System.Directory (doesFileExist)+import System.FilePath (takeDirectory) -- autoreconf :: Verbosity -> PackageDescription -> IO () -- autoreconf verbose pkgDesc = do@@ -45,84 +43,40 @@ -- c <- doesFileExist "configure" -- when (not c) $ do -- setupMessage verbose "Running autoreconf" pkgDesc--- runSystem "autoreconf"--data RpmStage = Binary | Source | Prep | BuildDep deriving Eq+-- cmd_ "autoreconf" [] -rpmBuild :: FilePath -> PackageDescription -> RpmFlags -> RpmStage -> IO ()-rpmBuild cabalPath pkgDesc flags stage = do--- let verbose = rpmVerbosity flags--- bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> do--- autoreconf verbose pkgDesc- mspcfile <- fileWithExtension "." ".spec"- specFile <- case mspcfile of- Just s -> return s- Nothing -> specFileName pkgDesc flags- specFileExists <- doesFileExist specFile- if specFileExists- then putStrLn $ "Using existing" +-+ specFile- else createSpecFile cabalPath pkgDesc flags Nothing- let pkg = package pkgDesc- name = packageName pkg- when (stage `elem` [Binary,BuildDep]) $ do- missing <- missingPackages pkgDesc name- yumInstall missing True+rpmBuild :: PackageData -> RpmFlags -> RpmStage ->+ IO FilePath+rpmBuild pkgdata flags stage = do+-- let verbose = rpmVerbosity flags+-- bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> do+-- autoreconf verbose pkgDesc+ let pkgDesc = packageDesc pkgdata+ mspec = specFilename pkgdata+ cabalPath = cabalFilename pkgdata+ specFile <- maybe (createSpecFile pkgdata flags Nothing)+ (\ s -> putStrLn ("Using existing" +-+ s) >> return s)+ mspec+ let pkg = package pkgDesc+ name = packageName pkg+ when (stage `elem` [Binary,BuildDep]) $ do+ missing <- missingPackages pkgDesc name+ yumInstall missing True - unless (stage == BuildDep) $ do- let version = packageVersion pkg- tarFile = name ++ "-" ++ version ++ ".tar.gz"- rpmCmd = case stage of- Binary -> "a"- Source -> "s"- Prep -> "p"- BuildDep -> "_"+ unless (stage == BuildDep) $ do+ let version = packageVersion pkg+ tarFile = name ++ "-" ++ version ++ ".tar.gz" - tarFileExists <- doesFileExist tarFile- unless tarFileExists $ do- scmRepo <- isScmDir $ takeDirectory cabalPath- when scmRepo $- error "No tarball for source repo"+ tarFileExists <- doesFileExist tarFile+ unless tarFileExists $ do+ scmRepo <- isScmDir $ takeDirectory cabalPath+ when scmRepo $+ error "No tarball for source repo" - cwd <- getCurrentDirectory- copyTarball name version False- runSystem ("rpmbuild -b" ++ rpmCmd +-+- (if stage == Prep then "--nodeps" else "") +-+- "--define \"_rpmdir" +-+ cwd ++ "\"" +-+- "--define \"_srcrpmdir" +-+ cwd ++ "\"" +-+- "--define \"_sourcedir" +-+ cwd ++ "\"" +-+- specFile)- where- copyTarball :: String -> String -> Bool -> IO ()- copyTarball n v ranFetch = do- let tarfile = n ++ "-" ++ v ++ ".tar.gz"- already <- doesFileExist tarfile- unless already $ do- home <- getEnv "HOME"- let cacheparent = home </> ".cabal" </> "packages"- tarpath = n </> v </> tarfile- remotes <- getDirectoryContents_ cacheparent- let paths = map (\ repo -> cacheparent </> repo </> tarpath) remotes- -- if more than one tarball, should maybe warn if they are different- tarballs <- filterM doesFileExist paths- if null tarballs- then if ranFetch- then error $ "No" +-+ tarfile +-+ "found"- else do- runSystem ("cabal fetch -v0 --no-dependencies" +-+ n ++ "-" ++ v)- copyTarball n v True- else do- copyFile (head tarballs) tarfile- -- cabal fetch creates tarballs with mode 0600- stat <- getFileStatus tarfile- when (fileMode stat /= 0o100644) $- setFileMode tarfile 0o0644+ copyTarball name version False+ rpmbuild stage False Nothing specFile+ return specFile -specFileName :: PackageDescription -- ^pkg description- -> RpmFlags -- ^rpm flags- -> IO FilePath-specFileName pkgDesc flags = do- let pkg = package pkgDesc- name = packageName pkg- pkgname = if isExec then name else "ghc-" ++ name- isExec = not (rpmLibrary flags) && hasExes pkgDesc- return $ pkgname ++ ".spec"+rpmBuild_ :: PackageData -> RpmFlags -> RpmStage -> IO ()+rpmBuild_ pkgdata flags stage =+ void (rpmBuild pkgdata flags stage)
src/Commands/Spec.hs view
@@ -17,17 +17,16 @@ -- (at your option) any later version. module Commands.Spec (- createSpecFile+ createSpecFile, createSpecFile_ ) where import Dependencies (packageDependencies, showDep, testsuiteDependencies)-import FileUtils (fileWithExtension)-import PackageUtils (isScmDir, notInstalled, packageName, packageVersion)+import PackageUtils (getPkgName, isScmDir, notInstalled, PackageData (..),+ packageName, packageVersion) import Setup (RpmFlags (..)) import SysCmd ((+-+)) ---import Control.Exception (bracket)-import Control.Monad (filterM, when, unless)+import Control.Monad (filterM, unless, void, when) import Data.Char (toLower, toUpper) import Data.List (groupBy, isPrefixOf, isSuffixOf, sort, (\\)) import Data.Maybe (fromMaybe, maybeToList)@@ -48,18 +47,18 @@ import System.Directory (doesFileExist, getDirectoryContents) import System.IO (IOMode (..), hClose, hPutStrLn, openFile) import System.Locale (defaultTimeLocale)-import System.FilePath (dropFileName, takeBaseName, takeDirectory, (</>))+import System.FilePath (dropFileName, takeDirectory, (</>)) import qualified Paths_cabal_rpm (version) defaultRelease :: FilePath -> UTCTime -> IO String defaultRelease cabalPath now = do- let pkgDir = takeDirectory cabalPath- scmRepo <- isScmDir pkgDir- return $ if scmRepo- then formatTime defaultTimeLocale "0.%Y%m%d" now- else "1"+ let pkgDir = takeDirectory cabalPath+ scmRepo <- isScmDir pkgDir+ return $ if scmRepo+ then formatTime defaultTimeLocale "0.%Y%m%d" now+ else "1" rstrip :: (Char -> Bool) -> String -> String rstrip p = reverse . dropWhile p . reverse@@ -71,265 +70,327 @@ -- packageVersion :: PackageIdentifier -> String -- packageVersion pkg = (showVersion . pkgVersion) pkg -createSpecFile :: FilePath -- ^pkg cabal file- -> PackageDescription -- ^pkg description- -> RpmFlags -- ^rpm flags- -> Maybe FilePath -- ^optional destdir- -> IO ()-createSpecFile cabalPath pkgDesc flags mdest = do- let verbose = rpmVerbosity flags- now <- getCurrentTime- defRelease <- defaultRelease cabalPath now- mspcfile <- if rpmForce flags then return Nothing- else fileWithExtension "." ".spec"- let mpkgname = fmap takeBaseName mspcfile- pkg = package pkgDesc- name = packageName pkg- pkgname = fromMaybe (if hasExec then name else "ghc-" ++ name) mpkgname- pkg_name = if pkgname == name then "%{name}" else "%{pkg_name}"- basename | isBinLib = "%{pkg_name}"- | hasExecPkg = name- | otherwise = "ghc-%{pkg_name}"- version = packageVersion pkg- release = fromMaybe defRelease (rpmRelease flags)- specFile = fromMaybe "" mdest </> pkgname ++ ".spec"- hasExec = hasExes pkgDesc- hasLib = hasLibs pkgDesc- isBinLib = hasLib && not (rpmLibrary flags) && pkgname == name- hasExecPkg = not (rpmLibrary flags) && (isBinLib || hasExes pkgDesc && not hasLib)- specAlreadyExists <- doesFileExist specFile- let specFilename = specFile ++ if not (rpmForce flags) && specAlreadyExists then ".cblrpm" else ""- when specAlreadyExists $- notice verbose $ specFile +-+ "exists:" +-+ if rpmForce flags then "forcing overwrite" else "creating" +-+ specFilename- h <- openFile specFilename WriteMode- let putHdr hdr val = hPutStrLn h (hdr ++ ":" ++ padding hdr ++ val)- padding hdr = replicate (14 - length hdr) ' ' ++ " "- putNewline = hPutStrLn h ""- put = hPutStrLn h- putDef v s = put $ "%global" +-+ v +-+ s- ghcPkg = if isBinLib then "-n ghc-%{name}" else ""- ghcPkgDevel = if isBinLib then "-n ghc-%{name}-devel" else "devel"-- put "# https://fedoraproject.org/wiki/Packaging:Haskell"- putNewline+createSpecFile :: PackageData -> RpmFlags ->+ Maybe FilePath -> IO FilePath+createSpecFile pkgdata flags mdest = do+ let mspec = specFilename pkgdata+ cabalPath = cabalFilename pkgdata+ pkgDesc = packageDesc pkgdata+ pkg = package pkgDesc+ name = packageName pkg+ verbose = rpmVerbosity flags+ hasExec = hasExes pkgDesc+ hasLib = hasLibs pkgDesc+ now <- getCurrentTime+ defRelease <- defaultRelease cabalPath now+ (pkgname, binlib) <- getPkgName mspec pkgDesc (rpmBinary flags)+ putStrLn pkgname+ let pkg_name = if pkgname == name then "%{name}" else "%{pkg_name}"+ basename | binlib = "%{pkg_name}"+ | hasExecPkg = name+ | otherwise = "ghc-%{pkg_name}"+ version = packageVersion pkg+ release = fromMaybe defRelease (rpmRelease flags)+ specFile = fromMaybe "" mdest </> pkgname ++ ".spec"+ 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 pkgDesc name+ let testsuiteDeps = testsuiteDependencies pkgDesc name+ missTestDeps <- filterM notInstalled testsuiteDeps - -- Some packages conflate the synopsis and description fields. Ugh.- let syn = synopsis pkgDesc- when (null syn) $- warn verbose "this package has no synopsis."- let initialCapital (c:cs) = toUpper c:cs- initialCapital [] = []- let syn' = if null syn- then "Haskell" +-+ name +-+ "package"- else (unwords . lines . initialCapital) syn- let summary = rstrip (== '.') syn'- when (length ("Summary : " ++ syn') > 79) $- warn verbose "this package has a long synopsis."+ specAlreadyExists <- doesFileExist specFile+ let specFile' = specFile ++ if not (rpmForce flags) && specAlreadyExists then ".cblrpm" else ""+ when specAlreadyExists $+ notice verbose $ specFile +-+ "exists:" +-+ if rpmForce flags then "forcing overwrite" else "creating" +-+ specFile'+ h <- openFile specFile' WriteMode+ let putHdr hdr val = hPutStrLn h (hdr ++ ":" ++ padding hdr ++ val)+ padding hdr = replicate (14 - length hdr) ' ' ++ " "+ putNewline = hPutStrLn h ""+ 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" - let descr = description pkgDesc- when (null descr) $- warn verbose "this package has no description."- let descLines = (formatParagraphs . initialCapital . filterSymbols . finalPeriod) $- if null descr then syn' else descr- finalPeriod cs = if last cs == '.' then cs else cs ++ "."- filterSymbols (c:cs) =- if c `notElem` "@\\" then c: filterSymbols cs- else case c of- '@' -> '\'': filterSymbols cs- '\\' -> head cs: filterSymbols (tail cs)- _ -> c: filterSymbols cs- filterSymbols [] = []- when hasLib $ do- putDef "pkg_name" name- putNewline+ distro <- detectDistro+ if distro /= SUSE+ then put "# https://fedoraproject.org/wiki/Packaging:Haskell"+ else do+ let year = formatTime defaultTimeLocale "%Y" now+ put "#"+ put $ "# spec file for package " ++ pkgname+ put "#"+ put $ "# Copyright (c) " ++ year ++ " SUSE LINUX Products GmbH, Nuernberg, Germany."+ put "#"+ put "# All modifications and additions to the file contributed by third parties"+ put "# remain the property of their copyright owners, unless otherwise agreed"+ put "# upon. The license for this file, and modifications and additions to the"+ put "# file, is the same license as for the pristine package itself (unless the"+ put "# license for the pristine package is not an Open Source License, in which"+ put "# case the license is the MIT License). An \"Open Source License\" is a"+ put "# license that conforms to the Open Source Definition (Version 1.9)"+ put "# published by the Open Source Initiative."+ putNewline+ put "# Please submit bugfixes or comments via http://bugs.opensuse.org/"+ put "#"+ putNewline - let testsuiteDeps = testsuiteDependencies pkgDesc name- missTestDeps <- filterM notInstalled testsuiteDeps- unless (null testsuiteDeps) $ do- put $ "%bcond_" ++ (if null missTestDeps then "without" else "with") +-+ "tests"- putNewline+ -- Some packages conflate the synopsis and description fields. Ugh.+ let syn = synopsis pkgDesc+ when (null syn) $+ warn verbose "this package has no synopsis."+ let initialCapital (c:cs) = toUpper c:cs+ initialCapital [] = []+ let syn' = if null syn+ then "Haskell" +-+ name +-+ "package"+ else (unwords . lines . initialCapital) syn+ let summary = rstrip (== '.') syn'+ when (length ("Summary : " ++ syn') > 79) $+ warn verbose "this package has a long synopsis." - let eCsources = concatMap (cSources . buildInfo) $ executables pkgDesc- 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}"- putNewline+ let descr = description pkgDesc+ when (null descr) $+ warn verbose "this package has no description."+ let descLines = (formatParagraphs . initialCapital . filterSymbols . finalPeriod) $ if null descr then syn' else descr+ finalPeriod cs = if last cs == '.' then cs else cs ++ "."+ filterSymbols (c:cs) =+ if c `notElem` "@\\" then c: filterSymbols cs+ else case c of+ '@' -> '\'': filterSymbols cs+ '\\' -> head cs: filterSymbols (tail cs)+ _ -> c: filterSymbols cs+ filterSymbols [] = []+ when hasLib $ do+ putDef "pkg_name" name+ putNewline - putHdr "Name" (if isBinLib then "%{pkg_name}" else basename)- putHdr "Version" version- putHdr "Release" $ release ++ "%{?dist}"- putHdr "Summary" summary+ unless (null testsuiteDeps) $ do+ put $ "%bcond_" ++ (if null missTestDeps then "without" else "with") +-+ "tests" putNewline- putHdr "License" $ (showLicense . license) pkgDesc- putHdr "URL" $ "http://hackage.haskell.org/package/" ++ pkg_name- putHdr "Source0" $ "http://hackage.haskell.org/package/" ++ pkg_name ++ "-%{version}/" ++ pkg_name ++ "-%{version}.tar.gz"++ let eCsources = concatMap (cSources . buildInfo) $ executables pkgDesc+ 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}" putNewline- putHdr "BuildRequires" "ghc-Cabal-devel"- putHdr "BuildRequires" "ghc-rpm-macros" - (deps, tools, clibs, pkgcfgs, selfdep) <- packageDependencies pkgDesc name- 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- when (any (\ d -> d `elem` map showDep ["template-haskell", "hamlet"]) deps) $- putHdr "ExclusiveArch" "%{ghc_arches_with_ghci}"- unless (null extraTestDeps) $ do- put "%if %{with tests}"- mapM_ (putHdr "BuildRequires") extraTestDeps- put "%endif"- put "# End cabal-rpm deps"+ putHdr "Name" (if binlib then "%{pkg_name}" else basename)+ putHdr "Version" version+ putHdr "Release" $ release ++ (if distro == SUSE then [] else "%{?dist}")+ putHdr "Summary" summary+ case distro of+ SUSE -> putHdr "Group" (if binlib then "Development/Languages/Other"+ else "System/Libraries")+ RHEL5 -> putHdr "Group" (if binlib then "Development/Languages"+ else "System Environment/Libraries")+ _ -> return ()+ putNewline+ putHdr "License" $ (showLicense distro . license) pkgDesc+ putHdr "Url" $ "http://hackage.haskell.org/package/" ++ pkg_name+ putHdr "Source0" $ "http://hackage.haskell.org/package/" ++ pkg_name ++ "-%{version}/" ++ pkg_name ++ "-%{version}.tar.gz"+ case distro of+ Fedora -> return ()+ _ -> putHdr "BuildRoot" "%{_tmppath}/%{name}-%{version}-build"+ putNewline+ putHdr "BuildRequires" "ghc-Cabal-devel"+ putHdr "BuildRequires" "ghc-rpm-macros" - putNewline+ 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+ when (any (\ d -> d `elem` map showDep ["template-haskell", "hamlet"]) deps) $+ putHdr "ExclusiveArch" "%{ghc_arches_with_ghci}"+ unless (null extraTestDeps) $ do+ put "%if %{with tests}"+ mapM_ (putHdr "BuildRequires") extraTestDeps+ put "%endif"+ put "# End cabal-rpm deps" - put "%description"- mapM_ put descLines- putNewline+ putNewline - let wrapGenDesc = wordwrap (79 - max 0 (length pkgname - length pkg_name))+ put "%description"+ mapM_ put descLines+ putNewline - when hasLib $ do- when isBinLib $ do- put $ "%package" +-+ ghcPkg- putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library"- putNewline- put $ "%description" +-+ ghcPkg- put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "shared library."- putNewline- put $ "%package" +-+ ghcPkgDevel- putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library development files"- putHdr "Provides" $ (if isBinLib then "ghc-%{name}" else "%{name}") ++ "-static = %{version}-%{release}"- putHdr "Requires" "ghc-compiler = %{ghc_version}"- putHdr "Requires(post)" "ghc-compiler = %{ghc_version}"- putHdr "Requires(postun)" "ghc-compiler = %{ghc_version}"- putHdr "Requires" $ (if isBinLib 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- put "# End cabal-rpm deps"+ let wrapGenDesc = wordwrap (79 - max 0 (length pkgname - length pkg_name))++ when hasLib $ do+ when binlib $ do+ put $ "%package" +-+ ghcPkg+ putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library"+ case distro of+ Fedora -> return ()+ SUSE -> putHdr "Group" "System/Libraries"+ RHEL5 -> putHdr "Group" "System Environment/Libraries" putNewline- put $ "%description" +-+ ghcPkgDevel- put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "library development files."+ put $ "%description" +-+ ghcPkg+ put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "shared library." putNewline-- put "%prep"- put $ "%setup -q" ++ (if pkgname /= name then " -n %{pkg_name}-%{version}" else "")+ put $ "%package" +-+ ghcPkgDevel+ putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library development files"+ case distro of+ Fedora -> return ()+ RHEL5 -> putHdr "Group" "Development/Libraries"+ SUSE -> putHdr "Group" "Development/Libraries/Other"+ unless (distro == SUSE) $+ putHdr "Provides" $ (if binlib then "ghc-%{name}" else "%{name}") ++ "-static = %{version}-%{release}"+ 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}"+ unless (null $ clibs ++ pkgcfgs) $ do+ put "# Begin cabal-rpm deps:"+ mapM_ (putHdr "Requires") $ sort $ map (++ isa) clibs ++ pkgcfgs+ put "# End cabal-rpm deps" putNewline+ put $ "%description" +-+ ghcPkgDevel+ put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "library development files." putNewline - put "%build"- let pkgType = if hasLib then "lib" else "bin"- put $ "%ghc_" ++ pkgType ++ "_build"- putNewline+ put "%prep"+ put $ "%setup -q" ++ (if pkgname /= name then " -n %{pkg_name}-%{version}" else "")+ putNewline+ putNewline++ put "%build"+ let pkgType = if hasLib then "lib" else "bin"+ put $ "%ghc_" ++ pkgType ++ "_build"+ putNewline+ putNewline++ put "%install"+ put $ "%ghc_" ++ pkgType ++ "_install"+ when selfdep $ do putNewline+ put "%ghc_fix_dynamic_rpath %{name}"+ putNewline+ putNewline - put "%install"- put $ "%ghc_" ++ pkgType ++ "_install"- when selfdep $ do- putNewline- put "%ghc_fix_dynamic_rpath %{name}"+ unless (null testsuiteDeps) $ do+ put "%check"+ put "%if %{with tests}"+ put "%cabal test"+ put "%endif" putNewline putNewline - unless (null testsuiteDeps) $ do- put "%check"- put "%if %{with tests}"- put "%cabal test"- put "%endif"- putNewline- putNewline-- when hasLib $ do- let putInstallScript = do- put "%ghc_pkg_recache"- putNewline- putNewline- put $ "%post" +-+ ghcPkgDevel- putInstallScript- put $ "%postun" +-+ ghcPkgDevel- putInstallScript+ when hasLib $ do+ let putInstallScript = do+ put "%ghc_pkg_recache"+ putNewline+ putNewline+ put $ "%post" +-+ ghcPkgDevel+ putInstallScript+ put $ "%postun" +-+ ghcPkgDevel+ putInstallScript - docs <- findDocs cabalPath pkgDesc+ let licensefiles =+#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,20,0)+ licenseFiles pkgDesc+#else+ if null (licenseFile pkgDesc) then [] else [licenseFile pkgDesc]+#endif+ docs <- findDocs cabalPath licensefiles - when hasExecPkg $ do- put "%files"- -- Add the license file to the main package only if it wouldn't- -- otherwise be empty.- unless (null $ licenseFile pkgDesc) $- put $ "%doc" +-+ licenseFile pkgDesc- unless (null docs) $- put $ "%doc" +-+ unwords docs+ when hasExecPkg $ do+ put "%files"+ when (distro /= Fedora) $ put "%defattr(-,root,root,-)"+ -- Add the license file to the main package only if it wouldn't+ -- otherwise be empty.+ mapM_ (\ l -> put $ "%doc" +-+ l) licensefiles+ unless (null docs) $+ put $ "%doc" +-+ unwords docs - withExe pkgDesc $ \exe ->- let program = exeName exe in- put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program)- unless (null (dataFiles pkgDesc)) $- put "%{_datadir}/%{name}-%{version}"+ withExe pkgDesc $ \exe ->+ let program = exeName exe in+ put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program)+ unless (null (dataFiles pkgDesc)) $+ put "%{_datadir}/%{name}-%{version}" - putNewline- putNewline+ putNewline+ putNewline - when hasLib $ do- let baseFiles = if isBinLib then "-f ghc-%{name}.files" else "-f %{name}.files"- develFiles = if isBinLib then "-f ghc-%{name}-devel.files" else "-f %{name}-devel.files"- put $ "%files" +-+ ghcPkg +-+ baseFiles- put $ "%doc" +-+ licenseFile pkgDesc- -- be strict for now--- unless (null (dataFiles pkgDesc) || isBinLib) $+ 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 $ "%doc" +-+ l) licensefiles+ -- be strict for now+-- unless (null (dataFiles pkgDesc) || binlib) $ -- put "%{_datadir}/%{pkg_name}-%{version}"- putNewline- putNewline- put $ "%files" +-+ ghcPkgDevel +-+ develFiles- unless (null docs) $- put $ "%doc" +-+ unwords docs- when (not isBinLib && hasExec) $- withExe pkgDesc $ \exe ->- let program = exeName exe in- put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program)- putNewline- putNewline+ putNewline+ putNewline+ put $ "%files" +-+ ghcPkgDevel +-+ develFiles+ when (distro /= Fedora) $ put "%defattr(-,root,root,-)"+ unless (null docs) $+ put $ "%doc" +-+ unwords docs+ when (not binlib && hasExec) $+ withExe pkgDesc $ \exe ->+ let program = exeName exe in+ put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program)+ putNewline+ putNewline + put "%changelog"+ unless (distro == SUSE) $ do let date = formatTime defaultTimeLocale "%a %b %e %Y" now- put "%changelog" put $ "*" +-+ date +-+ "Fedora Haskell SIG <haskell@lists.fedoraproject.org> - " ++ version ++ "-" ++ release put $ "- spec file generated by cabal-rpm-" ++ showVersion Paths_cabal_rpm.version- hClose h+ hClose h+ return specFile' -findDocs :: FilePath -> PackageDescription -> IO [FilePath]-findDocs cabalPath pkgDesc = do- contents <- getDirectoryContents $ dropFileName cabalPath- let docs = filter likely contents- return $ if null lf- then docs- else filter unlikely $ filter (/= lf) docs+createSpecFile_ :: PackageData -> RpmFlags ->+ Maybe FilePath -> IO ()+createSpecFile_ pkgFiles flags mdest =+ void (createSpecFile pkgFiles flags mdest)++findDocs :: FilePath -> [FilePath] -> IO [FilePath]+findDocs cabalPath licensefiles = do+ contents <- getDirectoryContents $ dropFileName cabalPath+ let docs = filter likely contents+ return $ if null licensefiles+ then docs+ else filter unlikely $ filter (`notElem` licensefiles) docs where names = ["author", "copying", "doc", "example", "licence", "license", "readme", "todo"] likely name = let lowerName = map toLower name in any (`isPrefixOf` lowerName) names- lf = licenseFile pkgDesc unlikely name = not $ any (`isSuffixOf` name) ["~"] -showLicense :: License -> String-showLicense (GPL Nothing) = "GPL+"-showLicense (GPL (Just ver)) = "GPLv" ++ showVersion ver ++ "+"-showLicense (LGPL Nothing) = "LGPLv2+"-showLicense (LGPL (Just ver)) = "LGPLv" ++ [head $ showVersion ver] ++ "+"-showLicense BSD3 = "BSD"-showLicense BSD4 = "BSD"-showLicense MIT = "MIT"-showLicense PublicDomain = "Public Domain"-showLicense AllRightsReserved = "Proprietary"-showLicense OtherLicense = "Unknown"-showLicense (UnknownLicense l) = "Unknown" +-+ l-#if MIN_VERSION_Cabal(1,16,0)-showLicense (Apache Nothing) = "ASL ?"-showLicense (Apache (Just ver)) = "ASL" +-+ showVersion ver+showLicense :: Distro -> License -> String+showLicense SUSE (GPL Nothing) = "GPL-1.0+"+showLicense _ (GPL Nothing) = "GPL+"+showLicense SUSE (GPL (Just ver)) = "GPL-" ++ showVersion ver ++ "+"+showLicense _ (GPL (Just ver)) = "GPLv" ++ showVersion ver ++ "+"+showLicense SUSE (LGPL Nothing) = "LGPL-2.0+"+showLicense _ (LGPL Nothing) = "LGPLv2+"+showLicense SUSE (LGPL (Just ver)) = "LGPL-" ++ [head $ showVersion ver] ++ "+"+showLicense _ (LGPL (Just ver)) = "LGPLv" ++ [head $ showVersion ver] ++ "+"+showLicense SUSE BSD3 = "BSD-3-Clause"+showLicense _ BSD3 = "BSD"+showLicense SUSE BSD4 = "BSD-4-Clause"+showLicense _ BSD4 = "BSD"+showLicense _ MIT = "MIT"+showLicense SUSE PublicDomain = "SUSE-Public-Domain"+showLicense _ PublicDomain = "Public Domain"+showLicense SUSE AllRightsReserved = "SUSE-NonFree"+showLicense _ AllRightsReserved = "Proprietary"+showLicense _ OtherLicense = "Unknown"+showLicense _ (UnknownLicense l) = "Unknown" +-+ l+#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,16,0)+showLicense SUSE (Apache Nothing) = "Apache-2.0"+showLicense _ (Apache Nothing) = "ASL ?"+showLicense SUSE (Apache (Just ver)) = "Apache-" +-+ showVersion ver+showLicense _ (Apache (Just ver)) = "ASL" +-+ showVersion ver #endif-#if MIN_VERSION_Cabal(1,18,0)-showLicense (AGPL Nothing) = "AGPLv?"-showLicense (AGPL (Just ver)) = "AGPLv" ++ showVersion ver+#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,18,0)+showLicense _ (AGPL Nothing) = "AGPLv?"+showLicense _ (AGPL (Just ver)) = "AGPLv" ++ showVersion ver #endif -- from http://stackoverflow.com/questions/930675/functional-paragraphs@@ -339,16 +400,30 @@ -- http://rosettacode.org/wiki/Word_wrap#Haskell wordwrap :: Int -> String -> String-wordwrap maxlen = wrap_ 0 False . words where- wrap_ _ _ [] = "\n"- wrap_ pos eos (w:ws)- -- at line start: put down the word no matter what- | pos == 0 = w ++ wrap_ (pos + lw) endp ws- | pos + lw + 1 > maxlen - 9 && eos = '\n':wrap_ 0 endp (w:ws)- | pos + lw + 1 > maxlen = '\n':wrap_ 0 endp (w:ws)- | otherwise = " " ++ w ++ wrap_ (pos + lw + 1) endp ws- where lw = length w- endp = last w == '.'+wordwrap maxlen = wrap_ 0 False . words+ where+ wrap_ _ _ [] = "\n"+ wrap_ pos eos (w:ws)+ -- at line start: put down the word no matter what+ | pos == 0 = w ++ wrap_ (pos + lw) endp ws+ | pos + lw + 1 > maxlen - 9 && eos = '\n':wrap_ 0 endp (w:ws)+ | pos + lw + 1 > maxlen = '\n':wrap_ 0 endp (w:ws)+ | otherwise = " " ++ w ++ wrap_ (pos + lw + 1) endp ws+ where+ lw = length w+ endp = last w == '.' formatParagraphs :: String -> [String] formatParagraphs = map (wordwrap 79) . paragraphs . lines++data Distro = Fedora | RHEL5 | SUSE deriving (Eq)++-- for now assume Fedora if no /etc/SuSE-release+detectDistro :: IO Distro+detectDistro = do+ suse <- doesFileExist "/etc/SuSE-release"+ if suse then return SUSE+ else do+ -- RHEL5 does not have macros.dist+ dist <- doesFileExist "/etc/rpm/macros.dist"+ return $ if dist then Fedora else RHEL5
src/Dependencies.hs view
@@ -17,15 +17,20 @@ dependencies, packageDependencies, showDep, testsuiteDependencies ) where -import SysCmd (tryReadProcess)+import SysCmd (cmd, optionalProgram, (+-+)) +import Control.Applicative ((<$>))+ import Data.List (delete, nub)+import Data.Maybe (catMaybes) import Distribution.Package (Dependency (..), PackageName (..)) import Distribution.PackageDescription (PackageDescription (..), allBuildInfo, BuildInfo (..), TestSuite (..))+import System.Directory (doesDirectoryExist, doesFileExist)+import System.IO (hPutStrLn, stderr) excludedPkgs :: String -> Bool excludedPkgs = flip notElem ["Cabal", "base", "ghc-prim", "integer-gmp"]@@ -51,26 +56,50 @@ buildinfo = allBuildInfo pkgDesc tools = nub $ map depName (concatMap buildTools buildinfo) pkgcfgs = nub $ map depName $ concatMap pkgconfigDepends buildinfo+ clibs = concatMap extraLibs buildinfo+ return (deps, tools, nub clibs, pkgcfgs, selfdep) - clibs <- mapM repoqueryLib $ concatMap extraLibs buildinfo- return (deps, tools, clibs, pkgcfgs, selfdep)+resolveLib :: String -> IO (Maybe String)+resolveLib lib = do+ lib64 <- doesDirectoryExist "/usr/lib64"+ let libsuffix = if lib64 then "64" else ""+ let lib_path = "/usr/lib" ++ libsuffix ++ "/lib" ++ lib ++ ".so"+ libInst <- doesFileExist lib_path+ if libInst+ then rpmquery "rpm" lib_path+ else do+ haveRpqry <- optionalProgram "repoquery"+ if haveRpqry+ then do+ putStrLn $ "Running repoquery on" +-+ "lib" ++ lib+ rpmquery "repoquery" lib_path+ else do+ warning $ "Install yum-utils to resolve package that provides uninstalled" +-+ lib_path+ return Nothing -repoqueryLib :: String -> IO String-repoqueryLib lib = do- let lib_path = "/usr/lib/lib" ++ lib ++ ".so"- out <- tryReadProcess "repoquery" ["--qf=%{name}", "-qf", lib_path]+-- use repoquery or rpm -q to query which package provides file+rpmquery :: String -> FilePath -> IO (Maybe String)+rpmquery c file = do+ out <- cmd c ["-q", "--qf=%{name}", "-f", file] let pkgs = nub $ words out case pkgs of- [pkg] -> return pkg- [] -> error $ "Could not resolve package that provides lib" ++ lib_path- _ -> error $ "More than one package seems to provide lib" ++ lib_path ++ ": " ++ show pkgs+ [pkg] -> return $ Just pkg+ [] -> do+ warning $ "Could not resolve package that provides" +-+ file+ return Nothing+ _ -> do+ warning $ "More than one package seems to provide" +-+ file ++ ": " +-+ unwords pkgs+ return Nothing +warning :: String -> IO ()+warning s = hPutStrLn stderr $ "Warning:" +-+ s+ packageDependencies :: PackageDescription -- ^pkg description -> String -- ^pkg name -> IO ([String], [String], [String], [String], Bool) -- ^depends, tools, c-libs, pkgcfg, selfdep packageDependencies pkgDesc self = do- (deps, tools', clibs, pkgcfgs, selfdep) <- dependencies pkgDesc self+ (deps, tools', clibs', pkgcfgs, selfdep) <- dependencies pkgDesc self let excludedTools n = n `notElem` ["ghc", "hsc2hs", "perl"] mapTools "gtk2hsC2hs" = "gtk2hs-buildtools" mapTools "gtk2hsHookGenerator" = "gtk2hs-buildtools"@@ -78,7 +107,7 @@ mapTools tool = tool chrpath = ["chrpath" | selfdep] tools = filter excludedTools $ nub $ map mapTools tools' ++ chrpath-+ clibs <- catMaybes <$> mapM resolveLib clibs' let showPkgCfg p = "pkgconfig(" ++ p ++ ")" return (map showDep deps, tools, clibs, map showPkgCfg pkgcfgs, selfdep)
src/FileUtils.hs view
@@ -15,12 +15,13 @@ -- (at your option) any later version. module FileUtils (+ filesWithExtension, fileWithExtension, fileWithExtension_, getDirectoryContents_, mktempdir) where -import SysCmd (tryReadProcess)+import SysCmd (cmd) import Control.Applicative ((<$>)) import Data.List (isPrefixOf)@@ -28,10 +29,14 @@ import System.Directory (getDirectoryContents) import System.FilePath (takeExtension, (</>)) +filesWithExtension :: FilePath -> String -> IO [FilePath]+filesWithExtension dir ext =+ filter (\ f -> takeExtension f == ext) <$> getDirectoryContents dir+ -- looks in current dir for a unique file with given extension fileWithExtension :: FilePath -> String -> IO (Maybe FilePath) fileWithExtension dir ext = do- files <- filter (\ f -> takeExtension f == ext) <$> getDirectoryContents dir+ files <- filesWithExtension dir ext case files of [file] -> return $ Just $ dir </> file [] -> return Nothing@@ -43,9 +48,7 @@ isJust <$> fileWithExtension dir ext mktempdir :: IO FilePath-mktempdir = do- mktempOut <- tryReadProcess "mktemp" ["-d"]- return $ init mktempOut+mktempdir = cmd "mktemp" ["-d", "cblrpm.XXXXXXXXXX"] -- getDirectoryContents without hidden files getDirectoryContents_ :: FilePath -> IO [FilePath]
src/Main.hs view
@@ -16,52 +16,38 @@ module Main where -import Commands.Depends (depends, missingDeps, requires)+import Commands.Depends (depends, Depends (..)) import Commands.Diff (diff) import Commands.Install (install)-import Commands.RpmBuild (rpmBuild, RpmStage (..))-import Commands.Spec (createSpecFile)+import Commands.RpmBuild (rpmBuild_)+import Commands.Spec (createSpecFile_) -import PackageUtils (simplePackageDescription)+import PackageUtils (prepare, PackageData (..), RpmStage (..)) import Setup (parseArgs) -import Data.Maybe (listToMaybe, fromMaybe)-import System.Directory (removeDirectoryRecursive)+import Control.Exception (bracket)+import System.Directory (removeDirectoryRecursive) import System.Environment (getArgs) main :: IO ()-main = do (opts, args) <- getArgs >>= parseArgs- let (cmd:args') = args- path = fromMaybe "." $ listToMaybe args'- (cabalPath, pkgDesc, mtmp) <- simplePackageDescription path opts- case cmd of- "spec" -> createSpecFile cabalPath pkgDesc opts Nothing- "srpm" -> rpmBuild cabalPath pkgDesc opts Source- "prep" -> rpmBuild cabalPath pkgDesc opts Prep- "local" -> rpmBuild cabalPath pkgDesc opts Binary- "rpm" -> do- putStrLn "* Warning the 'rpm' command has been renamed to 'local':"- putStrLn "* this alias may be removed in a future release."- rpmBuild cabalPath pkgDesc opts Binary- "builddep" -> rpmBuild cabalPath pkgDesc opts BuildDep- "install" -> install cabalPath pkgDesc- "depends" -> depends pkgDesc- "requires" -> requires pkgDesc- "missingdeps" -> missingDeps pkgDesc- "diff" -> diff cabalPath pkgDesc opts- c -> error $ "Unknown cmd: " ++ c- maybe (return ()) removeDirectoryRecursive mtmp-- -- where- -- -- copied from Distribution.Simple.Configure configure- -- depResolver = if build- -- then not . null . PackageIndex.lookupDependency pkgs'- -- else (const True)- -- pkgs' = PackageIndex.insert internalPackage installedPackageSet- -- pid = packageId genPkgDesc- -- internalPackage = emptyInstalledPackageInfo {- -- Installed.installedPackageId = InstalledPackageId $ display $ pid,- -- Installed.sourcePackageId = pid- -- }- -- internalPackageSet = PackageIndex.fromList [internalPackage]-+main = do+ (opts, cmd, mpkg) <- getArgs >>= parseArgs+ bracket (prepare mpkg opts)+ (maybe (return ()) removeDirectoryRecursive . workingDir)+ (\pkgdata ->+ case cmd of+ "spec" -> createSpecFile_ pkgdata opts Nothing+ "srpm" -> rpmBuild_ pkgdata opts Source+ "prep" -> rpmBuild_ pkgdata opts Prep+ "local" -> rpmBuild_ pkgdata opts Binary+ "builddep" -> rpmBuild_ pkgdata opts BuildDep+ "diff" -> diff pkgdata opts+ "install" -> install pkgdata opts+ "depends" -> depends pkgdata Depends+ "requires" -> depends pkgdata Requires+ "missingdeps" -> depends pkgdata Missing+ "rpm" -> do+ putStrLn "* Warning the 'rpm' command has been renamed to 'local':"+ putStrLn "* this alias may be removed in a future release."+ rpmBuild_ pkgdata opts Binary+ c -> error $ "Unknown cmd: " ++ c)
src/PackageUtils.hs view
@@ -14,32 +14,42 @@ -- (at your option) any later version. module PackageUtils (+ checkForSpecFile,+ copyTarball,+ getPkgName, isScmDir, missingPackages, notInstalled,+ PackageData (..), packageName, packageVersion,+ prepare,+ removePrefix,+ removeSuffix,+ rpmbuild,+ RpmStage (..), simplePackageDescription ) where import Dependencies (packageDependencies)-import FileUtils (fileWithExtension, fileWithExtension_,+import FileUtils (filesWithExtension, fileWithExtension, getDirectoryContents_, mktempdir) import Setup (RpmFlags (..))-import SysCmd (runSystem, tryReadProcess, systemBool, (+-+))+import SysCmd (cmd, cmd_, cmdSilent, systemBool, (+-+)) import Control.Applicative ((<$>))-import Control.Monad (filterM, liftM)+import Control.Monad (filterM, liftM, unless, when) -import Data.Char (isAlphaNum)-import Data.List (isSuffixOf, stripPrefix)+import Data.Char (isDigit)+import Data.List (stripPrefix) import Data.Maybe (fromMaybe) import Data.Version (showVersion) import Distribution.Compiler (CompilerFlavor (..)) import Distribution.Package (PackageIdentifier (..), PackageName (..))-import Distribution.PackageDescription (PackageDescription (..))+import Distribution.PackageDescription (PackageDescription (..),+ hasExes, hasLibs) import Distribution.PackageDescription.Configuration (finalizePackageDescription) import Distribution.PackageDescription.Parse (readPackageDescription) @@ -49,95 +59,121 @@ import Distribution.Simple.Utils (die, findPackageDesc) import Distribution.System (Platform (..), buildArch, buildOS)-import Distribution.Verbosity (Verbosity) -import System.Directory (doesDirectoryExist, doesFileExist,+import System.Directory (copyFile, doesDirectoryExist, doesFileExist, getCurrentDirectory, setCurrentDirectory)-import System.FilePath ((</>), takeExtension)-+import System.Environment (getEnv)+import System.FilePath ((</>), takeBaseName, takeFileName)+import System.Posix.Files (accessTime, fileMode, getFileStatus,+ modificationTime, setFileMode) -- returns path to .cabal file and possibly tmpdir to be removed-findCabalFile :: Verbosity -> FilePath -> IO (FilePath, Maybe FilePath)-findCabalFile vb path = do- isdir <- doesDirectoryExist path- if isdir- then do- cblfile <- fileWithExtension_ path ".cabal"- if cblfile- then do- file <- findPackageDesc path- return (file, Nothing)- else do- spcfile <- fileWithExtension path ".spec"- maybe (die "Cannot determine package in dir.")- (cabalFromSpec vb) spcfile- else do- isfile <- doesFileExist path- if not isfile- then if isPackageId path- then tryUnpack path- else error $ path ++ ": No such file or directory"- else if takeExtension path == ".cabal"- then return (path, Nothing)- else if takeExtension path == ".spec"- then cabalFromSpec vb path- else if ".tar.gz" `isSuffixOf` path- then do- tmpdir <- mktempdir- runSystem $ "tar zxf " ++ path ++ " -C " ++ tmpdir ++ " *.cabal"- subdir <- getDirectoryContents_ tmpdir- file <- findPackageDesc $ tmpdir ++ "/" ++ head subdir- return (file, Just tmpdir)- else error $ path ++ ": file should be a .cabal, .spec or .tar.gz file."+--findCabalFile :: Verbosity -> FilePath -> IO (FilePath, Maybe FilePath)+--findCabalFile vb path = do++stripVersion :: String -> String+stripVersion n | '-' `notElem` n = n+stripVersion nv = if hasVer then reverse mEman else nv where- isPackageId :: String -> Bool- isPackageId (c:cs) | isAlphaNum c =- all (\d -> isAlphaNum d || d `elem` "-." ) cs- isPackageId _ = False+ (mRev, '-':mEman) = break (== '-') $ reverse nv+ hasVer = all (\c -> isDigit c || c == '.') mRev simplePackageDescription :: FilePath -> RpmFlags- -> IO (FilePath, PackageDescription, Maybe FilePath)+ -> IO PackageDescription simplePackageDescription path opts = do let verbose = rpmVerbosity opts- (cabalPath, mtmp) <- findCabalFile verbose path- genPkgDesc <- readPackageDescription verbose cabalPath+ genPkgDesc <- readPackageDescription verbose path (compiler, _) <- configCompiler (Just GHC) Nothing Nothing defaultProgramConfiguration verbose case finalizePackageDescription (rpmConfigurationsFlags opts) (const True) (Platform buildArch buildOS) (compilerId compiler) [] genPkgDesc of Left e -> die $ "finalize failed: " ++ show e- Right (pd, _) -> return (cabalPath, pd, mtmp)+ Right (pd, _) -> return pd -cabalFromSpec :: Verbosity -> FilePath -> IO (FilePath, Maybe FilePath)-cabalFromSpec vrb spcfile = do+cabalFromSpec :: FilePath -> IO (FilePath, Maybe FilePath)+cabalFromSpec specFile = do -- no rpmspec command in RHEL 5 and 6- namever <- removePrefix "ghc-" <$> tryReadProcess "rpm" ["-q", "--qf", "%{name}-%{version}\n", "--specfile", spcfile]- findCabalFile vrb (head $ lines namever)+ namever <- removePrefix "ghc-" . head . lines <$> cmd "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+ rpmbuild Prep True Nothing specFile+ cabal <- findPackageDesc namever+ return (cabal, Nothing)+ else do+ tmpdir <- mktempdir+ bringTarball namever+ rpmbuild Prep True (Just tmpdir) specFile+ cabal <- findPackageDesc $ tmpdir </> namever+ return (cabal, Just tmpdir) where- removePrefix :: String -> String-> String- removePrefix pref str =- fromMaybe str (stripPrefix pref str)+ bringTarball nv = do+ fExists <- doesFileExist $ nv ++ ".tar.gz"+ unless fExists $+ let (n, v) = nameVersion nv in+ copyTarball n v False +nameVersion :: String -> (String, String)+nameVersion nv =+ if '-' `notElem` nv+ then error $ "nameVersion: malformed NAME-VER string" +-+ nv+ else (reverse eman, reverse rev)+ where+ (rev, '-':eman) = break (== '-') $ reverse nv++data RpmStage = Binary | Source | Prep | BuildDep deriving Eq++rpmbuild :: RpmStage -> Bool -> Maybe FilePath -> FilePath -> IO ()+rpmbuild mode quiet moutdir spec = do+ let rpmCmd = case mode of+ Binary -> "a"+ Source -> "s"+ Prep -> "p"+ BuildDep -> "_"+ cwd <- getCurrentDirectory+ command "rpmbuild" $ ["-b" ++ rpmCmd] +++ ["--nodeps" | mode == Prep] +++ ["--define=_builddir" +-+ maybe cwd (cwd </>) moutdir,+ "--define=_rpmdir" +-+ cwd,+ "--define=_srcrpmdir" +-+ cwd,+ "--define=_sourcedir" +-+ cwd,+ spec]+ where+ command = if quiet then cmdSilent else cmd_++removePrefix :: String -> String-> String+removePrefix pref str = fromMaybe str (stripPrefix pref str)++removeSuffix :: String -> String -> String+removeSuffix suffix orig =+ fromMaybe orig $ stripSuffix suffix orig+ where+ stripSuffix sf str = reverse <$> stripPrefix (reverse sf) (reverse str)+ tryUnpack :: String -> IO (FilePath, Maybe FilePath) tryUnpack pkg = do pkgver <- if '.' `elem` pkg then return pkg else do- contains_pkg <- tryReadProcess "cabal" ["list", "--simple-output", pkg]- let pkgs = filter ((== pkg) . takeWhile (not . (== ' '))) $ lines contains_pkg+ contains_pkg <- lines <$> cmd "cabal" ["list", "--simple-output", pkg]+ let pkgs = filter ((== pkg) . takeWhile (not . (== ' '))) contains_pkg if null pkgs then error $ pkg ++ " hackage not found" else return $ map (\c -> if c == ' ' then '-' else c) $ last pkgs isdir <- doesDirectoryExist pkgver if isdir then do- pth <-findPackageDesc pkgver+ pth <- findPackageDesc pkgver return (pth, Nothing) else do cwd <- getCurrentDirectory tmpdir <- mktempdir setCurrentDirectory tmpdir- runSystem $ "cabal unpack -v0 " ++ pkgver+ cmd_ "cabal" ["unpack", "-v0", pkgver] pth <- findPackageDesc pkgver setCurrentDirectory cwd return (tmpdir ++ "/" ++ pth, Just tmpdir)@@ -171,3 +207,100 @@ (deps, tools, clibs, pkgcfgs, _) <- packageDependencies pkgDesc name filterM notInstalled $ deps ++ ["ghc-Cabal-devel", "ghc-rpm-macros"] ++ tools ++ clibs ++ pkgcfgs +getPkgName :: Maybe FilePath -> PackageDescription -> Bool -> IO (String, Bool)+getPkgName (Just spec) pkgDesc binary = do+ let name = packageName $ package pkgDesc+ pkgname = takeBaseName spec+ hasLib = hasLibs pkgDesc+ return $ if name == pkgname || binary then (name, hasLib) else (pkgname, False)+getPkgName Nothing pkgDesc binary = do+ let name = packageName $ package pkgDesc+ hasExec = hasExes pkgDesc+ hasLib = hasLibs pkgDesc+ return $ if binary || hasExec && not hasLib then (name, hasLib) else ("ghc-" ++ name, False)++checkForSpecFile :: Maybe String -> IO (Maybe FilePath)+checkForSpecFile Nothing = do+ specs <- filesWithExtension "." ".spec"+ case specs of+ [one] -> return $ Just one+ _ -> return Nothing+checkForSpecFile (Just pkg) = do+ specs <- filesWithExtension "." ".spec"+ case specs of+ [one] | takeBaseName one `elem` ["ghc-" ++ pkg, pkg] -> return $ Just one+ _ -> return Nothing++checkForCabalFile :: String -> IO (Maybe FilePath)+checkForCabalFile pkgver = do+ exists <- doesDirectoryExist pkgver+ mcabal <- fileWithExtension (if exists then pkgver else ".") ".cabal"+ return $ if (Just $ stripVersion pkgver) == (takeBaseName <$> mcabal)+ then mcabal+ else Nothing++-- findSpecFile :: PackageDescription -> RpmFlags -> IO (FilePath, Bool)+-- findSpecFile pkgDesc flags = do+-- pkgname <- findPkgName pkgDesc flags+-- let specfile = pkgname ++ ".spec"+-- exists <- doesFileExist specfile+-- return (specfile, exists)++copyTarball :: String -> String -> Bool -> IO ()+copyTarball n v ranFetch = do+ let tarfile = n ++ "-" ++ v ++ ".tar.gz"+ already <- doesFileExist tarfile+ unless already $ do+ home <- getEnv "HOME"+ let cacheparent = home </> ".cabal" </> "packages"+ tarpath = n </> v </> tarfile+ remotes <- getDirectoryContents_ cacheparent+ let paths = map (\ repo -> cacheparent </> repo </> tarpath) remotes+ -- if more than one tarball, should maybe warn if they are different+ tarballs <- filterM doesFileExist paths+ if null tarballs+ then if ranFetch+ then error $ "No" +-+ tarfile +-+ "found"+ else do+ cmd_ "cabal" ["fetch", "-v0", "--no-dependencies", n ++ "-" ++ v]+ copyTarball n v True+ else do+ copyFile (head tarballs) tarfile+ -- cabal fetch creates tarballs with mode 0600+ stat <- getFileStatus tarfile+ when (fileMode stat /= 0o100644) $+ setFileMode tarfile 0o0644++data PackageData =+ PackageData { specFilename :: Maybe FilePath+ , cabalFilename :: FilePath+ , packageDesc :: PackageDescription+ , workingDir :: Maybe FilePath+ }++-- Nothing implies existing packaging in cwd+-- Something implies either new packaging or could be multiple spec files in dir+prepare :: Maybe String -> RpmFlags -> IO PackageData+prepare mpkgver flags = do+ let mpkg = stripVersion <$> mpkgver+ mspec <- checkForSpecFile mpkg+ case mspec of+ Just spec -> do+ (cabal, mtmp) <- cabalFromSpec spec+ pkgDesc <- simplePackageDescription cabal flags+ return $ PackageData mspec cabal pkgDesc mtmp+ Nothing ->+ case mpkgver of+ Nothing -> do+ cwd <- getCurrentDirectory+ prepare (Just $ takeFileName cwd) flags+ Just pkgmver -> do+ mcabal <- checkForCabalFile pkgmver+ case mcabal of+ Just cabal -> do+ pkgDesc <- simplePackageDescription cabal flags+ return $ PackageData Nothing cabal pkgDesc Nothing+ Nothing -> do+ (cabal, mtmp) <- tryUnpack pkgmver+ pkgDesc <- simplePackageDescription cabal flags+ return $ PackageData Nothing cabal pkgDesc mtmp
src/Setup.hs view
@@ -22,6 +22,7 @@ import Control.Monad (unless, when) import Data.Char (toLower)+import Data.Maybe (listToMaybe) import Data.Version (showVersion) import Distribution.PackageDescription (FlagName (..))@@ -32,15 +33,16 @@ getOpt', usageInfo) import System.Environment (getProgName) import System.Exit (ExitCode (..), exitSuccess, exitWith)-import System.IO (Handle, hPutStr, hPutStrLn, stderr, stdout)+import System.IO (Handle, hPutStrLn, stderr, stdout) import Paths_cabal_rpm (version)+import SysCmd ((+-+)) data RpmFlags = RpmFlags { rpmConfigurationsFlags :: [(FlagName, Bool)] , rpmForce :: Bool , rpmHelp :: Bool- , rpmLibrary :: Bool+ , rpmBinary :: Bool , rpmRelease :: Maybe String , rpmVerbosity :: Verbosity , rpmVersion :: Bool@@ -52,7 +54,7 @@ { rpmConfigurationsFlags = [] , rpmForce = False , rpmHelp = False- , rpmLibrary = False+ , rpmBinary = False , rpmRelease = Nothing , rpmVerbosity = normal , rpmVersion = False@@ -64,8 +66,8 @@ [ Option "h?" ["help"] (NoArg (\x -> x { rpmHelp = True })) "Show this help text",- Option "l" ["library"] (NoArg (\x -> x { rpmLibrary = True }))- "Force package to be a Library ignoring executables",+ Option "b" ["binary"] (NoArg (\x -> x { rpmBinary = True }))+ "Force Haskell package name to be base package name", Option "f" ["flags"] (ReqArg (\flags x -> x { rpmConfigurationsFlags = rpmConfigurationsFlags x ++ flagList flags }) "FLAGS") "Set given flags in Cabal conditionals", Option "" ["force"] (NoArg (\x -> x { rpmForce = True }))@@ -85,52 +87,45 @@ tagWithValue name = (FlagName (map toLower name), True) printHelp :: Handle -> IO ()- printHelp h = do- progName <- getProgName- let info = "Usage: " ++ progName ++ " [OPTION]... COMMAND [PATH|PKG|PKG-VERSION]\n"- ++ "\n"- ++ "PATH can be to a .spec or .cabal file, pkg dir, or tarball.\n"- ++ "\n"- ++ "Commands:\n"- ++ " spec\t\t- generate a spec file\n"- ++ " srpm\t\t- generate a src rpm file\n"- ++ " prep\t\t- unpack source\n"- ++ " local\t\t- build rpm package locally\n"- ++ " builddep\t- install dependencies\n"- ++ " install\t- user install package\n"- ++ " depends\t- list Cabal depends\n"- ++ " requires\t- list package buildrequires\n"- ++ " missingdeps\t- list missing buildrequires\n"- ++ " diff\t\t- diff current spec file\n"+ progName <- getProgName+ let info = "Usage: " ++ progName ++ " [OPTION]... COMMAND [PATH|PKG|PKG-VERSION]\n"+ ++ "\n"+ ++ "PATH can be to a .spec or .cabal file, pkg dir, or tarball.\n"+ ++ "\n"+ ++ "Commands:\n"+ ++ " spec\t\t- generate a spec file\n"+ ++ " srpm\t\t- generate a src rpm file\n"+ ++ " prep\t\t- unpack source\n"+ ++ " local\t\t- build rpm package locally\n"+ ++ " builddep\t- install dependencies\n"+ ++ " install\t- install packages recursively\n"+ ++ " depends\t- list Cabal depends\n"+ ++ " requires\t- list package buildrequires\n"+ ++ " missingdeps\t- list missing buildrequires\n"+ ++ " diff\t\t- diff current spec file\n" -- ++ " mock\t\t- mock build package\n"- ++ "\n"- ++ "Options:"- hPutStrLn h (usageInfo info options)+ ++ "\n"+ ++ "Options:"+ hPutStrLn h (usageInfo info options) -parseArgs :: [String] -> IO (RpmFlags, [String])+parseArgs :: [String] -> IO (RpmFlags, String, Maybe String) parseArgs args = do- let (os, args', unknown, errs) = getOpt' Permute options args- opts = foldl (flip ($)) emptyRpmFlags os- when (rpmHelp opts) $ do- printHelp stdout- exitSuccess- when (rpmVersion opts) $ do- putStrLn $ showVersion version- exitSuccess- unless (null errs) $ do- hPutStrLn stderr "Error:"- mapM_ (hPutStrLn stderr) errs- exitWith (ExitFailure 1)- unless (null unknown) $ do- hPutStr stderr "Unrecognised options: "- hPutStrLn stderr $ unwords unknown- exitWith (ExitFailure 1)- when (null args' || notElem (head args') ["builddep", "depends", "diff", "install", "missingdeps", "prep", "requires", "spec", "srpm", "local", "rpm"]) $ do- printHelp stderr- exitWith (ExitFailure 1)- when (length args' > 2) $ do- hPutStr stderr "Too many arguments: "- hPutStrLn stderr $ unwords args'- exitWith (ExitFailure 1)- return (opts, args')+ let (os, args', unknown, errs) = getOpt' Permute options args+ opts = foldl (flip ($)) emptyRpmFlags os+ when (rpmHelp opts) $ do+ printHelp stdout+ exitSuccess+ when (rpmVersion opts) $ do+ putStrLn $ showVersion version+ exitSuccess+ unless (null errs) $+ error $ unlines errs+ unless (null unknown) $+ error $ "Unrecognised options:" +-+ unwords unknown+ when (null args' || notElem (head args') ["builddep", "depends", "diff", "install", "missingdeps", "prep", "requires", "spec", "srpm", "local", "rpm"]) $ do+ printHelp stderr+ exitWith (ExitFailure 1)+ when (length args' > 2) $+ error $ "Too many arguments:" +-+ unwords args'+ return (opts, head args', listToMaybe $ tail args')
src/SysCmd.hs view
@@ -15,60 +15,93 @@ -- (at your option) any later version. module SysCmd (+ optionalProgram, requireProgram,- runSystem,- tryReadProcess,+ cmd,+ cmd_,+ cmdSilent, trySystem,+ shell,+ sudo, systemBool, yumInstall, (+-+)) where import Control.Monad (unless, void, when)-import Data.Maybe (isJust, isNothing)+import Data.Functor ((<$>))+import Data.List ((\\))+import Data.Maybe (fromMaybe, isJust, isNothing) import Distribution.Simple.Utils (die, warn, findProgramLocation) import Distribution.Verbosity (normal) import System.Posix.User (getEffectiveUserID)-import System.Process (readProcess, system)+import System.Process (readProcess, readProcessWithExitCode, system, rawSystem) import System.Exit (ExitCode(..)) requireProgram :: String -> IO ()-requireProgram cmd = do- mavail <- findProgramLocation normal cmd- when (isNothing mavail) $ die (cmd ++ ": command not found")+requireProgram c = do+ mavail <- findProgramLocation normal c+ when (isNothing mavail) $ die (c ++ ": command not found") optionalProgram :: String -> IO Bool-optionalProgram cmd = do- mavail <- findProgramLocation normal cmd- when (isNothing mavail) $ warn normal (cmd ++ ": command not found")- return $ isJust mavail+optionalProgram c = do+ mavail <- findProgramLocation normal c+ when (isNothing mavail) $ warn normal (c ++ ": command not found")+ return $ isJust mavail -runSystem :: String -> IO ()-runSystem cmd = do- requireProgram $ head $ words cmd- ret <- system cmd- case ret of- ExitSuccess -> return ()- ExitFailure n -> die ("\"" ++ cmd ++ "\"" +-+ "failed with status" +-+ show n)+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) -trySystem :: String -> IO ()-trySystem cmd = do- requireProgram $ head $ words cmd- void $ system cmd+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 as = do+ requireProgram "sudo"+ requireProgram c+ putStrLn $ "sudo" +-+ c +-+ unwords as+ cmd_ "sudo" (c:as)++trySystem :: String -> [String] -> IO ()+trySystem c args = do+ requireProgram c+ void $ rawSystem c args+ systemBool :: String -> IO Bool-systemBool cmd = do- requireProgram $ head $ words cmd- ret <- system $ cmd +-+ ">/dev/null"- case ret of- ExitSuccess -> return True- ExitFailure _ -> return False+systemBool c = do+ requireProgram $ head $ words c+ ret <- system $ c +-+ ">/dev/null"+ case ret of+ ExitSuccess -> return True+ ExitFailure _ -> return False -tryReadProcess :: FilePath -> [String] -> IO String-tryReadProcess cmd args = do- requireProgram cmd- readProcess cmd args []+cmd :: FilePath -> [String] -> IO String+cmd c args = do+ requireProgram c+ removeTrailingNewline <$> readProcess c args ""+ where+ removeTrailingNewline :: String -> String+ removeTrailingNewline "" = ""+ removeTrailingNewline str =+ if last str == '\n'+ then init str+ else str (+-+) :: String -> String -> String "" +-+ s = s@@ -78,20 +111,27 @@ yumInstall :: [String] -> Bool -> IO () yumInstall pkgs hard = unless (null pkgs) $ do- putStrLn "Uninstalled dependencies:"- mapM_ putStrLn pkgs- uid <- getEffectiveUserID- cmdprefix <-- if uid == 0- then return ""+ putStrLn $ "Running repoquery" +-+ unwords pkgs+ repopkgs <- lines <$> readProcess "repoquery" (["--qf", "%{name}"] ++ pkgs) []+ if repopkgs /= pkgs+ then+ when hard $+ error $ unwords (pkgs \\ repopkgs) +-+ "not available." else do- havesudo <- optionalProgram "sudo"- return $ if havesudo then "sudo" else ""- requireProgram "yum"- let args = unwords $ map showPkg pkgs- putStrLn $ "Running:" +-+ cmdprefix +-+ "yum install" +-+ args- let exec = if hard then runSystem else trySystem- exec $ cmdprefix +-+ "yum install" +-+ args+ putStrLn "Uninstalled dependencies:"+ mapM_ putStrLn pkgs+ uid <- getEffectiveUserID+ maybeSudo <-+ if uid == 0+ then return Nothing+ else do+ havesudo <- optionalProgram "sudo"+ return $ if havesudo then Just "sudo" else Nothing+ requireProgram "yum"+ let args = map showPkg pkgs+ putStrLn $ "Running:" +-+ fromMaybe "" maybeSudo +-+ "yum install" +-+ unwords args+ let exec = if hard then cmd_ else trySystem+ exec (fromMaybe "yum" maybeSudo) $ maybe [] (const "yum") maybeSudo : "install" : args showPkg :: String -> String showPkg p = if '(' `elem` p then show p else p