{-# LANGUAGE PackageImports #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}

module Propellor.Types.Core where

import Propellor.Types.Info
import Propellor.Types.OS
import Propellor.Types.Result

import Data.Monoid
import qualified Data.Semigroup as Sem
import "mtl" Control.Monad.RWS.Strict
import Control.Monad.Catch
import Control.Applicative
import Prelude

-- | Everything Propellor knows about a system: Its hostname,
-- properties and their collected info.
data Host = Host
	{ Host -> HostName
hostName :: HostName
	, Host -> [ChildProperty]
hostProperties :: [ChildProperty]
	, Host -> Info
hostInfo :: Info
	}
	deriving (Int -> Host -> ShowS
[Host] -> ShowS
Host -> HostName
(Int -> Host -> ShowS)
-> (Host -> HostName) -> ([Host] -> ShowS) -> Show Host
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Host] -> ShowS
$cshowList :: [Host] -> ShowS
show :: Host -> HostName
$cshow :: Host -> HostName
showsPrec :: Int -> Host -> ShowS
$cshowsPrec :: Int -> Host -> ShowS
Show, Typeable)

-- | Propellor's monad provides read-only access to info about the host
-- it's running on, and a writer to accumulate EndActions.
newtype Propellor p = Propellor { Propellor p -> RWST Host [EndAction] () IO p
runWithHost :: RWST Host [EndAction] () IO p }
	deriving
		( Applicative Propellor
a -> Propellor a
Applicative Propellor
-> (forall a b. Propellor a -> (a -> Propellor b) -> Propellor b)
-> (forall a b. Propellor a -> Propellor b -> Propellor b)
-> (forall a. a -> Propellor a)
-> Monad Propellor
Propellor a -> (a -> Propellor b) -> Propellor b
Propellor a -> Propellor b -> Propellor b
forall a. a -> Propellor a
forall a b. Propellor a -> Propellor b -> Propellor b
forall a b. Propellor a -> (a -> Propellor b) -> Propellor b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Propellor a
$creturn :: forall a. a -> Propellor a
>> :: Propellor a -> Propellor b -> Propellor b
$c>> :: forall a b. Propellor a -> Propellor b -> Propellor b
>>= :: Propellor a -> (a -> Propellor b) -> Propellor b
$c>>= :: forall a b. Propellor a -> (a -> Propellor b) -> Propellor b
$cp1Monad :: Applicative Propellor
Monad
		, a -> Propellor b -> Propellor a
(a -> b) -> Propellor a -> Propellor b
(forall a b. (a -> b) -> Propellor a -> Propellor b)
-> (forall a b. a -> Propellor b -> Propellor a)
-> Functor Propellor
forall a b. a -> Propellor b -> Propellor a
forall a b. (a -> b) -> Propellor a -> Propellor b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Propellor b -> Propellor a
$c<$ :: forall a b. a -> Propellor b -> Propellor a
fmap :: (a -> b) -> Propellor a -> Propellor b
$cfmap :: forall a b. (a -> b) -> Propellor a -> Propellor b
Functor
		, Functor Propellor
a -> Propellor a
Functor Propellor
-> (forall a. a -> Propellor a)
-> (forall a b. Propellor (a -> b) -> Propellor a -> Propellor b)
-> (forall a b c.
    (a -> b -> c) -> Propellor a -> Propellor b -> Propellor c)
-> (forall a b. Propellor a -> Propellor b -> Propellor b)
-> (forall a b. Propellor a -> Propellor b -> Propellor a)
-> Applicative Propellor
Propellor a -> Propellor b -> Propellor b
Propellor a -> Propellor b -> Propellor a
Propellor (a -> b) -> Propellor a -> Propellor b
(a -> b -> c) -> Propellor a -> Propellor b -> Propellor c
forall a. a -> Propellor a
forall a b. Propellor a -> Propellor b -> Propellor a
forall a b. Propellor a -> Propellor b -> Propellor b
forall a b. Propellor (a -> b) -> Propellor a -> Propellor b
forall a b c.
(a -> b -> c) -> Propellor a -> Propellor b -> Propellor c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Propellor a -> Propellor b -> Propellor a
$c<* :: forall a b. Propellor a -> Propellor b -> Propellor a
*> :: Propellor a -> Propellor b -> Propellor b
$c*> :: forall a b. Propellor a -> Propellor b -> Propellor b
liftA2 :: (a -> b -> c) -> Propellor a -> Propellor b -> Propellor c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Propellor a -> Propellor b -> Propellor c
<*> :: Propellor (a -> b) -> Propellor a -> Propellor b
$c<*> :: forall a b. Propellor (a -> b) -> Propellor a -> Propellor b
pure :: a -> Propellor a
$cpure :: forall a. a -> Propellor a
$cp1Applicative :: Functor Propellor
Applicative
		, MonadReader Host
		, MonadWriter [EndAction]
		, Monad Propellor
Monad Propellor
-> (forall a. IO a -> Propellor a) -> MonadIO Propellor
IO a -> Propellor a
forall a. IO a -> Propellor a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Propellor a
$cliftIO :: forall a. IO a -> Propellor a
$cp1MonadIO :: Monad Propellor
MonadIO
		, MonadThrow Propellor
MonadThrow Propellor
-> (forall e a.
    Exception e =>
    Propellor a -> (e -> Propellor a) -> Propellor a)
-> MonadCatch Propellor
Propellor a -> (e -> Propellor a) -> Propellor a
forall e a.
Exception e =>
Propellor a -> (e -> Propellor a) -> Propellor a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: Propellor a -> (e -> Propellor a) -> Propellor a
$ccatch :: forall e a.
Exception e =>
Propellor a -> (e -> Propellor a) -> Propellor a
$cp1MonadCatch :: MonadThrow Propellor
MonadCatch
		, Monad Propellor
e -> Propellor a
Monad Propellor
-> (forall e a. Exception e => e -> Propellor a)
-> MonadThrow Propellor
forall e a. Exception e => e -> Propellor a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> Propellor a
$cthrowM :: forall e a. Exception e => e -> Propellor a
$cp1MonadThrow :: Monad Propellor
MonadThrow
		, MonadCatch Propellor
MonadCatch Propellor
-> (forall b.
    ((forall a. Propellor a -> Propellor a) -> Propellor b)
    -> Propellor b)
-> (forall b.
    ((forall a. Propellor a -> Propellor a) -> Propellor b)
    -> Propellor b)
-> (forall a b c.
    Propellor a
    -> (a -> ExitCase b -> Propellor c)
    -> (a -> Propellor b)
    -> Propellor (b, c))
-> MonadMask Propellor
Propellor a
-> (a -> ExitCase b -> Propellor c)
-> (a -> Propellor b)
-> Propellor (b, c)
((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
forall b.
((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
forall a b c.
Propellor a
-> (a -> ExitCase b -> Propellor c)
-> (a -> Propellor b)
-> Propellor (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: Propellor a
-> (a -> ExitCase b -> Propellor c)
-> (a -> Propellor b)
-> Propellor (b, c)
$cgeneralBracket :: forall a b c.
Propellor a
-> (a -> ExitCase b -> Propellor c)
-> (a -> Propellor b)
-> Propellor (b, c)
uninterruptibleMask :: ((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
$cuninterruptibleMask :: forall b.
((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
mask :: ((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
$cmask :: forall b.
((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
$cp1MonadMask :: MonadCatch Propellor
MonadMask
		)

class LiftPropellor m where
	liftPropellor :: m a -> Propellor a

instance LiftPropellor Propellor where
	liftPropellor :: Propellor a -> Propellor a
liftPropellor = Propellor a -> Propellor a
forall a. a -> a
id

instance LiftPropellor IO where
	liftPropellor :: IO a -> Propellor a
liftPropellor = IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | When two actions are appended together, the second action
-- is only run if the first action does not fail.
instance Sem.Semigroup (Propellor Result) where
	Propellor Result
x <> :: Propellor Result -> Propellor Result -> Propellor Result
<> Propellor Result
y = do
		Result
rx <- Propellor Result
x
		case Result
rx of
			Result
FailedChange -> Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
			Result
_ -> do
				Result
ry <- Propellor Result
y
				Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result
rx Result -> Result -> Result
forall a. Semigroup a => a -> a -> a
<> Result
ry)
	
instance Monoid (Propellor Result) where
	mempty :: Propellor Result
mempty = Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
	mappend :: Propellor Result -> Propellor Result -> Propellor Result
mappend = Propellor Result -> Propellor Result -> Propellor Result
forall a. Semigroup a => a -> a -> a
(Sem.<>)

-- | An action that Propellor runs at the end, after trying to satisfy all
-- properties. It's passed the combined Result of the entire Propellor run.
data EndAction = EndAction Desc (Result -> Propellor Result)

type Desc = String

-- | Props is a combination of a list of properties, with their combined 
-- metatypes.
data Props metatypes = Props [ChildProperty]

-- | Since there are many different types of Properties, they cannot be put
-- into a list. The simplified ChildProperty can be put into a list.
data ChildProperty = ChildProperty Desc (Maybe (Propellor Result)) Info [ChildProperty]
  
instance Show ChildProperty where
	show :: ChildProperty -> HostName
show ChildProperty
p = HostName
"property " HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> HostName
show (ChildProperty -> HostName
forall p. IsProp p => p -> HostName
getDesc ChildProperty
p)

class IsProp p where
	setDesc :: p -> Desc -> p
	getDesc :: p -> Desc
	getChildren :: p -> [ChildProperty]
	addChildren :: p -> [ChildProperty] -> p
	-- | Gets the info of the property, combined with all info
	-- of all children properties.
	getInfoRecursive :: p -> Info
	-- | Info, not including info from children.
	getInfo :: p -> Info
	-- | Gets a ChildProperty representing the Property.
	-- You should not normally need to use this.
	toChildProperty :: p -> ChildProperty
	-- | Gets the action that can be run to satisfy a Property.
	-- You should never run this action directly. Use
	-- 'Propellor.EnsureProperty.ensureProperty` instead.
	getSatisfy :: p -> Maybe (Propellor Result)

instance IsProp ChildProperty where
	setDesc :: ChildProperty -> HostName -> ChildProperty
setDesc (ChildProperty HostName
_ Maybe (Propellor Result)
a Info
i [ChildProperty]
c) HostName
d = HostName
-> Maybe (Propellor Result)
-> Info
-> [ChildProperty]
-> ChildProperty
ChildProperty HostName
d Maybe (Propellor Result)
a Info
i [ChildProperty]
c
	getDesc :: ChildProperty -> HostName
getDesc (ChildProperty HostName
d Maybe (Propellor Result)
_ Info
_ [ChildProperty]
_) = HostName
d
	getChildren :: ChildProperty -> [ChildProperty]
getChildren (ChildProperty HostName
_ Maybe (Propellor Result)
_ Info
_ [ChildProperty]
c) = [ChildProperty]
c
	addChildren :: ChildProperty -> [ChildProperty] -> ChildProperty
addChildren (ChildProperty HostName
d Maybe (Propellor Result)
a Info
i [ChildProperty]
c) [ChildProperty]
c' = HostName
-> Maybe (Propellor Result)
-> Info
-> [ChildProperty]
-> ChildProperty
ChildProperty HostName
d Maybe (Propellor Result)
a Info
i ([ChildProperty]
c [ChildProperty] -> [ChildProperty] -> [ChildProperty]
forall a. [a] -> [a] -> [a]
++ [ChildProperty]
c')
	getInfoRecursive :: ChildProperty -> Info
getInfoRecursive (ChildProperty HostName
_ Maybe (Propellor Result)
_ Info
i [ChildProperty]
c) =
		Info
i Info -> Info -> Info
forall a. Semigroup a => a -> a -> a
<> [Info] -> Info
forall a. Monoid a => [a] -> a
mconcat ((ChildProperty -> Info) -> [ChildProperty] -> [Info]
forall a b. (a -> b) -> [a] -> [b]
map ChildProperty -> Info
forall p. IsProp p => p -> Info
getInfoRecursive [ChildProperty]
c)
	getInfo :: ChildProperty -> Info
getInfo (ChildProperty HostName
_ Maybe (Propellor Result)
_ Info
i [ChildProperty]
_) = Info
i
	toChildProperty :: ChildProperty -> ChildProperty
toChildProperty = ChildProperty -> ChildProperty
forall a. a -> a
id
	getSatisfy :: ChildProperty -> Maybe (Propellor Result)
getSatisfy (ChildProperty HostName
_ Maybe (Propellor Result)
a Info
_ [ChildProperty]
_) = Maybe (Propellor Result)
a

propsInfo :: Props metatypes -> Info
propsInfo :: Props metatypes -> Info
propsInfo (Props [ChildProperty]
l) = [Info] -> Info
forall a. Monoid a => [a] -> a
mconcat ((ChildProperty -> Info) -> [ChildProperty] -> [Info]
forall a b. (a -> b) -> [a] -> [b]
map ChildProperty -> Info
forall p. IsProp p => p -> Info
getInfo [ChildProperty]
l)