cabal-rpm 0.9 → 0.9.1
raw patch · 11 files changed
+156/−89 lines, 11 files
Files
- ChangeLog +7/−0
- cabal-rpm.cabal +2/−2
- src/Commands/Depends.hs +40/−9
- src/Commands/Diff.hs +3/−3
- src/Commands/Install.hs +5/−8
- src/Commands/RpmBuild.hs +4/−4
- src/Commands/Spec.hs +8/−5
- src/Dependencies.hs +31/−13
- src/PackageUtils.hs +26/−32
- src/Setup.hs +7/−2
- src/SysCmd.hs +23/−11
ChangeLog view
@@ -1,3 +1,10 @@+* 0.9.1 (2014-08-26)+- missingdeps now lists missing dependencies recursively and outputs Hackage+ package names rather than ghc-*-devel package names+- do not assume package order when testing if dependencies installed+- check ~/.cabal/packages/ exists before looking for tarballs+- pass actual exeNames to %ghc_fix_dynamic_rpath+ * 0.9 (2014-07-17) - reworked initial logic to make better use of existing spec files, and prep source tree properly
cabal-rpm.cabal view
@@ -1,5 +1,5 @@ Name: cabal-rpm-Version: 0.9+Version: 0.9.1 Synopsis: RPM packaging tool for Haskell Cabal-based packages Description: This package generates RPM packages from Haskell Cabal packages.@@ -20,7 +20,7 @@ . * cblrpm requires: list package dependencies .- * cblrpm missingdeps: list uninstalled dependencies+ * cblrpm missingdeps: recursively list missing dependencies . * cblrpm diff: diff current spec file with newly generated one Homepage: https://github.com/juhp/cabal-rpm
src/Commands/Depends.hs view
@@ -17,28 +17,59 @@ Depends (..) ) where -import Dependencies (dependencies, packageDependencies )-import PackageUtils (missingPackages, PackageData (..), packageName)+import Dependencies (dependencies, missingPackages, packageDependencies)+import PackageUtils (PackageData (..), packageName, prepare, stripPkgDevel)+import Setup (quiet)+import SysCmd (cmd, (+-+)) -import Data.List (sort)+import Control.Applicative ((<$>))+import Control.Monad (filterM)+import Data.List (nub, sort, (\\)) import Distribution.PackageDescription (PackageDescription (..))+import System.Directory (removeDirectoryRecursive) data Depends = Depends | Requires | 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+ (deps, tools, clibs, pkgcfgs, _) <- dependencies pkgDesc 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+ (deps, tools, clibs, pkgcfgs, _) <- packageDependencies pkgDesc mapM_ putStrLn $ sort $ deps ++ tools ++ clibs ++ pkgcfgs Missing -> do- missing <- missingPackages pkgDesc name- mapM_ putStrLn missing+ miss <- missingPackages pkgDesc >>= filterM notAvail+ let name = packageName $ package pkgDesc+ putMissing name miss+ final <- recurseMissing miss (map stripPkgDevel miss)+ putStrLn ""+ mapM_ putStrLn $ sort $ map stripPkgDevel final++recurseMissing :: [String] -> [String] -> IO [String]+recurseMissing already [] = return already+recurseMissing already (dep:deps) = do+ miss <- missingDepsPkg dep+ putMissing dep miss+ let accum = nub $ miss ++ already+ deeper <- recurseMissing accum (miss \\ accum)+ let accum2 = nub $ accum ++ deeper+ more <- recurseMissing accum2 (deps \\ accum2)+ return $ nub $ accum2 ++ more++notAvail :: String -> IO Bool+notAvail pkg = null <$> cmd "repoquery" [pkg]++missingDepsPkg :: String -> IO [String]+missingDepsPkg pkg = do+ pkgdata <- prepare (Just pkg) quiet+ maybe (return ()) removeDirectoryRecursive $ workingDir pkgdata+ missingPackages (packageDesc pkgdata) >>= filterM notAvail++putMissing :: String -> [String] -> IO ()+putMissing _ [] = return ()+putMissing pkg deps = putStrLn $ pkg +-+ "misses:" +-+ unwords (map stripPkgDevel deps)
src/Commands/Diff.hs view
@@ -28,11 +28,11 @@ import System.Directory (removeDirectoryRecursive) diff :: PackageData -> RpmFlags -> IO ()-diff pkgFiles flags =- case specFilename pkgFiles of+diff pkgdata flags =+ case specFilename pkgdata of Nothing -> die "No (unique) .spec file in directory." Just spec -> do tmpdir <- mktempdir- speccblrpm <- createSpecFile pkgFiles flags (Just tmpdir)+ speccblrpm <- createSpecFile pkgdata flags (Just tmpdir) shell $ "diff" +-+ "-u" +-+ spec +-+ speccblrpm +-+ "| sed -e s%" ++ speccblrpm ++ "%" ++ spec ++ ".cblrpm" ++ "%" removeDirectoryRecursive tmpdir
src/Commands/Install.hs view
@@ -18,14 +18,13 @@ ) where import Commands.RpmBuild (rpmBuild)-import PackageUtils (missingPackages, notInstalled, PackageData (..),- packageName, removePrefix, removeSuffix, RpmStage (..))+import Dependencies (missingPackages, notInstalled)+import PackageUtils (PackageData (..), RpmStage (..), stripPkgDevel) import Setup (RpmFlags (..)) import SysCmd (cmd, cmd_, sudo, yumInstall, (+-+)) import Control.Applicative ((<$>)) import Control.Monad (when)-import Distribution.PackageDescription (PackageDescription (..)) --import System.Directory (getCurrentDirectory, setCurrentDirectory) --import System.FilePath (takeDirectory) import System.FilePath ((</>))@@ -33,11 +32,9 @@ install :: PackageData -> RpmFlags -> IO () install pkgdata flags = do let pkgDesc = packageDesc pkgdata- pkg = package pkgDesc- name = packageName pkg- missing <- missingPackages pkgDesc name+ missing <- missingPackages pkgDesc yumInstall missing False- stillMissing <- missingPackages pkgDesc name+ stillMissing <- missingPackages pkgDesc putStrLn $ "Missing:" +-+ unwords stillMissing mapM_ installMissing stillMissing -- let pkgDir = takeDirectory cabalPath@@ -51,6 +48,6 @@ installMissing pkg = do noInstall <- notInstalled pkg when noInstall $ do- let dep = removeSuffix "-devel" $ removePrefix "ghc-" pkg+ let dep = stripPkgDevel pkg putStrLn $ "Running cblrpm install" +-+ dep cmd_ "cblrpm" ["install", dep]
src/Commands/RpmBuild.hs view
@@ -20,9 +20,9 @@ ) where import Commands.Spec (createSpecFile)-import PackageUtils (copyTarball, isScmDir, missingPackages,- PackageData (..), packageName, packageVersion, rpmbuild,- RpmStage (..))+import Dependencies (missingPackages)+import PackageUtils (copyTarball, isScmDir, PackageData (..), packageName,+ packageVersion, rpmbuild, RpmStage (..)) import Setup (RpmFlags (..)) import SysCmd (yumInstall, (+-+)) @@ -60,7 +60,7 @@ let pkg = package pkgDesc name = packageName pkg when (stage `elem` [Binary,BuildDep]) $ do- missing <- missingPackages pkgDesc name+ missing <- missingPackages pkgDesc yumInstall missing True unless (stage == BuildDep) $ do
src/Commands/Spec.hs view
@@ -20,15 +20,17 @@ createSpecFile, createSpecFile_ ) where -import Dependencies (packageDependencies, showDep, testsuiteDependencies)-import PackageUtils (getPkgName, isScmDir, notInstalled, PackageData (..),+import Dependencies (notInstalled, packageDependencies, showDep,+ testsuiteDependencies)+import PackageUtils (getPkgName, isScmDir, PackageData (..), packageName, packageVersion) import Setup (RpmFlags (..)) import SysCmd ((+-+)) import Control.Monad (filterM, unless, void, when) import Data.Char (toLower, toUpper)-import Data.List (groupBy, isPrefixOf, isSuffixOf, sort, (\\))+import Data.List (groupBy, intercalate, isPrefixOf, isSuffixOf,+ sort, (\\)) import Data.Maybe (fromMaybe, maybeToList) import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Time.Format (formatTime)@@ -95,7 +97,7 @@ 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+ (deps, tools, clibs, pkgcfgs, selfdep) <- packageDependencies pkgDesc let testsuiteDeps = testsuiteDependencies pkgDesc name missTestDeps <- filterM notInstalled testsuiteDeps @@ -265,8 +267,9 @@ put "%install" put $ "%ghc_" ++ pkgType ++ "_install" when selfdep $ do+ let execs = map exeName $ executables pkgDesc putNewline- put "%ghc_fix_dynamic_rpath %{name}"+ put $ "%ghc_fix_dynamic_rpath" +-+ intercalate " " execs putNewline putNewline
src/Dependencies.hs view
@@ -14,12 +14,19 @@ -- (at your option) any later version. module Dependencies (- dependencies, packageDependencies, showDep, testsuiteDependencies+ dependencies,+ missingPackages,+ notInstalled,+ packageDependencies,+ showDep,+ testsuiteDependencies ) where -import SysCmd (cmd, optionalProgram, (+-+))+import PackageUtils (packageName)+import SysCmd (cmd, cmdBool, optionalProgram, (+-+)) import Control.Applicative ((<$>))+import Control.Monad (filterM, liftM) import Data.List (delete, nub) import Data.Maybe (catMaybes)@@ -48,11 +55,11 @@ showDep p = "ghc-" ++ p ++ "-devel" dependencies :: PackageDescription -- ^pkg description- -> String -- ^pkg name -> IO ([String], [String], [String], [String], Bool) -- ^depends, tools, c-libs, pkgcfg, selfdep-dependencies pkgDesc self = do- let (deps, selfdep) = buildDependencies pkgDesc self+dependencies pkgDesc = do+ let self = packageName $ package pkgDesc+ (deps, selfdep) = buildDependencies pkgDesc self buildinfo = allBuildInfo pkgDesc tools = nub $ map depName (concatMap buildTools buildinfo) pkgcfgs = nub $ map depName $ concatMap pkgconfigDepends buildinfo@@ -66,21 +73,21 @@ let lib_path = "/usr/lib" ++ libsuffix ++ "/lib" ++ lib ++ ".so" libInst <- doesFileExist lib_path if libInst- then rpmquery "rpm" lib_path+ then rpmqueryFile "rpm" lib_path else do haveRpqry <- optionalProgram "repoquery" if haveRpqry then do putStrLn $ "Running repoquery on" +-+ "lib" ++ lib- rpmquery "repoquery" lib_path+ rpmqueryFile "repoquery" lib_path else do warning $ "Install yum-utils to resolve package that provides uninstalled" +-+ lib_path return Nothing -- 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]+rpmqueryFile :: String -> FilePath -> IO (Maybe String)+rpmqueryFile qc file = do+ out <- cmd qc ["-q", "--qf=%{name}", "-f", file] let pkgs = nub $ words out case pkgs of [pkg] -> return $ Just pkg@@ -95,11 +102,10 @@ 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+packageDependencies pkgDesc = do+ (deps, tools', clibs', pkgcfgs, selfdep) <- dependencies pkgDesc let excludedTools n = n `notElem` ["ghc", "hsc2hs", "perl"] mapTools "gtk2hsC2hs" = "gtk2hs-buildtools" mapTools "gtk2hsHookGenerator" = "gtk2hs-buildtools"@@ -117,3 +123,15 @@ testsuiteDependencies pkgDesc self = map showDep . delete self . filter excludedPkgs . map depName . nub $ concatMap targetBuildDepends $ map testBuildInfo $ testSuites pkgDesc +missingPackages :: PackageDescription -> IO [String]+missingPackages pkgDesc = do+ (deps, tools, clibs, pkgcfgs, _) <- packageDependencies pkgDesc+ filterM notInstalled $ deps ++ ["ghc-Cabal-devel", "ghc-rpm-macros"] ++ tools ++ clibs ++ pkgcfgs++notInstalled :: String -> IO Bool+notInstalled dep =+ liftM not $ cmdBool $ "rpm -q --whatprovides" +-+ shellQuote dep+ where+ shellQuote :: String -> String+ shellQuote (c:cs) = (if c `elem` "()" then (['\\', c] ++) else (c:)) (shellQuote cs)+ shellQuote "" = ""
src/PackageUtils.hs view
@@ -18,27 +18,23 @@ copyTarball, getPkgName, isScmDir,- missingPackages,- notInstalled, PackageData (..), packageName, packageVersion, prepare,- removePrefix,- removeSuffix, rpmbuild, RpmStage (..),- simplePackageDescription- ) where+ simplePackageDescription,+ stripPkgDevel+ ) where -import Dependencies (packageDependencies) import FileUtils (filesWithExtension, fileWithExtension, getDirectoryContents_, mktempdir) import Setup (RpmFlags (..))-import SysCmd (cmd, cmd_, cmdSilent, systemBool, (+-+))+import SysCmd (cmd, cmd_, cmdSilent, (+-+)) import Control.Applicative ((<$>))-import Control.Monad (filterM, liftM, unless, when)+import Control.Monad (filterM, unless, when) import Data.Char (isDigit) import Data.List (stripPrefix)@@ -63,7 +59,7 @@ import System.Directory (copyFile, doesDirectoryExist, doesFileExist, getCurrentDirectory, setCurrentDirectory) import System.Environment (getEnv)-import System.FilePath ((</>), takeBaseName, takeFileName)+import System.FilePath ((</>), (<.>), takeBaseName, takeFileName) import System.Posix.Files (accessTime, fileMode, getFileStatus, modificationTime, setFileMode) @@ -113,7 +109,7 @@ return (cabal, Just tmpdir) where bringTarball nv = do- fExists <- doesFileExist $ nv ++ ".tar.gz"+ fExists <- doesFileExist $ nv <.> "tar.gz" unless fExists $ let (n, v) = nameVersion nv in copyTarball n v False@@ -155,6 +151,9 @@ where stripSuffix sf str = reverse <$> stripPrefix (reverse sf) (reverse str) +stripPkgDevel :: String -> String+stripPkgDevel = removeSuffix "-devel" . removePrefix "ghc-"+ tryUnpack :: String -> IO (FilePath, Maybe FilePath) tryUnpack pkg = do pkgver <- if '.' `elem` pkg then return pkg@@ -194,19 +193,6 @@ isScmDir dir = doesDirectoryExist (dir </> ".git") <||> doesDirectoryExist (dir </> "_darcs") -notInstalled :: String -> IO Bool-notInstalled br =- liftM not $ systemBool $ "rpm -q --whatprovides" +-+ shellQuote br- where- shellQuote :: String -> String- shellQuote (c:cs) = (if c `elem` "()" then (['\\', c] ++) else (c:)) (shellQuote cs)- shellQuote "" = ""--missingPackages :: PackageDescription -> String -> IO [String]-missingPackages pkgDesc name = do- (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@@ -232,28 +218,36 @@ _ -> 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+checkForCabalFile pkgmver = do+ let pkg = stripVersion pkgmver+ cabalfile = pkg <.> "cabal"+ pkgcabal <- doesFileExist cabalfile+ if pkgcabal+ then return $ Just cabalfile+ else do+ exists <- doesDirectoryExist pkgmver+ if exists+ then fileWithExtension pkgmver ".cabal"+ else return Nothing -- findSpecFile :: PackageDescription -> RpmFlags -> IO (FilePath, Bool) -- findSpecFile pkgDesc flags = do -- pkgname <- findPkgName pkgDesc flags--- let specfile = pkgname ++ ".spec"+-- 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"+ let tarfile = n ++ "-" ++ v <.> "tar.gz" already <- doesFileExist tarfile unless already $ do home <- getEnv "HOME" let cacheparent = home </> ".cabal" </> "packages" tarpath = n </> v </> tarfile+ pkgsdir <- doesDirectoryExist cacheparent+ unless pkgsdir $+ error $ "Run 'cabal update' to create" +-+ cacheparent remotes <- getDirectoryContents_ cacheparent let paths = map (\ repo -> cacheparent </> repo </> tarpath) remotes -- if more than one tarball, should maybe warn if they are different
src/Setup.hs view
@@ -18,6 +18,7 @@ module Setup ( RpmFlags(..) , parseArgs+ , quiet ) where import Control.Monad (unless, when)@@ -27,7 +28,8 @@ import Distribution.PackageDescription (FlagName (..)) import Distribution.ReadE (readEOrFail)-import Distribution.Verbosity (Verbosity, flagToVerbosity, normal)+import Distribution.Verbosity (Verbosity, flagToVerbosity, normal,+ silent) import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), OptDescr (..), getOpt', usageInfo)@@ -60,6 +62,9 @@ , rpmVersion = False } +quiet :: RpmFlags+quiet = emptyRpmFlags {rpmVerbosity = silent}+ options :: [OptDescr (RpmFlags -> RpmFlags)] options =@@ -91,7 +96,7 @@ 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"+ ++ "PATH can be to a .spec or .cabal file, pkg dir.\n" ++ "\n" ++ "Commands:\n" ++ " spec\t\t- generate a spec file\n"
src/SysCmd.hs view
@@ -19,11 +19,12 @@ requireProgram, cmd, cmd_,+ cmdBool,+ cmdQuiet, cmdSilent, trySystem, shell, sudo,- systemBool, yumInstall, (+-+)) where @@ -59,6 +60,16 @@ ExitSuccess -> return () ExitFailure n -> die ("\"" ++ c +-+ unwords args ++ "\"" +-+ "failed with status" +-+ show n) +-- hide stderr+cmdQuiet :: String -> [String] -> IO String+cmdQuiet c args = do+ requireProgram c+ (ret, out, err) <- readProcessWithExitCode c args ""+ case ret of+ ExitSuccess -> return $removeTrailingNewline out+ ExitFailure n -> die ("\"" ++ c +-+ unwords args ++ "\"" +-+ "failed with status" +-+ show n ++ "\n" ++ err)++-- hide stdout cmdSilent :: String -> [String] -> IO () cmdSilent c args = do requireProgram c@@ -83,8 +94,8 @@ requireProgram c void $ rawSystem c args -systemBool :: String -> IO Bool-systemBool c = do+cmdBool :: String -> IO Bool+cmdBool c = do requireProgram $ head $ words c ret <- system $ c +-+ ">/dev/null" case ret of@@ -95,14 +106,14 @@ 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 +removeTrailingNewline :: String -> String+removeTrailingNewline "" = ""+removeTrailingNewline str =+ if last str == '\n'+ then init str+ else str+ (+-+) :: String -> String -> String "" +-+ s = s s +-+ "" = s@@ -113,7 +124,7 @@ unless (null pkgs) $ do putStrLn $ "Running repoquery" +-+ unwords pkgs repopkgs <- lines <$> readProcess "repoquery" (["--qf", "%{name}"] ++ pkgs) []- if repopkgs /= pkgs+ if not (null (pkgs \\ repopkgs)) then when hard $ error $ unwords (pkgs \\ repopkgs) +-+ "not available."@@ -128,6 +139,7 @@ havesudo <- optionalProgram "sudo" return $ if havesudo then Just "sudo" else Nothing requireProgram "yum"+ -- FIXME: just install repopkgs? let args = map showPkg pkgs putStrLn $ "Running:" +-+ fromMaybe "" maybeSudo +-+ "yum install" +-+ unwords args let exec = if hard then cmd_ else trySystem