fedora-haskell-tools 1.1 → 1.2
raw patch · 11 files changed
+192/−988 lines, 11 filesdep +fedora-releasesdep +simple-promptdep −fedora-distsdep −semigroupsdep ~simple-cmddep ~simple-cmd-args
Dependencies added: fedora-releases, simple-prompt
Dependencies removed: fedora-dists, semigroups
Dependency ranges changed: simple-cmd, simple-cmd-args
Files
- ChangeLog +6/−0
- README.md +3/−8
- TODO +0/−2
- fedora-haskell-tools.cabal +11/−22
- fhbz.hs +9/−10
- fhmock.hs +0/−101
- fhpkg.hs +139/−269
- src/Build.hs +0/−318
- src/Dist.hs +0/−45
- src/Koji.hs +0/−180
- src/RPM.hs +24/−33
ChangeLog view
@@ -1,3 +1,9 @@+# 1.2 (2026-02-17)+- converted to fedora-releases+- fhpkg: drop most commands available in fbrnch+- fhpkg clone-new: filter out ghcX.Y+- drop fhmock+ # 1.1 (2023-11-19) - Dist: F39 and lts-21 - fhpkg update: add -k (--keep-going)
README.md view
@@ -19,17 +19,12 @@ Chain builds packages with wait-repo. Also checks that updated dependencies have been built first. -See TODO for possible future ideas.--Note that many of the generic commands provided are now available and-better maintained in the [fbrnch](https://github.com/juhp/fbrnch) tool,-which is packaged in Fedora and should be preferred.+Note some of the remaining generic commands provided are available in+the [fbrnch](https://github.com/juhp/fbrnch) tool,+which is packaged in Fedora and better maintained. ## 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.
TODO view
@@ -12,8 +12,6 @@ - "stackage" tool is broken (stackage-compare) - drop HTTP lib -- fix fhmock shell dist- - better unbranched command: pkg branches - warn about unpushed commit(s) without any bump - filter out ghc-prof & ghc-doc deps, ghc-rpm-macros removal?, ghc-srpm-macros
fedora-haskell-tools.cabal view
@@ -1,5 +1,5 @@ Name: fedora-haskell-tools-Version: 1.1+Version: 1.2 Synopsis: Building and maintenance tools for Fedora Haskell Description: Maintainer tools for building and managing Fedora Haskell packages.@@ -9,14 +9,14 @@ License-file: COPYING Author: Jens Petersen <petersen@fedoraproject.org> Maintainer: Jens Petersen <petersen@fedoraproject.org>-Copyright: 2014-2022 Jens Petersen <petersen@fedoraproject.org>+Copyright: 2014-2026 Jens Petersen <petersen@fedoraproject.org> Category: Distribution Build-type: Simple 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 == 9.2.8,- GHC == 9.4.7, GHC == 9.6.3+Tested-with: 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.8, GHC == 9.4.8,+ GHC == 9.6.7, GHC == 9.8.4, GHC == 9.10.3, GHC == 9.12.3 source-repository head type: git@@ -29,7 +29,7 @@ csv, directory, extra,- fedora-dists >= 2.0,+ fedora-releases, filepath, http-conduit >= 2.3.2, http-types,@@ -37,11 +37,13 @@ process, simple-cmd >= 0.2.0, simple-cmd-args >= 0.1.6,+ simple-prompt, split, time, unix Hs-Source-Dirs: src, .- Other-modules: Build, Dist, Koji, Paths_fedora_haskell_tools, Utils+ Other-modules: Paths_fedora_haskell_tools+ Utils RPM GHC-options: -fwarn-missing-signatures -Wall Default-Language: Haskell98@@ -50,26 +52,13 @@ Main-is: fhbz.hs Build-depends: base < 5, directory,- fedora-dists >= 2.0,+ fedora-releases, filepath, process, simple-cmd, simple-cmd-args, time Hs-Source-Dirs: src, .- Other-modules: Dist, Koji, RPM, Utils- GHC-options: -fwarn-missing-signatures -Wall- Default-Language: Haskell98--Executable fhmock- Main-is: fhmock.hs- Build-depends: base < 5,- fedora-dists >= 2.0,- simple-cmd >= 0.2.2,- simple-cmd-args >= 0.1.2- if impl(ghc<8.0)- Build-depends: semigroups- Hs-Source-Dirs: src, .- Other-modules: Dist, Paths_fedora_haskell_tools+ Other-modules: RPM, Utils GHC-options: -fwarn-missing-signatures -Wall Default-Language: Haskell98
fhbz.hs view
@@ -26,8 +26,7 @@ import System.Environment (getEnv, getProgName) import System.FilePath ((</>)) -import Distribution.Fedora (Dist, getRawhideDist)-import Koji (kojicmd)+--import Distribution.Fedora.Branch (Branch) import SimpleCmd ((+-+), cmd, cmd_, cmdStdErr, removeStrictPrefix, removeSuffix) import SimpleCmdArgs @@ -55,8 +54,7 @@ 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 force dryrun refresh nocomment check) bugs+ mapM_ (checkBug force dryrun refresh nocomment check) bugs bugzillaQuery :: [String] -> IO String bugzillaQuery args = cmd "bugzilla" ("query":args)@@ -72,8 +70,9 @@ BugState bid bcomp bst bsum bwh : parseLines rest parseLines _ = error "Bad bugzilla query output!" -checkBug :: Dist -> Bool -> Bool -> Bool -> Bool -> Bool -> BugState -> IO ()-checkBug rawhide force dryrun refresh nocomment check (BugState bid bcomp _bst bsum bwh) =+-- FIXME closes even for older release package version?!+checkBug :: Bool -> Bool -> Bool -> Bool -> Bool -> BugState -> IO ()+checkBug force dryrun refresh nocomment check (BugState bid bcomp _bst bsum bwh) = unless (bcomp `elem` excludedPkgs) $ do let hkg = removeGhcPrefix bcomp (hkgver, state) = colon bwh@@ -85,7 +84,7 @@ unless (hkg `isPrefixOf` hkgver') $ putStrLn $ "Component and Summary inconsistent!" +-+ hkg +-+ hkgver' +-+ "<" ++ "http://bugzilla.redhat.com/" ++ bid ++ ">" if not check- then closeBug rawhide dryrun bid bcomp pkgver+ then closeBug dryrun bid bcomp pkgver else when (hkgver /= hkgver' || force || refresh) $ do cabalUpdate@@ -121,9 +120,9 @@ where (nv, s) = break (== ':') ps -closeBug :: Dist -> Bool -> String -> String -> String -> IO ()-closeBug rawhide dryrun bid bcomp pkgver = do- latest <- cmd (kojicmd rawhide) ["latest-pkg", "rawhide", bcomp, "--quiet"]+closeBug :: Bool -> String -> String -> String -> IO ()+closeBug dryrun bid bcomp pkgver = do+ latest <- cmd "koji" ["latest-pkg", "rawhide", bcomp, "--quiet"] unless (null latest) $ do let nvr = (head . words) latest let nv = removeRelease nvr
− fhmock.hs
@@ -1,101 +0,0 @@-{-# LANGUAGE CPP #-}---- |--- Module : Mock--- Copyright : (C) 2018-2019 Jens Petersen------ Maintainer : Jens Petersen <petersen@fedoraproject.org>------ Explanation: Updating of Upstream Release Monitoring bugs---- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.--#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,13,0))-#else-import Control.Applicative (many, pure, some)-#endif-import Data.List (sort)-import System.Environment (getArgs)--import Dist (distArg)-import Paths_fedora_haskell_tools (version)--import Distribution.Fedora (Dist, getLatestFedoraDist, mockConfig)-import SimpleCmd (cmd_)-import SimpleCmdArgs---- mock :: [String] -> IO String--- mock os = cmd "mock" os--main :: IO ()-main = do- args <- getArgs- simpleCmdArgs (Just version) "Fedora Haskell mock chroot tool"- "Mock chroot setup for doing Fedora Haskell building and checking.\nYou can also use any mock command without '--'." $ subcommands $- [ Subcommand "check" "Check all Haskell libs installable" $- check <$> distArg- , Subcommand "repoquery" "Repoquery" $- repoquery <$> distArg <*> many (strArg "PKG...")- , Subcommand "help" "mock help" $ pure $ mock_ ["--help"]- , Subcommand "mockcmds" "List mock commands" $- pure $ putStrLn $ unwords $ sort allMockCmds- ] ++- [ Subcommand c ("Run mock " ++ c ++ " command") (runMock <$> distArg <*> optCmdArg <*> some (strArg "OPT")) | length args >= 2, let c = head args, c `elem` allMockCmds]- ++ map mockCmd commonMockCmds- where- mockCmd :: (String, Bool, String, Bool, String) -> Subcommand- mockCmd (com,needarg,var,externopt,desc) =- Subcommand com desc $- runMock <$> distArg <*> optCmdArg <*> arbitrary needarg var externopt-- optCmdArg =- mkOpt <$> strArg "CMD"- where- mkOpt c =- case c of- ('-':'-':_) -> c- _ -> "--" ++ c-- arbitrary :: Bool -> String -> Bool -> Parser [String]- arbitrary needarg var externopt =- (["--" | externopt] ++) <$> (if needarg then some else many) (strArg (var ++ "..."))-- -- (cmd, needarg, VAR, externalopts, desc)- commonMockCmds = [ ("chroot", True, "CMD", True, "Exec command in chroot")- , ("clean", False, "OPT", False, "Clean chroot")- , ("init", False, "OPT", False, "Setup chroot")- , ("install", True, "PKG", False, "Install packages")- , ("rebuild", True, "SRPM", False, "Build package(s)")- , ("remove", True, "PKG", False, "Remove package")- , ("shell", False, "CMD", False, "Interactive shell command")- , ("update", False, "PKG", False, "Update chroot packages")- ]--allMockCmds :: [String]-allMockCmds = sort- ["rebuild", "buildsrpm", "debug-config", "shell", "chroot",- "clean", "scrub", "init", "installdeps", "install", "update",- "remove", "orphanskill", "copyin", "copyout",- "pm-cmd", "yum-cmd", "dnf-cmd", "snapshot", "remove-snapshot",- "rollback-to", "umount", "mount"]--check :: Dist -> IO ()-check dist = runMock dist "--dnf-cmd" ["install", "ghc*devel"]--repoquery :: Dist -> [String] -> IO ()-repoquery dist ps = runMock dist "--dnf-cmd" $ "repoquery" : ps---runMock :: Dist -> String -> [String] -> IO ()-runMock dist c cs = do- branched <- getLatestFedoraDist- let conf = mockConfig branched dist "x86_64"- root = conf ++ "-haskell"- let opts = ["-r", conf, "--config-opts=root=" ++ root]- mock_ $ opts ++ (c:cs)--mock_ :: [String] -> IO ()-mock_ = cmd_ "mock"
fhpkg.hs view
@@ -30,10 +30,12 @@ import Data.Char (isDigit) import Data.Maybe import Data.List- import Data.List.Split (splitOn)+import Distribution.Fedora.Branch (Branch(..), getLatestFedoraBranch,+ readBranch, showBranch) import Network.HTTP.Simple import Network.HTTP.Types+import SimplePrompt (promptEnter) import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, getHomeDirectory, #if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5))@@ -47,10 +49,6 @@ --import System.Posix.Env (getEnv) import Text.CSV (parseCSV) -import Distribution.Fedora (Dist(..), distBranch, distRepo, distUpdates,- getLatestFedoraDist, getRawhideDist)---import Distribution.Fedora.Branch (Branch(..))- import SimpleCmd #if !MIN_VERSION_simple_cmd(0,2,3) import System.Exit@@ -59,11 +57,8 @@ import SimpleCmd.Git import SimpleCmdArgs -import Build (build, readBuildCmd)-import Dist (distArg, distRemote, hackageRelease, ltsStream)-import Koji (rpkg) import Paths_fedora_haskell_tools (version)-import RPM (buildRequires, haskellSrcPkgs, Package, pkgDir,+import RPM (buildRequires, haskellSrcPkgs, Package, repoquery, rpmspec, rqfnewline) import Utils (checkPkgsGit, withCurrentDirectory) @@ -78,114 +73,72 @@ main :: IO () main = do hSetBuffering stdout NoBuffering- cwd <- getCurrentDirectory- branched <- getLatestFedoraDist simpleCmdArgs (Just version) "Fedora Haskell packages tool" "Fedora packages maintenance tool" $ subcommands . sort $- [ Subcommand "checkout" "fedpkg switch-branch" $- repoAction_ branched True False (return ()) <$> distArg <*> pkgArgs- , Subcommand "clone" "clone repos" $- clone branched <$> branching <*> distArg <*> pkgArgs- , Subcommand "clone-new" "clone new packages" $- cloneNew branched <$> branching <*> distArg+ [+ Subcommand "clone-new" "clone new packages" $+ cloneNew <$> branchArg , Subcommand "cblrpm" "Run cblrpm command" $- cblrpm branched <$> strOptionWith 'c' "cmd" "CMD" "command to execute" <*> distArg <*> pkgArgs- , Subcommand "cmd" "arbitrary command (with args)" $- execCmd branched <$> strOptionWith 'c' "cmd" "CMD" "command to execute" <*> distArg <*> pkgArgs+ cblrpm <$> strOptionWith 'c' "cmd" "CMD" "command to execute" <*> branchArg <*> pkgArgs , Subcommand "count" "count number of packages" $- (repoqueryHaskellPkgs branched False >=> (print . length)) <$> distArg+ (repoqueryHaskellPkgs False >=> (print . length)) <$> branchArg , Subcommand "depends" "cabal-depends" $- repoAction branched False (Output cabalDepends) <$> distArg <*> pkgArgs- , Subcommand "diff" "git diff" $- gitDiff branched <$> optional gitFormat- <*> optional (strOptionWith 'w' "with-branch" "BRANCH" "Branch to compare")- <*> distArg <*> pkgArgs- , Subcommand "diff-origin" "git diff origin" $- gitDiffOrigin branched <$> distArg <*> pkgArgs--- , Subcommand "diff-branch" "compare branch with master" $--- repoAction branched True (Header False compareRawhide) <$> distArg <*> pkgArgs- , Subcommand "diffstat" "Show diffstat output" $- repoAction branched False (Output (const diffStat)) <$> distArg <*> pkgArgs+ repoAction False (Output cabalDepends) <$> branchArg <*> pkgArgs , Subcommand "hackage-upload" "upload Hackage distro data" $- hackageUpload branched <$> switchRefresh+ hackageUpload <$> branchArg <*> switchRefresh , Subcommand "hackage-compare" "compare with Hackage distro data" $- hackageCompare branched <$> switchRefresh+ hackageCompare <$> branchArg <*> switchRefresh -- more or less the same as 'pushed' , Subcommand "head-origin" "packages with head in sync with origin" $- headOrigin branched <$> distArg <*> pkgArgs+ headOrigin <$> branchArg <*> pkgArgs , Subcommand "leaf" "list leaf packages (slow!)" $- leaves branched <$> switchWith 'v' "deps" "show also deps" <*> distArg <*> pkgArgs+ leaves <$> switchWith 'v' "deps" "show also deps" <*> branchArg <*> pkgArgs , Subcommand "list" "list packages that BR ghc-Cabal-devel" $- (repoqueryHaskellPkgs branched False >=> putStrList) <$> distArg- , Subcommand "merge" "git merge" $- merge branched <$> strOptionWith 'f' "from" "BRANCH" "specify branch to merge from" <*> distArg <*> pkgArgs+ (repoqueryHaskellPkgs False >=> putStrList) <$> branchArg , Subcommand "missing" "missing dependency source packages" $- missingDeps branched <$> distArg <*> pkgArgs+ missingDeps <$> branchArg <*> pkgArgs , Subcommand "new" "unbuilt packages" $- (newPackages branched >=> putStrList) <$> distArg+ (newPackages >=> putStrList) <$> branchArg , Subcommand "old-packages" "packages not in repoquery" $- oldPackages branched <$> distArg <*> pkgArgs- , Subcommand "prep" "fedpkg prep" $- prep branched <$> distArg <*> pkgArgs+ oldPackages <$> branchArg <*> pkgArgs , Subcommand "stackage-compare" "compare with stackage" $- stackageCompare branched <$> streamOpt <*> stackageOpts <*> distArg <*> pkgArgs- , Subcommand "commit" "fedpkg commit" $- commit branched <$> strOptionWith 'm' "message" "COMMITMSG" "commit message" <*> distArg <*> pkgArgs- , Subcommand "fetch" "git fetch repos" $- repoAction_ branched True False (git_ "fetch" []) <$> distArg <*> pkgArgs- , Subcommand "pull" "git pull repos" $- repoAction_ branched True False (git_ "pull" ["--rebase"]) <$> distArg <*> pkgArgs- , Subcommand "push" "git push repos" $- repoAction_ branched True False (git_ "push" []) <$> distArg <*> pkgArgs+ stackageCompare <$> streamOpt Nothing <*> stackageOpts <*> branchArg <*> pkgArgs , Subcommand "pushed" "show git pushed packages" $- pushed branched <$> distArg <*> pkgArgs+ pushed <$> branchArg <*> pkgArgs , Subcommand "refresh" "cabal-rpm refresh" $- refresh branched <$> switchWith 'n' "dry-run" "Show patch but don't apply" <*> distArg <*> pkgArgs+ refresh <$> switchWith 'n' "dry-run" "Show patch but don't apply" <*> branchArg <*> pkgArgs , Subcommand "remaining" "remaining packages to be built in TAG" $ remaining <$> switchWith 'c' "count" "show many packages left" <*> strArg "TAG" <*> pkgArgs , Subcommand "subpkgs" "list subpackages" $- repoAction branched True (Header True (\ p -> rpmspec [] (Just "%{name}-%{version}") (p <.> "spec") >>= putStrList)) <$> distArg <*> pkgArgs+ repoAction True (Header True (\ p -> rpmspec [] (Just "%{name}-%{version}") (p <.> "spec") >>= putStrList)) <$> branchArg <*> pkgArgs , Subcommand "subpackaged" "list subpackaged libraries" $- subpackaged branched <$> switchWith 'V' "show-versions" "Show versions" <*> distArg <*> pkgArgs+ subpackaged <$> switchWith 'V' "show-versions" "Show versions" <*> branchArg <*> pkgArgs , Subcommand "tagged" "list koji DIST tagged builds" $ listTagged_ <$> switchWith 's' "short" "list packages not builds" <*> strArg "TAG" , Subcommand "unbranched" "packages without this branch" $- unbranched branched <$> distArg <*> pkgArgs+ unbranched <$> branchArg <*> pkgArgs , Subcommand "unpushed" "show unpushed commits" $- unpushed branched <$> switchWith 's' "short" "no log" <*> distArg <*> pkgArgs+ unpushed <$> switchWith 's' "short" "no log" <*> branchArg <*> pkgArgs , Subcommand "update" "cabal-rpm update" $- update branched <$> keepOpt <*> streamOpt <*> distArg <*> pkgArgs- , Subcommand "verrel" "show nvr of packages" $- verrel branched <$> distArg <*> pkgArgs] ++- map (buildCmd cwd) [ ("install", "build locally and install")- , ("mock", "build in mock")- , ("chain", "build deps recursively in Koji")- , ("koji", "build in Koji (deprecated) without checking dependencies")- , ("pending", "show planned changes")- , ("changed", "show changed pkgs")- , ("built", "show pkgs whose NVR already built")- , ("bump", "bump release for NVRs already built")- , ("not-installed", "list packages not locally installed")- ]+ update <$> keepOpt <*> streamOpt (Just "old") <*> branchArg <*> pkgArgs+ ] where- pkgArgs = some (removeSuffix "/" <$> strArg "PKG...")-- branching = switchWith 'B' "branches" "clone branch dirs (fedpkg clone -B)"+ branchArg :: Parser Branch+ branchArg = argumentWith branchM "BRANCH" - gitFormat :: Parser DiffFormat- gitFormat =- flagWith' DiffShort 's' "short" "Just output package name" <|>- DiffContext <$> optionWith auto 'u' "unified" "CONTEXT" "Lines of context"+ branchM :: ReadM Branch+ branchM = maybeReader readBranch - buildCmd cwd (c, desc) =- Subcommand c desc $- build cwd Nothing False (readBuildCmd c) <$> distArg <*> pkgArgs+ pkgArgs = some (removeSuffix "/" <$> strArg "PKG...") switchRefresh = switchWith 'r' "refresh" "repoquery --refresh" - streamOpt = strOptionalWith 's' "stream" "STACKAGESTREAM" ("Stackage stream [" ++ ltsStream ++ "]") ltsStream+ streamOpt mdesc = strOptionalWith 's' "stream" "STACKAGESTREAM" (fromMaybe "" mdesc +-+ "Stackage stream [" ++ ltsStream ++ "]") ltsStream + ltsStream :: String+ ltsStream = "lts-24"+ stackageOpts :: Parser StkgOpt stackageOpts = flagWith' StkgMissing 'm' "missing" "only list missing packages" <|>@@ -193,10 +146,6 @@ keepOpt = switchWith 'k' "keep-going" "Keep going after an error" -data DiffFormat =- DiffShort | DiffContext Int- deriving (Eq)- data StkgOpt = StkgAll | StkgOnly | StkgMissing deriving Eq @@ -204,55 +153,18 @@ putStrList = putStr . unlines --- should make separate rhel client so -B does not need dist-clone :: Dist -> Bool -> Dist -> [Package] -> IO ()-clone _ True dist pkgs = cloneAllBranches dist pkgs-clone branched False dist pkgs =- repoAction_ branched True False (return ()) dist pkgs--cloneNew :: Dist -> Bool -> Dist -> IO ()-cloneNew branched True dist = do- rawhide <- getRawhideDist- newPackages branched rawhide >>= cloneAllBranches dist-cloneNew branched False dist =- newPackages branched dist >>= repoAction_ branched True False (return ()) dist--execCmd :: Dist -> String -> Dist -> [Package] -> IO ()-execCmd _ "" _ _ = error "CMD string must be given"-execCmd branched cs dist pkgs =- repoAction_ branched True True (shell_ cs) dist pkgs--gitDiff :: Dist -> Maybe DiffFormat -> Maybe String -> Dist -> [Package] -> IO ()-gitDiff branched (Just DiffShort) mbrnch =- repoAction branched False (Header False doGitDiff)- where- doGitDiff pkg = do- let branch = maybeToList mbrnch- out <- git "diff" branch- unless (null out) $ putStrLn pkg-gitDiff branched fmt mbrnch =- repoAction branched False (Output (const doGitDiff))- where- doGitDiff = do- let branch = maybeToList mbrnch- contxt = case fmt of- (Just (DiffContext n)) -> ["--unified=" ++ show n]- _ -> []- out <- git "diff" $ branch ++ contxt- return $ if null out then "" else out--gitDiffOrigin :: Dist -> Dist -> [Package] -> IO ()-gitDiffOrigin branched dist =- repoAction branched False (Output (const (git "diff" [distRemote branched dist]))) dist+cloneNew :: Branch -> IO ()+cloneNew branch =+ newPackages branch >>= repoAction_ True False (return ()) branch -- 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+stackageCompare :: String -> StkgOpt -> Branch -> [Package] -> IO ()+stackageCompare stream opt =+ repoAction True (Header False compareStackage) where compareStackage :: Package -> IO () compareStackage p = do- nvr <- cmd (rpkg dist) ["verrel"]+ nvr <- cmd "fedpkg" ["verrel"] let hkg = removePrefix "ghc-" p (ok,_out,err) <- cmdFull "stack" ["--resolver" , stream, "list", hkg] "" -- FIXME rename to mstkgver?@@ -274,12 +186,12 @@ putStrLn nvr putStrLn $ replicate (length (dropVerrel nvr) + 1) ' ' ++ fromJust stkg +-+ "(" ++ stream ++ ")" -diffStat :: IO String-diffStat = git "diff" ["--stat"]--hackageUpload :: Dist -> Bool -> IO ()-hackageUpload branched refreshData = do- csv <- repoqueryHackageCSV hackageRelease+hackageUpload :: Branch -> Bool -> IO ()+hackageUpload hackageBranch refreshData = do+ branched <- getLatestFedoraBranch+ unless (branched == hackageBranch) $+ promptEnter "Not latest branch! Please Enter to continue anyway"+ csv <- repoqueryHackageCSV home <- getHomeDirectory [username, password] <- map B.pack . words <$> readFile (home </> ".fedora/hackage.auth") req <- setRequestBasicAuth username password .@@ -290,19 +202,19 @@ resp <- httpLbs req BL.putStrLn $ getResponseBody resp where- repoqueryHackageCSV :: Dist -> IO String- repoqueryHackageCSV dist = do- pkgs <- repoqueryHackages branched hackageRelease+ repoqueryHackageCSV :: IO String+ repoqueryHackageCSV = do+ pkgs <- repoqueryHackages hackageBranch -- 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}\"" ++ rqfnewline] ++ ["--refresh" | refreshData] ++ pkgs)+ repoquery hackageBranch (["--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 =- repoqueryHackages branched hackageRelease >>=- compareHackage hackageRelease+hackageCompare :: Branch -> Bool -> IO ()+hackageCompare hackageBranch refreshData =+ repoqueryHackages hackageBranch >>=+ compareHackage hackageBranch where- compareHackage :: Dist -> [Package] -> IO ()+ compareHackage :: Branch -> [Package] -> IO () compareHackage dist pkgs' = do req <- addRequestHeader hContentType (B.pack "text/csv") <$> parseRequestThrow "https://hackage.haskell.org/distro/Fedora/packages.csv"@@ -340,20 +252,20 @@ putStrLn $ pvPkg h ++ ":" +-+ pvVer h +-+ "->" +-+ pvVer f compareSets all' hs fs -headOrigin :: Dist -> Dist -> [Package] -> IO ()-headOrigin branched dist =- repoAction branched False (Header False gitHeadAtOrigin) dist+headOrigin :: Branch -> [Package] -> IO ()+headOrigin branch =+ repoAction False (Header False gitHeadAtOrigin) branch where gitHeadAtOrigin :: Package -> IO () gitHeadAtOrigin pkg = do -- use gitDiffQuiet- same <- gitBool "diff" ["--quiet", distRemote branched dist ++ "..HEAD"]+ same <- gitBool "diff" ["--quiet", "origin" </> showBranch branch ++ "..HEAD"] when same $ putStrLn pkg -- FIXME does not take static requires into account-leaves :: Dist -> Bool -> Dist -> [Package] -> IO ()-leaves branched verb =- repoAction branched True (Header verb checkLeafPkg)+leaves :: Bool -> Branch -> [Package] -> IO ()+leaves verb =+ repoAction True (Header verb checkLeafPkg) where -- FIXME: make a dependency cache checkLeafPkg :: Package -> IO ()@@ -379,13 +291,9 @@ return $ any (`elem` deps) subpkgs else return False -merge :: Dist -> String -> Dist -> [Package] -> IO ()-merge branched branch =- repoAction_ branched True False (git_ "merge" [branch])--missingDeps :: Dist -> Dist -> [Package] -> IO ()-missingDeps branched dist =- repoAction branched True (Output checkForMissingDeps) dist+missingDeps :: Branch -> [Package] -> IO ()+missingDeps dist =+ repoAction True (Output checkForMissingDeps) dist where checkForMissingDeps :: Package -> IO String checkForMissingDeps pkg = do@@ -403,51 +311,32 @@ noPkgDir top dep = not <$> doesDirectoryExist (top </> dep) -oldPackages :: Dist -> Dist -> [Package] -> IO ()-oldPackages branched dist pkgs = do- repopkgs <- repoqueryHaskellPkgs branched True dist+oldPackages :: Branch -> [Package] -> IO ()+oldPackages branch pkgs = do+ repopkgs <- repoqueryHaskellPkgs True branch putStrList (pkgs \\ repopkgs) -prep :: Dist -> Dist -> [Package] -> IO ()-prep branched dist =- repoAction_ branched True True (cmd_ (rpkg dist) ["prep"]) dist--commit :: Dist -> String -> Dist -> [Package] -> IO ()-commit branched logmsg dist =- repoAction branched False (Output (const commitChanges)) dist- where- commitChanges :: IO String- commitChanges = do- nochgs <- gitDiffQuiet []- if nochgs- then return ""- else cmd (rpkg dist) ["commit", "-m", logmsg]--unpushed :: Dist -> Bool -> Dist -> [Package] -> IO ()-unpushed branched nolog dist =- repoAction branched True (Header False gitLogOneLine) dist+unpushed :: Bool -> Branch -> [Package] -> IO ()+unpushed nolog branch =+ repoAction True (Header False gitLogOneLine) branch where gitLogOneLine :: Package -> IO () gitLogOneLine pkg = do- out <- git "log" [distRemote branched dist ++ "..HEAD", "--pretty=oneline"]+ out <- git "log" ["origin" </> showBranch branch ++ "..HEAD", "--pretty=oneline"] unless (null out) $ putStrLn $ pkg ++ if nolog then "" else (unwords . map replaceHash . words) out where replaceHash h = if length h /= 40 then h else ":" -pushed :: Dist -> Dist -> [Package] -> IO ()-pushed branched dist =- repoAction branched True (Header False checkPushed) dist+pushed :: Branch -> [Package] -> IO ()+pushed branch =+ repoAction True (Header False checkPushed) branch where checkPushed :: Package -> IO () checkPushed pkg = do- out <- git "log" [distRemote branched dist ++ "..HEAD", "--pretty=oneline"]+ out <- git "log" ["origin" </> showBranch branch ++ "..HEAD", "--pretty=oneline"] when (null out) $ putStrLn pkg -verrel :: Dist -> Dist -> [Package] -> IO ()-verrel branched dist =- repoAction_ branched False True (cmd_ (rpkg dist) ["verrel"]) dist- data PkgVer = PV { pvPkg :: String, pvVer :: String} deriving (Eq) @@ -466,24 +355,24 @@ else x:replace a b xs replace _ _ [] = [] -repoqueryHaskellPkgs :: Dist -> Bool -> Dist -> IO [Package]-repoqueryHaskellPkgs branched verbose dist = do+repoqueryHaskellPkgs :: Bool -> Branch -> IO [Package]+repoqueryHaskellPkgs verbose branch = do when verbose $ do tty <- hIsTerminalDevice stdout 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}" ++ rqfnewline, "--whatrequires", "ghc-Cabal-*"])+ let repo = "fedora"+ updates = ["updates"] -- maybeToList $ distUpdates dist+ bin <- words <$> repoquery branch (["--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- isGhcXY :: String -> Bool- isGhcXY p = let prefix = head (splitOn "-" p)- in all (\c -> isDigit c || c == '.') (removePrefix "ghc" prefix) -repoqueryHackages :: Dist -> Dist -> IO [Package]-repoqueryHackages branched dist = do- srcs <- repoqueryHaskellPkgs branched False dist+isGhcXY :: String -> Bool+isGhcXY p = let prefix = head (splitOn "-" p)+ in all (\c -> isDigit c || c == '.') (removePrefix "ghc" prefix)++repoqueryHackages :: Branch -> IO [Package]+repoqueryHackages branch = do+ srcs <- repoqueryHaskellPkgs False branch libs <- repoqueryHaskellLibs False let binsrcs = filter (not . ("ghc-" `isPrefixOf`)) srcs sublibs = libs \\ map ("ghc-" ++) binsrcs@@ -492,38 +381,28 @@ repoqueryHaskellLibs :: Bool -> IO [Package] repoqueryHaskellLibs verbose = do 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}" ++ rqfnewline, "--whatprovides", "libHS*-ghc*.so()(64bit)"])+ let repo = "fedora" -- distRepo branched dist+ updates = ["updates"]+ bin <- words <$> repoquery branch (["--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 -newPackages :: Dist -> Dist -> IO [Package]-newPackages branched dist = do- ps <- repoqueryHaskellPkgs branched True dist- pps <- cmdLines "pagure" ["list", "--namespace", "rpms", "ghc*"]+pagureListGhcHaskell :: IO [String]+pagureListGhcHaskell = do+ ps <- cmdLines "pagure" ["list", "--namespace", "rpms", "ghc*"]+ return $ filter (not . isGhcXY) ps++newPackages :: Branch -> IO [Package]+newPackages branch = do+ ps <- repoqueryHaskellPkgs True branch+ pps <- pagureListGhcHaskell local <- listDirectory "."- filterM (\ d -> not <$> doesFileExist (d </> "dead.package")) $ nub (pps ++ ps) \\ (local ++ ["Agda-stdlib", "ghc", "ghc-rpm-macros", "ghc-srpm-macros", "haskell-platform"])+ filterM (\ d -> not <$> doesFileExist (d </> "dead.package")) $ nub (pps ++ ps) \\ (local ++ ["Agda-stdlib", "ghc", "ghc-rpm-macros", "ghc-srpm-macros", "ghc-srpm-macros-epel", "haskell-platform"]) haveSshKey :: IO Bool haveSshKey = do home <- getHomeDirectory- doesFileExist $ home </> ".ssh/id_rsa"--cloneAllBranches :: Dist -> [Package] -> IO ()-cloneAllBranches _ [] = return ()-cloneAllBranches dist (pkg:rest) = do- withCurrentDirectory "." $ do- putStrLn $ "\n==" +-+ pkg +-+ "=="- -- muser <- getEnv "USER"- haveSSH <- haveSshKey- dirExists <- doesDirectoryExist pkg- unless dirExists $- cmd_ (rpkg dist) $ ["clone"] ++ ["-a" | not haveSSH] ++ ["-B", pkg]- singleDir <- isGitDir pkg- when singleDir $- error "branch checkout already exists!"- cloneAllBranches dist rest+ doesFileExist $ home </> ".ssh/id_ed25519" data Action = Output (Package -> IO String) | Header Bool (Package -> IO ()) @@ -531,13 +410,12 @@ showHeader (Header b _) = b showHeader (Output _) = False -repoAction :: Dist -> Bool -> Action -> Dist -> [Package] -> IO ()-repoAction _ _ _ _ [] = return ()-repoAction branched needsSpec action dist (pkg:rest) = do+repoAction :: Bool -> Action -> Branch -> [Package] -> IO ()+repoAction _ _ _ [] = return ()+repoAction needsSpec action branch (pkg:rest) = do withCurrentDirectory "." $ do- let branch = distBranch branched dist when (showHeader action) $- putStrLn $ "\n==" +-+ pkg +-+ branch +-+ "=="+ putStrLn $ "\n==" +-+ pkg +-+ showBranch branch +-+ "==" -- muser <- getEnv "USER" haveSSH <- haveSshKey fileExists <- doesFileExist pkg@@ -546,28 +424,21 @@ else do dirExists <- doesDirectoryExist pkg unless dirExists $- cmd_ (rpkg dist) $ ["clone"] ++ ["-a" | not haveSSH] ++ ["-b", branch, pkg]- singleDir <- isGitDir pkg- unless singleDir $ do- branchDir <- doesDirectoryExist $ pkg </> branch- unless branchDir $- withCurrentDirectory pkg $- cmd_ (rpkg dist) ["clone", "-b", branch, pkg, branch]- wd <- pkgDir pkg branch ""- setCurrentDirectory wd+ cmd_ "fedpkg" $ ["clone"] ++ ["-a" | not haveSSH] ++ ["-b", showBranch branch, pkg]+ setCurrentDirectory pkg pkggit <- do gd <- isGitDir "." if gd then checkPkgsGit else return False unless pkggit $- error $ "not a Fedora pkg git dir!:" +-+ wd+ error $ "not a Fedora pkg git dir!:" +-+ pkg actual <- gitBranch- when (branch /= actual) $- whenJustM (cmdMaybe (rpkg dist) ["switch-branch", branch]) $ \ out ->+ when (showBranch branch /= actual) $+ whenJustM (cmdMaybe "fedpkg" ["switch-branch", showBranch branch]) $ \ out -> when (showHeader action) $ putStrLn out currentBranch <- gitBranch- when (branch == currentBranch) $+ when (showBranch branch == currentBranch) $ unlessM (doesFileExist "dead.package") $ do let spec = pkg <.> "spec" hasSpec <- doesFileExist spec@@ -580,14 +451,14 @@ Output act -> do out <- act pkg unless (null out) $ do- putStrLn $ "\n==" +-+ pkg +-+ branch +-+ "=="+ putStrLn $ "\n==" +-+ pkg +-+ showBranch branch +-+ "==" putStrLn out- repoAction branched needsSpec action dist rest+ repoAction needsSpec action branch rest -- io independent of package-repoAction_ :: Dist -> Bool -> Bool -> IO () -> Dist -> [Package] -> IO ()-repoAction_ branched header needsSpec action =- repoAction branched needsSpec (Header header (const action))+repoAction_ :: Bool -> Bool -> IO () -> Branch -> [Package] -> IO ()+repoAction_ header needsSpec action =+ repoAction needsSpec (Header header (const action)) -- compareRawhide :: Package -> IO () -- compareRawhide p = do@@ -610,23 +481,23 @@ isFromHackage pkg = grep_ "hackage.haskell.org/package/" $ pkg <.> "spec" -update :: Dist -> Bool -> String -> Dist -> [Package] -> IO ()-update branched keep stream =- repoAction branched True (Header True doUpdate)+update :: Bool -> String -> Branch -> [Package] -> IO ()+update keep stream =+ repoAction True (Header True doUpdate) where doUpdate :: Package -> IO () doUpdate pkg = do hckg <- isFromHackage pkg if hckg then do- ok <- cmdBool "cabal-rpm" ["update", "-s", stream]+ ok <- cmdBool "cabal-rpm" ["update", "-o", stream] unless (ok || keep) $ error' $ "cabal-rpm update failed for: " ++ pkg else putStrLn "skipping since not hackage" -refresh :: Dist -> Bool -> Dist -> [Package] -> IO ()-refresh branched dryrun =- repoAction branched True (Header True refreshPkg)+refresh ::Bool -> Branch -> [Package] -> IO ()+refresh dryrun =+ repoAction True (Header True refreshPkg) where refreshPkg :: Package -> IO () refreshPkg pkg = do@@ -667,10 +538,10 @@ cmdQuiet "cabal-depends" ["--not-build", "--unique"] else return "" -cblrpm :: Dist -> String -> Dist -> [Package] -> IO ()-cblrpm _ "" = error "CMD string must be given"-cblrpm branched cs =- repoAction branched True (Header True doCblRpm)+cblrpm :: String -> Branch -> [Package] -> IO ()+cblrpm "" = error "CMD string must be given"+cblrpm cs =+ repoAction True (Header True doCblRpm) where doCblRpm :: Package -> IO () doCblRpm p = do@@ -678,8 +549,8 @@ when hckg $ cmd_ "cblrpm" [cs] -unbranched :: Dist -> Dist -> [Package] -> IO ()-unbranched branched dist =+unbranched :: Branch -> [Package] -> IO ()+unbranched branch = mapM_ checkBranch where checkBranch :: Package -> IO ()@@ -687,16 +558,15 @@ withCurrentDirectory pkg $ do dead <- doesFileExist "dead.package" unless dead $ do- let distbranch = distBranch branched dist- branch <- gitBool "show-ref" ["--verify", "--quiet", "refs/heads/" ++ distbranch]- unless branch $ do- remotebranch <- gitBool "ls-remote" ["--exit-code", "--refs", "origin", distbranch]+ havebranch <- gitBool "show-ref" ["--verify", "--quiet", "refs/heads/" ++ showBranch branch]+ unless havebranch $ do+ remotebranch <- gitBool "ls-remote" ["--exit-code", "--refs", "origin", showBranch branch] unless remotebranch $ putStrLn pkg -subpackaged :: Dist -> Bool -> Dist -> [Package] -> IO ()-subpackaged branched versions dist pkgs = do- repoAction branched True (Output listSubpkgs) dist pkgs+subpackaged ::Bool -> Branch -> [Package] -> IO ()+subpackaged versions branch pkgs = do+ repoAction True (Output listSubpkgs) branch pkgs where listSubpkgs pkg = do msubpkgs <- fmap (drop 2 . words) <$> cmdMaybe "grep" ["%global subpkgs", pkg <.> "spec"]
− src/Build.hs
@@ -1,318 +0,0 @@-{-# LANGUAGE CPP #-}---- |--- Module : Build--- Copyright : (C) 2014-2019 Jens Petersen------ Maintainer : Jens Petersen <petersen@fedoraproject.org>--- Stability : alpha------ Explanation: Main entry point for building RPM packages.---- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.--module Build- (build,- readBuildCmd- )-where--#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))-#else-import Control.Applicative ((<$>))-#endif-import Control.Monad (filterM, unless, void, when)-import Data.Maybe-import Data.List (intercalate, isPrefixOf, nub)--import System.Directory (doesDirectoryExist, doesFileExist,- setCurrentDirectory)-import System.Exit (ExitCode (..), exitWith)-import System.FilePath ((</>), dropExtension)--import Distribution.Fedora (Dist, distBranch, getLatestFedoraDist, rpmDistTag)-import Dist (distOverride, distRemote)-import Koji (kojiBuilding, kojiCheckFHBuilt, kojiLatestPkg, kojiListTags,- kojiWaitPkg, notInKoji, rpkg, rpkgBuild)-import RPM (buildRequires, derefSrcPkg, haskellSrcPkgs, Package,- packageManager, pkgDir, rpmInstall, rpmspec)-import SimpleCmd ((+-+), cmd, cmd_, cmdBool, cmdLines, cmdLog, cmdMaybe,- cmdSilent, grep_, removeStrictPrefix, sudo_)-import SimpleCmd.Git (git_, gitBool, gitBranch, isGitDir)-import Utils (checkPkgsGit)--data Command = Install | Mock | Koji | Chain | Pending | Changed | Built | Bump- | NotInstalled- deriving (Eq)--readBuildCmd :: String -> Command-readBuildCmd "install" = Install-readBuildCmd "mock" = Mock-readBuildCmd "koji" = Koji-readBuildCmd "chain" = Chain-readBuildCmd "pending" = Pending-readBuildCmd "changed" = Changed-readBuildCmd "built" = Built-readBuildCmd "bump" = Bump-readBuildCmd "not-installed" = NotInstalled-readBuildCmd _ = error "Unknown command"--build :: FilePath -> Maybe (String, String) -> Bool ->- Command -> Dist -> [String] -> IO ()-build _ _ _ _ _ [] = return ()-build topdir mlast waitrepo mode dist (pkg:rest) = do- setCurrentDirectory topdir- branched <- getLatestFedoraDist- let branch = distBranch branched dist- unless (mode `elem` [Pending, Changed, Built, NotInstalled]) $- putStrLn $ "\n==" +-+ pkg ++ ":" ++ branch +-+ "=="- dirExists <- doesDirectoryExist pkg- unless dirExists $ do- let anon = ["-a" | mode `notElem` [Koji, Chain]]- cmdSilent (rpkg dist) $ ["clone", "-b", branch, pkg] ++ anon- wd <- pkgDir pkg branch ""- setCurrentDirectory wd- ignore <- doesFileExist ".fhbuild-ignore"- if ignore && mode `elem` [Install, Koji, Chain, Mock] then putStrLn "ignored"- else do- failing <- doesFileExist ".fhbuild-fail"- when (failing && mode /= Pending) $ do- putStrLn "skipped: found '.fhbuild-fail' file"- exitWith (ExitFailure 1)- retired <- doesFileExist "dead.package"- if retired then do- unless (mode `elem` [NotInstalled,Pending]) $- putStrLn "skipping dead.package"- build topdir Nothing False mode dist rest- else do- pkggit <- do- gd <- isGitDir "."- if gd then checkPkgsGit- else return False- if not pkggit- then if mode `elem` [Install, Koji, Chain]- then error $ "not a Fedora pkg git dir!:" +-+ wd- else build topdir Nothing False mode dist rest- else do- when dirExists $ do- pulled <- gitBool "pull" ["-q", "--rebase"]- unless pulled $ error $ "git pull failed for " ++ pkg- actual <- gitBranch- when (branch /= actual) $- cmd_ (rpkg dist) ["switch-branch", branch]- -- noupdate <- doesFileExist ".noupdate"- -- unless noupdate $- -- void $ cmdBool "cabal-rpm" ["update"]- let spec = pkg ++ ".spec"- hasSpec <- doesFileExist spec- if not hasSpec- then error $ "No" +-+ spec- else do- nvr <- cmd (rpkg dist) ["verrel"]- let verrel = removeStrictPrefix (pkg ++ "-") nvr- case mode of- Install -> do- installed <- cmdMaybe "rpm" ["-q", "--qf", "%{name}-%{version}-%{release}", pkg]- if Just (pkg ++ "-" ++ verrel) == installed- then putStrLn $ nvr +-+ "already installed!\n"- else do- putStrLn $ fromMaybe "Not installed" installed +-+ "->" +-+ nvr- git_ "log" ["-1"]- putStrLn ""- missing <- nub <$> (buildRequires spec >>= filterM notInstalled)- -- FIXME sort into build order- let hmissing = filter (\ dp -> "ghc-" `isPrefixOf` dp || dp `elem` ["alex", "cabal-install", "gtk2hs-buildtools", "happy"]) missing- srcs <- nub <$> mapM (derefSrcPkg topdir dist True) hmissing- unless (null srcs) $ do- putStrLn "Missing:"- mapM_ putStrLn srcs- build topdir Nothing False Install dist srcs- setCurrentDirectory $ topdir </> wd- stillMissing <- filterM notInstalled missing- unless (null stillMissing) $ do- putStrLn $ "Installing:" +-+ intercalate ", " stillMissing- rpmInstall stillMissing- putStrLn ""- putStrLn $ "Building" +-+ nvr- -- note "fedpkg --path dir local" saves .build.log in cwd- success <- cmdBool (rpkg dist) ["local"]- if not success- then do- waitForEnter- build topdir Nothing False Install dist [pkg]- else do- opkgs <- rpmspec ["--builtrpms"] (Just "%{name}") spec- rpms <- rpmspec ["--builtrpms", "--define=dist" +-+ rpmDistTag dist] (Just "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm") spec- putStrLn $ nvr +-+ "built\n"- instpkgs <- cmdLines "rpm" ("-qa":opkgs)- if null instpkgs- -- maybe filter out pandoc-pdf and xmonad* if not installed- then rpmInstall rpms- else do- pkgmgr <- packageManager- sudo_ pkgmgr ("--setopt=clean_requirements_on_remove=no":"remove":"-y":instpkgs)- sudo_ pkgmgr ("install":"-y":rpms)- putStrLn ""- putStrLn $ show (length rest) +-+ "packages left"- build topdir Nothing False Install dist rest- Mock -> do- putStrLn $ "Mock building" +-+ nvr- cmdLog (rpkg dist) ["mockbuild"]- build topdir Nothing False Mock dist rest- Koji -> do- unless (null rest) $ do- putStrLn $ show (length rest) +-+ "more packages"- putStrLn ""- latest <- kojiLatestPkg dist pkg- if eqNVR nvr latest- then do- putStrLn $ fromJust latest +-+ "already built!"- kojiWaitPkg topdir dist nvr- build topdir mlast False Koji dist rest- else do- git_ "diff" []- building <- kojiBuilding pkg nvr dist- if building- then do- putStrLn $ nvr +-+ "is already building"- kojiWaitPkg topdir dist nvr- build topdir Nothing False Koji dist rest- else do- case mlast of- Nothing -> return ()- Just (pkg', nvr') -> do- dep <- dependent pkg' pkg branch topdir- when dep $- kojiWaitPkg topdir dist nvr'- showChange pkg latest nvr- putStrLn ""- git_ "push" []- -- note removed waitrepo:- rpkgBuild dist nvr- bodhiOverride branched dist nvr- unless (null rest) $ do- dep <- dependent pkg (head rest) branch topdir- when dep $- kojiWaitPkg topdir dist nvr- build topdir (if dep then Just (pkg, nvr) else Nothing) False Koji dist rest- Pending -> do- latest <- kojiLatestPkg dist pkg- unless (eqNVR nvr latest) $- showNVRChange pkg latest nvr- build topdir Nothing False Pending dist rest- Changed -> do- latest <- kojiLatestPkg dist pkg- unless (eqNVR nvr latest) $- putStrLn pkg- build topdir Nothing False Changed dist rest- Built -> do- latest <- kojiLatestPkg dist pkg- when (eqNVR nvr latest) $- putStrLn pkg- build topdir Nothing False Built dist rest- Bump -> do- latest <- kojiLatestPkg dist pkg- when (eqNVR nvr latest) $ do- git_ "log" [distRemote branched dist ++ "..HEAD", "--pretty=oneline"]- cmd_ "rpmdev-bumpspec" ["-c", "refresh to cabal-rpm-2.0.2", spec]--- cmd_ (rpkg dist) ["commit", "-m", "cabal-rpm-1.0.0: add doc and prof subpkgs"]- git_ "commit" ["-a", "--amend", "--no-edit"{-, "-m", "revised .cabal"-}]- build topdir Nothing False Bump dist rest- NotInstalled -> do- opkg <- head <$> rpmspec ["--builtrpms"] (Just "%{name}") spec- inst <- cmdMaybe "rpm" ["-q", opkg] :: IO (Maybe String)- when (isNothing inst) $ putStrLn pkg- build topdir Nothing False NotInstalled dist rest- Chain -> do- fhbuilt <- kojiCheckFHBuilt topdir nvr- latest <- if fhbuilt- then return $ Just nvr- else kojiLatestPkg dist pkg- if eqNVR nvr latest- then do- if fhbuilt- then putStrLn $ fromJust latest +-+ "already built!"- else kojiWaitPkg topdir dist nvr- unless (null rest) $- build topdir Nothing False Chain dist rest- else do- tags <- kojiListTags dist nvr- if any ((show dist ++ "-updates-") `isPrefixOf`) tags- then do- putStrLn $ nvr +-+ "tags:" +-+ unwords tags- bodhiOverride branched dist nvr- build topdir Nothing True Chain dist rest- else do- git_ "diff" []- building <- kojiBuilding pkg nvr dist- if building- then do- putStrLn $ nvr +-+ "is already building"- kojiWaitPkg topdir dist nvr- unless (null rest) $- build topdir Nothing False Chain dist rest- else do- showChange pkg latest nvr- putStrLn ""- srcs <- buildRequires spec >>= haskellSrcPkgs topdir dist- hmissing <- nub <$> filterM (notInKoji branch topdir dist) srcs- putStrLn ""- unless (null hmissing) $ do- putStrLn "Deps:"- mapM_ putStrLn hmissing- build topdir Nothing True Chain dist hmissing- setCurrentDirectory $ topdir </> wd- putStrLn ""- git_ "push" []- putStrLn ""- rpkgBuild dist nvr- -- may need waitrepo here?- bodhiOverride branched dist nvr- unless (null rest) $ do- putStrLn ""- putStrLn $ show (length rest) +-+ "packages left"- build topdir (Just (pkg, nvr)) waitrepo Chain dist rest--notInstalled :: String -> IO Bool-notInstalled pkg =- not <$> cmdBool "rpm" ["--quiet", "-q", "--whatprovides", pkg]--showChange :: Package -> Maybe String -> String -> IO ()-showChange pkg mlatest nvr = do- git_ "log" ["-1"]- putStrLn ""- showNVRChange pkg mlatest nvr--showNVRChange :: Package -> Maybe String -> String -> IO ()-showNVRChange pkg Nothing nvr =- putStrLn $ pkg +-+ "new" +-+ removeStrictPrefix (pkg ++ "-") nvr-showNVRChange pkg (Just latest) nvr = do- putStrLn $ pkg ++ ":" +-+ removeStrictPrefix prefix latest- putStrLn $ replicate (length pkg - 1) ' ' ++ "->" +-+ removeStrictPrefix prefix nvr- where- prefix = pkg ++ "-"--bodhiOverride :: Dist -> Dist -> String -> IO ()-bodhiOverride branched dist nvr = do- when (distOverride branched dist) $- -- FIXME: improve Notes with recursive info- cmdLog "bodhi" ["overrides", "save", "--notes", "Haskell stack", nvr]--eqNVR :: String -> Maybe String -> Bool-eqNVR p1 p2 =- Just (dropExtension p1) == fmap dropExtension p2--dependent :: String -> String -> String -> FilePath -> IO Bool-dependent dep pkg branch topdir = do- pkgpath <- pkgDir pkg branch topdir- grep_ dep $ pkgpath </> pkg ++ ".spec"--waitForEnter :: IO ()-waitForEnter = do- putStrLn ""- putChar '\a'- putStrLn "Press Enter after fixing"- void getLine
− src/Dist.hs
@@ -1,45 +0,0 @@-module Dist- (distArg,- distOverride,- distRemote,- distTag,- distTarget,- hackageRelease,- ltsStream)- where--import Data.Maybe (fromMaybe)-import Distribution.Fedora (Dist(..), distBranch, distOverride)-import SimpleCmdArgs (Parser, argumentWith, auto)----- | Used for Koji sidetag when needed.-sidetag :: Dist -> Maybe String---sidetag (Fedora n) | n >= 33 = Just "build-side-19539"-sidetag _ = Nothing---- | Maps `Dist` to build tag-distTag :: Dist -> String---distTag (Fedora n) | n >= 33 = "f33-build-side-19539"-distTag d = show d ++ "-" ++ fromMaybe "build" (sidetag d)---- | Maps `Dist` to target tag-distTarget :: Dist -> String---distTarget (Fedora n) | n >= 33 = "f33-build-side-19539"-distTarget d = show d ++ maybe "" ("-" ++) (sidetag d)---- | optparse-application DIST arg-distArg :: Parser Dist-distArg = argumentWith auto "DIST"---- | Maps `Dist` to remote branch: eg "origin/master"-distRemote :: Dist -> Dist -> String-distRemote branch d = "origin/" ++ distBranch branch d---- | Fedora release being tracked in Hackage Distro data-hackageRelease :: Dist-hackageRelease = Fedora 39---- | Stackage LTS stream major version-ltsStream :: String-ltsStream = "lts-21"
− src/Koji.hs
@@ -1,180 +0,0 @@-{-# LANGUAGE CPP #-}---- |--- Module : Koji--- Copyright : (C) 2016-2019 Jens Petersen------ Maintainer : Jens Petersen <petersen@fedoraproject.org>--- Stability : alpha--- Portability : *nix------ Explanation: Koji commands---- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.--module Koji (kojiBuilding,- kojiCheckFHBuilt,- kojicmd,- kojiLatestPkg,- kojiListPkgs,- kojiListTags,- kojiWaitPkg,- notInKoji,- rpkg,- rpkgBuild- ) where--#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))-#else-import Control.Applicative ((<$>))-#endif-import Control.Concurrent (threadDelay)-import Control.Monad (unless, when)-import Data.Fixed (Micro)-import Data.List (isInfixOf, isPrefixOf)-import Data.Time.Clock (diffUTCTime, getCurrentTime)-import System.Directory (doesFileExist)-import System.Exit (ExitCode (..))-import System.FilePath ((</>), (<.>))-import System.Process (readProcessWithExitCode, rawSystem)--import Distribution.Fedora (Dist, kojicmd, rpkg)-import SimpleCmd (cmd, cmd_, cmdBool, cmdLines, cmdMaybe, cmdN, grep_, logMsg,- removePrefix, removeStrictPrefix, warning, (+-+))-import Dist (distTag, distTarget)-import RPM (pkgDir)-import Utils (setTermTitle)--kojisafe :: Dist -> String -> [String] -> IO String-kojisafe dist c as =- cmdFragile (kojicmd dist) (c:as)--kojiLatestPkg :: Dist -> String -> IO (Maybe String)-kojiLatestPkg dist pkg = do- res <- words <$> kojisafe dist "latest-pkg" ["--quiet", distTag dist, pkg]- return $ if null res then Nothing else Just $ head res--kojiWaitPkg :: FilePath -> Dist -> String -> IO ()-kojiWaitPkg topdir dist nvr = do- let fhbuilt = topdir </> ".fhbuilt"- tag = distTag dist- already <- kojiCheckFHBuilt topdir nvr- unless already $ do- logMsg $ "Waiting for" +-+ nvr +-+ "in" +-+ tag- setTermTitle $ '*' : removePrefix "ghc-" nvr- cmdFragile_ (kojicmd dist) ["wait-repo", tag, "--build=" ++ nvr]- tags <- cmdLines (kojicmd dist) ["list-tags", "--build=" ++ nvr]- -- do not cache overrides- when (tag `elem` tags) $- appendFile fhbuilt $ nvr ++ "\n"--kojiCheckFHBuilt :: FilePath -> String -> IO Bool-kojiCheckFHBuilt topdir nvr = do- let fhbuilt = topdir </> ".fhbuilt"- grep_ nvr fhbuilt--kojiBuilding :: String -> String -> Dist -> IO Bool-kojiBuilding pkg build dist = do- tasks <- lines <$> kojisafe dist "list-tasks" ["--mine", "--quiet"]- return $ any (build `isInfixOf`) tasks || any (("/" ++ pkg ++ ":") `isInfixOf`) tasks---- parseKojiTask :: [String] -> Maybe String--- parseKojiTask [] = Nothing--- parseKojiTask (l:ls) | "Created task:" `isPrefixOf` l = Just $ removeStrictPrefix "Created task: " l--- | otherwise = parseKojiTask ls--notInKoji :: String -> FilePath -> Dist -> String -> IO Bool-notInKoji branch topdir dist pkg = do- latest <- kojiLatestPkg dist pkg- pkgpath <- pkgDir pkg branch topdir- let spec = pkg <.> "spec"- specExists <- doesFileExist $ pkgpath </> spec- if not specExists- then error $ spec +-+ "not found"- else do- local <- cmd (rpkg dist) ["--path", pkgpath, "verrel"]- if latest == Just local- then kojiWaitPkg topdir dist local >> return False- else return True--kojiListPkgs :: Dist -> IO [String]-kojiListPkgs dist =- words <$> cmd (kojicmd dist) ["list-pkgs", "--tag=" ++ distTag dist]--kojiListTags :: Dist -> String -> IO [String]-kojiListTags dist nvr = do- res <- cmdMaybe (kojicmd dist) ["list-tags", "--build=" ++ nvr]- return $ maybe [] words res--rpkgBuild :: Dist -> String -> IO ()-rpkgBuild dist nvr = do- giturl <- cmd (rpkg dist) ["giturl"]- setTermTitle $ removePrefix "ghc-" nvr- -- FIXME switch to cmdLog later- cmd_ "date" []- cmdN (kojicmd dist) ["build", "--nowait", "--fail-fast", distTarget dist, giturl]- out <- cmd (kojicmd dist) ["build", "--nowait", "--fail-fast", distTarget dist, giturl]- putStrLn out- let task = last . words . head $ lines out- start <- getCurrentTime- success <- kojiWatchTask dist task- if success- then do- logMsg $ nvr ++ " built"- else do- now <- getCurrentTime- -- koji srpms typically take 2 minutes- let countdown = 120 - round (diffUTCTime now start) :: Int- when (countdown >= 0) $- cmd_ "sleep" [show countdown]--data TaskState = TaskOpen | TaskFailed | TaskClosed | TaskFree--kojiWatchTask :: Dist -> String -> IO Bool-kojiWatchTask dist task = do- res <- cmdBool (kojicmd dist) ["watch-task", task]- if res then return True- else do- ti <- kojiTaskInfo- case ti of- TaskClosed -> return True- TaskFailed -> error "Task failed!"- _ -> kojiWatchTask dist task- where- kojiTaskInfo :: IO TaskState- kojiTaskInfo = do- info <- cmdLines (kojicmd dist) ["taskinfo", task]- let state = removeStrictPrefix "State: " <$> filter ("State: " `isPrefixOf`) info- return $- case state of- ["open"] -> TaskOpen- ["failed"] -> TaskFailed- ["closed"] -> TaskClosed- ["free"] -> TaskFree- _ -> error "unknown task state!"--cmdFragile :: String -> [String] -> IO String-cmdFragile c as = do- (ret, out, err) <- readProcessWithExitCode c as ""- case ret of- ExitSuccess -> return out- ExitFailure n -> do- unless (null out) $ putStrLn out- when (null (out ++ err)) $- warning $ "\"" ++ c +-+ unwords as ++ "\"" +-+ "failed with status" +-+ show n- unless (null err) $ warning err- threadDelay (fromEnum (2 :: Micro))- cmdFragile c as--cmdFragile_ :: String -> [String] -> IO ()-cmdFragile_ c as = do- ret <- rawSystem c as- case ret of- ExitSuccess -> return ()- ExitFailure _ -> do- warning $ "retrying \"" ++ c +-+ unwords as ++ "\""- threadDelay (fromEnum (2 :: Micro))- cmdFragile_ c as
src/RPM.hs view
@@ -18,7 +18,6 @@ haskellSrcPkgs, Package, packageManager,- pkgDir, repoquery, rqfnewline, rpmInstall,@@ -31,16 +30,14 @@ import Control.Monad (when) import Data.List (isPrefixOf, isSuffixOf, nub, (\\)) import Data.Maybe (isJust, isNothing)+import Distribution.Fedora.Branch (Branch, branchRelease, showBranch)+import Distribution.Fedora.Release (releaseVersion)+import SimpleCmd (cmd, cmdN, removeStrictPrefix, removeSuffix, sudo_, warning, (+-+))+import qualified SimpleCmd.Rpm as S import System.Directory (doesDirectoryExist, findExecutable) import System.FilePath ((</>), takeDirectory)--- die is available in ghc-7.10 base-4.8 import System.Exit (ExitCode (..), exitFailure, exitWith) -import Dist (distTag)-import Distribution.Fedora (Dist, distBranch, distVersion, getFedoraDists, getLatestFedoraDist)-import SimpleCmd (cmd, removeStrictPrefix, removeSuffix, sudo_, warning, (+-+))-import qualified SimpleCmd.Rpm as S- -- @since base 4.8.0.0 die :: String -> IO a die err = warning err >> exitFailure@@ -69,25 +66,26 @@ -- should be \n for dnf5 repoquery workaround -- FIXME integrate into repoquery or add to SimpleCmd.Rpm? rqfnewline :: String-rqfnewline = ""+rqfnewline = "\n" -repoquery :: Dist -> [String] -> IO String-repoquery dist args = do+-- FIXME use frpq+repoquery :: Branch -> [String] -> IO String+repoquery branch args = do havednf <- optionalProgram "dnf" let (prog, subcmd) = if havednf then ("dnf", ["repoquery", "--quiet"]) else ("repoquery", [])- branched <- getLatestFedoraDist- let releasever = ["--releasever=" ++ distVersion branched dist]+ rel <- branchRelease branch+ let releasever = ["--releasever=" ++ releaseVersion rel]+ -- FIXME debug output+ when False $+ cmdN prog (subcmd ++ releasever ++ args) cmd prog (subcmd ++ releasever ++ args) -repoquerySrc :: Dist -> String -> IO (Maybe String)-repoquerySrc dist key = do+repoquerySrc :: Branch -> String -> IO (Maybe String)+repoquerySrc branch key = do havednf <- optionalProgram "dnf" let srcflag = if havednf then ["--qf=%{source_name}"] else ["--qf", "%{base_package_name}"]- dists <- getFedoraDists- let repo = if dist `elem` dists- then ["--repo=koji-buildroot", "--repofrompath", "koji-buildroot,https://kojipkgs.fedoraproject.org/repos" </> distTag dist </> "latest/x86_64/"]- else []- res <- words <$> repoquery dist (srcflag ++ repo ++ ["--whatprovides", key])+ let repo = ["--repo=koji-buildroot", "--repofrompath", "koji-buildroot,https://kojipkgs.fedoraproject.org/repos" </> showBranch branch </> "latest/x86_64/"]+ res <- words <$> repoquery branch (srcflag ++ repo ++ ["--whatprovides", key]) return $ case res of [p] -> Just p ps | key `elem` ps -> Just key@@ -105,7 +103,7 @@ type Package = String -derefSrcPkg :: FilePath -> Dist -> Bool -> Package -> IO Package+derefSrcPkg :: FilePath -> Branch -> Bool -> Package -> IO Package derefSrcPkg topdir dist verb pkg = do res <- maybeDerefSrcPkg topdir dist verb pkg case res of@@ -116,14 +114,14 @@ when (pkg /= s && verb) $ putStrLn $ pkg +-+ "->" +-+ s return s -derefSrcPkgRelax :: FilePath -> Dist -> Package -> IO Package+derefSrcPkgRelax :: FilePath -> Branch -> Package -> IO Package derefSrcPkgRelax topdir dist pkg = do res <- maybeDerefSrcPkg topdir dist False pkg case res of Nothing -> return pkg Just s -> return s -maybeDerefSrcPkg :: FilePath -> Dist -> Bool -> Package -> IO (Maybe Package)+maybeDerefSrcPkg :: FilePath -> Branch -> Bool -> Package -> IO (Maybe Package) maybeDerefSrcPkg topdir dist verb pkg = do let lib = removeLibSuffix pkg -- fixme: should check branch (dir)@@ -152,17 +150,10 @@ haskellTools :: [Package] haskellTools = ["alex", "cabal-install", "gtk2hs-buildtools", "happy", "hspec-discover"] -haskellSrcPkgs :: FilePath -> Dist -> [Package] -> IO [Package]-haskellSrcPkgs topdir dist brs = do+haskellSrcPkgs :: FilePath -> Branch -> [Package] -> IO [Package]+haskellSrcPkgs topdir branch brs = do ghcLibs <- do- branched <- getLatestFedoraDist- let branch = distBranch branched dist- ghcDir <- pkgDir "ghc" branch (takeDirectory topdir)+ let ghcDir = takeDirectory topdir </> "ghc" 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--pkgDir :: String -> String -> FilePath -> IO FilePath-pkgDir dir branch top = do- b <- doesDirectoryExist $ top </> dir </> branch- return $ top </> dir </> if b then branch else ""+ nub <$> mapM (derefSrcPkgRelax topdir branch) hdeps