summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2015-10-10 11:40:12 -0400
committerJoey Hess2015-10-10 11:40:12 -0400
commit349e675a499187379ddb14c5f6ce8203de10183e (patch)
tree44f9eed959335dca27bb35947a952c3ca9f97efb /src
parentea29beecfeebf304e544ab588da43fa66d83fd43 (diff)
Improved documentation, particularly of the Propellor module.
This involved some code changes, including some renaming of instance methods. (ABI change)
Diffstat (limited to 'src')
-rw-r--r--src/Propellor.hs40
-rw-r--r--src/Propellor/Location.hs5
-rw-r--r--src/Propellor/PropAccum.hs44
-rw-r--r--src/Propellor/Property.hs12
-rw-r--r--src/Propellor/Property/Chroot.hs4
-rw-r--r--src/Propellor/Property/Docker.hs4
-rw-r--r--src/Propellor/Property/Systemd.hs4
-rw-r--r--src/Propellor/Types.hs57
8 files changed, 111 insertions, 59 deletions
diff --git a/src/Propellor.hs b/src/Propellor.hs
index 51079ed0..c316c729 100644
--- a/src/Propellor.hs
+++ b/src/Propellor.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE PackageImports #-}
+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
-- | Pulls in lots of useful modules for building and using Properties.
--
@@ -30,18 +31,42 @@
-- git clone <git://git.joeyh.name/propellor>
module Propellor (
- module Propellor.Types
+ -- * Core data types
+ Host(..)
+ , Property
+ , RevertableProperty
+ , (<!>)
+ -- * Defining a Host and its properties
+ , host
+ , (&)
+ , (!)
+ -- * Combining properties
+ -- | Properties are often combined together in your propellor
+ -- configuration. For example:
+ --
+ -- > "/etc/foo/config" `File.containsLine` "bar=1"
+ -- > `requires` File.dirExists "/etc/foo"
+ , requires
+ , before
+ , onChange
+ -- * Included modules
+ , module Propellor.Types
, module Propellor.Property
- , module Propellor.Property.List
+ -- | Everything you need to build your own properties,
+ -- and useful property combinators
, module Propellor.Property.Cmd
+ -- | Properties to run shell commands
+ , module Propellor.Property.List
+ -- | Combining a list of properties into a single property
+ , module Propellor.Types.PrivData
+ -- | Private data access for properties
, module Propellor.PropAccum
, module Propellor.Info
, module Propellor.PrivData
- , module Propellor.Types.PrivData
, module Propellor.Engine
, module Propellor.Exception
, module Propellor.Message
- , localdir
+ , module Propellor.Location
, module X
) where
@@ -57,7 +82,10 @@ import Propellor.Message
import Propellor.Exception
import Propellor.Info
import Propellor.PropAccum
+import Propellor.Location
+-- Things imported as X won't be included in the haddock for this page,
+-- but will be re-exported silently.
import Utility.PartialPrelude as X
import Utility.Process as X
import Utility.Exception as X
@@ -77,7 +105,3 @@ import Control.Monad as X
import Data.Monoid as X
import Control.Monad.IfElse as X
import "mtl" Control.Monad.Reader as X
-
--- | This is where propellor installs itself when deploying a host.
-localdir :: FilePath
-localdir = "/usr/local/propellor"
diff --git a/src/Propellor/Location.hs b/src/Propellor/Location.hs
new file mode 100644
index 00000000..3fc09538
--- /dev/null
+++ b/src/Propellor/Location.hs
@@ -0,0 +1,5 @@
+module Propellor.Location where
+
+-- | This is where propellor installs itself when deploying a host.
+localdir :: FilePath
+localdir = "/usr/local/propellor"
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index dec204a2..350f4ab4 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -4,6 +4,8 @@ module Propellor.PropAccum
( host
, props
, PropAccum(..)
+ , (&)
+ , (&^)
, (!)
, PropList
, propigateContainer
@@ -37,37 +39,45 @@ props = PropList []
-- | Something that can accumulate properties.
class PropAccum h where
-- | Adds a property.
- --
- -- Can add Properties and RevertableProperties
- (&) :: IsProp p => h -> p -> h
+ addProp :: IsProp p => h -> p -> h
- -- | Like (&), but adds the property at the front of the list.
- (&^) :: IsProp p => h -> p -> h
+ -- | Like addProp, but adds the property at the front of the list.
+ addPropFront :: IsProp p => h -> p -> h
getProperties :: h -> [Property HasInfo]
+-- | Adds a property to a `Host` or other `PropAccum`
+--
+-- Can add Properties and RevertableProperties
+(&) :: (PropAccum h, IsProp p) => h -> p -> h
+(&) = addProp
+
+-- | Adds a property before any other properties.
+(&^) :: (PropAccum h, IsProp p) => h -> p -> h
+(&^) = addPropFront
+
+-- | Adds a property in reverted form.
+(!) :: PropAccum h => h -> RevertableProperty -> h
+h ! p = h & revert p
+
+infixl 1 &
+infixl 1 &^
+infixl 1 !
+
instance PropAccum Host where
- (Host hn ps is) & p = Host hn (ps ++ [toProp p])
+ (Host hn ps is) `addProp` p = Host hn (ps ++ [toProp p])
(is <> getInfoRecursive p)
- (Host hn ps is) &^ p = Host hn (toProp p : ps)
+ (Host hn ps is) `addPropFront` p = Host hn (toProp p : ps)
(getInfoRecursive p <> is)
getProperties = hostProperties
data PropList = PropList [Property HasInfo]
instance PropAccum PropList where
- PropList l & p = PropList (toProp p : l)
- PropList l &^ p = PropList (l ++ [toProp p])
+ PropList l `addProp` p = PropList (toProp p : l)
+ PropList l `addPropFront` p = PropList (l ++ [toProp p])
getProperties (PropList l) = reverse l
--- | Adds a property in reverted form.
-(!) :: PropAccum h => h -> RevertableProperty -> h
-h ! p = h & revert p
-
-infixl 1 &^
-infixl 1 &
-infixl 1 !
-
-- | Adjust the provided Property, adding to its
-- propertyChidren the properties of the provided container.
--
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index e8d70a80..3ab66ca3 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -39,6 +39,18 @@ flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do
writeFile flagfile ""
return r
+-- | Indicates that the first property depends on the second,
+-- so before the first is ensured, the second must be ensured.
+requires :: Combines x y => x -> y -> CombinedType x y
+requires = (<<>>)
+
+-- | 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.
+before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x
+before x y = (y `requires` x) `describe` getDesc x
+
-- | Whenever a change has to be made for a Property, causes a hook
-- Property to also be run, but not otherwise.
onChange
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index b059e3eb..aecf33ec 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -34,8 +34,8 @@ data BuilderConf
deriving (Show)
instance PropAccum Chroot where
- (Chroot l s c h) & p = Chroot l s c (h & p)
- (Chroot l s c h) &^ p = Chroot l s c (h &^ p)
+ (Chroot l s c h) `addProp` p = Chroot l s c (h & p)
+ (Chroot l s c h) `addPropFront` p = Chroot l s c (h `addPropFront` p)
getProperties (Chroot _ _ _ h) = hostProperties h
-- | Defines a Chroot at the given location, built with debootstrap.
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index e6365276..c3a1de72 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -97,8 +97,8 @@ instance HasImage Container where
getImageName (Container i _) = i
instance PropAccum Container where
- (Container i h) & p = Container i (h & p)
- (Container i h) &^ p = Container i (h &^ p)
+ (Container i h) `addProp` p = Container i (h `addProp` p)
+ (Container i h) `addPropFront` p = Container i (h `addPropFront` p)
getProperties (Container _ h) = hostProperties h
-- | Defines a Container with a given name, image, and properties.
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index e44ef717..d816ab6c 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -62,8 +62,8 @@ data Container = Container MachineName Chroot.Chroot Host
deriving (Show)
instance PropAccum Container where
- (Container n c h) & p = Container n c (h & p)
- (Container n c h) &^ p = Container n c (h &^ p)
+ (Container n c h) `addProp` p = Container n c (h `addProp` p)
+ (Container n c h) `addPropFront` p = Container n c (h `addPropFront` p)
getProperties (Container _ _ h) = hostProperties h
-- | Starts a systemd service.
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index ce93e144..0dfafbe8 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -10,12 +10,12 @@
module Propellor.Types
( Host(..)
- , Desc
, Property
, Info
, HasInfo
, NoInfo
, CInfo
+ , Desc
, infoProperty
, simpleProperty
, adjustPropertySatisfy
@@ -27,7 +27,6 @@ module Propellor.Types
, IsProp(..)
, Combines(..)
, CombinedType
- , before
, combineWith
, Propellor(..)
, EndAction(..)
@@ -93,6 +92,12 @@ type Desc = String
-- | The core data type of Propellor, this represents a property
-- that the system should have, and an action to ensure it has the
-- property.
+--
+-- A property can have associated `Info` or not. This is tracked at the
+-- type level with Property `NoInfo` and Property `HasInfo`.
+--
+-- There are many instances and type families, which are mostly used
+-- internally, so you needn't worry about them.
data Property i where
IProperty :: Desc -> Propellor Result -> Info -> [Property HasInfo] -> Property HasInfo
SProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
@@ -164,11 +169,11 @@ propertyChildren :: Property i -> [Property i]
propertyChildren (IProperty _ _ _ cs) = cs
propertyChildren (SProperty _ _ cs) = cs
--- | A property that can be reverted.
+-- | A property that can be reverted. The first Property is run
+-- normally and the second is run when it's reverted.
data RevertableProperty = RevertableProperty (Property HasInfo) (Property HasInfo)
--- | Makes a revertable property; the first Property is run
--- normally and the second is run when it's reverted.
+-- | Shorthand to construct a revertable property.
(<!>) :: Property i1 -> Property i2 -> RevertableProperty
p1 <!> p2 = RevertableProperty (toIProperty p1) (toIProperty p2)
@@ -202,8 +207,8 @@ instance IsProp RevertableProperty where
-- | Return the Info of the currently active side.
getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
--- | Type level calculation of the type that results from combining two types
--- with `requires`.
+-- | Type level calculation of the type that results from combining two
+-- types of properties.
type family CombinedType x y
type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
type instance CombinedType RevertableProperty (Property NoInfo) = RevertableProperty
@@ -211,15 +216,11 @@ type instance CombinedType RevertableProperty (Property HasInfo) = RevertablePro
type instance CombinedType RevertableProperty RevertableProperty = RevertableProperty
class Combines x y where
- -- | Indicates that the first property depends on the second,
- -- so before the first is ensured, the second will be ensured.
- requires :: x -> y -> CombinedType x y
-
--- | Combines together two properties, resulting in one property
--- that ensures the first, and if the first succeeds, ensures the second.
--- The property uses the description of the first property.
-before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x
-before x y = (y `requires` x) `describe` getDesc x
+ -- | Combines two properties. The second property is ensured
+ -- first, and only once it is successfully ensures will the first
+ -- be ensured. The combined property will have the description of
+ -- the first property.
+ (<<>>) :: x -> y -> CombinedType x y
-- | Combines together two properties, yielding a property that
-- has the description and info of the first, and that has the second
@@ -231,36 +232,36 @@ combineWith
-> Property x
-> Property y
-> CombinedType (Property x) (Property y)
-combineWith f x y = adjustPropertySatisfy (x `requires` y) $ \_ ->
+combineWith f x y = adjustPropertySatisfy (x <<>> y) $ \_ ->
f (propertySatisfy $ toSProperty x) (propertySatisfy $ toSProperty y)
instance Combines (Property HasInfo) (Property HasInfo) where
- requires (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
+ (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
- requires (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) =
+ (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
- requires (SProperty d1 a1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
+ (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
- requires (SProperty d1 a1 cs1) y@(SProperty _d2 a2 _cs2) =
+ (SProperty d1 a1 cs1) <<>> y@(SProperty _d2 a2 _cs2) =
SProperty d1 (a2 <> a1) (y : cs1)
instance Combines RevertableProperty (Property HasInfo) where
- requires (RevertableProperty p1 p2) y =
- RevertableProperty (p1 `requires` y) p2
+ (RevertableProperty p1 p2) <<>> y =
+ RevertableProperty (p1 <<>> y) p2
instance Combines RevertableProperty (Property NoInfo) where
- requires (RevertableProperty p1 p2) y =
- RevertableProperty (p1 `requires` toIProperty y) p2
+ (RevertableProperty p1 p2) <<>> y =
+ RevertableProperty (p1 <<>> toIProperty y) p2
instance Combines RevertableProperty RevertableProperty where
- requires (RevertableProperty x1 x2) (RevertableProperty y1 y2) =
+ (RevertableProperty x1 x2) <<>> (RevertableProperty y1 y2) =
RevertableProperty
- (x1 `requires` y1)
+ (x1 <<>> y1)
-- when reverting, run actions in reverse order
- (y2 `requires` x2)
+ (y2 <<>> x2)