module Propellor.Types
( Host(..)
, Property
, Info
, HasInfo
, NoInfo
, CInfo
, Desc
, infoProperty
, simpleProperty
, adjustPropertySatisfy
, propertyInfo
, propertyDesc
, propertyChildren
, RevertableProperty(..)
, (<!>)
, IsProp(..)
, Combines(..)
, CombinedType
, combineWith
, Propellor(..)
, EndAction(..)
, module Propellor.Types.OS
, module Propellor.Types.Dns
, module Propellor.Types.Result
, propertySatisfy
, ignoreInfo
) where
import Data.Monoid
import Control.Applicative
import "mtl" Control.Monad.RWS.Strict
import Control.Monad.Catch
import Data.Typeable
import Propellor.Types.Info
import Propellor.Types.OS
import Propellor.Types.Dns
import Propellor.Types.Result
data Host = Host
{ hostName :: HostName
, hostProperties :: [Property HasInfo]
, 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
)
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 Property i where
IProperty :: Desc -> Propellor Result -> Info -> [Property HasInfo] -> Property HasInfo
SProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
data HasInfo
data NoInfo
type family CInfo x y
type instance CInfo HasInfo HasInfo = HasInfo
type instance CInfo HasInfo NoInfo = HasInfo
type instance CInfo NoInfo HasInfo = HasInfo
type instance CInfo NoInfo NoInfo = NoInfo
infoProperty
:: Desc
-> Propellor Result
-> Info
-> [Property i]
-> Property HasInfo
infoProperty d a i cs = IProperty d a i (map toIProperty cs)
simpleProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
simpleProperty = SProperty
toIProperty :: Property i -> Property HasInfo
toIProperty p@(IProperty {}) = p
toIProperty (SProperty d s cs) = IProperty d s mempty (map toIProperty cs)
toSProperty :: Property i -> Property NoInfo
toSProperty (IProperty d s _ cs) = SProperty d s (map toSProperty cs)
toSProperty p@(SProperty {}) = p
ignoreInfo :: Property i -> Property NoInfo
ignoreInfo = toSProperty
propertySatisfy :: Property i -> Propellor Result
propertySatisfy (IProperty _ a _ _) = a
propertySatisfy (SProperty _ a _) = a
instance Show (Property i) where
show p = "property " ++ show (propertyDesc p)
adjustPropertySatisfy :: Property i -> (Propellor Result -> Propellor Result) -> Property i
adjustPropertySatisfy (IProperty d s i cs) f = IProperty d (f s) i cs
adjustPropertySatisfy (SProperty d s cs) f = SProperty d (f s) cs
propertyInfo :: Property i -> Info
propertyInfo (IProperty _ _ i _) = i
propertyInfo (SProperty {}) = mempty
propertyDesc :: Property i -> Desc
propertyDesc (IProperty d _ _ _) = d
propertyDesc (SProperty d _ _) = d
propertyChildren :: Property i -> [Property i]
propertyChildren (IProperty _ _ _ cs) = cs
propertyChildren (SProperty _ _ cs) = cs
data RevertableProperty = RevertableProperty (Property HasInfo) (Property HasInfo)
(<!>) :: Property i1 -> Property i2 -> RevertableProperty
p1 <!> p2 = RevertableProperty (toIProperty p1) (toIProperty p2)
class IsProp p where
setDesc :: p -> Desc -> p
toProp :: p -> Property HasInfo
getDesc :: p -> Desc
getInfoRecursive :: p -> Info
instance IsProp (Property HasInfo) where
setDesc (IProperty _ a i cs) d = IProperty d a i cs
toProp = id
getDesc = propertyDesc
getInfoRecursive (IProperty _ _ i cs) =
i <> mconcat (map getInfoRecursive cs)
instance IsProp (Property NoInfo) where
setDesc (SProperty _ a cs) d = SProperty d a cs
toProp = toIProperty
getDesc = propertyDesc
getInfoRecursive _ = mempty
instance IsProp RevertableProperty where
setDesc (RevertableProperty p1 p2) d =
RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
getDesc (RevertableProperty p1 _) = getDesc p1
toProp (RevertableProperty p1 _) = p1
getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
type family CombinedType x y
type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
type instance CombinedType RevertableProperty (Property NoInfo) = RevertableProperty
type instance CombinedType RevertableProperty (Property HasInfo) = RevertableProperty
type instance CombinedType RevertableProperty RevertableProperty = RevertableProperty
class Combines x y where
(<<>>) :: x -> y -> CombinedType x y
combineWith
:: (Combines (Property x) (Property y))
=> (Propellor Result -> Propellor Result -> Propellor Result)
-> Property x
-> Property y
-> CombinedType (Property x) (Property y)
combineWith f x y = adjustPropertySatisfy (x <<>> y) $ \_ ->
f (propertySatisfy $ toSProperty x) (propertySatisfy $ toSProperty y)
instance Combines (Property HasInfo) (Property HasInfo) where
(IProperty d1 a1 i1 cs1) <<>> y@(IProperty _d2 a2 _i2 _cs2) =
IProperty d1 (a2 <> a1) i1 (y : cs1)
instance Combines (Property HasInfo) (Property NoInfo) where
(IProperty d1 a1 i1 cs1) <<>> y@(SProperty _d2 a2 _cs2) =
IProperty d1 (a2 <> a1) i1 (toIProperty y : cs1)
instance Combines (Property NoInfo) (Property HasInfo) where
(SProperty d1 a1 cs1) <<>> y@(IProperty _d2 a2 _i2 _cs2) =
IProperty d1 (a2 <> a1) mempty (y : map toIProperty cs1)
instance Combines (Property NoInfo) (Property NoInfo) where
(SProperty d1 a1 cs1) <<>> y@(SProperty _d2 a2 _cs2) =
SProperty d1 (a2 <> a1) (y : cs1)
instance Combines RevertableProperty (Property HasInfo) where
(RevertableProperty p1 p2) <<>> y =
RevertableProperty (p1 <<>> y) p2
instance Combines RevertableProperty (Property NoInfo) where
(RevertableProperty p1 p2) <<>> y =
RevertableProperty (p1 <<>> toIProperty y) p2
instance Combines RevertableProperty RevertableProperty where
(RevertableProperty x1 x2) <<>> (RevertableProperty y1 y2) =
RevertableProperty
(x1 <<>> y1)
(y2 <<>> x2)