From 5b946ea4e32657f64771f3e2ef8bc865afc4c1fc Mon Sep 17 00:00:00 2001 From: Zihao Wang Date: Wed, 28 Dec 2016 17:19:49 +0800 Subject: add property for Pacman Signed-off-by: Zihao Wang --- src/Propellor/Property/Pacman.hs | 68 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 src/Propellor/Property/Pacman.hs diff --git a/src/Propellor/Property/Pacman.hs b/src/Propellor/Property/Pacman.hs new file mode 100644 index 00000000..60ed4bea --- /dev/null +++ b/src/Propellor/Property/Pacman.hs @@ -0,0 +1,68 @@ +-- | Maintainer: Zihao Wang +-- +-- Support for the Pacman package manager + +module Propellor.Property.Pacman where + +import Propellor.Base + +runPacman :: [String] -> UncheckedProperty ArchLinux +runPacman ps = tightenTargets $ cmdProperty "pacman" ps + +-- | Have pacman update its lists of packages, but without upgrading anything. +update :: Property ArchLinux +update = combineProperties ("pacman update") $ props + & runPacman ["-Sy", "--noconfirm"] + `assume` MadeChange + +upgrade :: Property ArchLinux +upgrade = combineProperties ("pacman upgrade") $ props + & runPacman ["-Syu", "--noconfirm"] + `assume` MadeChange + +type Package = String + +installed :: [Package] -> Property ArchLinux +installed = installed' ["--noconfirm"] + +installed' :: [String] -> [Package] -> Property ArchLinux +installed' params ps = check (not <$> isInstalled' ps) go + `describe` unwords ("pacman installed":ps) + where + go = runPacman (params ++ ["-S"] ++ ps) + +removed :: [Package] -> Property ArchLinux +removed ps = check (any (== IsInstalled) <$> getInstallStatus ps) + (runPacman (["-R", "--noconfirm"] ++ ps)) + `describe` unwords ("pacman removed":ps) + +isInstalled :: Package -> IO Bool +isInstalled p = isInstalled' [p] + +isInstalled' :: [Package] -> IO Bool +isInstalled' ps = all (== IsInstalled) <$> getInstallStatus ps + +data InstallStatus = IsInstalled | NotInstalled + deriving (Show, 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 ps = mapMaybe id <$> mapM status ps + where + status :: Package -> IO (Maybe InstallStatus) + status p = do + ifM (succeeds "pacman" ["-Q", p]) + (return (Just IsInstalled), + ifM (succeeds "pacman" ["-Sp", p]) + (return (Just NotInstalled), + return Nothing)) + +succeeds :: String -> [String] -> IO Bool +succeeds cmd args = (quietProcess >> return True) + `catchIO` (\_ -> return False) + where + quietProcess :: IO () + quietProcess = withQuietOutput createProcessSuccess p + p = (proc cmd args) -- cgit v1.2.3