propellor-4.1.0: property-based host configuration management in haskell

Safe HaskellNone
LanguageHaskell98

Propellor.Types

Contents

Synopsis

Core data types

data Host Source #

Everything Propellor knows about a system: Its hostname, properties and their collected info.

Constructors

Host 

data Property metatypes Source #

The core data type of Propellor, this represents a property that the system should have, with a descrition, and an action to ensure it has the property.

There are different types of properties that target different OS's, and so have different metatypes. For example: "Property DebianLike" and "Property FreeBSD".

Also, some properties have associated Info, which is indicated in their type: "Property (HasInfo + DebianLike)"

There are many associated type families, which are mostly used internally, so you needn't worry about them.

Constructors

Property metatypes Desc (Maybe (Propellor Result)) Info [ChildProperty] 

Instances

TightenTargets Property Source # 

Methods

tightenTargets :: ((CheckCombine ~ NotSuperset a (Targets a untightened) (Targets a tightened)) CanCombine, (CheckCombine ~ NotSuperset a (NonTargets a tightened) (NonTargets a untightened)) CanCombine, SingI [a] tightened) => Property (MetaTypes [a] untightened) -> Property (MetaTypes [a] tightened) Source #

Checkable Property i Source # 
Show (Property metatypes) Source # 

Methods

showsPrec :: Int -> Property metatypes -> ShowS #

show :: Property metatypes -> String #

showList :: [Property metatypes] -> ShowS #

SingI k metatypes => Monoid (Property (MetaTypes k metatypes)) Source #

Any type of Property is a monoid. When properties x and y are appended together, the resulting property has a description like "x and y". Note that when x fails to be ensured, it will not try to ensure y.

Methods

mempty :: Property (MetaTypes k metatypes) #

mappend :: Property (MetaTypes k metatypes) -> Property (MetaTypes k metatypes) -> Property (MetaTypes k metatypes) #

mconcat :: [Property (MetaTypes k metatypes)] -> Property (MetaTypes k metatypes) #

IsProp (Property metatypes) Source # 

Methods

setDesc :: Property metatypes -> Desc -> Property metatypes Source #

getDesc :: Property metatypes -> Desc Source #

getChildren :: Property metatypes -> [ChildProperty] Source #

addChildren :: Property metatypes -> [ChildProperty] -> Property metatypes Source #

getInfoRecursive :: Property metatypes -> Info Source #

getInfo :: Property metatypes -> Info Source #

toChildProperty :: Property metatypes -> ChildProperty Source #

getSatisfy :: Property metatypes -> Maybe (Propellor Result) Source #

((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (Property (MetaTypes [a] x)) (Property (MetaTypes [a] y)) Source # 
((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (Property (MetaTypes [a] x)) (RevertableProperty (MetaTypes [a] y) (MetaTypes k y')) Source # 
((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (RevertableProperty (MetaTypes [a] x) (MetaTypes k x')) (Property (MetaTypes [a] y)) Source # 
type CombinedType (Property (MetaTypes [a] x)) (Property (MetaTypes [a] y)) Source # 
type CombinedType (Property (MetaTypes [a] x)) (Property (MetaTypes [a] y)) = Property (MetaTypes [a] (Combine a x y))
type CombinedType (Property (MetaTypes [a] x)) (RevertableProperty (MetaTypes [a] y) (MetaTypes k y')) Source # 
type CombinedType (RevertableProperty (MetaTypes [a] x) (MetaTypes k x')) (Property (MetaTypes [a] y)) Source # 

property :: SingI metatypes => Desc -> Propellor Result -> Property (MetaTypes metatypes) Source #

Constructs a Property, from a description and an action to run to ensure the Property is met.

Due to the polymorphic return type of this function, most uses will need to specify a type signature. This lets you specify what OS the property targets, etc.

For example:

 foo :: Property Debian
 foo = property "foo" $ do
	...
 	return MadeChange

property'' :: SingI metatypes => Desc -> Maybe (Propellor Result) -> Property (MetaTypes metatypes) Source #

data RevertableProperty setupmetatypes undometatypes Source #

A property that can be reverted. The first Property is run normally and the second is run when it's reverted.

Constructors

RevertableProperty 

Fields

Instances

((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (Property (MetaTypes [a] x)) (RevertableProperty (MetaTypes [a] y) (MetaTypes k y')) Source # 
Show (RevertableProperty setupmetatypes undometatypes) Source # 

Methods

showsPrec :: Int -> RevertableProperty setupmetatypes undometatypes -> ShowS #

show :: RevertableProperty setupmetatypes undometatypes -> String #

showList :: [RevertableProperty setupmetatypes undometatypes] -> ShowS #

(Monoid (Property setupmetatypes), Monoid (Property undometatypes)) => Monoid (RevertableProperty setupmetatypes undometatypes) Source #

Any type of RevertableProperty is a monoid. When revertable properties x and y are appended together, the resulting revertable property has a description like "x and y". Note that when x fails to be ensured, it will not try to ensure y.

Methods

mempty :: RevertableProperty setupmetatypes undometatypes #

mappend :: RevertableProperty setupmetatypes undometatypes -> RevertableProperty setupmetatypes undometatypes -> RevertableProperty setupmetatypes undometatypes #

mconcat :: [RevertableProperty setupmetatypes undometatypes] -> RevertableProperty setupmetatypes undometatypes #

IsProp (RevertableProperty setupmetatypes undometatypes) Source # 

Methods

setDesc :: RevertableProperty setupmetatypes undometatypes -> Desc -> RevertableProperty setupmetatypes undometatypes Source #

getDesc :: RevertableProperty setupmetatypes undometatypes -> Desc Source #

getChildren :: RevertableProperty setupmetatypes undometatypes -> [ChildProperty] Source #

addChildren :: RevertableProperty setupmetatypes undometatypes -> [ChildProperty] -> RevertableProperty setupmetatypes undometatypes Source #

getInfoRecursive :: RevertableProperty setupmetatypes undometatypes -> Info Source #

getInfo :: RevertableProperty setupmetatypes undometatypes -> Info Source #

toChildProperty :: RevertableProperty setupmetatypes undometatypes -> ChildProperty Source #

getSatisfy :: RevertableProperty setupmetatypes undometatypes -> Maybe (Propellor Result) Source #

((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (RevertableProperty (MetaTypes [a] x) (MetaTypes k x')) (Property (MetaTypes [a] y)) Source # 
((~) CheckCombine (CheckCombinable a1 x y) CanCombine, (~) CheckCombine (CheckCombinable a x' y') CanCombine, SingI [a1] (Combine a1 x y), SingI [a] (Combine a x' y')) => Combines (RevertableProperty (MetaTypes [a1] x) (MetaTypes [a] x')) (RevertableProperty (MetaTypes [a1] y) (MetaTypes [a] y')) Source # 
type CombinedType (Property (MetaTypes [a] x)) (RevertableProperty (MetaTypes [a] y) (MetaTypes k y')) Source # 
type CombinedType (RevertableProperty (MetaTypes [a] x) (MetaTypes k x')) (Property (MetaTypes [a] y)) Source # 
type CombinedType (RevertableProperty (MetaTypes [a1] x) (MetaTypes [a] x')) (RevertableProperty (MetaTypes [a1] y) (MetaTypes [a] y')) Source # 
type CombinedType (RevertableProperty (MetaTypes [a1] x) (MetaTypes [a] x')) (RevertableProperty (MetaTypes [a1] y) (MetaTypes [a] y')) = RevertableProperty (MetaTypes [a1] (Combine a1 x y)) (MetaTypes [a] (Combine a x' y'))

(<!>) :: Property setupmetatypes -> Property undometatypes -> RevertableProperty setupmetatypes undometatypes Source #

Shorthand to construct a revertable property from any two Properties.

newtype Propellor p Source #

Propellor's monad provides read-only access to info about the host it's running on, and a writer to accumulate EndActions.

Constructors

Propellor 

Fields

Instances

Monad Propellor Source # 

Methods

(>>=) :: Propellor a -> (a -> Propellor b) -> Propellor b #

(>>) :: Propellor a -> Propellor b -> Propellor b #

return :: a -> Propellor a #

fail :: String -> Propellor a #

Functor Propellor Source # 

Methods

fmap :: (a -> b) -> Propellor a -> Propellor b #

(<$) :: a -> Propellor b -> Propellor a #

Applicative Propellor Source # 

Methods

pure :: a -> Propellor a #

(<*>) :: Propellor (a -> b) -> Propellor a -> Propellor b #

(*>) :: Propellor a -> Propellor b -> Propellor b #

(<*) :: Propellor a -> Propellor b -> Propellor a #

MonadIO Propellor Source # 

Methods

liftIO :: IO a -> Propellor a #

MonadThrow Propellor Source # 

Methods

throwM :: Exception e => e -> Propellor a #

MonadCatch Propellor Source # 

Methods

catch :: Exception e => Propellor a -> (e -> Propellor a) -> Propellor a #

MonadMask Propellor Source # 

Methods

mask :: ((forall a. Propellor a -> Propellor a) -> Propellor b) -> Propellor b #

uninterruptibleMask :: ((forall a. Propellor a -> Propellor a) -> Propellor b) -> Propellor b #

LiftPropellor Propellor Source # 
MonadReader Host Propellor Source # 

Methods

ask :: Propellor Host #

local :: (Host -> Host) -> Propellor a -> Propellor a #

reader :: (Host -> a) -> Propellor a #

Monoid (Propellor Result) Source #

When two actions are appended together, the second action is only run if the first action does not fail.

MonadWriter [EndAction] Propellor Source # 

Methods

writer :: (a, [EndAction]) -> Propellor a #

tell :: [EndAction] -> Propellor () #

listen :: Propellor a -> Propellor (a, [EndAction]) #

pass :: Propellor (a, [EndAction] -> [EndAction]) -> Propellor a #

class LiftPropellor m where Source #

Minimal complete definition

liftPropellor

Methods

liftPropellor :: m a -> Propellor a Source #

data Info Source #

Information about a Host, which can be provided by its properties.

Many different types of data can be contained in the same Info value at the same time. See toInfo and fromInfo.

Instances

Types of properties

type DebianLike = MetaTypes '[Targeting OSDebian, Targeting OSBuntish] Source #

Debian and derivatives.

type HasInfo = MetaTypes '[WithInfo] Source #

Used to indicate that a Property adds Info to the Host where it's used.

type family a + b :: ab Source #

Convenience type operator to combine two MetaTypes lists.

For example:

HasInfo + Debian

Which is shorthand for this type:

MetaTypes '[WithInfo, Targeting OSDebian]

Instances

type (+) * (MetaTypes [a] a1) (MetaTypes [a] b) Source # 
type (+) * (MetaTypes [a] a1) (MetaTypes [a] b)

class TightenTargets p where Source #

Minimal complete definition

tightenTargets

Methods

tightenTargets :: ((Targets untightened `NotSuperset` Targets tightened) ~ CanCombine, (NonTargets tightened `NotSuperset` NonTargets untightened) ~ CanCombine, SingI tightened) => p (MetaTypes untightened) -> p (MetaTypes tightened) Source #

Tightens the MetaType list of a Property (or similar), to contain fewer targets.

For example, to make a property that uses apt-get, which is only available on DebianLike systems:

upgraded :: Property DebianLike
upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"]

Instances

TightenTargets Property Source # 

Methods

tightenTargets :: ((CheckCombine ~ NotSuperset a (Targets a untightened) (Targets a tightened)) CanCombine, (CheckCombine ~ NotSuperset a (NonTargets a tightened) (NonTargets a untightened)) CanCombine, SingI [a] tightened) => Property (MetaTypes [a] untightened) -> Property (MetaTypes [a] tightened) Source #

TightenTargets UncheckedProperty Source # 

Methods

tightenTargets :: ((CheckCombine ~ NotSuperset a (Targets a untightened) (Targets a tightened)) CanCombine, (CheckCombine ~ NotSuperset a (NonTargets a tightened) (NonTargets a untightened)) CanCombine, SingI [a] tightened) => UncheckedProperty (MetaTypes [a] untightened) -> UncheckedProperty (MetaTypes [a] tightened) Source #

Combining and modifying properties

class Combines x y where Source #

Minimal complete definition

combineWith

Methods

combineWith :: ResultCombiner -> ResultCombiner -> x -> y -> CombinedType x y Source #

Combines together two properties, yielding a property that has the description and info of the first, and that has the second property as a child property.

Instances

((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (Property (MetaTypes [a] x)) (Property (MetaTypes [a] y)) Source # 
((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (Property (MetaTypes [a] x)) (RevertableProperty (MetaTypes [a] y) (MetaTypes k y')) Source # 
((~) CheckCombine (CheckCombinable a x y) CanCombine, SingI [a] (Combine a x y)) => Combines (RevertableProperty (MetaTypes [a] x) (MetaTypes k x')) (Property (MetaTypes [a] y)) Source # 
((~) CheckCombine (CheckCombinable a1 x y) CanCombine, (~) CheckCombine (CheckCombinable a x' y') CanCombine, SingI [a1] (Combine a1 x y), SingI [a] (Combine a x' y')) => Combines (RevertableProperty (MetaTypes [a1] x) (MetaTypes [a] x')) (RevertableProperty (MetaTypes [a1] y) (MetaTypes [a] y')) Source # 

type family CombinedType x y Source #

Type level calculation of the type that results from combining two types of properties.

adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes Source #

Changes the action that is performed to satisfy a property.

Other included types