fedora-haskell-tools 0.3 → 0.4
raw patch · 8 files changed
+160/−56 lines, 8 files
Files
- ChangeLog +7/−0
- Dists.hs +6/−3
- README.md +3/−0
- RPM.hs +10/−4
- Utils.hs +19/−0
- fedora-haskell-tools.cabal +4/−3
- fhbuild.hs +4/−4
- fhpkg.hs +107/−42
ChangeLog view
@@ -1,3 +1,10 @@+* 0.4 (2017-12-05)+- new commands: clone-new, diff-stackage, diff-branch+- fix hackage distro data output+- check spec file exists+- fix cloning of missing branch dirs+- allow no dist arg before pkg arg+ * 0.3 (2017-10-24) - initial release with fhbuild, fhbz, and fhpkg
Dists.hs view
@@ -23,6 +23,7 @@ distTarget, distUpdates, distOverride,+ hackageRelease, releaseVersion, rawhide) where @@ -37,6 +38,9 @@ rawhide :: String rawhide = "f28" +hackageRelease :: String+hackageRelease = "f27"+ distBranch :: Dist -> String distBranch d | d == rawhide = "master" | otherwise = d@@ -73,6 +77,5 @@ | otherwise = Nothing releaseVersion :: Dist -> String-releaseVersion "epel7" = "7"-releaseVersion r | head r == 'f' = tail r-releaseVersion _ = error "Unknown release"+releaseVersion r | r == rawhide = "rawhide"+releaseVersion r = distVersion r
README.md view
@@ -1,4 +1,7 @@ [](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) # Fedora Haskell Tools
RPM.hs view
@@ -14,7 +14,8 @@ module RPM (packageManager, repoquery, repoquerySrc,- rpmInstall) where+ rpmInstall,+ rpmspec) where import Control.Monad (unless, when) import Data.List (elemIndices)@@ -24,7 +25,7 @@ import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) -import Utils (cmdStdErr, singleLine, sudo)+import Utils (cmd, cmdStdErr, singleLine, sudo) -- @since base 4.8.0.0 die :: String -> IO a@@ -63,8 +64,8 @@ repoqWrap prog (subcmd ++ args ++ [key]) repoqWrap :: String -> [String] -> IO String-repoqWrap cmd args = do- (out, err) <- cmdStdErr cmd args+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") $@@ -87,3 +88,8 @@ where dashes = elemIndices '-' nvr nameDash = last $ init dashes++rpmspec :: [String] -> Maybe String -> FilePath -> IO String+rpmspec args mqf spec = do+ let qf = maybe [] (\ q -> ["--queryformat", q]) mqf+ cmd "rpmspec" (["-q"] ++ args ++ qf ++ [spec])
Utils.hs view
@@ -25,6 +25,12 @@ import System.Exit (ExitCode (..)) import System.Process (readProcess, readProcessWithExitCode, rawSystem) +#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))+#else+import Control.Exception (bracket)+import System.Directory ( getCurrentDirectory, setCurrentDirectory)+#endif+ infixr 4 +-+ (+-+) :: String -> String -> String "" +-+ s = s@@ -112,6 +118,10 @@ removePrefix prefix orig = fromMaybe (error prefix +-+ "is not prefix of" +-+ orig) $ stripPrefix prefix orig +maybeRemovePrefix :: String -> String -> String+maybeRemovePrefix prefix orig =+ fromMaybe orig $ stripPrefix prefix orig+ removeSuffix :: String -> String -> String removeSuffix suffix orig = fromMaybe orig $ stripSuffix suffix orig@@ -123,4 +133,13 @@ error_ = errorWithoutStackTrace #else error_ = error+#endif++#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))+#else+withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory dir action =+ bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do+ setCurrentDirectory dir+ action #endif
fedora-haskell-tools.cabal view
@@ -1,8 +1,8 @@ Name: fedora-haskell-tools-Version: 0.3-Synopsis: Building and tracking tools for Fedora Haskell+Version: 0.4+Synopsis: Building and managing tools for Fedora Haskell Description:- Tools for recursive building of Fedora Haskell packages.+ 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@@ -37,6 +37,7 @@ Main-is: fhbz.hs Build-depends: base < 5, time+ Other-modules: Utils GHC-options: -fwarn-missing-signatures -Wall Extensions: CPP
fhbuild.hs view
@@ -31,7 +31,7 @@ import Dists (Dist, dists, distBranch, distOverride, distTag, distTarget) import Koji (kojiBuilding, kojiLatestPkg, kojiWaitPkg, notInKoji)-import RPM (packageManager, rpmInstall, repoquery, repoquerySrc)+import RPM (packageManager, rpmInstall, repoquery, repoquerySrc, rpmspec) import Utils ((+-+), cmd, cmd_, cmdBool, cmdMaybe, cmdlog, error_, logMsg, removePrefix, removeSuffix, sudo) @@ -162,8 +162,8 @@ putStrLn $ "To watch: tail -f" +-+ wd </> logfile -- note "fedpkg --path dir local" saves .build.log in cwd _out <- cmd "fedpkg" ["local"]- opkgs <- lines <$> cmd "rpmspec" ["-q", "--queryformat", "%{name}\n", spec]- rpms <- lines <$> cmd "rpmspec" ["-q", "--queryformat", "%{arch}/%{name}-%{version}-" ++ release ++ ".%{arch}.rpm\n", spec]+ 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@@ -324,7 +324,7 @@ buildRequires :: FilePath -> IO [String] buildRequires spec =- (map (head . words) . lines) <$> cmd "rpmspec" ["-q", "--buildrequires", spec] >>= mapM whatProvides+ (map (head . words) . lines) <$> rpmspec ["--buildrequires"] Nothing spec >>= mapM whatProvides derefSrcPkg :: String -> IO (Maybe String) derefSrcPkg pkg = do
fhpkg.hs view
@@ -26,64 +26,97 @@ #else import Control.Applicative ((<$>)) #endif-import Control.Exception (bracket) import Control.Monad (unless, when) import Data.Maybe-import Data.List (isPrefixOf, nub, sort, (\\))+import Data.List (isInfixOf, isPrefixOf, nub, sort, (\\)) import System.Directory (doesDirectoryExist, doesFileExist,- getCurrentDirectory, setCurrentDirectory)+ setCurrentDirectory,+#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))+ withCurrentDirectory+#endif+ ) import System.Environment (getArgs, getProgName) import System.Exit (ExitCode (..), exitWith) import System.FilePath ((</>)) import System.IO (hPutStrLn, stderr) --import System.Posix.Env (getEnv) -import Dists (Dist, dists, distBranch, releaseVersion)+import Dists (Dist, dists, distBranch, hackageRelease, releaseVersion) import Koji (kojiListPkgs)-import Utils ((+-+), cmd, cmd_, cmdBool, removePrefix)+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+ ) main :: IO () main = do margs <- getArgs >>= parseArgs case margs of Nothing -> return ()- Just (com, mdist, pkgs) -> do- ps <- if null pkgs then repoqueryHaskell False mdist else return pkgs+ Just (com, mdist, pkgs) -> case com of- "list" -> mapM_ putStrLn ps- "count" -> print $ length ps+ "list" -> withPackages mdist pkgs (mapM_ putStrLn)+ "count" -> withPackages mdist pkgs (print . length) "hackage" -> do- unless (mdist == Just "f27") $ error "Hackage is currently for F27!"- repoqueryHackageCSV mdist ps- "clone" -> do- new <- newPackages mdist ps- repoAction True mdist (new ++ ps) (return ())- "pull" -> repoAction True mdist ps (cmd_ "git" ["pull", "--rebase"])- "diff" -> repoAction True mdist ps (cmd_ "git" ["diff"])- "verrel" -> repoAction False mdist ps (cmd_ "fedpkg" ["verrel"])- "subpkgs" -> repoAction True mdist ps (cmd "fedpkg" ["gimmespec"] >>= \ p -> cmd_ "rpmspec" ["-q", "--qf", "%{name}-%{version}\n", p])- "new" -> newPackages mdist ps >>= mapM_ putStrLn+ let currentHackage = Just hackageRelease+ unless (isNothing mdist || mdist == currentHackage) $ error $ "Hackage is currently for" +-+ fromJust currentHackage ++ "!"+ withPackages currentHackage pkgs (repoqueryHackageCSV currentHackage)+ "clone" -> withPackages mdist pkgs $+ repoAction_ True False mdist (return ())+ "clone-new" -> do+ new <- newPackages mdist+ withPackages mdist new $ repoAction_ True False mdist (return ())+ "pull" -> withPackages mdist pkgs $+ repoAction_ True False mdist (cmd_ "git" ["pull", "--rebase"])+ "diff" -> withPackages mdist pkgs $+ repoAction_ True False mdist (cmd_ "git" ["--no-pager", "diff"])+ "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"])+ "subpkgs" -> withPackages mdist pkgs $+ repoAction True True mdist (\ p -> rpmspec [] (Just "%{name}-%{version}") (p ++ ".spec") >>= putStrLn)+ "new" -> newPackages mdist >>= mapM_ putStrLn _ -> return ()+ where+ withPackages :: Maybe Dist -> [Package] -> ([Package] -> IO ()) -> IO ()+ withPackages mdist pkgs act =+ (if null pkgs then repoqueryHaskell False mdist else return pkgs) >>= act -commands :: [String]-commands = ["clone", "count", "diff", "hackage", "list", "new", "pull" , "subpkgs", "verrel"]+commands :: [(String, String)]+commands = [("clone", "clone repos"),+ ("clone-new", "clone new packages"),+ ("count", "count number of packages"),+ ("diff", "git diff"),+ ("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"),+ ("subpkgs", "list subpackages"),+ ("verrel", "show nvr of packages")] +cmds :: [String]+cmds = map fst commands+ help :: IO () help = do progName <- getProgName hPutStrLn stderr $ "Usage:" +-+ progName +-+ "CMD [DIST]\n" ++ "\n" ++ "Commands:\n"- ++ " clone\t- clone repos\n"- ++ " pull\t\t- pull repos\n"- ++ " list\t\t- list packages\n"- ++ " count\t\t- count number of packages\n"- ++ " verrel\t\t- show nvr of packages\n"- ++ " subpkgs\t\t- list subpackages\n"- ++ " new\t\t- new unbuilt packages\n"- ++ " hackage\t- generate Hackage distro date\n"+ mapM_ (putStrLn . (\(c, desc) -> " " ++ c ++ replicate (mx - length c) ' ' +-+ "-" +-+ desc)) commands exitWith (ExitFailure 1)+ where+ mx = maximum $ map length cmds type Package = String @@ -91,13 +124,13 @@ parseArgs :: [String] -> IO Arguments parseArgs [c] =- if c `elem` commands+ if c `elem` cmds then return (Just (c, Nothing, [])) else giveUp $ "No such command '" ++ c ++ "'"-parseArgs (c:dist:pkgs) | dist `notElem` dists = - giveUp $ "Unknown dist '" ++ dist ++ "'"- | c `notElem` commands =+parseArgs (c:dist:pkgs) | c `notElem` cmds = giveUp $ "No such command '" ++ c ++ "'"+ | dist `notElem` dists =+ return $ Just (c, Nothing, dist:pkgs) | otherwise = return $ Just (c, Just dist, pkgs) parseArgs _ = help >> return Nothing@@ -119,7 +152,7 @@ repoqueryHackageCSV mdist pkgs = do let relver = maybe "rawhide" releaseVersion mdist -- Hackage csv chokes on final newline so remove it- init . unlines . map (replace "\"ghc-" "\"") . lines <$> cmd "dnf" (["repoquery", "--quiet", "--releasever=" ++ relver, "-q", "--qf=\"%{name}\",\"%{version}\",\"https://apps.fedoraproject.org/packages/%{name}\""] ++ pkgs) >>= putStr+ 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 replace :: Eq a => [a] -> [a] -> [a] -> [a] replace a b s@(x:xs) =@@ -139,15 +172,16 @@ when (null bin) $ error "No libHSbase consumers found!" return $ sort $ nub bin -newPackages :: Maybe Dist -> [Package] -> IO [Package]-newPackages mdist ps = do+newPackages :: Maybe Dist -> IO [Package]+newPackages mdist = do+ ps <- repoqueryHaskell True mdist kps <- kojiListHaskell True mdist return $ kps \\ ps -repoAction :: Bool -> Maybe Dist -> [Package] -> IO () -> IO ()-repoAction _ _ [] _ = return ()-repoAction header mdist (pkg:rest) action = do- bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do+repoAction :: Bool -> Bool -> Maybe Dist -> (Package -> IO ()) -> [Package] -> IO ()+repoAction _ _ _ _ [] = return ()+repoAction header needsSpec mdist action (pkg:rest) = do+ withCurrentDirectory "." $ do let branchGiven = isJust mdist branch = maybe "master" distBranch mdist when header $@@ -157,6 +191,12 @@ dirExists <- doesDirectoryExist pkg unless dirExists $ cmd_ "fedpkg" $ ["clone"] ++ (if branchGiven then ["-b", branch] else ["-B"]) ++ [pkg]+ singleDir <- doesFileExist $ pkg </> ".git/config"+ unless singleDir $ do+ branchDir <- doesDirectoryExist $ pkg </> branch+ unless branchDir $+ withCurrentDirectory pkg $+ cmd_ "fedpkg" ["clone", "-b", branch, pkg, branch] wd <- pkgDir pkg branch "" setCurrentDirectory wd pkggit <- do@@ -175,9 +215,14 @@ let spec = pkg ++ ".spec" hasSpec <- doesFileExist spec unless hasSpec $ putStrLn "No spec file!"- action- repoAction header mdist rest action+ unless (needsSpec && not hasSpec) $+ action pkg+ repoAction header needsSpec mdist action rest +repoAction_ :: Bool -> Bool -> Maybe Dist -> IO () -> [Package] -> IO ()+repoAction_ header needsSpec mdist action =+ repoAction header needsSpec mdist (const action)+ pkgDir :: String -> String -> FilePath -> IO FilePath pkgDir dir branch top = do b <- doesDirectoryExist $ top </> dir </> branch@@ -187,3 +232,23 @@ gitBranch = (removePrefix "* " . head . filter (isPrefixOf "* ") . lines) <$> cmd "git" ["branch"] +compareStackage :: Package -> IO ()+compareStackage p = do+ nvr <- cmd "fedpkg" ["verrel"]+ stkg <- cmdMaybe "stackage" ["package", "lts", maybeRemovePrefix "ghc-" p]+ let same = isJust stkg && fromJust stkg `isInfixOf` nvr+ putStrLn $ removePrefix (p ++ "-") nvr +-+ "(fedora)"+ putStrLn $ (if same then "same" else fromMaybe "none" stkg) +-+ "(lts)"+++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+ putStrLn nvr+ putStrLn nvr'+ putStrLn ""+ where+ removeDisttag = reverse . tail . dropWhile (/= '.') . reverse