1 files changed, 60 insertions, 62 deletions

diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 85a30af5..d9fa8ec7 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -1,88 +1,86 @@
-{-# LANGUAGE PackageImports, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DataKinds #-}
 
 module Propellor.PropAccum
 	( host
-	, PropAccum(..)
+	, Props(..)
+	, props
 	, (&)
 	, (&^)
 	, (!)
-	, propagateContainer
 	) where
 
-import Data.Monoid
-
 import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Property
-import Propellor.Types.Info
-import Propellor.PrivData
 
--- | Starts accumulating the properties of a Host.
+import Data.Monoid
+import Prelude
+
+-- | Defines a host and its properties.
 --
--- > host "example.com"
+-- > host "example.com" $ props
 -- > 	& someproperty
 -- > 	! oldproperty
 -- > 	& otherproperty
-host :: HostName -> Host
-host hn = Host hn [] mempty
+host :: HostName -> Props metatypes -> Host
+host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps))
 
--- | Something that can accumulate properties.
-class PropAccum h where
-	-- | Adds a property.
-	addProp :: IsProp p => h -> p -> h
+-- | Start accumulating a list of properties.
+--
+-- Properties can be added to it using `(&)` etc.
+props :: Props UnixLike
+props = Props []
 
-	-- | Like addProp, but adds the property at the front of the list.
-	addPropFront :: IsProp p => h -> p -> h
+infixl 1 &
+infixl 1 &^
+infixl 1 !
 
-	getProperties :: h -> [Property HasInfo]
+type family GetMetaTypes x
+type instance GetMetaTypes (Property (MetaTypes t)) = MetaTypes t
+type instance GetMetaTypes (RevertableProperty (MetaTypes t) undo) = MetaTypes t
 
--- | Adds a property to a `Host` or other `PropAccum`
+-- | Adds a property to a Props.
 --
 -- Can add Properties and RevertableProperties
-(&) :: (PropAccum h, IsProp p) => h -> p -> h
-(&) = addProp
+(&)
+	::
+		( IsProp p
+		, MetaTypes y ~ GetMetaTypes p
+		, CheckCombinable x y ~ 'CanCombine
+		)
+	=> Props (MetaTypes x)
+	-> p
+	-> Props (MetaTypes (Combine x y))
+Props c & p = Props (c ++ [toChildProperty p])
 
 -- | Adds a property before any other properties.
-(&^) :: (PropAccum h, IsProp p) => h -> p -> h
-(&^) = addPropFront
+(&^)
+	::
+		( IsProp p
+		, MetaTypes y ~ GetMetaTypes p
+		, CheckCombinable x y ~ 'CanCombine
+		)
+	=> Props (MetaTypes x)
+	-> p
+	-> Props (MetaTypes (Combine x y))
+Props c &^ p = Props (toChildProperty p : c)
 
 -- | Adds a property in reverted form.
-(!) :: IsProp (RevertableProperty i) => PropAccum h => h -> RevertableProperty i -> h
-h ! p = h & revert p
+(!)
+	:: (CheckCombinable x z ~ 'CanCombine)
+	=> Props (MetaTypes x)
+	-> RevertableProperty (MetaTypes y) (MetaTypes z)
+	-> Props (MetaTypes (Combine x z))
+Props c ! p = Props (c ++ [toChildProperty (revert p)])
 
-infixl 1 &
-infixl 1 &^
-infixl 1 !
-
-instance PropAccum Host where
-	(Host hn ps is) `addProp`  p = Host hn (ps ++ [toProp p])
-		(is <> getInfoRecursive p)
-	(Host hn ps is) `addPropFront` p = Host hn (toProp p : ps)
-		(getInfoRecursive p <> is)
-	getProperties = hostProperties
-
--- | 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 propagated out to the Property.
---
--- Any PrivInfo that uses HostContext is adjusted to use the name
--- of the container as its context.
-propagateContainer
-	:: (PropAccum container)
-	=> String
-	-> container
-	-> Property HasInfo
-	-> Property HasInfo
-propagateContainer containername c prop = infoProperty
-	(propertyDesc prop)
-	(propertySatisfy prop)
-	(propertyInfo prop)
-	(propertyChildren prop ++ hostprops)
-  where
-	hostprops = map go $ getProperties c
-	go p = 
-		let i = mapInfo (forceHostContext containername)
-			(propagatableInfo (propertyInfo p))
-		    cs = map go (propertyChildren p)
-		in infoProperty (propertyDesc p) (propertySatisfy p) i cs
+-- addPropsHost :: Host -> [Prop] -> Host
+-- addPropsHost (Host hn ps i) p = Host hn ps' i'
+--   where
+-- 	ps' = ps ++ [toChildProperty p]
+-- 	i' = i <> getInfoRecursive p