diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -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 diff --git a/cabal-rpm.cabal b/cabal-rpm.cabal --- a/cabal-rpm.cabal +++ b/cabal-rpm.cabal @@ -1,5 +1,5 @@ Name: cabal-rpm -Version: 0.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 diff --git a/src/Commands/Depends.hs b/src/Commands/Depends.hs --- a/src/Commands/Depends.hs +++ b/src/Commands/Depends.hs @@ -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) diff --git a/src/Commands/Diff.hs b/src/Commands/Diff.hs --- a/src/Commands/Diff.hs +++ b/src/Commands/Diff.hs @@ -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 diff --git a/src/Commands/Install.hs b/src/Commands/Install.hs --- a/src/Commands/Install.hs +++ b/src/Commands/Install.hs @@ -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] diff --git a/src/Commands/RpmBuild.hs b/src/Commands/RpmBuild.hs --- a/src/Commands/RpmBuild.hs +++ b/src/Commands/RpmBuild.hs @@ -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 diff --git a/src/Commands/Spec.hs b/src/Commands/Spec.hs --- a/src/Commands/Spec.hs +++ b/src/Commands/Spec.hs @@ -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 diff --git a/src/Dependencies.hs b/src/Dependencies.hs --- a/src/Dependencies.hs +++ b/src/Dependencies.hs @@ -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 "" = "" diff --git a/src/PackageUtils.hs b/src/PackageUtils.hs --- a/src/PackageUtils.hs +++ b/src/PackageUtils.hs @@ -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 diff --git a/src/Setup.hs b/src/Setup.hs --- a/src/Setup.hs +++ b/src/Setup.hs @@ -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" diff --git a/src/SysCmd.hs b/src/SysCmd.hs --- a/src/SysCmd.hs +++ b/src/SysCmd.hs @@ -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