module Propellor.Types
( Host(..)
, Property
, Info
, HasInfo
, NoInfo
, CInfo
, Desc
, infoProperty
, simpleProperty
, adjustPropertySatisfy
, propertyInfo
, propertyDesc
, propertyChildren
, RevertableProperty(..)
, MkRevertableProperty(..)
, IsProp(..)
, Combines(..)
, CombinedType
, ResultCombiner
, Propellor(..)
, LiftPropellor(..)
, 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
)
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 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
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
instance Show (Property i) where
show p = "property " ++ show (propertyDesc p)
propertyChildren :: Property i -> [Property i]
propertyChildren (IProperty _ _ _ cs) = cs
propertyChildren (SProperty _ _ cs) = cs
data RevertableProperty i = RevertableProperty (Property i) (Property i)
instance Show (RevertableProperty i) where
show (RevertableProperty p _) = show p
class MkRevertableProperty i1 i2 where
(<!>) :: Property i1 -> Property i2 -> RevertableProperty (CInfo i1 i2)
instance MkRevertableProperty HasInfo HasInfo where
x <!> y = RevertableProperty x y
instance MkRevertableProperty NoInfo NoInfo where
x <!> y = RevertableProperty x y
instance MkRevertableProperty NoInfo HasInfo where
x <!> y = RevertableProperty (toProp x) y
instance MkRevertableProperty HasInfo NoInfo where
x <!> y = RevertableProperty x (toProp y)
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 HasInfo) where
setDesc = setDescR
getDesc (RevertableProperty p1 _) = getDesc p1
toProp (RevertableProperty p1 _) = p1
getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
instance IsProp (RevertableProperty NoInfo) where
setDesc = setDescR
getDesc (RevertableProperty p1 _) = getDesc p1
toProp (RevertableProperty p1 _) = toProp p1
getInfoRecursive (RevertableProperty _ _) = mempty
setDescR :: IsProp (Property i) => RevertableProperty i -> Desc -> RevertableProperty i
setDescR (RevertableProperty p1 p2) d =
RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
type family CombinedType x y
type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
type instance CombinedType (RevertableProperty x) (RevertableProperty y) = RevertableProperty (CInfo x y)
type instance CombinedType (RevertableProperty x) (Property y) = Property (CInfo x y)
type instance CombinedType (Property x) (RevertableProperty y) = Property (CInfo x y)
type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result
class Combines x y where
combineWith
:: ResultCombiner
-> ResultCombiner
-> x
-> y
-> CombinedType x y
instance Combines (Property HasInfo) (Property HasInfo) where
combineWith f _ (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
IProperty d1 (f a1 a2) i1 (y : cs1)
instance Combines (Property HasInfo) (Property NoInfo) where
combineWith f _ (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) =
IProperty d1 (f a1 a2) i1 (toIProperty y : cs1)
instance Combines (Property NoInfo) (Property HasInfo) where
combineWith f _ (SProperty d1 a1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
IProperty d1 (f a1 a2) mempty (y : map toIProperty cs1)
instance Combines (Property NoInfo) (Property NoInfo) where
combineWith f _ (SProperty d1 a1 cs1) y@(SProperty _d2 a2 _cs2) =
SProperty d1 (f a1 a2) (y : cs1)
instance Combines (RevertableProperty NoInfo) (RevertableProperty NoInfo) where
combineWith = combineWithRR
instance Combines (RevertableProperty HasInfo) (RevertableProperty HasInfo) where
combineWith = combineWithRR
instance Combines (RevertableProperty HasInfo) (RevertableProperty NoInfo) where
combineWith = combineWithRR
instance Combines (RevertableProperty NoInfo) (RevertableProperty HasInfo) where
combineWith = combineWithRR
instance Combines (RevertableProperty NoInfo) (Property HasInfo) where
combineWith = combineWithRP
instance Combines (RevertableProperty NoInfo) (Property NoInfo) where
combineWith = combineWithRP
instance Combines (RevertableProperty HasInfo) (Property HasInfo) where
combineWith = combineWithRP
instance Combines (RevertableProperty HasInfo) (Property NoInfo) where
combineWith = combineWithRP
instance Combines (Property HasInfo) (RevertableProperty NoInfo) where
combineWith = combineWithPR
instance Combines (Property NoInfo) (RevertableProperty NoInfo) where
combineWith = combineWithPR
instance Combines (Property HasInfo) (RevertableProperty HasInfo) where
combineWith = combineWithPR
instance Combines (Property NoInfo) (RevertableProperty HasInfo) where
combineWith = combineWithPR
combineWithRR
:: Combines (Property x) (Property y)
=> ResultCombiner
-> ResultCombiner
-> RevertableProperty x
-> RevertableProperty y
-> RevertableProperty (CInfo x y)
combineWithRR sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
RevertableProperty
(combineWith sf tf s1 s2)
(combineWith tf sf t1 t2)
combineWithRP
:: Combines (Property i) y
=> (Propellor Result -> Propellor Result -> Propellor Result)
-> (Propellor Result -> Propellor Result -> Propellor Result)
-> RevertableProperty i
-> y
-> CombinedType (Property i) y
combineWithRP sf tf (RevertableProperty x _) y = combineWith sf tf x y
combineWithPR
:: Combines x (Property i)
=> (Propellor Result -> Propellor Result -> Propellor Result)
-> (Propellor Result -> Propellor Result -> Propellor Result)
-> x
-> RevertableProperty i
-> CombinedType x (Property i)
combineWithPR sf tf x (RevertableProperty y _) = combineWith sf tf x y