{-# LANGUAGE TupleSections #-}

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

import Control.Monad.Extra (forM_, mapMaybeM, unless, when)
import Data.Either (partitionEithers)
import Data.List.Extra (foldl', groupOnKey, isInfixOf, nubOrd, nubSort, sort,
                        (\\))
import Data.RPM.NVRA (NVRA(..), readNVRA, showNVRA)
import Safe (headMay)
import SimpleCmd (cmd_, cmdMaybe, error', sudo_, (+-+))
import SimpleCmdArgs (Parser, 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
$c== :: Select -> Select -> Bool
== :: Select -> Select -> Bool
$c/= :: Select -> Select -> Bool
/= :: Select -> Select -> Bool
Eq

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

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

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

    checkPat :: t a -> a -> a
checkPat t a
w' a
f =
      if t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
w'
      then FilePath -> a
forall a. FilePath -> a
error' FilePath
"empty pattern!"
      else a
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 :: forall (m :: * -> *). Monad m => Select -> m ()
checkSelection (PkgsReq [FilePath]
ps [FilePath]
es [FilePath]
xs [FilePath]
is) =
  [FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([FilePath]
ps [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
es [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
xs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
is) ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
s ->
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall a. FilePath -> a
error' FilePath
"empty package pattern not allowed"
checkSelection Select
_ = () -> m ()
forall a. a -> m a
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 :: [FilePath] -> [NVRA]
rpmsToNVRAs = [NVRA] -> [NVRA]
forall a. Ord a => [a] -> [a]
sort ([NVRA] -> [NVRA])
-> ([FilePath] -> [NVRA]) -> [FilePath] -> [NVRA]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> NVRA) -> [FilePath] -> [NVRA]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> NVRA
readNVRA ([FilePath] -> [NVRA])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [NVRA]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
notDebugPkg

-- | how to handle already installed packages: re-install or skip
data ExistingStrategy = ExistingNoReinstall | ExistingSkip

-- | 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
$c== :: Yes -> Yes -> Bool
== :: Yes -> Yes -> Bool
$c/= :: Yes -> Yes -> Bool
/= :: 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
$c== :: Existence -> Existence -> Bool
== :: Existence -> Existence -> Bool
$c/= :: Existence -> Existence -> Bool
/= :: 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
$ccompare :: Existence -> Existence -> Ordering
compare :: Existence -> Existence -> Ordering
$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
>= :: Existence -> Existence -> Bool
$cmax :: Existence -> Existence -> Existence
max :: Existence -> Existence -> Existence
$cmin :: Existence -> Existence -> Existence
min :: Existence -> Existence -> Existence
Ord, Int -> Existence -> ShowS
[Existence] -> ShowS
Existence -> FilePath
(Int -> Existence -> ShowS)
-> (Existence -> FilePath)
-> ([Existence] -> ShowS)
-> Show Existence
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Existence -> ShowS
showsPrec :: Int -> Existence -> ShowS
$cshow :: Existence -> FilePath
show :: Existence -> FilePath
$cshowList :: [Existence] -> ShowS
showList :: [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
-> FilePath
-> [NVRA]
-> IO [ExistNVRA]
decideRPMs Yes
yes Bool
listmode Maybe ExistingStrategy
mstrategy Select
select FilePath
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 [FilePath]
subpkgs [FilePath]
exceptpkgs [FilePath]
exclpkgs [FilePath]
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
$
        FilePath
-> ([FilePath], [FilePath], [FilePath], [FilePath])
-> [ExistNVRA]
-> [ExistNVRA]
selectRPMs FilePath
prefix ([FilePath]
subpkgs,[FilePath]
exceptpkgs,[FilePath]
exclpkgs,[FilePath]
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else
    case Select
select of
      Select
All -> Yes -> [ExistNVRA] -> IO [ExistNVRA]
promptPkgs 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 [FilePath]
subpkgs [FilePath]
exceptpkgs [FilePath]
exclpkgs [FilePath]
addpkgs ->
        Yes -> [ExistNVRA] -> IO [ExistNVRA]
promptPkgs Yes
yes ([ExistNVRA] -> IO [ExistNVRA]) -> [ExistNVRA] -> IO [ExistNVRA]
forall a b. (a -> b) -> a -> b
$
        FilePath
-> ([FilePath], [FilePath], [FilePath], [FilePath])
-> [ExistNVRA]
-> [ExistNVRA]
selectRPMs FilePath
prefix ([FilePath]
subpkgs,[FilePath]
exceptpkgs,[FilePath]
exclpkgs,[FilePath]
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 FilePath
minstalled <- FilePath -> [FilePath] -> IO (Maybe FilePath)
cmdMaybe FilePath
"rpm" [FilePath
"-q", NVRA -> FilePath
rpmName NVRA
nvra FilePath -> ShowS
<.> NVRA -> FilePath
rpmArch NVRA
nvra]
      let existence :: Existence
existence =
            case Maybe FilePath
minstalled of
              Maybe FilePath
Nothing -> Existence
NotInstalled
              Just FilePath
installed ->
                if NVRA -> FilePath
showNVRA NVRA
nvra FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath -> [FilePath]
lines FilePath
installed
                then Existence
ExistingNVR
                else Existence
ChangedNVR
      Maybe ExistNVRA -> IO (Maybe ExistNVRA)
forall a. a -> IO a
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
          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 :: FilePath
-> ([FilePath], [FilePath], [FilePath], [FilePath])
-> [ExistNVRA]
-> [ExistNVRA]
selectRPMs FilePath
prefix ([FilePath]
subpkgs,[FilePath]
exceptpkgs,[FilePath]
exclpkgs,[FilePath]
addpkgs) [ExistNVRA]
rpms =
  let excluded :: [ExistNVRA]
excluded = FilePath -> [FilePath] -> [ExistNVRA] -> [ExistNVRA]
matchingRPMs FilePath
prefix [FilePath]
exclpkgs [ExistNVRA]
rpms
      included :: [ExistNVRA]
included = FilePath -> [FilePath] -> [ExistNVRA] -> [ExistNVRA]
matchingRPMs FilePath
prefix [FilePath]
addpkgs [ExistNVRA]
rpms
      matching :: [ExistNVRA]
matching =
        if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
subpkgs Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
exceptpkgs
        then [ExistNVRA] -> [ExistNVRA]
defaultRPMs [ExistNVRA]
rpms
        else FilePath -> [FilePath] -> [ExistNVRA] -> [ExistNVRA]
matchingRPMs FilePath
prefix [FilePath]
subpkgs [ExistNVRA]
rpms
      nonmatching :: [ExistNVRA]
nonmatching = FilePath -> [FilePath] -> [ExistNVRA] -> [ExistNVRA]
nonMatchingRPMs FilePath
prefix [FilePath]
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 = (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"src") (FilePath -> Bool) -> (NVRA -> FilePath) -> NVRA -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVRA -> FilePath
rpmArch

renderInstalled :: ExistNVRA -> String
renderInstalled :: ExistNVRA -> FilePath
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 -> FilePath
showNVRA NVRA
nvra

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

promptPkgs :: Yes -> [ExistNVRA]
           -> IO [ExistNVRA]
promptPkgs :: Yes -> [ExistNVRA] -> IO [ExistNVRA]
promptPkgs Yes
_ [] = FilePath -> IO [ExistNVRA]
forall a. FilePath -> a
error' FilePath
"no rpms found"
promptPkgs 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 -> FilePath -> IO Bool
prompt Yes
yes FilePath
"install above"
  [ExistNVRA] -> IO [ExistNVRA]
forall a. a -> IO a
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 -> FilePath -> IO Bool
prompt Yes
yes FilePath
str = do
  if Yes
yes Yes -> Yes -> Bool
forall a. Eq a => a -> a -> Bool
== Yes
Yes
    then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else Bool -> FilePath -> IO Bool
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Bool -> FilePath -> m Bool
yesNoDefault Bool
True FilePath
str

rpmPrompt :: Yes -> ExistNVRA -> IO (Maybe ExistNVRA)
rpmPrompt :: Yes -> ExistNVRA -> IO (Maybe ExistNVRA)
rpmPrompt Yes
yes ExistNVRA
epn = do
  Bool
ok <- Yes -> FilePath -> IO Bool
prompt Yes
yes (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ ExistNVRA -> FilePath
renderInstalled ExistNVRA
epn
  Maybe ExistNVRA -> IO (Maybe ExistNVRA)
forall a. a -> IO a
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExistNVRA]
installed
     then [ExistNVRA]
rpms
     else [ExistNVRA]
installed

matchingRPMs :: String -> [String] -> [ExistNVRA] -> [ExistNVRA]
matchingRPMs :: FilePath -> [FilePath] -> [ExistNVRA] -> [ExistNVRA]
matchingRPMs FilePath
prefix [FilePath]
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
$
  ((FilePath -> [ExistNVRA]) -> [FilePath] -> [[ExistNVRA]])
-> [FilePath] -> (FilePath -> [ExistNVRA]) -> [[ExistNVRA]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FilePath -> [ExistNVRA]) -> [FilePath] -> [[ExistNVRA]]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd [FilePath]
subpkgs) ((FilePath -> [ExistNVRA]) -> [[ExistNVRA]])
-> (FilePath -> [ExistNVRA]) -> [[ExistNVRA]]
forall a b. (a -> b) -> a -> b
$ \ FilePath
pkgpat ->
  case FilePath -> [ExistNVRA]
getMatches FilePath
pkgpat of
    [] -> if FilePath -> Maybe Char
forall a. [a] -> Maybe a
headMay FilePath
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 FilePath -> [ExistNVRA]
getMatches (FilePath
prefix FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
pkgpat) of
              [] -> FilePath -> [ExistNVRA]
forall a. FilePath -> a
error' (FilePath -> [ExistNVRA]) -> FilePath -> [ExistNVRA]
forall a b. (a -> b) -> a -> b
$ FilePath
"no subpackage match for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
pkgpat
              [ExistNVRA]
result -> [ExistNVRA]
result
          else FilePath -> [ExistNVRA]
forall a. FilePath -> a
error' (FilePath -> [ExistNVRA]) -> FilePath -> [ExistNVRA]
forall a b. (a -> b) -> a -> b
$ FilePath
"no subpackage match for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
pkgpat
    [ExistNVRA]
result -> [ExistNVRA]
result
  where
    getMatches :: String -> [ExistNVRA]
    getMatches :: FilePath -> [ExistNVRA]
getMatches FilePath
pkgpat =
      (ExistNVRA -> Bool) -> [ExistNVRA] -> [ExistNVRA]
forall a. (a -> Bool) -> [a] -> [a]
filter (Pattern -> FilePath -> Bool
match (FilePath -> Pattern
compile FilePath
pkgpat) (FilePath -> Bool) -> (ExistNVRA -> FilePath) -> ExistNVRA -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVRA -> FilePath
rpmName (NVRA -> FilePath) -> (ExistNVRA -> NVRA) -> ExistNVRA -> FilePath
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 :: FilePath -> [FilePath] -> [ExistNVRA] -> [ExistNVRA]
nonMatchingRPMs FilePath
_ [] [ExistNVRA]
_ = []
nonMatchingRPMs FilePath
prefix [FilePath]
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 b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([FilePath] -> [ExistNVRA] -> ExistNVRA -> [ExistNVRA]
exclude ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd [FilePath]
subpkgs)) [] [ExistNVRA]
rpms
  where
    rpmnames :: [FilePath]
rpmnames = (ExistNVRA -> FilePath) -> [ExistNVRA] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (NVRA -> FilePath
rpmName (NVRA -> FilePath) -> (ExistNVRA -> NVRA) -> ExistNVRA -> FilePath
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 :: [FilePath] -> [ExistNVRA] -> ExistNVRA -> [ExistNVRA]
exclude [] [ExistNVRA]
acc ExistNVRA
rpm = [ExistNVRA]
acc [ExistNVRA] -> [ExistNVRA] -> [ExistNVRA]
forall a. [a] -> [a] -> [a]
++ [ExistNVRA
rpm]
    exclude (FilePath
pat:[FilePath]
pats) [ExistNVRA]
acc ExistNVRA
rpm =
        if FilePath -> Bool
checkMatch (NVRA -> FilePath
rpmName (ExistNVRA -> NVRA
forall a b. (a, b) -> b
snd ExistNVRA
rpm))
        then [ExistNVRA]
acc
        else [FilePath] -> [ExistNVRA] -> ExistNVRA -> [ExistNVRA]
exclude [FilePath]
pats [ExistNVRA]
acc ExistNVRA
rpm
      where
        checkMatch :: String -> Bool
        checkMatch :: FilePath -> Bool
checkMatch FilePath
rpmname =
          let comppat :: Pattern
comppat = FilePath -> Pattern
compile FilePath
pat
          in if Pattern -> Bool
isLiteral Pattern
comppat
             then FilePath
pat FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
rpmname Bool -> Bool -> Bool
||
                  FilePath
pat FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
rpmnames Bool -> Bool -> Bool
&&
                  (FilePath
prefix FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
pat) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
rpmname
             else Pattern -> FilePath -> Bool
match Pattern
comppat FilePath
rpmname

notDebugPkg :: String -> Bool
notDebugPkg :: FilePath -> Bool
notDebugPkg FilePath
p =
  Bool -> Bool
not (FilePath
"-debuginfo-" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
p Bool -> Bool -> Bool
|| FilePath
"-debugsource-" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
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
$c== :: PkgMgr -> PkgMgr -> Bool
== :: PkgMgr -> PkgMgr -> Bool
$c/= :: PkgMgr -> PkgMgr -> Bool
/= :: 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
-> [(FilePath, [ExistNVRA])]
-> IO ()
installRPMs Bool
_ Bool
_ Maybe PkgMgr
_ Yes
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
installRPMs Bool
dryrun Bool
debug Maybe PkgMgr
mmgr Yes
yes [(FilePath, [ExistNVRA])]
classifieds = do
  case [(FilePath, ExistNVRA)] -> ([(FilePath, NVRA)], [(FilePath, NVRA)])
installTypes (((FilePath, [ExistNVRA]) -> [(FilePath, ExistNVRA)])
-> [(FilePath, [ExistNVRA])] -> [(FilePath, ExistNVRA)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FilePath, [ExistNVRA]) -> [(FilePath, ExistNVRA)]
zipDir [(FilePath, [ExistNVRA])]
classifieds) of
    ([],[(FilePath, NVRA)]
is) -> InstallType -> [(FilePath, NVRA)] -> IO ()
doInstall InstallType
Install [(FilePath, NVRA)]
is
    ([(FilePath, NVRA)]
ris,[(FilePath, NVRA)]
is) -> do
      InstallType -> [(FilePath, NVRA)] -> IO ()
doInstall InstallType
ReInstall ([(FilePath, NVRA)]
ris [(FilePath, NVRA)] -> [(FilePath, NVRA)] -> [(FilePath, NVRA)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, NVRA)]
is) -- include any new deps
      InstallType -> [(FilePath, NVRA)] -> IO ()
doInstall InstallType
Install [(FilePath, NVRA)]
is            -- install any non-deps
  where
    zipDir :: (FilePath,[ExistNVRA]) -> [(FilePath,ExistNVRA)]
    zipDir :: (FilePath, [ExistNVRA]) -> [(FilePath, ExistNVRA)]
zipDir (FilePath
dir, [ExistNVRA]
rpms) = (ExistNVRA -> (FilePath, ExistNVRA))
-> [ExistNVRA] -> [(FilePath, ExistNVRA)]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir,) [ExistNVRA]
rpms

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

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

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

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

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

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

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