fbrnch 1.3.1 → 1.3.2
raw patch · 38 files changed
+313/−261 lines, 38 filesdep ~simple-prompt
Dependency ranges changed: simple-prompt
Files
- CHANGELOG.md +17/−0
- README.md +3/−1
- fbrnch.cabal +3/−4
- src/Bodhi.hs +14/−11
- src/Branches.hs +24/−26
- src/Bugzilla.hs +16/−16
- src/Cmd/Build.hs +13/−10
- src/Cmd/Commit.hs +3/−6
- src/Cmd/Copr.hs +5/−5
- src/Cmd/Diff.hs +1/−1
- src/Cmd/Import.hs +4/−4
- src/Cmd/Install.hs +4/−3
- src/Cmd/ListBranches.hs +4/−4
- src/Cmd/Merge.hs +5/−3
- src/Cmd/Override.hs +2/−2
- src/Cmd/Owner.hs +1/−1
- src/Cmd/Parallel.hs +27/−20
- src/Cmd/PkgReview.hs +8/−7
- src/Cmd/Prep.hs +4/−5
- src/Cmd/PullPush.hs +1/−1
- src/Cmd/RequestBranch.hs +13/−10
- src/Cmd/RequestRepo.hs +6/−6
- src/Cmd/Scratch.hs +3/−3
- src/Cmd/SideTags.hs +2/−2
- src/Cmd/Sort.hs +6/−4
- src/Cmd/SrcDeps.hs +6/−6
- src/Cmd/Status.hs +9/−9
- src/Cmd/Update.hs +13/−11
- src/Cmd/WaitRepo.hs +1/−1
- src/Common.hs +2/−0
- src/Common/System.hs +1/−1
- src/Git.hs +10/−10
- src/Koji.hs +16/−15
- src/Main.hs +3/−2
- src/Package.hs +27/−27
- src/Pagure.hs +2/−2
- src/RpmBuild.hs +33/−22
- src/Types.hs +1/−0
CHANGELOG.md view
@@ -1,5 +1,22 @@ # Changelog +## 1.3.2 (2023-05-30)+- prompts now support line-editting thanks to simple-prompt-0.2 using haskeline+- 'parallel', 'sort', 'graph': use getDynSourcesMacros+- 'parallel': include no of layers in "more package layers" message+- 'parallel': output sidetag+- 'prep': default to --nodeps+- 'request-branches': output owners (to ask) if no permission+- 'request-branches': committers can also request branches+- 'scratch': print target for srpm build (only)+- 'src-deps': add --define 'MACRO DEF'+- 'update-version': munch spectool patch filenames too+- Bodhi only accepts update notes <= 10000 characters now+- Git refPrompt: also accept y/yes+- Koji targetMaybeSidetag dryrun: do not append "-dryrun" to buildtag+- Merge: newline after local commits+- Package cleanChangelog: append a newline+ ## 1.3.1 (2023-04-09) - check for %autorelease more carefully - buildRequires: fix dynamic BRs with getSources and space after %_srcrpmdir
README.md view
@@ -259,7 +259,7 @@ ``` $ fbrnch --version-1.3+1.3.2 $ fbrnch --help Fedora branch building tool @@ -418,6 +418,8 @@ (specifically koji, bodhi-client, fedpkg), but all queries are done directly by Web APIs for speed and control. - https checkouts are currently treated as anonymous git checkouts+- parallel and sort, etc do not take pkgconfig() and other meta() deps into+ account yet (this will be fixed in rpmbuild-order) ## Motivation, history, talks This project started off as a simple tool to build a package across branches
fbrnch.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch-version: 1.3.1+version: 1.3.2 synopsis: Fedora packager tool to build package branches description: fbrnch (fedora branch) is a convenient packaging tool for@@ -34,7 +34,7 @@ README.md tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.7,- GHC == 9.4.4+ GHC == 9.4.5 source-repository head type: git@@ -113,7 +113,6 @@ extra, fedora-dists >= 2.1.1, filepath,- -- haskeline, http-conduit, http-directory >= 0.1.5, http-query,@@ -127,7 +126,7 @@ rpm-nvr >= 0.1.2, simple-cmd >= 0.2.3, simple-cmd-args >= 0.1.8,- simple-prompt,+ simple-prompt >= 0.2, text, time, typed-process >= 0.2.4.0,
src/Bodhi.hs view
@@ -17,7 +17,7 @@ import Data.Aeson.Types (Object, (.:), parseEither) import Data.Char (isDigit) import Fedora.Bodhi hiding (bodhiUpdate)-import SimplePrompt+import SimplePrompt (promptEnter, promptNonEmpty) import Text.Read import qualified Text.ParserCombinators.ReadP as R import qualified Text.ParserCombinators.ReadPrec as RP@@ -41,7 +41,7 @@ -- Error in $: key "create_automatic_updates" not found lookupKey'' :: T.Text -> Object -> Bool lookupKey'' k obj =- let errMsg e = error $ e ++ " " ++ show obj in+ let errMsg e = error $ e +-+ show obj in -- bodhi-hs has lookupKeyEither either errMsg id $ parseEither (.: fromText k) obj @@ -54,7 +54,7 @@ -- FIXME handle expired override? bodhiCreateOverride :: Bool -> Maybe Int -> String -> IO () bodhiCreateOverride dryrun mduration nvr = do- putStrLn $ "Creating Bodhi Override for " ++ nvr ++ ":"+ putStrLn $ "Creating Bodhi Override for" +-+ nvr ++ ":" unless dryrun $ do ok <- cmdBool "bodhi" ["overrides", "save", "--notes", "chain building with fbrnch", "--duration", show (fromMaybe 4 mduration), "--no-wait", nvr] if ok@@ -64,7 +64,7 @@ case moverride of Nothing -> do putStrLn "bodhi override failed"- prompt_ "Press Enter to retry"+ promptEnter "Press Enter to retry" bodhiCreateOverride dryrun mduration nvr -- FIXME prettyprint Just obj -> error' $ show obj@@ -123,6 +123,7 @@ Nothing -> Nothing Just _ -> lookupKey' "testing_tag" obj +-- FIXME support --no-close-bugs -- push comma separated list of builds for a package to bodhi bodhiUpdate :: Bool -> (Maybe UpdateType, UpdateSeverity) -> Maybe BugId -> Bool -> FilePath -> String -> IO ()@@ -148,10 +149,12 @@ then cleanChangelog spec else -- FIXME list open bugs- changeLogPrompt (Just "update") spec+ changeLogPrompt True spec if trim (lower changelog) `elem` ["no","n"] then return False else do+ when (length changelog > 10000) $+ putStrLn "Bodhi only accepts up to 10000 chars: will be truncated" let cbugs = extractBugReferences changelog bugs = let bids = [show rev | Just rev <- [mreview]] ++ cbugs in@@ -161,19 +164,19 @@ when (isJust mreview && updateType `elem` [SecurityUpdate,BugfixUpdate]) $ warning "overriding update type with 'newpackage'"- putStrLn $ "Creating Bodhi Update for " ++ nvrs ++ ":"+ putStrLn $ "Creating Bodhi Update for" +-+ nvrs ++ ":" -- FIXME check for Bodhi URL to confirm update -- FIXME returns json error string if it exists: -- {"status": "error", "errors": [{"location": "body", "name": "builds", "description": "Update for ghc9.2-9.2.5-14.fc36 already exists"}]}- cmd_ "bodhi" $ ["updates", "new", "--type", if isJust mreview then "newpackage" else show updateType, "--severity", show severity, "--request", "testing", "--notes", changelog, "--autokarma", "--autotime", "--close-bugs"] ++ bugs ++ [nvrs]+ cmd_ "bodhi" $ ["updates", "new", "--type", if isJust mreview then "newpackage" else show updateType, "--severity", show severity, "--request", "testing", "--notes", take 10000 changelog, "--autokarma", "--autotime", "--close-bugs"] ++ bugs ++ [nvrs] return True when updatedone $ do -- FIXME avoid this if we know the update URLs (split update does not seem to return URLs) updates <- bodhiUpdates [makeItem "display_user" "0", makeItem "builds" nvrs] if null updates then do- putStrLn $ "bodhi submission failed for " ++ nvrs- prompt_ "Press Enter to resubmit to Bodhi"+ putStrLn $ "bodhi submission failed for" +-+ nvrs+ promptEnter "Press Enter to resubmit to Bodhi" bodhiUpdate dryrun (mupdate,severity) mreview usechangelog spec nvrs else forM_ updates $ \update ->@@ -194,12 +197,12 @@ maybeTemplate :: UpdateType -> IO (Maybe FilePath) maybeTemplate TemplateUpdate = do- file <- prompt "Please input the update template filepath"+ file <- promptNonEmpty "Please input the update template filepath" exists <- doesFileExist file if exists then return $ Just file else do- putStrLn ("no such file: " ++ file)+ putStrLn ("no such file:" +-+ file) maybeTemplate TemplateUpdate maybeTemplate _ = return Nothing
src/Branches.hs view
@@ -25,7 +25,8 @@ branchVersion, anyBranchToRelease, getRequestedBranches,- BranchesReq(..)+ BranchesReq(..),+ gitLines ) where import Common@@ -35,7 +36,7 @@ import Data.Tuple import Distribution.Fedora.Branch import SimpleCmd.Git-import SimplePrompt+import SimplePrompt (promptEnter, promptInitial) import qualified System.Info (arch) import Pagure@@ -89,11 +90,12 @@ localBranches local = if local then do- locals <- cmdLines "git" ["branch", "--list", "--format=%(refname:lstrip=-1)"]+ locals <- gitLines "branch" ["--list", "--format=%(refname:lstrip=-1)"] return $ locals \\ ["HEAD", "master"] else do- origins <- filter ("origin/" `isPrefixOf`) <$>- cmdLines "git" ["branch", "--remote", "--list", "--format=%(refname:lstrip=-2)"]+ origins <-+ filter ("origin/" `isPrefixOf`) <$>+ gitLines "branch" ["--remote", "--list", "--format=%(refname:lstrip=-2)"] return $ map (removePrefix "origin/") origins \\ ["HEAD", "master"] pagurePkgBranches :: String -> IO [String]@@ -102,7 +104,7 @@ res <- pagureListGitBranches srcfpo project return $ either (error' . include project) id res where- include p e = e ++ ": " ++ p+ include p e = e ++ ":" +-+ p mockRoot :: Branch -> Maybe String -> String mockRoot br march =@@ -121,7 +123,7 @@ onlyRelBranch :: AnyBranch -> Branch onlyRelBranch (RelBranch br) = br-onlyRelBranch (OtherBranch br) = error' $ "Non-release branch not allowed: " ++ br+onlyRelBranch (OtherBranch br) = error' $ "Non-release branch not allowed:" +-+ br systemBranch :: IO Branch systemBranch =@@ -158,13 +160,13 @@ forM_ brs $ \ br -> if active then when (br `notElem` activeBrs) $- error' $ show br ++ " is not an active branch"+ error' $ show br +-+ "is not an active branch" else case br of Fedora _ -> do let latest = maximum (delete Rawhide activeBrs) when (br > latest) $- error' $ show br ++ " is newer than latest branch"+ error' $ show br +-+ "is newer than latest branch" -- FIXME also check for too new EPEL _ -> return () return brs@@ -189,7 +191,7 @@ if br == OtherBranch "HEAD" then do dir <- getDirectoryName- prompt_ $ dir ++ ": " ++ show br ++ " is not a branch, please fix"+ promptEnter $ dir ++ ":" +-+ show br +-+ "is not a branch, please fix" gitCurrentBranch else return br @@ -203,7 +205,7 @@ if br == OtherBranch "master" then do dir <- getDirectoryName- prompt_ $ dir ++ ": " ++ show br ++ " is not a valid branch, please use 'rename-rawhide'"+ promptEnter $ dir ++ ":" +-+ show br +-+ "is not a valid branch, please use 'rename-rawhide'" gitCurrentBranchWarn else return br @@ -235,25 +237,21 @@ AllFedora -> filter isFedoraBranch activenew AllEPEL -> filter isEPELBranch activenew ExcludeBranches xbrs -> activenew \\ xbrs- inp <- prompt $ "Confirm branches request [" ++ unwords (map show requested) ++ "]"- return $ if null inp- then requested- else map (readActiveBranch' activenew) $ words inp+ inp <- promptInitial "Confirm branches to request" $ unwords (map show requested)+ return $ map (readActiveBranch' activenew) $ words inp where branchingPrompt :: [Branch] -> IO [Branch] branchingPrompt active = do- inp <- prompt "Enter required branches [default: latest 2], or no/none"- if null inp- then return $ take 2 active- else- if lower (trim inp) `elem` ["no", "none"]- then return []- else- let abrs = map anyBranch $ words inp- in if all isRelBranch abrs- then return $ map onlyRelBranch abrs- else branchingPrompt active+ inp <- promptInitial "Enter required branches" $+ unwords $ map show $ take 2 active+ let abrs = map anyBranch $ words inp+ in if all isRelBranch abrs+ then return $ map onlyRelBranch abrs+ else branchingPrompt active data BranchesReq = BranchOpt BranchOpts | Branches [Branch] deriving Eq++gitLines :: String -> [String] -> IO [String]+gitLines c args = lines <$> git c args
src/Bugzilla.hs view
@@ -73,7 +73,7 @@ import Common import Common.System import qualified Common.Text as T-import SimplePrompt+import SimplePrompt (promptNonEmpty) import Data.Aeson.Types (Array, Object) import qualified Data.ByteString.Char8 as B@@ -109,7 +109,7 @@ case lookupKey "message" res of Nothing -> print res Just msg -> T.putStrLn msg- error' $ "failed to update bug " ++ show bid+ error' $ "failed to update bug" +-+ show bid putStrLn "Comment added" updateBug :: BugzillaSession -> BugId -> [(String,String)] -> IO ()@@ -126,7 +126,7 @@ case lookupKey "message" res of Nothing -> print res Just msg -> T.putStrLn msg- error' $ "failed to update bug " ++ show bid+ error' $ "failed to update bug" +-+ show bid encodeParams :: [(String, String)] -> [(ByteString, ByteString)] encodeParams [] = []@@ -139,7 +139,7 @@ unless dryrun $ void $ updateBug session bid [("cf_fixed_in", nvr), ("status", "MODIFIED")]- putStrLn $ "bug " ++ show bid ++ (if dryrun then " would be" else "") ++ " moved to MODIFIED with " ++ nvr+ putStrLn $ "bug" +-+ show bid ++ (if dryrun then " would be" else "") +-+ "moved to MODIFIED with" +-+ nvr brc :: T.Text brc = "bugzilla.redhat.com"@@ -186,13 +186,13 @@ then readIniConfig config rcParser rcUserEmail else do -- FIXME: option to override email- email <- prompt "Bugzilla Username"+ email <- promptNonEmpty "Bugzilla Username" when (emailIsValid email) $ do let configDir = takeDirectory config configDirExists <- doesDirectoryExist configDir unless configDirExists $ createDirectory configDir T.writeFile config $ "[" <> brc <> "]\nuser = " <> T.pack email <> "\n"- putStrLn $ "Saved in " ++ config ++ "\n"+ putStrLn $ "Saved in" +-+ config ++ "\n" getBzUser where rcParser :: IniParser BzUserRC@@ -233,7 +233,7 @@ "Create a key at https://bugzilla.redhat.com/userprefs.cgi?tab=apikey", "Save the key under in '" ++ config ++ "' under:", "[bugzilla.redhat.com]",- apiKeyField ++ " = <YourApiKey>"]+ apiKeyField +-+ "= <YourApiKey>"] else do apikey <- readIniConfig config rcParser bzApiKey return $ ApiKeySession brc $ BugzillaApiKey apikey@@ -283,12 +283,12 @@ pkgReviews :: String -> SearchExpression pkgReviews pkg =- SummaryField `contains` T.pack ("Review Request: " ++ pkg ++ " - ") .&&.+ SummaryField `contains` T.pack ("Review Request:" +-+ pkg +-+ "- ") .&&. packageReview pkgReviewsPrefix :: String -> SearchExpression pkgReviewsPrefix prefix =- SummaryField `contains` T.pack ("Review Request: " ++ prefix) .&&.+ SummaryField `contains` T.pack ("Review Request:" +-+ prefix) .&&. packageReview pkgBugs :: String -> SearchExpression@@ -327,7 +327,7 @@ reviewBugIdSession pkg = do bugs <- bugIdsAnon $ pkgReviews pkg .&&. statusOpen case bugs of- [] -> error $ "No review bug found for " ++ pkg+ [] -> error $ "No review bug found for" +-+ pkg [bug] -> do session <- bzApiKeySession return (bug, session)@@ -338,7 +338,7 @@ bugs <- bugIdsAnon $ pkgReviews pkg .&&. statusOpen .&&. reviewApproved case bugs of- [] -> error $ "No review bug found for " ++ pkg+ [] -> error $ "No review bug found for" +-+ pkg [bug] -> do session <- bzApiKeySession return (bug, session)@@ -349,7 +349,7 @@ bugs <- bugsAnon $ pkgReviews pkg .&&. statusOpen .&&. reviewApproved case bugs of- [] -> error $ "No review bug found for " ++ pkg+ [] -> error $ "No review bug found for" +-+ pkg [bug] -> do session <- bzApiKeySession return (bug, session)@@ -367,7 +367,7 @@ ini <- T.readFile inifile return $ case parseIniFile ini iniparser of- Left err -> error' $ err ++ "\nin " ++ inifile+ Left err -> error' $ err ++ "\nin" +-+ inifile Right res -> fn res sortBugsByID :: [Bug] -> [Bug]@@ -416,7 +416,7 @@ if short then putStr $ reviewBugToPackage bug ++ " " else do- putStr $ T.unpack (bugStatus bug) ++ " " ++ reviewBugToPackage bug ++ ": "+ putStr $ T.unpack (bugStatus bug) +-+ reviewBugToPackage bug ++ ": " putBugId $ bugId bug putBug :: Bug -> IO ()@@ -477,7 +477,7 @@ else do users <- listBzUsers session userid case users of- [] -> error' $ "No user found for " ++ userid+ [] -> error' $ "No user found for" +-+ userid [obj] -> return $ T.pack $ lookupKey' "email" obj- objs -> error' $ "Found multiple user matches: " +++ objs -> error' $ "Found multiple user matches:" +-+ unwords (map (lookupKey' "email") objs)
src/Cmd/Build.hs view
@@ -5,6 +5,8 @@ BuildOpts(..) ) where +import SimplePrompt (promptEnter, yesNo)+ import Common import Common.System @@ -16,7 +18,6 @@ import Krb import Koji import Package-import SimplePrompt import RpmBuild (checkSourcesMatch) import Types @@ -34,6 +35,7 @@ , buildoptAllowDirty :: Bool } +-- FIXME --yes -- FIXME merge --from -- FIXME check bugs before building? -- FIXME --sidetag@@ -46,7 +48,7 @@ -- FIXME --auto-override for deps in testing -- FIXME -B fails to find new branches (fixed?) -- FIXME disallow override for autoupdate?--- FIXME --yes+-- FIXME --scratch build first buildCmd :: BuildOpts -> (BranchesReq, [String]) -> IO () buildCmd opts (breq, pkgs) = do let singleBrnch = if isJust (buildoptSidetagTarget opts)@@ -125,7 +127,7 @@ target <- targetMaybeSidetag dryrun br msidetagTarget case buildstatus of Just BuildComplete -> do- putStrLn $ nvr ++ " is already built"+ putStrLn $ nvr +-+ "is already built" when (isJust mpush) $ error' "Please bump the spec file" when (br /= Rawhide && isNothing msidetagTarget) $ do@@ -147,7 +149,7 @@ (autoupdate && mwaitrepo == Just True)) $ kojiWaitRepo dryrun True True target nvr Just BuildBuilding -> do- putStrLn $ nvr ++ " is already building"+ putStrLn $ nvr +-+ "is already building" when (isJust mpush) $ error' "Please bump the spec file" whenJustM (kojiGetBuildTaskID fedoraHub nvr) kojiWatchTask@@ -160,17 +162,17 @@ opentasks <- kojiOpenTasks pkg mbuildref target case opentasks of [task] -> do- putStrLn $ nvr ++ " task " ++ displayID task ++ " is already open"+ putStrLn $ nvr +-+ "task" +-+ displayID task +-+ "is already open" when (isJust mpush) $ error' "Please bump the spec file" kojiWatchTask task- (_:_) -> error' $ show (length opentasks) ++ " open " ++ unPackage pkg ++ " tasks already!"+ (_:_) -> error' $ show (length opentasks) +-+ "open" +-+ unPackage pkg +-+ "tasks already!" [] -> do let tag = if target == branchTarget br then branchDestTag br else target mlatest <- kojiLatestNVR tag $ unPackage pkg if equivNVR nvr (fromMaybe "" mlatest)- then putStrLn $ nvr ++ " is already latest" ++ if Just nvr /= mlatest then " (modulo disttag)" else ""+ then putStrLn $ nvr +-+ "is already latest" +-+ if Just nvr /= mlatest then "(modulo disttag)" else "" else do when (null unpushed || merged && br /= Rawhide) $ do putStrLn $ nvr ++ "\n"@@ -185,8 +187,9 @@ Just newest -> do newestTags <- kojiNVRTags newest unless (any (`elem` newestTags) [show br, show br ++ "-updates", show br ++ "-updates-pending"]) $ do- putStrLn $ "Warning: " ++ newest ++ " still in testing?"- prompt_ "Press Enter to continue"+ -- FIXME print how many days left+ putStrLn $ "Warning:" +-+ newest +-+ "still in testing?"+ promptEnter "Press Enter to continue" return False unless dryrun krbTicket whenJust mpush $ \ref ->@@ -194,7 +197,7 @@ gitPush False $ Just $ ref ++ ":" ++ show br unlessM (null <$> gitOneLineLog ("origin/" ++ show br ++ "..HEAD")) $ unless dryrun $ do- ok <- yesno Nothing "Unpushed changes remain, continue"+ ok <- yesNo "Unpushed changes remain, continue" unless ok $ error' "aborted" unless (buildoptAllowDirty opts) $ unlessM isGitDirClean $
src/Cmd/Commit.hs view
@@ -3,11 +3,12 @@ ) where +import SimplePrompt (promptNonEmpty)+ import Common import Common.System import Git import Package-import SimplePrompt -- FIXME reject if nvr ahead of newer branch -- FIXME use branches after all?@@ -64,9 +65,5 @@ readCommitMsg = do tty <- isTty if tty- then do- clog <- prompt "\nPlease input the commit message"- if null clog- then readCommitMsg- else return clog+ then promptNonEmpty "\nPlease input the commit message" else error' "please input commit message in a terminal"
src/Cmd/Copr.hs view
@@ -53,7 +53,7 @@ username <- getUsername chroots <- map T.unpack <$> coprChroots coprServer username project when (null chroots) $- error' $ "No chroots found for " ++ username ++ "/" ++ project+ error' $ "No chroots found for" +-+ username ++ "/" ++ project branches <- case breq of Branches brs ->@@ -144,7 +144,7 @@ readIniConfig inifile iniparser record = do havefile <- doesFileExist inifile if not havefile- then error' $ inifile ++ " not found: try https://" ++ coprServer ++ "/api"+ then error' $ inifile +-+ "not found: try https://" ++ coprServer ++ "/api" else do ini <- T.readFile inifile let config = parseIniFile ini iniparser@@ -163,7 +163,7 @@ let bid = read $ last $ words $ last $ lines output ok <- timeIO $ coprWatchBuild bid Nothing unless ok $- error' $ "Failed: copr " ++ unwords buildargs+ error' $ "Failed: copr" +-+ unwords buildargs -- FIXME idea: Maybe Seconds to increment sleep coprWatchBuild :: Int -> Maybe String -> IO Bool@@ -174,7 +174,7 @@ if mstate == Just state then sleep 20 >> coprWatchBuild bid mstate else do- logMsg $ "Build " ++ show bid ++ " " ++ state+ logMsg $ "Build" +-+ show bid +-+ state case state of "succeeded" -> return True "skipped" -> return True@@ -183,7 +183,7 @@ _ -> sleep 1 >> coprWatchBuild bid (Just state) Nothing -> do let err = lookupKey' "error" res- logMsg $ "Error: " ++ err+ logMsg $ "Error:" +-+ err return False -- #if !MIN_VERSION_simple_cmd(0,1,4)
src/Cmd/Diff.hs view
@@ -47,7 +47,7 @@ if speconlyNone then do dead <- doesFileExist "dead.package"- unless dead $ putStrLn $ "no " ++ packageSpec pkg+ unless dead $ putStrLn $ "no" +-+ packageSpec pkg else do let contxt = case fmt of DiffContext n -> ["--unified=" ++ show n]
src/Cmd/Import.hs view
@@ -7,6 +7,7 @@ import qualified Common.Text as T import Network.URI+import SimplePrompt (promptEnter) import Branches import Bugzilla@@ -16,7 +17,6 @@ import Krb import ListReviews import Package-import SimplePrompt -- FIXME separate pre-checked listReviews and direct pkg call, which needs checks -- FIXME add --dryrun@@ -54,14 +54,14 @@ putStr "Review bug: " putBugId bid putNewLn- prompt_ "Press Enter to continue"+ promptEnter "Press Enter to continue" let srpms = map (T.replace "/reviews//" "/reviews/") $ concatMap findSRPMs comments when (null srpms) $ error "No srpm urls found!" mapM_ T.putStrLn srpms let srpm = (head . filter isURI . filter (".src.rpm" `isSuffixOf`) . words . T.unpack . last) srpms let srpmfile = takeFileName srpm -- FIXME if havesrpm then print local filename- prompt_ $ "Press Enter to import " ++ srpmfile+ promptEnter $ "Press Enter to import" +-+ srpmfile havesrpm <- doesFileExist srpmfile unless havesrpm $ cmd_ "curl" ["--silent", "--show-error", "--remote-name", srpm]@@ -69,7 +69,7 @@ fedpkg_ "import" [srpmfile] git_ "commit" ["--message", "import #" ++ show bid] nvr <- pkgNameVerRel' Rawhide (pkg <.> "spec")- prompt_ $ "Press Enter to push and build " ++ nvr+ promptEnter $ "Press Enter to push and build" +-+ nvr gitPush True Nothing -- FIXME build more branches kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"]
src/Cmd/Install.hs view
@@ -9,7 +9,7 @@ #if !MIN_VERSION_simple_cmd(0,2,7) import System.Posix.User (getEffectiveUserID) #endif-import SimplePrompt+import SimplePrompt (promptEnter) import Branches import Cmd.Merge@@ -70,9 +70,10 @@ -- FIXME check not metadep with parens mpkgdir <- lookForPkgDir rbr ".." dep case mpkgdir of- Nothing -> putStrLn $ dep ++ " not known"+ Nothing -> putStrLn $ dep +-+ "not known" Just pkgdir -> installCmd verbose recurse mfrom mforceshort bconds reinstall nobuilddeps allsubpkgs (mbr, [pkgdir]) >> putNewLn -- FIXME option to enable/disable installing missing deps+ -- FIXME --skip-missing-deps or prompt else installDeps True spec wasbuilt <- buildRPMs (not verbose) False False mforceshort' bconds rpms br spec unless (isShortCircuit mforceshort') $ do@@ -99,7 +100,7 @@ if wasbuilt then error' $ "error from:" +-+ unwords command else do- prompt_ "Press Enter to rebuild package"+ promptEnter "Press Enter to rebuild package" doInstallPkg (Just ForceBuild) spec rpms already lookForPkgDir :: Branch -> FilePath -> String -> IO (Maybe FilePath)
src/Cmd/ListBranches.hs view
@@ -60,18 +60,18 @@ RelBranch rbr -> Branches [rbr] == breq OtherBranch _abr -> False if missing- then unless onbranch $ putStrLn $ unPackage pkg ++ ": " ++ show br+ then unless onbranch $ putStrLn $ unPackage pkg ++ ":" +-+ show br else case breq of Branches [req] -> when (RelBranch req == br) $- putStrLn $ unPackage pkg ++ ": " ++ show br- _ -> putStrLn $ unPackage pkg ++ ": " ++ show br+ putStrLn $ unPackage pkg ++ ":" +-+ show br+ _ -> putStrLn $ unPackage pkg ++ ":" +-+ show br else do brs <- delete "main" <$> if mode == Remote then pagurePkgBranches (unPackage pkg) else localBranches False if allbrs then do- putStrLn $ unPackage pkg ++ ": " ++ unwords brs+ putStrLn $ unPackage pkg ++ ":" +-+ unwords brs else do if breq == Branches [] then do -- FIXME better to filter inactive instead
src/Cmd/Merge.hs view
@@ -14,6 +14,7 @@ import Package import Patch +-- FIXME should rawhide default to no-op mergeCmd :: Bool -> Bool -> Bool -> Maybe Natural -> Bool -> Maybe Branch -> (BranchesReq,[String]) -> IO () mergeCmd dryrun nofetch noprompt mnotrivial showall mfrom =@@ -66,16 +67,17 @@ mergeBranch dryrun build noprompt showall mpkg (True, unmerged) from br = do whenJust mpkg $ flip putPkgBrnchHdr br isnewrepo <- initialPkgRepo- putStrLn $ (if isnewrepo || noprompt then "Merging from" else "New commits in") ++ " " ++ show from ++ ":"+ putStrLn $ (if isnewrepo || noprompt then "Merging from" else "New commits in") +-+ show from ++ ":" displayCommits showall unmerged unpushed <- gitOneLineLog $ "origin/" ++ show br ++ "..HEAD" unless (null unpushed) $ do putStrLn "Local commits:" displayCommits showall unpushed+ putNewLn mmerge <- if isnewrepo && length unmerged == 1 || noprompt then return $ Just $ commitRef (head unmerged)- else refPrompt unmerged ("Press Enter to merge " ++ show from +++ else refPrompt unmerged ("Press Enter to merge" +-+ show from ++ (if build then " and build" else "") ++ (if length unmerged > 1 then "; or give ref to merge" else "") ++ "; or 'no' to skip merge")@@ -89,7 +91,7 @@ git_ "merge" ["--quiet", ref] mergeBranch dryrun build noprompt showall mpkg (False,unmerged) from br = do unless build $ whenJust mpkg $ flip putPkgBrnchHdr br- putStrLn $ show from ++ " branch is not directly mergeable:"+ putStrLn $ show from +-+ "branch is not directly mergeable:" displayCommits False unmerged putNewLn unpushed <- gitOneLineLog $ "origin/" ++ show br ++ "..HEAD"
src/Cmd/Override.hs view
@@ -9,6 +9,7 @@ import Data.Aeson (Object) import Fedora.Bodhi (bodhiOverrides) import Network.HTTP.Query+import SimplePrompt (yesNo) import Common import Common.System@@ -20,7 +21,6 @@ import Koji import Krb (krbTicket) import Package-import SimplePrompt (yesno) data OverrideMode = OverrideCreate | OverrideList | OverrideExpire deriving Eq@@ -69,7 +69,7 @@ Just _expired -> return () Nothing -> do whenJust (lookupKey "nvr" override) $ \nvr -> do- ok <- yesno Nothing $ "Expire override" +-+ nvr+ ok <- yesNo $ "Expire override" +-+ nvr when ok $ cmd_ "bodhi" ["overrides", "edit", "--expire", nvr]
src/Cmd/Owner.hs view
@@ -24,7 +24,7 @@ putNewLn let maintain = groupSort pkgowners forM_ maintain $ \(o,ps) ->- putStrLn $ o ++ ": " ++ unwords (map unPackage ps)+ putStrLn $ o ++ ":" +-+ unwords (map unPackage ps) where ownerPkg :: String -> IO (String,Package) ownerPkg path = do
src/Cmd/Parallel.hs view
@@ -13,6 +13,7 @@ import Distribution.RPM.Build.Order (dependencyLayers) import Fedora.Bodhi hiding (bodhiUpdate) import qualified Fedora.Bodhi as FedoraBodhi (bodhiUpdate)+import SimplePrompt (prompt, promptEnter, yesNo) import System.Console.Pretty import System.Time.Extra (sleep) @@ -24,8 +25,7 @@ import Krb import Koji import Package-import RpmBuild (checkSourcesMatch)-import SimplePrompt+import RpmBuild (checkSourcesMatch, getDynSourcesMacros) import Types data JobDone = Done {jobNvr :: String,@@ -76,14 +76,17 @@ withExistingDirectory p $ do pkg <- getPackageName p mergeNewerBranch (Just pkg) rbr+ getDynSourcesMacros $ packageSpec pkg allLayers <- dependencyLayers pkgs let layers = drop firstlayer allLayers when (isNothing msidetagTarget && length allLayers > 1) $ unlessM (checkAutoBodhiUpdate rbr) $ error' "You must use --target/--sidetag to build package layers for this branch" when (length branches > 1) $- putStrLn $ "# " ++ show rbr+ putStrLn $ "#" +-+ show rbr target <- targetMaybeSidetag dryrun rbr msidetagTarget+ when (msidetagTarget == Just SideTag) $+ putStrLn $ "Target:" +-+ target nvrclogs <- concatMapM (timeIO . parallelBuild target rbr) (zip [firstlayer..length allLayers] $ init $ tails layers) -- tails ends in []@@ -94,6 +97,9 @@ let changelog = intercalate "" $ renderChangelogs $ reverse nvrclogs putNewLn putStrLn changelog+ when (length changelog > 10000) $+ putStrLn "Bodhi only accepts up to 10000 chars: will be truncated"+ -- FIXME allow editor input <- prompt "Press Enter to use above or input update summary now; or 'no' to skip update" unless (trim (lower input) `elem` ["no","n"] || dryrun) $ bodhiSidetagUpdate rbr (map jobNvr nvrclogs) target $@@ -103,7 +109,7 @@ parallelBranches brs pkg = do krbTicket currentbranch <- gitCurrentBranch- putStrLn $ "= Building " ++ pluralException (length brs) "branch" "branches" ++ " in parallel:"+ putStrLn $ "= Building" +-+ pluralException (length brs) "branch" "branches" +-+ "in parallel:" putStrLn $ unwords $ map show brs jobs <- mapM setupBranch brs (failures,nvrclogs) <- timeIO $ watchJobs (length jobs == 1) Nothing [] [] jobs@@ -112,7 +118,7 @@ gitSwitchBranch currentbranch unless (null failures) $ do putStrLn $ "Build failures:" +-+ unwords failures- okay <- yesno Nothing "Do you want to continue nevertheless"+ okay <- yesNo "Do you want to continue nevertheless" unless okay $ error' "Quitting" when (isNothing msidetagTarget) $ do let spec = packageSpec pkg@@ -159,7 +165,8 @@ let layerspkgs = map length nextLayers in case layerspkgs of [n] -> plural n "more package" +-+ "left in next final layer"- _ -> "more package layers left:" +-+ show layerspkgs+ _ -> plural (length layerspkgs) "more package layer" +-+ "left:" +-++ show layerspkgs jobs <- zipWithM (setupBuild singlelayer) (reverse [0..(length layer - 1)]) layer when (null jobs) $ error' "No jobs run"@@ -171,7 +178,7 @@ putStrLn $ "\nBuild failures" +-+ (if singlelayer then ":" else "in layer" +-+ show layernum ++ ":") +-+ unwords failures- okay <- yesno Nothing "Do you want to continue nevertheless"+ okay <- yesNo "Do you want to continue nevertheless" if okay then return nvrs else error' $@@ -209,7 +216,7 @@ Just (Left except) -> do print except let pkg = fst job- putStrLn $ "** " ++ color Magenta pkg +-+ "job" +-+ color Magenta "failed" ++ " **" +-+ if singlejob then "" else "(" ++ plural (length jobs) "job" +-+ "left" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer ++ ")"+ putStrLn $ "**" +-+ color Magenta pkg +-+ "job" +-+ color Magenta "failed" +-+ "**" +-+ if singlejob then "" else "(" ++ plural (length jobs) "job" +-+ "left" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer ++ ")" watchJobs singlejob mlayer (pkg : fails) dones jobs -- FIXME prefix output with package name@@ -256,14 +263,14 @@ putStrLn $ color Yellow nvr +-+ "is already" +-+ color Yellow "building" mtask <- kojiGetBuildTaskID fedoraHub nvr case mtask of- Nothing -> error' $ "Task for " ++ nvr ++ " not found"+ Nothing -> error' $ "Task for" +-+ nvr +-+ "not found" Just task -> return $ do kojiWaitTaskAndRepo (isNothing mlatest) nvr task return $ Done nvr br changelog _ -> do when (null unpushed) $ do- putStrLn $ nvr ++ " (" ++ target ++ ")" +-+ show n +-+ "more" +-++ putStrLn $ nvr +-+ "(" ++ target ++ ")" +-+ show n +-+ "more" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer putNewLn putStrLn changelog@@ -271,16 +278,16 @@ opentasks <- kojiOpenTasks pkg (Just buildref) target case opentasks of [task] -> do- putStrLn $ nvr ++ " task is already open"+ putStrLn $ nvr +-+ "task is already open" return $ do kojiWaitTaskAndRepo (isNothing mlatest) nvr task return $ Done nvr br changelog- (_:_) -> error' $ show (length opentasks) ++ " open " ++ unPackage pkg ++ " tasks already"+ (_:_) -> error' $ show (length opentasks) +-+ "open" +-+ unPackage pkg +-+ "tasks already" [] -> do if equivNVR nvr (fromMaybe "" mlatest) then do -- FIXME add a retry prompt- putStrLn $ color Red $ nvr ++ " is already latest (modulo disttag)"+ putStrLn $ color Red $ nvr +-+ "is already latest (modulo disttag)" return $ error' $ nvr +-+ "failed" else do -- FIXME parse build output@@ -296,9 +303,9 @@ kojiWaitTaskAndRepo newpkg nvr task = do finish <- kojiWaitTask task if finish- then putStrLn $ color Green $ nvr ++ " build success"+ then putStrLn $ color Green $ nvr +-+ "build success" -- FIXME print koji task url- else error' $ color Red $ nvr ++ " build failed"+ else error' $ color Red $ nvr +-+ "build failed" autoupdate <- checkAutoBodhiUpdate br if autoupdate then when newpkg $ do@@ -308,7 +315,7 @@ else do when (target == branchTarget br && morelayers) $ -- -- FIXME: avoid prompt in- -- changelog <- changeLogPrompt Nothing spec+ -- changelog <- changeLogPrompt False spec -- bodhiUpdate (fmap fst mBugSess) changelog nvr bodhiCreateOverride dryrun Nothing nvr when morelayers $@@ -326,14 +333,14 @@ case mupdate of (Nothing, _) -> return () (Just updateType, severity) -> do- putStrLn $ "Creating Bodhi Update for " ++ sidetag+ putStrLn $ "Creating Bodhi Update for" +-+ sidetag ok <- if updateType == TemplateUpdate then do putStrLn "Paste update template now:" template <- getContents cmdBool "bodhi" ["updates", "new", "--file", template, "--from-tag", sidetag]- else cmdBool "bodhi" ["updates", "new", "--type", show updateType , "--severity", show severity, "--request", "testing", "--notes", if null notes then "to be written" else notes, "--autokarma", "--autotime", "--close-bugs", "--from-tag", sidetag]+ else cmdBool "bodhi" ["updates", "new", "--type", show updateType , "--severity", show severity, "--request", "testing", "--notes", if null notes then "to be written" else take 10000 notes, "--autokarma", "--autotime", "--close-bugs", "--from-tag", sidetag] if not ok then bodhiSidetagUpdate rbr nvrs sidetag notes else@@ -343,7 +350,7 @@ case res of [] -> do putStrLn "bodhi submission failed"- prompt_ "Press Enter to resubmit to Bodhi"+ promptEnter "Press Enter to resubmit to Bodhi" bodhiSidetagUpdate rbr nvrs sidetag notes [update] -> case lookupKey "updateid" update of@@ -353,7 +360,7 @@ -- FIXME countdown timer sleep 90 bodhiUpdateTestingRequesting 1 updateid update- _ -> error' $ "impossible happened: more than one update found for " ++ last nvrs+ _ -> error' $ "impossible happened: more than one update found for" +-+ last nvrs bodhiUpdateTestingRequesting :: Double -> String -> Object -> IO () bodhiUpdateTestingRequesting retries updateid update =
src/Cmd/PkgReview.hs view
@@ -13,13 +13,13 @@ import Data.Char import Network.HTTP.Directory (httpExists, httpManager)+import SimplePrompt (promptEnter) import Branches import Bugzilla import Koji import Krb import Package-import SimplePrompt import RpmBuild data ScratchOption = ScratchBuild | ScratchTask Int | SkipScratch@@ -27,6 +27,7 @@ -- FIXME add --dependent pkgreview -- FIXME verify tarball is same as upstream+-- FIXME post URL field too createReview :: ScratchOption -> Bool -> [FilePath] -> IO () createReview scratchOpt mock pkgs = withPackagesByBranches HeaderMust False Nothing Zero createPkgReview (Branches [], pkgs)@@ -43,7 +44,7 @@ putStrLn "Existing review(s):" mapM_ putBug bugs -- FIXME abort if open review (unless --force?)- prompt_ "Press Enter to continue"+ promptEnter "Press Enter to continue" srpm <- generateSrpm Nothing spec mockRpmLint mock (scratchOpt == ScratchBuild) pkg spec srpm (mkojiurl,specSrpmUrls) <- buildAndUpload scratchOpt srpm pkg spec@@ -84,7 +85,7 @@ error' "This NVR was already posted on the review bug: please bump" mockRpmLint mock (scratchOpt == ScratchBuild) pkg spec srpm (mkojiurl,specSrpmUrls) <- buildAndUpload scratchOpt srpm pkg spec- changelog <- changeLogPrompt Nothing spec+ changelog <- changeLogPrompt False spec commentBug session bid (specSrpmUrls <> (if null changelog then "" else "\n\n" <> changelog) <> maybe "" ("\n\nKoji scratch build: " <>) mkojiurl) -- putStrLn "Review bug updated" where@@ -114,7 +115,7 @@ where checkUrlOk mgr url = do okay <- httpExists mgr url- unless okay $ error' $ "Could not access: " ++ url+ unless okay $ error' $ "Could not access:" +-+ url mockRpmLint :: Bool -> Bool -> String -> FilePath -> FilePath -> IO () mockRpmLint mock scratch pkg spec srpm = do@@ -128,7 +129,7 @@ builtRpms (RelBranch Rawhide) spec >>= filterM doesFileExist -- FIXME parse # of errors/warnings void $ cmdBool "rpmlint" $ spec:srpm:rpms- prompt_ $ "Press Enter to " ++ if scratch then "submit" else "upload"+ promptEnter $ "Press Enter to" +-+ if scratch then "submit" else "upload" -- FIXME does not work with pkg dir/spec: -- 'fbrnch: No spec file found'@@ -144,7 +145,7 @@ case bugs of [bug] -> do putReviewBug False bug- prompt_ "Press Enter to run fedora-review"+ promptEnter "Press Enter to run fedora-review" -- FIXME support copr build -- FIXME if toolbox set REVIEW_NO_MOCKGROUP_CHECK cmd_ "fedora-review" ["-b", show (bugId bug)]@@ -152,4 +153,4 @@ spec <- findSpecfile srpm <- generateSrpm Nothing spec cmd_ "fedora-review" ["-rn", srpm]- _ -> error' $ "More than one review bug found for " ++ pkg+ _ -> error' $ "More than one review bug found for" +-+ pkg
src/Cmd/Prep.hs view
@@ -34,15 +34,14 @@ else do spec <- localBranchSpecFile pkg br unlessM (doesFileExist spec) $- error' $ spec ++ " not found"- void $ getSources spec- installMissingMacros spec+ error' $ spec +-+ "not found"+ getSourcesMacros spec case br of RelBranch rbr -> do nvr <- pkgNameVerRel' rbr spec -- newline avoids error starting on same line- putStr $ "Prepping " ++ nvr ++ ": "+ putStr $ "Prepping" +-+ nvr ++ ": " _ -> return () timeIO $- (if verbose then cmdLog else cmdSilent') "rpmbuild" ["-bp", spec]+ (if verbose then cmdLog else cmdSilent') "rpmbuild" ["-bp", "--nodeps", spec] putStrLn "done"
src/Cmd/PullPush.hs view
@@ -36,7 +36,7 @@ haveGit <- isPkgGitRepo if haveGit then doPullPkg- else putStrLn $ "ignoring " ++ unPackage pkg+ else putStrLn $ "ignoring" +-+ unPackage pkg else doPullPkg where doPullPkg :: IO ()
src/Cmd/RequestBranch.hs view
@@ -6,6 +6,7 @@ ) where import Network.HTTP.Query (lookupKey')+import SimplePrompt (promptEnter) import Common import Common.System@@ -18,7 +19,6 @@ import ListReviews import Package import Pagure-import SimplePrompt (prompt_) -- FIXME option to do koji scratch build instead of mock requestBranchesCmd :: Bool -> Maybe Branch -> Bool -> (BranchesReq,[String]) -> IO ()@@ -38,10 +38,11 @@ pkgs <- case mrecursebr of Just br -> do- deps <- concat <$> srcDeps False (br,ps)+ -- FIXME --rpmopt+ deps <- concat <$> srcDeps False [] (br,ps) putStrLn $ unwords deps unless quiet $- prompt_ "\nPress Enter to check these packages for branches"+ promptEnter "\nPress Enter to check these packages for branches" return deps Nothing -> return ps forM_ pkgs $ \ p ->@@ -109,7 +110,7 @@ let pkgPrefix = if multiple then unPackage pkg ++ ": " else "" forM_ branches $ \ br -> when (br `elem` existing) $- putStrLn $ pkgPrefix ++ show br ++ " branch already exists"+ putStrLn $ pkgPrefix ++ show br +-+ "branch already exists" let brs' = branches \\ existing if null brs' then return []@@ -117,7 +118,7 @@ current <- fedoraBranchesNoRawhide $ pagurePkgBranches (unPackage pkg) forM_ brs' $ \ br -> when (br `elem` current) $- putStrLn $ pkgPrefix ++ show br ++ " remote branch already exists"+ putStrLn $ pkgPrefix ++ show br +-+ "remote branch already exists" let newbranches = brs' \\ current if null newbranches then return [] else do@@ -136,7 +137,7 @@ notExistingRequest requests br = do let pending = filter ((("New Branch \"" ++ show br ++ "\" for \"rpms/" ++ unPackage pkg ++ "\"") ==) . pagureIssueTitle) requests unless (null pending) $ do- putStrLn $ "Branch request already exists for " ++ unPackage pkg ++ ":" ++ show br+ putStrLn $ "Branch request already exists for" +-+ unPackage pkg ++ ":" ++ show br mapM_ printScmIssue pending return $ null pending @@ -148,13 +149,15 @@ case epkginfo of Left err -> error' err Right pkginfo -> do- let access = fasid `elem` (lookupOwnerAdmins pkginfo :: [String])+ let (admins, committers) = usersWithAccess pkginfo :: ([String],[String])+ access = fasid `elem` admins ++ committers unless access $- warning $ "-" +-+ fasid +-+ "does not have access"+ warning $ "-" +-+ fasid +-+ "does not have access, ask:" +-+ unwords admins return access where- lookupOwnerAdmins pkginfo =+ usersWithAccess pkginfo = let access = lookupKey' "access_users" pkginfo owners = lookupKey' "owner" access admins = lookupKey' "admin" access- in owners ++ admins+ collabs = lookupKey' "collaborator" access+ in (owners ++ admins, collabs)
src/Cmd/RequestRepo.hs view
@@ -7,6 +7,7 @@ import Network.HTTP.Directory (httpExists, httpManager) import SimpleCmd+import SimplePrompt (promptEnter, promptInitial) import Branches import Bugzilla@@ -14,7 +15,6 @@ import ListReviews import Package import Pagure-import SimplePrompt -- FIXME separate pre-checked listReviews and direct pkg call, which needs checks requestRepos :: Bool -> Bool -> Bool -> (BranchesReq, [String]) -> IO ()@@ -53,23 +53,23 @@ comments <- getComments session bid mapM_ showComment comments putNewLn- prompt_ "Press Enter to continue"+ promptEnter "Press Enter to continue" -- FIXME check api key is still valid or open pagure ticket directly url <- fedpkg "request-repo" [pkg, show bid] let assignee = userRealName (bugAssignedToDetail bug)- let draft = "Thank you for the review" ++ maybe "" (", " ++) (getFirstname assignee)+ let draft = "Thank you for the review" ++ maybe "" ("," +-+) (getFirstname assignee) putStrLn "```" putStrLn draft putStrLn "```" putStrLn $ url ++ "\n"- input <- prompt "Press Enter to post above comment, or input now"+ input <- promptInitial "Enter comment" draft let comment = (if null input then draft else input) ++ "\n\n" <> url commentBug session bid comment putNewLn branches <- getRequestedBranches [] breq forM_ branches $ \ br -> do when mock $ fedpkg_ "mockbuild" ["--root", mockRoot br Nothing]- putStr (show br ++ " ")+ putStr $ show br ++ " " fedpkg_ "request-branch" ["--repo", pkg, show br] putNewLn where@@ -92,7 +92,7 @@ mgr <- httpManager exists <- httpExists mgr $ "https://" ++ srcfpo +/+ "rpms" +/+ pkg when exists $- error' $ "Repo for " ++ pkg ++ " already exists"+ error' $ "Repo for" +-+ pkg +-+ "already exists" -- FIXME handle "email name" getFirstname :: T.Text -> Maybe String
src/Cmd/Scratch.hs view
@@ -50,7 +50,6 @@ then return [anyTarget br] else mapM (targetMaybeSidetag dryrun (onlyRelBranch br) . Just) sidetagTargets forM_ targets $ \target -> do- putStrLn $ "Target: " ++ target archs <- case marchopts of Nothing -> return []@@ -87,7 +86,7 @@ case msource of Just (ScratchRef ref) -> if length ref < 6- then error' $ "please use a longer ref: " ++ ref+ then error' $ "please use a longer ref:" +-+ ref -- FIXME print commit log else return True Just (ScratchSRPM _) -> return False@@ -113,7 +112,8 @@ else srpmBuild kojiargs where srpmBuild :: [String] -> IO ()- srpmBuild kojiargs =+ srpmBuild kojiargs = do+ putStrLn $ "Target:" +-+ target void $ generateSrpm (Just br) spec >>= kojiScratchBuild target kojiargs -- FIXME default -X to --no-fastfail?
src/Cmd/SideTags.hs view
@@ -1,12 +1,12 @@ module Cmd.SideTags (sideTagsCmd) where import SimpleCmd (cmd_)+import SimplePrompt (yesNo) import Branches import Common import Koji import Krb (krbTicket)-import SimplePrompt (yesno) sideTagsCmd :: Bool -> [Branch] -> IO () sideTagsCmd remove brs = do@@ -19,5 +19,5 @@ where removeSideTag :: String -> IO () removeSideTag tag =- whenM (yesno Nothing $ "Remove " ++ tag) $+ whenM (yesNo $ "Remove" +-+ tag) $ cmd_ "fedpkg" ["remove-side-tag", tag]
src/Cmd/Sort.hs view
@@ -16,6 +16,7 @@ import Branches import Git import Package+import RpmBuild (getDynSourcesMacros) data RpmWith = RpmWith String | RpmWithout String @@ -25,7 +26,7 @@ sortCmd :: SortDisplay -> Maybe RpmWith -> (Branch,[String]) -> IO () sortCmd _ _ (_,[]) = return () sortCmd displaymode mrpmwith (br, pkgs) = do- withPackagesBranch HeaderNone False Nothing noop (br, pkgs)+ withPackagesBranch HeaderNone False Nothing setupPkg (br, pkgs) let rpmopts = maybe [] toRpmOption mrpmwith case displaymode of -- reverse because rpmbuild-order reverses the order of independent pkgs?@@ -40,9 +41,10 @@ SortPlain -> dependencySortRpmOpts rpmopts (reverse pkgs) >>= putStrLn . unwords -noop :: Package -> AnyBranch -> IO ()-noop _pkg br =+setupPkg :: Package -> AnyBranch -> IO ()+setupPkg pkg br = do whenM isPkgGitRepo $ gitSwitchBranch br+ getDynSourcesMacros $ packageSpec pkg toRpmOption :: RpmWith -> [String] toRpmOption (RpmWith opt) = ["--with=" ++ opt]@@ -50,7 +52,7 @@ graphCmd :: Bool -> Maybe RpmWith -> (Maybe Branch,[FilePath]) -> IO () graphCmd dot mrpmwith (mbr, pkgs) = do- withPackagesMaybeBranchNoHeadergit noop (mbr, pkgs)+ withPackagesMaybeBranchNoHeadergit setupPkg (mbr, pkgs) let rpmopts = maybe [] toRpmOption mrpmwith createGraph4 False [] rpmopts False False True Nothing pkgs >>= if dot then printGraph else renderGraph
src/Cmd/SrcDeps.hs view
@@ -12,20 +12,20 @@ import Git import Package -srcDepsCmd :: Bool -> (Branch,[String]) -> IO ()-srcDepsCmd rev (rbr,pkgs) =- srcDeps rev (rbr,pkgs) >>=+srcDepsCmd :: Bool -> [String] -> (Branch,[String]) -> IO ()+srcDepsCmd rev macros (rbr,pkgs) =+ srcDeps rev macros (rbr,pkgs) >>= mapM_ (putStrLn . unwords) -srcDeps :: Bool -> (Branch,[String]) -> IO [[String]]-srcDeps rev (rbr,pkgs) = do+srcDeps :: Bool -> [String] -> (Branch,[String]) -> IO [[String]]+srcDeps rev macros (rbr,pkgs) = do when (null pkgs) $ error' "please specify one or more package dirs" whenM isPkgGitRepo $ error' "please run from the directory containing the dependency package set" listDirectory "." >>= filterM checkPackage . filter ((/= '.') . head) >>=- fmap (topsortGraph Combine) . depsGraphDeps rev [] False [] [] False Nothing pkgs+ fmap (topsortGraph Combine) . depsGraphDeps rev (map ("-D" +-+) macros) False [] [] False Nothing pkgs where checkPackage :: FilePath -> IO Bool checkPackage p = do
src/Cmd/Status.hs view
@@ -44,14 +44,14 @@ if not brExists then do name <- getDirectoryName- putStrLn $ name ++ " has no branch " ++ show br+ putStrLn $ name +-+ "has no branch" +-+ show br else do gitSwitchBranch rbr let spec = packageSpec pkg ifM (notM (doesFileExist spec)) (ifM initialPkgRepo (putStrLn $ show br ++ ": initial repo")- (putStrLn $ "missing " ++ spec)) $+ (putStrLn $ "missing" +-+ spec)) $ do mnvr <- pkgNameVerRel br spec case mnvr of@@ -66,7 +66,7 @@ -- when ancestor $ do -- unmerged <- gitOneLineLog $ "HEAD..origin/" ++ show newerBr -- unless (null unmerged) $ do- -- putStrLn $ "Newer commits in " ++ show newerBr ++ ":"+ -- putStrLn $ "Newer commits in" +-+ show newerBr ++ ":" -- mapM_ putStrLn unmerged munpushed <- gitShortLog1 $ Just $ "origin/" ++ show br ++ "..HEAD" case munpushed of@@ -76,9 +76,9 @@ Nothing -> do mlatest <- kojiLatestNVR (branchDestTag br) (unPackage pkg) case mlatest of- Nothing -> putStrLn $ "new " ++ nvr+ Nothing -> putStrLn $ "new" +-+ nvr Just latest ->- putStrLn $ if equivNVR nvr latest then latest ++ " is latest modulo disttag" else (if null latest then "new " else (head . words) latest ++ " ->\n") ++ nvr+ putStrLn $ if equivNVR nvr latest then latest +-+ "is latest modulo disttag" else (if null latest then "new " else (head . words) latest +-+ "->\n") ++ nvr Just buildid -> do tags <- kojiBuildTags fedoraHub (buildIDInfo buildid) if null tags@@ -87,10 +87,10 @@ -- FIXME show pending archs building whenJust mstatus $ \ status -> -- FIXME better Show BuildStatus- putStr $ nvr ++ " (" ++ show status ++ ")"+ putStr $ nvr +-+ "(" ++ show status ++ ")" else do -- FIXME hide testing if ga/stable- putStr $ nvr ++ " (" ++ unwords tags ++ ")"+ putStr $ nvr +-+ "(" ++ unwords tags ++ ")" unless (isStable tags) $ do updates <- bodhiUpdates [makeItem "display_user" "0",@@ -149,7 +149,7 @@ if not brExists then do name <- getDirectoryName- putStrLn $ name ++ " has no branch " ++ show br+ putStrLn $ name +-+ "has no branch" +-+ show br else do gitSwitchBranch rbr let spec = packageSpec pkg@@ -164,7 +164,7 @@ (ifM initialPkgRepo (putStrLn $ prefix +-+ "initial repo") (unlessM (doesFileExist "dead.package") $- putStrLn $ "missing " ++ spec)) $+ putStrLn $ "missing" +-+ spec)) $ do whenM (isNothing <$> pkgNameVerRel br spec) $ do putStrLn "undefined NVR!\n"
src/Cmd/Update.hs view
@@ -12,8 +12,10 @@ import Package import Data.RPM.VerCmp-import SimplePrompt (prompt_)+import SimplePrompt (promptEnter) +-- FIXME if autorelease, drop -b baserelease+-- FIXME --no-prep to avoid overwriting ongoing build -- FIXME don't bump release if already bumped -- FIXME check EVR increased -- FIXME if multiple sources might need to bump release@@ -42,7 +44,7 @@ updatePkg :: Maybe String -> Package -> AnyBranch -> IO () updatePkg mver pkg br = do when (br /= RelBranch Rawhide) $- prompt_ $ "Are you sure you want to update " ++ show br ++ "?"+ promptEnter $ "Are you sure you want to update" +-+ show br +-+ "branch?!" spec <- if allowHEAD then findSpecfile else localBranchSpecFile pkg br@@ -54,12 +56,12 @@ Nothing -> do when (null vdiff && not onlysources) $ error' "specify or edit version to update"- putStrLn $ "current version: " ++ curver+ putStrLn $ "current version:" +-+ curver Just nver -> do when (length vdiff == 2) $- error' $ "spec version already bumped to " ++ curver+ error' $ "spec version already bumped to" +-+ curver when (curver == nver) $- putStrLn $ "already new version " ++ curver+ putStrLn $ "already new version" +-+ curver let moldnewver = case mver of Just nver -> Just (curver,nver)@@ -73,7 +75,7 @@ -- FIXME take epoch into account when (rpmVerCompare oldver newver == GT) $ putStrLn $ "current" +-+ oldver +-+ "is newer!"- putStrLn $ oldver ++ " ->\n" ++ newver+ putStrLn $ oldver +-+ "->\n" ++ newver when (curver /= newver) $ do editSpecField "Version" newver spec editSpecField "Release" "0%{?dist}" spec@@ -89,7 +91,7 @@ unless force $ -- FIXME only if not all exist cmd_ "spectool" ["-g", "-S", spec]- patches <- cmdLines "spectool" ["-P", spec]+ patches <- map sourceFieldFile <$> cmdLines "spectool" ["-P", spec] forM_ patches $ \patch -> unlessM (doesFileExist patch) $ cmd_ "spectool" ["-g", "-P", spec]@@ -103,8 +105,8 @@ versions <- changelogVersions spec let missing = null versions || not ((newver ++ "-") `isPrefixOf` head versions) when missing $ do- cmd_ "rpmdev-bumpspec" ["-c", "update to " ++ newver, spec]- git_ "commit" ["-a", "-m", "update to " ++ newver]+ cmd_ "rpmdev-bumpspec" ["-c", "update to" +-+ newver, spec]+ git_ "commit" ["-a", "-m", "update to" +-+ newver] putStr "Prepping... " cmdSilent' "rpmbuild" ["-bp", spec] putStrLn "done"@@ -129,7 +131,7 @@ --hostdist <- cmd "rpm" ["--eval", "%{dist}"] mvr <- cmdMaybe "rpmspec" ["-q", "--srpm", "--qf", "%{version}-%{release}", spec] case mvr of- Nothing -> error' $ "Failed to read package ver-rel: " ++ spec+ Nothing -> error' $ "Failed to read package ver-rel:" +-+ spec Just vr -> return $ splitBy "-" vr splitBy :: String -> String -> (String,String)@@ -137,7 +139,7 @@ let ws = splitOn sep xs in case ws of [f,v] -> (f,v)- _ -> error $ "inconsistent field: " ++ xs+ _ -> error $ "inconsistent field:" +-+ xs changelogVersions :: FilePath -> IO [String] changelogVersions spec = do
src/Cmd/WaitRepo.hs view
@@ -33,5 +33,5 @@ let spec = packageSpec pkg nvr <- pkgNameVerRel' br spec target <- targetMaybeSidetag dryrun br msidetagTarget- logMsg $ "Waiting for " ++ nvr ++ " to appear in " ++ target+ logMsg $ "Waiting for" +-+ nvr +-+ "to appear in" +-+ target timeIO $ kojiWaitRepo dryrun True knowntag target nvr
src/Common.hs view
@@ -8,6 +8,7 @@ (<>), #endif (+/+),+ (+-+), plural, pluralException, putNewLn@@ -22,6 +23,7 @@ #endif import Network.HTTP.Query ((+/+))+import SimpleCmd ((+-+)) plural :: Int -> String -> String plural i ns =
src/Common/System.hs view
@@ -44,7 +44,7 @@ (\start -> do end <- getCurrentTime let duration = diffUTCTime end start- putStrLn $ "took " ++ show duration)+ putStrLn $ "took" +-+ show duration) (const action) #endif
src/Git.hs view
@@ -63,7 +63,7 @@ diff <- git "diff" [ref] unless (null diff) $ do putStrLn $ "current branch is ahead of newer" +-+ show br +-+ "!!"- prompt_ "Press Enter if you want to continue"+ promptEnter "Press Enter if you want to continue" else putStrLn $ "current branch" +-+ "is diverged from" +-+ show br return (ancestor, commits) @@ -164,7 +164,7 @@ else do when quiet $ putStrLn "" putStrLn $ unwords ("git" : args) +-+ "failed with\n" ++ err- yes <- yesno Nothing "Retry git push"+ yes <- yesNo "Retry git push" when yes $ gitPush quiet mref -- FIXME use this in more places@@ -176,7 +176,7 @@ gitFetchSilent quiet = do name <- gitRepoName unless quiet $- putStr $ "git fetching " ++ name ++ "... "+ putStr $ "git fetching" +-+ name ++ "... " (ok, out, err) <- cmdFull "git" ["fetch"] "" unless (null out) $ putStrLn out unless ok $ error' err@@ -193,7 +193,7 @@ clean <- isGitDirClean unless clean $ do dir <- getCurrentDirectory- error' $ "Working dir is not clean: " ++ dir+ error' $ "Working dir is not clean:" +-+ dir isGitDirClean :: IO Bool isGitDirClean =@@ -233,9 +233,6 @@ egrep_ key $ gitdir </> "config" else return False -gitLines :: String -> [String] -> IO [String]-gitLines c args = lines <$> git c args- gitSwitchBranch :: AnyBranch -> IO () gitSwitchBranch (OtherBranch "HEAD") = do dir <- getDirectoryName@@ -257,7 +254,7 @@ if not remotebranch then do name <- getDirectoryName- error' $ name ++ " " ++ show br ++ " branch does not exist!"+ error' $ name +-+ show br +-+ "branch does not exist!" else git_ "checkout" ["-q", "-b", show br, "--track", "origin/" ++ show br] @@ -283,7 +280,7 @@ then do name <- getDirectoryName unless quiet $- warning $ name ++ " " ++ show br ++ " branch does not exist!"+ warning $ name +-+ show br +-+ "branch does not exist!" return False else do git_ "checkout" ["-q", "-b", show br, "--track", "origin/" ++ show br]@@ -302,9 +299,12 @@ case map commitRef commits of [] -> error' "empty commits list" (c:cs) -> do+ -- FIXME use promptMap ref <- prompt txt- case lower ref of+ case lower (trim ref) of "" -> return $ Just c+ "y" -> return $ Just c+ "yes" -> return $ Just c "no" -> return Nothing "n" -> return Nothing _ ->
src/Koji.hs view
@@ -32,7 +32,7 @@ import Data.Fixed (Micro) import Distribution.Koji import qualified Distribution.Koji.API as Koji-import SimplePrompt+import SimplePrompt (promptEnter) import System.Exit import System.Process.Typed import System.Timeout (timeout)@@ -54,7 +54,7 @@ kojiNVRTags nvr = do mbldid <- kojiGetBuildID fedoraHub nvr case mbldid of- Nothing -> error' $ nvr ++ " koji build not found"+ Nothing -> error' $ nvr +-+ "koji build not found" Just bldid -> kojiBuildTags fedoraHub (buildIDInfo bldid) kojiBuildStatus :: String -> IO (Maybe BuildState)@@ -121,7 +121,7 @@ cmd_ "date" ["+%T"] return $ if wait then Right kojiurl else Left task else do- prompt_ "Press Enter to resubmit Koji build"+ promptEnter "Press Enter to resubmit Koji build" kojiBuild' wait target args -- kojiBuild :: String -> [String] -> IO String@@ -145,7 +145,8 @@ Just TaskFailed -> do let kojitool = "/usr/bin/koji-tool" whenM (doesFileExist kojitool) $- cmd_ kojitool ["tasks", displayID task, "--tail", "-s", "fail"]+ -- FIXME fails to output when run immediately? (cmdlog deprecated)+ cmdlog kojitool ["tasks", displayID task, "--tail", "-s", "fail"] error' "Task failed!" Just TaskCanceled -> return () _ -> kojiWatchTask task@@ -170,7 +171,7 @@ kojiWaitTask task else return $ ts == TaskClosed Nothing -> do- error $ "failed to get info for koji task " ++ displayID task+ error $ "failed to get info for koji task" +-+ displayID task kojiSource :: Package -> String -> String kojiSource pkg ref =@@ -186,7 +187,7 @@ kojiBuildBranch target pkg mref args = checkResult <$> kojiBuildBranch' True target pkg mref args where- checkResult = either (\ task -> error' (displayID task ++ " not completed")) (const ())+ checkResult = either (\ task -> error' (displayID task +-+ "not completed")) (const ()) kojiBuildBranchNoWait ::String -> Package -> Maybe String -> [String] -> IO TaskID kojiBuildBranchNoWait target pkg mref args = do@@ -216,7 +217,7 @@ putStrLn $ "current tags:" +-+ unwords tags unless (buildtag `elem` tags) $ do putStrLn $ "no" +-+ nvr +-+ "tagged" +-+ buildtag- prompt_ "Press Enter to continue anyway"+ promptEnter "Press Enter to continue anyway" waitRepo buildtag Nothing where waitRepo :: String -> Maybe Struct -> IO ()@@ -225,7 +226,7 @@ threadDelay (fromEnum (50 :: Micro)) -- 50s mrepo <- kojiGetRepo fedoraHub buildtag Nothing Nothing case mrepo of- Nothing -> error' $ "failed to find koji repo for " ++ buildtag+ Nothing -> error' $ "failed to find koji repo for" +-+ buildtag Just repo -> if moldrepo == mrepo then waitRepo buildtag mrepo@@ -236,13 +237,13 @@ Just event -> do latest <- kojiLatestNVRRepo buildtag event (nameOfNVR nvr) if latest == Just nvr- then logMsg $ nvr +++ then logMsg $ nvr +-+ if isNothing moldrepo- then " is in " ++ buildtag- else " appeared"+ then "is in" +-+ buildtag+ else "appeared" else do when (isNothing moldrepo && not quiet) $- logMsg $ "Waiting for " ++ buildtag ++ " to have " ++ nvr+ logMsg $ "Waiting for" +-+ buildtag +-+ "to have" +-+ nvr waitRepo buildtag mrepo -- FIXME: obsolete by using NVR@@ -291,17 +292,17 @@ Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub (show br) out <- if dryrun- then return $ "Side tag '" ++ buildtag ++ "-dryrun'"+ then return $ "Side tag '" ++ buildtag ++ "'" else head . lines <$> fedpkg "request-side-tag" ["--base-tag", buildtag] if "Side tag '" `isPrefixOf` out then do putStrLn out let sidetag = init . dropWhileEnd (/= '\'') $ dropPrefix "Side tag '" out- logMsg $ "Waiting for " ++ sidetag ++ " repo"+ logMsg $ "Waiting for" +-+ sidetag +-+ "repo" unless dryrun $ cmd_ "koji" ["wait-repo", sidetag] return sidetag else error' "'fedpkg request-side-tag' failed" [tag] -> return tag- _ -> error' $ "More than one user side-tag found for " ++ show br+ _ -> error' $ "More than one user side-tag found for" +-+ show br
src/Main.hs view
@@ -210,6 +210,7 @@ , Subcommand "src-deps" "List source package dependencies" $ srcDepsCmd <$> switchWith 'r' "reverse" "Reverse dependencies"+ <*> many (strOptionWith 'D' "define" "'MACRO DEF'" "Define RPM macro") <*> branchPackages , Subcommand "mock" "Local mock build" $ mockCmd@@ -436,7 +437,7 @@ in case brs of [] -> error' "specify one branch" [br] -> (br,pkgs)- _ -> error' $ "cannot have more than one branch: " ++ unwords (map show brs)+ _ -> error' $ "cannot have more than one branch:" +-+ unwords (map show brs) maybeBranchPackages :: Bool -> Parser (Maybe Branch,[String]) maybeBranchPackages oneplus =@@ -451,7 +452,7 @@ in case brs of [] -> (Nothing, pkgs) [br] -> (Just br,pkgs)- _ -> error' $ "cannot have more than one branch: " ++ unwords (map show brs)+ _ -> error' $ "cannot have more than one branch:" +-+ unwords (map show brs) -- FIXME split later to prevent branches after packages branchesPackages :: Parser (BranchesReq, [String])
src/Package.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- module Package ( clonePkg, CloneUser(..),@@ -46,7 +44,7 @@ import Distribution.Fedora hiding (Fedora,EPEL,EPELNext) import SimpleCmd.Rpm-import SimplePrompt+import SimplePrompt (prompt) import Branches import Common@@ -65,10 +63,11 @@ checkForSpecFile :: String -> IO () checkForSpecFile spec = do have <- doesFileExist spec- unless have $ error' $ spec ++ " not found"+ unless have $ error' $ spec +-+ "not found" -changeLogPrompt :: Maybe String -> FilePath -> IO String-changeLogPrompt mcontext spec = do+-- FIXME allow editor to be used+changeLogPrompt :: Bool -> FilePath -> IO String+changeLogPrompt isupdate spec = do clog <- cleanChangelog spec putNewLn putStrLn "```"@@ -79,7 +78,7 @@ if not tty then return clog else do- userlog <- prompt $ "Press Enter to use above or input " ++ fromMaybe "change" mcontext ++ " summary now" ++ if isJust mcontext then "; or 'no' to skip update" else ""+ userlog <- prompt $ "Press Enter to use above or input" +-+ (if isupdate then "update" else "change") +-+ "summary now" ++ if isupdate then "; or 'no' to skip update" else "" return $ if null userlog then clog else userlog getChangelog :: FilePath -> IO [String]@@ -93,9 +92,10 @@ cleanChangelog :: FilePath -> IO String cleanChangelog spec = do ls <- getChangelog spec- return $ case filter ("- " `isPrefixOf`) ls of- [l] -> removePrefix "- " l- _ -> unlines ls+ return $+ case filter ("- " `isPrefixOf`) ls of+ [l] -> removePrefix "- " l ++ "\n"+ _ -> unlines ls getSummaryURL :: FilePath -> IO String getSummaryURL spec = do@@ -124,7 +124,7 @@ Just spec -> return spec Nothing -> do dir <- getDirectoryName- error' $ "No spec file found in: " ++ dir+ error' $ "No spec file found in:" +-+ dir -- adapted from fileWithExtension maybeFindSpecfile :: IO (Maybe FilePath)@@ -133,7 +133,7 @@ case files of [] -> return Nothing [spec] -> return $ Just spec- _ -> error' $ "More than one .spec file: " ++ unwords files+ _ -> error' $ "More than one .spec file:" +-+ unwords files localBranchSpecFile :: Package -> AnyBranch -> IO FilePath localBranchSpecFile pkg br = do@@ -148,9 +148,9 @@ mspec <- maybeFindSpecfile case mspec of Just spc -> do- putStrLn $ "Warning: directory name differs from " ++ spc ++ "\n"+ putStrLn $ "Warning: directory name differs from" +-+ spc ++ "\n" return spc- Nothing -> error' $ "No spec file for: " ++ unPackage pkg+ Nothing -> error' $ "No spec file for:" +-+ unPackage pkg else findSpecfile withExistingDirectory :: FilePath -> IO a -> IO a@@ -158,7 +158,7 @@ exists <- doesDirectoryExist dir if exists then withCurrentDirectory dir act- else error' $ "No such directory: " ++ dir+ else error' $ "No such directory:" +-+ dir -- newly created Fedora repos/branches have just one README commit initialPkgRepo :: IO Bool@@ -171,15 +171,15 @@ putPkgHdr :: Package -> IO () putPkgHdr pkg =- putStrLn $ "\n= " ++ unPackage pkg ++ " ="+ putStrLn $ "\n=" +-+ unPackage pkg +-+ "=" putPkgBrnchHdr :: Package -> Branch -> IO () putPkgBrnchHdr pkg br =- putStrLn $ "\n== " ++ unPackage pkg ++ " " ++ show br ++ " =="+ putStrLn $ "\n==" +-+ unPackage pkg +-+ show br +-+ "==" putPkgAnyBrnchHdr :: Package -> AnyBranch -> IO () putPkgAnyBrnchHdr pkg br =- putStrLn $ "\n== " ++ unPackage pkg ++ " " ++ show br ++ " =="+ putStrLn $ "\n==" +-+ unPackage pkg +-+ show br +-+ "==" packageSpec :: Package -> FilePath packageSpec pkg = unPackage pkg <.> "spec"@@ -255,7 +255,7 @@ putStrLn $ "Warning: package name (" ++ unPackage pkg ++ ") differs from spec filename!" haveGit <- isPkgGitRepo when (isJust mgitopts && not haveGit) $- error' $ "Not a pkg git dir: " ++ unPackage pkg+ error' $ "Not a pkg git dir:" +-+ unPackage pkg mcurrentbranch <- if haveGit then@@ -271,7 +271,7 @@ 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)+ error' $ "more than one branch given:" +-+ unwords (map show brs) ExactlyOne | null brs -> error' "please specify one branch" ExactlyOne | length brs > 1 ->@@ -287,7 +287,7 @@ when fetch $ gitFetchSilent False -- FIXME!! no branch restriction when (breq `elem` map BranchOpt [AllBranches,AllFedora,AllEPEL]) $- putStrLn $ "Branches: " ++ unwords (map show brs) ++ "\n"+ putStrLn $ "Branches:" +-+ unwords (map show brs) ++ "\n" -- FIXME add newline at end? let action' p b = do when (header /= HeaderNone && length brs > 1) $ putPkgAnyBrnchHdr p b@@ -344,7 +344,7 @@ git_ "clone" $ ["--quiet"] ++ mbranch ++ ["ssh://" ++ fasid ++ "@pkgs.fedoraproject.org/rpms/" ++ pkg <.> "git"] where msgout =- putStrLn $ if quiet then "cloning..." else "Cloning: " ++ pkg+ putStrLn $ if quiet then "cloning..." else "Cloning:" +-+ pkg isAutoRelease :: FilePath -> IO Bool isAutoRelease spec = do@@ -379,7 +379,7 @@ pkgNameVerRel' br spec = do mnvr <- pkgNameVerRel br spec case mnvr of- Nothing -> error' $ "rpmspec failed to parse " ++ spec+ Nothing -> error' $ "rpmspec failed to parse" +-+ spec Just nvr -> return nvr getBranchDist :: AnyBranch -> IO Dist@@ -435,13 +435,13 @@ -- if ".spec" `isExtensionOf` fp -- then do -- exists' <- doesFileExist fp--- unless exists' $ error' $ fp ++ " file not found"+-- 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"+-- error' $ fp +-+ "directory not found" -- return exists' -- brPkgsToBranchesPkgs :: [BrPkg] -> ([AnyBranch], [String])@@ -457,12 +457,12 @@ -- toBranch :: BrPkg -> AnyBranch -- toBranch (IsBr br) = br -- toBranch (Unknown br) = OtherBranch br--- toBranch (IsPkg p) = error' $ "can't map package to branch: " ++ p+-- 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 (IsBr b) = error' $ "can't map branch to package:" +-+ show b editSpecField :: String -> String -> FilePath -> IO () editSpecField field new spec =
src/Pagure.hs view
@@ -10,7 +10,7 @@ printScmIssue ) where -import Common ((+/+))+import Common ((+/+), (+-+)) import qualified Common.Text as T import Fedora.Pagure@@ -23,6 +23,6 @@ printScmIssue :: IssueTitleStatus -> IO () printScmIssue issue =- putStrLn $ "https://" ++ pagureio +/+ "releng/fedora-scm-requests" +/+ "issue" +/+ show (pagureIssueId issue) ++ " (" ++ T.unpack (pagureIssueStatus issue) ++ mclosed ++ "): " ++ pagureIssueTitle issue+ putStrLn $ "https://" ++ pagureio +/+ "releng/fedora-scm-requests" +/+ "issue" +/+ show (pagureIssueId issue) +-+ "(" ++ T.unpack (pagureIssueStatus issue) ++ mclosed ++ "):" +-+ pagureIssueTitle issue where mclosed = maybe "" (\s-> ":" ++ T.unpack s) $ pagureIssueCloseStatus issue
src/RpmBuild.hs view
@@ -2,9 +2,10 @@ builtRpms, buildRPMs, installDeps,- installMissingMacros, buildRequires, getSources,+ getSourcesMacros,+ getDynSourcesMacros, generateSrpm, generateSrpm', BCond(..),@@ -22,7 +23,7 @@ import Distribution.Fedora hiding (Fedora,EPEL,EPELNext) import Network.HTTP.Directory (Manager, httpExists, httpManager) import SimpleCmd.Rpm-import SimplePrompt (prompt_)+import SimplePrompt (promptEnter) import System.Console.Pretty import System.IO.Extra (withTempDir) import System.Posix.Files@@ -38,9 +39,9 @@ dist <- getBranchDist br -- previously was "" for pkggit rpmdir <- fromMaybe "" <$> rpmEval "%{_rpmdir}"- rpms <- rpmspec ["--builtrpms", "--define", "dist " ++ rpmDistTag dist] (Just (rpmdir </> "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm")) spec+ rpms <- rpmspec ["--builtrpms", "--define", "dist" +-+ rpmDistTag dist] (Just (rpmdir </> "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm")) spec if null rpms- then error' $ spec ++ " does not seem to create any rpms"+ then error' $ spec +-+ "does not seem to create any rpms" else return rpms rpmEval :: String -> IO (Maybe String)@@ -51,7 +52,7 @@ -- rpmEval' :: String -> IO String -- rpmEval' s = do -- mres <- rpmEval s--- fromMaybe (error' (show s ++ " undefined!")) mres+-- fromMaybe (error' (show s +-+ "undefined!")) mres getSources :: FilePath -> IO [FilePath] getSources spec = do@@ -93,7 +94,7 @@ else do cmd_ "spectool" ["-g", "-S", spec] unlessM (doesFileExist src) $- error' $ "download failed: " ++ src+ error' $ "download failed:" +-+ src unless inSrcdir $ whenJust msrcdir $ \srcdir -> createLink src (srcdir </> src)@@ -105,7 +106,7 @@ else do cmd_ "spectool" ["-g", "-P", spec] unlessM (doesFileExist patch) $- error' $ "missing patch: " ++ patch+ error' $ "missing patch:" +-+ patch return $ srcs ++ patches where sourceFieldFile :: String -> Either FilePath FilePath@@ -117,7 +118,7 @@ (case lower (dropWhileEnd isDigit (init f)) of "source" -> Right "patch" -> Left- _ -> error' $! "illegal field: " ++ f)+ _ -> error' $! "illegal field:" +-+ f) $ takeFileName v checkCompression :: FilePath -> IO Bool@@ -135,7 +136,7 @@ Just prog -> do have <- findExecutable prog when (isNothing have) $ do- putStrLn $ "Running 'dnf install' " ++ prog+ putStrLn $ "Running 'dnf install'" +-+ prog cmd_ "/usr/bin/sudo" $ "/usr/bin/dnf":"install": ["--assumeyes", prog] cmdBool prog ["-t", file] Nothing -> return True@@ -161,11 +162,11 @@ Nothing -> return [] Just br -> do dist <- getBranchDist br- return ["--define", "dist " ++ rpmDistTag dist]+ return ["--define", "dist" +-+ rpmDistTag dist] msrcrpmdir <- rpmEval "%{_srcrpmdir}" srpmfile <- cmd "rpmspec" $ ["-q", "--srpm"] ++ distopt ++ ["--qf", fromMaybe "" msrcrpmdir </> "%{name}-%{version}-%{release}.src.rpm", spec] cwd <- getCurrentDirectory- let sourcediropt = ["--define", "_sourcedir " ++ cwd]+ let sourcediropt = ["--define", "_sourcedir" +-+ cwd] opts = distopt ++ sourcediropt if force then buildSrpm opts@@ -180,12 +181,12 @@ then buildSrpm opts else do -- pretty print with ~/- putStrLn $ srpmfile ++ " is up to date"+ putStrLn $ srpmfile +-+ "is up to date" return srpmfile where buildSrpm opts = do srpm <- last . words <$> cmd "rpmbuild" (opts ++ ["-bs", spec])- putStrLn $ "Created " ++ takeFileName srpm+ putStrLn $ "Created" +-+ takeFileName srpm return srpm data ForceShort = ForceBuild | ShortCompile | ShortInstall@@ -230,13 +231,13 @@ Just ShortCompile -> ["-bc", "--short-circuit"] Just ShortInstall -> ["-bi", "--short-circuit"] _ -> "-bb" : ["--noclean" | noclean]- sourcediropt = ["--define", "_sourcedir " ++ cwd]- args = sourcediropt ++ ["--define", "dist " ++ rpmDistTag dist] +++ sourcediropt = ["--define", "_sourcedir" +-+ cwd]+ args = sourcediropt ++ ["--define", "dist" +-+ rpmDistTag dist] ++ buildopt ++ map show bconds ++ [spec] date <- cmd "date" ["+%T"] rbr <- anyBranchToRelease br nvr <- pkgNameVerRel' rbr spec- putStr $ date ++ " Building " ++ nvr ++ " locally... "+ putStr $ date +-+ "Building" +-+ nvr +-+ "locally... " ok <- do let buildlog = ".build-" ++ (showVerRel . nvrVerRel . readNVR) nvr <.> "log" whenM (doesFileExist buildlog) $@@ -246,7 +247,7 @@ then do putNewLn -- FIXME would like to have pipeOutErr- let buildcmd = unwords $ "rpmbuild" : map quoteArg args ++ "|&" : "tee" : [buildlog ++ " && exit ${PIPESTATUS[0]}"]+ let buildcmd = unwords $ "rpmbuild" : map quoteArg args ++ "|&" : "tee" : [buildlog +-+ "&& exit ${PIPESTATUS[0]}"] when debug $ putStrLn buildcmd shellBool buildcmd else do@@ -258,7 +259,7 @@ else cmd_ "tail" ["-n 100", buildlog] return res unless ok $- error' $ nvr ++ " failed to build"+ error' $ nvr +-+ "failed to build" return needBuild where quoteArg :: String -> String@@ -270,7 +271,7 @@ installDeps strict spec = do missingdeps <- nub <$> (buildRequires spec >>= filterM notInstalled) unless (null missingdeps) $ do- putStrLn $ "Running 'dnf install' " ++ unwords missingdeps+ putStrLn $ "Running 'dnf install'" +-+ unwords missingdeps cmd_ "/usr/bin/sudo" $ "/usr/bin/dnf":"install": ["--skip-broken" | not strict] ++ ["--assumeyes"] ++ missingdeps installMissingMacros :: FilePath -> IO ()@@ -338,7 +339,7 @@ src `notElem` gitfiles) sourcefiles unless (null missing) $ do- prompt_ $ color Red $ unwords missing ++ " not in sources, please fix"+ promptEnter $ color Red $ unwords missing +-+ "not in sources, please fix" checkOnBranch checkSourcesMatch spec mgr <- httpManager@@ -356,10 +357,20 @@ (file', "https://src.fedoraproject.org/lookaside/pkgs" +/+ pkg +/+ file +/+ "md5" +/+ hash +/+ file) _ -> error' $ "invalid/unknown source:\n" ++ source unlessM (httpExists mgr url) $ do- putStrLn $ url ++ " not found"- putStrLn $ "uploading " ++ file ++ " to lookaside source repo"+ putStrLn $ url +-+ "not found"+ putStrLn $ "uploading" +-+ file +-+ "to lookaside source repo" fedpkg_ "upload" [file] notInstalled :: String -> IO Bool notInstalled pkg = not <$> cmdBool "rpm" ["--quiet", "-q", "--whatprovides", pkg]++getSourcesMacros :: FilePath -> IO ()+getSourcesMacros spec = do+ void $ getSources spec+ installMissingMacros spec++getDynSourcesMacros :: FilePath -> IO ()+getDynSourcesMacros spec =+ whenM (grep_ "^%generate_buildrequires" spec) $+ getSourcesMacros spec
src/Types.hs view
@@ -8,6 +8,7 @@ data Archs = Archs [String] | ExcludedArchs [String] data SideTagTarget = SideTag | Target String+ deriving Eq maybeTarget :: Maybe SideTagTarget -> Maybe String maybeTarget (Just (Target t)) = Just t