{-# 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)
data Select = All
| Ask
| PkgsReq
[String]
[String]
[String]
[String]
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
selectDefault :: Select
selectDefault :: Select
selectDefault = [String] -> [String] -> [String] -> [String] -> Select
PkgsReq [] [] [] []
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")
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
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 ()
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
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"
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
data Existence = ExistingNVR
| ChangedNVR
| NotInstalled
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)
type ExistNVRA = (Existence, NVRA)
decideRPMs :: Yes
-> Bool
-> Maybe ExistingStrategy
-> Select
-> String
-> [NVRA]
-> IO [ExistNVRA]
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
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)
selectRPMs :: String
-> ([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 =
[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)
data InstallType = ReInstall
| Install
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
installRPMs :: Bool
-> Bool
-> Maybe PkgMgr
-> Yes
-> [(FilePath,[ExistNVRA])]
-> 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)
InstallType -> [(String, NVRA)] -> IO ()
doInstall InstallType
Install [(String, NVRA)]
is
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"]
nvraToRPM :: NVRA -> FilePath
nvraToRPM :: NVRA -> String
nvraToRPM NVRA
nvra = NVRA -> String
showNVRA NVRA
nvra String -> ShowS
<.> String
"rpm"
showRpmFile :: (FilePath,NVRA) -> FilePath
showRpmFile :: (String, NVRA) -> String
showRpmFile (String
dir,NVRA
nvra) = String
dir String -> ShowS
</> NVRA -> String
nvraToRPM NVRA
nvra
groupOnArch :: FilePath
-> [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
-> [String]
-> IO ()
sudoLog :: String -> [String] -> IO ()
sudoLog = String -> [String] -> IO ()
sudo_
#endif