packages feed

fedora-repoquery-0.9.1: src/Main.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

-- SPDX-License-Identifier: GPL-3.0-or-later

module Main (main) where

#if !MIN_VERSION_simple_cmd_args(0,1,4)
import Control.Applicative (
  many,
#if !MIN_VERSION_simple_cmd_args(0,1,3)
  (<|>)
#endif
  )
#endif
import Control.Monad (forM_, unless, when)
import Data.Either (partitionEithers)
import Data.Maybe (isNothing)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif
import Options.Applicative (flag', long, short, strOption,
#if !MIN_VERSION_simple_cmd_args(0,1,7)
    eitherReader
#endif
    )
import SimpleCmd ((+-+), cmd_, error', warning)
import SimpleCmdArgs
import System.Environment (getArgs, withArgs)
import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout)

import Arch
import Cache (cacheSize, cleanEmptyCaches)
import List (listVersionsCmd)
import Paths_fedora_repoquery (version)
import Query
import Release (activeFedoraReleases, activeEPELReleases, activeReleases,
                downloadServer, showReleaseCmd)
import Types (Mirror(..), RepoSource(..), Verbosity(..), eitherRelease)

data Command = Query [DnfOption] [String]
             | CacheSize | CacheEmpties | DnfHelp | ReleaseList

data AllReleases = AllFedora | AllEPEL | AllReleases

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  args <- getArgs
  if null args
    then withArgs ["--help"] main'
    else main'

main' :: IO ()
main' = do
  sysarch <- getSystemArch
  simpleCmdArgs (Just version) "fedora-repoquery tool for querying Fedora repos for packages."
    ("where RELEASE is {fN or N (fedora), 'rawhide', epelN, epel10.x, epel9-next, cN (centos stream), 'eln'}, with N the release version number." +-+
     "<https://github.com/juhp/fedora-repoquery#readme>") $
    runMain sysarch
    <$> switchWith '4' "dnf4" "Use dnf4 instead of dnf5 (if available)"
    <*> (flagWith' Quiet 'q' "quiet" "Avoid output to stderr" <|>
         flagWith Normal Verbose 'v' "verbose" "Show stderr from dnf repoquery")
    <*> switchLongWith "dynamic" "Redirect each HTTP through mirror"
    <*> switchWith 'T' "time" "Show time-stamp of repos"
    <*> (RepoSource
          <$> switchWith 'K' "koji" "Use Koji buildroot"
          <*> ((Mirror <$> strOptionWith 'm' "mirror" "URL" ("Fedora mirror [default: " ++ downloadServer ++ "]")) <|>
               flagLongWith' CloudFront "cf" "Use CloudFront cache" <|>
               flagWith DownloadFpo DlFpo 'd' "dl" "Use dl.fp.o"))
    <*> optional (flagWith' AllFedora 'F' "all-fedora" "Query all current Fedora releases" <|>
                  flagWith' AllEPEL 'E' "all-epel" "Query all current EPEL releases" <|>
                  flagLongWith' AllReleases "all-releases" "Query all current releases")
    <*> (flagWith' [Source] 's' "source" "Query source repos" <|>
         flagWith' allArchs 'A' "all-archs" "Query all arch repos" <|>
         many (optionWith (eitherReader eitherArch) 'a' "repo-arch" "ARCH" ("Specify repo arch [default:" +-+ showArch sysarch ++ "]")))
    <*> switchWith 't' "testing" "Fedora updates-testing"
    <*> switchWith 'D' "debug" "Show some debug output"
    <*> (flagWith' CacheSize 'z' "cache-size" "Show total dnf repo metadata cache disksize"
         <|> flagWith' CacheEmpties 'e' "cache-clean-empty" "Remove empty dnf caches"
         <|> flagLongWith' ReleaseList "list-releases" "List Fedora versions"
         <|> flagLongWith' DnfHelp "help-dnf" "Show dnf --help"
         <|> Query <$> many queryOptions <*> many (strArg "[RELEASE]... [REPOQUERY_OPTS]... [PKGSPECIFIER]..."))

-- man 8 dnf-repoquery (dnf5-5.2.17.0-2.fc44)
-- https://github.com/rpm-software-management/dnf5/blob/main/doc/commands/repoquery.8.rst

dnfFlag, dnfOption :: String -> Parser DnfOption
dnfFlag o = flag' (DnfFlag o) (long o)
dnfOption o = DnfOption o <$> strOption (long o)
dnfFlag', dnfOption' :: Char -> String -> Parser DnfOption
dnfFlag' s l = flag' (DnfFlag l) (short s <> long l)
dnfOption' s l = DnfOption l <$> strOption (short s <> long l)
dnfFlag'', dnfOption'' :: String -> String -> Parser DnfOption
dnfFlag'' s l = flag' (DnfFlag l) (long s <> long l)
dnfOption'' s l = DnfOption l <$> strOption (long s <> long l)

queryOptions :: Parser DnfOption
queryOptions =
  -- # OPTIONS
  dnfOption "advisories"
  <|> dnfOption "advisory-severities"
  <|> dnfOption "arch"
  <|> dnfFlag "available" -- default
  <|> dnfFlag "bugfix"
  <|> dnfOption "bzs"
  <|> dnfOption "cves"
  <|> dnfFlag "disable-modular-filtering"
  <|> dnfFlag "duplicates"
  <|> dnfFlag "enhancement"
  <|> dnfFlag "exactdeps"
  <|> dnfFlag "extras"
  <|> dnfOption' 'f' "file"
  <|> dnfFlag "installed"
  <|> dnfOption "installed-from-repo"
  <|> dnfFlag "installonly"
  <|> dnfOption "latest-limit"
  <|> dnfFlag "leaves"
  <|> dnfFlag "newpackage"
  <|> dnfOption "providers-of" -- for certain commands see manpage
  <|> dnfFlag "recent"
  <|> dnfFlag "recursive" -- with --whatrequires or --providers-of only
  <|> dnfFlag "security"
  <|> dnfFlag "srpm"
  <|> dnfFlag "unneeded"
  <|> dnfFlag "upgrades"
  <|> dnfFlag "userinstalled"
  <|> dnfOption "whatconflicts"
  <|> dnfOption'' "wd" "whatdepends"
  <|> dnfOption "whatenhances"
  <|> dnfOption "whatobsoletes"
  <|> dnfOption'' "wp" "whatprovides"
  <|> dnfOption "whatrecommends"
  <|> dnfOption'' "wr" "whatrequires"
  <|> dnfOption "whatsuggests"
  <|> dnfOption "whatsupplements"
  -- # FORMATTING
  <|> dnfFlag "conflicts"
  <|> dnfFlag "depends"
  <|> dnfFlag "enhances"
  <|> dnfFlag "files"
  <|> dnfFlag' 'l' "list"
  <|> dnfFlag "obsoletes"
  <|> dnfFlag' 'p' "provides"
  <|> dnfFlag "recommends"
  <|> dnfFlag' 'r' "requires"
  <|> dnfFlag "requires-pre"
  <|> dnfFlag "sourcerpm"
  <|> dnfFlag "suggests"
  <|> dnfFlag "supplements"
  <|> dnfFlag "location"
  <|> dnfFlag' 'i' "info"
  <|> dnfFlag'' "changelog" "changelogs"
  <|> dnfFlag "querytags"
  <|> dnfOption'' "qf" "queryformat"

runMain :: Arch -> Bool -> Verbosity -> Bool -> Bool -> RepoSource
        -> Maybe AllReleases -> [Arch] -> Bool -> Bool -> Command -> IO ()
runMain sysarch dnf4 verbose dynredir time reposource mallreleases archs testing debug command = do
  case command of
    CacheSize -> cacheSize
    CacheEmpties -> cleanEmptyCaches
    ReleaseList -> listVersionsCmd
    DnfHelp -> cmd_ (if dnf4 then "dnf4" else "dnf") ["repoquery", "--help"]
    Query opts relargs ->
      -- spanJust from utility-ht nicer but this gets us enough
      let (args,releases) = partitionEithers $ map eitherRelease relargs
      in do
        unless (null releases || isNothing mallreleases) $
          error' "cannot specify releases and --all-{fedora,epel}"
        when (null releases && isNothing mallreleases) $
          when (verbose == Verbose || debug) $
          warning "(using system repos)"
        releaselist <-
          if null releases
          then
            case mallreleases of
              Just allreleases ->
                map Just <$>
                case allreleases of
                  AllFedora -> activeFedoraReleases
                  AllEPEL -> activeEPELReleases
                  AllReleases -> activeReleases
              Nothing -> return [Nothing]
          else return $ map Just releases
        forM_ releaselist $ \mrelease ->
          if null args && null opts
          then if null archs
               then showReleaseCmd debug dynredir reposource mrelease sysarch Nothing testing
               else forM_ archs $ \arch -> showReleaseCmd debug dynredir reposource mrelease sysarch (Just arch) testing
          else
            let multiple = length releaselist > 1 || length archs > 1
            in repoqueryCmd dnf4 debug verbose multiple dynredir time mrelease reposource sysarch archs testing opts args