fbrnch 0.7.3 → 0.8.0
raw patch · 30 files changed
+645/−669 lines, 30 filesdep ~basedep ~directoryPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, directory
API changes (from Hackage documentation)
Files
- CHANGELOG.md +14/−0
- README.md +0/−2
- fbrnch.cabal +69/−132
- libs/koji-hs/src/Fedora/Koji.hs +3/−3
- src/Bodhi.hs +16/−14
- src/Branches.hs +68/−41
- src/Bugzilla.hs +4/−3
- src/Cmd/Build.hs +50/−55
- src/Cmd/Bump.hs +3/−3
- src/Cmd/Copr.hs +18/−18
- src/Cmd/Diff.hs +3/−3
- src/Cmd/Import.hs +6/−5
- src/Cmd/Install.hs +6/−6
- src/Cmd/ListBranches.hs +21/−19
- src/Cmd/Local.hs +26/−25
- src/Cmd/Merge.hs +2/−2
- src/Cmd/Mock.hs +14/−16
- src/Cmd/Override.hs +7/−9
- src/Cmd/Parallel.hs +65/−65
- src/Cmd/PkgReview.hs +3/−3
- src/Cmd/Pull.hs +2/−2
- src/Cmd/RequestBranch.hs +14/−34
- src/Cmd/RequestRepo.hs +9/−10
- src/Cmd/Scratch.hs +3/−3
- src/Cmd/Status.hs +3/−4
- src/Cmd/Switch.hs +6/−5
- src/Cmd/Update.hs +6/−7
- src/Koji.hs +4/−3
- src/Main.hs +54/−36
- src/Package.hs +146/−141
CHANGELOG.md view
@@ -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
README.md view
@@ -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
fbrnch.cabal view
@@ -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
libs/koji-hs/src/Fedora/Koji.hs view
@@ -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 -> ("<value><string>" ++ target ++ "</string></value>") `isInfixOf` req) mtarget+ maybe True (`L.isInfixOf` req) msource &&+ maybe True (\ target -> ("<value><string>" ++ target ++ "</string></value>") `L.isInfixOf` req) mtarget -- getTagID :: String -- ^ tag -- -> IO TagID
src/Bodhi.hs view
@@ -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
src/Branches.hs view
@@ -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
src/Bugzilla.hs view
@@ -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
src/Cmd/Build.hs view
@@ -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 =
src/Cmd/Bump.hs view
@@ -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
src/Cmd/Copr.hs view
@@ -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
src/Cmd/Diff.hs view
@@ -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
src/Cmd/Import.hs view
@@ -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
src/Cmd/Install.hs view
@@ -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
src/Cmd/ListBranches.hs view
@@ -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 ++ ": "
src/Cmd/Local.hs view
@@ -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
src/Cmd/Merge.hs view
@@ -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 _) =
src/Cmd/Mock.hs view
@@ -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
src/Cmd/Override.hs view
@@ -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
src/Cmd/Parallel.hs view
@@ -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]
src/Cmd/PkgReview.hs view
@@ -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
src/Cmd/Pull.hs view
@@ -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 =
src/Cmd/RequestBranch.hs view
@@ -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
src/Cmd/RequestRepo.hs view
@@ -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]
src/Cmd/Scratch.hs view
@@ -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
src/Cmd/Status.hs view
@@ -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 ()
src/Cmd/Switch.hs view
@@ -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
src/Cmd/Update.hs view
@@ -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
src/Koji.hs view
@@ -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
src/Main.hs view
@@ -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 =
src/Package.hs view
@@ -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 ()