diff options
| author | Joey Hess <joeyh@joeyh.name> | 2015-01-18 18:02:07 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2015-01-18 18:46:38 -0400 |
| commit | afee550e708cb50a72f0505e3c4ca8f775f39ef0 (patch) | |
| tree | 923be3a07f86c7cf30c20152922e7513d7fe0057 /src/Propellor/Host.hs | |
| parent | fcd8a3171b4fece8400f7e0b6796d6918b1aec43 (diff) | |
Property tree
Properties now form a tree, instead of the flat list used before.
This simplifies propigation of Info from the Properties used inside a
container to the outer host; the Property that docks the container on the
host can just have as child properties all the inner Properties, and their
Info can then be gathered recursively. (Although in practice it still needs
to be filtered, since not all Info should propigate out of a container.)
Note that there is no change to how Properties are actually satisfied.
Just because a Property lists some child properties, this does not mean
they always have their propertySatisfy actions run. It's still up to the
parent property to run those actions.
That's necessary so that a container's properties can be satisfied inside
it, not outside. It also allows property combinators to
add the combined Properties to their childProperties list, even if,
like onChange, they don't always run the child properties at all.
Testing: I tested that the exact same Info is calculated before and after
this change, for every Host in my config file.
Diffstat (limited to 'src/Propellor/Host.hs')
| -rw-r--r-- | src/Propellor/Host.hs | 46 |
1 files changed, 28 insertions, 18 deletions
diff --git a/src/Propellor/Host.hs b/src/Propellor/Host.hs index 896db676..cfe90949 100644 --- a/src/Propellor/Host.hs +++ b/src/Propellor/Host.hs @@ -3,12 +3,9 @@ module Propellor.Host where import Data.Monoid -import qualified Data.Set as S import Propellor.Types -import Propellor.Info import Propellor.Property -import Propellor.PrivData -- | Starts accumulating the properties of a Host. -- @@ -35,8 +32,10 @@ class Hostlike h where getHost :: h -> Host instance Hostlike Host where - (Host hn ps is) & p = Host hn (ps ++ [toProp p]) (is <> getInfo p) - (Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) (getInfo p <> is) + (Host hn ps is) & p = Host hn (ps ++ [toProp p]) + (is <> getInfoRecursive p) + (Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) + (getInfoRecursive p <> is) getHost h = h -- | Adds a property in reverted form. @@ -47,18 +46,29 @@ infixl 1 &^ infixl 1 & infixl 1 ! --- | When eg, docking a container, some of the Info about the container --- should propigate out to the Host it's on. This includes DNS info, --- so that eg, aliases of the container are reflected in the dns for the --- host where it runs. +-- | Adjust the provided Property, adding to its +-- propertyChidren the properties of the Hostlike. + +-- The Info of the propertyChildren is adjusted to only include +-- info that should be propigated out to the Property. +-- +-- DNS Info is propigated, so that eg, aliases of a Hostlike +-- are reflected in the dns for the host where it runs. -- --- This adjusts the Property that docks a container, to include such info --- from the container. -propigateInfo :: Hostlike hl => hl -> Property -> (Info -> Info) -> Property -propigateInfo hl p f = combineProperties (propertyDesc p) $ - p' : dnsprops ++ privprops +-- PrivData Info is propigated, so that properties used inside a +-- Hostlike will have the necessary PrivData available. +propigateHostLike :: Hostlike hl => hl -> Property -> Property +propigateHostLike hl prop = prop + { propertyChildren = propertyChildren prop ++ hostprops + } where - p' = p { propertyInfo = f (propertyInfo p) } - i = hostInfo (getHost hl) - dnsprops = map addDNS (S.toList $ _dns i) - privprops = map addPrivData (S.toList $ _privData i) + hostprops = map go $ hostProperties $ getHost hl + go p = + let i = propertyInfo p + in p + { propertyInfo = mempty + { _dns = _dns i + , _privData = _privData i + } + , propertyChildren = map go (propertyChildren p) + } |
