-- | Maintainer: Zihao Wang <dev@wzhd.org>
--
-- Support for the Pacman package manager <https://www.archlinux.org/pacman/>

module Propellor.Property.Pacman where

import Propellor.Base

runPacman :: [String] -> UncheckedProperty ArchLinux
runPacman :: [String] -> UncheckedProperty ArchLinux
runPacman [String]
ps = UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UncheckedProperty ArchLinux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (UncheckedProperty
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> UncheckedProperty ArchLinux)
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UncheckedProperty ArchLinux
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"pacman" [String]
ps

-- | Have pacman update its lists of packages, but without upgrading anything.
update :: Property ArchLinux
update :: Property ArchLinux
update =  String -> Props ArchLinux -> Property ArchLinux
forall k (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (String
"pacman update") (Props ArchLinux -> Property ArchLinux)
-> Props ArchLinux -> Property ArchLinux
forall a b. (a -> b) -> a -> b
$ Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
	Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property ArchLinux
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSArchLinux]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& [String] -> UncheckedProperty ArchLinux
runPacman [String
"-Sy", String
"--noconfirm"]
		UncheckedProperty ArchLinux -> Result -> Property ArchLinux
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange

upgrade :: Property ArchLinux
upgrade :: Property ArchLinux
upgrade = String -> Props ArchLinux -> Property ArchLinux
forall k (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (String
"pacman upgrade") (Props ArchLinux -> Property ArchLinux)
-> Props ArchLinux -> Property ArchLinux
forall a b. (a -> b) -> a -> b
$ Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
	Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property ArchLinux
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSArchLinux]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& [String] -> UncheckedProperty ArchLinux
runPacman [String
"-Syu", String
"--noconfirm"]
		UncheckedProperty ArchLinux -> Result -> Property ArchLinux
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange

type Package = String

installed :: [Package] -> Property ArchLinux
installed :: [String] -> Property ArchLinux
installed = [String] -> [String] -> Property ArchLinux
installed' [String
"--noconfirm"]

installed' :: [String] -> [Package] -> Property ArchLinux
installed' :: [String] -> [String] -> Property ArchLinux
installed' [String]
params [String]
ps = IO Bool -> UncheckedProperty ArchLinux -> Property ArchLinux
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IO Bool
isInstalled' [String]
ps) UncheckedProperty ArchLinux
go
	Property ArchLinux -> String -> Property ArchLinux
forall p. IsProp p => p -> String -> p
`describe` [String] -> String
unwords (String
"pacman installed"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ps)
  where
	go :: UncheckedProperty ArchLinux
go = [String] -> UncheckedProperty ArchLinux
runPacman ([String]
params [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-S"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ps)

removed :: [Package] -> Property ArchLinux
removed :: [String] -> Property ArchLinux
removed [String]
ps = IO Bool -> UncheckedProperty ArchLinux -> Property ArchLinux
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check ((InstallStatus -> Bool) -> [InstallStatus] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (InstallStatus -> InstallStatus -> Bool
forall a. Eq a => a -> a -> Bool
== InstallStatus
IsInstalled) ([InstallStatus] -> Bool) -> IO [InstallStatus] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IO [InstallStatus]
getInstallStatus [String]
ps)
	([String] -> UncheckedProperty ArchLinux
runPacman ([String
"-R", String
"--noconfirm"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ps))
	Property ArchLinux -> String -> Property ArchLinux
forall p. IsProp p => p -> String -> p
`describe` [String] -> String
unwords (String
"pacman removed"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ps)

isInstalled :: Package -> IO Bool
isInstalled :: String -> IO Bool
isInstalled String
p = [String] -> IO Bool
isInstalled' [String
p]

isInstalled' :: [Package] -> IO Bool
isInstalled' :: [String] -> IO Bool
isInstalled' [String]
ps = (InstallStatus -> Bool) -> [InstallStatus] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (InstallStatus -> InstallStatus -> Bool
forall a. Eq a => a -> a -> Bool
== InstallStatus
IsInstalled) ([InstallStatus] -> Bool) -> IO [InstallStatus] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IO [InstallStatus]
getInstallStatus [String]
ps

data InstallStatus = IsInstalled | NotInstalled
	deriving (Int -> InstallStatus -> ShowS
[InstallStatus] -> ShowS
InstallStatus -> String
(Int -> InstallStatus -> ShowS)
-> (InstallStatus -> String)
-> ([InstallStatus] -> ShowS)
-> Show InstallStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstallStatus] -> ShowS
$cshowList :: [InstallStatus] -> ShowS
show :: InstallStatus -> String
$cshow :: InstallStatus -> String
showsPrec :: Int -> InstallStatus -> ShowS
$cshowsPrec :: Int -> InstallStatus -> ShowS
Show, InstallStatus -> InstallStatus -> Bool
(InstallStatus -> InstallStatus -> Bool)
-> (InstallStatus -> InstallStatus -> Bool) -> Eq InstallStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstallStatus -> InstallStatus -> Bool
$c/= :: InstallStatus -> InstallStatus -> Bool
== :: InstallStatus -> InstallStatus -> Bool
$c== :: InstallStatus -> InstallStatus -> Bool
Eq)

{- Returns the InstallStatus of packages that are installed
 - or known and not installed. If a package is not known at all to apt
 - or dpkg, it is not included in the list. -}
getInstallStatus :: [Package] -> IO [InstallStatus]
getInstallStatus :: [String] -> IO [InstallStatus]
getInstallStatus [String]
ps = (Maybe InstallStatus -> Maybe InstallStatus)
-> [Maybe InstallStatus] -> [InstallStatus]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Maybe InstallStatus -> Maybe InstallStatus
forall a. a -> a
id ([Maybe InstallStatus] -> [InstallStatus])
-> IO [Maybe InstallStatus] -> IO [InstallStatus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Maybe InstallStatus))
-> [String] -> IO [Maybe InstallStatus]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe InstallStatus)
status [String]
ps
  where
	status :: Package -> IO (Maybe InstallStatus)
	status :: String -> IO (Maybe InstallStatus)
status String
p = do
	  IO Bool
-> (IO (Maybe InstallStatus), IO (Maybe InstallStatus))
-> IO (Maybe InstallStatus)
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> [String] -> IO Bool
succeeds String
"pacman" [String
"-Q", String
p])
	    (Maybe InstallStatus -> IO (Maybe InstallStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return (InstallStatus -> Maybe InstallStatus
forall a. a -> Maybe a
Just InstallStatus
IsInstalled),
	      IO Bool
-> (IO (Maybe InstallStatus), IO (Maybe InstallStatus))
-> IO (Maybe InstallStatus)
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> [String] -> IO Bool
succeeds String
"pacman" [String
"-Sp", String
p])
	        (Maybe InstallStatus -> IO (Maybe InstallStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return (InstallStatus -> Maybe InstallStatus
forall a. a -> Maybe a
Just InstallStatus
NotInstalled),
	         Maybe InstallStatus -> IO (Maybe InstallStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InstallStatus
forall a. Maybe a
Nothing))

succeeds :: String -> [String] -> IO Bool
succeeds :: String -> [String] -> IO Bool
succeeds String
cmd [String]
args = (IO ()
quietProcess IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
	IO Bool -> (IOException -> IO Bool) -> IO Bool
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (IOException -> m a) -> m a
`catchIO` (\IOException
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
  where
	quietProcess :: IO ()
	quietProcess :: IO ()
quietProcess = CreateProcessRunner -> CreateProcess -> IO ()
withQuietOutput CreateProcessRunner
createProcessSuccess CreateProcess
p
	p :: CreateProcess
p = (String -> [String] -> CreateProcess
proc String
cmd [String]
args)