fedora-haskell-tools 1.0 → 1.1
raw patch · 8 files changed
+115/−82 lines, 8 filesdep ~simple-cmd
Dependency ranges changed: simple-cmd
Files
- ChangeLog +7/−0
- README.md +8/−3
- fedora-haskell-tools.cabal +4/−3
- fhbz.hs +39/−58
- fhpkg.hs +44/−12
- src/Build.hs +4/−3
- src/Dist.hs +2/−2
- src/RPM.hs +7/−1
ChangeLog view
@@ -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
README.md view
@@ -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.++<https://github.com/fedora-haskell/fedora-haskell-tools>
fedora-haskell-tools.cabal view
@@ -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
fhbz.hs view
@@ -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 (/= '-')
fhpkg.hs view
@@ -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
src/Build.hs view
@@ -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]
src/Dist.hs view
@@ -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"
src/RPM.hs view
@@ -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