diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +* 0.4 (2017-12-05) +- new commands: clone-new, diff-stackage, diff-branch +- fix hackage distro data output +- check spec file exists +- fix cloning of missing branch dirs +- allow no dist arg before pkg arg + * 0.3 (2017-10-24) - initial release with fhbuild, fhbz, and fhpkg diff --git a/Dists.hs b/Dists.hs --- a/Dists.hs +++ b/Dists.hs @@ -23,6 +23,7 @@ distTarget, distUpdates, distOverride, + hackageRelease, releaseVersion, rawhide) where @@ -37,6 +38,9 @@ rawhide :: String rawhide = "f28" +hackageRelease :: String +hackageRelease = "f27" + distBranch :: Dist -> String distBranch d | d == rawhide = "master" | otherwise = d @@ -73,6 +77,5 @@ | otherwise = Nothing releaseVersion :: Dist -> String -releaseVersion "epel7" = "7" -releaseVersion r | head r == 'f' = tail r -releaseVersion _ = error "Unknown release" +releaseVersion r | r == rawhide = "rawhide" +releaseVersion r = distVersion r diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,7 @@ [![Build Status](https://travis-ci.org/fedora-haskell/fedora-haskell-tools.png)](https://travis-ci.org/fedora-haskell/fedora-haskell-tools) +[![Hackage](http://img.shields.io/hackage/v/fedora-haskell-tools.png)](http://hackage.haskell.org/package/fedora-haskell-tools) +[![Stackage LTS](http://stackage.org/package/fedora-haskell-tools/badge/lts)](http://stackage.org/lts/package/fedora-haskell-tools) +[![Stackage Nightly](http://stackage.org/package/fedora-haskell-tools/badge/nightly)](http://stackage.org/nightly/package/fedora-haskell-tools) # Fedora Haskell Tools diff --git a/RPM.hs b/RPM.hs --- a/RPM.hs +++ b/RPM.hs @@ -14,7 +14,8 @@ module RPM (packageManager, repoquery, repoquerySrc, - rpmInstall) where + rpmInstall, + rpmspec) where import Control.Monad (unless, when) import Data.List (elemIndices) @@ -24,7 +25,7 @@ import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) -import Utils (cmdStdErr, singleLine, sudo) +import Utils (cmd, cmdStdErr, singleLine, sudo) -- @since base 4.8.0.0 die :: String -> IO a @@ -63,8 +64,8 @@ repoqWrap prog (subcmd ++ args ++ [key]) repoqWrap :: String -> [String] -> IO String -repoqWrap cmd args = do - (out, err) <- cmdStdErr cmd args +repoqWrap c args = do + (out, err) <- cmdStdErr c args -- workaround noisy dnf2 repoquery --quiet -- ignore "Last metadata expiration check" warnings unless (null err || head (words err) == "Last") $ @@ -87,3 +88,8 @@ where dashes = elemIndices '-' nvr nameDash = last $ init dashes + +rpmspec :: [String] -> Maybe String -> FilePath -> IO String +rpmspec args mqf spec = do + let qf = maybe [] (\ q -> ["--queryformat", q]) mqf + cmd "rpmspec" (["-q"] ++ args ++ qf ++ [spec]) diff --git a/Utils.hs b/Utils.hs --- a/Utils.hs +++ b/Utils.hs @@ -25,6 +25,12 @@ import System.Exit (ExitCode (..)) import System.Process (readProcess, readProcessWithExitCode, rawSystem) +#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3)) +#else +import Control.Exception (bracket) +import System.Directory ( getCurrentDirectory, setCurrentDirectory) +#endif + infixr 4 +-+ (+-+) :: String -> String -> String "" +-+ s = s @@ -112,6 +118,10 @@ removePrefix prefix orig = fromMaybe (error prefix +-+ "is not prefix of" +-+ orig) $ stripPrefix prefix orig +maybeRemovePrefix :: String -> String -> String +maybeRemovePrefix prefix orig = + fromMaybe orig $ stripPrefix prefix orig + removeSuffix :: String -> String -> String removeSuffix suffix orig = fromMaybe orig $ stripSuffix suffix orig @@ -123,4 +133,13 @@ error_ = errorWithoutStackTrace #else error_ = error +#endif + +#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3)) +#else +withCurrentDirectory :: FilePath -> IO a -> IO a +withCurrentDirectory dir action = + bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do + setCurrentDirectory dir + action #endif diff --git a/fedora-haskell-tools.cabal b/fedora-haskell-tools.cabal --- a/fedora-haskell-tools.cabal +++ b/fedora-haskell-tools.cabal @@ -1,8 +1,8 @@ Name: fedora-haskell-tools -Version: 0.3 -Synopsis: Building and tracking tools for Fedora Haskell +Version: 0.4 +Synopsis: Building and managing tools for Fedora Haskell Description: - Tools for recursive building of Fedora Haskell packages. + Tools for building and managing Fedora Haskell packages. Homepage: https://github.com/fedora-haskell/fedora-haskell-tools Bug-reports: https://github.com/fedora-haskell/fedora-haskell-tools/issues License: GPL-3 @@ -37,6 +37,7 @@ Main-is: fhbz.hs Build-depends: base < 5, time + Other-modules: Utils GHC-options: -fwarn-missing-signatures -Wall Extensions: CPP diff --git a/fhbuild.hs b/fhbuild.hs --- a/fhbuild.hs +++ b/fhbuild.hs @@ -31,7 +31,7 @@ import Dists (Dist, dists, distBranch, distOverride, distTag, distTarget) import Koji (kojiBuilding, kojiLatestPkg, kojiWaitPkg, notInKoji) -import RPM (packageManager, rpmInstall, repoquery, repoquerySrc) +import RPM (packageManager, rpmInstall, repoquery, repoquerySrc, rpmspec) import Utils ((+-+), cmd, cmd_, cmdBool, cmdMaybe, cmdlog, error_, logMsg, removePrefix, removeSuffix, sudo) @@ -162,8 +162,8 @@ putStrLn $ "To watch: tail -f" +-+ wd logfile -- note "fedpkg --path dir local" saves .build.log in cwd _out <- cmd "fedpkg" ["local"] - opkgs <- lines <$> cmd "rpmspec" ["-q", "--queryformat", "%{name}\n", spec] - rpms <- lines <$> cmd "rpmspec" ["-q", "--queryformat", "%{arch}/%{name}-%{version}-" ++ release ++ ".%{arch}.rpm\n", spec] + opkgs <- lines <$> rpmspec [] (Just "%{name}\n") spec + rpms <- lines <$> rpmspec [] (Just ("%{arch}/%{name}-%{version}-" ++ release ++ ".%{arch}.rpm\n")) spec built <- and <$> mapM doesFileExist rpms if built then do @@ -324,7 +324,7 @@ buildRequires :: FilePath -> IO [String] buildRequires spec = - (map (head . words) . lines) <$> cmd "rpmspec" ["-q", "--buildrequires", spec] >>= mapM whatProvides + (map (head . words) . lines) <$> rpmspec ["--buildrequires"] Nothing spec >>= mapM whatProvides derefSrcPkg :: String -> IO (Maybe String) derefSrcPkg pkg = do diff --git a/fhpkg.hs b/fhpkg.hs --- a/fhpkg.hs +++ b/fhpkg.hs @@ -26,64 +26,97 @@ #else import Control.Applicative ((<$>)) #endif -import Control.Exception (bracket) import Control.Monad (unless, when) import Data.Maybe -import Data.List (isPrefixOf, nub, sort, (\\)) +import Data.List (isInfixOf, isPrefixOf, nub, sort, (\\)) import System.Directory (doesDirectoryExist, doesFileExist, - getCurrentDirectory, setCurrentDirectory) + setCurrentDirectory, +#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3)) + withCurrentDirectory +#endif + ) import System.Environment (getArgs, getProgName) import System.Exit (ExitCode (..), exitWith) import System.FilePath (()) import System.IO (hPutStrLn, stderr) --import System.Posix.Env (getEnv) -import Dists (Dist, dists, distBranch, releaseVersion) +import Dists (Dist, dists, distBranch, hackageRelease, releaseVersion) import Koji (kojiListPkgs) -import Utils ((+-+), cmd, cmd_, cmdBool, removePrefix) +import RPM (rpmspec) +import Utils ((+-+), cmd, cmd_, cmdBool, cmdMaybe, maybeRemovePrefix, + removePrefix, +#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3)) +#else + withCurrentDirectory +#endif + ) main :: IO () main = do margs <- getArgs >>= parseArgs case margs of Nothing -> return () - Just (com, mdist, pkgs) -> do - ps <- if null pkgs then repoqueryHaskell False mdist else return pkgs + Just (com, mdist, pkgs) -> case com of - "list" -> mapM_ putStrLn ps - "count" -> print $ length ps + "list" -> withPackages mdist pkgs (mapM_ putStrLn) + "count" -> withPackages mdist pkgs (print . length) "hackage" -> do - unless (mdist == Just "f27") $ error "Hackage is currently for F27!" - repoqueryHackageCSV mdist ps - "clone" -> do - new <- newPackages mdist ps - repoAction True mdist (new ++ ps) (return ()) - "pull" -> repoAction True mdist ps (cmd_ "git" ["pull", "--rebase"]) - "diff" -> repoAction True mdist ps (cmd_ "git" ["diff"]) - "verrel" -> repoAction False mdist ps (cmd_ "fedpkg" ["verrel"]) - "subpkgs" -> repoAction True mdist ps (cmd "fedpkg" ["gimmespec"] >>= \ p -> cmd_ "rpmspec" ["-q", "--qf", "%{name}-%{version}\n", p]) - "new" -> newPackages mdist ps >>= mapM_ putStrLn + let currentHackage = Just hackageRelease + unless (isNothing mdist || mdist == currentHackage) $ error $ "Hackage is currently for" +-+ fromJust currentHackage ++ "!" + withPackages currentHackage pkgs (repoqueryHackageCSV currentHackage) + "clone" -> withPackages mdist pkgs $ + repoAction_ True False mdist (return ()) + "clone-new" -> do + new <- newPackages mdist + withPackages mdist new $ repoAction_ True False mdist (return ()) + "pull" -> withPackages mdist pkgs $ + repoAction_ True False mdist (cmd_ "git" ["pull", "--rebase"]) + "diff" -> withPackages mdist pkgs $ + repoAction_ True False mdist (cmd_ "git" ["--no-pager", "diff"]) + "diff-branch" -> withPackages mdist pkgs $ + repoAction False True mdist compareRawhide + "diff-stackage" -> withPackages mdist pkgs $ + repoAction True True mdist compareStackage + "verrel" -> withPackages mdist pkgs $ + repoAction_ False True mdist (cmd_ "fedpkg" ["verrel"]) + "subpkgs" -> withPackages mdist pkgs $ + repoAction True True mdist (\ p -> rpmspec [] (Just "%{name}-%{version}") (p ++ ".spec") >>= putStrLn) + "new" -> newPackages mdist >>= mapM_ putStrLn _ -> return () + where + withPackages :: Maybe Dist -> [Package] -> ([Package] -> IO ()) -> IO () + withPackages mdist pkgs act = + (if null pkgs then repoqueryHaskell False mdist else return pkgs) >>= act -commands :: [String] -commands = ["clone", "count", "diff", "hackage", "list", "new", "pull" , "subpkgs", "verrel"] +commands :: [(String, String)] +commands = [("clone", "clone repos"), + ("clone-new", "clone new packages"), + ("count", "count number of packages"), + ("diff", "git diff"), + ("diff-branch","compare branch with master"), + ("diff-stackage","compare with stackage"), + ("hackage", "generate Hackage distro data"), + ("list", "list packages"), + ("new", "new unbuilt packages"), + ("pull", "pull repos"), + ("subpkgs", "list subpackages"), + ("verrel", "show nvr of packages")] +cmds :: [String] +cmds = map fst commands + help :: IO () help = do progName <- getProgName hPutStrLn stderr $ "Usage:" +-+ progName +-+ "CMD [DIST]\n" ++ "\n" ++ "Commands:\n" - ++ " clone\t- clone repos\n" - ++ " pull\t\t- pull repos\n" - ++ " list\t\t- list packages\n" - ++ " count\t\t- count number of packages\n" - ++ " verrel\t\t- show nvr of packages\n" - ++ " subpkgs\t\t- list subpackages\n" - ++ " new\t\t- new unbuilt packages\n" - ++ " hackage\t- generate Hackage distro date\n" + mapM_ (putStrLn . (\(c, desc) -> " " ++ c ++ replicate (mx - length c) ' ' +-+ "-" +-+ desc)) commands exitWith (ExitFailure 1) + where + mx = maximum $ map length cmds type Package = String @@ -91,13 +124,13 @@ parseArgs :: [String] -> IO Arguments parseArgs [c] = - if c `elem` commands + if c `elem` cmds then return (Just (c, Nothing, [])) else giveUp $ "No such command '" ++ c ++ "'" -parseArgs (c:dist:pkgs) | dist `notElem` dists = - giveUp $ "Unknown dist '" ++ dist ++ "'" - | c `notElem` commands = +parseArgs (c:dist:pkgs) | c `notElem` cmds = giveUp $ "No such command '" ++ c ++ "'" + | dist `notElem` dists = + return $ Just (c, Nothing, dist:pkgs) | otherwise = return $ Just (c, Just dist, pkgs) parseArgs _ = help >> return Nothing @@ -119,7 +152,7 @@ repoqueryHackageCSV mdist pkgs = do let relver = maybe "rawhide" releaseVersion mdist -- Hackage csv chokes on final newline so remove it - init . unlines . map (replace "\"ghc-" "\"") . lines <$> cmd "dnf" (["repoquery", "--quiet", "--releasever=" ++ relver, "-q", "--qf=\"%{name}\",\"%{version}\",\"https://apps.fedoraproject.org/packages/%{name}\""] ++ pkgs) >>= putStr + init . unlines . sort . map (replace "\"ghc-" "\"") . lines <$> cmd "dnf" (["repoquery", "--quiet", "--releasever=" ++ relver, "--latest-limit=1", "-q", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{name}\""] ++ pkgs) >>= putStr replace :: Eq a => [a] -> [a] -> [a] -> [a] replace a b s@(x:xs) = @@ -139,15 +172,16 @@ when (null bin) $ error "No libHSbase consumers found!" return $ sort $ nub bin -newPackages :: Maybe Dist -> [Package] -> IO [Package] -newPackages mdist ps = do +newPackages :: Maybe Dist -> IO [Package] +newPackages mdist = do + ps <- repoqueryHaskell True mdist kps <- kojiListHaskell True mdist return $ kps \\ ps -repoAction :: Bool -> Maybe Dist -> [Package] -> IO () -> IO () -repoAction _ _ [] _ = return () -repoAction header mdist (pkg:rest) action = do - bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do +repoAction :: Bool -> Bool -> Maybe Dist -> (Package -> IO ()) -> [Package] -> IO () +repoAction _ _ _ _ [] = return () +repoAction header needsSpec mdist action (pkg:rest) = do + withCurrentDirectory "." $ do let branchGiven = isJust mdist branch = maybe "master" distBranch mdist when header $ @@ -157,6 +191,12 @@ dirExists <- doesDirectoryExist pkg unless dirExists $ cmd_ "fedpkg" $ ["clone"] ++ (if branchGiven then ["-b", branch] else ["-B"]) ++ [pkg] + singleDir <- doesFileExist $ pkg ".git/config" + unless singleDir $ do + branchDir <- doesDirectoryExist $ pkg branch + unless branchDir $ + withCurrentDirectory pkg $ + cmd_ "fedpkg" ["clone", "-b", branch, pkg, branch] wd <- pkgDir pkg branch "" setCurrentDirectory wd pkggit <- do @@ -175,9 +215,14 @@ let spec = pkg ++ ".spec" hasSpec <- doesFileExist spec unless hasSpec $ putStrLn "No spec file!" - action - repoAction header mdist rest action + unless (needsSpec && not hasSpec) $ + action pkg + repoAction header needsSpec mdist action rest +repoAction_ :: Bool -> Bool -> Maybe Dist -> IO () -> [Package] -> IO () +repoAction_ header needsSpec mdist action = + repoAction header needsSpec mdist (const action) + pkgDir :: String -> String -> FilePath -> IO FilePath pkgDir dir branch top = do b <- doesDirectoryExist $ top dir branch @@ -187,3 +232,23 @@ gitBranch = (removePrefix "* " . head . filter (isPrefixOf "* ") . lines) <$> cmd "git" ["branch"] +compareStackage :: Package -> IO () +compareStackage p = do + nvr <- cmd "fedpkg" ["verrel"] + stkg <- cmdMaybe "stackage" ["package", "lts", maybeRemovePrefix "ghc-" p] + let same = isJust stkg && fromJust stkg `isInfixOf` nvr + putStrLn $ removePrefix (p ++ "-") nvr +-+ "(fedora)" + putStrLn $ (if same then "same" else fromMaybe "none" stkg) +-+ "(lts)" + + +compareRawhide :: Package -> IO () +compareRawhide p = do + nvr <- rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") (p ++ ".spec") + nvr' <- withCurrentDirectory "../master" $ + rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") (p ++ ".spec") + when (removeDisttag nvr /= removeDisttag nvr') $ do + putStrLn nvr + putStrLn nvr' + putStrLn "" + where + removeDisttag = reverse . tail . dropWhile (/= '.') . reverse