diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +* 0.8 (2019-04-26) +- remaining --counting option +- make kojiWatchTask safe by checking taskinfo status +- move distTag and distTarget from fedora-dists to Dist +- use eqNVR to avoid trivial Rawhide rebuilds after branching +- repoquery --refresh option for hackage and hackage-compare +- change Hackage distro urls back to Fedora Packages app +- output git diff before building package in koji (to show dirty) +- use simple-cmd-opts-0.1.1 option wrappers +- fix Hackage data generation repoqueries + * 0.7 (2019-02-28) - merge fhbuild into fhpkg (please delete fhbuild) - use simple-cmd and fedora-dists diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -27,3 +27,6 @@ ## fhbz Update version update bugs in Bugzilla for Haskell packages. + +## fhmock +Tool for standalone mock chroots for building and development. diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -4,6 +4,7 @@ - use optparse-applicative - only print header if output - license-check command +* use pagure-cli to get new ghc-* packages (from fhpkg.hs): - cache dist package lists? diff --git a/fedora-haskell-tools.cabal b/fedora-haskell-tools.cabal --- a/fedora-haskell-tools.cabal +++ b/fedora-haskell-tools.cabal @@ -1,5 +1,5 @@ Name: fedora-haskell-tools -Version: 0.7 +Version: 0.8 Synopsis: Building and maintenance tools for Fedora Haskell Description: Tools for building and managing Fedora Haskell packages. @@ -15,7 +15,7 @@ Extra-source-files: README.md TODO ChangeLog Cabal-version: >=1.6 Tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, - GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 + GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.4 source-repository head type: git @@ -30,12 +30,13 @@ filepath, HTTP, process, - simple-cmd >= 0.1.1, + simple-cmd >= 0.1.4, + simple-cmd-args >= 0.1.1, split, time < 1.9, unix Hs-Source-Dirs: src, . - Other-modules: Build, Koji, Options, Paths_fedora_haskell_tools, Utils + Other-modules: Build, Dist, Koji, Paths_fedora_haskell_tools, Utils RPM GHC-options: -fwarn-missing-signatures -Wall Extensions: CPP @@ -46,7 +47,7 @@ fedora-dists, time Hs-Source-Dirs: src, . - Other-modules: Koji, RPM + Other-modules: Dist, Koji, RPM GHC-options: -fwarn-missing-signatures -Wall Extensions: CPP @@ -60,6 +61,6 @@ if impl(ghc<8.0) Build-depends: semigroups Hs-Source-Dirs: src, . - Other-modules: Options, Paths_fedora_haskell_tools + Other-modules: Dist, Paths_fedora_haskell_tools GHC-options: -fwarn-missing-signatures -Wall Extensions: CPP diff --git a/fhmock.hs b/fhmock.hs --- a/fhmock.hs +++ b/fhmock.hs @@ -14,10 +14,10 @@ import Data.List (sort) import System.Environment (getArgs) -import FedoraDists -import Options (distArg) +import Dist (distArg) import Paths_fedora_haskell_tools (version) +import FedoraDists (Dist, distRepo, releaseVersion) import SimpleCmd (cmd_) import SimpleCmdArgs import Options.Applicative diff --git a/fhpkg.hs b/fhpkg.hs --- a/fhpkg.hs +++ b/fhpkg.hs @@ -26,7 +26,7 @@ import Data.List.Split (splitOn) import Network.HTTP (getRequest, getResponseBody, simpleHTTP) -import Options.Applicative (Parser, auto, flag', option, switch, strOption) +import Options.Applicative (Parser, auto, flag') import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, getHomeDirectory, #if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5)) @@ -49,8 +49,8 @@ import SimpleCmdArgs import Build (build, readBuildCmd) +import Dist (distArg, distRemote) import Koji (kojiListPkgs, rpkg) -import Options (distArg) import Paths_fedora_haskell_tools (version) import RPM (buildRequires, haskellSrcPkgs, Package, pkgDir, repoquery, rpmspec) @@ -72,7 +72,7 @@ "Fedora packages maintenance tool" $ subcommands $ [ Subcommand "bump" "bump package release" $ - bump <$> strOption (optionMods 'm' "message" "CHANGELOG" "changelog message") <*> distArg <*> pkgArgs + bump <$> strOptionWith 'm' "message" "CHANGELOG" "changelog message" <*> distArg <*> pkgArgs , Subcommand "checkout" "fedpkg switch-branch" $ repoAction_ True False (return ()) <$> distArg <*> pkgArgs , Subcommand "clone" "clone repos" $ @@ -80,30 +80,30 @@ , Subcommand "clone-new" "clone new packages" $ cloneNew <$> branching <*> distArg , Subcommand "cmd" "arbitrary command (with args)" $ - execCmd <$> strOption (optionMods 'c' "cmd" "CMD" "command to execute") <*> distArg <*> pkgArgs + execCmd <$> strOptionWith 'c' "cmd" "CMD" "command to execute" <*> distArg <*> pkgArgs , Subcommand "count" "count number of packages" $ - (repoqueryHaskell False >=> (print . length)) <$> distArg + (repoqueryHaskellPkgs False >=> (print . length)) <$> distArg , Subcommand "diff" "git diff" $ gitDiff <$> optional gitFormat - <*> optional (strOption (optionMods 'w' "with-branch" "BRANCH" "Branch to compare")) + <*> optional (strOptionWith 'w' "with-branch" "BRANCH" "Branch to compare") <*> distArg <*> pkgArgs , Subcommand "diff-origin" "git diff origin" $ gitDiffOrigin <$> distArg <*> pkgArgs , Subcommand "diff-branch" "compare branch with master" $ repoAction False True compareRawhide <$> distArg <*> pkgArgs , Subcommand "diff-stackage" "compare with stackage" $ - diffStackage <$> switch (switchMods 'm' "missing" "only list missing packages") <*> distArg <*> pkgArgs + diffStackage <$> switchWith 'm' "missing" "only list missing packages" <*> distArg <*> pkgArgs , Subcommand "hackage" "generate Hackage distro data" $ - pure $ repoqueryHackageCSV hackageRelease + repoqueryHackageCSV hackageRelease <$> switchRefresh , Subcommand "hackage-compare" "compare with Hackage distro data" $ - pure hackageCompare + hackageCompare <$> switchRefresh , Subcommand "head-origin" "head in sync with origin" $ headOrigin <$> distArg <*> pkgArgs , Subcommand "leaf" "list leaf packages" $ - leaves <$> switch (switchMods 'v' "deps" "show also deps") <*> distArg <*> pkgArgs + leaves <$> switchWith 'v' "deps" "show also deps" <*> distArg <*> pkgArgs , Subcommand "list" "list packages" $ mapM_ putStrLn <$> pkgArgs , Subcommand "merge" "git merge" $ - merge <$> strOption (optionMods 'f' "from" "BRANCH" "specify branch to merge from") <*> distArg <*> pkgArgs + merge <$> strOptionWith 'f' "from" "BRANCH" "specify branch to merge from" <*> distArg <*> pkgArgs , Subcommand "missing" "missing dependency source packages" $ missingDeps <$> distArg <*> pkgArgs , Subcommand "new" "new unbuilt packages" $ @@ -113,23 +113,23 @@ , Subcommand "prep" "fedpkg prep" $ prep <$> distArg <*> pkgArgs , Subcommand "commit" "fedpkg commit" $ - commit <$> strOption (optionMods 'm' "message" "COMMITMSG" "commit message") <*> distArg <*> pkgArgs + commit <$> strOptionWith 'm' "message" "COMMITMSG" "commit message" <*> distArg <*> pkgArgs , Subcommand "pull" "git pull repos" $ repoAction_ True False (git_ "pull" ["--rebase"]) <$> distArg <*> pkgArgs , Subcommand "push" "git push repos" $ repoAction_ True False (git_ "push" []) <$> distArg <*> pkgArgs , Subcommand "refresh" "cabal-rpm refresh" $ - repoAction True True refresh <$> distArg <*> pkgArgs + repoAction True True refreshPkg <$> distArg <*> pkgArgs , Subcommand "remaining" "remaining packages to be built in TAG" $ - remaining <$> strArg "TAG" <*> pkgArgs + remaining <$> switchWith 'c' "count" "show many packages left" <*> strArg "TAG" <*> pkgArgs , Subcommand "unpushed" "show unpushed commits" $ - unpushed <$> switch (switchMods 's' "short" "no log") <*> distArg <*> pkgArgs + unpushed <$> switchWith 's' "short" "no log" <*> distArg <*> pkgArgs , Subcommand "update" "cabal-rpm update" $ - update <$> strOption (optionMods 's' "stream" "STACKAGESTREAM" "Stackage stream (lts-X)") <*> distArg <*> pkgArgs + update <$> strOptionWith 's' "stream" "STACKAGESTREAM" "Stackage stream (lts-X)" <*> distArg <*> pkgArgs , Subcommand "subpkgs" "list subpackages" $ repoAction True True (\ p -> rpmspec [] (Just "%{name}-%{version}") (p <.> "spec") >>= mapM_ putStrLn) <$> distArg <*> pkgArgs , Subcommand "tagged" "list koji DIST tagged builds" $ - listTagged_ <$> switch (switchMods 's' "short" "list packages not builds") <*> strArg "TAG" + listTagged_ <$> switchWith 's' "short" "list packages not builds" <*> strArg "TAG" , Subcommand "verrel" "show nvr of packages" $ verrel <$> distArg <*> pkgArgs] ++ map (buildCmd cwd) [ ("install", "build locally and install") @@ -145,17 +145,19 @@ where pkgArgs = some (strArg "PKG...") - branching = switch (switchMods 'B' "branches" "clone branch dirs (fedpkg clone -B)") + branching = switchWith 'B' "branches" "clone branch dirs (fedpkg clone -B)" gitFormat :: Parser DiffFormat gitFormat = flag' DiffShort (switchMods 's' "short" "Just output package name") <|> - DiffContext <$> option auto (optionMods 'u' "unified" "CONTEXT" "Lines of context") + DiffContext <$> optionWith auto 'u' "unified" "CONTEXT" "Lines of context" buildCmd cwd (c, desc) = Subcommand c desc $ build cwd Nothing Nothing False (readBuildCmd c) <$> distArg <*> pkgArgs + switchRefresh = switchWith 'r' "refresh" "repoquery --refresh" + data DiffFormat = DiffShort | DiffContext Int deriving (Eq) @@ -200,7 +202,7 @@ gitDiffOrigin :: Dist -> [Package] -> IO () gitDiffOrigin dist = - repoAction_ True False (git_ "diff" ["origin/" ++ show dist]) dist + repoAction_ True False (git_ "diff" [distRemote dist]) dist diffStackage :: Bool -> Dist -> [Package] -> IO () diffStackage missingOnly dist = @@ -218,26 +220,26 @@ else putStrLn $ (if same then "same" else fromMaybe "none" stkg) +-+ "(" ++ stream ++ ")" -hackageCompare :: IO () -hackageCompare = - repoqueryHaskell False hackageRelease >>= +hackageCompare :: Bool -> IO () +hackageCompare refresh = + repoqueryHackages hackageRelease >>= compareHackage hackageRelease where compareHackage :: Dist -> [Package] -> IO () compareHackage dist pkgs' = do hck <- simpleHTTP (getRequest "http://hackage.haskell.org/distro/Fedora/packages.csv") >>= getResponseBody let hackage = sort . either (error "Malformed Hackage csv") (map mungeHackage) $ parseCSV "packages.csv" hck - fedora <- sort . map mungeRepo . lines <$> repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=%{name},%{version}"] ++ pkgs') - compareSets True hackage fedora + sort . map mungeRepo . lines <$> repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=%{name},%{version}"] ++ ["--refresh" | refresh] ++ pkgs') >>= + compareSets True hackage mungeHackage :: [String] -> PkgVer - mungeHackage [_,v,u] = PV (takeFileName u) v + mungeHackage [n,v,_] = PV n v mungeHackage _ = error "Malformed Hackage csv" mungeRepo :: String -> PkgVer mungeRepo s | ',' `elem` s = let (p,v) = break (== ',') s in - PV p (tail v) + PV (removePrefix "ghc-" p) (tail v) | otherwise = error "Malformed repoquery output" compareSets :: Bool -> [PkgVer] -> [PkgVer] -> IO () @@ -266,7 +268,7 @@ gitHeadAtOrigin :: Package -> IO () gitHeadAtOrigin pkg = do -- use gitDiffQuiet - same <- cmdBool "git" ["diff", "--quiet", "origin/" ++ show dist ++ "..HEAD"] + same <- cmdBool "git" ["diff", "--quiet", distRemote dist ++ "..HEAD"] when same $ putStrLn pkg leaves :: Bool -> Dist -> [Package] -> IO () @@ -324,10 +326,9 @@ oldPackages :: Dist -> [Package] -> IO () oldPackages dist pkgs = do - repopkgs <- repoqueryHaskell True dist + repopkgs <- repoqueryHaskellPkgs True dist mapM_ putStrLn (pkgs \\ repopkgs) - prep :: Dist -> [Package] -> IO () prep dist = repoAction_ True True (cmd_ (rpkg dist) ["prep"]) dist @@ -350,7 +351,7 @@ where gitLogOneLine :: Package -> IO () gitLogOneLine pkg = do - out <- git "log" ["origin/" ++ show dist ++ "..HEAD", "--pretty=oneline"] + out <- git "log" [distRemote dist ++ "..HEAD", "--pretty=oneline"] unless (null out) $ putStrLn $ pkg ++ if nolog then "" else (unwords . map replaceHash . words) out where @@ -360,11 +361,11 @@ verrel dist = repoAction_ False True (cmd_ (rpkg dist) ["verrel"]) dist -repoqueryHackageCSV :: Dist -> IO () -repoqueryHackageCSV dist = do - pkgs <- repoqueryHaskell False dist +repoqueryHackageCSV :: Dist -> Bool -> IO () +repoqueryHackageCSV dist refresh = do + pkgs <- repoqueryHackages dist -- Hackage csv chokes on final newline so remove it - init . unlines . sort . map (replace "\"ghc-" "\"") . lines <$> repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{name}\""] ++ pkgs) >>= putStr + init . unlines . sort . map (replace "\"ghc-" "\"") . lines <$> repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=\"%{name}\",\"%{version}\",\"https://apps.fedoraproject.org/packages/%{source_name}\""] ++ ["--refresh" | refresh] ++ pkgs) >>= putStr data PkgVer = PV { pvPkg :: String, pvVer :: String} deriving (Eq) @@ -384,18 +385,35 @@ else x:replace a b xs replace _ _ [] = [] -repoqueryHaskell :: Bool -> Dist -> IO [Package] -repoqueryHaskell verbose dist = do +repoqueryHaskellPkgs :: Bool -> Dist -> IO [Package] +repoqueryHaskellPkgs verbose dist = do when verbose $ putStrLn "Getting packages from repoquery" let repo = distRepo dist updates = maybeToList $ distUpdates dist - bin <- words <$> repoquery dist (["--repo=" ++ repo] ++ ["--repo=" ++ u | u <- updates] ++ ["--qf=%{source_name}", "--whatrequires", "libHSbase-*-ghc*.so()(64bit)"]) - when (null bin) $ error "No libHSbase consumers found!" + bin <- words <$> repoquery dist (["--repo=" ++ repo ++ "-source"] ++ ["--repo=" ++ u ++ "-source" | u <- updates] ++ ["--qf=%{name}", "--whatrequires", "ghc-Cabal-devel"]) + when (null bin) $ error "No packages using ghc-Cabal-devel found!" return $ sort $ nub bin +repoqueryHackages :: Dist -> IO [Package] +repoqueryHackages dist = do + srcs <- repoqueryHaskellPkgs False dist + libs <- repoqueryHaskellLibs False + let binsrcs = filter (not . ("ghc-" `isPrefixOf`)) srcs + sublibs = libs \\ map ("ghc-" ++) binsrcs + return $ sort $ nub (srcs ++ sublibs) + where + repoqueryHaskellLibs :: Bool -> IO [Package] + repoqueryHaskellLibs verbose = do + when verbose $ putStrLn "Getting libraries from repoquery" + let repo = distRepo dist + updates = maybeToList $ distUpdates dist + bin <- words <$> repoquery dist (["--repo=" ++ repo] ++ ["--repo=" ++ u | u <- updates] ++ ["--qf=%{name}", "--whatprovides", "libHS*-ghc*.so()(64bit)"]) + when (null bin) $ error "No libHS*.so providers found!" + return $ sort $ nub bin + newPackages :: Dist -> IO [Package] newPackages dist = do - ps <- repoqueryHaskell True dist + ps <- repoqueryHaskellPkgs True dist kps <- kojiListHaskell True dist return $ kps \\ ps @@ -508,8 +526,8 @@ then cmd_ "cabal-rpm" ["update", "-s", stream] else putStrLn "skipping since not hackage" -refresh :: Package -> IO () -refresh pkg = do +refreshPkg :: Package -> IO () +refreshPkg pkg = do hckg <- isFromHackage pkg if hckg then cmd_ "cabal-rpm" ["refresh"] @@ -529,7 +547,10 @@ let parts = splitOn "-" nvr in intercalate "-" $ take (length parts - 2) parts -remaining :: String -> [Package] -> IO () -remaining tag pkgs = do +remaining :: Bool -> String -> [Package] -> IO () +remaining count tag pkgs = do built <- listTagged True tag - cmd_ "rpmbuild-order" $ ["sort", "-p"] ++ (pkgs \\ built) + let left = pkgs \\ built + if count + then print $ length left + else cmd_ "rpmbuild-order" $ ["sort", "-p"] ++ left diff --git a/src/Build.hs b/src/Build.hs --- a/src/Build.hs +++ b/src/Build.hs @@ -36,7 +36,7 @@ notInKoji, rpkg, rpkgBuild) import RPM (buildRequires, derefSrcPkg, haskellSrcPkgs, Package, packageManager, pkgDir, rpmInstall, rpmspec) -import SimpleCmd ((+-+), cmd, cmd_, cmdBool, cmdLines, cmdMaybe, cmdlog, +import SimpleCmd ((+-+), cmd, cmd_, cmdBool, cmdLines, cmdLog, cmdMaybe, cmdSilent, grep_, removeStrictPrefix, sudo) import SimpleCmd.Git (git_, gitBranch, isGitDir) import Utils (checkPkgsGit) @@ -160,19 +160,20 @@ build topdir Nothing Nothing False Install dist rest Mock -> do putStrLn $ "Mock building" +-+ nvr - cmdlog (rpkg dist) ["mockbuild"] + cmdLog (rpkg dist) ["mockbuild"] build topdir Nothing Nothing False Mock dist rest Koji -> do unless (null rest) $ do putStrLn $ show (length rest) +-+ "more packages" putStrLn "" latest <- kojiLatestPkg dist pkg - if Just nvr == latest + if eqNVR nvr latest then do - putStrLn $ nvr +-+ "already built!" + putStrLn $ fromJust latest +-+ "already built!" kojiWaitPkg topdir dist nvr build topdir Nothing mlast False Koji dist rest else do + git_ "diff" [] building <- kojiBuilding pkg nvr dist if building then do @@ -184,18 +185,16 @@ Nothing -> return () Just (pkg', nvr') -> do dep <- dependent pkg' pkg branch topdir - when dep $ do - putStrLn $ "Waiting for" +-+ nvr' + when dep $ kojiWaitPkg topdir dist nvr' showChange pkg latest nvr putStrLn "" git_ "push" [] - rpkgBuild topdir dist Nothing nvr waitrepo + rpkgBuild topdir dist nvr waitrepo bodhiOverride dist nvr unless (null rest) $ do dep <- dependent pkg (head rest) branch topdir - when dep $ do - putStrLn $ "Waiting for" +-+ nvr + when dep $ kojiWaitPkg topdir dist nvr build topdir Nothing (if dep then Just (pkg, nvr) else Nothing) False Koji dist rest Pending -> do @@ -230,13 +229,14 @@ latest <- if fhbuilt then return $ Just nvr else kojiLatestPkg dist pkg - if Just nvr == latest + if eqNVR nvr latest then do - putStrLn $ nvr +-+ "already built!" + putStrLn $ fromJust latest +-+ "already built!" unless (null rest) $ --do --kojiWaitPkg topdir dist nvr build topdir Nothing Nothing False Chain dist rest else do + git_ "diff" [] building <- kojiBuilding pkg nvr dist if building then do @@ -260,7 +260,7 @@ -- note "fedpkg --path dir local" saves .build.log in cwd git_ "push" [] putStrLn "" - rpkgBuild topdir dist Nothing nvr waitrepo + rpkgBuild topdir dist nvr waitrepo bodhiOverride dist nvr unless (null rest) $ do putStrLn "" diff --git a/src/Dist.hs b/src/Dist.hs new file mode 100644 --- /dev/null +++ b/src/Dist.hs @@ -0,0 +1,32 @@ +module Dist + (distArg, + distRemote, + distTag, + distTarget) + where + +import Data.Maybe (fromMaybe) +import FedoraDists (Dist(..), distBranch) +import Options.Applicative + + +-- | Used for Koji sidetag when needed. +sidetag :: Dist -> Maybe String +-- sidetag (Fedora n) | n == 31 = Just "ghc" +sidetag _ = Nothing + +-- | Maps `Dist` to build tag +distTag :: Dist -> String +distTag d = show d ++ "-" ++ fromMaybe "build" (sidetag d) + +-- | Maps `Dist` to target tag +distTarget :: Dist -> String +distTarget d = show d ++ maybe "" ("-" ++) (sidetag d) + +-- | optparse-application DIST arg +distArg :: Parser Dist +distArg = argument auto (metavar "DIST") + +-- | Maps `Dist` to remote branch: eg "origin/master" +distRemote :: Dist -> String +distRemote d = "origin/" ++ distBranch d diff --git a/src/Koji.hs b/src/Koji.hs --- a/src/Koji.hs +++ b/src/Koji.hs @@ -30,8 +30,7 @@ #endif import Control.Concurrent (threadDelay) import Control.Monad (unless, when) -import Data.List (isInfixOf) -import Data.Maybe (fromMaybe) +import Data.List (isInfixOf, isPrefixOf) import Data.Time.Clock (diffUTCTime, getCurrentTime) import System.Directory (doesFileExist) import System.Exit (ExitCode (..)) @@ -39,10 +38,13 @@ import System.IO (hPutStrLn, stderr) import System.Process (readProcessWithExitCode, rawSystem) -import FedoraDists (Dist, distTag, distTarget, kojicmd, rpkg) +import FedoraDists (Dist, kojicmd, rpkg) +import SimpleCmd (cmd, cmd_, cmdBool, cmdLines, grep_, logMsg, + removeStrictPrefix, (+-+)) +import Dist (distTag, distTarget) import RPM (pkgDir) -import SimpleCmd (cmd, cmd_, cmdBool, grep_, logMsg, (+-+)) + kojisafe :: Dist -> String -> [String] -> IO String kojisafe dist c as = cmdFragile (kojicmd dist) (c:as) @@ -95,15 +97,14 @@ kojiListPkgs dist = words <$> cmd (kojicmd dist) ["list-pkgs", "--tag=" ++ distTag dist] -rpkgBuild :: FilePath -> Dist -> Maybe String -> String -> Bool -> IO () -rpkgBuild topdir dist mtarget nvr waitrepo = do +rpkgBuild :: FilePath -> Dist -> String -> Bool -> IO () +rpkgBuild topdir dist nvr waitrepo = do giturl <- cmd (rpkg dist) ["giturl"] - let target = fromMaybe (distTarget dist) mtarget - out <- cmd (kojicmd dist) ["build", "--nowait", "--fail-fast", target, giturl] + out <- cmd (kojicmd dist) ["build", "--nowait", "--fail-fast", distTarget dist, giturl] putStrLn out let task = last . words . head $ lines out start <- getCurrentTime - success <- cmdBool "koji" ["watch-task", task] + success <- kojiWatchTask dist task if success then do logMsg $ nvr ++ " built" @@ -114,6 +115,31 @@ let countdown = 120 - round (diffUTCTime now start) :: Int when (countdown >= 0) $ cmd_ "sleep" [show countdown] + +data TaskState = TaskOpen | TaskFailed | TaskClosed | TaskFree + +kojiWatchTask :: Dist -> String -> IO Bool +kojiWatchTask dist task = do + res <- cmdBool (kojicmd dist) ["watch-task", task] + if res then return True + else do + ti <- kojiTaskInfo + case ti of + TaskClosed -> return True + TaskFailed -> error "Task failed!" + _ -> kojiWatchTask dist task + where + kojiTaskInfo :: IO TaskState + kojiTaskInfo = do + info <- cmdLines (kojicmd dist) ["taskinfo", task] + let state = removeStrictPrefix "State: " <$> filter ("State: " `isPrefixOf`) info + return $ + case state of + ["open"] -> TaskOpen + ["failed"] -> TaskFailed + ["closed"] -> TaskClosed + ["free"] -> TaskFree + _ -> error "unknown task state!" cmdFragile :: String -> [String] -> IO String cmdFragile c as = do diff --git a/src/Options.hs b/src/Options.hs deleted file mode 100644 --- a/src/Options.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Options - (distArg) - where - -import FedoraDists -import Options.Applicative - -distArg :: Parser Dist -distArg = argument auto (metavar "DIST") - diff --git a/src/RPM.hs b/src/RPM.hs --- a/src/RPM.hs +++ b/src/RPM.hs @@ -34,7 +34,8 @@ import System.Exit (ExitCode (..), exitFailure, exitWith) import System.IO (hPutStrLn, stderr) -import FedoraDists (Dist, distBranch, dists, distTag, releaseVersion) +import Dist (distTag) +import FedoraDists (Dist, distBranch, dists, releaseVersion) import SimpleCmd (cmd, removeStrictPrefix, removeSuffix, sudo, (+-+)) import qualified SimpleCmd.Rpm as S diff --git a/src/Utils.hs b/src/Utils.hs --- a/src/Utils.hs +++ b/src/Utils.hs @@ -14,7 +14,6 @@ -- (at your option) any later version. module Utils (checkPkgsGit, - error', withCurrentDirectory) where #if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3)) @@ -37,13 +36,6 @@ -- case ret of -- ExitSuccess -> return (True, out) -- ExitFailure n -> hPutStrLn stderr ("\"" ++ c +-+ unwords as ++ "\"" +-+ "failed with status" +-+ show n ++ "\n" ++ err) >> return (False, out) - -error' :: String -> a -#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,9,0)) -error' = errorWithoutStackTrace -#else -error' = error -#endif #if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3)) #else