-- | 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]
cmd[Char] -> [[Char]] -> [[Char]]
forall 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 ([Char] -> [[Char]]) -> IO [Char] -> IO [[Char]]
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 = UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UncheckedProperty FreeBSD
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 FreeBSD)
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> UncheckedProperty FreeBSD
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
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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 ([Char] -> [[Char]]) -> IO [Char] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> IO [Char]
readProcessEnv [Char]
p [[Char]]
a ([([Char], [Char])] -> Maybe [([Char], [Char])]
forall a. a -> Maybe a
Just [([Char], [Char])]
noninteractiveEnv)

newtype PkgUpdate = PkgUpdate String
	deriving (Typeable, b -> PkgUpdate -> PkgUpdate
NonEmpty PkgUpdate -> PkgUpdate
PkgUpdate -> PkgUpdate -> PkgUpdate
(PkgUpdate -> PkgUpdate -> PkgUpdate)
-> (NonEmpty PkgUpdate -> PkgUpdate)
-> (forall b. Integral b => b -> PkgUpdate -> PkgUpdate)
-> Semigroup 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 :: 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
Semigroup PkgUpdate
-> PkgUpdate
-> (PkgUpdate -> PkgUpdate -> PkgUpdate)
-> ([PkgUpdate] -> PkgUpdate)
-> Monoid 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
$cp1Monoid :: Semigroup PkgUpdate
Monoid, Int -> PkgUpdate -> ShowS
[PkgUpdate] -> ShowS
PkgUpdate -> [Char]
(Int -> PkgUpdate -> ShowS)
-> (PkgUpdate -> [Char])
-> ([PkgUpdate] -> ShowS)
-> Show PkgUpdate
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PkgUpdate] -> ShowS
$cshowList :: [PkgUpdate] -> ShowS
show :: PkgUpdate -> [Char]
$cshow :: PkgUpdate -> [Char]
showsPrec :: Int -> PkgUpdate -> ShowS
$cshowsPrec :: Int -> PkgUpdate -> ShowS
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 = Propellor Bool
-> (Propellor Result, Propellor Result) -> Propellor Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (PkgUpdate -> Bool
pkgUpdated (PkgUpdate -> Bool) -> Propellor PkgUpdate -> Propellor Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Propellor PkgUpdate
forall v. IsInfo v => Propellor v
askInfo) ((Propellor Result
noChange), (IO [[Char]] -> Propellor [[Char]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [[Char]]
upd Propellor [[Char]] -> Propellor Result -> Propellor Result
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange))
	in
		([Char] -> Propellor Result -> Property FreeBSD
forall k (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property [Char]
"pkg update has run" Propellor Result
go :: Property FreeBSD)
			Property FreeBSD
-> Info
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (PkgUpdate -> Info
forall v. IsInfo v => v -> Info
toInfo ([Char] -> PkgUpdate
PkgUpdate [Char]
""))

newtype PkgUpgrade = PkgUpgrade String
	deriving (Typeable, b -> PkgUpgrade -> PkgUpgrade
NonEmpty PkgUpgrade -> PkgUpgrade
PkgUpgrade -> PkgUpgrade -> PkgUpgrade
(PkgUpgrade -> PkgUpgrade -> PkgUpgrade)
-> (NonEmpty PkgUpgrade -> PkgUpgrade)
-> (forall b. Integral b => b -> PkgUpgrade -> PkgUpgrade)
-> Semigroup 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 :: 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
Semigroup PkgUpgrade
-> PkgUpgrade
-> (PkgUpgrade -> PkgUpgrade -> PkgUpgrade)
-> ([PkgUpgrade] -> PkgUpgrade)
-> Monoid 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
$cp1Monoid :: Semigroup PkgUpgrade
Monoid, Int -> PkgUpgrade -> ShowS
[PkgUpgrade] -> ShowS
PkgUpgrade -> [Char]
(Int -> PkgUpgrade -> ShowS)
-> (PkgUpgrade -> [Char])
-> ([PkgUpgrade] -> ShowS)
-> Show PkgUpgrade
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PkgUpgrade] -> ShowS
$cshowList :: [PkgUpgrade] -> ShowS
show :: PkgUpgrade -> [Char]
$cshow :: PkgUpgrade -> [Char]
showsPrec :: Int -> PkgUpgrade -> ShowS
$cshowsPrec :: Int -> PkgUpgrade -> ShowS
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 = Propellor Bool
-> (Propellor Result, Propellor Result) -> Propellor Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (PkgUpgrade -> Bool
pkgUpgraded (PkgUpgrade -> Bool) -> Propellor PkgUpgrade -> Propellor Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Propellor PkgUpgrade
forall v. IsInfo v => Propellor v
askInfo) ((Propellor Result
noChange), (IO [[Char]] -> Propellor [[Char]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [[Char]]
upd Propellor [[Char]] -> Propellor Result -> Propellor Result
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange))
	in
		([Char] -> Propellor Result -> Property FreeBSD
forall k (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property [Char]
"pkg upgrade has run" Propellor Result
go :: Property FreeBSD)
			Property FreeBSD
-> Info
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (PkgUpdate -> Info
forall v. IsInfo v => v -> Info
toInfo ([Char] -> PkgUpdate
PkgUpdate [Char]
""))
			Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
-> CombinedType
     (Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD]))
     (Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
Property (HasInfo + FreeBSD)
update

type Package = String

installed :: Package -> Property FreeBSD
installed :: [Char] -> Property FreeBSD
installed [Char]
pkg = IO Bool -> UncheckedProperty FreeBSD -> Property FreeBSD
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check ([Char] -> IO Bool
isInstallable [Char]
pkg) (UncheckedProperty FreeBSD -> Property FreeBSD)
-> UncheckedProperty FreeBSD -> Property FreeBSD
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 (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Bool
isInstalled [Char]
p) IO Bool -> IO Bool -> IO Bool
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] IO [[Char]] -> 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)

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] IO [[Char]] -> 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)