fedora-haskell-tools 0.4 → 0.5
raw patch · 8 files changed
+383/−290 lines, 8 files
Files
- Dists.hs +8/−6
- Koji.hs +23/−7
- RPM.hs +23/−32
- TODO +3/−0
- Utils.hs +41/−11
- fedora-haskell-tools.cabal +2/−1
- fhbuild.hs +228/−207
- fhpkg.hs +55/−26
Dists.hs view
@@ -28,6 +28,8 @@ rawhide) where import Data.Char (isNumber)+import Data.Maybe (fromMaybe, maybe)+ import Utils ((+-+)) type Dist = String@@ -38,6 +40,9 @@ rawhide :: String rawhide = "f28" +sidetag :: Maybe String+sidetag = Nothing -- Just "ghc"+ hackageRelease :: String hackageRelease = "f27" @@ -68,13 +73,10 @@ distOverride d = d `notElem` [rawhide, "f28" {-, "epel7"-}] distTag :: Dist -> String-distTag d {- | d == rawhide = "f28" ++ "-ghc" -}- {- | d == "epel7" = d ++ "-ghc" -}- {- | otherwise -} = d ++ "-build"+distTag d = d ++ "-" ++ fromMaybe "build" sidetag -distTarget :: Dist -> Maybe String-distTarget d | d `elem` [rawhide, "epel7"] = Nothing -- Just $ d ++ "-ghc"- | otherwise = Nothing+distTarget :: Dist -> String+distTarget d = maybe d (\ suff -> d ++ "-" ++ suff) sidetag releaseVersion :: Dist -> String releaseVersion r | r == rawhide = "rawhide"
Koji.hs view
@@ -19,22 +19,32 @@ #else import Control.Applicative ((<$>)) #endif+import Control.Monad (unless) import Data.List (isInfixOf)+import System.Directory (doesDirectoryExist) import System.FilePath ((</>)) import Dists (Dist)-import Utils (cmd, cmd_)+import Utils (cmd, cmd_, cmdBool) kojiLatestPkg :: Dist -> String -> IO String kojiLatestPkg dist pkg = do res <- words <$> cmd "koji" ["latest-pkg", "--quiet", dist, pkg] return $ if null res then "" else head res -kojiWaitPkg :: Dist -> String -> IO ()-kojiWaitPkg dist pkg = --do- cmd_ "koji" ["wait-repo", dist, "--build=" ++ pkg]- --putStrLn ""+kojiWaitPkg :: FilePath -> Dist -> String -> IO ()+kojiWaitPkg topdir dist nvr = do+ let fhbuilt = topdir </> ".fhbuilt"+ already <- kojiCheckFHBuilt topdir nvr+ unless already $ do+ cmd_ "koji" ["wait-repo", dist, "--build=" ++ nvr]+ appendFile fhbuilt $ nvr ++ "\n" +kojiCheckFHBuilt :: FilePath -> String -> IO Bool+kojiCheckFHBuilt topdir nvr = do+ let fhbuilt = topdir </> ".fhbuilt"+ cmdBool "grep" ["-q", nvr, fhbuilt]+ kojiBuilding :: String -> String -> IO Bool kojiBuilding pkg build = do tasks <- lines <$> cmd "koji" ["list-tasks", "--mine", "--quiet"]@@ -48,11 +58,17 @@ notInKoji :: String -> FilePath -> String -> String -> IO Bool notInKoji branch topdir tag pkg = do latest <- kojiLatestPkg tag pkg- local <- cmd "fedpkg" ["--path", topdir </> pkg </> branch, "verrel"]+ pkgpath <- pkgDir pkg branch topdir+ local <- cmd "fedpkg" ["--path", pkgpath, "verrel"] if latest == local- then kojiWaitPkg tag latest >> return False+ then kojiWaitPkg topdir tag latest >> return False else return True kojiListPkgs :: Dist -> IO [String] kojiListPkgs dist = words <$> cmd "koji" ["list-pkgs", "--tag=" ++ dist]++pkgDir :: String -> String -> FilePath -> IO FilePath+pkgDir dir branch top = do+ b <- doesDirectoryExist $ top </> dir </> branch+ return $ top </> dir </> if b then branch else ""
RPM.hs view
@@ -17,23 +17,21 @@ rpmInstall, rpmspec) where -import Control.Monad (unless, when)-import Data.List (elemIndices)+import Control.Monad (when) import Data.Maybe (isJust, isNothing) import System.Directory (findExecutable)+import System.FilePath ((</>)) -- die is available in ghc-7.10 base-4.8 import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) -import Utils (cmd, cmdStdErr, singleLine, sudo)+import Dists (Dist, distTag)+import Utils (cmd, sudo) -- @since base 4.8.0.0 die :: String -> IO a die err = hPutStrLn stderr err >> exitFailure -warn :: String -> IO ()-warn = hPutStrLn stderr- requireProgram :: String -> IO () requireProgram c = do mavail <- findExecutable c@@ -57,37 +55,30 @@ let (inst, arg) = if pkginstaller == "dnf" then ("dnf", "install") else ("yum", "localinstall") sudo inst $ ["-y", "--nogpgcheck", arg] ++ rpms -repoquery :: [String] -> String -> IO String-repoquery args key = do+repoquery :: String -> [String] -> IO String+repoquery relver args = do havednf <- optionalProgram "dnf" let (prog, subcmd) = if havednf then ("dnf", ["repoquery", "--quiet"]) else ("repoquery", [])- repoqWrap prog (subcmd ++ args ++ [key])+ cmd prog (subcmd ++ ["--releasever=" ++ relver] ++ args) -repoqWrap :: String -> [String] -> IO String-repoqWrap c args = do- (out, err) <- cmdStdErr c args- -- workaround noisy dnf2 repoquery --quiet- -- ignore "Last metadata expiration check" warnings- unless (null err || head (words err) == "Last") $- warn err- return $ singleLine out+-- repoqWrap :: String -> [String] -> IO String+-- repoqWrap c args = do+-- (out, err) <- cmdStdErr c args+-- -- workaround noisy dnf2 repoquery --quiet+-- -- ignore "Last metadata expiration check" warnings+-- unless (null err || head (words err) == "Last") $+-- warn err+-- return $ singleLine out -repoquerySrc :: String -> IO (Maybe String)-repoquerySrc key = do+repoquerySrc :: Dist -> String -> String -> IO (Maybe String)+repoquerySrc dist relver key = do havednf <- optionalProgram "dnf"- let (prog, subcmd) = if havednf then ("dnf", ["repoquery", "--quiet", "-s"]) else ("repoquery", ["--qf", "%{base_package_name}", "--whatprovides"])- res <- repoqWrap prog (subcmd ++ [key])- if null res then return Nothing- else return $ Just $ nvrToName res--nvrToName :: String -> String-nvrToName nvr =- if length dashes < 2- then error $ "malformed NVR string: '" ++ nvr ++ "'"- else take nameDash nvr- where- dashes = elemIndices '-' nvr- nameDash = last $ init dashes+ let srcflag = if havednf then ["--qf=%{source_name}"] else ["--qf", "%{base_package_name}"]+ res <- words <$> repoquery relver (srcflag ++ ["--repofrompath", "koji,http://kojipkgs.fedoraproject.org/repos" </> distTag dist </> "latest/x86_64/", "--whatprovides", key])+ return $ case res of+ [p] -> Just p+ ps | key `elem` ps -> Just key+ _ -> Nothing rpmspec :: [String] -> Maybe String -> FilePath -> IO String rpmspec args mqf spec = do
TODO view
@@ -24,6 +24,9 @@ - copr support - parallel/async building - cache passwd for bodhi+- do not downgrade versions+- --liberal (allow failures)+- reconnect to koji when disconnected (build or wait-repo) # updating - port update-pkg-ver
Utils.hs view
@@ -13,7 +13,24 @@ -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -module Utils where+module Utils (checkFedoraPkgGit,+ cmd,+ cmd_,+ cmdBool,+ cmdlog,+ cmdMaybe,+ cmdN,+ cmdSilent,+ cmdStdErr,+ error_,+ logMsg,+ maybeRemovePrefix,+ removePrefix,+ removeSuffix,+ singleLine,+ sudo,+ withCurrentDirectory,+ (+-+) ) where #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else@@ -26,9 +43,10 @@ import System.Process (readProcess, readProcessWithExitCode, rawSystem) #if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))+import System.Directory (withCurrentDirectory) #else import Control.Exception (bracket)-import System.Directory ( getCurrentDirectory, setCurrentDirectory)+import System.Directory (getCurrentDirectory, setCurrentDirectory) #endif infixr 4 +-+@@ -78,14 +96,14 @@ -- dry-run cmdN :: String -> [String] -> IO ()-cmdN c as = putStrLn $ c +-+ show as+cmdN c as = putStrLn $ c +-+ unwords as -cmdAssert :: String -> String -> [String] -> IO ()-cmdAssert msg c as = do- ret <- rawSystem c as- case ret of- ExitSuccess -> return ()- ExitFailure _ -> error msg+--cmdAssert :: String -> String -> [String] -> IO ()+--cmdAssert msg c as = do+-- ret <- rawSystem c as+-- case ret of+-- ExitSuccess -> return ()+-- ExitFailure _ -> error msg cmdlogStdIn :: String -> [String] -> String -> IO () cmdlogStdIn c as inp = do@@ -108,11 +126,19 @@ ExitSuccess -> return True ExitFailure _ -> return False +-- hide stdout+cmdSilent :: String -> [String] -> IO ()+cmdSilent c args = do+ (ret, _, err) <- readProcessWithExitCode c args ""+ case ret of+ ExitSuccess -> return ()+ ExitFailure n -> error $ "\"" ++ c +-+ unwords args ++ "\"" +-+ "failed with status" +-+ show n ++ "\n" ++ err+ sudo :: String -> [String] -> IO () sudo c as = cmdlog "sudo" (c:as) -shell :: String -> IO String-shell c = cmd "sh" ["-c", c]+--shell :: String -> IO String+--shell c = cmd "sh" ["-c", c] removePrefix :: String -> String -> String removePrefix prefix orig =@@ -143,3 +169,7 @@ setCurrentDirectory dir action #endif++checkFedoraPkgGit :: IO Bool+checkFedoraPkgGit =+ cmdBool "grep" ["-q", "-e", "\\(pkgs\\|src\\).fedoraproject.org", ".git/config"]
fedora-haskell-tools.cabal view
@@ -1,5 +1,5 @@ Name: fedora-haskell-tools-Version: 0.4+Version: 0.5 Synopsis: Building and managing tools for Fedora Haskell Description: Tools for building and managing Fedora Haskell packages.@@ -50,6 +50,7 @@ unix Other-modules: Dists, Koji,+ RPM, Utils GHC-options: -fwarn-missing-signatures -Wall Extensions: CPP
fhbuild.hs view
@@ -20,7 +20,7 @@ #endif import Control.Monad (filterM, unless, when) import Data.Maybe-import Data.List (intercalate, isPrefixOf, nub, (\\))+import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, (\\)) import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, setCurrentDirectory)@@ -29,13 +29,16 @@ import System.FilePath ((</>), dropExtension) import System.IO (hPutStrLn, stderr) -import Dists (Dist, dists, distBranch, distOverride, distTag, distTarget)-import Koji (kojiBuilding, kojiLatestPkg, kojiWaitPkg, notInKoji)-import RPM (packageManager, rpmInstall, repoquery, repoquerySrc, rpmspec)-import Utils ((+-+), cmd, cmd_, cmdBool, cmdMaybe, cmdlog, error_, logMsg,- removePrefix, removeSuffix, sudo)+import Dists (Dist, dists, distBranch, distOverride, distTag, distTarget,+ releaseVersion)+import Koji (kojiBuilding, kojiCheckFHBuilt, kojiLatestPkg, kojiWaitPkg,+ notInKoji, pkgDir)+import RPM (packageManager, rpmInstall, repoquerySrc, rpmspec)+import Utils ((+-+), checkFedoraPkgGit, cmd, cmd_, cmdBool, cmdMaybe, cmdlog,+ logMsg, removePrefix, removeSuffix, sudo) -data Command = Install | Mock | Koji | Chain | Pending | Changed | Built deriving (Eq)+data Command = Install | Mock | Koji | Chain | Pending | Changed | Built | Bump+ deriving (Eq) main :: IO () main = do@@ -53,10 +56,12 @@ mode "pending" = Pending mode "changed" = Changed mode "built" = Built+ mode "bump" = Bump mode _ = error "Unknown command" commands :: [String]-commands = ["install", "mock" , "koji", "chain", "pending", "changed", "built"]+commands = ["install", "mock" , "koji", "chain", "pending", "changed", "built", + "bump"] help :: IO () help = do@@ -71,6 +76,7 @@ ++ " pending\t- show planned changes\n" ++ " changed\t- show changed pkgs\n" ++ " built\t\t- show pkgs whose NVR already built\n"+ ++ " bump\t\t- bump release for NVRs already built\n" exitWith (ExitFailure 1) type Arguments = Maybe (String, Dist, [String])@@ -85,7 +91,7 @@ giveUp :: String -> IO Arguments giveUp err = do hPutStrLn stderr err- help >> return Nothing+ return Nothing build :: FilePath -> Command -> Dist -> Maybe String -> Maybe (String, String) -> Bool -> [String] -> IO () build _ _ _ _ _ _ [] = return ()@@ -100,73 +106,77 @@ cmdlog "fedpkg" $ ["clone", "-b", branch, pkg] ++ anon wd <- pkgDir pkg branch "" setCurrentDirectory wd- retired <- doesFileExist "dead.package"- if retired then do- unless (mode == Pending) $- putStrLn "skipping dead.package"- build topdir mode dist Nothing Nothing False rest+ ignore <- doesFileExist ".fhbuild-ignore"+ if ignore && mode `elem` [Install, Koji, Chain, Mock] then putStrLn "ignored" else do- pkggit <- do- gd <- doesFileExist ".git/config"- if gd then cmdBool "grep" ["-q", "pkgs.fedoraproject.org", ".git/config"]- 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 mode dist Nothing Nothing False rest+ 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 == Pending) $+ putStrLn "skipping dead.package"+ build topdir mode dist Nothing Nothing False rest else do- when dirExists $ do- actual <- gitBranch- when (branch /= actual) $- cmd_ "fedpkg" ["switch-branch", branch]- cmd_ "git" ["pull", "-q"]- -- noupdate <- doesFileExist ".noupdate"- -- unless noupdate $- -- void $ cmdBool "cabal-rpm" ["update"]- let spec = pkg ++ ".spec"- hasSpec <- doesFileExist spec- if not hasSpec- then putStrLn $ "No" +-+ spec+ pkggit <- do+ gd <- doesFileExist ".git/config"+ if gd then checkFedoraPkgGit+ 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 mode dist Nothing Nothing False rest else do- nvr <- cmd "fedpkg" ["verrel"]- let verrel = removePrefix (pkg ++ "-") nvr- release = tail $ dropWhile (/= '-') verrel- tag = distTag dist- case mode of- Install -> do- let req = fromMaybe pkg msubpkg- installed <- cmdMaybe "rpm" ["-q", "--qf", "%{name}-%{version}-%{release}", req]- if Just (req ++ "-" ++ verrel) == installed- then putStrLn $ nvr +-+ "already installed!\n"- else do- putStrLn $ fromMaybe "Not installed" installed +-+ "->" +-+ nvr- cmd_ "git" ["--no-pager", "log", "-1"]- putStrLn ""- putStrLn "Repoquerying deps..."- brs <- buildRequires spec- missing <- catMaybes <$> (nub <$> filterM notInstalled brs >>= mapM derefSrcPkg)- -- FIXME sort into build order- let hmissing = filter (\ dp -> "ghc-" `isPrefixOf` dp || dp `elem` ["alex", "cabal-install", "gtk2hs-buildtools", "happy"]) missing- unless (null hmissing) $ do- putStrLn "Missing:"- mapM_ putStrLn hmissing- build topdir Install dist Nothing Nothing False hmissing- setCurrentDirectory $ topdir </> wd- stillMissing <- filterM notInstalled missing- unless (null stillMissing) $ do- putStrLn $ "Installing:" +-+ intercalate ", " stillMissing- rpmInstall stillMissing- let logfile = ".build-" ++ verrel ++ ".log"- putStrLn ""- putStrLn $ "Building" +-+ nvr- putStrLn $ "To watch: tail -f" +-+ wd </> logfile- -- note "fedpkg --path dir local" saves .build.log in cwd- _out <- cmd "fedpkg" ["local"]- opkgs <- lines <$> rpmspec [] (Just "%{name}\n") spec- rpms <- lines <$> rpmspec [] (Just ("%{arch}/%{name}-%{version}-" ++ release ++ ".%{arch}.rpm\n")) spec- built <- and <$> mapM doesFileExist rpms- if built- then do+ when dirExists $ do+ actual <- gitBranch+ when (branch /= actual) $+ cmd_ "fedpkg" ["switch-branch", branch]+ cmd_ "git" ["pull", "-q"]+ -- noupdate <- doesFileExist ".noupdate"+ -- unless noupdate $+ -- void $ cmdBool "cabal-rpm" ["update"]+ let spec = pkg ++ ".spec"+ hasSpec <- doesFileExist spec+ if not hasSpec+ then putStrLn $ "No" +-+ spec+ else do+ nvr <- cmd "fedpkg" ["verrel"]+ let verrel = removePrefix (pkg ++ "-") nvr+ release = tail $ dropWhile (/= '-') verrel+ tag = distTag dist+ relver = releaseVersion dist+ case mode of+ Install -> do+ let req = fromMaybe pkg msubpkg+ installed <- cmdMaybe "rpm" ["-q", "--qf", "%{name}-%{version}-%{release}", req]+ if Just (req ++ "-" ++ verrel) == installed+ then putStrLn $ nvr +-+ "already installed!\n"+ else do+ putStrLn $ fromMaybe "Not installed" installed +-+ "->" +-+ nvr+ cmd_ "git" ["--no-pager", "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 relver) hmissing+ unless (null srcs) $ do+ putStrLn "Missing:"+ mapM_ putStrLn srcs+ build topdir Install dist Nothing Nothing False 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 "fedpkg" ["local"]+ unless success+ fhbuildFail+ opkgs <- lines <$> rpmspec ["--builtrpms"] (Just "%{name}\n") spec+ rpms <- lines <$> rpmspec ["--builtrpms"] (Just ("%{arch}/%{name}-%{version}-" ++ release ++ ".%{arch}.rpm\n")) spec putStrLn $ nvr +-+ "built\n" instpkgs <- lines <$> cmd "rpm" ("-qa":opkgs) if null instpkgs@@ -177,115 +187,117 @@ -- sudo pkgmgr ("--setopt=clean_requirements_on_remove=no":"remove":"-y":instpkgs) sudo pkgmgr ("install":"-y":rpms) setCurrentDirectory topdir- else do- displayLogTail logfile- error_ $ "Build of " ++ nvr ++ " failed!"- build topdir Install dist Nothing Nothing False rest- Mock -> do- putStrLn $ "Mock building" +-+ nvr- cmdlog "fedpkg" ["mockbuild"]- build topdir Mock dist Nothing Nothing False rest- Koji -> do- putStrLn "'koji' mode is deprecated, please use 'chain'"- unless (null rest) $ do- putStrLn $ show (length rest) +-+ "packages left"- putStrLn ""- latest <- kojiLatestPkg tag pkg- if nvr == latest- then do- putStrLn $ nvr +-+ "already built!"- kojiWaitPkg tag nvr- print mlast- build topdir Koji dist Nothing mlast False rest- else do- building <- kojiBuilding pkg nvr- if building+ build topdir Install dist Nothing Nothing False rest+ Mock -> do+ putStrLn $ "Mock building" +-+ nvr+ cmdlog "fedpkg" ["mockbuild"]+ build topdir Mock dist Nothing Nothing False rest+ Koji -> do+ putStrLn "'koji' mode is deprecated, please use 'chain'"+ unless (null rest) $ do+ putStrLn $ show (length rest) +-+ "more packages"+ putStrLn ""+ latest <- kojiLatestPkg tag pkg+ if nvr == latest then do- putStrLn $ nvr +-+ "is already building"- kojiWaitPkg tag nvr- build topdir Koji dist Nothing Nothing False rest+ putStrLn $ nvr +-+ "already built!"+ kojiWaitPkg topdir tag nvr+ build topdir Koji dist Nothing mlast False rest else do- print mlast- case mlast of- Nothing -> return ()- Just (pkg', nvr') -> do- dep <- dependent pkg' pkg branch topdir+ building <- kojiBuilding pkg nvr+ if building+ then do+ putStrLn $ nvr +-+ "is already building"+ kojiWaitPkg topdir tag nvr+ build topdir Koji dist Nothing Nothing False rest+ else do+ case mlast of+ Nothing -> return ()+ Just (pkg', nvr') -> do+ dep <- dependent pkg' pkg branch topdir+ when dep $ do+ putStrLn $ "Waiting for" +-+ nvr'+ kojiWaitPkg topdir tag nvr'+ showChange latest nvr+ cmd_ "git" ["push"]+ fedpkgBuild topdir dist nvr (if waitrepo then Just tag else Nothing)+ bodhiOverride dist nvr+ unless (null rest) $ do+ dep <- dependent pkg (head rest) branch topdir when dep $ do- putStrLn $ "Waiting for" +-+ nvr'- kojiWaitPkg tag nvr'- showChange latest nvr- cmd_ "git" ["push"]- fedpkgBuild dist nvr (if waitrepo then Just tag else Nothing)- bodhiOverride dist nvr- unless (null rest) $ do- dep <- dependent pkg (head rest) branch topdir- when dep $ do- putStrLn $ "Waiting for" +-+ nvr- kojiWaitPkg tag nvr- build topdir Koji dist Nothing (if dep then Just (pkg, nvr) else Nothing) False rest- Pending -> do- latest <- kojiLatestPkg tag pkg- unless (eqNVR nvr latest) $- putStrLn $ latest +-+ "->" +-+ nvr- build topdir Pending dist Nothing Nothing False rest- Changed -> do- latest <- kojiLatestPkg tag pkg- unless (eqNVR nvr latest) $- putStrLn pkg- build topdir Changed dist Nothing Nothing False rest- Built -> do- latest <- kojiLatestPkg tag pkg- when (eqNVR nvr latest) $- putStrLn pkg- build topdir Built dist Nothing Nothing False rest- Chain -> do- latest <- kojiLatestPkg tag pkg- if nvr == latest- then do- putStrLn $ nvr +-+ "already built!"- unless (null rest) $ --do- --kojiWaitPkg tag nvr- build topdir Chain dist Nothing Nothing False rest- else do- building <- kojiBuilding pkg nvr- if building+ putStrLn $ "Waiting for" +-+ nvr+ kojiWaitPkg topdir tag nvr+ build topdir Koji dist Nothing (if dep then Just (pkg, nvr) else Nothing) False rest+ Pending -> do+ latest <- kojiLatestPkg tag pkg+ unless (eqNVR nvr latest) $+ putStrLn $ latest +-+ "->" +-+ nvr+ build topdir Pending dist Nothing Nothing False rest+ Changed -> do+ latest <- kojiLatestPkg tag pkg+ unless (eqNVR nvr latest) $+ putStrLn pkg+ build topdir Changed dist Nothing Nothing False rest+ Built -> do+ latest <- kojiLatestPkg tag pkg+ when (eqNVR nvr latest) $+ putStrLn pkg+ build topdir Built dist Nothing Nothing False rest+ Bump -> do+ latest <- kojiLatestPkg tag pkg+ when (eqNVR nvr latest) $ do+ putStrLn pkg+ cmd_ "rpmdev-bumpspec" ["-c", "rebuild", spec]+ cmd_ "fedpkg" ["commit", "-m", "bump release"]+ build topdir Bump dist Nothing Nothing False rest+ Chain -> do+ fhbuilt <- kojiCheckFHBuilt topdir nvr+ latest <- if fhbuilt+ then return nvr+ else kojiLatestPkg tag pkg+ if nvr == latest then do- putStrLn $ nvr +-+ "is already building"+ putStrLn $ nvr +-+ "already built!" unless (null rest) $ --do- --kojiWaitPkg tag nvr+ --kojiWaitPkg topdir tag nvr build topdir Chain dist Nothing Nothing False rest else do- showChange latest nvr- putStrLn "Repoquerying deps..."- brs <- buildRequires spec- --print brs- -- FIXME sort into build order- let hdeps = filter (\ dp -> "ghc-" `isPrefixOf` dp || dp `elem` ["alex", "cabal-install", "gtk2hs-buildtools", "happy"]) (brs \\ ["ghc-rpm-macros", "ghc-rpm-macros-extra", "ghc-Cabal-devel"])- --print hdeps- srcs <- filter (`notElem` ["ghc"]) . catMaybes . nub <$> mapM derefSrcPkg hdeps- --print srcs- hmissing <- nub <$> filterM (notInKoji branch topdir tag) srcs- putStrLn ""- unless (null hmissing) $ do- putStrLn "Missing:"- mapM_ putStrLn hmissing- build topdir Chain dist Nothing Nothing True hmissing- setCurrentDirectory $ topdir </> wd+ building <- kojiBuilding pkg nvr+ if building+ then do+ putStrLn $ nvr +-+ "is already building"+ kojiWaitPkg topdir tag nvr+ unless (null rest) $+ build topdir Chain dist Nothing Nothing False rest+ else do+ showChange latest nvr+ brs <- buildRequires spec+ --print brs+ ghcLibs <- do+ ghcDir <- pkgDir "ghc" branch topdir+ filter isHaskellDevelPkg . words <$> rpmspec [] (Just "%{name}\n") (ghcDir </> "ghc.spec")+ -- FIXME sort into build order+ let hdeps = filter (\ dp -> "ghc-" `isPrefixOf` dp || dp `elem` ["alex", "cabal-install", "gtk2hs-buildtools", "happy"]) (brs \\ (["ghc-rpm-macros", "ghc-rpm-macros-extra"] ++ ghcLibs))+ --print hdeps+ srcs <- filter (`notElem` ["ghc"]) . nub <$> mapM (derefSrcPkg topdir dist relver) hdeps+ --print srcs+ hmissing <- nub <$> filterM (notInKoji branch topdir tag) srcs putStrLn ""- -- note "fedpkg --path dir local" saves .build.log in cwd- cmd_ "git" ["push"]- putStrLn ""- fedpkgBuild dist nvr (if waitrepo then Just tag else Nothing)- bodhiOverride dist nvr- unless (null rest) $ do+ unless (null hmissing) $ do+ putStrLn "Missing:"+ mapM_ putStrLn hmissing+ build topdir Chain dist Nothing Nothing True hmissing+ setCurrentDirectory $ topdir </> wd+ putStrLn ""+ -- note "fedpkg --path dir local" saves .build.log in cwd+ cmd_ "git" ["push"] putStrLn ""- putStrLn $ show (length rest) +-+ "packages left"- build topdir Chain dist Nothing (Just (pkg, nvr)) waitrepo rest--pkgDir :: String -> String -> FilePath -> IO FilePath-pkgDir dir branch top = do- b <- doesDirectoryExist $ top </> dir </> branch- return $ top </> dir </> if b then branch else ""+ fedpkgBuild topdir dist nvr (if waitrepo then Just tag else Nothing)+ bodhiOverride dist nvr+ unless (null rest) $ do+ putStrLn ""+ putStrLn $ show (length rest) +-+ "packages left"+ build topdir Chain dist Nothing (Just (pkg, nvr)) waitrepo rest maybePkgVer :: String -> Maybe String -> String maybePkgVer pkg mver = pkg ++ maybe "" ("-" ++) mver@@ -300,11 +312,14 @@ putStrLn "" putStrLn $ latest +-+ "->" +-+ nvr ++ "\n" -fedpkgBuild :: Dist -> String -> Maybe String -> IO ()-fedpkgBuild dist nvr waittag = do- cmd_ "fedpkg" $ "build" : maybe [] (\ d -> "--target":[d]) (distTarget dist)+fedpkgBuild :: FilePath -> Dist -> String -> Maybe String -> IO ()+fedpkgBuild topdir dist nvr waittag = do+ giturl <- cmd "fedpkg" ["giturl"]+ success <- cmdBool "koji" ["build", "--fail-fast", distTarget dist, giturl]+ unless success+ fhbuildFail logMsg $ nvr +-+ "built"- maybe (return ()) (`kojiWaitPkg` nvr) waittag+ maybe (return ()) (\ t -> kojiWaitPkg topdir t nvr) waittag bodhiOverride :: Dist -> String -> IO () bodhiOverride dist nvr =@@ -312,45 +327,43 @@ -- FIXME: improve Notes with recursive info cmd_ "bodhi" ["overrides", "save", "--notes", "Haskell stack", nvr] --- dereference meta BRs-whatProvides :: String -> IO String-whatProvides pkg = do- res <- repoquery ["--qf", "%{name}", "--whatprovides"] pkg- --print res- when (null res) $ do- installed <- not <$> notInstalled pkg- unless installed $ putStrLn $ "Warning:" +-+ pkg +-+ "not found by repoquery"- return $ if null res then pkg else res+-- -- dereference meta BRs+-- whatProvides :: String -> String -> IO String+-- whatProvides relver pkg = do+-- res <- repoquery relver ["--qf", "%{name}", "--whatprovides", pkg]+-- --print res+-- when (null res) $ do+-- installed <- not <$> notInstalled pkg+-- unless installed $ putStrLn $ "Warning:" +-+ pkg +-+ "not found by repoquery"+-- return $ if null res then pkg else res buildRequires :: FilePath -> IO [String] buildRequires spec =- (map (head . words) . lines) <$> rpmspec ["--buildrequires"] Nothing spec >>= mapM whatProvides+ -- FIXME should resolve "pkgconfig()" etc+ (map (head . words) . lines) <$> rpmspec ["--buildrequires"] Nothing spec+-- >>= mapM (whatProvides relver) -derefSrcPkg :: String -> IO (Maybe String)-derefSrcPkg pkg = do- res <- repoquerySrc pkg- --putStrLn $ pkg +-+ "->" +-+ show res- case res of- -- maybe package has never been built yet- Nothing -> do- let base = removeSuffix "-devel" pkg- p <- pkgdb base- if isJust p- then return p- else pkgdb $ removePrefix "ghc-" base- Just s -> return $ Just s+derefSrcPkg :: FilePath -> Dist -> String -> String -> IO String+derefSrcPkg topdir dist relver pkg =+ if isHaskellDevelPkg pkg+ then+ do let base = removeSuffix "-devel" pkg+ dirExists <- doesDirectoryExist $ topdir </> base+ if dirExists then return base else derefSrcPkg topdir dist relver base+ else+ do putStrLn $ "Repoquerying" +-+ pkg+ res <- repoquerySrc dist relver pkg+ putStrLn $ pkg +-+ "->" +-+ show res+ case res of+ Nothing ->+ do putStrLn $ "Unknown package" +-+ removeSuffix "-devel" pkg+ fhbuildFail+ Just s -> return s gitBranch :: IO String gitBranch = (removePrefix "* " . head . filter (isPrefixOf "* ") . lines) <$> cmd "git" ["branch"] -pkgdb :: String -> IO (Maybe String)-pkgdb pkg = do- res <- fmap words <$> cmdMaybe "pkgdb-cli" ["list", "--nameonly", pkg]- return $ case res of- (Just ps) | pkg `elem` ps -> Just pkg- _ -> Nothing- eqNVR :: String -> String -> Bool eqNVR p1 p2 = dropExtension p1 == dropExtension p2@@ -373,3 +386,11 @@ disp = 12 start = length ls - (disp + foot) mapM_ putStrLn $ take disp $ drop start ls++fhbuildFail :: IO a+fhbuildFail = --do+ --cmdlog "touch" [".fhbuild-fail"]+ exitWith (ExitFailure 1)++isHaskellDevelPkg :: String -> Bool+isHaskellDevelPkg pkg = "ghc-" `isPrefixOf` pkg && ("-devel" `isSuffixOf` pkg)
fhpkg.hs view
@@ -31,11 +31,7 @@ import Data.List (isInfixOf, isPrefixOf, nub, sort, (\\)) import System.Directory (doesDirectoryExist, doesFileExist,- setCurrentDirectory,-#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))- withCurrentDirectory-#endif- )+ getHomeDirectory, setCurrentDirectory) import System.Environment (getArgs, getProgName) import System.Exit (ExitCode (..), exitWith) import System.FilePath ((</>))@@ -44,14 +40,9 @@ import Dists (Dist, dists, distBranch, hackageRelease, releaseVersion) import Koji (kojiListPkgs)-import RPM (rpmspec)-import Utils ((+-+), cmd, cmd_, cmdBool, cmdMaybe, maybeRemovePrefix,- removePrefix,-#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))-#else- withCurrentDirectory-#endif- )+import RPM (repoquery, rpmspec)+import Utils ((+-+), checkFedoraPkgGit, cmd, cmd_, cmdBool, cmdMaybe, cmdSilent,+ maybeRemovePrefix, removePrefix, withCurrentDirectory) main :: IO () main = do@@ -73,14 +64,27 @@ withPackages mdist new $ repoAction_ True False mdist (return ()) "pull" -> withPackages mdist pkgs $ repoAction_ True False mdist (cmd_ "git" ["pull", "--rebase"])+ "push" -> withPackages mdist pkgs $+ repoAction_ True False mdist (cmd_ "git" ["push"]) "diff" -> withPackages mdist pkgs $- repoAction_ True False mdist (cmd_ "git" ["--no-pager", "diff"])+ repoAction_ False False mdist (cmd_ "git" ["--no-pager", "diff"])+ "diff-origin" -> withPackages mdist pkgs $+ repoAction_ True False mdist (cmd_ "git" ["--no-pager", "diff", "origin"]) "diff-branch" -> withPackages mdist pkgs $ repoAction False True mdist compareRawhide "diff-stackage" -> withPackages mdist pkgs $ repoAction True True mdist compareStackage "verrel" -> withPackages mdist pkgs $ repoAction_ False True mdist (cmd_ "fedpkg" ["verrel"])+ "update" -> withPackages mdist pkgs $+ repoAction True True mdist updatePackage+ "refresh" -> withPackages mdist pkgs $+ repoAction_ True True mdist (cmd_ "cabal-rpm" ["refresh"])+ "prep" -> withPackages mdist pkgs $+ repoAction_ True True mdist (cmd_ "fedpkg" ["prep"])+ "commit" -> withPackages mdist pkgs $+ -- need to handle passing commit message+ repoAction_ True True mdist (commitChanges "") "subpkgs" -> withPackages mdist pkgs $ repoAction True True mdist (\ p -> rpmspec [] (Just "%{name}-%{version}") (p ++ ".spec") >>= putStrLn) "new" -> newPackages mdist >>= mapM_ putStrLn@@ -95,12 +99,18 @@ ("clone-new", "clone new packages"), ("count", "count number of packages"), ("diff", "git diff"),+ ("diff-origin", "git diff origin"), ("diff-branch","compare branch with master"), ("diff-stackage","compare with stackage"), ("hackage", "generate Hackage distro data"), ("list", "list packages"), ("new", "new unbuilt packages"),- ("pull", "pull repos"),+ ("prep", "fedpkg prep"),+ ("commit", "fedpkg commit"),+ ("pull", "git pull repos"),+ ("push", "git push repos"),+ ("update", "cabal-rpm update"),+ ("refresh", "cabal-rpm refresh"), ("subpkgs", "list subpackages"), ("verrel", "show nvr of packages")] @@ -152,7 +162,7 @@ repoqueryHackageCSV mdist pkgs = do let relver = maybe "rawhide" releaseVersion mdist -- Hackage csv chokes on final newline so remove it- init . unlines . sort . map (replace "\"ghc-" "\"") . lines <$> cmd "dnf" (["repoquery", "--quiet", "--releasever=" ++ relver, "--latest-limit=1", "-q", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{name}\""] ++ pkgs) >>= putStr+ init . unlines . sort . map (replace "\"ghc-" "\"") . lines <$> repoquery relver (["--disablerepo=*", "--enablerepo=fedora", "--enablerepo=updates", "--latest-limit=1", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{name}\""] ++ pkgs) >>= putStr replace :: Eq a => [a] -> [a] -> [a] -> [a] replace a b s@(x:xs) =@@ -164,11 +174,9 @@ repoqueryHaskell :: Bool -> Maybe Dist -> IO [Package] repoqueryHaskell verbose mdist = do -- fixme: should use repoquery instead:- base <- cmd "ghc-pkg" ["--simple-output", "list", "base"]- ghcver <- cmd "ghc" ["--numeric-version"] let relver = maybe "rawhide" releaseVersion mdist when verbose $ putStrLn "Getting packages from repoquery"- bin <- words <$> cmd "dnf" ["repoquery", "--quiet", "--releasever=" ++ relver, "--whatrequires", "libHS" ++ base ++ "-ghc" ++ ghcver ++ ".so()(64bit)", "--qf=%{source_name}"]+ bin <- words <$> repoquery relver ["--qf=%{source_name}", "--whatrequires", "libHSbase-*-ghc*.so()(64bit)"] when (null bin) $ error "No libHSbase consumers found!" return $ sort $ nub bin @@ -188,9 +196,11 @@ putStrLn $ "\n==" +-+ pkg ++ (if branchGiven then ":" ++ branch else "") +-+ "==" -- muser <- getEnv "USER" -- let anon = "-a"+ home <- getHomeDirectory+ haveSSH <- doesFileExist $ home </> ".ssh/id_rsa" dirExists <- doesDirectoryExist pkg unless dirExists $- cmd_ "fedpkg" $ ["clone"] ++ (if branchGiven then ["-b", branch] else ["-B"]) ++ [pkg]+ cmd_ "fedpkg" $ ["clone"] ++ ["-a" | not haveSSH] ++ (if branchGiven then ["-b", branch] else ["-B"]) ++ [pkg] singleDir <- doesFileExist $ pkg </> ".git/config" unless singleDir $ do branchDir <- doesDirectoryExist $ pkg </> branch@@ -202,7 +212,7 @@ pkggit <- do gd <- doesFileExist ".git/config" if gd- then cmdBool "grep" ["-q", "pkgs.fedoraproject.org", ".git/config"]+ then checkFedoraPkgGit else return False unless pkggit $ error $ "not a Fedora pkg git dir!:" +-+ wd@@ -243,12 +253,31 @@ compareRawhide :: Package -> IO () compareRawhide p = do- nvr <- rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") (p ++ ".spec")- nvr' <- withCurrentDirectory "../master" $- rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") (p ++ ".spec")- when (removeDisttag nvr /= removeDisttag nvr') $ do+ let spec = p ++ ".spec"+ nvr <- removeDisttag <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec+ nvr' <- withCurrentDirectory "../master" $ do+ haveSpec <- doesFileExist spec+ unless haveSpec $ cmdSilent "git" ["pull"]+ removeDisttag <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec+ if nvr == nvr'+ then putStrLn nvr+ else do putStrLn nvr putStrLn nvr'- putStrLn ""+ putStrLn "" where removeDisttag = reverse . tail . dropWhile (/= '.') . reverse++updatePackage :: Package -> IO ()+updatePackage pkg = do+ hckg <- cmdBool "grep" ["-q", "hackage.haskell.org/package/", pkg ++ ".spec"]+ if hckg+ then cmd_ "cabal-rpm" ["update"]+ else putStrLn "skipping since not hackage"++commitChanges :: String -> IO ()+commitChanges msg = do+ chgs <- cmd "git" ["diff"]+ if null chgs+ then putStrLn "no changes"+ else cmd_ "fedpkg" ["commit", "-m", msg]