fbrnch-1.7: src/Cmd/ListPackages.hs
{-# LANGUAGE OverloadedStrings #-}
module Cmd.ListPackages (
listCmd,
Packager(..),
listLocalCmd,
listPackages
)
where
import Fedora.Pagure
import SimplePrompt (yesNoDefault)
import Branches
import Common
import Common.System
import Git (gitSwitchBranch')
import Package
import Pagure (srcfpo)
data Packager = Owner String | Committer String
-- FIXME remote/pagure branch and --remote or --no-remote
listCmd :: Bool -> Bool -> Maybe Packager -> [String] -> IO ()
listCmd force count mpackager pkgs = do
unless (force || count || isJust mpackager || not (null pkgs)) $
error' "Please give a package pattern, --count, or --owner/--username"
ecountpkgs <- countListPackages force count mpackager pkgs
case ecountpkgs of
Left num -> print num
Right packages -> mapM_ putStrLn packages
countListPackages :: Bool -> Bool -> Maybe Packager -> [String]
-> IO (Either Integer [String])
countListPackages force count mpackager pkgs = do
emcounts <-
if null pkgs
then Left <$> countPackages Nothing
else Right <$> mapM (countPackages . Just) pkgs
case emcounts of
Left mcount ->
if count
then return $ Left $ fromMaybe 0 mcount
else Right <$> doListPackages (mcount, Nothing)
Right mcounts ->
if count
then return $ Left $ sum $ catMaybes mcounts
else Right <$> concatMapM doListPackages (zip mcounts $ map Just pkgs)
where
path = "projects"
mkParams mpattern =
makeKey "short" "1" ++ makeKey "fork" "0" ++ packager ++ makeKey "namespace" "rpms" ++ maybeKey "pattern" mpattern
where
packager =
case mpackager of
Nothing -> makeKey "owner" "!orphan"
Just (Owner o) -> makeKey "owner" o
Just (Committer c) -> makeKey "username" c
countPackages :: Maybe String -> IO (Maybe Integer)
countPackages mpattern =
queryPagureCount srcfpo path (mkParams mpattern) "pagination"
-- FIXME add default --max-pages?
doListPackages :: (Maybe Integer, Maybe String) -> IO [String]
doListPackages (Nothing, mpat) =
error' $ "no matches found" +-+ maybe "" ("for" +-+) mpat
doListPackages (Just 0, _mpat) = return []
doListPackages (Just num, mpattern) = do
ok <-
if num > 1000 && not force
then yesNoDefault False $ show num +-+ "results, continue"
else return True
if ok
then do
pages <- queryPagureCountPaged srcfpo False path (mkParams mpattern) ("pagination", "page")
return $
concatMap (map (lookupKey' "name")) $
mapMaybe (lookupKey "projects") pages
else error' "aborted"
-- FIXME add --count
listLocalCmd :: (Maybe Branch, [String]) -> IO ()
listLocalCmd =
withPackagesMaybeBranch HeaderNone False dirtyGit listLocalPkg
where
listLocalPkg :: Package -> AnyBranch -> IO ()
listLocalPkg pkg (RelBranch br) = do
exists <- gitSwitchBranch' True br
when exists $
whenM (isJust <$> maybeFindSpecfile) $
putStrLn $ unPackage pkg
listLocalPkg _ (OtherBranch _) =
error' "other branches not supported yet"
listPackages :: Bool -> Maybe Packager -> [String] -> IO [String]
listPackages force mpackager pkgs =
either (error' "impossible happened") id <$>
countListPackages force False mpackager pkgs