Merge branch 'joeyconfig'

Conflicts:
	doc/todo/info_propigation_out_of_nested_properties.mdwn
	privdata.joey/privdata.gpg

1 files changed, 92 insertions, 0 deletions

diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
new file mode 100644
index 00000000..139f1471
--- /dev/null
+++ b/src/Propellor/PropAccum.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE PackageImports #-}
+
+module Propellor.PropAccum where
+
+import Data.Monoid
+
+import Propellor.Types
+import Propellor.Property
+
+-- | Starts accumulating the properties of a Host.
+--
+-- > host "example.com"
+-- > 	& someproperty
+-- > 	! oldproperty
+-- > 	& otherproperty
+host :: HostName -> Host
+host hn = Host hn [] mempty
+
+-- | Starts accumulating a list of properties.
+--
+-- > propertyList "foo" $ props
+-- > 	& someproperty
+-- > 	! oldproperty
+-- > 	& otherproperty
+props :: PropList
+props = PropList []
+
+-- | Something that can accumulate properties.
+class PropAccum h where
+	-- | Adds a property.
+	--
+	-- Can add Properties and RevertableProperties
+	(&) :: IsProp p => h -> p -> h
+
+	-- | Like (&), but adds the property at the front of the list.
+	(&^) :: IsProp p => h -> p -> h
+
+	getProperties :: h -> [Property HasInfo]
+
+instance PropAccum Host where
+	(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)
+	getProperties = hostProperties
+
+data PropList = PropList [Property HasInfo]
+
+instance PropAccum PropList where
+	PropList l &  p = PropList (l ++ [toProp p])
+	PropList l &^ p = PropList ([toProp p] ++ l)
+	getProperties (PropList l) = 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.
+-- 
+-- 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 PropAccum
+-- are reflected in the dns for the host where it runs.
+--
+-- PrivData Info is propigated, so that properties used inside a
+-- PropAccum will have the necessary PrivData available.
+propigateContainer
+	:: (PropAccum container)
+	=> container
+	-> Property HasInfo
+	-> Property HasInfo
+propigateContainer c prop = infoProperty
+	(propertyDesc prop)
+	(propertySatisfy prop)
+	(propertyInfo prop)
+	(propertyChildren prop ++ hostprops)
+  where
+	hostprops = map go $ getProperties c
+	go p = 
+		let i = propertyInfo p
+		    i' = mempty
+			{ _dns = _dns i
+			, _privData = _privData i
+			}
+		    cs = map go (propertyChildren p)
+		in infoProperty (propertyDesc p) (propertySatisfy p) i' cs