diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +# 1.1 (2023-11-19) +- Dist: F39 and lts-21 +- fhpkg update: add -k (--keep-going) +- fhpkg stackage-compare restored with new stack list command +- Build: better error after failed git rebase +- fhbz: port to simple-cmd-args + # 1.0 (2022-01-22) - use fedora-dists-2.0 - Hackage distro urls now point to pagure dist-git diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -19,14 +19,19 @@ Chain builds packages with wait-repo. Also checks that updated dependencies have been built first. -See TODO for more planned features. +See TODO for possible future ideas. Note that many of the generic commands provided are now available and -maintained in the [fbrnch](https://github.com/juhp/fbrnch) tool, -which should be preferred. +better maintained in the [fbrnch](https://github.com/juhp/fbrnch) tool, +which is packaged in Fedora and should be preferred. ## fhbz Update version update bugs in Bugzilla for Haskell packages. ## fhmock Tool for standalone mock chroots for building and development. + +## Contribute +fedora-haskell-tools is distributed under the GPL license version 3 or later. + + diff --git a/fedora-haskell-tools.cabal b/fedora-haskell-tools.cabal --- a/fedora-haskell-tools.cabal +++ b/fedora-haskell-tools.cabal @@ -1,5 +1,5 @@ Name: fedora-haskell-tools -Version: 1.0 +Version: 1.1 Synopsis: Building and maintenance tools for Fedora Haskell Description: Maintainer tools for building and managing Fedora Haskell packages. @@ -15,7 +15,8 @@ Extra-source-files: README.md TODO ChangeLog Cabal-version: >=1.10 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 == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.8, + GHC == 9.4.7, GHC == 9.6.3 source-repository head type: git @@ -64,7 +65,7 @@ Main-is: fhmock.hs Build-depends: base < 5, fedora-dists >= 2.0, - simple-cmd >= 0.2.0, + simple-cmd >= 0.2.2, simple-cmd-args >= 0.1.2 if impl(ghc<8.0) Build-depends: semigroups diff --git a/fhbz.hs b/fhbz.hs --- a/fhbz.hs +++ b/fhbz.hs @@ -21,17 +21,15 @@ import Control.Monad (unless, when) import Data.Char (isLetter) import Data.List (dropWhileEnd, intercalate, isPrefixOf) -import Data.Maybe (fromMaybe, listToMaybe) import Data.Time.Clock (diffUTCTime, getCurrentTime) import System.Directory ({-doesFileExist, getCurrentDirectory,-} getModificationTime) -import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), OptDescr (..), - getOpt, usageInfo) -import System.Environment (getArgs, getEnv, getProgName) +import System.Environment (getEnv, getProgName) import System.FilePath (()) import Distribution.Fedora (Dist, getRawhideDist) import Koji (kojicmd) import SimpleCmd ((+-+), cmd, cmd_, cmdStdErr, removeStrictPrefix, removeSuffix) +import SimpleCmdArgs data BugState = BugState { bugNo :: String, @@ -41,40 +39,24 @@ whiteboard :: String } -data Flag = Check | Force | DryRun | NoComment | Refresh | State String - deriving (Eq, Show) - -isState :: Flag -> Bool -isState (State _) = True -isState _ = False - -options :: [OptDescr Flag] -options = - [ Option "f" ["force"] (NoArg Force) "update even if no version change (implies --refresh)" - , Option "n" ["dryrun"] (NoArg DryRun) "do not update bugzilla" - , Option "r" ["refresh"] (NoArg Refresh) "update if status changed" - , Option "s" ["state"] (ReqArg State "BUGSTATE") "bug state (default NEW)" - , Option "N" ["no-comment"] (NoArg NoComment) "update the whiteboard only" - , Option "c" ["check"] (NoArg Check) "check update for missing deps" - ] - -parseOpts :: [String] -> IO ([Flag], [String]) -parseOpts argv = - case getOpt Permute options argv of - (os,ps,[]) -> return (os,ps) - (_,_,errs) -> do - prog <- getProgName - error $ concat errs ++ usageInfo (header prog) options - where header prog = "Usage:" +-+ prog +-+ "[OPTION...] [PACKAGE...]" - main :: IO () -main = do - (opts, args) <- getArgs >>= parseOpts - when (null args) $ error "must give one or more packages" - let state = fromMaybe "NEW" $ listToMaybe $ map (\ (State s) -> s) $ filter isState opts - bugs <- parseLines . lines <$> bugzillaQuery (["--bug_status=" ++ state, "--short_desc=is available", "--outputformat=%{id}\n%{component}\n%{bug_status}\n%{summary}\n%{status_whiteboard}"] ++ ["--component=" ++ intercalate "," args]) +main = + simpleCmdArgs Nothing "Fedora Haskell Bugzilla tool" + "Updates Fedora Haskell release monitoring bugs" $ + run + <$> switchWith 'f' "force" "update even if no version change (implies --refresh)" + <*> switchWith 'n' "dryrun" "do not update bugzilla" + <*> switchWith 'r' "refresh" "update if status changed" + <*> strOptionalWith 's' "state" "STATE" "bug state (default NEW)" "NEW" + <*> switchWith 'N' "no-comment" "update the whiteboard only" + <*> switchWith 'c' "check" "check update for missing deps" + <*> some (strArg "[Package...]") + +run :: Bool -> Bool -> Bool -> String -> Bool -> Bool -> [String] -> IO () +run force dryrun refresh state nocomment check pkgs = do + bugs <- parseLines . lines <$> bugzillaQuery (["--bug_status=" ++ state, "--short_desc=is available", "--outputformat=%{id}\n%{component}\n%{bug_status}\n%{summary}\n%{status_whiteboard}"] ++ ["--component=" ++ intercalate "," pkgs]) rawhide <- getRawhideDist - mapM_ (checkBug rawhide opts) bugs + mapM_ (checkBug rawhide force dryrun refresh nocomment check) bugs bugzillaQuery :: [String] -> IO String bugzillaQuery args = cmd "bugzilla" ("query":args) @@ -90,8 +72,8 @@ BugState bid bcomp bst bsum bwh : parseLines rest parseLines _ = error "Bad bugzilla query output!" -checkBug :: Dist -> [Flag] -> BugState -> IO () -checkBug rawhide opts (BugState bid bcomp _bst bsum bwh) = +checkBug :: Dist -> Bool -> Bool -> Bool -> Bool -> Bool -> BugState -> IO () +checkBug rawhide force dryrun refresh nocomment check (BugState bid bcomp _bst bsum bwh) = unless (bcomp `elem` excludedPkgs) $ do let hkg = removeGhcPrefix bcomp (hkgver, state) = colon bwh @@ -102,24 +84,23 @@ -- should not happen! unless (hkg `isPrefixOf` hkgver') $ putStrLn $ "Component and Summary inconsistent!" +-+ hkg +-+ hkgver' +-+ "<" ++ "http://bugzilla.redhat.com/" ++ bid ++ ">" - if Check `notElem` opts then closeBug rawhide opts bid bcomp pkgver else do - let force = Force `elem` opts - refresh = Refresh `elem` opts + if not check + then closeBug rawhide dryrun bid bcomp pkgver + else when (hkgver /= hkgver' || force || refresh) $ do - cabalUpdate - (missing, err) <- cmdStdErr "cblrpm" ["missingdeps", hkgver'] - let state' = if null missing && null err then "ok" else "deps" - when ((hkgver, state) /= (hkgver', state') || force) $ do - let statemsg = if null state || state == state' then state' else state +-+ "->" +-+ state' - putStrLn $ if hkgver == hkgver' - then hkgver ++ ":" +-+ statemsg - else (if null bwh then "New" else hkgver +-+ "->") +-+ hkgver' ++ ":" +-+ statemsg - unless (null missing) $ - putStrLn missing - putStrLn "" - unless (DryRun `elem` opts) $ do - let nocomment = NoComment `elem` opts - updateBug bid bcomp hkgver' missing state' nocomment + cabalUpdate + (missing, err) <- cmdStdErr "cblrpm" ["missingdeps", hkgver'] + let state' = if null missing && null err then "ok" else "deps" + when ((hkgver, state) /= (hkgver', state') || force) $ do + let statemsg = if null state || state == state' then state' else state +-+ "->" +-+ state' + putStrLn $ if hkgver == hkgver' + then hkgver ++ ":" +-+ statemsg + else (if null bwh then "New" else hkgver +-+ "->") +-+ hkgver' ++ ":" +-+ statemsg + unless (null missing) $ + putStrLn missing + putStrLn "" + unless dryrun $ + updateBug bid bcomp hkgver' missing state' nocomment excludedPkgs :: [String] excludedPkgs = ["ghc", "emacs-haskell-mode"] @@ -140,15 +121,15 @@ where (nv, s) = break (== ':') ps -closeBug :: Dist -> [Flag] -> String -> String -> String -> IO () -closeBug rawhide opts bid bcomp pkgver = do +closeBug :: Dist -> Bool -> String -> String -> String -> IO () +closeBug rawhide dryrun bid bcomp pkgver = do latest <- cmd (kojicmd rawhide) ["latest-pkg", "rawhide", bcomp, "--quiet"] unless (null latest) $ do let nvr = (head . words) latest let nv = removeRelease nvr when (nv == pkgver) $ do putStrLn $ "closing" +-+ bid ++ ":" +-+ nv +-+ "in rawhide" - unless (DryRun `elem` opts) $ + unless dryrun $ bugzillaModify ["--close=RAWHIDE", "--fixed_in=" ++ nvr, "--comment=Closed with fhbz from fedora-haskell-tools", bid] where removeRelease = init . dropWhileEnd (/= '-') diff --git a/fhpkg.hs b/fhpkg.hs --- a/fhpkg.hs +++ b/fhpkg.hs @@ -51,8 +51,11 @@ getLatestFedoraDist, getRawhideDist) --import Distribution.Fedora.Branch (Branch(..)) -import SimpleCmd ((+-+), cmd, cmd_, cmdLines, cmdMaybe, cmdQuiet, {-cmdSilent,-} - grep_, removePrefix, removeSuffix, shell_, warning) +import SimpleCmd +#if !MIN_VERSION_simple_cmd(0,2,3) +import System.Exit +import qualified System.Process as P +#endif import SimpleCmd.Git import SimpleCmdArgs @@ -61,7 +64,7 @@ import Koji (rpkg) import Paths_fedora_haskell_tools (version) import RPM (buildRequires, haskellSrcPkgs, Package, pkgDir, - repoquery, rpmspec) + repoquery, rpmspec, rqfnewline) import Utils (checkPkgsGit, withCurrentDirectory) #if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5)) @@ -152,7 +155,7 @@ , Subcommand "unpushed" "show unpushed commits" $ unpushed branched <$> switchWith 's' "short" "no log" <*> distArg <*> pkgArgs , Subcommand "update" "cabal-rpm update" $ - update branched <$> streamOpt <*> distArg <*> pkgArgs + update branched <$> keepOpt <*> streamOpt <*> distArg <*> pkgArgs , Subcommand "verrel" "show nvr of packages" $ verrel branched <$> distArg <*> pkgArgs] ++ map (buildCmd cwd) [ ("install", "build locally and install") @@ -188,6 +191,8 @@ flagWith' StkgMissing 'm' "missing" "only list missing packages" <|> flagWith StkgAll StkgOnly 'o' "only" "only Stackage packages" + keepOpt = switchWith 'k' "keep-going" "Keep going after an error" + data DiffFormat = DiffShort | DiffContext Int deriving (Eq) @@ -240,6 +245,7 @@ gitDiffOrigin branched dist = repoAction branched False (Output (const (git "diff" [distRemote branched dist]))) dist +-- FIXME option only to show PVP X.Y bumps or X.Y.Z bumps stackageCompare :: Dist -> String -> StkgOpt -> Dist -> [Package] -> IO () stackageCompare branched stream opt dist = repoAction branched True (Header False compareStackage) dist @@ -247,7 +253,15 @@ compareStackage :: Package -> IO () compareStackage p = do nvr <- cmd (rpkg dist) ["verrel"] - stkg <- cmdMaybe "stackage" ["package", stream, removePrefix "ghc-" p] + let hkg = removePrefix "ghc-" p + (ok,_out,err) <- cmdFull "stack" ["--resolver" , stream, "list", hkg] "" + -- FIXME rename to mstkgver? + let stkg = + if ok then + case filter (not . ("Selected resolver:" `isPrefixOf`)) (lines err) of + [nv] -> Just (removePrefix (hkg ++ "-") nv) + _ -> Nothing + else Nothing let same = isJust stkg && (fromJust stkg ++ "-") `isInfixOf` nvr unless same $ if opt == StkgMissing @@ -280,7 +294,8 @@ repoqueryHackageCSV dist = do pkgs <- repoqueryHackages branched hackageRelease -- Hackage csv chokes on a final newline - intercalate "\n" . sort . map (replace "\"ghc-" "\"") . lines <$> repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{source_name}\""] ++ ["--refresh" | refreshData] ++ pkgs) + intercalate "\n" . sort . map (replace "\"ghc-" "\"") . lines <$> + repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{source_name}\"" ++ rqfnewline] ++ ["--refresh" | refreshData] ++ pkgs) hackageCompare :: Dist -> Bool -> IO () hackageCompare branched refreshData = @@ -293,7 +308,7 @@ parseRequestThrow "https://hackage.haskell.org/distro/Fedora/packages.csv" hck <- getResponseBody <$> httpLbs req let hackage = sort . either (error "Malformed Hackage csv") (map mungeHackage) $ parseCSV "packages.csv" (BL.unpack hck) - repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=%{name},%{version}"] ++ ["--refresh" | refreshData] ++ pkgs') >>= + repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=%{name},%{version}" ++ rqfnewline] ++ ["--refresh" | refreshData] ++ pkgs') >>= compareSets True hackage . sort . map mungeRepo . lines mungeHackage :: [String] -> PkgVer @@ -458,7 +473,7 @@ when tty $ warning "Getting packages from repoquery" let repo = distRepo branched dist updates = maybeToList $ distUpdates branched dist - bin <- words <$> repoquery dist (["--repo=" ++ repo ++ "-source"] ++ ["--repo=" ++ u ++ "-source" | u <- updates] ++ ["--qf=%{name}", "--whatrequires", "ghc-Cabal-*"]) + bin <- words <$> repoquery dist (["--repo=" ++ repo ++ "-source"] ++ ["--repo=" ++ u ++ "-source" | u <- updates] ++ ["--qf=%{name}" ++ rqfnewline, "--whatrequires", "ghc-Cabal-*"]) when (null bin) $ error "No packages using ghc-Cabal-devel found!" return $ sort $ filter (not . isGhcXY) $ nub bin where @@ -479,7 +494,7 @@ when verbose $ putStrLn "Getting libraries from repoquery" let repo = distRepo branched dist updates = maybeToList $ distUpdates branched dist - bin <- words <$> repoquery dist (["--repo=" ++ repo] ++ ["--repo=" ++ u | u <- updates] ++ ["--qf=%{name}", "--whatprovides", "libHS*-ghc*.so()(64bit)"]) + bin <- words <$> repoquery dist (["--repo=" ++ repo] ++ ["--repo=" ++ u | u <- updates] ++ ["--qf=%{name}" ++ rqfnewline, "--whatprovides", "libHS*-ghc*.so()(64bit)"]) when (null bin) $ error "No libHS*.so providers found!" return $ sort $ filter ("ghc-" `isPrefixOf`) $ nub bin @@ -595,15 +610,18 @@ isFromHackage pkg = grep_ "hackage.haskell.org/package/" $ pkg <.> "spec" -update :: Dist -> String -> Dist -> [Package] -> IO () -update branched stream = +update :: Dist -> Bool -> String -> Dist -> [Package] -> IO () +update branched keep stream = repoAction branched True (Header True doUpdate) where doUpdate :: Package -> IO () doUpdate pkg = do hckg <- isFromHackage pkg if hckg - then cmd_ "cabal-rpm" ["update", "-s", stream] + then do + ok <- cmdBool "cabal-rpm" ["update", "-s", stream] + unless (ok || keep) $ + error' $ "cabal-rpm update failed for: " ++ pkg else putStrLn "skipping since not hackage" refresh :: Dist -> Bool -> Dist -> [Package] -> IO () @@ -702,4 +720,18 @@ gitBool c args = do mout <- cmdMaybe "git" (c:args) return $ isJust mout +#endif + +#if !MIN_VERSION_simple_cmd(0,2,3) +cmdFull :: String -> [String] -> String -> IO (Bool, String, String) +cmdFull c args input = do + (ret, out, err) <- P.readProcessWithExitCode c args input + return (ret == ExitSuccess, removeTrailingNewline out, removeTrailingNewline err) + where + removeTrailingNewline :: String -> String + removeTrailingNewline "" = "" + removeTrailingNewline str' = + if last str' == '\n' + then init str' + else str' #endif diff --git a/src/Build.hs b/src/Build.hs --- a/src/Build.hs +++ b/src/Build.hs @@ -41,7 +41,7 @@ packageManager, pkgDir, rpmInstall, rpmspec) import SimpleCmd ((+-+), cmd, cmd_, cmdBool, cmdLines, cmdLog, cmdMaybe, cmdSilent, grep_, removeStrictPrefix, sudo_) -import SimpleCmd.Git (git_, gitBranch, isGitDir) +import SimpleCmd.Git (git_, gitBool, gitBranch, isGitDir) import Utils (checkPkgsGit) data Command = Install | Mock | Koji | Chain | Pending | Changed | Built | Bump @@ -67,7 +67,7 @@ setCurrentDirectory topdir branched <- getLatestFedoraDist let branch = distBranch branched dist - when (mode `notElem` [Pending, Changed, Built, NotInstalled]) $ + unless (mode `elem` [Pending, Changed, Built, NotInstalled]) $ putStrLn $ "\n==" +-+ pkg ++ ":" ++ branch +-+ "==" dirExists <- doesDirectoryExist pkg unless dirExists $ do @@ -98,7 +98,8 @@ else build topdir Nothing False mode dist rest else do when dirExists $ do - git_ "pull" ["-q", "--rebase"] + pulled <- gitBool "pull" ["-q", "--rebase"] + unless pulled $ error $ "git pull failed for " ++ pkg actual <- gitBranch when (branch /= actual) $ cmd_ (rpkg dist) ["switch-branch", branch] diff --git a/src/Dist.hs b/src/Dist.hs --- a/src/Dist.hs +++ b/src/Dist.hs @@ -38,8 +38,8 @@ -- | Fedora release being tracked in Hackage Distro data hackageRelease :: Dist -hackageRelease = Fedora 35 +hackageRelease = Fedora 39 -- | Stackage LTS stream major version ltsStream :: String -ltsStream = "lts-16" +ltsStream = "lts-21" diff --git a/src/RPM.hs b/src/RPM.hs --- a/src/RPM.hs +++ b/src/RPM.hs @@ -20,6 +20,7 @@ packageManager, pkgDir, repoquery, + rqfnewline, rpmInstall, rpmspec) where @@ -65,6 +66,11 @@ let (inst, arg) = if pkginstaller == "dnf" then ("dnf", "install") else ("yum", "localinstall") sudo_ inst $ ["-y", "--nogpgcheck", arg] ++ rpms +-- should be \n for dnf5 repoquery workaround +-- FIXME integrate into repoquery or add to SimpleCmd.Rpm? +rqfnewline :: String +rqfnewline = "" + repoquery :: Dist -> [String] -> IO String repoquery dist args = do havednf <- optionalProgram "dnf" @@ -152,7 +158,7 @@ branched <- getLatestFedoraDist let branch = distBranch branched dist ghcDir <- pkgDir "ghc" branch (takeDirectory topdir) - map removeLibSuffix . filter isHaskellDevelPkg <$> rpmspec [] (Just "%{name}") (ghcDir "ghc.spec") + map removeLibSuffix . filter isHaskellDevelPkg <$> rpmspec [] (Just "%{name}\n") (ghcDir "ghc.spec") let hdeps = filter (\ dp -> "ghc-" `isPrefixOf` dp || dp `elem` haskellTools) (map removeLibSuffix brs \\ (["ghc-rpm-macros", "ghc-rpm-macros-extra"] ++ ghcLibs)) nub <$> mapM (derefSrcPkgRelax topdir dist) hdeps