summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog34
-rw-r--r--src/Propellor/Base.hs4
-rw-r--r--src/Propellor/Engine.hs16
-rw-r--r--src/Propellor/EnsureProperty.hs2
-rw-r--r--src/Propellor/PrivData.hs2
-rw-r--r--src/Propellor/PropAccum.hs9
-rw-r--r--src/Propellor/Property.hs4
-rw-r--r--src/Propellor/Property/Chroot.hs2
-rw-r--r--src/Propellor/Property/Concurrent.hs4
-rw-r--r--src/Propellor/Property/Docker.hs2
-rw-r--r--src/Propellor/Property/List.hs104
-rw-r--r--src/Propellor/Types.hs20
12 files changed, 93 insertions, 110 deletions
diff --git a/debian/changelog b/debian/changelog
index ead6585e..b27559bd 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,37 +1,43 @@
propellor (3.0.0) UNRELEASED; urgency=medium
* Property types have been improved to indicate what systems they target.
- This allows, eg, Property Debian to not be used on a FreeBSD system.
+ This prevents using eg, Property FreeBSD on a Debian system.
Transition guide for this sweeping API change:
+ - Change "host name & foo & bar"
+ to "host name $ props & foo & bar"
+ - Similarly, Chroot and Docker need `props` to be used to combine
+ together the properies used inside them.
+ - And similarly, `propertyList` and `combineProperties` need `props`
+ to be used to combine together properties; lists of properties will
+ no longer work.
- Change "Property NoInfo" to "Property UnixLike"
- Change "Property HasInfo" to "Property (HasInfo + UnixLike)"
- Change "RevertableProperty NoInfo" to
"RevertableProperty UnixLike UnixLike"
- Change "RevertableProperty HasInfo" to
"RevertableProperty (HasInfo + UnixLike) UnixLike"
- - GHC needs {-# LANGUAGE TypeOperators #-} to use these new type signatures.
+ - GHC needs {-# LANGUAGE TypeOperators #-} to use these fancy types.
This is enabled by default for all modules in propellor.cabal. But
if you are using propellor as a library, you may need to enable it
manually.
- If you know a property only works on a particular OS, like Debian
or FreeBSD, use that instead of "UnixLike". For example:
- "Property (HasInfo + Debian)"
+ "Property Debian"
- It's also possible make a property support a set of OS's, for example:
- "Property (HasInfo + Debian + FreeBSD)"
- - `ensureProperty` now needs information about the metatypes of the
- property it's used in to be passed to it. See the documentation
- of `ensureProperty` for an example, but basically, change
- this: foo = property desc $ ... ensureProperty bar
- to this: foo = property' desc $ \o -> ... ensureProperty o bar
+ "Property (Debian + FreeBSD)"
+ - `ensureProperty` now needs to be passed information about the
+ property it's used in.
+ change this: foo = property desc $ ... ensureProperty bar
+ to this: foo = property' desc $ \o -> ... ensureProperty o bar
- General purpose properties like cmdProperty have type "Property UnixLike".
When using that to run a command only available on Debian, you can
- tighten the targets to only the OS that your more specific
- property works on. For example:
+ tighten the type to only the OS that your more specific property works on.
+ For example:
upgraded :: Property Debian
upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"])
- - The new `pickOS` property combinator can be used to combine different
- properties, supporting different OS's, into one Property that chooses
- what to do based on the Host's OS.
+ * The new `pickOS` property combinator can be used to combine different
+ properties, supporting different OS's, into one Property that chooses
+ what to do based on the Host's OS.
-- Joey Hess <id@joeyh.name> Thu, 24 Mar 2016 15:02:33 -0400
diff --git a/src/Propellor/Base.hs b/src/Propellor/Base.hs
index e50adf10..4afad2ab 100644
--- a/src/Propellor/Base.hs
+++ b/src/Propellor/Base.hs
@@ -9,7 +9,7 @@ module Propellor.Base (
, module Propellor.Property.Cmd
--, module Propellor.Property.List
, module Propellor.Types.PrivData
- --, module Propellor.PropAccum
+ , module Propellor.PropAccum
, module Propellor.Info
, module Propellor.PrivData
--, module Propellor.Engine
@@ -43,7 +43,7 @@ import Propellor.Message
import Propellor.Debug
import Propellor.Exception
import Propellor.Info
---import Propellor.PropAccum
+import Propellor.PropAccum
import Propellor.Location
import Propellor.Utilities
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 2e914d67..62fad5af 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -2,10 +2,10 @@
{-# LANGUAGE GADTs #-}
module Propellor.Engine (
- mainProperties,
+ -- mainProperties,
runPropellor,
ensureProperty,
- ensureProperties,
+ ensureChildProperties,
fromHost,
fromHost',
onlyProcess,
@@ -29,6 +29,8 @@ import Propellor.Info
import Propellor.Property
import Utility.Exception
+{-
+
-- | Gets the Properties of a Host, and ensures them all,
-- with nice display of what's being done.
mainProperties :: Host -> IO ()
@@ -42,6 +44,8 @@ mainProperties host = do
where
ps = map ignoreInfo $ hostProperties host
+-}
+
-- | Runs a Propellor action with the specified host.
--
-- If the Result is not FailedChange, any EndActions
@@ -58,14 +62,14 @@ runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc
(ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host ()
return ret
--- | Ensures a list of Properties, with a display of each as it runs.
-ensureProperties :: [Property NoInfo] -> Propellor Result
-ensureProperties ps = ensure ps NoChange
+-- | Ensures the child properties, with a display of each as it runs.
+ensureChildProperties :: [ChildProperty] -> Propellor Result
+ensureChildProperties ps = ensure ps NoChange
where
ensure [] rs = return rs
ensure (p:ls) rs = do
hn <- asks hostName
- r <- actionMessageOn hn (propertyDesc p) (ensureProperty p)
+ r <- actionMessageOn hn (getDesc p) (catchPropellor $ getSatisfy p)
ensure ls (r <> rs)
-- | Lifts an action into the context of a different host.
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index f42003c0..21f8acce 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -39,7 +39,7 @@ ensureProperty
=> OuterMetaTypes outer
-> Property (MetaTypes inner)
-> Propellor Result
-ensureProperty _ = catchPropellor . propertySatisfy
+ensureProperty _ = catchPropellor . getSatisfy
-- The name of this was chosen to make type errors a more understandable.
type family CannotUse_ensureProperty_WithInfo (l :: [a]) :: Bool
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index bc61c538..5e6e0869 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -129,7 +129,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
return FailedChange
addinfo p = Property undefined -- FIXME: should use sing here
(propertyDesc p)
- (propertySatisfy p)
+ (getSatisfy p)
(propertyInfo p `addInfo` privset)
(propertyChildren p)
privset = PrivInfo $ S.fromList $
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index fb38e260..8177b97b 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -36,8 +36,9 @@ host hn (Props i c) = Host hn c i
-- metatypes and info.
data Props metatypes = Props Info [ChildProperty]
--- | Start constructing a Props. Properties can then be added to it using
--- `(&)` etc.
+-- | Start accumulating a list of properties.
+--
+-- Properties can be added to it using `(&)` etc.
props :: Props UnixLike
props = Props mempty []
@@ -102,7 +103,7 @@ propagateContainer
propagateContainer containername c prop = Property
undefined
(propertyDesc prop)
- (propertySatisfy prop)
+ (getSatisfy prop)
(propertyInfo prop)
(propertyChildren prop ++ hostprops)
where
@@ -111,6 +112,6 @@ propagateContainer containername c prop = Property
let i = mapInfo (forceHostContext containername)
(propagatableInfo (propertyInfo p))
cs = map go (propertyChildren p)
- in infoProperty (propertyDesc p) (propertySatisfy p) i cs
+ in infoProperty (propertyDesc p) (getSatisfy p) i cs
-}
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 582b7cfb..8999d8d8 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -255,8 +255,8 @@ isNewerThan x y = do
tightenTargets
::
-- Note that this uses PolyKinds
- ( (Targets old `NotSuperset` Targets new) ~ 'CanCombineTargets
- , (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombineTargets
+ ( (Targets old `NotSuperset` Targets new) ~ 'CanCombine
+ , (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombine
, SingI new
)
=> Property (MetaTypes old)
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 378836e8..fb05d659 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -148,7 +148,7 @@ propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c p'
where
p' = infoProperty
(propertyDesc p)
- (propertySatisfy p)
+ (getSatisfy p)
(propertyInfo p <> chrootInfo c)
(propertyChildren p)
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index 74afecc4..8d608a54 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -97,7 +97,7 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps
(p:rest) -> return (rest, Just p)
case v of
Nothing -> return r
- -- This use of propertySatisfy does not lose any
+ -- This use of getSatisfy does not lose any
-- Info asociated with the property, because
-- concurrentList sets all the properties as
-- children, and so propigates their info.
@@ -105,7 +105,7 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps
hn <- asks hostName
r' <- actionMessageOn hn
(propertyDesc p)
- (propertySatisfy p)
+ (getSatisfy p)
worker q (r <> r')
-- | Run an action with the number of capabiities increased as necessary to
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index ebc0b301..c2c131c7 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -178,7 +178,7 @@ propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p'
where
p' = infoProperty
(propertyDesc p)
- (propertySatisfy p)
+ (getSatisfy p)
(propertyInfo p <> dockerinfo)
(propertyChildren p)
dockerinfo = dockerInfo $
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index 74aa6ca6..b4a72fa8 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -1,86 +1,54 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Propellor.Property.List (
props,
- PropertyList(..),
- PropertyListType,
- PropList(..),
+ Props,
+ propertyList,
+ combineProperties,
) where
import Propellor.Types
+import Propellor.Types.MetaTypes
import Propellor.Engine
import Propellor.PropAccum
+import Propellor.Exception
import Data.Monoid
--- | Starts accumulating a list of properties.
+-- | Combines a list of properties, resulting in a single property
+-- that when run will run each property in the list in turn,
+-- and print out the description of each as it's run. Does not stop
+-- on failure; does propagate overall success/failure.
+--
+-- For example:
--
-- > propertyList "foo" $ props
--- > & someproperty
--- > ! oldproperty
--- > & otherproperty
-props :: PropList
-props = PropList []
-
-data PropList = PropList [Property HasInfo]
-
-instance PropAccum PropList where
- PropList l `addProp` p = PropList (toProp p : l)
- PropList l `addPropFront` p = PropList (l ++ [toProp p])
- getProperties (PropList l) = reverse l
-
-class PropertyList l where
- -- | Combines a list of properties, resulting in a single property
- -- that when run will run each property in the list in turn,
- -- and print out the description of each as it's run. Does not stop
- -- on failure; does propagate overall success/failure.
- --
- -- Note that Property HasInfo and Property NoInfo are not the same
- -- type, and so cannot be mixed in a list. To make a list of
- -- mixed types, which can also include RevertableProperty,
- -- use `props`
- propertyList :: Desc -> l -> Property (PropertyListType l)
-
- -- | Combines a list of properties, resulting in one property that
- -- ensures each in turn. Stops if a property fails.
- combineProperties :: Desc -> l -> Property (PropertyListType l)
-
--- | Type level function to calculate whether a PropertyList has Info.
-type family PropertyListType t
-type instance PropertyListType [Property HasInfo] = HasInfo
-type instance PropertyListType [Property NoInfo] = NoInfo
-type instance PropertyListType [RevertableProperty NoInfo] = NoInfo
-type instance PropertyListType [RevertableProperty HasInfo] = HasInfo
-type instance PropertyListType PropList = HasInfo
-
-instance PropertyList [Property NoInfo] where
- propertyList desc ps = simpleProperty desc (ensureProperties ps) ps
- combineProperties desc ps = simpleProperty desc (combineSatisfy ps NoChange) ps
-
-instance PropertyList [Property HasInfo] where
- -- It's ok to use ignoreInfo here, because the ps are made the
- -- child properties of the property, and so their info is visible
- -- that way.
- propertyList desc ps = infoProperty desc (ensureProperties $ map ignoreInfo ps) mempty ps
- combineProperties desc ps = infoProperty desc (combineSatisfy ps NoChange) mempty ps
-
-instance PropertyList [RevertableProperty HasInfo] where
- propertyList desc ps = propertyList desc (map setupRevertableProperty ps)
- combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps)
-
-instance PropertyList [RevertableProperty NoInfo] where
- propertyList desc ps = propertyList desc (map setupRevertableProperty ps)
- combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps)
-
-instance PropertyList PropList where
- propertyList desc = propertyList desc . getProperties
- combineProperties desc = combineProperties desc . getProperties
-
-combineSatisfy :: [Property i] -> Result -> Propellor Result
+-- > & bar
+-- > & baz
+propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+propertyList desc (Props _i ps) =
+ property desc (ensureChildProperties cs)
+ `modifyChildren` (++ cs)
+ where
+ cs = map toProp ps
+
+-- | Combines a list of properties, resulting in one property that
+-- ensures each in turn. Stops if a property fails.
+combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+combineProperties desc (Props _i ps) =
+ property desc (combineSatisfy cs NoChange)
+ `modifyChildren` (++ cs)
+ where
+ cs = map toProp ps
+
+combineSatisfy :: [ChildProperty] -> Result -> Propellor Result
combineSatisfy [] rs = return rs
-combineSatisfy (l:ls) rs = do
- r <- ensureProperty $ ignoreInfo l
+combineSatisfy (p:ps) rs = do
+ r <- catchPropellor $ getSatisfy p
case r of
FailedChange -> return FailedChange
- _ -> combineSatisfy ls (r <> rs)
+ _ -> combineSatisfy ps (r <> rs)
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 42c12492..db05e100 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -14,6 +14,7 @@ module Propellor.Types
, Info
, Desc
, MetaType(..)
+ , MetaTypes
, OS(..)
, UnixLike
, Debian
@@ -41,8 +42,6 @@ module Propellor.Types
, module Propellor.Types.Dns
, module Propellor.Types.Result
, module Propellor.Types.ZFS
- , propertySatisfy
- , MetaTypes
) where
import Data.Monoid
@@ -169,12 +168,6 @@ ignoreInfo =
-}
--- | Gets the action that can be run to satisfy a Property.
--- You should never run this action directly. Use
--- 'Propellor.EnsureProperty.ensureProperty` instead.
-propertySatisfy :: Property metatypes -> Propellor Result
-propertySatisfy (Property _ _ a _ _) = a
-
-- | Changes the action that is performed to satisfy a property.
adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c
@@ -214,34 +207,45 @@ setup <!> undo = RevertableProperty setup undo
class IsProp p where
setDesc :: p -> Desc -> p
getDesc :: p -> Desc
+ modifyChildren :: p -> ([ChildProperty] -> [ChildProperty]) -> p
-- | Gets the info of the property, combined with all info
-- of all children properties.
getInfoRecursive :: p -> Info
toProp :: p -> ChildProperty
+ -- | Gets the action that can be run to satisfy a Property.
+ -- You should never run this action directly. Use
+ -- 'Propellor.EnsureProperty.ensureProperty` instead.
+ getSatisfy :: p -> Propellor Result
instance IsProp (Property metatypes) where
setDesc (Property t _ a i c) d = Property t d a i c
getDesc = propertyDesc
+ modifyChildren (Property t d a i c) f = Property t d a i (f c)
getInfoRecursive (Property _ _ _ i c) =
i <> mconcat (map getInfoRecursive c)
toProp (Property _ d a i c) = ChildProperty d a i c
+ getSatisfy (Property _ _ a _ _) = a
instance IsProp ChildProperty where
setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
getDesc (ChildProperty d _ _ _) = d
+ modifyChildren (ChildProperty d a i c) f = ChildProperty d a i (f c)
getInfoRecursive (ChildProperty _ _ i c) =
i <> mconcat (map getInfoRecursive c)
toProp = id
+ getSatisfy (ChildProperty _ a _ _) = a
instance IsProp (RevertableProperty setupmetatypes undometatypes) where
-- | Sets the description of both sides.
setDesc (RevertableProperty p1 p2) d =
RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
getDesc (RevertableProperty p1 _) = getDesc p1
+ modifyChildren (RevertableProperty p1 p2) f = RevertableProperty (modifyChildren p1 f) (modifyChildren p2 f)
-- toProp (RevertableProperty p1 _) = p1
-- | Return the Info of the currently active side.
getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
toProp (RevertableProperty p1 _p2) = toProp p1
+ getSatisfy (RevertableProperty p1 _) = getSatisfy p1
-- | Type level calculation of the type that results from combining two
-- types of properties.