summaryrefslogtreecommitdiff
path: root/src/Propellor/Host.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Host.hs')
-rw-r--r--src/Propellor/Host.hs46
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)
+ }