-- |
-- Module : Packages
-- Copyright : (C) 2017 Jens Petersen
--
-- Maintainer : Jens Petersen <petersen@fedoraproject.org>
-- Stability : alpha
--
-- Explanation: Cloning and pulling package git repos
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
-- Todo:
-- cache dist package lists?
-- push subpackages to Hackage
-- compare branch versions
-- compare with LTS
-- arbitrary command
-- query-format string
module Main where
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2))
#else
import Control.Applicative ((<$>))
#endif
import Control.Monad (unless, when)
import Data.Maybe
import Data.List (isInfixOf, isPrefixOf, nub, sort, (\\))
import System.Directory (doesDirectoryExist, doesFileExist,
getHomeDirectory, setCurrentDirectory)
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, hackageRelease, releaseVersion)
import Koji (kojiListPkgs)
import RPM (repoquery, rpmspec)
import Utils ((+-+), checkFedoraPkgGit, cmd, cmd_, cmdBool, cmdMaybe, cmdSilent,
maybeRemovePrefix, removePrefix, withCurrentDirectory)
main :: IO ()
main = do
margs <- getArgs >>= parseArgs
case margs of
Nothing -> return ()
Just (com, mdist, pkgs) ->
case com of
"list" -> withPackages mdist pkgs (mapM_ putStrLn)
"count" -> withPackages mdist pkgs (print . length)
"hackage" -> do
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"])
"push" -> withPackages mdist pkgs $
repoAction_ True False mdist (cmd_ "git" ["push"])
"diff" -> withPackages mdist pkgs $
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
_ -> 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, String)]
commands = [("clone", "clone repos"),
("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"),
("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")]
cmds :: [String]
cmds = map fst commands
help :: IO ()
help = do
progName <- getProgName
hPutStrLn stderr $ "Usage:" +-+ progName +-+ "CMD [DIST]\n"
++ "\n"
++ "Commands:\n"
mapM_ (putStrLn . (\(c, desc) -> " " ++ c ++ replicate (mx - length c) ' ' +-+ "-" +-+ desc)) commands
exitWith (ExitFailure 1)
where
mx = maximum $ map length cmds
type Package = String
type Arguments = Maybe (String, Maybe Dist, [Package])
parseArgs :: [String] -> IO Arguments
parseArgs [c] =
if c `elem` cmds
then return (Just (c, Nothing, []))
else giveUp $ "No such command '" ++ c ++ "'"
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
giveUp :: String -> IO Arguments
giveUp err = do
hPutStrLn stderr err
help >> return Nothing
kojiListHaskell :: Bool -> Maybe Dist -> IO [Package]
kojiListHaskell verbose mdist = do
when verbose $ putStrLn "Getting package list from Koji"
libs <- filter (\ p -> "ghc-" `isPrefixOf` p && p `notElem` ["ghc-rpm-macros", "ghc-srpm-macros"]) <$> kojiListPkgs (fromMaybe "rawhide" mdist)
when (null libs) $ error "No library packages found"
return $ sort $ nub libs
repoqueryHackageCSV :: Maybe Dist -> [Package] -> IO ()
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 <$> 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) =
if a `isPrefixOf` s
then b ++ replace a b (drop (length a) s)
else x:replace a b xs
replace _ _ [] = []
repoqueryHaskell :: Bool -> Maybe Dist -> IO [Package]
repoqueryHaskell verbose mdist = do
-- fixme: should use repoquery instead:
let relver = maybe "rawhide" releaseVersion mdist
when verbose $ putStrLn "Getting packages from repoquery"
bin <- words <$> repoquery relver ["--qf=%{source_name}", "--whatrequires", "libHSbase-*-ghc*.so()(64bit)"]
when (null bin) $ error "No libHSbase consumers found!"
return $ sort $ nub bin
newPackages :: Maybe Dist -> IO [Package]
newPackages mdist = do
ps <- repoqueryHaskell True mdist
kps <- kojiListHaskell True mdist
return $ kps \\ ps
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 $
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"] ++ ["-a" | not haveSSH] ++ (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
gd <- doesFileExist ".git/config"
if gd
then checkFedoraPkgGit
else return False
unless pkggit $
error $ "not a Fedora pkg git dir!:" +-+ wd
when dirExists $ do
actual <- gitBranch
when (branch /= actual) $
cmd_ "fedpkg" ["switch-branch", branch]
isDead <- doesFileExist "dead.package"
unless isDead $ do
let spec = pkg ++ ".spec"
hasSpec <- doesFileExist spec
unless hasSpec $ putStrLn "No spec file!"
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
return $ top </> dir </> if b then branch else ""
gitBranch :: IO String
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
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 ""
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]