{-# LANGUAGE CPP, TupleSections #-}

module SelectRPMs (
  Select(..),
  selectDefault,
  selectRpmsOptions,
  installArgs,
  checkSelection,
  rpmsToNVRAs,
  Existence(..),
  ExistNVRA,
  Yes(..),
  ExistingStrategy(..),
  existingStrategyOption,
  decideRPMs,
  nvraToRPM,
  groupOnArch,
  PkgMgr(..),
  installRPMs
  )
where

import Control.Monad.Extra (forM_, mapMaybeM, unless, when)
import Data.Either (partitionEithers)
import Data.List.Extra (foldl', isInfixOf, nubOrd, nubSort, sort,
#if MIN_VERSION_extra(1,7,11)
                        groupOnKey,
#endif
                        (\\))
import Data.RPM.NVRA (NVRA(..), readNVRA, showNVRA)
import Safe (headMay)
import SimpleCmd (cmd_, cmdMaybe, error', sudo_, (+-+),
#if MIN_VERSION_simple_cmd(0,2,7)
                  sudoLog
#endif
                 )
import SimpleCmdArgs (Parser, flagWith', flagLongWith', many, strOptionWith,
                      (<|>))
import SimplePrompt (yesNoDefault)
import System.Directory
import System.FilePath ((</>), (<.>))
import System.FilePath.Glob (compile, isLiteral, match)

-- | The Select type specifies the subpackage selection
data Select = All -- ^ all packages
            | Ask -- ^ interactive prompting
            | PkgsReq
              [String] -- ^ include matches
              [String] -- ^ except matches
              [String] -- ^ exclude
              [String] -- ^ added
  deriving Select -> Select -> Bool
(Select -> Select -> Bool)
-> (Select -> Select -> Bool) -> Eq Select
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Select -> Select -> Bool
$c/= :: Select -> Select -> Bool
== :: Select -> Select -> Bool
$c== :: Select -> Select -> Bool
Eq

-- | default package selection
selectDefault :: Select
selectDefault :: Select
selectDefault = [String] -> [String] -> [String] -> [String] -> Select
PkgsReq [] [] [] []

-- | optparse-applicative Parser for Select
selectRpmsOptions :: Parser Select
selectRpmsOptions :: Parser Select
selectRpmsOptions =
  Select -> String -> String -> Parser Select
forall a. a -> String -> String -> Parser a
flagLongWith' Select
All String
"all" String
"all subpackages [default if not installed]" Parser Select -> Parser Select -> Parser Select
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Select -> String -> String -> Parser Select
forall a. a -> String -> String -> Parser a
flagLongWith' Select
Ask String
"ask" String
"ask for each subpackage" Parser Select -> Parser Select -> Parser Select
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  [String] -> [String] -> [String] -> [String] -> Select
PkgsReq
  ([String] -> [String] -> [String] -> [String] -> Select)
-> Parser [String]
-> Parser ([String] -> [String] -> [String] -> Select)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> String -> String -> String -> Parser String
strOptionWith Char
'p' String
"package" String
"SUBPKG" String
"select subpackage (glob) matches")
  Parser ([String] -> [String] -> [String] -> Select)
-> Parser [String] -> Parser ([String] -> [String] -> Select)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> String -> String -> String -> Parser String
strOptionWith Char
'e' String
"except" String
"SUBPKG" String
"select subpackages not matching (glob)")
  Parser ([String] -> [String] -> Select)
-> Parser [String] -> Parser ([String] -> Select)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> String -> String -> String -> Parser String
strOptionWith Char
'x' String
"exclude" String
"SUBPKG" String
"deselect subpackage (glob): overrides -p and -e")
  Parser ([String] -> Select) -> Parser [String] -> Parser Select
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> String -> String -> String -> Parser String
strOptionWith Char
'i' String
"include" String
"SUBPKG" String
"additional subpackage (glob) to install: overrides -x")

-- | alternative CLI args option parsing to Select packages
installArgs :: String -> Select
installArgs :: String -> Select
installArgs String
cs =
  case String -> [String]
words String
cs of
    [String
"-a"] -> Select
All
    [String
"--all"] -> Select
All
    [String
"-A"] -> Select
Ask
    [String
"--ask"] -> Select
Ask
    [String]
ws -> [String] -> [String] -> [String] -> [String] -> [String] -> Select
installPairs [] [] [] [] [String]
ws
  where
    installPairs :: [String] -> [String] -> [String] -> [String]
                 -> [String] -> Select
    installPairs :: [String] -> [String] -> [String] -> [String] -> [String] -> Select
installPairs [String]
incl [String]
except [String]
excl [String]
add [] = [String] -> [String] -> [String] -> [String] -> Select
PkgsReq [String]
incl [String]
except [String]
excl [String]
add
    installPairs [String]
incl [String]
except [String]
excl [String]
add (String
w:[String]
ws)
      | String
w String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-p",String
"--package"] =
          case [String]
ws of
            [] -> String -> Select
forall a. String -> a
error' String
"--install opts: --package missing value"
            (String
w':[String]
ws') -> String -> Select -> Select
forall (t :: * -> *) a p. Foldable t => t a -> p -> p
checkPat String
w' (Select -> Select) -> Select -> Select
forall a b. (a -> b) -> a -> b
$
                        [String] -> [String] -> [String] -> [String] -> [String] -> Select
installPairs (String
w'String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
incl) [String]
except [String]
excl [String]
add [String]
ws'
      | String
w String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-e",String
"--except"] =
          case [String]
ws of
            [] -> String -> Select
forall a. String -> a
error' String
"--install opts: --except missing value"
            (String
w':[String]
ws') -> String -> Select -> Select
forall (t :: * -> *) a p. Foldable t => t a -> p -> p
checkPat String
w' (Select -> Select) -> Select -> Select
forall a b. (a -> b) -> a -> b
$
                        [String] -> [String] -> [String] -> [String] -> [String] -> Select
installPairs [String]
incl (String
w'String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
except) [String]
excl [String]
add [String]
ws'
      | String
w String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-x",String
"--exclude"] =
          case [String]
ws of
            [] -> String -> Select
forall a. String -> a
error' String
"--install opts: --exclude missing value"
            (String
w':[String]
ws') -> String -> Select -> Select
forall (t :: * -> *) a p. Foldable t => t a -> p -> p
checkPat String
w' (Select -> Select) -> Select -> Select
forall a b. (a -> b) -> a -> b
$
                        [String] -> [String] -> [String] -> [String] -> [String] -> Select
installPairs [String]
incl [String]
except (String
w'String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
excl) [String]
add [String]
ws'
      | String
w String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-i",String
"--include"] =
          case [String]
ws of
            [] -> String -> Select
forall a. String -> a
error' String
"--install opts: --include missing value"
            (String
w':[String]
ws') -> String -> Select -> Select
forall (t :: * -> *) a p. Foldable t => t a -> p -> p
checkPat String
w' (Select -> Select) -> Select -> Select
forall a b. (a -> b) -> a -> b
$
                        [String] -> [String] -> [String] -> [String] -> [String] -> Select
installPairs [String]
incl [String]
except [String]
excl (String
w'String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
add) [String]
ws'
      | Bool
otherwise = String -> Select
forall a. String -> a
error' String
"invalid --install opts"

    checkPat :: t a -> p -> p
checkPat t a
w' p
f =
      if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
w'
      then String -> p
forall a. String -> a
error' String
"empty pattern!"
      else p
f

-- FIXME explain if/why this is actually needed (used by koji-tool install)
-- | check package Select is not empty
checkSelection :: Monad m => Select -> m ()
checkSelection :: Select -> m ()
checkSelection (PkgsReq [String]
ps [String]
es [String]
xs [String]
is) =
  [String] -> (String -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([String]
ps [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
es [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
is) ((String -> m ()) -> m ()) -> (String -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \String
s ->
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. String -> a
error' String
"empty package pattern not allowed"
checkSelection Select
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | converts a list of RPM files to NVRA's, filtering out debug subpackages
rpmsToNVRAs :: [String] -> [NVRA]
rpmsToNVRAs :: [String] -> [NVRA]
rpmsToNVRAs = [NVRA] -> [NVRA]
forall a. Ord a => [a] -> [a]
sort ([NVRA] -> [NVRA]) -> ([String] -> [NVRA]) -> [String] -> [NVRA]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> NVRA) -> [String] -> [NVRA]
forall a b. (a -> b) -> [a] -> [b]
map String -> NVRA
readNVRA ([String] -> [NVRA])
-> ([String] -> [String]) -> [String] -> [NVRA]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
notDebugPkg

-- | how to handle already installed packages: re-install, skip, or
-- default update
--
-- The default strategy is to select existing subpackages, otherwise all.
data ExistingStrategy = ExistingNoReinstall | ExistingSkip | ExistingOnly
  deriving ExistingStrategy -> ExistingStrategy -> Bool
(ExistingStrategy -> ExistingStrategy -> Bool)
-> (ExistingStrategy -> ExistingStrategy -> Bool)
-> Eq ExistingStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExistingStrategy -> ExistingStrategy -> Bool
$c/= :: ExistingStrategy -> ExistingStrategy -> Bool
== :: ExistingStrategy -> ExistingStrategy -> Bool
$c== :: ExistingStrategy -> ExistingStrategy -> Bool
Eq

existingStrategyOption :: Parser ExistingStrategy
existingStrategyOption :: Parser ExistingStrategy
existingStrategyOption =
  ExistingStrategy
-> Char -> String -> String -> Parser ExistingStrategy
forall a. a -> Char -> String -> String -> Parser a
flagWith' ExistingStrategy
ExistingNoReinstall Char
'N' String
"no-reinstall" String
"Do not reinstall existing NVRs" Parser ExistingStrategy
-> Parser ExistingStrategy -> Parser ExistingStrategy
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ExistingStrategy
-> Char -> String -> String -> Parser ExistingStrategy
forall a. a -> Char -> String -> String -> Parser a
flagWith' ExistingStrategy
ExistingSkip Char
'S' String
"skip-existing" String
"Ignore already installed subpackages (implies --no-reinstall)" Parser ExistingStrategy
-> Parser ExistingStrategy -> Parser ExistingStrategy
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ExistingStrategy
-> Char -> String -> String -> Parser ExistingStrategy
forall a. a -> Char -> String -> String -> Parser a
flagWith' ExistingStrategy
ExistingOnly Char
'O' String
"only-existing" String
"Only update existing installed subpackages"


-- | sets prompt default behaviour for yes/no questions
data Yes = No | Yes
  deriving Yes -> Yes -> Bool
(Yes -> Yes -> Bool) -> (Yes -> Yes -> Bool) -> Eq Yes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Yes -> Yes -> Bool
$c/= :: Yes -> Yes -> Bool
== :: Yes -> Yes -> Bool
$c== :: Yes -> Yes -> Bool
Eq

-- | current state of a package NVR
data Existence = ExistingNVR -- ^ NVR is already installed
               | ChangedNVR -- ^ NVR is different to installed package
               | NotInstalled -- ^ package is not currently installed
  deriving (Existence -> Existence -> Bool
(Existence -> Existence -> Bool)
-> (Existence -> Existence -> Bool) -> Eq Existence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Existence -> Existence -> Bool
$c/= :: Existence -> Existence -> Bool
== :: Existence -> Existence -> Bool
$c== :: Existence -> Existence -> Bool
Eq, Eq Existence
Eq Existence
-> (Existence -> Existence -> Ordering)
-> (Existence -> Existence -> Bool)
-> (Existence -> Existence -> Bool)
-> (Existence -> Existence -> Bool)
-> (Existence -> Existence -> Bool)
-> (Existence -> Existence -> Existence)
-> (Existence -> Existence -> Existence)
-> Ord Existence
Existence -> Existence -> Bool
Existence -> Existence -> Ordering
Existence -> Existence -> Existence
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Existence -> Existence -> Existence
$cmin :: Existence -> Existence -> Existence
max :: Existence -> Existence -> Existence
$cmax :: Existence -> Existence -> Existence
>= :: Existence -> Existence -> Bool
$c>= :: Existence -> Existence -> Bool
> :: Existence -> Existence -> Bool
$c> :: Existence -> Existence -> Bool
<= :: Existence -> Existence -> Bool
$c<= :: Existence -> Existence -> Bool
< :: Existence -> Existence -> Bool
$c< :: Existence -> Existence -> Bool
compare :: Existence -> Existence -> Ordering
$ccompare :: Existence -> Existence -> Ordering
$cp1Ord :: Eq Existence
Ord, Int -> Existence -> ShowS
[Existence] -> ShowS
Existence -> String
(Int -> Existence -> ShowS)
-> (Existence -> String)
-> ([Existence] -> ShowS)
-> Show Existence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Existence] -> ShowS
$cshowList :: [Existence] -> ShowS
show :: Existence -> String
$cshow :: Existence -> String
showsPrec :: Int -> Existence -> ShowS
$cshowsPrec :: Int -> Existence -> ShowS
Show)

-- | combines Existence state with an NVRA
type ExistNVRA = (Existence, NVRA)

-- FIXME determine and add missing internal deps
-- | decide list of NVRs based on a Select selection (using a package prefix)
decideRPMs :: Yes -- ^ prompt default choice
           -> Bool -- ^ enable list mode which just display the package list
           -> Maybe ExistingStrategy -- ^ optional existing install strategy
           -> Select -- ^ specifies package Select choices
           -> String -- ^ package set prefix: allows abbreviated Select
           -> [NVRA] -- ^ list of packages to select from
           -> IO [ExistNVRA] -- ^ returns list of selected packages
decideRPMs :: Yes
-> Bool
-> Maybe ExistingStrategy
-> Select
-> String
-> [NVRA]
-> IO [ExistNVRA]
decideRPMs Yes
yes Bool
listmode Maybe ExistingStrategy
mstrategy Select
select String
prefix [NVRA]
nvras = do
  [ExistNVRA]
classified <- (NVRA -> IO (Maybe ExistNVRA)) -> [NVRA] -> IO [ExistNVRA]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM NVRA -> IO (Maybe ExistNVRA)
installExists ((NVRA -> Bool) -> [NVRA] -> [NVRA]
forall a. (a -> Bool) -> [a] -> [a]
filter NVRA -> Bool
isBinaryRpm [NVRA]
nvras)
  if Bool
listmode
    then do
    case Select
select of
      PkgsReq [String]
subpkgs [String]
exceptpkgs [String]
exclpkgs [String]
addpkgs ->
        (ExistNVRA -> IO ()) -> [ExistNVRA] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ExistNVRA -> IO ()
printInstalled ([ExistNVRA] -> IO ()) -> [ExistNVRA] -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
-> ([String], [String], [String], [String])
-> [ExistNVRA]
-> [ExistNVRA]
selectRPMs String
prefix ([String]
subpkgs,[String]
exceptpkgs,[String]
exclpkgs,[String]
addpkgs) [ExistNVRA]
classified
      Select
_ -> (ExistNVRA -> IO ()) -> [ExistNVRA] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ExistNVRA -> IO ()
printInstalled [ExistNVRA]
classified
    [ExistNVRA] -> IO [ExistNVRA]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else
    case Select
select of
      Select
All -> Maybe ExistingStrategy -> Yes -> [ExistNVRA] -> IO [ExistNVRA]
promptPkgs Maybe ExistingStrategy
mstrategy Yes
yes [ExistNVRA]
classified
      Select
Ask -> (ExistNVRA -> IO (Maybe ExistNVRA))
-> [ExistNVRA] -> IO [ExistNVRA]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (Yes -> ExistNVRA -> IO (Maybe ExistNVRA)
rpmPrompt Yes
yes) [ExistNVRA]
classified
      PkgsReq [String]
subpkgs [String]
exceptpkgs [String]
exclpkgs [String]
addpkgs ->
        Maybe ExistingStrategy -> Yes -> [ExistNVRA] -> IO [ExistNVRA]
promptPkgs Maybe ExistingStrategy
mstrategy Yes
yes ([ExistNVRA] -> IO [ExistNVRA]) -> [ExistNVRA] -> IO [ExistNVRA]
forall a b. (a -> b) -> a -> b
$
        String
-> ([String], [String], [String], [String])
-> [ExistNVRA]
-> [ExistNVRA]
selectRPMs String
prefix ([String]
subpkgs,[String]
exceptpkgs,[String]
exclpkgs,[String]
addpkgs) [ExistNVRA]
classified
  where
    installExists :: NVRA -> IO (Maybe ExistNVRA)
    installExists :: NVRA -> IO (Maybe ExistNVRA)
installExists NVRA
nvra = do
      -- FIXME this will fail for noarch changes
      -- FIXME check kernel
      Maybe String
minstalled <- String -> [String] -> IO (Maybe String)
cmdMaybe String
"rpm" [String
"-q", NVRA -> String
rpmName NVRA
nvra String -> ShowS
<.> NVRA -> String
rpmArch NVRA
nvra]
      let existence :: Existence
existence =
            case Maybe String
minstalled of
              Maybe String
Nothing -> Existence
NotInstalled
              Just String
installed ->
                if NVRA -> String
showNVRA NVRA
nvra String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String -> [String]
lines String
installed
                then Existence
ExistingNVR
                else Existence
ChangedNVR
      Maybe ExistNVRA -> IO (Maybe ExistNVRA)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExistNVRA -> IO (Maybe ExistNVRA))
-> Maybe ExistNVRA -> IO (Maybe ExistNVRA)
forall a b. (a -> b) -> a -> b
$
        case Maybe ExistingStrategy
mstrategy of
          Just ExistingStrategy
ExistingSkip | Existence
existence Existence -> Existence -> Bool
forall a. Eq a => a -> a -> Bool
/= Existence
NotInstalled -> Maybe ExistNVRA
forall a. Maybe a
Nothing
          Just ExistingStrategy
ExistingNoReinstall | Existence
existence Existence -> Existence -> Bool
forall a. Eq a => a -> a -> Bool
== Existence
ExistingNVR -> Maybe ExistNVRA
forall a. Maybe a
Nothing
          Just ExistingStrategy
ExistingOnly | Existence
existence Existence -> Existence -> Bool
forall a. Eq a => a -> a -> Bool
== Existence
NotInstalled -> Maybe ExistNVRA
forall a. Maybe a
Nothing
          Maybe ExistingStrategy
_ -> ExistNVRA -> Maybe ExistNVRA
forall a. a -> Maybe a
Just (Existence
existence, NVRA
nvra)

-- FIXME move to submodule?
selectRPMs :: String
           -- (subpkgs,except,exclpkgs,addpkgs)
           -> ([String],[String],[String],[String])
           -> [ExistNVRA] -> [ExistNVRA]
selectRPMs :: String
-> ([String], [String], [String], [String])
-> [ExistNVRA]
-> [ExistNVRA]
selectRPMs String
prefix ([String]
subpkgs,[String]
exceptpkgs,[String]
exclpkgs,[String]
addpkgs) [ExistNVRA]
rpms =
  let excluded :: [ExistNVRA]
excluded = String -> [String] -> [ExistNVRA] -> [ExistNVRA]
matchingRPMs String
prefix [String]
exclpkgs [ExistNVRA]
rpms
      included :: [ExistNVRA]
included = String -> [String] -> [ExistNVRA] -> [ExistNVRA]
matchingRPMs String
prefix [String]
addpkgs [ExistNVRA]
rpms
      matching :: [ExistNVRA]
matching =
        if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
subpkgs Bool -> Bool -> Bool
&& [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
exceptpkgs
        then [ExistNVRA] -> [ExistNVRA]
defaultRPMs [ExistNVRA]
rpms
        else String -> [String] -> [ExistNVRA] -> [ExistNVRA]
matchingRPMs String
prefix [String]
subpkgs [ExistNVRA]
rpms
      nonmatching :: [ExistNVRA]
nonmatching = String -> [String] -> [ExistNVRA] -> [ExistNVRA]
nonMatchingRPMs String
prefix [String]
exceptpkgs [ExistNVRA]
rpms
  in [ExistNVRA] -> [ExistNVRA]
forall a. Ord a => [a] -> [a]
nubSort ([ExistNVRA] -> [ExistNVRA]) -> [ExistNVRA] -> [ExistNVRA]
forall a b. (a -> b) -> a -> b
$ (([ExistNVRA]
matching [ExistNVRA] -> [ExistNVRA] -> [ExistNVRA]
forall a. [a] -> [a] -> [a]
++ [ExistNVRA]
nonmatching) [ExistNVRA] -> [ExistNVRA] -> [ExistNVRA]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ExistNVRA]
excluded) [ExistNVRA] -> [ExistNVRA] -> [ExistNVRA]
forall a. [a] -> [a] -> [a]
++ [ExistNVRA]
included

isBinaryRpm :: NVRA -> Bool
isBinaryRpm :: NVRA -> Bool
isBinaryRpm = (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"src") (String -> Bool) -> (NVRA -> String) -> NVRA -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVRA -> String
rpmArch

renderInstalled :: ExistNVRA -> String
renderInstalled :: ExistNVRA -> String
renderInstalled (Existence
exist, NVRA
nvra) =
  case Existence
exist of
    Existence
ExistingNVR -> Char
'='
    Existence
ChangedNVR -> Char
'^'
    Existence
NotInstalled -> Char
'+'
  Char -> ShowS
forall a. a -> [a] -> [a]
: NVRA -> String
showNVRA NVRA
nvra

printInstalled :: ExistNVRA -> IO ()
printInstalled :: ExistNVRA -> IO ()
printInstalled = String -> IO ()
putStrLn (String -> IO ()) -> (ExistNVRA -> String) -> ExistNVRA -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistNVRA -> String
renderInstalled

promptPkgs :: Maybe ExistingStrategy -> Yes -> [ExistNVRA] -> IO [ExistNVRA]
promptPkgs :: Maybe ExistingStrategy -> Yes -> [ExistNVRA] -> IO [ExistNVRA]
promptPkgs (Just ExistingStrategy
ExistingOnly) Yes
_ [] = do
  String -> IO ()
putStrLn String
"skipped"
  [ExistNVRA] -> IO [ExistNVRA]
forall (m :: * -> *) a. Monad m => a -> m a
return []
promptPkgs Maybe ExistingStrategy
_ Yes
_ [] = String -> IO [ExistNVRA]
forall a. String -> a
error' String
"no rpms found"
promptPkgs Maybe ExistingStrategy
_ Yes
yes [ExistNVRA]
classified = do
  (ExistNVRA -> IO ()) -> [ExistNVRA] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ExistNVRA -> IO ()
printInstalled [ExistNVRA]
classified
  Bool
ok <- Yes -> String -> IO Bool
prompt Yes
yes String
"install above"
  [ExistNVRA] -> IO [ExistNVRA]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ExistNVRA] -> IO [ExistNVRA]) -> [ExistNVRA] -> IO [ExistNVRA]
forall a b. (a -> b) -> a -> b
$ if Bool
ok then [ExistNVRA]
classified else []

prompt :: Yes -> String -> IO Bool
prompt :: Yes -> String -> IO Bool
prompt Yes
yes String
str = do
  if Yes
yes Yes -> Yes -> Bool
forall a. Eq a => a -> a -> Bool
== Yes
Yes
    then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else Bool -> String -> IO Bool
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Bool -> String -> m Bool
yesNoDefault Bool
True String
str

rpmPrompt :: Yes -> ExistNVRA -> IO (Maybe ExistNVRA)
rpmPrompt :: Yes -> ExistNVRA -> IO (Maybe ExistNVRA)
rpmPrompt Yes
yes ExistNVRA
epn = do
  Bool
ok <- Yes -> String -> IO Bool
prompt Yes
yes (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ ExistNVRA -> String
renderInstalled ExistNVRA
epn
  Maybe ExistNVRA -> IO (Maybe ExistNVRA)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExistNVRA -> IO (Maybe ExistNVRA))
-> Maybe ExistNVRA -> IO (Maybe ExistNVRA)
forall a b. (a -> b) -> a -> b
$
    if Bool
ok
    then ExistNVRA -> Maybe ExistNVRA
forall a. a -> Maybe a
Just ExistNVRA
epn
    else Maybe ExistNVRA
forall a. Maybe a
Nothing

defaultRPMs :: [ExistNVRA] -> [ExistNVRA]
defaultRPMs :: [ExistNVRA] -> [ExistNVRA]
defaultRPMs [ExistNVRA]
rpms =
  let installed :: [ExistNVRA]
installed = (ExistNVRA -> Bool) -> [ExistNVRA] -> [ExistNVRA]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Existence -> Existence -> Bool
forall a. Eq a => a -> a -> Bool
/= Existence
NotInstalled) (Existence -> Bool)
-> (ExistNVRA -> Existence) -> ExistNVRA -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistNVRA -> Existence
forall a b. (a, b) -> a
fst) [ExistNVRA]
rpms
  in if [ExistNVRA] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExistNVRA]
installed
     then [ExistNVRA]
rpms
     else [ExistNVRA]
installed

matchingRPMs :: String -> [String] -> [ExistNVRA] -> [ExistNVRA]
matchingRPMs :: String -> [String] -> [ExistNVRA] -> [ExistNVRA]
matchingRPMs String
prefix [String]
subpkgs [ExistNVRA]
rpms =
  [ExistNVRA] -> [ExistNVRA]
forall a. Ord a => [a] -> [a]
nubSort ([ExistNVRA] -> [ExistNVRA])
-> ([[ExistNVRA]] -> [ExistNVRA]) -> [[ExistNVRA]] -> [ExistNVRA]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ExistNVRA]] -> [ExistNVRA]
forall a. Monoid a => [a] -> a
mconcat ([[ExistNVRA]] -> [ExistNVRA]) -> [[ExistNVRA]] -> [ExistNVRA]
forall a b. (a -> b) -> a -> b
$
  ((String -> [ExistNVRA]) -> [String] -> [[ExistNVRA]])
-> [String] -> (String -> [ExistNVRA]) -> [[ExistNVRA]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> [ExistNVRA]) -> [String] -> [[ExistNVRA]]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd [String]
subpkgs) ((String -> [ExistNVRA]) -> [[ExistNVRA]])
-> (String -> [ExistNVRA]) -> [[ExistNVRA]]
forall a b. (a -> b) -> a -> b
$ \ String
pkgpat ->
  case String -> [ExistNVRA]
getMatches String
pkgpat of
    [] -> if String -> Maybe Char
forall a. [a] -> Maybe a
headMay String
pkgpat Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'*'
          then
            case String -> [ExistNVRA]
getMatches (String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: String
pkgpat) of
              [] -> String -> [ExistNVRA]
forall a. String -> a
error' (String -> [ExistNVRA]) -> String -> [ExistNVRA]
forall a b. (a -> b) -> a -> b
$ String
"no subpackage match for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgpat
              [ExistNVRA]
result -> [ExistNVRA]
result
          else String -> [ExistNVRA]
forall a. String -> a
error' (String -> [ExistNVRA]) -> String -> [ExistNVRA]
forall a b. (a -> b) -> a -> b
$ String
"no subpackage match for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pkgpat
    [ExistNVRA]
result -> [ExistNVRA]
result
  where
    getMatches :: String -> [ExistNVRA]
    getMatches :: String -> [ExistNVRA]
getMatches String
pkgpat =
      (ExistNVRA -> Bool) -> [ExistNVRA] -> [ExistNVRA]
forall a. (a -> Bool) -> [a] -> [a]
filter (Pattern -> String -> Bool
match (String -> Pattern
compile String
pkgpat) (String -> Bool) -> (ExistNVRA -> String) -> ExistNVRA -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVRA -> String
rpmName (NVRA -> String) -> (ExistNVRA -> NVRA) -> ExistNVRA -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistNVRA -> NVRA
forall a b. (a, b) -> b
snd) [ExistNVRA]
rpms

nonMatchingRPMs :: String -> [String] -> [ExistNVRA] -> [ExistNVRA]
nonMatchingRPMs :: String -> [String] -> [ExistNVRA] -> [ExistNVRA]
nonMatchingRPMs String
_ [] [ExistNVRA]
_ = []
nonMatchingRPMs String
prefix [String]
subpkgs [ExistNVRA]
rpms =
  -- FIXME somehow determine unused excludes
  [ExistNVRA] -> [ExistNVRA]
forall a. Ord a => [a] -> [a]
nubSort ([ExistNVRA] -> [ExistNVRA]) -> [ExistNVRA] -> [ExistNVRA]
forall a b. (a -> b) -> a -> b
$ ([ExistNVRA] -> ExistNVRA -> [ExistNVRA])
-> [ExistNVRA] -> [ExistNVRA] -> [ExistNVRA]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([String] -> [ExistNVRA] -> ExistNVRA -> [ExistNVRA]
exclude ([String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd [String]
subpkgs)) [] [ExistNVRA]
rpms
  where
    rpmnames :: [String]
rpmnames = (ExistNVRA -> String) -> [ExistNVRA] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (NVRA -> String
rpmName (NVRA -> String) -> (ExistNVRA -> NVRA) -> ExistNVRA -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistNVRA -> NVRA
forall a b. (a, b) -> b
snd) [ExistNVRA]
rpms

    exclude :: [String] -> [ExistNVRA] -> ExistNVRA
            -> [ExistNVRA]
    exclude :: [String] -> [ExistNVRA] -> ExistNVRA -> [ExistNVRA]
exclude [] [ExistNVRA]
acc ExistNVRA
rpm = [ExistNVRA]
acc [ExistNVRA] -> [ExistNVRA] -> [ExistNVRA]
forall a. [a] -> [a] -> [a]
++ [ExistNVRA
rpm]
    exclude (String
pat:[String]
pats) [ExistNVRA]
acc ExistNVRA
rpm =
        if String -> Bool
checkMatch (NVRA -> String
rpmName (ExistNVRA -> NVRA
forall a b. (a, b) -> b
snd ExistNVRA
rpm))
        then [ExistNVRA]
acc
        else [String] -> [ExistNVRA] -> ExistNVRA -> [ExistNVRA]
exclude [String]
pats [ExistNVRA]
acc ExistNVRA
rpm
      where
        checkMatch :: String -> Bool
        checkMatch :: String -> Bool
checkMatch String
rpmname =
          let comppat :: Pattern
comppat = String -> Pattern
compile String
pat
          in if Pattern -> Bool
isLiteral Pattern
comppat
             then String
pat String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
rpmname Bool -> Bool -> Bool
||
                  String
pat String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
rpmnames Bool -> Bool -> Bool
&&
                  (String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: String
pat) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
rpmname
             else Pattern -> String -> Bool
match Pattern
comppat String
rpmname

notDebugPkg :: String -> Bool
notDebugPkg :: String -> Bool
notDebugPkg String
p =
  Bool -> Bool
not (String
"-debuginfo-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
p Bool -> Bool -> Bool
|| String
"-debugsource-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
p)

-- | whether a package needs to be reinstalled or installed
data InstallType = ReInstall
                 | Install

-- | package manager
data PkgMgr = DNF3 | DNF5 | RPM | OSTREE
  deriving PkgMgr -> PkgMgr -> Bool
(PkgMgr -> PkgMgr -> Bool)
-> (PkgMgr -> PkgMgr -> Bool) -> Eq PkgMgr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgMgr -> PkgMgr -> Bool
$c/= :: PkgMgr -> PkgMgr -> Bool
== :: PkgMgr -> PkgMgr -> Bool
$c== :: PkgMgr -> PkgMgr -> Bool
Eq

-- FIXME support options per build: install ibus imsettings -i plasma
-- (or don't error if multiple packages)
-- | do installation of packages
installRPMs :: Bool -- ^ dry-run
            -> Bool -- ^ debug output
            -> Maybe PkgMgr -- ^ optional specify package manager
            -> Yes -- ^ prompt default choice
            -> [(FilePath,[ExistNVRA])] -- ^ list of rpms to install with path
            -> IO ()
installRPMs :: Bool
-> Bool -> Maybe PkgMgr -> Yes -> [(String, [ExistNVRA])] -> IO ()
installRPMs Bool
_ Bool
_ Maybe PkgMgr
_ Yes
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
installRPMs Bool
dryrun Bool
debug Maybe PkgMgr
mmgr Yes
yes [(String, [ExistNVRA])]
classifieds = do
  case [(String, ExistNVRA)] -> ([(String, NVRA)], [(String, NVRA)])
installTypes (((String, [ExistNVRA]) -> [(String, ExistNVRA)])
-> [(String, [ExistNVRA])] -> [(String, ExistNVRA)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [ExistNVRA]) -> [(String, ExistNVRA)]
zipDir [(String, [ExistNVRA])]
classifieds) of
    ([],[(String, NVRA)]
is) -> InstallType -> [(String, NVRA)] -> IO ()
doInstall InstallType
Install [(String, NVRA)]
is
    ([(String, NVRA)]
ris,[(String, NVRA)]
is) -> do
      InstallType -> [(String, NVRA)] -> IO ()
doInstall InstallType
ReInstall ([(String, NVRA)]
ris [(String, NVRA)] -> [(String, NVRA)] -> [(String, NVRA)]
forall a. [a] -> [a] -> [a]
++ [(String, NVRA)]
is) -- include any new deps
      InstallType -> [(String, NVRA)] -> IO ()
doInstall InstallType
Install [(String, NVRA)]
is            -- install any non-deps
  where
    zipDir :: (FilePath,[ExistNVRA]) -> [(FilePath,ExistNVRA)]
    zipDir :: (String, [ExistNVRA]) -> [(String, ExistNVRA)]
zipDir (String
dir, [ExistNVRA]
rpms) = (ExistNVRA -> (String, ExistNVRA))
-> [ExistNVRA] -> [(String, ExistNVRA)]
forall a b. (a -> b) -> [a] -> [b]
map (String
dir,) [ExistNVRA]
rpms

    installTypes :: [(FilePath,ExistNVRA)]
                 -> ([(FilePath,NVRA)],[(FilePath,NVRA)])
    installTypes :: [(String, ExistNVRA)] -> ([(String, NVRA)], [(String, NVRA)])
installTypes = [Either (String, NVRA) (String, NVRA)]
-> ([(String, NVRA)], [(String, NVRA)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (String, NVRA) (String, NVRA)]
 -> ([(String, NVRA)], [(String, NVRA)]))
-> ([(String, ExistNVRA)]
    -> [Either (String, NVRA) (String, NVRA)])
-> [(String, ExistNVRA)]
-> ([(String, NVRA)], [(String, NVRA)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, ExistNVRA) -> Either (String, NVRA) (String, NVRA))
-> [(String, ExistNVRA)] -> [Either (String, NVRA) (String, NVRA)]
forall a b. (a -> b) -> [a] -> [b]
map (String, ExistNVRA) -> Either (String, NVRA) (String, NVRA)
partExist
      where
        partExist :: (FilePath,ExistNVRA)
                  -> Either (FilePath,NVRA) (FilePath,NVRA)
        partExist :: (String, ExistNVRA) -> Either (String, NVRA) (String, NVRA)
partExist (String
d,(Existence
e,NVRA
n)) = (if Existence
e Existence -> Existence -> Bool
forall a. Eq a => a -> a -> Bool
== Existence
ExistingNVR then (String, NVRA) -> Either (String, NVRA) (String, NVRA)
forall a b. a -> Either a b
Left else (String, NVRA) -> Either (String, NVRA) (String, NVRA)
forall a b. b -> Either a b
Right) (String
d,NVRA
n)

    doInstall :: InstallType -> [(FilePath,NVRA)] -> IO ()
    doInstall :: InstallType -> [(String, NVRA)] -> IO ()
doInstall InstallType
inst [(String, NVRA)]
dirpkgs =
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(String, NVRA)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, NVRA)]
dirpkgs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      PkgMgr
mgr <-
        case Maybe PkgMgr
mmgr of
          Just PkgMgr
m -> PkgMgr -> IO PkgMgr
forall (m :: * -> *) a. Monad m => a -> m a
return PkgMgr
m
          Maybe PkgMgr
Nothing -> do
            Bool
ostree <- String -> IO Bool
doesDirectoryExist String
"/sysroot/ostree"
            if Bool
ostree
              then PkgMgr -> IO PkgMgr
forall (m :: * -> *) a. Monad m => a -> m a
return PkgMgr
OSTREE
              else do
              Maybe String
mdnf5 <- String -> IO (Maybe String)
findExecutable String
"dnf5"
              PkgMgr -> IO PkgMgr
forall (m :: * -> *) a. Monad m => a -> m a
return (PkgMgr -> IO PkgMgr) -> PkgMgr -> IO PkgMgr
forall a b. (a -> b) -> a -> b
$ PkgMgr -> (String -> PkgMgr) -> Maybe String -> PkgMgr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PkgMgr
DNF3 (PkgMgr -> String -> PkgMgr
forall a b. a -> b -> a
const PkgMgr
DNF5) Maybe String
mdnf5
      let pkgmgr :: String
pkgmgr =
            case PkgMgr
mgr of
              PkgMgr
DNF3 -> String
"dnf-3"
              PkgMgr
DNF5 -> String
"dnf5"
              PkgMgr
RPM -> String
"rpm"
              PkgMgr
OSTREE -> String
"rpm-ostree"
          com :: [String]
com =
            case InstallType
inst of
              InstallType
ReInstall -> PkgMgr -> [String]
reinstallCommand PkgMgr
mgr
              InstallType
Install -> PkgMgr -> [String]
installCommand PkgMgr
mgr
        in
        if Bool
dryrun
        then (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ (String
"would" String -> ShowS
+-+ [String] -> String
unwords (String
pkgmgr String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
com) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String, NVRA) -> String) -> [(String, NVRA)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, NVRA) -> String
showRpmFile [(String, NVRA)]
dirpkgs
        else do
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ((String, NVRA) -> IO ()) -> [(String, NVRA)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ())
-> ((String, NVRA) -> String) -> (String, NVRA) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, NVRA) -> String
showRpmFile) [(String, NVRA)]
dirpkgs
          (case PkgMgr
mgr of
            PkgMgr
OSTREE -> String -> [String] -> IO ()
cmd_
            PkgMgr
_ -> if Bool
debug then String -> [String] -> IO ()
sudoLog else String -> [String] -> IO ()
sudo_) String
pkgmgr ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [String]
com [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((String, NVRA) -> String) -> [(String, NVRA)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, NVRA) -> String
showRpmFile [(String, NVRA)]
dirpkgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--assumeyes" | Yes
yes Yes -> Yes -> Bool
forall a. Eq a => a -> a -> Bool
== Yes
Yes Bool -> Bool -> Bool
&& PkgMgr
mgr PkgMgr -> [PkgMgr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PkgMgr
DNF3,PkgMgr
DNF5]]

    reinstallCommand :: PkgMgr -> [String]
    reinstallCommand :: PkgMgr -> [String]
reinstallCommand PkgMgr
mgr =
      case PkgMgr
mgr of
        PkgMgr
DNF3 -> [String
"reinstall"]
        PkgMgr
DNF5 -> [String
"reinstall"]
        PkgMgr
RPM -> [String
"-Uvh",String
"--replacepkgs"]
        PkgMgr
OSTREE -> [String
"install"]

    installCommand :: PkgMgr -> [String]
    installCommand :: PkgMgr -> [String]
installCommand PkgMgr
mgr =
      case PkgMgr
mgr of
        PkgMgr
DNF3 -> [String
"localinstall"]
        PkgMgr
DNF5 -> [String
"install"]
        PkgMgr
RPM -> [String
"-ivh"]
        PkgMgr
OSTREE -> [String
"install"]

-- FIXME replace with export from rpm-nvr (once released)
-- | render a NVRA as rpm file
nvraToRPM :: NVRA -> FilePath
nvraToRPM :: NVRA -> String
nvraToRPM NVRA
nvra = NVRA -> String
showNVRA NVRA
nvra String -> ShowS
<.> String
"rpm"

-- | render path and NVRA are rpm filepath
showRpmFile :: (FilePath,NVRA) -> FilePath
showRpmFile :: (String, NVRA) -> String
showRpmFile (String
dir,NVRA
nvra) = String
dir String -> ShowS
</> NVRA -> String
nvraToRPM NVRA
nvra

-- | group rpms by arch (subdirs)
groupOnArch :: FilePath -- ^ prefix directory (eg "RPMS")
            -> [ExistNVRA]
            -> [(FilePath,[ExistNVRA])]
groupOnArch :: String -> [ExistNVRA] -> [(String, [ExistNVRA])]
groupOnArch String
dir = (ExistNVRA -> String) -> [ExistNVRA] -> [(String, [ExistNVRA])]
forall k a. Eq k => (a -> k) -> [a] -> [(k, [a])]
groupOnKey (\(Existence
_,NVRA
p) -> String
dir String -> ShowS
</> NVRA -> String
rpmArch NVRA
p)

#if !MIN_VERSION_extra(1,7,11)
groupOnKey :: Eq k => (a -> k) -> [a] -> [(k, [a])]
groupOnKey :: (a -> k) -> [a] -> [(k, [a])]
groupOnKey a -> k
_ []     = []
groupOnKey a -> k
f (a
x:[a]
xs) = (k
fx, a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
yes) (k, [a]) -> [(k, [a])] -> [(k, [a])]
forall a. a -> [a] -> [a]
: (a -> k) -> [a] -> [(k, [a])]
forall k a. Eq k => (a -> k) -> [a] -> [(k, [a])]
groupOnKey a -> k
f [a]
no
    where
        fx :: k
fx = a -> k
f a
x
        ([a]
yes, [a]
no) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\a
y -> k
fx k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== a -> k
f a
y) [a]
xs
#endif

#if !MIN_VERSION_simple_cmd(0,2,7)
sudoLog :: String -- ^ command
     -> [String] -- ^ arguments
     -> IO ()
sudoLog :: String -> [String] -> IO ()
sudoLog = String -> [String] -> IO ()
sudo_
#endif