Safe Haskell | None |
---|---|
Language | Haskell98 |
When propellor runs on a Host, it ensures that its Properties are satisfied, taking action as necessary when a Property is not currently satisfied.
A simple propellor program example:
import Propellor import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt main :: IO () main = defaultMain hosts hosts :: [Host] hosts = [example] example :: Host example = host "example.com" $ props & Apt.installed ["mydaemon"] & "/etc/mydaemon.conf" `File.containsLine` "secure=1" `onChange` cmdProperty "service" ["mydaemon", "restart"] ! Apt.installed ["unwantedpackage"]
See config.hs for a more complete example, and clone Propellor's git repository for a deployable system using Propellor: git clone git://git.joeyh.name/propellor
Synopsis
- data Host = Host {
- hostName :: HostName
- hostProperties :: [ChildProperty]
- hostInfo :: Info
- data Property metatypes
- data RevertableProperty setupmetatypes undometatypes
- module Propellor.Types
- defaultMain :: [Host] -> IO ()
- host :: HostName -> Props metatypes -> Host
- (&) :: (IsProp p, MetaTypes y ~ GetMetaTypes p, CheckCombinableNote x y (NoteFor (Text "&"))) => Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
- (!) :: CheckCombinableNote x z (NoteFor (Text "!")) => Props (MetaTypes x) -> RevertableProperty (MetaTypes y) (MetaTypes z) -> Props (MetaTypes (Combine x z))
- requires :: Combines x y => x -> y -> CombinedType x y
- before :: Combines x y => x -> y -> CombinedType x y
- onChange :: Combines x y => x -> y -> CombinedType x y
- describe :: IsProp p => p -> Desc -> p
- module Propellor.Property
- module Propellor.Property.Cmd
- module Propellor.Info
- module Propellor.Property.List
- module Propellor.Types.PrivData
- fromString :: IsString a => String -> a
- (<>) :: Semigroup a => a -> a -> a
- class Semigroup a => Monoid a where
- newtype First a = First {}
- newtype Last a = Last {}
- newtype Ap (f :: k -> Type) (a :: k) :: forall k. (k -> Type) -> k -> Type = Ap {
- getAp :: f a
- newtype Dual a = Dual {
- getDual :: a
- newtype Endo a = Endo {
- appEndo :: a -> a
- newtype All = All {}
- newtype Any = Any {}
- newtype Sum a = Sum {
- getSum :: a
- newtype Product a = Product {
- getProduct :: a
- newtype Alt (f :: k -> Type) (a :: k) :: forall k. (k -> Type) -> k -> Type = Alt {
- getAlt :: f a
Core data types
Everything Propellor knows about a system: Its hostname, properties and their collected info.
Host | |
|
Instances
Show Host Source # | |
IsContainer Host Source # | |
Defined in Propellor.Container containerProperties :: Host -> [ChildProperty] Source # containerInfo :: Host -> Info Source # setContainerProperties :: Host -> [ChildProperty] -> Host Source # | |
Conductable Host Source # | |
MonadReader Host Propellor Source # | |
Conductable [Host] Source # | |
data Property metatypes Source #
The core data type of Propellor, this represents a property that the system should have, with a description, 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.
Instances
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.
See Versioned
for a way to use RevertableProperty to define different
versions of a host.
Instances
module Propellor.Types
Config file
defaultMain :: [Host] -> IO () Source #
Runs propellor on hosts, as controlled by command-line options.
host :: HostName -> Props metatypes -> Host Source #
Defines a host and its properties.
host "example.com" $ props & someproperty ! oldproperty & otherproperty
(&) :: (IsProp p, MetaTypes y ~ GetMetaTypes p, CheckCombinableNote x y (NoteFor (Text "&"))) => Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y)) infixl 1 Source #
Adds a property to a Props.
Can add Properties and RevertableProperties
(!) :: CheckCombinableNote x z (NoteFor (Text "!")) => Props (MetaTypes x) -> RevertableProperty (MetaTypes y) (MetaTypes z) -> Props (MetaTypes (Combine x z)) infixl 1 Source #
Adds a property in reverted form.
Propertries
Properties are often combined together in your propellor configuration. For example:
"/etc/foo/config" `File.containsLine` "bar=1" `requires` File.dirExists "/etc/foo"
requires :: Combines x y => x -> y -> CombinedType x y Source #
Indicates that the first property depends on the second, so before the first is ensured, the second must be ensured.
The combined property uses the description of the first property.
before :: Combines x y => x -> y -> CombinedType x y Source #
Combines together two properties, resulting in one property that ensures the first, and if the first succeeds, ensures the second.
The combined property uses the description of the first property.
onChange :: Combines x y => x -> y -> CombinedType x y Source #
Whenever a change has to be made for a Property, causes a hook Property to also be run, but not otherwise.
module Propellor.Property
Everything you need to build your own properties, and useful property combinators
module Propellor.Property.Cmd
Properties to run shell commands
module Propellor.Info
Properties that set Info
module Propellor.Property.List
Combining a list of properties into a single property
module Propellor.Types.PrivData
Private data access for properties
fromString :: IsString a => String -> a #
class Semigroup a => Monoid a where #
The class of monoids (types with an associative binary operation that has an identity). Instances should satisfy the following laws:
x
<>
mempty
= xmempty
<>
x = xx
(<>
(y<>
z) = (x<>
y)<>
zSemigroup
law)mconcat
=foldr
'(<>)'mempty
The method names refer to the monoid of lists under concatenation, but there are many other instances.
Some types can be viewed as a monoid in more than one way,
e.g. both addition and multiplication on numbers.
In such cases we often define newtype
s and make those instances
of Monoid
, e.g. Sum
and Product
.
NOTE: Semigroup
is a superclass of Monoid
since base-4.11.0.0.
Identity of mappend
An associative operation
NOTE: This method is redundant and has the default
implementation
since base-4.11.0.0.mappend
= '(<>)'
Fold a list using the monoid.
For most types, the default definition for mconcat
will be
used, but the function is included in the class definition so
that an optimized version can be provided for specific types.
Instances
Maybe monoid returning the leftmost non-Nothing value.
is isomorphic to First
a
, but precedes it
historically.Alt
Maybe
a
>>>
getFirst (First (Just "hello") <> First Nothing <> First (Just "world"))
Just "hello"
Use of this type is discouraged. Note the following equivalence:
Data.Monoid.First x === Maybe (Data.Semigroup.First x)
In addition to being equivalent in the structural sense, the two
also have Monoid
instances that behave the same. This type will
be marked deprecated in GHC 8.8, and removed in GHC 8.10.
Users are advised to use the variant from Data.Semigroup and wrap
it in Maybe
.
Instances
Monad First | Since: base-4.8.0.0 |
Functor First | Since: base-4.8.0.0 |
MonadFix First | Since: base-4.8.0.0 |
Defined in Control.Monad.Fix | |
Applicative First | Since: base-4.8.0.0 |
Foldable First | Since: base-4.8.0.0 |
Defined in Data.Foldable fold :: Monoid m => First m -> m # foldMap :: Monoid m => (a -> m) -> First a -> m # foldr :: (a -> b -> b) -> b -> First a -> b # foldr' :: (a -> b -> b) -> b -> First a -> b # foldl :: (b -> a -> b) -> b -> First a -> b # foldl' :: (b -> a -> b) -> b -> First a -> b # foldr1 :: (a -> a -> a) -> First a -> a # foldl1 :: (a -> a -> a) -> First a -> a # elem :: Eq a => a -> First a -> Bool # maximum :: Ord a => First a -> a # minimum :: Ord a => First a -> a # | |
Traversable First | Since: base-4.8.0.0 |
Eq a => Eq (First a) | Since: base-2.1 |
Ord a => Ord (First a) | Since: base-2.1 |
Read a => Read (First a) | Since: base-2.1 |
Show a => Show (First a) | Since: base-2.1 |
Generic (First a) | |
Semigroup (First a) | Since: base-4.9.0.0 |
Monoid (First a) | Since: base-2.1 |
Generic1 First | |
type Rep (First a) | Since: base-4.7.0.0 |
Defined in Data.Monoid | |
type Rep1 First | Since: base-4.7.0.0 |
Defined in Data.Monoid |
Maybe monoid returning the rightmost non-Nothing value.
is isomorphic to Last
a
, and thus to
Dual
(First
a)Dual
(Alt
Maybe
a)
>>>
getLast (Last (Just "hello") <> Last Nothing <> Last (Just "world"))
Just "world"
Use of this type is discouraged. Note the following equivalence:
Data.Monoid.Last x === Maybe (Data.Semigroup.Last x)
In addition to being equivalent in the structural sense, the two
also have Monoid
instances that behave the same. This type will
be marked deprecated in GHC 8.8, and removed in GHC 8.10.
Users are advised to use the variant from Data.Semigroup and wrap
it in Maybe
.
Instances
Monad Last | Since: base-4.8.0.0 |
Functor Last | Since: base-4.8.0.0 |
MonadFix Last | Since: base-4.8.0.0 |
Defined in Control.Monad.Fix | |
Applicative Last | Since: base-4.8.0.0 |
Foldable Last | Since: base-4.8.0.0 |
Defined in Data.Foldable fold :: Monoid m => Last m -> m # foldMap :: Monoid m => (a -> m) -> Last a -> m # foldr :: (a -> b -> b) -> b -> Last a -> b # foldr' :: (a -> b -> b) -> b -> Last a -> b # foldl :: (b -> a -> b) -> b -> Last a -> b # foldl' :: (b -> a -> b) -> b -> Last a -> b # foldr1 :: (a -> a -> a) -> Last a -> a # foldl1 :: (a -> a -> a) -> Last a -> a # elem :: Eq a => a -> Last a -> Bool # maximum :: Ord a => Last a -> a # | |
Traversable Last | Since: base-4.8.0.0 |
Eq a => Eq (Last a) | Since: base-2.1 |
Ord a => Ord (Last a) | Since: base-2.1 |
Read a => Read (Last a) | Since: base-2.1 |
Show a => Show (Last a) | Since: base-2.1 |
Generic (Last a) | |
Semigroup (Last a) | Since: base-4.9.0.0 |
Monoid (Last a) | Since: base-2.1 |
Generic1 Last | |
type Rep (Last a) | Since: base-4.7.0.0 |
Defined in Data.Monoid | |
type Rep1 Last | Since: base-4.7.0.0 |
Defined in Data.Monoid |
newtype Ap (f :: k -> Type) (a :: k) :: forall k. (k -> Type) -> k -> Type #
This data type witnesses the lifting of a Monoid
into an
Applicative
pointwise.
Since: base-4.12.0.0
Instances
Generic1 (Ap f :: k -> Type) | |
Monad f => Monad (Ap f) | Since: base-4.12.0.0 |
Functor f => Functor (Ap f) | Since: base-4.12.0.0 |
MonadFix f => MonadFix (Ap f) | Since: base-4.12.0.0 |
Defined in Control.Monad.Fix | |
MonadFail f => MonadFail (Ap f) | Since: base-4.12.0.0 |
Defined in Data.Monoid | |
Applicative f => Applicative (Ap f) | Since: base-4.12.0.0 |
Foldable f => Foldable (Ap f) | Since: base-4.12.0.0 |
Defined in Data.Foldable fold :: Monoid m => Ap f m -> m # foldMap :: Monoid m => (a -> m) -> Ap f a -> m # foldr :: (a -> b -> b) -> b -> Ap f a -> b # foldr' :: (a -> b -> b) -> b -> Ap f a -> b # foldl :: (b -> a -> b) -> b -> Ap f a -> b # foldl' :: (b -> a -> b) -> b -> Ap f a -> b # foldr1 :: (a -> a -> a) -> Ap f a -> a # foldl1 :: (a -> a -> a) -> Ap f a -> a # elem :: Eq a => a -> Ap f a -> Bool # maximum :: Ord a => Ap f a -> a # | |
Traversable f => Traversable (Ap f) | Since: base-4.12.0.0 |
Alternative f => Alternative (Ap f) | Since: base-4.12.0.0 |
MonadPlus f => MonadPlus (Ap f) | Since: base-4.12.0.0 |
(Applicative f, Bounded a) => Bounded (Ap f a) | Since: base-4.12.0.0 |
Enum (f a) => Enum (Ap f a) | Since: base-4.12.0.0 |
Defined in Data.Monoid | |
Eq (f a) => Eq (Ap f a) | Since: base-4.12.0.0 |
(Applicative f, Num a) => Num (Ap f a) | Since: base-4.12.0.0 |
Ord (f a) => Ord (Ap f a) | Since: base-4.12.0.0 |
Read (f a) => Read (Ap f a) | Since: base-4.12.0.0 |
Show (f a) => Show (Ap f a) | Since: base-4.12.0.0 |
Generic (Ap f a) | |
(Applicative f, Semigroup a) => Semigroup (Ap f a) | Since: base-4.12.0.0 |
(Applicative f, Monoid a) => Monoid (Ap f a) | Since: base-4.12.0.0 |
type Rep1 (Ap f :: k -> Type) | Since: base-4.12.0.0 |
Defined in Data.Monoid | |
type Rep (Ap f a) | Since: base-4.12.0.0 |
Defined in Data.Monoid |
The dual of a Monoid
, obtained by swapping the arguments of mappend
.
>>>
getDual (mappend (Dual "Hello") (Dual "World"))
"WorldHello"
Instances
Monad Dual | Since: base-4.8.0.0 |
Functor Dual | Since: base-4.8.0.0 |
MonadFix Dual | Since: base-4.8.0.0 |
Defined in Control.Monad.Fix | |
Applicative Dual | Since: base-4.8.0.0 |
Foldable Dual | Since: base-4.8.0.0 |
Defined in Data.Foldable fold :: Monoid m => Dual m -> m # foldMap :: Monoid m => (a -> m) -> Dual a -> m # foldr :: (a -> b -> b) -> b -> Dual a -> b # foldr' :: (a -> b -> b) -> b -> Dual a -> b # foldl :: (b -> a -> b) -> b -> Dual a -> b # foldl' :: (b -> a -> b) -> b -> Dual a -> b # foldr1 :: (a -> a -> a) -> Dual a -> a # foldl1 :: (a -> a -> a) -> Dual a -> a # elem :: Eq a => a -> Dual a -> Bool # maximum :: Ord a => Dual a -> a # | |
Traversable Dual | Since: base-4.8.0.0 |
Bounded a => Bounded (Dual a) | Since: base-2.1 |
Eq a => Eq (Dual a) | Since: base-2.1 |
Ord a => Ord (Dual a) | Since: base-2.1 |
Read a => Read (Dual a) | Since: base-2.1 |
Show a => Show (Dual a) | Since: base-2.1 |
Generic (Dual a) | |
Semigroup a => Semigroup (Dual a) | Since: base-4.9.0.0 |
Monoid a => Monoid (Dual a) | Since: base-2.1 |
Generic1 Dual | |
type Rep (Dual a) | Since: base-4.7.0.0 |
Defined in Data.Semigroup.Internal | |
type Rep1 Dual | Since: base-4.7.0.0 |
Defined in Data.Semigroup.Internal |
The monoid of endomorphisms under composition.
>>>
let computation = Endo ("Hello, " ++) <> Endo (++ "!")
>>>
appEndo computation "Haskell"
"Hello, Haskell!"
Boolean monoid under conjunction (&&
).
>>>
getAll (All True <> mempty <> All False)
False
>>>
getAll (mconcat (map (\x -> All (even x)) [2,4,6,7,8]))
False
Instances
Bounded All | Since: base-2.1 |
Eq All | Since: base-2.1 |
Ord All | Since: base-2.1 |
Read All | Since: base-2.1 |
Show All | Since: base-2.1 |
Generic All | |
Semigroup All | Since: base-4.9.0.0 |
Monoid All | Since: base-2.1 |
type Rep All | Since: base-4.7.0.0 |
Defined in Data.Semigroup.Internal | |
type MEmpty | |
Defined in Fcf.Class.Monoid | |
type (All a :: All) <> (All b :: All) | |
Boolean monoid under disjunction (||
).
>>>
getAny (Any True <> mempty <> Any False)
True
>>>
getAny (mconcat (map (\x -> Any (even x)) [2,4,6,7,8]))
True
Instances
Bounded Any | Since: base-2.1 |
Eq Any | Since: base-2.1 |
Ord Any | Since: base-2.1 |
Read Any | Since: base-2.1 |
Show Any | Since: base-2.1 |
Generic Any | |
Semigroup Any | Since: base-4.9.0.0 |
Monoid Any | Since: base-2.1 |
type Rep Any | Since: base-4.7.0.0 |
Defined in Data.Semigroup.Internal | |
type MEmpty | |
Defined in Fcf.Class.Monoid | |
type (Any a :: Any) <> (Any b :: Any) | |
Monoid under addition.
>>>
getSum (Sum 1 <> Sum 2 <> mempty)
3
Instances
Monad Sum | Since: base-4.8.0.0 |
Functor Sum | Since: base-4.8.0.0 |
MonadFix Sum | Since: base-4.8.0.0 |
Defined in Control.Monad.Fix | |
Applicative Sum | Since: base-4.8.0.0 |
Foldable Sum | Since: base-4.8.0.0 |
Defined in Data.Foldable fold :: Monoid m => Sum m -> m # foldMap :: Monoid m => (a -> m) -> Sum a -> m # foldr :: (a -> b -> b) -> b -> Sum a -> b # foldr' :: (a -> b -> b) -> b -> Sum a -> b # foldl :: (b -> a -> b) -> b -> Sum a -> b # foldl' :: (b -> a -> b) -> b -> Sum a -> b # foldr1 :: (a -> a -> a) -> Sum a -> a # foldl1 :: (a -> a -> a) -> Sum a -> a # elem :: Eq a => a -> Sum a -> Bool # maximum :: Ord a => Sum a -> a # | |
Traversable Sum | Since: base-4.8.0.0 |
Bounded a => Bounded (Sum a) | Since: base-2.1 |
Eq a => Eq (Sum a) | Since: base-2.1 |
Num a => Num (Sum a) | Since: base-4.7.0.0 |
Ord a => Ord (Sum a) | Since: base-2.1 |
Read a => Read (Sum a) | Since: base-2.1 |
Show a => Show (Sum a) | Since: base-2.1 |
Generic (Sum a) | |
Num a => Semigroup (Sum a) | Since: base-4.9.0.0 |
Num a => Monoid (Sum a) | Since: base-2.1 |
Generic1 Sum | |
type Rep (Sum a) | Since: base-4.7.0.0 |
Defined in Data.Semigroup.Internal | |
type Rep1 Sum | Since: base-4.7.0.0 |
Defined in Data.Semigroup.Internal |
Monoid under multiplication.
>>>
getProduct (Product 3 <> Product 4 <> mempty)
12
Product | |
|
Instances
Monad Product | Since: base-4.8.0.0 |
Functor Product | Since: base-4.8.0.0 |
MonadFix Product | Since: base-4.8.0.0 |
Defined in Control.Monad.Fix | |
Applicative Product | Since: base-4.8.0.0 |
Foldable Product | Since: base-4.8.0.0 |
Defined in Data.Foldable fold :: Monoid m => Product m -> m # foldMap :: Monoid m => (a -> m) -> Product a -> m # foldr :: (a -> b -> b) -> b -> Product a -> b # foldr' :: (a -> b -> b) -> b -> Product a -> b # foldl :: (b -> a -> b) -> b -> Product a -> b # foldl' :: (b -> a -> b) -> b -> Product a -> b # foldr1 :: (a -> a -> a) -> Product a -> a # foldl1 :: (a -> a -> a) -> Product a -> a # elem :: Eq a => a -> Product a -> Bool # maximum :: Ord a => Product a -> a # minimum :: Ord a => Product a -> a # | |
Traversable Product | Since: base-4.8.0.0 |
Bounded a => Bounded (Product a) | Since: base-2.1 |
Eq a => Eq (Product a) | Since: base-2.1 |
Num a => Num (Product a) | Since: base-4.7.0.0 |
Defined in Data.Semigroup.Internal | |
Ord a => Ord (Product a) | Since: base-2.1 |
Defined in Data.Semigroup.Internal | |
Read a => Read (Product a) | Since: base-2.1 |
Show a => Show (Product a) | Since: base-2.1 |
Generic (Product a) | |
Num a => Semigroup (Product a) | Since: base-4.9.0.0 |
Num a => Monoid (Product a) | Since: base-2.1 |
Generic1 Product | |
type Rep (Product a) | Since: base-4.7.0.0 |
Defined in Data.Semigroup.Internal | |
type Rep1 Product | Since: base-4.7.0.0 |
Defined in Data.Semigroup.Internal |
newtype Alt (f :: k -> Type) (a :: k) :: forall k. (k -> Type) -> k -> Type #
Monoid under <|>
.
Since: base-4.8.0.0
Instances
Generic1 (Alt f :: k -> Type) | |
Monad f => Monad (Alt f) | Since: base-4.8.0.0 |
Functor f => Functor (Alt f) | Since: base-4.8.0.0 |
MonadFix f => MonadFix (Alt f) | Since: base-4.8.0.0 |
Defined in Control.Monad.Fix | |
Applicative f => Applicative (Alt f) | Since: base-4.8.0.0 |
Foldable f => Foldable (Alt f) | Since: base-4.12.0.0 |
Defined in Data.Foldable fold :: Monoid m => Alt f m -> m # foldMap :: Monoid m => (a -> m) -> Alt f a -> m # foldr :: (a -> b -> b) -> b -> Alt f a -> b # foldr' :: (a -> b -> b) -> b -> Alt f a -> b # foldl :: (b -> a -> b) -> b -> Alt f a -> b # foldl' :: (b -> a -> b) -> b -> Alt f a -> b # foldr1 :: (a -> a -> a) -> Alt f a -> a # foldl1 :: (a -> a -> a) -> Alt f a -> a # elem :: Eq a => a -> Alt f a -> Bool # maximum :: Ord a => Alt f a -> a # minimum :: Ord a => Alt f a -> a # | |
Traversable f => Traversable (Alt f) | Since: base-4.12.0.0 |
Alternative f => Alternative (Alt f) | Since: base-4.8.0.0 |
MonadPlus f => MonadPlus (Alt f) | Since: base-4.8.0.0 |
Enum (f a) => Enum (Alt f a) | Since: base-4.8.0.0 |
Eq (f a) => Eq (Alt f a) | Since: base-4.8.0.0 |
Num (f a) => Num (Alt f a) | Since: base-4.8.0.0 |
Ord (f a) => Ord (Alt f a) | Since: base-4.8.0.0 |
Read (f a) => Read (Alt f a) | Since: base-4.8.0.0 |
Show (f a) => Show (Alt f a) | Since: base-4.8.0.0 |
Generic (Alt f a) | |
Alternative f => Semigroup (Alt f a) | Since: base-4.9.0.0 |
Alternative f => Monoid (Alt f a) | Since: base-4.8.0.0 |
type Rep1 (Alt f :: k -> Type) | Since: base-4.8.0.0 |
Defined in Data.Semigroup.Internal | |
type Rep (Alt f a) | Since: base-4.8.0.0 |
Defined in Data.Semigroup.Internal |