module Propellor.Types.Core where
import Propellor.Types.Info
import Propellor.Types.OS
import Propellor.Types.Result
import Data.Monoid
import "mtl" Control.Monad.RWS.Strict
import Control.Monad.Catch
import Control.Applicative
import Prelude
data Host = Host
{ hostName :: HostName
, hostProperties :: [ChildProperty]
, hostInfo :: Info
}
deriving (Show, Typeable)
newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
deriving
( Monad
, Functor
, Applicative
, MonadReader Host
, MonadWriter [EndAction]
, MonadIO
, MonadCatch
, MonadThrow
, MonadMask
)
class LiftPropellor m where
liftPropellor :: m a -> Propellor a
instance LiftPropellor Propellor where
liftPropellor = id
instance LiftPropellor IO where
liftPropellor = liftIO
instance Monoid (Propellor Result) where
mempty = return NoChange
mappend x y = do
rx <- x
case rx of
FailedChange -> return FailedChange
_ -> do
ry <- y
return (rx <> ry)
data EndAction = EndAction Desc (Result -> Propellor Result)
type Desc = String
data Props metatypes = Props [ChildProperty]
data ChildProperty = ChildProperty Desc (Maybe (Propellor Result)) Info [ChildProperty]
instance Show ChildProperty where
show p = "property " ++ show (getDesc p)
class IsProp p where
setDesc :: p -> Desc -> p
getDesc :: p -> Desc
getChildren :: p -> [ChildProperty]
addChildren :: p -> [ChildProperty] -> p
getInfoRecursive :: p -> Info
getInfo :: p -> Info
toChildProperty :: p -> ChildProperty
getSatisfy :: p -> Maybe (Propellor Result)
instance IsProp ChildProperty where
setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
getDesc (ChildProperty d _ _ _) = d
getChildren (ChildProperty _ _ _ c) = c
addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
getInfoRecursive (ChildProperty _ _ i c) =
i <> mconcat (map getInfoRecursive c)
getInfo (ChildProperty _ _ i _) = i
toChildProperty = id
getSatisfy (ChildProperty _ a _ _) = a