-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
-- 
-- FreeBSD pkgng properties

{-# Language ScopedTypeVariables, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}

module Propellor.Property.FreeBSD.Pkg where

import Propellor.Base
import Propellor.Types.Info

import qualified Data.Semigroup as Sem

noninteractiveEnv :: [([Char], [Char])]
noninteractiveEnv :: [([Char], [Char])]
noninteractiveEnv = [([Char]
"ASSUME_ALWAYS_YES", [Char]
"yes")]

pkgCommand :: String -> [String] -> (String, [String])
pkgCommand :: [Char] -> [[Char]] -> ([Char], [[Char]])
pkgCommand [Char]
cmd [[Char]]
args = ([Char]
"pkg", ([Char]
cmdforall a. a -> [a] -> [a]
:[[Char]]
args))

runPkg :: String -> [String] -> IO [String]
runPkg :: [Char] -> [[Char]] -> IO [[Char]]
runPkg [Char]
cmd [[Char]]
args =
	let
		([Char]
p, [[Char]]
a) = [Char] -> [[Char]] -> ([Char], [[Char]])
pkgCommand [Char]
cmd [[Char]]
args
	in
		[Char] -> [[Char]]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> IO [Char]
readProcess [Char]
p [[Char]]
a

pkgCmdProperty :: String -> [String] -> UncheckedProperty FreeBSD
pkgCmdProperty :: [Char] -> [[Char]] -> UncheckedProperty FreeBSD
pkgCmdProperty [Char]
cmd [[Char]]
args = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ 
	let
		([Char]
p, [[Char]]
a) = [Char] -> [[Char]] -> ([Char], [[Char]])
pkgCommand [Char]
cmd [[Char]]
args
	in
		[Char]
-> [[Char]] -> [([Char], [Char])] -> UncheckedProperty UnixLike
cmdPropertyEnv [Char]
p [[Char]]
a [([Char], [Char])]
noninteractiveEnv

pkgCmd :: String -> [String] -> IO [String]
pkgCmd :: [Char] -> [[Char]] -> IO [[Char]]
pkgCmd [Char]
cmd [[Char]]
args =
	let
		([Char]
p, [[Char]]
a) = [Char] -> [[Char]] -> ([Char], [[Char]])
pkgCommand [Char]
cmd [[Char]]
args
	in
		[Char] -> [[Char]]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> IO [Char]
readProcessEnv [Char]
p [[Char]]
a (forall a. a -> Maybe a
Just [([Char], [Char])]
noninteractiveEnv)

newtype PkgUpdate = PkgUpdate String
	deriving (Typeable, NonEmpty PkgUpdate -> PkgUpdate
PkgUpdate -> PkgUpdate -> PkgUpdate
forall b. Integral b => b -> PkgUpdate -> PkgUpdate
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> PkgUpdate -> PkgUpdate
$cstimes :: forall b. Integral b => b -> PkgUpdate -> PkgUpdate
sconcat :: NonEmpty PkgUpdate -> PkgUpdate
$csconcat :: NonEmpty PkgUpdate -> PkgUpdate
<> :: PkgUpdate -> PkgUpdate -> PkgUpdate
$c<> :: PkgUpdate -> PkgUpdate -> PkgUpdate
Sem.Semigroup, Semigroup PkgUpdate
PkgUpdate
[PkgUpdate] -> PkgUpdate
PkgUpdate -> PkgUpdate -> PkgUpdate
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PkgUpdate] -> PkgUpdate
$cmconcat :: [PkgUpdate] -> PkgUpdate
mappend :: PkgUpdate -> PkgUpdate -> PkgUpdate
$cmappend :: PkgUpdate -> PkgUpdate -> PkgUpdate
mempty :: PkgUpdate
$cmempty :: PkgUpdate
Monoid, Int -> PkgUpdate -> [Char] -> [Char]
[PkgUpdate] -> [Char] -> [Char]
PkgUpdate -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [PkgUpdate] -> [Char] -> [Char]
$cshowList :: [PkgUpdate] -> [Char] -> [Char]
show :: PkgUpdate -> [Char]
$cshow :: PkgUpdate -> [Char]
showsPrec :: Int -> PkgUpdate -> [Char] -> [Char]
$cshowsPrec :: Int -> PkgUpdate -> [Char] -> [Char]
Show)
instance IsInfo PkgUpdate where
	propagateInfo :: PkgUpdate -> PropagateInfo
propagateInfo PkgUpdate
_ = Bool -> PropagateInfo
PropagateInfo Bool
False

pkgUpdated :: PkgUpdate -> Bool
pkgUpdated :: PkgUpdate -> Bool
pkgUpdated (PkgUpdate [Char]
_) = Bool
True

update :: Property (HasInfo + FreeBSD)
update :: Property (HasInfo + FreeBSD)
update =
	let
		upd :: IO [[Char]]
upd = [Char] -> [[Char]] -> IO [[Char]]
pkgCmd [Char]
"update" []
		go :: Propellor Result
go = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (PkgUpdate -> Bool
pkgUpdated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. IsInfo v => Propellor v
askInfo) ((Propellor Result
noChange), (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [[Char]]
upd forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange))
	in
		(forall {k} (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property [Char]
"pkg update has run" Propellor Result
go :: Property FreeBSD)
			forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (forall v. IsInfo v => v -> Info
toInfo ([Char] -> PkgUpdate
PkgUpdate [Char]
""))

newtype PkgUpgrade = PkgUpgrade String
	deriving (Typeable, NonEmpty PkgUpgrade -> PkgUpgrade
PkgUpgrade -> PkgUpgrade -> PkgUpgrade
forall b. Integral b => b -> PkgUpgrade -> PkgUpgrade
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> PkgUpgrade -> PkgUpgrade
$cstimes :: forall b. Integral b => b -> PkgUpgrade -> PkgUpgrade
sconcat :: NonEmpty PkgUpgrade -> PkgUpgrade
$csconcat :: NonEmpty PkgUpgrade -> PkgUpgrade
<> :: PkgUpgrade -> PkgUpgrade -> PkgUpgrade
$c<> :: PkgUpgrade -> PkgUpgrade -> PkgUpgrade
Sem.Semigroup, Semigroup PkgUpgrade
PkgUpgrade
[PkgUpgrade] -> PkgUpgrade
PkgUpgrade -> PkgUpgrade -> PkgUpgrade
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PkgUpgrade] -> PkgUpgrade
$cmconcat :: [PkgUpgrade] -> PkgUpgrade
mappend :: PkgUpgrade -> PkgUpgrade -> PkgUpgrade
$cmappend :: PkgUpgrade -> PkgUpgrade -> PkgUpgrade
mempty :: PkgUpgrade
$cmempty :: PkgUpgrade
Monoid, Int -> PkgUpgrade -> [Char] -> [Char]
[PkgUpgrade] -> [Char] -> [Char]
PkgUpgrade -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [PkgUpgrade] -> [Char] -> [Char]
$cshowList :: [PkgUpgrade] -> [Char] -> [Char]
show :: PkgUpgrade -> [Char]
$cshow :: PkgUpgrade -> [Char]
showsPrec :: Int -> PkgUpgrade -> [Char] -> [Char]
$cshowsPrec :: Int -> PkgUpgrade -> [Char] -> [Char]
Show)

instance IsInfo PkgUpgrade where
	propagateInfo :: PkgUpgrade -> PropagateInfo
propagateInfo PkgUpgrade
_ = Bool -> PropagateInfo
PropagateInfo Bool
False

pkgUpgraded :: PkgUpgrade -> Bool
pkgUpgraded :: PkgUpgrade -> Bool
pkgUpgraded (PkgUpgrade [Char]
_) = Bool
True

upgrade :: Property (HasInfo + FreeBSD)
upgrade :: Property (HasInfo + FreeBSD)
upgrade =
	let
		upd :: IO [[Char]]
upd = [Char] -> [[Char]] -> IO [[Char]]
pkgCmd [Char]
"upgrade" []
		go :: Propellor Result
go = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (PkgUpgrade -> Bool
pkgUpgraded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. IsInfo v => Propellor v
askInfo) ((Propellor Result
noChange), (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [[Char]]
upd forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange))
	in
		(forall {k} (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property [Char]
"pkg upgrade has run" Propellor Result
go :: Property FreeBSD)
			forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (forall v. IsInfo v => v -> Info
toInfo ([Char] -> PkgUpdate
PkgUpdate [Char]
""))
			forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property (HasInfo + FreeBSD)
update

type Package = String

installed :: Package -> Property FreeBSD
installed :: [Char] -> Property FreeBSD
installed [Char]
pkg = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check ([Char] -> IO Bool
isInstallable [Char]
pkg) forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> UncheckedProperty FreeBSD
pkgCmdProperty [Char]
"install" [[Char]
pkg]

isInstallable :: Package -> IO Bool
isInstallable :: [Char] -> IO Bool
isInstallable [Char]
p = (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Bool
isInstalled [Char]
p) forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> [Char] -> IO Bool
exists [Char]
p

isInstalled :: Package -> IO Bool
isInstalled :: [Char] -> IO Bool
isInstalled [Char]
p = ([Char] -> [[Char]] -> IO [[Char]]
runPkg [Char]
"info" [[Char]
p] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
	forall (m :: * -> *) a.
MonadCatch m =>
m a -> (IOException -> m a) -> m a
`catchIO` (\IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

exists :: Package -> IO Bool
exists :: [Char] -> IO Bool
exists [Char]
p = ([Char] -> [[Char]] -> IO [[Char]]
runPkg [Char]
"search" [[Char]
"--search", [Char]
"name", [Char]
"--exact", [Char]
p] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
	forall (m :: * -> *) a.
MonadCatch m =>
m a -> (IOException -> m a) -> m a
`catchIO` (\IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)