fedora-haskell-tools 0.9 → 1.0
raw patch · 13 files changed
+483/−326 lines, 13 filesdep +bytestringdep +extradep +http-conduitdep −HTTPdep ~fedora-distsdep ~simple-cmddep ~simple-cmd-argssetup-changed
Dependencies added: bytestring, extra, http-conduit, http-types
Dependencies removed: HTTP
Dependency ranges changed: fedora-dists, simple-cmd, simple-cmd-args
Files
- ChangeLog +9/−0
- README.md +4/−6
- Setup.hs +0/−2
- TODO +18/−1
- fedora-haskell-tools.cabal +22/−14
- fhbz.hs +13/−13
- fhmock.hs +7/−8
- fhpkg.hs +294/−195
- src/Build.hs +73/−65
- src/Dist.hs +9/−6
- src/Koji.hs +18/−8
- src/RPM.hs +11/−6
- src/Utils.hs +5/−2
ChangeLog view
@@ -1,3 +1,12 @@+# 1.0 (2022-01-22)+- use fedora-dists-2.0+- Hackage distro urls now point to pagure dist-git+- Hackage distro upload now uses http-conduit+- new 'subpackaged' command lists subpackaged libs+- can build with ghc9 and aeson-2.0+- Hackage commands ignore new ghcX.Y packages+- bunch of smaller tweaks and other improvements+ # 0.9 (2019-10-30) - changes for Fedora 31 - ghc now lives in ../
README.md view
@@ -1,4 +1,3 @@-[](https://travis-ci.org/fedora-haskell/fedora-haskell-tools) [](http://hackage.haskell.org/package/fedora-haskell-tools) [](http://stackage.org/lts/package/fedora-haskell-tools) [](http://stackage.org/nightly/package/fedora-haskell-tools)@@ -12,7 +11,7 @@ Git clones and pull, etc Fedora Haskell package repos. Can also generate Hackage distro meta data. Builds set of packages locally or in Koji or Mock.-(fhbuild has been merged into fhpkg.)+(fhbuild has been merged into fhpkg, but now superceded by fbrnch.) For local builds unbuilt dependent packages are also built recursively. @@ -20,12 +19,11 @@ Chain builds packages with wait-repo. Also checks that updated dependencies have been built first. -Please be careful when using the build commands:-eg for Rawhide this can easily cause package builds to take place in Koji-when packages haven't been built yet for the latest disttag.- See TODO for more planned features. +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. ## fhbz Update version update bugs in Bugzilla for Haskell packages.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
TODO view
@@ -1,3 +1,20 @@+- counts package list too (otherwise all)+- don't "== ==" deps until confirming unbuilt+- prevent building nvr downgrades+- detect started koji (srpm) tasks which are not builds yet+- chain --no-check (to replace koji)+- hledger think ghc-yesod-static-prof -> ghc-yesod-static -> ghc-yesod??+ - maybe rpmbuild-order too?+ - can cabal repl load libHS*.a? (if no .so)+- if unbumped subpackages check that release is bumped+- ghc.spec needs ghc-rpm-macros-extra to list libs+- map lts to minor version+- "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 - filter xmonad and pandoc-pdf from install@@ -57,7 +74,7 @@ - git out of sync with koji, updates # Data generation and updating-- packages and Hackage +- packages and Hackage - dependencies and consumers # Bugs
fedora-haskell-tools.cabal view
@@ -1,21 +1,21 @@ Name: fedora-haskell-tools-Version: 0.9+Version: 1.0 Synopsis: Building and maintenance tools for Fedora Haskell Description:- Tools for building and managing Fedora Haskell packages.+ Maintainer tools for building and managing Fedora Haskell packages. Homepage: https://github.com/fedora-haskell/fedora-haskell-tools Bug-reports: https://github.com/fedora-haskell/fedora-haskell-tools/issues License: GPL-3 License-file: COPYING Author: Jens Petersen <petersen@fedoraproject.org> Maintainer: Jens Petersen <petersen@fedoraproject.org>-Copyright: 2014-2019 Jens Petersen <petersen@fedoraproject.org>+Copyright: 2014-2022 Jens Petersen <petersen@fedoraproject.org> Category: Distribution Build-type: Simple Extra-source-files: README.md TODO ChangeLog-Cabal-version: >=1.6-Tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2,- GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5+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 source-repository head type: git@@ -24,15 +24,18 @@ Executable fhpkg Main-is: fhpkg.hs Build-depends: base >= 4.6 && < 5,+ bytestring, csv, directory,- fedora-dists,+ extra,+ fedora-dists >= 2.0, filepath,- HTTP,+ http-conduit >= 2.3.2,+ http-types, optparse-applicative, process, simple-cmd >= 0.2.0,- simple-cmd-args >= 0.1.2,+ simple-cmd-args >= 0.1.6, split, time, unix@@ -40,22 +43,27 @@ Other-modules: Build, Dist, Koji, Paths_fedora_haskell_tools, Utils RPM GHC-options: -fwarn-missing-signatures -Wall- Extensions: CPP+ Default-Language: Haskell98 Executable fhbz Main-is: fhbz.hs Build-depends: base < 5,- fedora-dists,+ directory,+ fedora-dists >= 2.0,+ filepath,+ process,+ simple-cmd,+ simple-cmd-args, time Hs-Source-Dirs: src, . Other-modules: Dist, Koji, RPM, Utils GHC-options: -fwarn-missing-signatures -Wall- Extensions: CPP+ Default-Language: Haskell98 Executable fhmock Main-is: fhmock.hs Build-depends: base < 5,- fedora-dists,+ fedora-dists >= 2.0, simple-cmd >= 0.2.0, simple-cmd-args >= 0.1.2 if impl(ghc<8.0)@@ -63,4 +71,4 @@ Hs-Source-Dirs: src, . Other-modules: Dist, Paths_fedora_haskell_tools GHC-options: -fwarn-missing-signatures -Wall- Extensions: CPP+ Default-Language: Haskell98
fhbz.hs view
@@ -1,7 +1,6 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-} -- |--- Module : Bugzilla -- Copyright : (C) 2014-2018 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org>@@ -30,7 +29,7 @@ import System.Environment (getArgs, getEnv, getProgName) import System.FilePath ((</>)) -import FedoraDists (rawhide)+import Distribution.Fedora (Dist, getRawhideDist) import Koji (kojicmd) import SimpleCmd ((+-+), cmd, cmd_, cmdStdErr, removeStrictPrefix, removeSuffix) @@ -74,7 +73,8 @@ 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])- mapM_ (checkBug opts) bugs+ rawhide <- getRawhideDist+ mapM_ (checkBug rawhide opts) bugs bugzillaQuery :: [String] -> IO String bugzillaQuery args = cmd "bugzilla" ("query":args)@@ -90,8 +90,8 @@ BugState bid bcomp bst bsum bwh : parseLines rest parseLines _ = error "Bad bugzilla query output!" -checkBug :: [Flag] -> BugState -> IO ()-checkBug opts (BugState bid bcomp _bst bsum bwh) =+checkBug :: Dist -> [Flag] -> BugState -> IO ()+checkBug rawhide opts (BugState bid bcomp _bst bsum bwh) = unless (bcomp `elem` excludedPkgs) $ do let hkg = removeGhcPrefix bcomp (hkgver, state) = colon bwh@@ -102,7 +102,7 @@ -- 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 opts bid bcomp pkgver else do+ if Check `notElem` opts then closeBug rawhide opts bid bcomp pkgver else do let force = Force `elem` opts refresh = Refresh `elem` opts when (hkgver /= hkgver' || force || refresh) $ do@@ -129,10 +129,10 @@ | otherwise = p removeGhcPrefix pkg = pkg -comma :: String -> String-comma nv = reverse eman ++ "," ++ reverse rev- where- (rev, '-':eman) = break (== '-') $ reverse nv+-- comma :: String -> String+-- comma nv = reverse eman ++ "," ++ reverse rev+-- where+-- (rev, '-':eman) = break (== '-') $ reverse nv colon :: String -> (String, String) colon "" = ("","")@@ -140,8 +140,8 @@ where (nv, s) = break (== ':') ps -closeBug :: [Flag] -> String -> String -> String -> IO ()-closeBug opts bid bcomp pkgver = do+closeBug :: Dist -> [Flag] -> String -> String -> String -> IO ()+closeBug rawhide opts bid bcomp pkgver = do latest <- cmd (kojicmd rawhide) ["latest-pkg", "rawhide", bcomp, "--quiet"] unless (null latest) $ do let nvr = (head . words) latest
fhmock.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Module : Mock -- Copyright : (C) 2018-2019 Jens Petersen@@ -21,12 +23,9 @@ import Dist (distArg) import Paths_fedora_haskell_tools (version) -import FedoraDists (Dist, distRepo, releaseVersion)+import Distribution.Fedora (Dist, getLatestFedoraDist, mockConfig) import SimpleCmd (cmd_) import SimpleCmdArgs-#if (defined(MIN_VERSION_optparse_applicative) && MIN_VERSION_optparse_applicative(0,13,0))---import Data.Semigroup ((<>))-#endif -- mock :: [String] -> IO String -- mock os = cmd "mock" os@@ -36,7 +35,6 @@ 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 $- map mockCmd commonMockCmds ++ [ Subcommand "check" "Check all Haskell libs installable" $ check <$> distArg , Subcommand "repoquery" "Repoquery" $@@ -46,6 +44,7 @@ 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) =@@ -71,7 +70,7 @@ , ("install", True, "PKG", False, "Install packages") , ("rebuild", True, "SRPM", False, "Build package(s)") , ("remove", True, "PKG", False, "Remove package")- , ("shell", False, "CMD", True, "Interactive shell command")+ , ("shell", False, "CMD", False, "Interactive shell command") , ("update", False, "PKG", False, "Update chroot packages") ] @@ -92,11 +91,11 @@ runMock :: Dist -> String -> [String] -> IO () runMock dist c cs = do- let conf = distRepo dist ++ "-" ++ releaseVersion dist ++ "-x86_64"+ 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
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Module : Packages -- Copyright : (C) 2017-2019 Jens Petersen@@ -12,8 +14,6 @@ -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -module Main where- #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,13,0)) #else import Control.Applicative (optional, some, (<|>)@@ -24,11 +24,16 @@ ) #endif import Control.Monad (filterM, unless, when, (>=>))+import Control.Monad.Extra (mapMaybeM, unlessM, whenJustM)+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Char (isDigit) import Data.Maybe-import Data.List (intercalate, isInfixOf, isPrefixOf, nub, sort, (\\))+import Data.List import Data.List.Split (splitOn)-import Network.HTTP (getRequest, getResponseBody, simpleHTTP)+import Network.HTTP.Simple+import Network.HTTP.Types import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, getHomeDirectory, #if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5))@@ -42,16 +47,18 @@ --import System.Posix.Env (getEnv) import Text.CSV (parseCSV) -import FedoraDists (Dist(..), distBranch, distRepo, distUpdates, rawhide)+import Distribution.Fedora (Dist(..), distBranch, distRepo, distUpdates,+ getLatestFedoraDist, getRawhideDist)+--import Distribution.Fedora.Branch (Branch(..)) -import SimpleCmd ((+-+), cmd, cmd_, cmdBool, cmdLines, cmdMaybe, cmdQuiet,- cmdSilent, grep_, removePrefix, shell_, warning)-import SimpleCmd.Git (git, git_, gitBranch, gitDiffQuiet, isGitDir)+import SimpleCmd ((+-+), cmd, cmd_, cmdLines, cmdMaybe, cmdQuiet, {-cmdSilent,-}+ grep_, removePrefix, removeSuffix, shell_, warning)+import SimpleCmd.Git import SimpleCmdArgs import Build (build, readBuildCmd) import Dist (distArg, distRemote, hackageRelease, ltsStream)-import Koji (kojiListPkgs, rpkg)+import Koji (rpkg) import Paths_fedora_haskell_tools (version) import RPM (buildRequires, haskellSrcPkgs, Package, pkgDir, repoquery, rpmspec)@@ -67,83 +74,91 @@ main :: IO () main = do- hSetBuffering stdout LineBuffering+ hSetBuffering stdout NoBuffering cwd <- getCurrentDirectory+ branched <- getLatestFedoraDist simpleCmdArgs (Just version) "Fedora Haskell packages tool" "Fedora packages maintenance tool" $- subcommands $+ subcommands . sort $ [ Subcommand "checkout" "fedpkg switch-branch" $- repoAction_ True False (return ()) <$> distArg <*> pkgArgs+ repoAction_ branched True False (return ()) <$> distArg <*> pkgArgs , Subcommand "clone" "clone repos" $- clone <$> branching <*> distArg <*> pkgArgs+ clone branched <$> branching <*> distArg <*> pkgArgs , Subcommand "clone-new" "clone new packages" $- cloneNew <$> branching <*> distArg+ cloneNew branched <$> branching <*> distArg , Subcommand "cblrpm" "Run cblrpm command" $- cblrpm <$> strOptionWith 'c' "cmd" "CMD" "command to execute" <*> distArg <*> pkgArgs+ cblrpm branched <$> strOptionWith 'c' "cmd" "CMD" "command to execute" <*> distArg <*> pkgArgs , Subcommand "cmd" "arbitrary command (with args)" $- execCmd <$> strOptionWith 'c' "cmd" "CMD" "command to execute" <*> distArg <*> pkgArgs+ execCmd branched <$> strOptionWith 'c' "cmd" "CMD" "command to execute" <*> distArg <*> pkgArgs , Subcommand "count" "count number of packages" $- (repoqueryHaskellPkgs False >=> (print . length)) <$> distArg+ (repoqueryHaskellPkgs branched False >=> (print . length)) <$> distArg , Subcommand "depends" "cabal-depends" $- repoAction False (Output cabalDepends) <$> distArg <*> pkgArgs+ repoAction branched False (Output cabalDepends) <$> distArg <*> pkgArgs , Subcommand "diff" "git diff" $- gitDiff <$> optional gitFormat+ gitDiff branched <$> optional gitFormat <*> optional (strOptionWith 'w' "with-branch" "BRANCH" "Branch to compare") <*> distArg <*> pkgArgs , Subcommand "diff-origin" "git diff origin" $- gitDiffOrigin <$> distArg <*> pkgArgs- , Subcommand "diff-branch" "compare branch with master" $- repoAction True (Header False compareRawhide) <$> distArg <*> pkgArgs+ 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 False (Output (const diffStat)) <$> distArg <*> pkgArgs- , Subcommand "hackage" "generate Hackage distro data" $- repoqueryHackageCSV hackageRelease <$> switchRefresh+ repoAction branched False (Output (const diffStat)) <$> distArg <*> pkgArgs+ , Subcommand "hackage-upload" "upload Hackage distro data" $+ hackageUpload branched <$> switchRefresh , Subcommand "hackage-compare" "compare with Hackage distro data" $- hackageCompare <$> switchRefresh+ hackageCompare branched <$> switchRefresh+ -- more or less the same as 'pushed' , Subcommand "head-origin" "packages with head in sync with origin" $- headOrigin <$> distArg <*> pkgArgs+ headOrigin branched <$> distArg <*> pkgArgs , Subcommand "leaf" "list leaf packages (slow!)" $- leaves <$> switchWith 'v' "deps" "show also deps" <*> distArg <*> pkgArgs+ leaves branched <$> switchWith 'v' "deps" "show also deps" <*> distArg <*> pkgArgs , Subcommand "list" "list packages that BR ghc-Cabal-devel" $- (repoqueryHaskellPkgs False >=> putStrList) <$> distArg+ (repoqueryHaskellPkgs branched False >=> putStrList) <$> distArg , Subcommand "merge" "git merge" $- merge <$> strOptionWith 'f' "from" "BRANCH" "specify branch to merge from" <*> distArg <*> pkgArgs+ merge branched <$> strOptionWith 'f' "from" "BRANCH" "specify branch to merge from" <*> distArg <*> pkgArgs , Subcommand "missing" "missing dependency source packages" $- missingDeps <$> distArg <*> pkgArgs+ missingDeps branched <$> distArg <*> pkgArgs , Subcommand "new" "unbuilt packages" $- (newPackages >=> putStrList) <$> distArg+ (newPackages branched >=> putStrList) <$> distArg , Subcommand "old-packages" "packages not in repoquery" $- oldPackages <$> distArg <*> pkgArgs+ oldPackages branched <$> distArg <*> pkgArgs , Subcommand "prep" "fedpkg prep" $- prep <$> distArg <*> pkgArgs+ prep branched <$> distArg <*> pkgArgs , Subcommand "stackage-compare" "compare with stackage" $- stackageCompare <$> streamOpt <*> switchWith 'm' "missing" "only list missing packages" <*> distArg <*> pkgArgs+ stackageCompare branched <$> streamOpt <*> stackageOpts <*> distArg <*> pkgArgs , Subcommand "commit" "fedpkg commit" $- commit <$> strOptionWith 'm' "message" "COMMITMSG" "commit message" <*> distArg <*> pkgArgs+ commit branched <$> strOptionWith 'm' "message" "COMMITMSG" "commit message" <*> distArg <*> pkgArgs , Subcommand "fetch" "git fetch repos" $- repoAction_ True False (git_ "fetch" []) <$> distArg <*> pkgArgs+ repoAction_ branched True False (git_ "fetch" []) <$> distArg <*> pkgArgs , Subcommand "pull" "git pull repos" $- repoAction_ True False (git_ "pull" ["--rebase"]) <$> distArg <*> pkgArgs+ repoAction_ branched True False (git_ "pull" ["--rebase"]) <$> distArg <*> pkgArgs , Subcommand "push" "git push repos" $- repoAction_ True False (git_ "push" []) <$> distArg <*> pkgArgs+ repoAction_ branched True False (git_ "push" []) <$> distArg <*> pkgArgs+ , Subcommand "pushed" "show git pushed packages" $+ pushed branched <$> distArg <*> pkgArgs , Subcommand "refresh" "cabal-rpm refresh" $- refresh <$> switchWith 'n' "dry-run" "Show patch but don't apply" <*> distArg <*> pkgArgs+ refresh branched <$> switchWith 'n' "dry-run" "Show patch but don't apply" <*> distArg <*> 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 True (Header True (\ p -> rpmspec [] (Just "%{name}-%{version}") (p <.> "spec") >>= putStrList)) <$> distArg <*> pkgArgs+ repoAction branched True (Header True (\ p -> rpmspec [] (Just "%{name}-%{version}") (p <.> "spec") >>= putStrList)) <$> distArg <*> pkgArgs+ , Subcommand "subpackaged" "list subpackaged libraries" $+ subpackaged branched <$> switchWith 'V' "show-versions" "Show versions" <*> distArg <*> 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 , Subcommand "unpushed" "show unpushed commits" $- unpushed <$> switchWith 's' "short" "no log" <*> distArg <*> pkgArgs+ unpushed branched <$> switchWith 's' "short" "no log" <*> distArg <*> pkgArgs , Subcommand "update" "cabal-rpm update" $- update <$> streamOpt <*> distArg <*> pkgArgs+ update branched <$> streamOpt <*> distArg <*> pkgArgs , Subcommand "verrel" "show nvr of packages" $- verrel <$> distArg <*> pkgArgs] +++ 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)")+ , ("koji", "build in Koji (deprecated) without checking dependencies") , ("pending", "show planned changes") , ("changed", "show changed pkgs") , ("built", "show pkgs whose NVR already built")@@ -151,7 +166,7 @@ , ("not-installed", "list packages not locally installed") ] where- pkgArgs = some (strArg "PKG...")+ pkgArgs = some (removeSuffix "/" <$> strArg "PKG...") branching = switchWith 'B' "branches" "clone branch dirs (fedpkg clone -B)" @@ -162,58 +177,72 @@ buildCmd cwd (c, desc) = Subcommand c desc $- build cwd Nothing Nothing False (readBuildCmd c) <$> distArg <*> pkgArgs+ build cwd Nothing False (readBuildCmd c) <$> distArg <*> pkgArgs switchRefresh = switchWith 'r' "refresh" "repoquery --refresh" streamOpt = strOptionalWith 's' "stream" "STACKAGESTREAM" ("Stackage stream [" ++ ltsStream ++ "]") ltsStream + stackageOpts :: Parser StkgOpt+ stackageOpts =+ flagWith' StkgMissing 'm' "missing" "only list missing packages" <|>+ flagWith StkgAll StkgOnly 'o' "only" "only Stackage packages"+ data DiffFormat = DiffShort | DiffContext Int deriving (Eq) +data StkgOpt = StkgAll | StkgOnly | StkgMissing+ deriving Eq+ putStrList :: [String] -> IO () putStrList = putStr . unlines -- should make separate rhel client so -B does not need dist-clone :: Bool -> Dist -> [Package] -> IO ()-clone True dist pkgs = cloneAllBranches dist pkgs-clone False dist pkgs =- repoAction_ True False (return ()) dist pkgs+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 :: Bool -> Dist -> IO ()-cloneNew True dist =- newPackages rawhide >>= cloneAllBranches dist-cloneNew False dist =- newPackages dist >>= repoAction_ True False (return ()) dist+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 :: String -> Dist -> [Package] -> IO ()-execCmd "" _ _ = error "CMD string must be given"-execCmd cs dist pkgs =- repoAction_ True True (shell_ cs) dist pkgs+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 :: Maybe DiffFormat -> Maybe String -> Dist -> [Package] -> IO ()-gitDiff fmt mbrnch =- repoAction False (Output doGitDiff)+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)) -> ["-u", show n]+ (Just (DiffContext n)) -> ["--unified=" ++ show n] _ -> []- short = fmt == Just DiffShort out <- git "diff" $ branch ++ contxt- return $ if null out then ""- else if short then pkg else out+ return $ if null out then "" else out -gitDiffOrigin :: Dist -> [Package] -> IO ()-gitDiffOrigin dist =- repoAction False (Output (const (git "diff" [distRemote dist]))) dist+gitDiffOrigin :: Dist -> Dist -> [Package] -> IO ()+gitDiffOrigin branched dist =+ repoAction branched False (Output (const (git "diff" [distRemote branched dist]))) dist -stackageCompare :: String -> Bool -> Dist -> [Package] -> IO ()-stackageCompare stream missingOnly dist =- repoAction True (Header False compareStackage) dist+stackageCompare :: Dist -> String -> StkgOpt -> Dist -> [Package] -> IO ()+stackageCompare branched stream opt dist =+ repoAction branched True (Header False compareStackage) dist where compareStackage :: Package -> IO () compareStackage p = do@@ -221,11 +250,12 @@ stkg <- cmdMaybe "stackage" ["package", stream, removePrefix "ghc-" p] let same = isJust stkg && (fromJust stkg ++ "-") `isInfixOf` nvr unless same $- if missingOnly+ if opt == StkgMissing then when (isNothing stkg) $ putStrLn p else if isNothing stkg- then putStrLn $ stream ++ " missing: " ++ removePrefix "ghc-" p+ then unless (opt == StkgOnly) $+ putStrLn $ stream ++ " missing: " ++ removePrefix "ghc-" p else do putStrLn nvr putStrLn $ replicate (length (dropVerrel nvr) + 1) ' ' ++ fromJust stkg +-+ "(" ++ stream ++ ")"@@ -233,17 +263,38 @@ diffStat :: IO String diffStat = git "diff" ["--stat"] -hackageCompare :: Bool -> IO ()-hackageCompare refreshData =- repoqueryHackages hackageRelease >>=+hackageUpload :: Dist -> Bool -> IO ()+hackageUpload branched refreshData = do+ csv <- repoqueryHackageCSV hackageRelease+ home <- getHomeDirectory+ [username, password] <- map B.pack . words <$> readFile (home </> ".fedora/hackage.auth")+ req <- setRequestBasicAuth username password .+ setRequestBodyLBS (BL.pack csv) .+ addRequestHeader hContentType (B.pack "text/csv") .+ setRequestMethod methodPut <$>+ parseRequestThrow "https://hackage.haskell.org/distro/Fedora/packages.csv"+ resp <- httpLbs req+ BL.putStrLn $ getResponseBody resp+ where+ repoqueryHackageCSV :: Dist -> IO String+ 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)++hackageCompare :: Dist -> Bool -> IO ()+hackageCompare branched refreshData =+ repoqueryHackages branched hackageRelease >>= compareHackage hackageRelease where compareHackage :: Dist -> [Package] -> IO () compareHackage dist pkgs' = do- hck <- simpleHTTP (getRequest "http://hackage.haskell.org/distro/Fedora/packages.csv") >>= getResponseBody- let hackage = sort . either (error "Malformed Hackage csv") (map mungeHackage) $ parseCSV "packages.csv" hck- sort . map mungeRepo . lines <$> repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=%{name},%{version}"] ++ ["--refresh" | refreshData] ++ pkgs') >>=- compareSets True hackage+ req <- addRequestHeader hContentType (B.pack "text/csv") <$>+ 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') >>=+ compareSets True hackage . sort . map mungeRepo . lines mungeHackage :: [String] -> PkgVer mungeHackage [n,v,_] = PV n v@@ -258,7 +309,7 @@ compareSets :: Bool -> [PkgVer] -> [PkgVer] -> IO () compareSets _ [] [] = return () compareSets _ [] (f:fs) = do- putStrLn ("New:" +-+ show f)+ putStrLn (show f +-+ "(new)") compareSets False [] fs compareSets all' (h:hs) [] = do when all' $ putStrLn ("Removed:" +-+ show h)@@ -268,25 +319,26 @@ when all' $ putStrLn $ "Removed:" +-+ show h compareSets all' hs (f:fs) | h > f = do- putStrLn $ "New:" +-+ show f+ putStrLn $ show f +-+ "(new)" compareSets all' (h:hs) fs | otherwise = do putStrLn $ pvPkg h ++ ":" +-+ pvVer h +-+ "->" +-+ pvVer f compareSets all' hs fs -headOrigin :: Dist -> [Package] -> IO ()-headOrigin dist =- repoAction False (Header False gitHeadAtOrigin) dist+headOrigin :: Dist -> Dist -> [Package] -> IO ()+headOrigin branched dist =+ repoAction branched False (Header False gitHeadAtOrigin) dist where gitHeadAtOrigin :: Package -> IO () gitHeadAtOrigin pkg = do -- use gitDiffQuiet- same <- cmdBool "git" ["diff", "--quiet", distRemote dist ++ "..HEAD"]+ same <- gitBool "diff" ["--quiet", distRemote branched dist ++ "..HEAD"] when same $ putStrLn pkg -leaves :: Bool -> Dist -> [Package] -> IO ()-leaves verb =- repoAction True (Header verb checkLeafPkg)+-- FIXME does not take static requires into account+leaves :: Dist -> Bool -> Dist -> [Package] -> IO ()+leaves branched verb =+ repoAction branched True (Header verb checkLeafPkg) where -- FIXME: make a dependency cache checkLeafPkg :: Package -> IO ()@@ -312,13 +364,13 @@ return $ any (`elem` deps) subpkgs else return False -merge :: String -> Dist -> [Package] -> IO ()-merge branch =- repoAction_ True False (git_ "merge" [branch])+merge :: Dist -> String -> Dist -> [Package] -> IO ()+merge branched branch =+ repoAction_ branched True False (git_ "merge" [branch]) -missingDeps :: Dist -> [Package] -> IO ()-missingDeps dist =- repoAction True (Output checkForMissingDeps) dist+missingDeps :: Dist -> Dist -> [Package] -> IO ()+missingDeps branched dist =+ repoAction branched True (Output checkForMissingDeps) dist where checkForMissingDeps :: Package -> IO String checkForMissingDeps pkg = do@@ -336,18 +388,18 @@ noPkgDir top dep = not <$> doesDirectoryExist (top </> dep) -oldPackages :: Dist -> [Package] -> IO ()-oldPackages dist pkgs = do- repopkgs <- repoqueryHaskellPkgs True dist+oldPackages :: Dist -> Dist -> [Package] -> IO ()+oldPackages branched dist pkgs = do+ repopkgs <- repoqueryHaskellPkgs branched True dist putStrList (pkgs \\ repopkgs) -prep :: Dist -> [Package] -> IO ()-prep dist =- repoAction_ True True (cmd_ (rpkg dist) ["prep"]) dist+prep :: Dist -> Dist -> [Package] -> IO ()+prep branched dist =+ repoAction_ branched True True (cmd_ (rpkg dist) ["prep"]) dist -commit :: String -> Dist -> [Package] -> IO ()-commit logmsg dist =- repoAction False (Output (const commitChanges)) dist+commit :: Dist -> String -> Dist -> [Package] -> IO ()+commit branched logmsg dist =+ repoAction branched False (Output (const commitChanges)) dist where commitChanges :: IO String commitChanges = do@@ -356,27 +408,30 @@ then return "" else cmd (rpkg dist) ["commit", "-m", logmsg] -unpushed :: Bool -> Dist -> [Package] -> IO ()-unpushed nolog dist =- repoAction True (Header False gitLogOneLine) dist+unpushed :: Dist -> Bool -> Dist -> [Package] -> IO ()+unpushed branched nolog dist =+ repoAction branched True (Header False gitLogOneLine) dist where gitLogOneLine :: Package -> IO () gitLogOneLine pkg = do- out <- git "log" [distRemote dist ++ "..HEAD", "--pretty=oneline"]+ out <- git "log" [distRemote branched dist ++ "..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 ":" -verrel :: Dist -> [Package] -> IO ()-verrel dist =- repoAction_ False True (cmd_ (rpkg dist) ["verrel"]) dist+pushed :: Dist -> Dist -> [Package] -> IO ()+pushed branched dist =+ repoAction branched True (Header False checkPushed) dist+ where+ checkPushed :: Package -> IO ()+ checkPushed pkg = do+ out <- git "log" [distRemote branched dist ++ "..HEAD", "--pretty=oneline"]+ when (null out) $ putStrLn pkg -repoqueryHackageCSV :: Dist -> Bool -> IO ()-repoqueryHackageCSV dist refreshData = do- pkgs <- repoqueryHackages dist- -- Hackage csv chokes on final newline so remove it- init . unlines . sort . map (replace "\"ghc-" "\"") . lines <$> repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=\"%{name}\",\"%{version}\",\"https://apps.fedoraproject.org/packages/%{source_name}\""] ++ ["--refresh" | refreshData] ++ pkgs) >>= putStr+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)@@ -396,46 +451,44 @@ else x:replace a b xs replace _ _ [] = [] -repoqueryHaskellPkgs :: Bool -> Dist -> IO [Package]-repoqueryHaskellPkgs verbose dist = do+repoqueryHaskellPkgs :: Dist -> Bool -> Dist -> IO [Package]+repoqueryHaskellPkgs branched verbose dist = do when verbose $ do tty <- hIsTerminalDevice stdout when tty $ warning "Getting packages from repoquery"- let repo = distRepo dist- updates = maybeToList $ distUpdates dist+ 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-*"]) when (null bin) $ error "No packages using ghc-Cabal-devel found!"- return $ sort $ nub bin+ 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 -> IO [Package]-repoqueryHackages dist = do- srcs <- repoqueryHaskellPkgs False dist+repoqueryHackages :: Dist -> Dist -> IO [Package]+repoqueryHackages branched dist = do+ srcs <- repoqueryHaskellPkgs branched False dist libs <- repoqueryHaskellLibs False let binsrcs = filter (not . ("ghc-" `isPrefixOf`)) srcs sublibs = libs \\ map ("ghc-" ++) binsrcs- return $ sort $ nub (srcs ++ sublibs)+ return $ sort $ nub (delete "haskell-platform" srcs ++ sublibs) where repoqueryHaskellLibs :: Bool -> IO [Package] repoqueryHaskellLibs verbose = do when verbose $ putStrLn "Getting libraries from repoquery"- let repo = distRepo dist- updates = maybeToList $ distUpdates dist+ 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)"]) when (null bin) $ error "No libHS*.so providers found!"- return $ sort $ nub bin--newPackages :: Dist -> IO [Package]-newPackages dist = do- ps <- repoqueryHaskellPkgs True dist- pps <- cmdLines "pagure" ["list", "ghc*"]- filterM (\ d -> not <$> doesFileExist (d </> "dead.package")) $ pps \\ ps+ return $ sort $ filter ("ghc-" `isPrefixOf`) $ nub bin -kojiListHaskell :: Bool -> Dist -> IO [Package]-kojiListHaskell verbose dist = do- when verbose $ putStrLn "Getting package list from Koji"- libs <- filter (\ p -> "ghc" `isPrefixOf` p && p `notElem` ["ghc-rpm-macros", "ghc-srpm-macros"]) <$> kojiListPkgs dist- when (null libs) $ error "No library packages found"- return $ sort $ nub libs+newPackages :: Dist -> Dist -> IO [Package]+newPackages branched dist = do+ ps <- repoqueryHaskellPkgs branched True dist+ pps <- cmdLines "pagure" ["list", "--namespace", "rpms", "ghc*"]+ local <- listDirectory "."+ filterM (\ d -> not <$> doesFileExist (d </> "dead.package")) $ nub (pps ++ ps) \\ (local ++ ["Agda-stdlib", "ghc", "ghc-rpm-macros", "ghc-srpm-macros", "haskell-platform"]) haveSshKey :: IO Bool haveSshKey = do@@ -463,13 +516,13 @@ showHeader (Header b _) = b showHeader (Output _) = False -repoAction :: Bool -> Action -> Dist -> [Package] -> IO ()-repoAction _ _ _ [] = return ()-repoAction needsSpec action dist (pkg:rest) = do+repoAction :: Dist -> Bool -> Action -> Dist -> [Package] -> IO ()+repoAction _ _ _ _ [] = return ()+repoAction branched needsSpec action dist (pkg:rest) = do withCurrentDirectory "." $ do- let branch = distBranch dist+ let branch = distBranch branched dist when (showHeader action) $- putStrLn $ "\n==" +-+ pkg ++ ":" ++ branch +-+ "=="+ putStrLn $ "\n==" +-+ pkg +-+ branch +-+ "==" -- muser <- getEnv "USER" haveSSH <- haveSshKey fileExists <- doesFileExist pkg@@ -494,55 +547,57 @@ else return False unless pkggit $ error $ "not a Fedora pkg git dir!:" +-+ wd- when dirExists $ do- actual <- gitBranch- when (branch /= actual) $- cmd_ (rpkg dist) ["switch-branch", branch]- isDead <- doesFileExist "dead.package"- unless isDead $ do- let spec = pkg <.> "spec"- hasSpec <- doesFileExist spec- -- FIXME: silence for cmds that only output package names (eg unpushed -s)- unless hasSpec $ putStrLn $ (if showHeader action then "" else pkg ++ ": ") ++ "No spec file!"- unless (needsSpec && not hasSpec) $- case action of- Header _ act -> act pkg- Output act -> do- out <- act pkg- unless (null out) $ do- putStrLn $ "\n==" +-+ pkg ++ ":" ++ branch +-+ "=="- putStrLn out- repoAction needsSpec action dist rest+ actual <- gitBranch+ when (branch /= actual) $+ whenJustM (cmdMaybe (rpkg dist) ["switch-branch", branch]) $ \ out ->+ when (showHeader action) $ putStrLn out+ currentBranch <- gitBranch+ when (branch == currentBranch) $+ unlessM (doesFileExist "dead.package") $ do+ let spec = pkg <.> "spec"+ hasSpec <- doesFileExist spec+ -- FIXME: silence for cmds that only output package names (eg unpushed -s)+ when (not hasSpec && showHeader action) $+ putStrLn "No spec file!"+ unless (needsSpec && not hasSpec) $+ case action of+ Header _ act -> act pkg+ Output act -> do+ out <- act pkg+ unless (null out) $ do+ putStrLn $ "\n==" +-+ pkg +-+ branch +-+ "=="+ putStrLn out+ repoAction branched needsSpec action dist rest -- io independent of package-repoAction_ :: Bool -> Bool -> IO () -> Dist -> [Package] -> IO ()-repoAction_ header needsSpec action =- repoAction needsSpec (Header header (const action))+repoAction_ :: Dist -> Bool -> Bool -> IO () -> Dist -> [Package] -> IO ()+repoAction_ branched header needsSpec action =+ repoAction branched needsSpec (Header header (const action)) -compareRawhide :: Package -> IO ()-compareRawhide p = do- let spec = p <.> "spec"- nvr <- removeDisttag . unwords <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec- nvr' <- withCurrentDirectory "../master" $ do- haveSpec <- doesFileExist spec- unless haveSpec $ cmdSilent "git" ["pull"]- removeDisttag . unwords <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec- if nvr == nvr'- then putStrLn nvr- else do- putStrLn nvr- putStrLn nvr'- putStrLn ""- where- removeDisttag = reverse . tail . dropWhile (/= '.') . reverse+-- compareRawhide :: Package -> IO ()+-- compareRawhide p = do+-- let spec = p <.> "spec"+-- nvr <- removeDisttag . unwords <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec+-- nvr' <- withBranch "master" $ do+-- haveSpec <- doesFileExist spec+-- unless haveSpec $ cmdSilent "git" ["pull"]+-- removeDisttag . unwords <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec+-- if nvr == nvr'+-- then putStrLn nvr+-- else do+-- putStrLn nvr+-- putStrLn nvr'+-- putStrLn ""+-- where+-- removeDisttag = reverse . tail . dropWhile (/= '.') . reverse isFromHackage :: Package -> IO Bool isFromHackage pkg = grep_ "hackage.haskell.org/package/" $ pkg <.> "spec" -update :: String -> Dist -> [Package] -> IO ()-update stream =- repoAction True (Header True doUpdate)+update :: Dist -> String -> Dist -> [Package] -> IO ()+update branched stream =+ repoAction branched True (Header True doUpdate) where doUpdate :: Package -> IO () doUpdate pkg = do@@ -551,9 +606,9 @@ then cmd_ "cabal-rpm" ["update", "-s", stream] else putStrLn "skipping since not hackage" -refresh :: Bool -> Dist -> [Package] -> IO ()-refresh dryrun =- repoAction True (Header True refreshPkg)+refresh :: Dist -> Bool -> Dist -> [Package] -> IO ()+refresh branched dryrun =+ repoAction branched True (Header True refreshPkg) where refreshPkg :: Package -> IO () refreshPkg pkg = do@@ -594,13 +649,57 @@ cmdQuiet "cabal-depends" ["--not-build", "--unique"] else return "" -cblrpm :: String -> Dist -> [Package] -> IO ()-cblrpm "" = error "CMD string must be given"-cblrpm cs =- repoAction True (Header True doCblRpm)+cblrpm :: Dist -> String -> Dist -> [Package] -> IO ()+cblrpm _ "" = error "CMD string must be given"+cblrpm branched cs =+ repoAction branched True (Header True doCblRpm) where doCblRpm :: Package -> IO () doCblRpm p = do hckg <- isFromHackage p when hckg $ cmd_ "cblrpm" [cs]++unbranched :: Dist -> Dist -> [Package] -> IO ()+unbranched branched dist =+ mapM_ checkBranch+ where+ checkBranch :: Package -> IO ()+ checkBranch pkg =+ 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]+ unless remotebranch $+ putStrLn pkg++subpackaged :: Dist -> Bool -> Dist -> [Package] -> IO ()+subpackaged branched versions dist pkgs = do+ repoAction branched True (Output listSubpkgs) dist pkgs+ where+ listSubpkgs pkg = do+ msubpkgs <- fmap (drop 2 . words) <$> cmdMaybe "grep" ["%global subpkgs", pkg <.> "spec"]+ case msubpkgs of+ Nothing -> return ""+ Just subpkgs ->+ intercalate "\n" <$> mapMaybeM expand subpkgs+ where+ expand subpkg =+ let macro = (init . drop 2) subpkg in+ fmap (removeVersion . last . words) <$> cmdMaybe "grep" ["%global " ++ macro, pkg <.> "spec"]++ removeVersion nv =+ if versions then nv else init (dropWhileEnd (/= '-') nv)++#if !MIN_VERSION_simple_cmd(0,2,2)+-- | 'gitBool c args' runs git command and return result+gitBool :: String -- ^ git command+ -> [String] -- ^ arguments+ -> IO Bool -- ^ result+gitBool c args = do+ mout <- cmdMaybe "git" (c:args)+ return $ isJust mout+#endif
src/Build.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Module : Build -- Copyright : (C) 2014-2019 Jens Petersen@@ -31,10 +33,10 @@ import System.Exit (ExitCode (..), exitWith) import System.FilePath ((</>), dropExtension) -import FedoraDists (Dist, distBranch, distOverride, rpmDistTag)-import Dist (distRemote)-import Koji (kojiBuilding, kojiCheckFHBuilt, kojiLatestPkg, kojiWaitPkg,- notInKoji, rpkg, rpkgBuild)+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,@@ -58,16 +60,13 @@ readBuildCmd "not-installed" = NotInstalled readBuildCmd _ = error "Unknown command" --- commands :: [String]--- commands = ["install", "mock" , "koji", "chain", "pending", "changed", "built", --- "bump", "notinstalled"]--build :: FilePath -> Maybe String -> Maybe (String, String) -> Bool ->+build :: FilePath -> Maybe (String, String) -> Bool -> Command -> Dist -> [String] -> IO ()-build _ _ _ _ _ _ [] = return ()-build topdir msubpkg mlast waitrepo mode dist (pkg:rest) = do+build _ _ _ _ _ [] = return ()+build topdir mlast waitrepo mode dist (pkg:rest) = do setCurrentDirectory topdir- let branch = distBranch dist+ branched <- getLatestFedoraDist+ let branch = distBranch branched dist when (mode `notElem` [Pending, Changed, Built, NotInstalled]) $ putStrLn $ "\n==" +-+ pkg ++ ":" ++ branch +-+ "==" dirExists <- doesDirectoryExist pkg@@ -87,7 +86,7 @@ if retired then do unless (mode `elem` [NotInstalled,Pending]) $ putStrLn "skipping dead.package"- build topdir Nothing Nothing False mode dist rest+ build topdir Nothing False mode dist rest else do pkggit <- do gd <- isGitDir "."@@ -96,10 +95,10 @@ if not pkggit then if mode `elem` [Install, Koji, Chain] then error $ "not a Fedora pkg git dir!:" +-+ wd- else build topdir Nothing Nothing False mode dist rest+ else build topdir Nothing False mode dist rest else do when dirExists $ do- git_ "pull" ["-q"]+ git_ "pull" ["-q", "--rebase"] actual <- gitBranch when (branch /= actual) $ cmd_ (rpkg dist) ["switch-branch", branch]@@ -115,9 +114,8 @@ let verrel = removeStrictPrefix (pkg ++ "-") nvr case mode of Install -> do- let req = fromMaybe pkg msubpkg- installed <- cmdMaybe "rpm" ["-q", "--qf", "%{name}-%{version}-%{release}", req]- if Just (req ++ "-" ++ verrel) == installed+ 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@@ -130,7 +128,7 @@ unless (null srcs) $ do putStrLn "Missing:" mapM_ putStrLn srcs- build topdir Nothing Nothing False Install dist srcs+ build topdir Nothing False Install dist srcs setCurrentDirectory $ topdir </> wd stillMissing <- filterM notInstalled missing unless (null stillMissing) $ do@@ -143,7 +141,7 @@ if not success then do waitForEnter- build topdir Nothing Nothing False Install dist [pkg]+ 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@@ -158,11 +156,11 @@ sudo_ pkgmgr ("install":"-y":rpms) putStrLn "" putStrLn $ show (length rest) +-+ "packages left"- build topdir Nothing Nothing False Install dist rest+ build topdir Nothing False Install dist rest Mock -> do putStrLn $ "Mock building" +-+ nvr cmdLog (rpkg dist) ["mockbuild"]- build topdir Nothing Nothing False Mock dist rest+ build topdir Nothing False Mock dist rest Koji -> do unless (null rest) $ do putStrLn $ show (length rest) +-+ "more packages"@@ -172,7 +170,7 @@ then do putStrLn $ fromJust latest +-+ "already built!" kojiWaitPkg topdir dist nvr- build topdir Nothing mlast False Koji dist rest+ build topdir mlast False Koji dist rest else do git_ "diff" [] building <- kojiBuilding pkg nvr dist@@ -180,7 +178,7 @@ then do putStrLn $ nvr +-+ "is already building" kojiWaitPkg topdir dist nvr- build topdir Nothing Nothing False Koji dist rest+ build topdir Nothing False Koji dist rest else do case mlast of Nothing -> return ()@@ -191,41 +189,42 @@ showChange pkg latest nvr putStrLn "" git_ "push" []- rpkgBuild topdir dist nvr waitrepo- bodhiOverride dist nvr+ -- 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 Nothing (if dep then Just (pkg, nvr) else Nothing) False Koji dist rest+ 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 Nothing False Pending dist rest+ build topdir Nothing False Pending dist rest Changed -> do latest <- kojiLatestPkg dist pkg unless (eqNVR nvr latest) $ putStrLn pkg- build topdir Nothing Nothing False Changed dist rest+ build topdir Nothing False Changed dist rest Built -> do latest <- kojiLatestPkg dist pkg when (eqNVR nvr latest) $ putStrLn pkg- build topdir Nothing Nothing False Built dist rest+ build topdir Nothing False Built dist rest Bump -> do latest <- kojiLatestPkg dist pkg when (eqNVR nvr latest) $ do- git_ "log" [distRemote dist ++ "..HEAD", "--pretty=oneline"]- cmd_ "rpmdev-bumpspec" ["-c", "add doc and prof subpackages (cabal-rpm-1.0.0)", spec]+ 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", "-m", "cabal-rpm-1.0.0: add doc and prof subpkgs"]- build topdir Nothing Nothing False Bump dist rest+ 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 Nothing False NotInstalled dist rest+ build topdir Nothing False NotInstalled dist rest Chain -> do fhbuilt <- kojiCheckFHBuilt topdir nvr latest <- if fhbuilt@@ -233,39 +232,48 @@ else kojiLatestPkg dist pkg if eqNVR nvr latest then do- putStrLn $ fromJust latest +-+ "already built!"+ if fhbuilt+ then putStrLn $ fromJust latest +-+ "already built!"+ else kojiWaitPkg topdir dist nvr unless (null rest) $- build topdir Nothing Nothing False Chain dist rest+ build topdir Nothing False Chain dist rest else do- git_ "diff" []- building <- kojiBuilding pkg nvr dist- if building+ tags <- kojiListTags dist nvr+ if any ((show dist ++ "-updates-") `isPrefixOf`) tags then do- putStrLn $ nvr +-+ "is already building"- kojiWaitPkg topdir dist nvr- unless (null rest) $- build topdir Nothing Nothing False Chain dist rest+ putStrLn $ nvr +-+ "tags:" +-+ unwords tags+ bodhiOverride branched dist nvr+ build topdir Nothing True 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 "Missing:"- mapM_ putStrLn hmissing- build topdir Nothing Nothing True Chain dist hmissing- setCurrentDirectory $ topdir </> wd+ 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 ""- -- note "fedpkg --path dir local" saves .build.log in cwd- git_ "push" []- putStrLn ""- rpkgBuild topdir dist nvr waitrepo- bodhiOverride dist nvr- unless (null rest) $ do+ srcs <- buildRequires spec >>= haskellSrcPkgs topdir dist+ hmissing <- nub <$> filterM (notInKoji branch topdir dist) srcs putStrLn ""- putStrLn $ show (length rest) +-+ "packages left"- build topdir Nothing (Just (pkg, nvr)) waitrepo Chain dist rest+ 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 =@@ -286,9 +294,9 @@ where prefix = pkg ++ "-" -bodhiOverride :: Dist -> String -> IO ()-bodhiOverride dist nvr =- when (distOverride dist) $+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]
src/Dist.hs view
@@ -1,5 +1,6 @@ module Dist (distArg,+ distOverride, distRemote, distTag, distTarget,@@ -8,21 +9,23 @@ where import Data.Maybe (fromMaybe)-import FedoraDists (Dist(..), distBranch)+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 == 31 = Just "ghc"+--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@@ -30,13 +33,13 @@ distArg = argumentWith auto "DIST" -- | Maps `Dist` to remote branch: eg "origin/master"-distRemote :: Dist -> String-distRemote d = "origin/" ++ distBranch d+distRemote :: Dist -> Dist -> String+distRemote branch d = "origin/" ++ distBranch branch d -- | Fedora release being tracked in Hackage Distro data hackageRelease :: Dist-hackageRelease = Fedora 31+hackageRelease = Fedora 35 -- | Stackage LTS stream major version ltsStream :: String-ltsStream = "lts-13"+ltsStream = "lts-16"
src/Koji.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Module : Koji -- Copyright : (C) 2016-2019 Jens Petersen@@ -18,6 +20,7 @@ kojicmd, kojiLatestPkg, kojiListPkgs,+ kojiListTags, kojiWaitPkg, notInKoji, rpkg,@@ -30,6 +33,7 @@ #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)@@ -37,8 +41,8 @@ import System.FilePath ((</>), (<.>)) import System.Process (readProcessWithExitCode, rawSystem) -import FedoraDists (Dist, kojicmd, rpkg)-import SimpleCmd (cmd, cmd_, cmdBool, cmdLines, grep_, logMsg,+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)@@ -100,10 +104,18 @@ kojiListPkgs dist = words <$> cmd (kojicmd dist) ["list-pkgs", "--tag=" ++ distTag dist] -rpkgBuild :: FilePath -> Dist -> String -> Bool -> IO ()-rpkgBuild topdir dist nvr waitrepo = do+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@@ -112,7 +124,6 @@ if success then do logMsg $ nvr ++ " built"- when waitrepo $ kojiWaitPkg topdir dist nvr else do now <- getCurrentTime -- koji srpms typically take 2 minutes@@ -155,7 +166,7 @@ when (null (out ++ err)) $ warning $ "\"" ++ c +-+ unwords as ++ "\"" +-+ "failed with status" +-+ show n unless (null err) $ warning err- threadDelay 2000000+ threadDelay (fromEnum (2 :: Micro)) cmdFragile c as cmdFragile_ :: String -> [String] -> IO ()@@ -165,6 +176,5 @@ ExitSuccess -> return () ExitFailure _ -> do warning $ "retrying \"" ++ c +-+ unwords as ++ "\""- threadDelay 2000000+ threadDelay (fromEnum (2 :: Micro)) cmdFragile_ c as-
src/RPM.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Module : RPM -- Copyright : (C) 2015-2019 Jens Petersen@@ -29,12 +31,12 @@ import Data.List (isPrefixOf, isSuffixOf, nub, (\\)) import Data.Maybe (isJust, isNothing) import System.Directory (doesDirectoryExist, findExecutable)-import System.FilePath ((</>))+import System.FilePath ((</>), takeDirectory) -- die is available in ghc-7.10 base-4.8 import System.Exit (ExitCode (..), exitFailure, exitWith) import Dist (distTag)-import FedoraDists (Dist, distBranch, dists, releaseVersion)+import Distribution.Fedora (Dist, distBranch, distVersion, getFedoraDists, getLatestFedoraDist) import SimpleCmd (cmd, removeStrictPrefix, removeSuffix, sudo_, warning, (+-+)) import qualified SimpleCmd.Rpm as S @@ -67,14 +69,16 @@ repoquery dist args = do havednf <- optionalProgram "dnf" let (prog, subcmd) = if havednf then ("dnf", ["repoquery", "--quiet"]) else ("repoquery", [])- releasever = ["--releasever=" ++ releaseVersion dist]+ branched <- getLatestFedoraDist+ let releasever = ["--releasever=" ++ distVersion branched dist] cmd prog (subcmd ++ releasever ++ args) repoquerySrc :: Dist -> String -> IO (Maybe String) repoquerySrc dist key = do havednf <- optionalProgram "dnf" let srcflag = if havednf then ["--qf=%{source_name}"] else ["--qf", "%{base_package_name}"]- repo = if dist `elem` dists+ 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])@@ -145,8 +149,9 @@ haskellSrcPkgs :: FilePath -> Dist -> [Package] -> IO [Package] haskellSrcPkgs topdir dist brs = do ghcLibs <- do- let branch = distBranch dist- ghcDir <- pkgDir "ghc" branch (topdir </> "..")+ branched <- getLatestFedoraDist+ let branch = distBranch branched dist+ ghcDir <- pkgDir "ghc" branch (takeDirectory topdir) map removeLibSuffix . filter isHaskellDevelPkg <$> rpmspec [] (Just "%{name}") (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
src/Utils.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Module : Cmd -- Copyright : (C) 2014, 2016-2018 Jens Petersen@@ -15,7 +17,8 @@ module Utils (checkPkgsGit, setTermTitle,- withCurrentDirectory) where+ withCurrentDirectory)+where import Control.Monad (when) #if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))@@ -51,7 +54,7 @@ checkPkgsGit :: IO Bool checkPkgsGit =- grepGitConfig "\\(pkgs\\|src\\)."+ grepGitConfig "@\\(pkgs\\|src\\)\\." -- git :: String -> [String] -> IO String -- git c as =