1 files changed, 89 insertions, 0 deletions
diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
new file mode 100644
index 00000000..7e02d99b
--- /dev/null
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -0,0 +1,89 @@
+-- | FreeBSD pkgng properties
+--
+-- Copyright 2016 Evan Cofsky <evan@theunixman.com>
+-- License: BSD 2-clause
+
+{-# Language ScopedTypeVariables, GeneralizedNewtypeDeriving #-}
+
+module Propellor.Property.FreeBSD.Pkg where
+
+import Propellor.Base
+import Propellor.Types.Info
+
+noninteractiveEnv :: [([Char], [Char])]
+noninteractiveEnv = [("ASSUME_ALWAYS_YES", "yes")]
+
+pkgCommand :: String -> [String] -> (String, [String])
+pkgCommand cmd args = ("pkg", (cmd:args))
+
+runPkg :: String -> [String] -> IO [String]
+runPkg cmd args =
+	let
+		(p, a) = pkgCommand cmd args
+	in
+		lines <$> readProcess p a
+
+pkgCmdProperty :: String -> [String] -> UncheckedProperty NoInfo
+pkgCmdProperty cmd args =
+	let
+		(p, a) = pkgCommand cmd args
+	in
+		cmdPropertyEnv p a noninteractiveEnv
+
+pkgCmd :: String -> [String] -> IO [String]
+pkgCmd cmd args =
+	let
+		(p, a) = pkgCommand cmd args
+	in
+		lines <$> readProcessEnv p a (Just noninteractiveEnv)
+
+newtype PkgUpdate = PkgUpdate String
+	deriving (Typeable, Monoid, Show)
+instance IsInfo PkgUpdate where
+	propagateInfo _ = False
+
+pkgUpdated :: PkgUpdate -> Bool
+pkgUpdated (PkgUpdate _) = True
+
+update :: Property HasInfo
+update =
+	let
+		upd = pkgCmd "update" []
+		go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
+	in
+		infoProperty "pkg update has run" go (addInfo mempty (PkgUpdate "")) []
+
+newtype PkgUpgrade = PkgUpgrade String
+	deriving (Typeable, Monoid, Show)
+instance IsInfo PkgUpgrade where
+	propagateInfo _ = False
+
+pkgUpgraded :: PkgUpgrade -> Bool
+pkgUpgraded (PkgUpgrade _) = True
+
+upgrade :: Property HasInfo
+upgrade =
+	let
+		upd = pkgCmd "upgrade" []
+		go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
+	in
+		infoProperty "pkg upgrade has run" go (addInfo mempty (PkgUpgrade "")) [] `requires` update
+
+type Package = String
+
+installed :: Package -> Property NoInfo
+installed pkg =
+	check (isInstallable pkg) $ pkgCmdProperty "install" [pkg]
+
+isInstallable :: Package -> IO Bool
+isInstallable p = do
+	l <- isInstalled p
+	e <- exists p
+
+	return $ (not l) && e
+
+isInstalled :: Package -> IO Bool
+isInstalled p = catch (runPkg "info" [p] >> return True) (\(_ :: IOError ) -> return False)
+
+exists :: Package -> IO Bool
+exists p = catch (runPkg "search" ["--search", "name", "--exact", p] >> return True) (\(_ :: IOError ) -> return False)