fedora-haskell-tools 0.7 → 0.8
raw patch · 12 files changed
+171/−93 lines, 12 filesdep ~simple-cmddep ~simple-cmd-args
Dependency ranges changed: simple-cmd, simple-cmd-args
Files
- ChangeLog +11/−0
- README.md +3/−0
- TODO +1/−0
- fedora-haskell-tools.cabal +7/−6
- fhmock.hs +2/−2
- fhpkg.hs +66/−45
- src/Build.hs +12/−12
- src/Dist.hs +32/−0
- src/Koji.hs +35/−9
- src/Options.hs +0/−10
- src/RPM.hs +2/−1
- src/Utils.hs +0/−8
ChangeLog view
@@ -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
README.md view
@@ -27,3 +27,6 @@ ## fhbz Update version update bugs in Bugzilla for Haskell packages.++## fhmock+Tool for standalone mock chroots for building and development.
TODO view
@@ -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?
fedora-haskell-tools.cabal view
@@ -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
fhmock.hs view
@@ -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
fhpkg.hs view
@@ -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
src/Build.hs view
@@ -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 ""
+ src/Dist.hs view
@@ -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
src/Koji.hs view
@@ -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
− src/Options.hs
@@ -1,10 +0,0 @@-module Options- (distArg)- where--import FedoraDists-import Options.Applicative--distArg :: Parser Dist-distArg = argument auto (metavar "DIST")-
src/RPM.hs view
@@ -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
src/Utils.hs view
@@ -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