diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,19 @@ # Changelog +## 0.8.0 (2021-04-08) +- 'request-repos' can now take branch args and --mock option (#18) +- 'parallel': only override and waitrepo if more layers +- extend dryrun to bodhiCreateOverride, putBugBuild, bodhiUpdate, kojiWaitRepo +- drop the restriction of no packages inside a pkg dir (#19) +- 'switch': drop git clean requirement to prevent error when on branch +- 'parallel': use parallelBranches for single package arg +- 'request-branch': allow request with closed pkg review +- major refactor of branch-package args handling together with branch options +- 'copr': new --list-chroots option for project +- 'command': skip dead.package's +- 'build': clearer bodhi note prompt +- 'install': fix conflicting short options for --recurse and --reinstall + ## 0.7.3 (2021-03-23) - 'scratch': don't get sources for pushed git build - changes/improvements to package header output diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -224,8 +224,6 @@ ## Installation fbrnch is packaged in Fedora: `sudo dnf install fbrnch`. -There is also a [copr repo](https://copr.fedorainfracloud.org/coprs/petersen/fbrnch/). - ## Build from source 1. Install openssl-devel diff --git a/fbrnch.cabal b/fbrnch.cabal --- a/fbrnch.cabal +++ b/fbrnch.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch -version: 0.7.3 +version: 0.8.0 synopsis: Build and create Fedora package repos and branches description: fbrnch is a convenient packaging tool for Fedora Packagers, @@ -90,40 +90,64 @@ Pagure Paths_fbrnch Prompt + -- copr + Web.Fedora.Copr + Web.Fedora.Copr.API + -- fedora-dists + Distribution.Fedora + Distribution.Fedora.Branch + Distribution.Fedora.Products + Distribution.Fedora.ReadProducts + -- koji + Fedora.Koji + Fedora.Koji.Internal + -- pdc + Fedora.PDC + hs-source-dirs: src + libs/copr-hs/src + libs/fedora-dists/src + libs/koji-hs/src + libs/pdc-hs/src default-language: Haskell2010 - build-depends: aeson - , async - , base < 5 - , bodhi-internal - , bugzilla-redhat >= 0.3 - , bytestring - , config-ini - , copr-internal - , directory >= 1.2.3 - , email-validate - , extra - , fedora-dists-internal - -- > 2.0 - , filepath - , http-conduit - , http-directory >= 0.1.5 - , http-query - , koji-internal - , network-uri - , optparse-applicative - , pagure-internal - , pretty-terminal - , process - , rpmbuild-order >= 0.4.2 - , simple-cmd >= 0.2.0 - , simple-cmd-args >= 0.1.6 - , text - , time - , typed-process >= 0.2.4.0 - , utf8-string - , xdg-basedir + build-depends: aeson, + async, + -- pretty-terminal needs 4.9: + base >= 4.9 && < 5, + bodhi-internal, + bugzilla-redhat >= 0.3, + bytestring, + config-ini, + -- copr, + directory >= 1.2.3, + email-validate, + extra, + -- fedora-dists > 2.0, + filepath, + http-conduit, + http-directory >= 0.1.5, + http-query, + -- koji, + network-uri, + optparse-applicative, + pagure-internal, + pretty-terminal, + process, + rpmbuild-order >= 0.4.2, + simple-cmd >= 0.2.0, + simple-cmd-args >= 0.1.6, + text, + time, + typed-process >= 0.2.4.0, + utf8-string, + xdg-basedir, + -- for copr: + unordered-containers, + -- for koji: + haxr >= 3000.11.4, + mtl + if impl(ghc<8.0) build-depends: semigroups @@ -145,12 +169,13 @@ library bodhi-internal - build-depends: aeson - , base >= 4 && < 5 - , http-query - , text - , time - , lens, lens-aeson + build-depends: aeson, + base >= 4 && < 5, + http-query, + text, + time, + lens, + lens-aeson default-language: Haskell2010 default-extensions: OverloadedStrings hs-source-dirs: libs/bodhi-hs/src @@ -168,105 +193,17 @@ ghc-options: -Wmissing-export-lists -Wpartial-fields -library copr-internal - default-language: Haskell2010 - exposed-modules: Web.Fedora.Copr - Web.Fedora.Copr.API - hs-source-dirs: libs/copr-hs/src - build-depends: - base >= 4.7 && <5 - , aeson - , bytestring - , directory - , http-query - , text - , unordered-containers - ghc-options: -Wall - if impl(ghc >= 8.0) - ghc-options: -Wcompat - -Widentities - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wredundant-constraints - if impl(ghc >= 8.2) - ghc-options: -fhide-source-paths - if impl(ghc >= 8.4) - ghc-options: -Wmissing-export-lists - -Wpartial-fields - -library fedora-dists-internal - exposed-modules: Distribution.Fedora - Distribution.Fedora.Branch - other-modules: Distribution.Fedora.Products - Distribution.Fedora.ReadProducts - hs-source-dirs: libs/fedora-dists/src - build-depends: base >= 4.6 && < 5 - , aeson - , bytestring - , directory - , filepath - , pdc-internal - , text - , time - default-language: Haskell2010 - ghc-options: -Wall - if impl(ghc >= 8.0) - ghc-options: -Wcompat - -Widentities - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wredundant-constraints - if impl(ghc >= 8.2) - ghc-options: -fhide-source-paths - if impl(ghc >= 8.4) - ghc-options: -Wmissing-export-lists - -Wpartial-fields - - -library koji-internal - hs-source-dirs: libs/koji-hs/src - exposed-modules: Fedora.Koji - Fedora.Koji.Internal - - build-depends: base >= 4 && < 5 - , haxr >= 3000.11.4 - , mtl - default-language: Haskell2010 - default-extensions: OverloadedStrings - ghc-options: -Wall - library pagure-internal - build-depends: aeson - , base >= 4 && < 5 - , http-query - , text - , lens, lens-aeson + build-depends: aeson, + base >= 4 && < 5, + http-query, + text, + lens, + lens-aeson default-language: Haskell2010 default-extensions: OverloadedStrings hs-source-dirs: libs/pagure-hs/src exposed-modules: Fedora.Pagure - ghc-options: -Wall - if impl(ghc >= 8.0) - ghc-options: -Wcompat - -Widentities - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wredundant-constraints - if impl(ghc >= 8.2) - ghc-options: -fhide-source-paths - if impl(ghc >= 8.4) - ghc-options: -Wmissing-export-lists - -Wpartial-fields - -library pdc-internal - build-depends: aeson - , base >= 4 && < 5 - , http-query - , text - , time - default-language: Haskell2010 - exposed-modules: Fedora.PDC - hs-source-dirs: libs/pdc-hs/src ghc-options: -Wall if impl(ghc >= 8.0) ghc-options: -Wcompat diff --git a/libs/koji-hs/src/Fedora/Koji.hs b/libs/koji-hs/src/Fedora/Koji.hs --- a/libs/koji-hs/src/Fedora/Koji.hs +++ b/libs/koji-hs/src/Fedora/Koji.hs @@ -48,7 +48,7 @@ ) where -import Data.List +import qualified Data.List as L import Data.Maybe import Network.XmlRpc.Internals @@ -161,8 +161,8 @@ case mreq of Nothing -> False Just req -> - maybe True (`isInfixOf` req) msource && - maybe True (\ target -> ("" ++ target ++ "") `isInfixOf` req) mtarget + maybe True (`L.isInfixOf` req) msource && + maybe True (\ target -> ("" ++ target ++ "") `L.isInfixOf` req) mtarget -- getTagID :: String -- ^ tag -- -> IO TagID diff --git a/src/Bodhi.hs b/src/Bodhi.hs --- a/src/Bodhi.hs +++ b/src/Bodhi.hs @@ -17,6 +17,7 @@ import Branches +import Common import Common.System import qualified Common.Text as T import Prompt @@ -37,21 +38,22 @@ -- FIXME should determine 3 days for branched devel release -- FIXME handle expired override? -bodhiCreateOverride :: String -> IO () -bodhiCreateOverride nvr = do +bodhiCreateOverride :: Bool -> String -> IO () +bodhiCreateOverride dryrun nvr = do putStrLn $ "Creating Bodhi Override for " ++ nvr ++ ":" - ok <- cmdBool "bodhi" ["overrides", "save", "--notes", "chain building with fbrnch", "--duration", "4", nvr] - if ok - then putStrLn $ "https://bodhi.fedoraproject.org/overrides/" ++ nvr - else do - moverride <- bodhiOverride nvr - case moverride of - Nothing -> do - putStrLn "bodhi override failed" - prompt_ "Press Enter to retry" - bodhiCreateOverride nvr - -- FIXME prettyprint - Just obj -> error' $ show obj + unless dryrun $ do + ok <- cmdBool "bodhi" ["overrides", "save", "--notes", "chain building with fbrnch", "--duration", "4", nvr] + if ok + then putStrLn $ "https://bodhi.fedoraproject.org/overrides/" ++ nvr + else do + moverride <- bodhiOverride nvr + case moverride of + Nothing -> do + putStrLn "bodhi override failed" + prompt_ "Press Enter to retry" + bodhiCreateOverride dryrun nvr + -- FIXME prettyprint + Just obj -> error' $ show obj data UpdateType = SecurityUpdate | BugfixUpdate | EnhancementUpdate | NewPackageUpdate diff --git a/src/Branches.hs b/src/Branches.hs --- a/src/Branches.hs +++ b/src/Branches.hs @@ -12,18 +12,23 @@ anyBranch, isRelBranch, onlyRelBranch, + partitionBranches, BranchOpts(..), listOfBranches, + listOfAnyBranches, gitCurrentBranch, systemBranch, getReleaseBranch, branchVersion, anyBranchToRelease, - branchingPrompt + getRequestedBranches, + BranchesReq(..) ) where import Common +import Data.Either +import Data.Tuple import Distribution.Fedora.Branch import SimpleCmd import SimpleCmd.Git @@ -48,6 +53,10 @@ show (RelBranch br) = show br show (OtherBranch obr) = obr +partitionBranches :: [String] -> ([Branch],[String]) +partitionBranches args = + swap . partitionEithers $ map eitherBranch args + activeBranches :: [Branch] -> [String] -> [Branch] activeBranches active = -- newest branch first @@ -104,57 +113,52 @@ systemBranch = readBranch' . init . removePrefix "PLATFORM_ID=\"platform:" <$> cmd "grep" ["PLATFORM_ID=", "/etc/os-release"] -listOfBranches :: Bool -> Bool -> Maybe BranchOpts -> [AnyBranch] -> IO [AnyBranch] -listOfBranches _ _active (Just AllBranches) (_:_) = - error' "cannot specify branches with --all-branches" -listOfBranches distgit _active (Just AllBranches) [] = +listOfBranches :: Bool -> Bool -> BranchesReq -> IO [Branch] +listOfBranches distgit _active (BranchOpt AllBranches) = if distgit - then map RelBranch <$> fedoraBranches localBranches + then fedoraBranches localBranches else error' "--all-branches only allowed for dist-git packages" -listOfBranches _ _active (Just AllFedora) (_:_) = - error' "cannot specify branches with --all-fedora" -listOfBranches distgit _active (Just AllFedora) [] = +listOfBranches distgit _active (BranchOpt AllFedora) = if distgit - then map RelBranch . filter isFedoraBranch <$> fedoraBranches localBranches + then filter isFedoraBranch <$> fedoraBranches localBranches else error' "--all-fedora only allowed for dist-git packages" -listOfBranches _ _active (Just AllEPEL) (_:_) = - error' "cannot specify branches with --all-epel" -listOfBranches distgit _active (Just AllEPEL) [] = +listOfBranches distgit _active (BranchOpt AllEPEL) = if distgit - then map RelBranch . filter isEPELBranch <$> fedoraBranches localBranches + then filter isEPELBranch <$> fedoraBranches localBranches else error' "--all-epel only allowed for dist-git packages" -listOfBranches distgit active Nothing brs = +listOfBranches distgit _ (BranchOpt (ExcludeBranches brs)) = do + branches <- if distgit + then fedoraBranches localBranches + else getFedoraBranches + return $ branches \\ brs +listOfBranches distgit active (Branches brs) = if null brs then pure <$> if distgit - then gitCurrentBranch - else RelBranch <$> systemBranch + then getReleaseBranch + else systemBranch else do activeBrs <- getFedoraBranches forM_ brs $ \ br -> - case br of - RelBranch rbr -> do if active - then when (rbr `notElem` activeBrs) $ + then when (br `notElem` activeBrs) $ error' $ show br ++ " is not an active branch" else - case rbr of + case br of Fedora _ -> do let latest = maximum (delete Rawhide activeBrs) - when (rbr > latest) $ - error' $ show rbr ++ " is newer than latest branch" + when (br > latest) $ + error' $ show br ++ " is newer than latest branch" -- FIXME also check for too new EPEL _ -> return () - _ -> return () return brs -listOfBranches _ _ (Just (ExcludeBranches _)) (_:_) = - error' "cannot specify branches with exclude-branch" -listOfBranches distgit _ (Just (ExcludeBranches brs)) [] = do - branches <- if distgit - then fedoraBranches localBranches - else getFedoraBranches - return $ map RelBranch (branches \\ brs) +listOfAnyBranches :: Bool -> Bool -> BranchesReq -> IO [AnyBranch] +listOfAnyBranches distgit active breq = + if breq == Branches [] && distgit + then pure <$> gitCurrentBranch + else fmap RelBranch <$> listOfBranches distgit active breq + getReleaseBranch :: IO Branch getReleaseBranch = gitCurrentBranch >>= anyBranchToRelease @@ -173,13 +177,36 @@ branchVersion (Fedora n) = show n branchVersion (EPEL n) = show n -branchingPrompt :: IO [Branch] -branchingPrompt = do - inp <- prompt "Enter required branches [default: latest 2]" - if null inp - then return [] - else - let brs = map anyBranch $ words inp - in if all isRelBranch brs - then return $ map onlyRelBranch brs - else branchingPrompt +getRequestedBranches :: BranchesReq -> IO [Branch] +getRequestedBranches breq = do + active <- getFedoraBranched + case breq of + Branches brs -> if null brs + then branchingPrompt + else return brs + BranchOpt request -> do + let requested = case request of + AllBranches -> active + AllFedora -> filter isFedoraBranch active + AllEPEL -> filter isEPELBranch active + ExcludeBranches xbrs -> active \\ xbrs + inp <- prompt $ "Confirm branches request [" ++ unwords (map show requested) ++ "]" + return $ if null inp + then requested + else map (readActiveBranch' active) $ words inp + where + branchingPrompt :: IO [Branch] + branchingPrompt = do + -- FIXME default may be wrong now + inp <- prompt "Enter required branches [default: latest 2]" + if null inp + then return [] + else + let abrs = map anyBranch $ words inp + in if all isRelBranch abrs + then return $ map onlyRelBranch abrs + else branchingPrompt + +data BranchesReq = + BranchOpt BranchOpts | Branches [Branch] + deriving Eq diff --git a/src/Bugzilla.hs b/src/Bugzilla.hs --- a/src/Bugzilla.hs +++ b/src/Bugzilla.hs @@ -124,9 +124,10 @@ encodeParams ((k,v):ps) = (B.pack k, fromString v) : encodeParams ps -putBugBuild :: BugzillaSession -> BugId -> String -> IO () -putBugBuild session bid nvr = do - void $ updateBug session bid +putBugBuild :: Bool -> BugzillaSession -> BugId -> String -> IO () +putBugBuild dryrun session bid nvr = do + unless dryrun $ + void $ updateBug session bid [("cf_fixed_in", nvr), ("status", "MODIFIED")] putStrLn $ "build posted to review bug " ++ show bid diff --git a/src/Cmd/Build.hs b/src/Cmd/Build.hs --- a/src/Cmd/Build.hs +++ b/src/Cmd/Build.hs @@ -38,16 +38,15 @@ -- FIXME provide direct link to failed task/build.log -- FIXME default behaviour for build in pkg dir: all branches or current? -- FIXME --auto-override for deps in testing -buildCmd :: BuildOpts -> Maybe BranchOpts -> [String] -> IO () -buildCmd opts mbrnchopts args = do +buildCmd :: BuildOpts -> (BranchesReq, [String]) -> IO () +buildCmd opts (breq, pkgs) = do let singleBrnch = if isJust (buildoptTarget opts) then ZeroOrOne else AnyNumber - (brs,pkgs) <- splitBranchesPkgs True mbrnchopts True args let mlastOfPkgs = if length pkgs > 1 then Just (Package (last pkgs)) else Nothing - withPackageByBranches' (Just False) cleanGitFetchActive mbrnchopts singleBrnch (buildBranch mlastOfPkgs opts) (brs,pkgs) + withPackageByBranches (Just False) cleanGitFetchActive singleBrnch (buildBranch mlastOfPkgs opts) (breq, pkgs) -- FIXME what if untracked files buildBranch :: Maybe Package -> BuildOpts -> Package -> AnyBranch -> IO () @@ -93,22 +92,17 @@ error' "Please bump the spec file" when (br /= Rawhide && isNothing mtarget) $ do tags <- kojiNVRTags nvr - unless dryrun $ - unlessM (checkAutoBodhiUpdate br) $ do + autoupdate <- checkAutoBodhiUpdate br + unless autoupdate $ do unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-updates-pending", show br ++ "-updates-testing", show br ++ "-updates-testing-pending"]) $ do - mBugSess <- do - (mbid, session) <- bzReviewSession - return $ case mbid of - Just bid -> Just (bid,session) - Nothing -> Nothing - bodhiUpdate (fmap fst mBugSess) spec nvr + mbug <- fst <$> bzReviewSession + bodhiUpdate dryrun mbug spec nvr unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ when (buildoptOverride opts) $ - bodhiCreateOverride nvr - when (isJust mlastpkg && mlastpkg /= Just pkg) $ do - autoupdate <- checkAutoBodhiUpdate br - when (buildoptOverride opts || autoupdate) $ - kojiWaitRepo target nvr + bodhiCreateOverride dryrun nvr + when (isJust mlastpkg && mlastpkg /= Just pkg) $ + when (buildoptOverride opts || autoupdate) $ + kojiWaitRepo dryrun target nvr Just BuildBuilding -> do putStrLn $ nvr ++ " is already building" when (isJust mpush) $ @@ -152,41 +146,41 @@ unless dryrun $ gitPushSilent $ fmap (++ ":" ++ show br) mref unlessM (null <$> gitShortLog ("origin" show br ++ "..HEAD")) $ - when (mpush == Just Nothing) $ + when (mpush == Just Nothing && not dryrun) $ error' "Unpushed changes remain" unlessM isGitDirClean $ error' "local changes remain (dirty)" -- FIXME parse build output - unless dryrun $ do + unless dryrun $ kojiBuildBranch target pkg mbuildref ["--fail-fast"] - mBugSess <- - if firstBuild - then do - (mbid, session) <- bzReviewSession - return $ case mbid of - Just bid -> Just (bid,session) - Nothing -> Nothing - else return Nothing - autoupdate <- checkAutoBodhiUpdate br - if autoupdate - then whenJust mBugSess $ - \ (bid,session) -> putBugBuild session bid nvr - else do - when (isNothing mtarget) $ do - -- FIXME diff previous changelog? - bodhiUpdate (fmap fst mBugSess) spec nvr - -- FIXME prompt for override note - when (buildoptOverride opts) $ - bodhiCreateOverride nvr - when (isJust mlastpkg && mlastpkg /= Just pkg) $ - when (buildoptOverride opts || autoupdate) $ - kojiWaitRepo target nvr + mBugSess <- + if firstBuild + then do + (mbid, session) <- bzReviewSession + return $ case mbid of + Just bid -> Just (bid,session) + Nothing -> Nothing + else return Nothing + autoupdate <- checkAutoBodhiUpdate br + if autoupdate + then whenJust mBugSess $ + \ (bid,session) -> putBugBuild dryrun session bid nvr + else do + when (isNothing mtarget) $ do + -- FIXME diff previous changelog? + bodhiUpdate dryrun (fmap fst mBugSess) spec nvr + -- FIXME prompt for override note + when (buildoptOverride opts) $ + bodhiCreateOverride dryrun nvr + when (isJust mlastpkg && mlastpkg /= Just pkg) $ + when (buildoptOverride opts || autoupdate) $ + kojiWaitRepo dryrun target nvr where - bodhiUpdate :: Maybe BugId -> FilePath -> String -> IO () - bodhiUpdate mreview spec nvr = do + bodhiUpdate :: Bool -> Maybe BugId -> FilePath -> String -> IO () + bodhiUpdate dryrun mreview spec nvr = do changelog <- if isJust mreview then getSummaryURL spec - else getChangeLog spec + else getChangeLog (Just "update") spec let cbugs = mapMaybe extractBugReference $ lines changelog bugs = let bids = [show rev | Just rev <- [mreview]] ++ cbugs in if null bids then [] else ["--bugs", intercalate "," bids] @@ -195,17 +189,18 @@ Nothing -> return () Just updateType -> do putStrLn $ "Creating Bodhi Update for " ++ nvr ++ ":" - cmd_ "bodhi" (["updates", "new", "--type", if isJust mreview then "newpackage" else show updateType, "--request", "testing", "--notes", changelog, "--autokarma", "--autotime", "--close-bugs"] ++ bugs ++ [nvr]) - updatequery <- bodhiUpdates [makeItem "display_user" "0", makeItem "builds" nvr] - case updatequery of - [] -> do - putStrLn "bodhi submission failed" - prompt_ "Press Enter to resubmit to Bodhi" - bodhiUpdate mreview spec nvr - [update] -> case lookupKey "url" update of - Nothing -> error' "Update created but no url" - Just uri -> putStrLn uri - _ -> error' $ "impossible happened: more than one update found for " ++ nvr + unless dryrun $ do + cmd_ "bodhi" (["updates", "new", "--type", if isJust mreview then "newpackage" else show updateType, "--request", "testing", "--notes", changelog, "--autokarma", "--autotime", "--close-bugs"] ++ bugs ++ [nvr]) + updatequery <- bodhiUpdates [makeItem "display_user" "0", makeItem "builds" nvr] + case updatequery of + [] -> do + putStrLn "bodhi submission failed" + prompt_ "Press Enter to resubmit to Bodhi" + bodhiUpdate dryrun mreview spec nvr + [update] -> case lookupKey "url" update of + Nothing -> error' "Update created but no url" + Just uri -> putStrLn uri + _ -> error' $ "impossible happened: more than one update found for " ++ nvr extractBugReference :: String -> Maybe String extractBugReference clog = diff --git a/src/Cmd/Bump.hs b/src/Cmd/Bump.hs --- a/src/Cmd/Bump.hs +++ b/src/Cmd/Bump.hs @@ -10,9 +10,9 @@ import Koji import Package -bumpPkgs :: Maybe CommitOpt -> Maybe BranchOpts -> [String] -> IO () -bumpPkgs mopt mbrnchopts = - withPackageByBranches (Just False) cleanGitFetchActive mbrnchopts True AnyNumber bumpPkg +bumpPkgs :: Maybe CommitOpt -> (BranchesReq,[String]) -> IO () +bumpPkgs mopt = + withPackageByBranches (Just False) cleanGitFetchActive AnyNumber bumpPkg where bumpPkg :: Package -> AnyBranch -> IO () bumpPkg pkg br = do diff --git a/src/Cmd/Copr.hs b/src/Cmd/Copr.hs --- a/src/Cmd/Copr.hs +++ b/src/Cmd/Copr.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Cmd.Copr ( @@ -28,36 +27,37 @@ -- FIXME repo config with a setup command? -- FIXME interact with copr dist-git -- FIXME parallel copr builds -coprCmd :: - Bool -> BuildBy -> [String] -> String -> Maybe BranchOpts -> [String] -> IO () -coprCmd dryrun buildBy archs project mbrnchopts args = do - (brs,pkgs) <- splitBranchesPkgs True mbrnchopts True args - chroots <- coprGetChroots brs - if null pkgs then - getPackageName "." >>= coprBuildPkg chroots +coprCmd :: Bool -> Bool -> BuildBy -> [String] -> String + -> (BranchesReq,[String]) -> IO () +coprCmd dryrun listchroots buildBy archs project (breq, pkgs) = do + chroots <- coprGetChroots + if listchroots + then mapM_ putStrLn chroots else - mapM_ (\ p -> withExistingDirectory p $ coprBuildPkg chroots (Package p)) pkgs + if null pkgs then + getPackageName "." >>= coprBuildPkg chroots + else + mapM_ (\ p -> withExistingDirectory p $ coprBuildPkg chroots (Package p)) pkgs where - coprGetChroots brs = do + coprGetChroots = do username <- getUsername chroots <- map T.unpack <$> coprChroots coprServer username project when (null chroots) $ error' $ "No chroots found for " ++ username ++ "/" ++ project branches <- - if isNothing mbrnchopts && null brs - then return $ (map (releaseBranch . T.pack) . nub . map removeArch) chroots - else do - brs' <- listOfBranches False False mbrnchopts brs - forM brs' $ \ case - OtherBranch obr -> error' $ "unknown copr target: " ++ obr - RelBranch rbr -> return rbr + case breq of + Branches brs -> + if null brs + then return $ (map (releaseBranch . T.pack) . nub . map removeArch) chroots + else listOfBranches False False breq + _ -> listOfBranches False False breq let buildroots = reverseSort $ if null archs then [chroot | chroot <- chroots, removeArch chroot `elem` map branchRelease branches] else [chroot | arch <- archs, br <- branches, let chroot = branchRelease br ++ "-" ++ arch, chroot `elem` chroots] if null buildroots - then error' "No chroots chosen" + then error' "No valid chroots" else return buildroots coprBuildPkg buildroots pkg = do diff --git a/src/Cmd/Diff.hs b/src/Cmd/Diff.hs --- a/src/Cmd/Diff.hs +++ b/src/Cmd/Diff.hs @@ -20,10 +20,10 @@ -- FIXME diff other branches without switching -- FIXME --older/--newer branch -diffCmd :: Bool -> DiffWork -> DiffFormat -> Maybe AnyBranch -> [String] - -> IO () +diffCmd :: Bool -> DiffWork -> DiffFormat -> Maybe AnyBranch -> Maybe Branch + -> [String] -> IO () diffCmd speconly work fmt mwbr = - withPackageByBranches Nothing dirtyGit Nothing True ZeroOrOne diffPkg + withPackagesMaybeBranch Nothing dirtyGit ZeroOrOne diffPkg where diffPkg :: Package -> AnyBranch -> IO () diffPkg pkg br = do diff --git a/src/Cmd/Import.hs b/src/Cmd/Import.hs --- a/src/Cmd/Import.hs +++ b/src/Cmd/Import.hs @@ -19,8 +19,9 @@ import Prompt -- FIXME separate pre-checked listReviews and direct pkg call, which needs checks -importCmd :: Bool -> [String] -> IO () -importCmd mock ps = do +-- FIXME add --dryrun +importCmd :: Bool -> (BranchesReq,[String]) -> IO () +importCmd mock (breq, ps) = do pkgs <- if null ps then map reviewBugToPackage <$> listReviews ReviewRepoCreated else return ps @@ -72,11 +73,11 @@ gitPushSilent Nothing -- FIXME build more branches kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"] - putBugBuild session bid nvr + putBugBuild False session bid nvr existing <- fedoraBranchesNoRawhide localBranches when (null existing) $ do - brs <- branchingPrompt - requestPkgBranches mock Nothing brs (Package pkg) + brs <- getRequestedBranches breq + requestPkgBranches mock (Branches brs) (Package pkg) when (pkg /= takeFileName dir) $ setCurrentDirectory dir where diff --git a/src/Cmd/Install.hs b/src/Cmd/Install.hs --- a/src/Cmd/Install.hs +++ b/src/Cmd/Install.hs @@ -11,11 +11,11 @@ -- FIXME package countdown -- FIXME --ignore-uninstalled subpackages -- FIXME --check any/all of package installed -installCmd :: Bool -> Maybe ForceShort -> [BCond] -> Bool -> [String] -> IO () -installCmd recurse mforceshort bconds reinstall = do +installCmd :: Bool -> Maybe ForceShort -> [BCond] -> Bool -> Maybe Branch -> [String] -> IO () +installCmd recurse mforceshort bconds reinstall mbr pkgs = do when (recurse && isJust mforceshort) $ error' "cannot use --recurse and --shortcircuit" - withPackageByBranches Nothing Nothing Nothing True ZeroOrOne installPkg + withPackagesMaybeBranch Nothing Nothing ZeroOrOne installPkg mbr pkgs where installPkg :: Package -> AnyBranch -> IO () installPkg pkg br = do @@ -41,7 +41,7 @@ mpkgdir <- lookForPkgDir rbr ".." dep case mpkgdir of Nothing -> putStrLn $ dep ++ " not known" - Just pkgdir -> installCmd recurse mforceshort bconds reinstall [show br, pkgdir] >> putStrLn "" + Just pkgdir -> installCmd recurse mforceshort bconds reinstall mbr [pkgdir] >> putStrLn "" else error' $ "missing deps:\n" ++ unlines missingdeps buildRPMs True mforceshort bconds rpms br spec putStrLn "" @@ -83,9 +83,9 @@ filterDebug = filter (\p -> not (any (`isInfixOf` p) ["-debuginfo-", "-debugsource-"])) -notInstalledCmd :: [String] -> IO () +notInstalledCmd :: Maybe Branch -> [String] -> IO () notInstalledCmd = - withPackageByBranches Nothing Nothing Nothing True ZeroOrOne notInstalledPkg + withPackagesMaybeBranch Nothing Nothing ZeroOrOne notInstalledPkg where notInstalledPkg :: Package -> AnyBranch -> IO () notInstalledPkg pkg br = do diff --git a/src/Cmd/ListBranches.hs b/src/Cmd/ListBranches.hs --- a/src/Cmd/ListBranches.hs +++ b/src/Cmd/ListBranches.hs @@ -12,21 +12,21 @@ -- FIXME remote/pagures branch and --remote or --no-remote -- FIXME --local for existing local branches -branchesCmd :: Bool -> Bool -> Bool -> Bool -> [String] -> IO () -branchesCmd skipdead allbrs missing remote args = do - (brs,pkgs) <- splitBranchesPkgs False Nothing (not remote) args - when allbrs $ do - unless (null brs) $ - error' "cannot combine --all and branches" - when missing $ - error' "cannot combine --all and --missing" +branchesCmd :: Bool -> Bool -> Bool -> Bool -> (BranchesReq,[String]) -> IO () +branchesCmd skipdead allbrs missing remote (breq, pkgs) = do + -- when (allbrs $ do + -- unless (null brs) $ + -- error' "cannot combine --all and branches" + -- when missing $ + -- error' "cannot combine --all and --missing" if null pkgs - then branchesPkg brs "." - else mapM_ (branchesPkg brs) pkgs + then branchesPkg "." + else mapM_ branchesPkg pkgs where - branchesPkg :: [AnyBranch] -> FilePath -> IO () - branchesPkg branches path = do - if remote then doBranchesPkg + branchesPkg :: FilePath -> IO () + branchesPkg path = do + if remote + then doBranchesPkg else withExistingDirectory path $ if skipdead then @@ -37,24 +37,26 @@ where doBranchesPkg :: IO () doBranchesPkg = do - unlessM isPkgGitRepo $ - unless remote $ - error' "not dist-git" + unless remote $ + unlessM isPkgGitRepo $ + error' "not Fedora dist-git" pkg <- getPackageName path - brs <- if remote + brs <- delete "main" <$> + if remote then pagurePkgBranches (unPackage pkg) else localBranches if allbrs then do putStrLn $ unPackage pkg ++ ": " ++ unwords brs else do - if null branches then do + if breq == Branches [] then do -- FIXME better to filter inactive instead active <- getFedoraBranches let result = if missing then active \\ mapMaybe readBranch brs else activeBranches active brs putStr $ unPackage pkg ++ ": " putStrLn $ (unwords . map show) result else do - let havebrs = filter (`elem` branches) (map anyBranch brs) + branches <- listOfBranches True False breq + let havebrs = filter (`elem` branches) $ map readBranch' brs result = if missing then branches \\ havebrs else havebrs unless (null result) $ do putStr $ unPackage pkg ++ ": " diff --git a/src/Cmd/Local.hs b/src/Cmd/Local.hs --- a/src/Cmd/Local.hs +++ b/src/Cmd/Local.hs @@ -18,12 +18,13 @@ import Branches import Common +import Common.System import Git import Package -localCmd :: Maybe ForceShort -> [BCond] -> [String] -> IO () +localCmd :: Maybe ForceShort -> [BCond] -> (BranchesReq, [String]) -> IO () localCmd mforceshort bconds = - withPackageByBranches Nothing Nothing Nothing True ZeroOrOne localBuildPkg + withPackageByBranches Nothing Nothing ZeroOrOne localBuildPkg where localBuildPkg :: Package -> AnyBranch -> IO () localBuildPkg pkg br = do @@ -33,19 +34,17 @@ else builtRpms br spec buildRPMs False mforceshort bconds rpms br spec --- FIXME single branch -installDepsCmd :: [String] -> IO () +installDepsCmd :: Maybe Branch -> [String] -> IO () installDepsCmd = - withPackageByBranches Nothing Nothing Nothing True ZeroOrOne installDepsPkg + withPackagesMaybeBranch Nothing Nothing ZeroOrOne installDepsPkg where installDepsPkg :: Package -> AnyBranch -> IO () installDepsPkg pkg br = localBranchSpecFile pkg br >>= installDeps --- FIXME single branch -srpmCmd :: Bool -> [String] -> IO () +srpmCmd :: Bool -> Maybe Branch -> [String] -> IO () srpmCmd force = - withPackageByBranches Nothing Nothing Nothing True ZeroOrOne srpmBuildPkg + withPackagesMaybeBranch Nothing Nothing ZeroOrOne srpmBuildPkg where srpmBuildPkg :: Package -> AnyBranch -> IO () srpmBuildPkg pkg br = do @@ -54,11 +53,10 @@ data RpmWith = RpmWith String | RpmWithout String -sortCmd :: Maybe RpmWith -> [String] -> IO () -sortCmd _ [] = return () -sortCmd mrpmwith args = do - (brs,pkgs) <- splitBranchesPkgs False Nothing True args - withPackageByBranches' Nothing Nothing Nothing ExactlyOne dummy (brs,pkgs) +sortCmd :: Maybe RpmWith -> Maybe Branch -> [String] -> IO () +sortCmd _ _ [] = return () +sortCmd mrpmwith mbr pkgs = do + withPackagesMaybeBranch Nothing Nothing ExactlyOne dummy mbr pkgs let rpmopts = maybe [] toRpmOption mrpmwith packages <- dependencySortRpmOpts rpmopts $ reverse pkgs putStrLn $ unwords packages @@ -70,13 +68,13 @@ toRpmOption (RpmWith opt) = ["--with=" ++ opt] toRpmOption (RpmWithout opt) = ["--without=" ++ opt] -prepCmd :: [String] -> IO () +prepCmd :: Maybe Branch -> [String] -> IO () prepCmd = - withPackageByBranches Nothing Nothing Nothing True ZeroOrOne prepPackage + withPackagesMaybeBranch Nothing Nothing ZeroOrOne prepPackage -nvrCmd :: Maybe BranchOpts -> [String] -> IO () -nvrCmd mbrnchopts = - withPackageByBranches Nothing Nothing mbrnchopts True AnyNumber nvrBranch +nvrCmd :: (BranchesReq, [String]) -> IO () +nvrCmd = + withPackageByBranches Nothing Nothing AnyNumber nvrBranch where nvrBranch :: Package -> AnyBranch -> IO () nvrBranch pkg br = do @@ -89,12 +87,15 @@ pkgNameVerRel' sbr spec >>= putStrLn -commandCmd :: Bool -> String -> Maybe BranchOpts -> [String] -> IO () -commandCmd ifoutput cs mbrnchopts = - withPackageByBranches (Just (not ifoutput)) Nothing mbrnchopts True AnyNumber cmdBranch +-- FIXME option to require spec file? +commandCmd :: Bool -> String -> (BranchesReq,[String]) -> IO () +commandCmd ifoutput cs = + withPackageByBranches (Just (not ifoutput)) Nothing AnyNumber cmdBranch where cmdBranch :: Package -> AnyBranch -> IO () - cmdBranch pkg br = do + cmdBranch pkg br = + ifM (doesFileExist "dead.package") + (putStrLn "dead.package") $ do curEnv <- getEnvironment if ifoutput then do out <- TP.readProcessInterleaved_ $ @@ -102,15 +103,15 @@ TP.shell cs unless (B.null out) $ do putPkgAnyBrnchHdr pkg br - B.putStrLn out + B.putStr out else do let p = (P.shell cs) { P.env = Just (("p",unPackage pkg):curEnv) } (_,_,_,h) <- P.createProcess p void $ P.waitForProcess h renameMasterCmd :: [String] -> IO () -renameMasterCmd = - withPackageByBranches (Just False) dirtyGit Nothing True ZeroOrOne renameMasterBranch +renameMasterCmd pkgs = + withPackageByBranches (Just False) dirtyGit ZeroOrOne renameMasterBranch (Branches [], pkgs) where renameMasterBranch :: Package -> AnyBranch -> IO () renameMasterBranch _pkg _br = do diff --git a/src/Cmd/Merge.hs b/src/Cmd/Merge.hs --- a/src/Cmd/Merge.hs +++ b/src/Cmd/Merge.hs @@ -9,9 +9,9 @@ import Prompt -- add BranchOpts? -mergeCmd :: Bool -> [String] -> IO () +mergeCmd :: Bool -> (BranchesReq,[String]) -> IO () mergeCmd noprompt = - withPackageByBranches (Just False) cleanGitFetchActive Nothing True AnyNumber runMergeBranch + withPackageByBranches (Just False) cleanGitFetchActive AnyNumber runMergeBranch where runMergeBranch :: Package -> AnyBranch -> IO () runMergeBranch _ (OtherBranch _) = diff --git a/src/Cmd/Mock.hs b/src/Cmd/Mock.hs --- a/src/Cmd/Mock.hs +++ b/src/Cmd/Mock.hs @@ -9,23 +9,21 @@ import Git import Package -mockCmd :: Bool -> Bool -> Bool -> Bool -> Maybe Branch -> [String] -> IO () -mockCmd dryrun noclean network noCleanAfter mroot args = do - (brs, pkgs) <- splitBranchesPkgs True Nothing True args - unless (null pkgs) $ - whenM isPkgGitRepo $ - error' "Cannot build multiple packages inside a package dir" - when (null brs && length pkgs > 1 && isNothing mroot) $ - error' "Must specific branch or --root chroot" +-- FIXME handle non-release branches +mockCmd :: Bool -> Bool -> Bool -> Bool -> Maybe Branch + -> (BranchesReq, [String]) -> IO () +mockCmd dryrun noclean network noCleanAfter mroot (breq, ps) = do branches <- - if null brs - then - if null pkgs - then pure <$> getReleaseBranch - else pure <$> systemBranch - else map onlyRelBranch <$> listOfBranches False False Nothing brs - let packages = if null pkgs then ["."] else pkgs - mapM_ (mockBuildPkgs (null brs) packages) branches + case breq of + Branches [] -> + if null ps + then pure <$> getReleaseBranch + else pure <$> systemBranch + _ -> listOfBranches False False breq + when (null branches && length ps > 1 && isNothing mroot) $ + error' "Must specific branch or --root chroot" + let packages = if null ps then ["."] else ps + mapM_ (mockBuildPkgs (breq == Branches []) packages) branches where mockBuildPkgs :: Bool -> [String] -> Branch -> IO () mockBuildPkgs noswitch pkgs br = do diff --git a/src/Cmd/Override.hs b/src/Cmd/Override.hs --- a/src/Cmd/Override.hs +++ b/src/Cmd/Override.hs @@ -10,9 +10,10 @@ import Koji import Package -overrideCmd :: Bool -> [String] -> IO () -overrideCmd dryrun = - withPackageByBranches (Just False) cleanGitFetchActive Nothing True AnyNumber overrideBranch +-- FIXME option to expire (all) overrides +overrideCmd :: Bool -> [Branch] -> [String] -> IO () +overrideCmd dryrun brs pkgs = + withPackageByBranches (Just False) cleanGitFetchActive AnyNumber overrideBranch (Branches brs, pkgs) where overrideBranch :: Package -> AnyBranch -> IO () overrideBranch _ (OtherBranch _) = @@ -25,9 +26,6 @@ putStrLn nvr tags <- kojiNVRTags nvr unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ - unlessM (checkAutoBodhiUpdate br) $ - if dryrun - then putStrLn $ "override " ++ nvr - else do - bodhiCreateOverride nvr - kojiWaitRepo (branchTarget br) nvr + unlessM (checkAutoBodhiUpdate br) $ do + bodhiCreateOverride dryrun nvr + kojiWaitRepo dryrun (branchTarget br) nvr diff --git a/src/Cmd/Parallel.hs b/src/Cmd/Parallel.hs --- a/src/Cmd/Parallel.hs +++ b/src/Cmd/Parallel.hs @@ -31,52 +31,51 @@ -- (pkg, (sidetag, nvr)) type Job = (String, Async (String, String)) --- FIXME only override if more packages to build -- FIXME option to build multiple packages over branches in parallel -- FIXME use --wait-build=NVR -- FIXME check sources asap -parallelBuildCmd :: Bool -> Maybe SideTagTarget -> Maybe UpdateType -> Maybe BranchOpts -> [String] - -> IO () -parallelBuildCmd dryrun msidetagTarget mupdatetype mbrnchopts args = do - (brs,pkgs) <- splitBranchesPkgs True mbrnchopts True args - when (null brs && isNothing mbrnchopts) $ +parallelBuildCmd :: Bool -> Maybe SideTagTarget -> Maybe UpdateType -> (BranchesReq, [String]) -> IO () +parallelBuildCmd dryrun msidetagTarget mupdatetype (breq, pkgs) = do + branches <- + case pkgs of + [] -> listOfBranches True True breq + [p] -> withExistingDirectory p $ listOfBranches True True breq + _ -> case breq of + Branches _ -> listOfBranches True True breq + _ -> error' "parallel does not support branch options for multiple packages: please give an explicit list of branches instead" + when (null branches) $ error' "Please specify at least one branch" - branches <- listOfBranches True True mbrnchopts brs let mtarget = maybeTarget msidetagTarget when (isJust mtarget && length branches > 1) $ error' "You can only specify target with one branch" - if null pkgs - then do - unlessM isPkgGitRepo $ - error' "Please specify at least one package" - parallelBranches $ map onlyRelBranch branches - else do - whenM isPkgGitRepo $ - error' "Cannot build multiple packages inside a package dir" - forM_ branches $ \ br -> do - case br of - (RelBranch rbr) -> do - layers <- dependencyLayers pkgs - when (isNothing msidetagTarget && length layers > 1) $ do - unlessM (checkAutoBodhiUpdate rbr) $ - error' "You must use --target/--sidetag to build package layers for this branch" - when (length branches > 1) $ - putStrLn $ "# " ++ show rbr - targets <- mapM (parallelBuild rbr) layers - when (isJust msidetagTarget && null targets) $ - error' "No target was returned from jobs!" - unless (isNothing msidetagTarget || null targets) $ do - let target = head targets - when (target /= branchTarget rbr) $ do - notes <- prompt $ "Enter notes to submit Bodhi update for " ++ target - bodhiSidetagUpdate target notes - (OtherBranch _) -> - error' "parallel builds only defined for release branches" + case pkgs of + [] -> do + unlessM isPkgGitRepo $ + error' "Please specify at least one package" + parallelBranches branches + [p] -> withExistingDirectory p $ + parallelBranches branches + _ -> + forM_ branches $ \ rbr -> do + layers <- dependencyLayers pkgs + when (isNothing msidetagTarget && length layers > 1) $ + unlessM (checkAutoBodhiUpdate rbr) $ + error' "You must use --target/--sidetag to build package layers for this branch" + when (length branches > 1) $ + putStrLn $ "# " ++ show rbr + targets <- mapM (parallelBuild rbr) $ zip (reverse [0..(length layers - 1)]) layers + when (isJust msidetagTarget && null targets && not dryrun) $ + error' "No target was returned from jobs!" + unless (isNothing msidetagTarget || null targets || dryrun) $ do + let target = head targets + when (target /= branchTarget rbr) $ do + notes <- prompt $ "Enter notes to submit Bodhi update for " ++ target + bodhiSidetagUpdate target notes where parallelBranches :: [Branch] -> IO () parallelBranches brs = do krbTicket - putStrLn $ "Building parallel " ++ show (length brs) ++ " branches:" + putStrLn $ "Building " ++ show (length brs) ++ " branches in parallel:" putStrLn $ unwords $ map show brs jobs <- mapM setupBranch brs (failures,_mtarget) <- watchJobs Nothing [] jobs @@ -85,16 +84,17 @@ where setupBranch :: Branch -> IO Job setupBranch br = do - job <- startBuild False br "." >>= async + job <- startBuild False False br "." >>= async unless dryrun $ sleep 5 return (show br,job) - parallelBuild :: Branch -> [String] -> IO String - parallelBuild br layer = do + parallelBuild :: Branch -> (Int,[String]) -> IO String + parallelBuild br (layersleft,layer) = do krbTicket when (nopkgs > 1) $ do putStrLn $ "\nBuilding parallel layer of " ++ show nopkgs ++ " packages:" putStrLn $ unwords layer + putStrLn $ "(" ++ show layersleft ++ " more layers left)" jobs <- mapM setupBuild layer (failures,mtarget) <- watchJobs Nothing [] jobs unless (null failures) $ @@ -107,7 +107,7 @@ setupBuild :: String -> IO Job setupBuild pkg = do - job <- startBuild (nopkgs > 5) br pkg >>= async + job <- startBuild (layersleft > 0) (nopkgs > 5) br pkg >>= async unless dryrun $ sleep 5 return (pkg,job) @@ -128,8 +128,8 @@ watchJobs mtarget (pkg : fails) jobs -- FIXME prefix output with package name - startBuild :: Bool -> Branch -> String -> IO (IO (String,String)) - startBuild background br pkgdir = + startBuild :: Bool -> Bool -> Branch -> String -> IO (IO (String,String)) + startBuild morelayers background br pkgdir = withExistingDirectory pkgdir $ do gitSwitchBranch (RelBranch br) pkg <- getPackageName pkgdir @@ -166,14 +166,14 @@ case buildstatus of Just BuildComplete -> do putStrLn $ nvr ++ " is " ++ color Green "already built" - when (br /= Rawhide && target == branchTarget br) $ do + when (br /= Rawhide && morelayers && target == branchTarget br) $ do tags <- kojiNVRTags nvr - unless (dryrun || any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ + unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ unlessM (checkAutoBodhiUpdate br) $ - bodhiCreateOverride nvr + bodhiCreateOverride dryrun nvr return $ do - unless dryrun $ - kojiWaitRepo target nvr + when morelayers $ + kojiWaitRepo dryrun target nvr return (target,nvr) Just BuildBuilding -> do putStrLn $ nvr ++ " is already building" @@ -206,24 +206,24 @@ if finish then putStrLn $ color Green $ nvr ++ " build success" else error' $ color Red $ nvr ++ " build failed" - unless dryrun $ do - autoupdate <- checkAutoBodhiUpdate br - if autoupdate then - when newpkg $ do - mBugSess <- do - (mbid, session) <- bzReviewSession - return $ case mbid of - Just bid -> Just (bid,session) - Nothing -> Nothing - whenJust mBugSess $ - \ (bid,session) -> putBugBuild session bid nvr - else do - when (target == branchTarget br) $ - -- -- FIXME: avoid prompt in - -- changelog <- getChangeLog spec - -- bodhiUpdate (fmap fst mBugSess) changelog nvr - bodhiCreateOverride nvr - kojiWaitRepo target nvr + autoupdate <- checkAutoBodhiUpdate br + if autoupdate then + when newpkg $ do + mBugSess <- do + (mbid, session) <- bzReviewSession + return $ case mbid of + Just bid -> Just (bid,session) + Nothing -> Nothing + whenJust mBugSess $ + \ (bid,session) -> putBugBuild dryrun session bid nvr + else do + when (target == branchTarget br && morelayers) $ + -- -- FIXME: avoid prompt in + -- changelog <- getChangeLog Nothing spec + -- bodhiUpdate (fmap fst mBugSess) changelog nvr + bodhiCreateOverride dryrun nvr + when morelayers $ + kojiWaitRepo dryrun target nvr return (target,nvr) bodhiSidetagUpdate :: String -> String -> IO () @@ -232,7 +232,7 @@ Nothing -> return () Just updateType -> do putStrLn $ "Creating Bodhi Update for " ++ sidetag - ok <- cmdBool "bodhi" ["updates", "new", "--type", show updateType , "--notes", "--request", "testing", if null notes then "to be written" else notes, "--autokarma", "--autotime", "--close-bugs", "--from-tag", sidetag] + ok <- cmdBool "bodhi" ["updates", "new", "--type", show updateType , "--request", "testing", "--notes", if null notes then "to be written" else notes, "--autokarma", "--autotime", "--close-bugs", "--from-tag", sidetag] when ok $ do prompt_ "After editing update, press Enter to remove sidetag" fedpkg_ "remove-side-tag" [sidetag] diff --git a/src/Cmd/PkgReview.hs b/src/Cmd/PkgReview.hs --- a/src/Cmd/PkgReview.hs +++ b/src/Cmd/PkgReview.hs @@ -23,8 +23,8 @@ -- FIXME add --dependent pkgreview -- FIXME reference existing/previous scratch build createReview :: Bool -> Bool -> [FilePath] -> IO () -createReview noscratch mock = - withPackageByBranches (Just True) Nothing Nothing True Zero createPkgReview +createReview noscratch mock pkgs = + withPackageByBranches (Just True) Nothing ZeroOrOne createPkgReview (Branches [], pkgs) where createPkgReview :: Package -> AnyBranch -> IO () createPkgReview package _br = do @@ -77,7 +77,7 @@ error' "This NVR was already posted on the review bug: please bump" mockRpmLint mock noscratch pkg spec srpm (mkojiurl,specSrpmUrls) <- buildAndUpload noscratch srpm pkg spec - changelog <- getChangeLog spec + changelog <- getChangeLog Nothing spec commentBug session bid (specSrpmUrls <> (if null changelog then "" else "\n\n" <> changelog) <> maybe "" ("\n\nKoji scratch build: " <>) mkojiurl) -- putStrLn "Review bug updated" where diff --git a/src/Cmd/Pull.hs b/src/Cmd/Pull.hs --- a/src/Cmd/Pull.hs +++ b/src/Cmd/Pull.hs @@ -6,9 +6,9 @@ -- FIXME pulling more than one branch -- FIXME print nvr after pulling or old -> new -pullPkgs :: [String] -> IO () +pullPkgs :: (BranchesReq, [String]) -> IO () pullPkgs = - withPackageByBranches (Just False) cleanGitFetch Nothing True AnyNumber pullPkg + withPackageByBranches (Just False) cleanGitFetch AnyNumber pullPkg where pullPkg :: Package -> AnyBranch -> IO () pullPkg _pkg _br = diff --git a/src/Cmd/RequestBranch.hs b/src/Cmd/RequestBranch.hs --- a/src/Cmd/RequestBranch.hs +++ b/src/Cmd/RequestBranch.hs @@ -1,7 +1,6 @@ module Cmd.RequestBranch ( requestBranches, - requestPkgBranches, - getRequestedBranches + requestPkgBranches ) where import Common @@ -14,34 +13,33 @@ import ListReviews import Package import Pagure -import Prompt -requestBranches :: Bool -> Maybe BranchOpts -> [String] -> IO () -requestBranches mock mbrnchopts args = do - (abrs,ps) <- splitBranchesPkgs True mbrnchopts True args - let brs = map onlyRelBranch abrs +requestBranches :: Bool -> (BranchesReq,[String]) -> IO () +requestBranches mock (breq, ps) = do if null ps then ifM isPkgGitRepo - (getDirectoryName >>= requestPkgBranches mock mbrnchopts brs . Package) $ + (getDirectoryName >>= requestPkgBranches mock breq . Package) $ do pkgs <- map reviewBugToPackage <$> listReviews ReviewUnbranched - mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches mock mbrnchopts brs (Package p)) pkgs + mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches mock breq (Package p)) pkgs else - mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches mock mbrnchopts brs (Package p)) ps + mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches mock breq (Package p)) ps -- FIXME add --yes, or skip prompt when args given -requestPkgBranches :: Bool -> Maybe BranchOpts -> [Branch] -> Package -> IO () -requestPkgBranches mock mbrnchopts brs pkg = do +requestPkgBranches :: Bool -> BranchesReq -> Package -> IO () +requestPkgBranches mock breq pkg = do putPkgHdr pkg git_ "fetch" [] - branches <- getRequestedBranches mbrnchopts brs + branches <- getRequestedBranches breq newbranches <- filterExistingBranchRequests branches unless (null newbranches) $ do - (bug,session) <- approvedReviewBugSession (unPackage pkg) - let bid = bugId bug + (mbid,session) <- bzReviewSession urls <- forM newbranches $ \ br -> do when mock $ fedpkg_ "mockbuild" ["--root", mockConfig br] fedpkg "request-branch" [show br] - commentBug session bid $ unlines urls + case mbid of + Just bid -> commentBug session bid + Nothing -> putStrLn + $ unlines urls where filterExistingBranchRequests :: [Branch] -> IO [Branch] filterExistingBranchRequests branches = do @@ -74,21 +72,3 @@ putStrLn $ "Branch request already open for " ++ unPackage pkg ++ ":" ++ show br mapM_ printScmIssue pending return $ null pending - -getRequestedBranches :: Maybe BranchOpts -> [Branch] -> IO [Branch] -getRequestedBranches mbrnchopts brs = do - active <- getFedoraBranched - case mbrnchopts of - Nothing -> if null brs - then return $ take 2 active - else return brs - Just request -> do - let requested = case request of - AllBranches -> active - AllFedora -> filter isFedoraBranch active - AllEPEL -> filter isEPELBranch active - ExcludeBranches xbrs -> active \\ xbrs - inp <- prompt $ "Confirm branches request [" ++ unwords (map show requested) ++ "]" - return $ if null inp - then requested - else map (readActiveBranch' active) $ words inp diff --git a/src/Cmd/RequestRepo.hs b/src/Cmd/RequestRepo.hs --- a/src/Cmd/RequestRepo.hs +++ b/src/Cmd/RequestRepo.hs @@ -11,7 +11,6 @@ import Branches import Bugzilla -import Cmd.RequestBranch (getRequestedBranches) import Krb import ListReviews import Package @@ -19,18 +18,18 @@ import Prompt -- FIXME separate pre-checked listReviews and direct pkg call, which needs checks -requestRepos :: Bool -> Bool -> Maybe BranchOpts -> [String] -> IO () -requestRepos allstates retry mbrnchopts ps = do +requestRepos :: Bool -> Bool -> Bool -> (BranchesReq, [String]) -> IO () +requestRepos mock allstates retry (breq, ps) = do when (retry && length ps /= 1) $ error' "--retry only for a single package" pkgs <- if null ps then map reviewBugToPackage <$> listReviewsAll allstates ReviewWithoutRepoReq else return ps - mapM_ (requestRepo retry mbrnchopts) pkgs + mapM_ (requestRepo mock retry breq) pkgs -- FIXME also accept bugid instead -requestRepo :: Bool -> Maybe BranchOpts -> String -> IO () -requestRepo retry mbrnchopts pkg = do +requestRepo :: Bool -> Bool -> BranchesReq -> String -> IO () +requestRepo mock retry breq pkg = do putStrLn pkg (bug,session) <- approvedReviewBugSession pkg putBug bug @@ -63,10 +62,10 @@ let comment = (if null input then draft else input) ++ "\n\n" <> url commentBug session bid comment putStrLn "" - brs <- branchingPrompt - branches <- getRequestedBranches mbrnchopts brs - forM_ branches $ \ br -> - putStr (show br ++ " ") >> + branches <- getRequestedBranches breq + forM_ branches $ \ br -> do + when mock $ fedpkg_ "mockbuild" ["--root", mockConfig br] + putStr (show br ++ " ") fedpkg_ "request-branch" ["--repo", pkg, show br] where existingRepoRequests :: IO [IssueTitleStatus] diff --git a/src/Cmd/Scratch.hs b/src/Cmd/Scratch.hs --- a/src/Cmd/Scratch.hs +++ b/src/Cmd/Scratch.hs @@ -16,10 +16,10 @@ -- FIXME default to rawhide/main? -- FIXME build from a specific git ref -- FIXME print message about uploading srpm -scratchCmd :: Bool -> Bool -> Bool -> Maybe Archs -> Maybe String -> [String] - -> IO () +scratchCmd :: Bool -> Bool -> Bool -> Maybe Archs -> Maybe String + -> (BranchesReq, [String]) -> IO () scratchCmd dryrun rebuildSrpm nofailfast marchopts mtarget = - withPackageByBranches (Just False) Nothing Nothing True AnyNumber scratchBuild + withPackageByBranches (Just False) Nothing AnyNumber scratchBuild where scratchBuild :: Package -> AnyBranch -> IO () scratchBuild pkg br = do diff --git a/src/Cmd/Status.hs b/src/Cmd/Status.hs --- a/src/Cmd/Status.hs +++ b/src/Cmd/Status.hs @@ -22,14 +22,13 @@ -- FIXME --pending -- FIXME handle not cloned (remote only) -- FIXME silence fetching of new branches? (for --reviews etc) -statusCmd :: Bool -> Bool -> Maybe BranchOpts -> [String] -> IO () -statusCmd nofetch reviews mbrnchopts args = do +statusCmd :: Bool -> Bool -> (BranchesReq,[String]) -> IO () +statusCmd nofetch reviews (breq, pkgs) = do reviewpkgs <- if reviews then map reviewBugToPackage <$> listReviewsAll True ReviewRepoCreated else return [] -- FIXME dirty not okay for multiple branches? - withPackageByBranches (Just False) (if nofetch then dirtyGit else dirtyGitFetch) mbrnchopts True AnyNumber statusBranch - (args ++ reviewpkgs) + withPackageByBranches (Just False) (if nofetch then dirtyGit else dirtyGitFetch) AnyNumber statusBranch (breq, pkgs ++ reviewpkgs) -- FIXME note dirty when local changes statusBranch :: Package -> AnyBranch -> IO () diff --git a/src/Cmd/Switch.hs b/src/Cmd/Switch.hs --- a/src/Cmd/Switch.hs +++ b/src/Cmd/Switch.hs @@ -1,12 +1,13 @@ module Cmd.Switch (switchCmd) where ---import Branches +import Branches import Git import Package -switchCmd :: [String] -> IO () -switchCmd = +-- FIXME noop when on branch already or drop cleanGit +switchCmd :: AnyBranch -> [String] -> IO () +switchCmd br pkgs = -- FIXME use withBranchByPackages ? - withPackageByBranches Nothing cleanGit Nothing True ExactlyOne dummy + withPackageByBranches Nothing dirtyGit ExactlyOne dummy (Branches [],pkgs) where - dummy _ br = gitSwitchBranch br + dummy _ _ = gitSwitchBranch br diff --git a/src/Cmd/Update.hs b/src/Cmd/Update.hs --- a/src/Cmd/Update.hs +++ b/src/Cmd/Update.hs @@ -14,14 +14,13 @@ import Package -- FIXME branch arg? -updateCmd :: [String] -> IO () -updateCmd args = do +updateCmd :: Maybe Branch -> [String] -> IO () +updateCmd mbr args = do pkgGit <- isPkgGitRepo - let (mver,pkgs) = - if pkgGit - then (listToMaybe args, if length args > 1 then error' "cannot specify packages in a dist-git repo" else []) - else (Nothing, args) - withPackageByBranches (Just False) dirtyGitFetch Nothing True ZeroOrOne (updatePkg mver) pkgs + let (mver,pkgs) = case args of + [a] -> if pkgGit then (Just a,[]) else (Nothing,[a]) + _ -> (Nothing,args) + withPackagesMaybeBranch (Just False) dirtyGitFetch ZeroOrOne (updatePkg mver) mbr pkgs where updatePkg :: Maybe String -> Package -> AnyBranch -> IO () updatePkg mver pkg br = do diff --git a/src/Koji.hs b/src/Koji.hs --- a/src/Koji.hs +++ b/src/Koji.hs @@ -173,10 +173,11 @@ Left task <- kojiBuildBranch' False target pkg mref args return task -kojiWaitRepo :: String -> String -> IO () -kojiWaitRepo target nvr = do +kojiWaitRepo :: Bool -> String -> String -> IO () +kojiWaitRepo dryrun target nvr = do Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub target - waitRepo buildtag Nothing + unless dryrun $ + waitRepo buildtag Nothing where waitRepo :: String -> Maybe Struct -> IO () waitRepo buildtag moldrepo = do diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,7 +1,7 @@ module Main (main) where import Distribution.Fedora.Branch -import Options.Applicative (eitherReader, ReadM) +import Options.Applicative (maybeReader, ReadM) import SimpleCmdArgs -- commands @@ -49,70 +49,70 @@ [ Subcommand "clone" "clone packages" $ cloneCmd <$> optional branchOpt <*> cloneRequest , Subcommand "switch" "Switch branch" $ - switchCmd <$> branchesPackages + switchCmd <$> anyBranchArg <*> manyPackages , Subcommand "nvr" "Print name-version-release" $ - nvrCmd <$> branchesOpt <*> branchesPackages + nvrCmd <$> branchesPackages , Subcommand "status" "Status package/branch status" $ - statusCmd <$> switchWith 'n' "no-fetch" "Do not git fetch to save time" <*> switchWith 'r' "reviews" "Status of reviewed packages" <*> branchesOpt <*> branchesPackages + statusCmd <$> switchWith 'n' "no-fetch" "Do not git fetch to save time" <*> switchWith 'r' "reviews" "Status of reviewed packages" <*> branchesPackages , Subcommand "merge" "Merge from newer branch" $ mergeCmd <$> nopromptOpt <*> branchesPackages , Subcommand "build" "Build package(s) in Koji" $ - buildCmd <$> buildOpts <*> branchesOpt <*> branchesPackages + buildCmd <$> buildOpts <*> branchesPackages , Subcommand "list" "List packages in pagure" $ listCmd <$> switchWith 'c' "count" "Print number of packages" <*> optional packagerOpt <*> many (pkgArg "PKGPAT...") , Subcommand "branches" "List package branches" $ - branchesCmd <$> switchWith 'd' "skip-dead" "Skip if dead.package exists" <*> switchWith 'a' "all" "List all branches" <*> switchWith 'm' "missing" "Show missing branches" <*> switchWith 'r' "remote" "List remote branches" <*> many (pkgArg "PACKAGE...") + branchesCmd <$> switchWith 'd' "skip-dead" "Skip if dead.package exists" <*> switchWith 'a' "all" "List all branches" <*> switchWith 'm' "missing" "Show missing branches" <*> switchWith 'r' "remote" "List remote branches" <*> branchesPackages , Subcommand "parallel" "Parallel build packages in Koji" $ - parallelBuildCmd <$> dryrunOpt <*> optional sidetagTargetOpt <*> updatetypeOpt <*> branchesOpt <*> branchesPackages + parallelBuildCmd <$> dryrunOpt <*> optional sidetagTargetOpt <*> updatetypeOpt <*> branchesPackages , Subcommand "sidetags" "List user's side-tags" $ sideTagsCmd <$> many branchArg , Subcommand "override" "Tag builds into buildroot override in Koji" $ - overrideCmd <$> dryrunOpt <*> branchesPackages + overrideCmd <$> dryrunOpt <*> many branchArg <*> manyPackages , Subcommand "scratch" "Scratch build package in Koji" $ scratchCmd <$> dryrunOpt <*> rebuildSrpmOpt <*> noFailFastOpt <*> optional archesOpt <*> mtargetOpt <*> branchesPackages , Subcommand "update" "Update package to newer version" $ - updateCmd <$> many (pkgArg "[VERSION] [PKG...]") + updateCmd <$> optional branchArg <*> manyPackages , Subcommand "sort" "Sort packages in build dependency order" $ - sortCmd <$> optional rpmWithOpt <*> branchesPackages + sortCmd <$> optional rpmWithOpt <*> optional branchArg <*> somePackages , Subcommand "prep" "Prep sources" $ - prepCmd <$> branchesPackages + prepCmd <$> optional branchArg <*> manyPackages , Subcommand "local" "Build locally" $ localCmd <$> optional forceshortOpt <*> many bcondOpt <*> branchesPackages , Subcommand "srpm" "Build srpm" $ - srpmCmd <$> switchWith 'f' "force" "regenerate even if spec older than existing srpm" <*> branchesPackages + srpmCmd <$> switchWith 'f' "force" "regenerate even if spec older than existing srpm" <*> optional branchArg <*> manyPackages , Subcommand "diff" "Diff local changes" $ - diffCmd <$> diffSpecOnly <*> diffWorkOpt <*> diffFormatOpt <*> diffBranchOpt <*> branchesPackages + diffCmd <$> diffSpecOnly <*> diffWorkOpt <*> diffFormatOpt <*> diffBranchOpt <*> optional branchArg <*> manyPackages , Subcommand "log" "Show commits between branches" $ - logCmd <$> switchWith 'l' "long" "show full commit log" <*> anyBranchArg <*> anyBranchArg <*> many (pkgArg "PACKAGE...") + logCmd <$> switchWith 'l' "long" "show full commit log" <*> anyBranchArg <*> anyBranchArg <*> manyPackages , Subcommand "mock" "Local mock build" $ mockCmd <$> switchWith 'd' "dry-run" "Do not build (but creates srpm)" <*> switchWith 'n' "no-clean" "Do not clean chroot before building a package" <*> switchWith 'w' "network" "Use network during build" <*> switchWith 'N' "no-clean-after" "Don't clean chroot after building a package" <*> optional (optionWith branchM 'r' "root" "BRANCH" "Mock config to use") <*> branchesPackages , Subcommand "install-deps" "Install package build dependencies" $ - installDepsCmd <$> branchesPackages + installDepsCmd <$> optional branchArg <*> manyPackages , Subcommand "install" "Build locally and install package(s)" $ -- FIXME drop --shortcircuit from install? - installCmd <$> switchWith 'r' "recurse" "build and install missing deps packages" <*> optional forceshortOpt <*> many bcondOpt <*> switchWith 'r' "reinstall" "reinstall rpms" <*> branchesPackages + installCmd <$> switchWith 'R' "recurse" "build and install missing deps packages" <*> optional forceshortOpt <*> many bcondOpt <*> switchWith 'r' "reinstall" "reinstall rpms" <*> optional branchArg <*> manyPackages , Subcommand "not-installed" "Packages not installed locally" $ - notInstalledCmd <$> branchesPackages + notInstalledCmd <$> optional branchArg <*> manyPackages , Subcommand "bugs" "List package bugs" $ - bugsCmd <$> optional (strOptionWith 's' "summary" "KEY" "Search for bugs containing keyword") <*> many (pkgArg "PACKAGE...") + bugsCmd <$> optional (strOptionWith 's' "summary" "KEY" "Search for bugs containing keyword") <*> manyPackages , Subcommand "bump" "Bump release for package" $ - bumpPkgs <$> optional commitOpts <*> branchesOpt <*> branchesPackages + bumpPkgs <$> optional commitOpts <*> branchesPackages , Subcommand "commit" "Git commit packages" $ - commitPkgs <$> optional commitOpts <*> many (pkgArg "PACKAGE...") + commitPkgs <$> optional commitOpts <*> manyPackages , Subcommand "pull" "Git pull packages" $ pullPkgs <$> branchesPackages , Subcommand "create-review" "Create a Package Review request" $ - createReview <$> noScratchBuild <*> mockOpt False <*> many (pkgArg "PACKAGE...") + createReview <$> noScratchBuild <*> mockOpt False <*> manyPackages , Subcommand "update-review" "Update a Package Review" $ updateReview <$> noScratchBuild <*> mockOpt False <*> optional (strArg "SPECFILE") , Subcommand "reviews" "List package reviews" $ reviewsCmd <$> reviewShortOpt <*> reviewAllStatusOpt <*> switchWith 'T' "assigned-to" "List reviews assigned to user" <*> optional (strOptionWith 'U' "user" "USER" "Bugzilla user email") <*> reviewStatusOpt , Subcommand "request-repos" "Request dist git repo for new approved packages" $ - requestRepos <$> reviewAllStatusOpt <*> switchWith 'r' "retry" "Re-request repo" <*> branchesOpt <*> many (pkgArg "NEWPACKAGE...") + requestRepos <$> mockOpt True <*> reviewAllStatusOpt <*> switchWith 'r' "retry" "Re-request repo" <*> branchesPackages , Subcommand "import" "Import new approved created packages from bugzilla review" $ - importCmd <$> mockOpt True <*> many (pkgArg "NEWPACKAGE...") + importCmd <$> mockOpt True <*> branchesPackages , Subcommand "request-branches" "Request branches for approved created packages" $ - requestBranches <$> mockOpt False <*> optional branchesRequestOpt <*> branchesPackages + requestBranches <$> mockOpt False <*> branchesPackages , Subcommand "find-review" "Find package review bug" $ findReview <$> pkgArg "PACKAGE" , Subcommand "review-package" "Run fedora-review on a package Review Request bug" $ @@ -120,15 +120,15 @@ -- , Subcommand "test-bz-token" "Check bugzilla login status" $ -- pure testBZlogin , Subcommand "command" "Run shell command in package dirs ($p)" $ - commandCmd <$> switchWith 'o' "if-output" "only print if output" <*> commandOpt <*> branchesOpt <*> branchesPackages + commandCmd <$> switchWith 'o' "if-output" "only print if output" <*> commandOpt <*> branchesPackages , Subcommand "copr" "Build package(s) in Fedora Copr" $ - coprCmd <$> dryrunOpt <*> buildByOpt <*> many archOpt <*> pkgArg "PROJECT" <*> branchesOpt <*> branchesPackages + coprCmd <$> dryrunOpt <*> switchWith 'l' "list-chroots" "Show project chroots" <*> buildByOpt <*> many archOpt <*> pkgArg "PROJECT" <*> branchesPackages , Subcommand "rename-master" "Rename local master branch to rawhide" $ - renameMasterCmd <$> many (pkgArg "[PACKAGE]...") + renameMasterCmd <$> manyPackages ] where cloneRequest :: Parser CloneRequest - cloneRequest = flagWith' (CloneUser Nothing) 'M' "mine" "Your packages" <|> CloneUser . Just <$> strOptionWith 'u' "user" "USER" "Packages of FAS user" <|> ClonePkgs <$> some (pkgArg "PACKAGE...") + cloneRequest = flagWith' (CloneUser Nothing) 'M' "mine" "Your packages" <|> CloneUser . Just <$> strOptionWith 'u' "user" "USER" "Packages of FAS user" <|> ClonePkgs <$> somePackages noScratchBuild = switchWith 'S' "no-scratch-build" "Skip Koji scratch build" @@ -157,8 +157,11 @@ anyBranchArg :: Parser AnyBranch anyBranchArg = argumentWith anyBranchM "BRANCH" + -- anyBranchOpt :: Parser AnyBranch + -- anyBranchOpt = optionWith anyBranchM 'b' "branch" "BRANCH" "branch" + branchM :: ReadM Branch - branchM = eitherReader eitherBranch' + branchM = maybeReader readBranch anyBranchM :: ReadM AnyBranch anyBranchM = anyBranch <$> str @@ -166,6 +169,12 @@ pkgArg :: String -> Parser String pkgArg lbl = removeSuffix "/" <$> strArg lbl + manyPackages :: Parser [String] + manyPackages = many (pkgArg "PACKAGE...") + + somePackages :: Parser [String] + somePackages = some (pkgArg "PACKAGE...") + branchesOpt :: Parser (Maybe BranchOpts) branchesOpt = optional (flagWith' AllBranches 'B' "all-branches" "All active release branches" <|> @@ -176,13 +185,22 @@ excludeBranchOpt :: Parser Branch excludeBranchOpt = optionWith branchM 'x' "exclude-branch" "BRANCH" "branch" - branchesPackages :: Parser [String] - branchesPackages = many (pkgArg "[BRANCH]... [PACKAGE]...") + -- branchesRequestOpt :: Parser BranchOpts + -- branchesRequestOpt = + -- flagWith' AllBranches 'B' "all-branches" "Request branches for all current releases [default latest 2]" <|> + -- ExcludeBranches <$> some excludeBranchOpt - branchesRequestOpt :: Parser BranchOpts - branchesRequestOpt = - flagWith' AllBranches 'B' "all-branches" "Request branches for all current releases [default latest 2]" <|> - ExcludeBranches <$> some excludeBranchOpt + branchesPackages :: Parser (BranchesReq, [String]) + branchesPackages = + branchesReqPkgs <$> branchesOpt <*> many (pkgArg "BRANCH... PACKAGE...") + where + branchesReqPkgs :: Maybe BranchOpts -> [String] -> (BranchesReq, [String]) + branchesReqPkgs mbrnchopts args = + let (brs,pkgs) = partitionBranches args + in case mbrnchopts of + Nothing -> (Branches brs, pkgs) + Just req | null brs -> (BranchOpt req, pkgs) + | otherwise -> error' "cannot have branch option and branch list" rpmWithOpt :: Parser RpmWith rpmWithOpt = @@ -255,7 +273,7 @@ buildByOpt = flagWith' SingleBuild 'S' "single" "Non-progressive normal single build" <|> flagWith' BuildByRelease 'R' "by-release" "Builds by release" <|> flagWith ValidateByRelease ValidateByArch 'A' "by-arch" "Build across latest release archs first (default is across releases for primary arch)" - commandOpt = strOptionWith 'c' "cmd" "COMMAND" "Shell command to run in $p" + commandOpt = strOptionWith 'c' "cmd" "SHELLCOMMAND" "Shell command to run in $p" sidetagTargetOpt :: Parser SideTagTarget sidetagTargetOpt = diff --git a/src/Package.hs b/src/Package.hs --- a/src/Package.hs +++ b/src/Package.hs @@ -27,10 +27,11 @@ putPkgAnyBrnchHdr, withExistingDirectory, initialPkgRepo, - splitBranchesPkgs, +-- splitBranchesPkgs, -- withBranchByPackages, withPackageByBranches, - withPackageByBranches', +-- withPackageByBranches', + withPackagesMaybeBranch, LimitBranches(..), cleanGit, cleanGitFetch, @@ -77,8 +78,8 @@ have <- doesFileExist spec unless have $ error' $ spec ++ " not found" -getChangeLog :: FilePath -> IO String -getChangeLog spec = do +getChangeLog :: Maybe String -> FilePath -> IO String +getChangeLog mcontext spec = do clog <- cleanChangelog <$> cmd "rpmspec" ["-q", "--srpm", "--qf", "%{changelogtext}", spec] putStrLn "" putStrLn "```" @@ -87,7 +88,7 @@ ifM (not <$> isTty) (return clog) $ do - userlog <- prompt "Press Enter to use above or input change summary now" + userlog <- prompt $ "Press Enter to use above or input " ++ fromMaybe "change" mcontext ++ " summary now" return $ if null userlog then clog else userlog cleanChangelog :: String -> String @@ -371,63 +372,63 @@ data BrPkg = IsBr AnyBranch | Unknown String | IsPkg String deriving Show -splitBranchesPkgs :: Bool -> Maybe BranchOpts -> Bool -> [String] - -> IO ([AnyBranch], [String]) -splitBranchesPkgs release mbrnchopts exists args = do - pkggit <- isPkgGitRepo - brPkgs <- mapM (toBrPkg pkggit) args - let (brs,pkgs) = brPkgsToBranchesPkgs brPkgs - return $ case mbrnchopts of - Just _ | brs /= [] -> error' "cannot specify branches with branch options" - _ -> (brs,pkgs) - where - toBrPkg :: Bool -> String -> IO BrPkg - toBrPkg gitdir str = - case anyBranch str of - rbr@(RelBranch _) -> return (IsBr rbr) - abr@(OtherBranch p) -> if release then return (IsPkg p) - else - ifM (isPath str) - (return $ IsPkg str) $ - if gitdir - then return (IsBr abr) - else return $ if exists - then IsBr abr - else IsPkg str - where - isPath :: FilePath -> IO Bool - isPath fp = - if ".spec" `isExtensionOf` fp - then do - exists' <- doesFileExist fp - unless exists' $ error' $ fp ++ " file not found" - return True - else do - exists' <- doesDirectoryExist fp - let ispath = '/' `elem` fp - when (not exists' && ispath) $ - error' $ fp ++ " directory not found" - return exists' +-- splitBranchesPkgs :: Bool -> Maybe BranchOpts -> Bool -> [String] +-- -> IO ([AnyBranch], [String]) +-- splitBranchesPkgs release mbrnchopts exists args = do +-- pkggit <- isPkgGitRepo +-- brPkgs <- mapM (toBrPkg pkggit) args +-- let (brs,pkgs) = brPkgsToBranchesPkgs brPkgs +-- return $ case mbrnchopts of +-- Just _ | brs /= [] -> error' "cannot specify branches with branch options" +-- _ -> (brs,pkgs) +-- where +-- toBrPkg :: Bool -> String -> IO BrPkg +-- toBrPkg gitdir str = +-- case anyBranch str of +-- rbr@(RelBranch _) -> return (IsBr rbr) +-- abr@(OtherBranch p) -> if release then return (IsPkg p) +-- else +-- ifM (isPath str) +-- (return $ IsPkg str) $ +-- if gitdir +-- then return (IsBr abr) +-- else return $ if exists +-- then IsBr abr +-- else IsPkg str +-- where +-- isPath :: FilePath -> IO Bool +-- isPath fp = +-- if ".spec" `isExtensionOf` fp +-- then do +-- exists' <- doesFileExist fp +-- unless exists' $ error' $ fp ++ " file not found" +-- return True +-- else do +-- exists' <- doesDirectoryExist fp +-- let ispath = '/' `elem` fp +-- when (not exists' && ispath) $ +-- error' $ fp ++ " directory not found" +-- return exists' - brPkgsToBranchesPkgs :: [BrPkg] -> ([AnyBranch], [String]) - brPkgsToBranchesPkgs brpkgs = - let (pbrs,ppkgs) = span isBranch brpkgs - in (map toBranch pbrs, map toPackage ppkgs) - where - isBranch :: BrPkg -> Bool - isBranch (IsBr _) = True - isBranch (Unknown _) = True - isBranch (IsPkg _) = False +-- brPkgsToBranchesPkgs :: [BrPkg] -> ([AnyBranch], [String]) +-- brPkgsToBranchesPkgs brpkgs = +-- let (pbrs,ppkgs) = span isBranch brpkgs +-- in (map toBranch pbrs, map toPackage ppkgs) +-- where +-- isBranch :: BrPkg -> Bool +-- isBranch (IsBr _) = True +-- isBranch (Unknown _) = True +-- isBranch (IsPkg _) = False - toBranch :: BrPkg -> AnyBranch - toBranch (IsBr br) = br - toBranch (Unknown br) = OtherBranch br - toBranch (IsPkg p) = error' $ "can't map package to branch: " ++ p +-- toBranch :: BrPkg -> AnyBranch +-- toBranch (IsBr br) = br +-- toBranch (Unknown br) = OtherBranch br +-- toBranch (IsPkg p) = error' $ "can't map package to branch: " ++ p - toPackage :: BrPkg -> String - toPackage (IsPkg p) = p - toPackage (Unknown p) = p - toPackage (IsBr b) = error' $ "can't map branch to package: " ++ show b +-- toPackage :: BrPkg -> String +-- toPackage (IsPkg p) = p +-- toPackage (Unknown p) = p +-- toPackage (IsBr b) = error' $ "can't map branch to package: " ++ show b data GitOpts = GitOpts @@ -444,108 +445,112 @@ dirtyGit = Just $ GitOpts False False False dirtyGitFetch = Just $ GitOpts False True False -data LimitBranches = AnyNumber | Zero | ZeroOrOne | ExactlyOne +data LimitBranches = AnyNumber | ZeroOrOne | ExactlyOne deriving Eq -- do package over branches +-- withPackageByBranches :: Maybe Bool +-- -> Maybe GitOpts +-- -> Maybe BranchOpts +-- -> Bool +-- -> LimitBranches +-- -> (Package -> AnyBranch -> IO ()) +-- -> [String] +-- -> IO () +-- withPackageByBranches mheader mgitopts mbrnchopts exists limitBranches action args = do +-- (brs,pkgs) <- splitBranchesPkgs (have gitOptActive) mbrnchopts exists args +-- let mheader' = +-- case mheader of +-- Nothing -> Nothing +-- Just _ | length pkgs < 2 && length brs < 2 && isNothing mbrnchopts -> Nothing +-- _ -> mheader +-- withPackageByBranches' mheader' mgitopts mbrnchopts limitBranches action (brs,pkgs) +-- where +-- have :: (GitOpts -> Bool) -> Bool +-- have opt = maybe False opt mgitopts + +-- FIXME rename to withPackages* withPackageByBranches :: Maybe Bool -> Maybe GitOpts - -> Maybe BranchOpts - -> Bool -> LimitBranches -> (Package -> AnyBranch -> IO ()) - -> [String] + -> (BranchesReq,[String]) -> IO () -withPackageByBranches mheader mgitopts mbrnchopts exists limitBranches action args = do - (brs,pkgs) <- splitBranchesPkgs (have gitOptActive) mbrnchopts exists args - let mheader' = - case mheader of - Nothing -> Nothing - Just _ | length pkgs < 2 && length brs < 2 -> Nothing - _ -> mheader - withPackageByBranches' mheader' mgitopts mbrnchopts limitBranches action (brs,pkgs) - where - have :: (GitOpts -> Bool) -> Bool - have opt = maybe False opt mgitopts - -withPackageByBranches' :: Maybe Bool - -> Maybe GitOpts - -> Maybe BranchOpts - -> LimitBranches - -> (Package -> AnyBranch -> IO ()) - -> ([AnyBranch], [String]) - -> IO () -withPackageByBranches' mheader mgitopts mbrnchopts limitBranches action (brs,pkgs) = do - case mbrnchopts of - Just _ -> - unless (null brs) $ - error' "cannot specify branches and branch option together" - Nothing -> - case limitBranches of - Zero | not (null brs) -> - error' $ "package not found: " ++ unwords (map show brs) - ZeroOrOne | length brs > 1 -> - -- FIXME: could be handled better (testcase: run long list of packages in wrong directory) - error' $ "more than one branch given or packages not found: " ++ unwords (tail (map show brs)) - ExactlyOne | null brs -> - error' "please specify one branch" - ExactlyOne | length brs > 1 -> - error' "please only specify one branch" - _ -> return () +withPackageByBranches mheader mgitopts limitBranches action (breq,pkgs) = if null pkgs - then do + then withPackageDir "." else do - when (length pkgs > 1 && null brs) $ + when (length pkgs > 1 && breq == Branches []) $ error' "At least one branch must be specified when there are multiple packages" mapM_ withPackageDir pkgs where -- FIXME support arbitrary (module) branches withPackageDir :: FilePath -> IO () withPackageDir path = do - let dir = - if ".spec" `isExtensionOf` path - then takeDirectory path - else path - withExistingDirectory dir $ do - mspec <- if ".spec" `isExtensionOf` path - then return $ Just $ takeFileName path - else maybeFindSpecfile - pkg <- Package <$> - case mspec of - -- FIXME fails if spec file can't be parsed and also is *slow* - -- cmd "rpmspec" ["-q", "--srpm", "--qf", "%{name}", spec] - -- For now assume spec filename = package name - Just spec -> return $ takeBaseName spec - Nothing -> getDirectoryName - unless (isNothing mspec || mspec == Just (unPackage pkg <.> "spec")) $ - putStrLn "Warning: package name and spec filename differ!" - haveGit <- isPkgGitRepo - when (isJust mgitopts && not haveGit) $ - error' $ "Not a pkg git dir: " ++ unPackage pkg - mcurrentbranch <- if haveGit then Just <$> gitCurrentBranch - else return Nothing - let fetch = have gitOptFetch - when ((isJust mheader || fetch) && dir /= ".") $ - case brs of - [br] -> when (fetch || mheader == Just True) $ putPkgAnyBrnchHdr pkg br - _ -> when (fetch || isJust mheader) $ putPkgHdr pkg - when haveGit $ - when (have gitOptClean) checkWorkingDirClean - when fetch $ gitFetchSilent >> putStrLn "" - branches <- listOfBranches haveGit (have gitOptActive) mbrnchopts brs - when (mbrnchopts == Just AllBranches) $ - putStrLn $ "Branches: " ++ unwords (map show branches) ++ "\n" - -- FIXME add newline at end? - let action' p b = do - when (isJust mheader && length brs > 1) $ putPkgAnyBrnchHdr p b - action p b - mapM_ (action' pkg) branches - when (length branches /= 1) $ - whenJust mcurrentbranch gitSwitchBranch + let dir = + if ".spec" `isExtensionOf` path + then takeDirectory path + else path + withExistingDirectory dir $ do + mspec <- if ".spec" `isExtensionOf` path + then return $ Just $ takeFileName path + else maybeFindSpecfile + pkg <- Package <$> + case mspec of + -- FIXME fails if spec file can't be parsed and also is *slow* + -- cmd "rpmspec" ["-q", "--srpm", "--qf", "%{name}", spec] + -- For now assume spec filename = package name + Just spec -> return $ takeBaseName spec + Nothing -> getDirectoryName + unless (isNothing mspec || mspec == Just (unPackage pkg <.> "spec")) $ + putStrLn "Warning: package name and spec filename differ!" + haveGit <- isPkgGitRepo + when (isJust mgitopts && not haveGit) $ + error' $ "Not a pkg git dir: " ++ unPackage pkg + mcurrentbranch <- if haveGit then Just <$> gitCurrentBranch + else return Nothing + brs <- listOfAnyBranches haveGit (have gitOptActive) breq + case limitBranches of + ZeroOrOne | length brs > 1 -> + -- FIXME: could be handled better (testcase: run long list of packages in wrong directory) + error' $ "more than one branch given: " ++ unwords (map show brs) + ExactlyOne | null brs -> + error' "please specify one branch" + ExactlyOne | length brs > 1 -> + error' "please only specify one branch" + _ -> return () + let fetch = have gitOptFetch + when ((isJust mheader || fetch) && dir /= ".") $ + case brs of + [br] -> when (fetch || mheader == Just True) $ putPkgAnyBrnchHdr pkg br + _ -> when (fetch || isJust mheader) $ putPkgHdr pkg + when haveGit $ + when (have gitOptClean) checkWorkingDirClean + when fetch $ gitFetchSilent >> putStrLn "" + -- FIXME!! no branch restriction + when (breq == BranchOpt AllBranches) $ + putStrLn $ "Branches: " ++ unwords (map show brs) ++ "\n" + -- FIXME add newline at end? + let action' p b = do + when (isJust mheader && length brs > 1) $ putPkgAnyBrnchHdr p b + action p b + mapM_ (action' pkg) brs + when (length brs /= 1) $ + whenJust mcurrentbranch gitSwitchBranch have :: (GitOpts -> Bool) -> Bool have opt = maybe False opt mgitopts + +withPackagesMaybeBranch :: Maybe Bool + -> Maybe GitOpts + -> LimitBranches + -> (Package -> AnyBranch -> IO ()) + -> Maybe Branch + -> [String] + -> IO () +withPackagesMaybeBranch mheader mgitopts limitBranches action mbr pkgs = + withPackageByBranches mheader mgitopts limitBranches action (Branches (maybeToList mbr),pkgs) -- -- do branch over packages -- withBranchByPackages :: (Branch -> [String] -> IO ()) -> (Branches,[String]) -> IO ()