From c0236e92be55cec267b425a3b1fffc65b119b1aa Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 24 Mar 2016 16:56:01 -0400
Subject: converted PrivData

Somewhat poorly; I don't like needing to export the Property constructor to
use it here, and there's a use of undefined where it should be able to use
sing.

I got quite stuck on this, so am happy to have anything that works.
---
 src/Propellor/PrivData.hs | 37 ++++++++++++++++++++++++++-----------
 1 file changed, 26 insertions(+), 11 deletions(-)

(limited to 'src/Propellor/PrivData.hs')

diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index bc09f0c6..6f3d4771 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -2,6 +2,8 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
 
 module Propellor.PrivData (
 	withPrivData,
@@ -40,6 +42,7 @@ import Prelude
 
 import Propellor.Types
 import Propellor.Types.PrivData
+import Propellor.Types.MetaTypes
 import Propellor.Types.Info
 import Propellor.Message
 import Propellor.Info
@@ -75,29 +78,41 @@ import Utility.FileSystemEncoding
 -- being used, which is necessary to ensure that the privdata is sent to
 -- the remote host by propellor.
 withPrivData
-	:: (IsContext c, IsPrivDataSource s, IsProp (Property i))
+	::
+		( IsContext c
+		, IsPrivDataSource s
+		, IncludesInfo metatypes ~ True
+		)
 	=> s
 	-> c
-	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property i)
-	-> Property HasInfo
+	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property metatypes)
+	-> Property metatypes
 withPrivData s = withPrivData' snd [s]
 
 -- Like withPrivData, but here any one of a list of PrivDataFields can be used.
 withSomePrivData
-	:: (IsContext c, IsPrivDataSource s, IsProp (Property i))
+	::
+		( IsContext c
+		, IsPrivDataSource s
+		, IncludesInfo metatypes ~ True
+		)
 	=> [s]
 	-> c
-	-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property i)
-	-> Property HasInfo
+	-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property metatypes)
+	-> Property metatypes
 withSomePrivData = withPrivData' id
 
 withPrivData' 
-	:: (IsContext c, IsPrivDataSource s, IsProp (Property i))
+	::
+		( IsContext c
+		, IsPrivDataSource s
+		, IncludesInfo metatypes ~ True
+		)
 	=> ((PrivDataField, PrivData) -> v)
 	-> [s]
 	-> c
-	-> (((v -> Propellor Result) -> Propellor Result) -> Property i)
-	-> Property HasInfo
+	-> (((v -> Propellor Result) -> Propellor Result) -> Property metatypes)
+	-> Property metatypes
 withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 	maybe missing (a . feed) =<< getM get fieldlist
   where
@@ -112,7 +127,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 			"Fix this by running:" :
 			showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist)
 		return FailedChange
-	addinfo p = infoProperty
+	addinfo p = Property undefined -- FIXME: should use sing here
 		(propertyDesc p)
 		(propertySatisfy p)
 		(propertyInfo p `addInfo` privset)
@@ -132,7 +147,7 @@ showSet = concatMap go
 		, Just ""
 		]
 
-addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property HasInfo
+addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property (HasInfo + UnixLike)
 addPrivData v = pureInfoProperty (show v) (PrivInfo (S.singleton v))
 
 {- Gets the requested field's value, in the specified context if it's
-- 
cgit v1.3-2-g0d8e


From 5d2d64678f506d23bdfddb3f7cc452ac1d7c42eb Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 25 Mar 2016 02:05:26 -0400
Subject: fix warnings

---
 src/Propellor/PrivData.hs | 6 +++---
 src/Propellor/Property.hs | 7 +++----
 src/Propellor/Types.hs    | 5 +++--
 3 files changed, 9 insertions(+), 9 deletions(-)

(limited to 'src/Propellor/PrivData.hs')

diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 6f3d4771..bc61c538 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -81,7 +81,7 @@ withPrivData
 	::
 		( IsContext c
 		, IsPrivDataSource s
-		, IncludesInfo metatypes ~ True
+		, IncludesInfo metatypes ~ 'True
 		)
 	=> s
 	-> c
@@ -94,7 +94,7 @@ withSomePrivData
 	::
 		( IsContext c
 		, IsPrivDataSource s
-		, IncludesInfo metatypes ~ True
+		, IncludesInfo metatypes ~ 'True
 		)
 	=> [s]
 	-> c
@@ -106,7 +106,7 @@ withPrivData'
 	::
 		( IsContext c
 		, IsPrivDataSource s
-		, IncludesInfo metatypes ~ True
+		, IncludesInfo metatypes ~ 'True
 		)
 	=> ((PrivDataField, PrivData) -> v)
 	-> [s]
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index c665b6a0..582b7cfb 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -56,7 +56,6 @@ import Propellor.Types
 import Propellor.Types.ResultCheck
 import Propellor.Types.MetaTypes
 import Propellor.Info
-import Propellor.Exception
 import Propellor.EnsureProperty
 import Utility.Exception
 import Utility.Monad
@@ -256,13 +255,13 @@ 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) ~ 'CanCombineTargets
+		, (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombineTargets
 		, SingI new
 		)
 	=> Property (MetaTypes old)
 	-> Property (MetaTypes new)
-tightenTargets (Property old d a i c) = Property sing d a i c
+tightenTargets (Property _old d a i c) = Property sing d a i c
 
 {-
 
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index f23a18dd..23716e58 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -28,6 +28,7 @@ module Propellor.Types
 	, propertyDesc
 	, propertyChildren
 	, RevertableProperty(..)
+	, (<!>)
 	, ChildProperty
 	, IsProp(..)
 	, Combines(..)
@@ -153,7 +154,7 @@ addInfoProperty
 	=> Property metatypes
 	-> Info
 	-> Property (MetaTypes metatypes')
-addInfoProperty (Property metatypes d a oldi c) newi =
+addInfoProperty (Property _ d a oldi c) newi =
 	Property sing d a (oldi <> newi) c
 
 {-
@@ -269,7 +270,7 @@ class Combines x y where
 		-> CombinedType x y
 
 instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where
-	combineWith f _ (Property t1 d1 a1 i1 c1) (Property _t2 d2 a2 i2 c2) =
+	combineWith f _ (Property _ d1 a1 i1 c1) (Property _ d2 a2 i2 c2) =
 		Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1)
 instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, CannotCombineTargets x' y' (Combine x' y') ~ 'CanCombineTargets, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
 	combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
-- 
cgit v1.3-2-g0d8e


From 91d1833155a2e8be2c435d0a92a750cc9d2f30b5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 25 Mar 2016 14:04:40 -0400
Subject: ported Property.List

I wanted to keep propertyList [foo, bar] working, but had some difficulty
making the type class approach work. Anyway, that's unlikely to be useful,
since foo and bar probably have different types, or could easiy have their
types updated breaking it.
---
 debian/changelog                     |  34 +++++++-----
 src/Propellor/Base.hs                |   4 +-
 src/Propellor/Engine.hs              |  16 ++++--
 src/Propellor/EnsureProperty.hs      |   2 +-
 src/Propellor/PrivData.hs            |   2 +-
 src/Propellor/PropAccum.hs           |   9 +--
 src/Propellor/Property.hs            |   4 +-
 src/Propellor/Property/Chroot.hs     |   2 +-
 src/Propellor/Property/Concurrent.hs |   4 +-
 src/Propellor/Property/Docker.hs     |   2 +-
 src/Propellor/Property/List.hs       | 104 ++++++++++++-----------------------
 src/Propellor/Types.hs               |  20 ++++---
 12 files changed, 93 insertions(+), 110 deletions(-)

(limited to 'src/Propellor/PrivData.hs')

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.
-- 
cgit v1.3-2-g0d8e


From 42da8445470a6e4950873fc5d6bea88646ec2b63 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 26 Mar 2016 18:54:18 -0400
Subject: got rid of the undefined in privdata

addInfoProperty' is like addInfoProperty but for when the input property
is already known to HasInfo.
---
 src/Propellor/PrivData.hs |  6 +-----
 src/Propellor/Types.hs    | 15 +++++++++++++++
 2 files changed, 16 insertions(+), 5 deletions(-)

(limited to 'src/Propellor/PrivData.hs')

diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 5e6e0869..77c7133f 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -127,11 +127,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 			"Fix this by running:" :
 			showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist)
 		return FailedChange
-	addinfo p = Property undefined -- FIXME: should use sing here
-		(propertyDesc p)
-		(getSatisfy p)
-		(propertyInfo p `addInfo` privset)
-		(propertyChildren p)
+	addinfo p = p `addInfoProperty'` (toInfo privset)
 	privset = PrivInfo $ S.fromList $
 		map (\s -> (privDataField s, describePrivDataSource s, hc)) srclist
 	fieldnames = map show fieldlist
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 4b3f665a..ccbfd3e0 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -25,6 +25,8 @@ module Propellor.Types
 	, HasInfo
 	, type (+)
 	, addInfoProperty
+	, addInfoProperty'
+	, addChildrenProperty
 	, adjustPropertySatisfy
 	, propertyInfo
 	, propertyDesc
@@ -159,6 +161,19 @@ addInfoProperty
 addInfoProperty (Property _ d a oldi c) newi =
 	Property sing d a (oldi <> newi) c
 
+-- | Adds more info to a Property that already HasInfo.
+addInfoProperty'
+	:: (IncludesInfo metatypes ~ 'True)
+	=> Property metatypes
+	-> Info
+	-> Property metatypes
+addInfoProperty' (Property t d a oldi c) newi =
+	Property t d a (oldi <> newi) c
+
+-- | Adds children to a Property.
+addChildrenProperty :: Property metatypes -> [ChildProperty] -> Property metatypes
+addChildrenProperty (Property t s a i cs) cs' = Property t s a i (cs ++ cs')
+
 -- | 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
-- 
cgit v1.3-2-g0d8e


From 36e97137e538de401bd0340b469e10dca5f4b475 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 26 Mar 2016 19:31:23 -0400
Subject: ported propagateContainer

Renamed several utility functions along the way.
---
 debian/changelog                         |  5 ++++
 doc/todo/type_level_OS_requirements.mdwn |  7 ++---
 propellor.cabal                          |  1 +
 src/Propellor/Container.hs               | 46 ++++++++++++++++++++++++++++++
 src/Propellor/Info.hs                    |  6 ++--
 src/Propellor/PrivData.hs                |  4 +--
 src/Propellor/PropAccum.hs               | 33 ----------------------
 src/Propellor/Property/Chroot.hs         | 43 +++++++++++++---------------
 src/Propellor/Property/Concurrent.hs     |  2 +-
 src/Propellor/Property/Conductor.hs      |  8 +++---
 src/Propellor/Property/Dns.hs            | 10 +++----
 src/Propellor/Property/Docker.hs         | 10 +++----
 src/Propellor/Property/List.hs           |  4 +--
 src/Propellor/Property/Partition.hs      |  2 +-
 src/Propellor/Property/Postfix.hs        |  2 +-
 src/Propellor/Property/Scheduled.hs      |  6 ++--
 src/Propellor/Property/Systemd.hs        | 18 ++++++------
 src/Propellor/Spin.hs                    |  4 +--
 src/Propellor/Types.hs                   | 48 +++++++++++++-------------------
 src/Propellor/Types/Info.hs              |  6 ++--
 20 files changed, 134 insertions(+), 131 deletions(-)
 create mode 100644 src/Propellor/Container.hs

(limited to 'src/Propellor/PrivData.hs')

diff --git a/debian/changelog b/debian/changelog
index df518753..8a5b67e4 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -49,6 +49,11 @@ propellor (3.0.0) UNRELEASED; urgency=medium
       For example:
         upgraded :: Property Debian
         upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"])
+    - Several utility functions have been renamed:
+      getInfo to fromInfo
+      propertyInfo to getInfo
+      propertyDesc to getDesc
+      propertyChildren to getChildren
   * 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.
diff --git a/doc/todo/type_level_OS_requirements.mdwn b/doc/todo/type_level_OS_requirements.mdwn
index 7c2fb78f..f1c3e59f 100644
--- a/doc/todo/type_level_OS_requirements.mdwn
+++ b/doc/todo/type_level_OS_requirements.mdwn
@@ -21,13 +21,12 @@ withOS.
 
 The `os` property would need to yield a `Property (os:[])`, where the type
 level list contains a type-level eqivilant of the value passed to the
-property. Is that possible to do? reification or something?
-(See: <https://www.schoolofhaskell.com/user/thoughtpolice/using-reflection>)
-Or, alternatively, could have less polymorphic `debian` etc
+property. Is that possible to do?
+Or, alternatively, could have less polymorphic `osDebian` etc
 properties replace the `os` property.
 
 If a Host's list of properties, when all combined together,
-contains more than one element in its '[OS], that needs to be a type error,
+contains more than one element in its '[OS], that could be a type error,
 the OS of the Host is indeterminite. Which would be fixed by using the `os`
 property to specify.
 
diff --git a/propellor.cabal b/propellor.cabal
index e47bb2e6..4a7739d3 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -141,6 +141,7 @@ Library
     Propellor.PropAccum
     Propellor.Utilities
     Propellor.CmdLine
+    Propellor.Container
     Propellor.Info
     Propellor.Message
     Propellor.Debug
diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
new file mode 100644
index 00000000..6e974efd
--- /dev/null
+++ b/src/Propellor/Container.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE DataKinds, TypeFamilies #-}
+
+module Propellor.Container where
+
+import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Info
+import Propellor.PrivData
+
+class Container c where
+	containerProperties :: c -> [ChildProperty]
+	containerInfo :: c -> Info
+
+instance Container Host where
+	 containerProperties = hostProperties
+	 containerInfo = hostInfo
+
+-- | 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
+	::
+		-- Since the children being added probably have info,
+		-- require the Property's metatypes to have info.
+		( IncludesInfo metatypes ~ 'True
+		, Container c
+		)
+	=> String
+	-> c
+	-> Property metatypes
+	-> Property metatypes
+propagateContainer containername c prop = prop
+	`addChildren` map convert (containerProperties c)
+  where
+	convert p = 
+		let n = property (getDesc p) (getSatisfy p) :: Property UnixLike
+		    n' = n
+		    	`addInfoProperty` mapInfo (forceHostContext containername)
+				(propagatableInfo (getInfo p))
+		   	`addChildren` map convert (getChildren p)
+		in toChildProperty n'
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index 725a02ad..ff0b3b5e 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -42,7 +42,7 @@ pureInfoProperty' desc i = addInfoProperty p i
 
 -- | Gets a value from the host's Info.
 askInfo :: (IsInfo v) => Propellor v
-askInfo = asks (getInfo . hostInfo)
+askInfo = asks (fromInfo . hostInfo)
 
 -- | Specifies that a host's operating system is Debian,
 -- and further indicates the suite and architecture.
@@ -129,7 +129,7 @@ hostMap l = M.fromList $ zip (map hostName l) l
 
 aliasMap :: [Host] -> M.Map HostName Host
 aliasMap = M.fromList . concat .
-	map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ getInfo $ hostInfo h)
+	map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ fromInfo $ hostInfo h)
 
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = (findHostNoAlias l hn) <|> (findAlias l hn)
@@ -141,7 +141,7 @@ findAlias :: [Host] -> HostName -> Maybe Host
 findAlias l hn = M.lookup hn (aliasMap l)
 
 getAddresses :: Info -> [IPAddr]
-getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . getInfo
+getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . fromInfo
 
 hostAddresses :: HostName -> [Host] -> [IPAddr]
 hostAddresses hn hosts = maybe [] (getAddresses . hostInfo) (findHost hosts hn)
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 77c7133f..0bc0c100 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -161,7 +161,7 @@ filterPrivData :: Host -> PrivMap -> PrivMap
 filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
   where
 	used = S.map (\(f, _, c) -> (f, mkHostContext c (hostName host))) $
-		fromPrivInfo $ getInfo $ hostInfo host
+		fromPrivInfo $ fromInfo $ hostInfo host
 
 getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
 getPrivData field context m = do
@@ -245,7 +245,7 @@ mkUsedByMap = M.unionsWith (++) . map (\h -> mkPrivDataMap h $ const [hostName h
 mkPrivDataMap :: Host -> (Maybe PrivDataSourceDesc -> a) -> M.Map (PrivDataField, Context) a
 mkPrivDataMap host mkv = M.fromList $
 	map (\(f, d, c) -> ((f, mkHostContext c (hostName host)), mkv d))
-		(S.toList $ fromPrivInfo $ getInfo $ hostInfo host)
+		(S.toList $ fromPrivInfo $ fromInfo $ hostInfo host)
 
 setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
 setPrivDataTo field context (PrivData value) = do
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 8281b9a1..af362ca7 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -12,7 +12,6 @@ module Propellor.PropAccum
 	, (&)
 	, (&^)
 	, (!)
-	--, propagateContainer
 	) where
 
 import Propellor.Types
@@ -82,35 +81,3 @@ Props c &^ p = Props (toChildProperty p : c)
 	-> RevertableProperty (MetaTypes y) (MetaTypes z)
 	-> Props (MetaTypes (Combine x z))
 Props c ! p = Props (c ++ [toChildProperty (revert p)])
-
-{-
-
--- | 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 metatypes
-	-> Property metatypes
-propagateContainer containername c prop = Property
-	undefined
-	(propertyDesc prop)
-	(getSatisfy 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) (getSatisfy p) i cs
-
--}
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 4480f98d..547e5c94 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -41,23 +41,18 @@ data Chroot where
 	Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
 
 chrootSystem :: Chroot -> Maybe System
-chrootSystem (Chroot _ _ h) = fromInfoVal (getInfo (hostInfo h))
+chrootSystem (Chroot _ _ h) = fromInfoVal (fromInfo (hostInfo h))
 
 instance Show Chroot where
 	show c@(Chroot loc _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
 
-instance PropAccum Chroot where
-	(Chroot l c h) `addProp` p = Chroot l c (h & p)
-	(Chroot l c h) `addPropFront` p = Chroot l c (h `addPropFront` p)
-	getProperties (Chroot _ _ h) = hostProperties h
-
 -- | Class of things that can do initial bootstrapping of an operating
 -- System in a chroot.
 class ChrootBootstrapper b where
 	-- | Do initial bootstrapping of an operating system in a chroot.
 	-- If the operating System is not supported, return
 	-- Left error message.
-	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property HasInfo)
+	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property (HasInfo + UnixLike))
 
 -- | Use this to bootstrap a chroot by extracting a tarball.
 --
@@ -70,12 +65,11 @@ data ChrootTarball = ChrootTarball FilePath
 instance ChrootBootstrapper ChrootTarball where
 	buildchroot (ChrootTarball tb) _ loc = Right $ extractTarball loc tb
 
-extractTarball :: FilePath -> FilePath -> Property HasInfo
-extractTarball target src = toProp .
-	check (unpopulated target) $
-		cmdProperty "tar" params
-			`assume` MadeChange
-			`requires` File.dirExists target
+extractTarball :: FilePath -> FilePath -> Property UnixLike
+extractTarball target src = check (unpopulated target) $
+	cmdProperty "tar" params
+		`assume` MadeChange
+		`requires` File.dirExists target
   where
 	params =
 		[ "-C"
@@ -92,14 +86,15 @@ instance ChrootBootstrapper Debootstrapped where
 		(Just s@(System (Debian _) _)) -> Right $ debootstrap s
 		(Just s@(System (Buntish _) _)) -> Right $ debootstrap s
 		(Just (System (FreeBSD _) _)) -> Left "FreeBSD not supported by debootstrap."
-		Nothing -> Left "Cannot debootstrap; `os` property not specified"
+		Nothing -> Left "Cannot debootstrap; OS not specified"
 	  where
 		debootstrap s = Debootstrap.built loc s cf
 
 -- | Defines a Chroot at the given location, built with debootstrap.
 --
 -- Properties can be added to configure the Chroot. At a minimum,
--- add the `os` property to specify the operating system to bootstrap.
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
 --
 -- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev"
 -- >	& osDebian Unstable "amd64"
@@ -131,25 +126,25 @@ provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
 	(propertyList (chrootDesc c "removed") [teardown])
   where
 	setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
-		`requires` toProp built
+		`requires` built
 
 	built = case buildchroot bootstrapper (chrootSystem c) loc of
 		Right p -> p
 		Left e -> cantbuild e
 
-	cantbuild e = infoProperty (chrootDesc c "built") (error e) mempty []
+	cantbuild e = property (chrootDesc c "built") (error e)
 
 	teardown = check (not <$> unpopulated loc) $
 		property ("removed " ++ loc) $
 			makeChange (removeChroot loc)
 
-propagateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo
+propagateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property (HasInfo + UnixLike)
 propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c p'
   where
 	p' = infoProperty
-		(propertyDesc p)
+		(getDesc p)
 		(getSatisfy p)
-		(propertyInfo p <> chrootInfo c)
+		(getInfo p <> chrootInfo c)
 		(propertyChildren p)
 
 chrootInfo :: Chroot -> Info
@@ -157,7 +152,7 @@ chrootInfo (Chroot loc _ h) = mempty `addInfo`
 	mempty { _chroots = M.singleton loc h }
 
 -- | Propellor is run inside the chroot to provision it.
-propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property NoInfo
+propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property UnixLike
 propellChroot c@(Chroot loc _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
 	let d = localdir </> shimdir c
 	let me = localdir </> "propellor"
@@ -205,7 +200,7 @@ chain :: [Host] -> CmdLine -> IO ()
 chain hostlist (ChrootChain hn loc systemdonly onconsole) =
 	case findHostNoAlias hostlist hn of
 		Nothing -> errorMessage ("cannot find host " ++ hn)
-		Just parenthost -> case M.lookup loc (_chroots $ getInfo $ hostInfo parenthost) of
+		Just parenthost -> case M.lookup loc (_chroots $ fromInfo $ hostInfo parenthost) of
 			Nothing -> errorMessage ("cannot find chroot " ++ loc ++ " on host " ++ hn)
 			Just h -> go h
   where
@@ -215,7 +210,7 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) =
 		onlyProcess (provisioningLock loc) $ do
 			r <- runPropellor (setInChroot h) $ ensureChildProperties $
 				if systemdonly
-					then [toProp Systemd.installed]
+					then [toChildProperty Systemd.installed]
 					else hostProperties h
 			flushConcurrentOutput
 			putStrLn $ "\n" ++ show r
@@ -257,7 +252,7 @@ chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
 -- This is accomplished by installing a </usr/sbin/policy-rc.d> script
 -- that does not let any daemons be started by packages that use
 -- invoke-rc.d. Reverting the property removes the script.
-noServices :: RevertableProperty NoInfo
+noServices :: RevertableProperty DebianLike DebianLike
 noServices = setup <!> teardown
   where
 	f = "/usr/sbin/policy-rc.d"
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index a86c839f..ace85a3c 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -78,7 +78,7 @@ concurrently p1 p2 = (combineWith go go p1 p2)
 -- The above example will run foo and bar concurrently, and once either of
 -- those 2 properties finishes, will start running baz.
 concurrentList :: SingI metatypes => IO Int -> Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
-concurrentList getn d (Props ps) = property d go `modifyChildren` (++ ps)
+concurrentList getn d (Props ps) = property d go `addChildren` ps
   where
 	go = do
 		n <- liftIO getn
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index ec15281b..8fe607bc 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -126,7 +126,7 @@ mkOrchestra = fromJust . go S.empty
   where
 	go seen h
 		| S.member (hostName h) seen = Nothing -- break loop
-		| otherwise = Just $ case getInfo (hostInfo h) of
+		| otherwise = Just $ case fromInfo (hostInfo h) of
 			ConductorFor [] -> Conducted h
 			ConductorFor l -> 
 				let seen' = S.insert (hostName h) seen
@@ -214,7 +214,7 @@ orchestrate :: [Host] -> [Host]
 orchestrate hs = map go hs
   where
 	go h
-		| isOrchestrated (getInfo (hostInfo h)) = h
+		| isOrchestrated (fromInfo (hostInfo h)) = h
 		| otherwise = foldl orchestrate' (removeold h) (map (deloop h) os)
 	os = extractOrchestras hs
 
@@ -222,7 +222,7 @@ orchestrate hs = map go hs
 	removeold' h oldconductor = addPropHost h $
 		undoRevertableProperty $ conductedBy oldconductor
 
-	oldconductors = zip hs (map (getInfo . hostInfo) hs)
+	oldconductors = zip hs (map (fromInfo . hostInfo) hs)
 	oldconductorsof h = flip mapMaybe oldconductors $ 
 		\(oldconductor, NotConductorFor l) ->
 			if any (sameHost h) l
@@ -299,7 +299,7 @@ addConductorPrivData h hs = h { hostInfo = hostInfo h <> i }
 	i = mempty 
 		`addInfo` mconcat (map privinfo hs)
 		`addInfo` Orchestrated (Any True)
-	privinfo h' = forceHostContext (hostName h') $ getInfo (hostInfo h')
+	privinfo h' = forceHostContext (hostName h') $ fromInfo (hostInfo h')
 
 -- Use this property to let the specified conductor ssh in and run propellor.
 conductedBy :: Host -> RevertableProperty DebianLike UnixLike
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index a660a016..2b5596bd 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -213,7 +213,7 @@ otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
 otherServers wantedtype hosts domain =
 	M.keys $ M.filter wanted $ hostMap hosts
   where
-	wanted h = case M.lookup domain (fromNamedConfMap $ getInfo $ hostInfo h) of
+	wanted h = case M.lookup domain (fromNamedConfMap $ fromInfo $ hostInfo h) of
 		Nothing -> False
 		Just conf -> confDnsServerType conf == wantedtype
 			&& confDomain conf == domain
@@ -468,7 +468,7 @@ genZone inzdomain hostmap zdomain soa =
 	-- So we can just use the IPAddrs.
 	addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
 	addcnames h = concatMap gen $ filter (inDomain zdomain) $
-		mapMaybe getCNAME $ S.toList $ fromDnsInfo $ getInfo info
+		mapMaybe getCNAME $ S.toList $ fromDnsInfo $ fromInfo info
 	  where
 		info = hostInfo h
 		gen c = case getAddresses info of
@@ -483,7 +483,7 @@ genZone inzdomain hostmap zdomain soa =
 	  where
 		info = hostInfo h
 		l = zip (repeat $ AbsDomain $ hostName h)
-			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (fromDnsInfo $ getInfo info))
+			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (fromDnsInfo $ fromInfo info))
 
 	-- Simplifies the list of hosts. Remove duplicate entries.
 	-- Also, filter out any CHAMES where the same domain has an
@@ -518,7 +518,7 @@ addNamedConf conf = NamedConfMap (M.singleton domain conf)
 	domain = confDomain conf
 
 getNamedConf :: Propellor (M.Map Domain NamedConf)
-getNamedConf = asks $ fromNamedConfMap . getInfo . hostInfo
+getNamedConf = asks $ fromNamedConfMap . fromInfo . hostInfo
 
 -- | Generates SSHFP records for hosts in the domain (or with CNAMES
 -- in the domain) that have configured ssh public keys.
@@ -531,7 +531,7 @@ genSSHFP domain h = concatMap mk . concat <$> (gen =<< get)
 	gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty
 	mk r = mapMaybe (\d -> if inDomain domain d then Just (d, r) else Nothing)
 		(AbsDomain hostname : cnames)
-	cnames = mapMaybe getCNAME $ S.toList $ fromDnsInfo $ getInfo info
+	cnames = mapMaybe getCNAME $ S.toList $ fromDnsInfo $ fromInfo info
 	hostname = hostName h
 	info = hostInfo h
 
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index d19d15aa..fe1e3b18 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -172,9 +172,9 @@ propagateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Pr
 propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p'
   where
 	p' = infoProperty
-		(propertyDesc p)
+		(getDesc p)
 		(getSatisfy p)
-		(propertyInfo p <> dockerinfo)
+		(getInfo p <> dockerinfo)
 		(propertyChildren p)
 	dockerinfo = dockerInfo $
 		mempty { _dockerContainers = M.singleton cn h }
@@ -186,7 +186,7 @@ mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
   where
 	runparams = map (\(DockerRunParam mkparam) -> mkparam hn)
 		(_dockerRunParams info)
-	info = getInfo $ hostInfo h'
+	info = fromInfo $ hostInfo h'
 	h' = h
 		-- Restart by default so container comes up on
 		-- boot or when docker is upgraded.
@@ -435,7 +435,7 @@ myContainerSuffix = ".propellor"
 containerDesc :: (IsProp (Property i)) => ContainerId -> Property i -> Property i
 containerDesc cid p = p `describe` desc
   where
-	desc = "container " ++ fromContainerId cid ++ " " ++ propertyDesc p
+	desc = "container " ++ fromContainerId cid ++ " " ++ getDesc p
 
 runningContainer :: ContainerId -> Image -> [RunParam] -> Property Linux
 runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do
@@ -574,7 +574,7 @@ chain hostlist hn s = case toContainerId s of
 	Nothing -> errorMessage "bad container id"
 	Just cid -> case findHostNoAlias hostlist hn of
 		Nothing -> errorMessage ("cannot find host " ++ hn)
-		Just parenthost -> case M.lookup (containerName cid) (_dockerContainers $ getInfo $ hostInfo parenthost) of
+		Just parenthost -> case M.lookup (containerName cid) (_dockerContainers $ fromInfo $ hostInfo parenthost) of
 			Nothing -> errorMessage ("cannot find container " ++ containerName cid ++ " docked on host " ++ hn)
 			Just h -> go cid h
   where
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index 304d0863..a8b8347a 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -35,7 +35,7 @@ toProps ps = Props (map toChildProperty ps)
 propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
 propertyList desc (Props ps) = 
 	property desc (ensureChildProperties cs)
-		`modifyChildren` (++ cs)
+		`addChildren` cs
   where
 	cs = map toChildProperty ps
 
@@ -44,7 +44,7 @@ propertyList desc (Props ps) =
 combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
 combineProperties desc (Props ps) = 
 	property desc (combineSatisfy cs NoChange)
-		`modifyChildren` (++ cs)
+		`addChildren` cs
   where
 	cs = map toChildProperty ps
 
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 5aff4ba4..291d4168 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -68,7 +68,7 @@ kpartx :: FilePath -> ([LoopDev] -> Property DebianLike) -> Property DebianLike
 kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"]
   where
 	go :: Property DebianLike
-	go = property' (propertyDesc (mkprop [])) $ \w -> do
+	go = property' (getDesc (mkprop [])) $ \w -> do
 		cleanup -- idempotency
 		loopdevs <- liftIO $ kpartxParse
 			<$> readProcess "kpartx" ["-avs", diskimage]
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index 7d9e7068..45aa4e42 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -304,7 +304,7 @@ saslAuthdInstalled = setupdaemon
 -- | Uses `saslpasswd2` to set the password for a user in the sasldb2 file.
 --
 -- The password is taken from the privdata.
-saslPasswdSet :: Domain -> User -> Property HasInfo
+saslPasswdSet :: Domain -> User -> Property (HasInfo + UnixLike)
 saslPasswdSet domain (User user) = go `changesFileContent` "/etc/sasldb2"
   where
 	go = withPrivData src ctx $ \getpw ->
diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs
index 534e1e88..95e4e362 100644
--- a/src/Propellor/Property/Scheduled.hs
+++ b/src/Propellor/Property/Scheduled.hs
@@ -22,18 +22,18 @@ import qualified Data.Map as M
 -- last run.
 period :: (IsProp (Property i)) => Property i -> Recurrance -> Property i
 period prop recurrance = flip describe desc $ adjustPropertySatisfy prop $ \satisfy -> do
-	lasttime <- liftIO $ getLastChecked (propertyDesc prop)
+	lasttime <- liftIO $ getLastChecked (getDesc prop)
 	nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
 	t <- liftIO localNow
 	if Just t >= nexttime
 		then do
 			r <- satisfy
-			liftIO $ setLastChecked t (propertyDesc prop)
+			liftIO $ setLastChecked t (getDesc prop)
 			return r
 		else noChange
   where
 	schedule = Schedule recurrance AnyTime
-	desc = propertyDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
+	desc = getDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
 
 -- | Like period, but parse a human-friendly string.
 periodParse :: (IsProp (Property i)) => Property i -> String -> Property i
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 2234ad5c..d909e4df 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -214,13 +214,13 @@ container name system mkchroot = Container name c h
 --
 -- Reverting this property stops the container, removes the systemd unit,
 -- and deletes the chroot and all its contents.
-nspawned :: Container -> RevertableProperty HasInfo
+nspawned :: Container -> RevertableProperty (HasInfo + UnixLike) UnixLike
 nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
 	p `describe` ("nspawned " ++ name)
   where
 	p = enterScript c
 		`before` chrootprovisioned
-		`before` nspawnService c (_chrootCfg $ getInfo $ hostInfo h)
+		`before` nspawnService c (_chrootCfg $ fromInfo $ hostInfo h)
 		`before` containerprovisioned
 
 	-- Chroot provisioning is run in systemd-only mode,
@@ -336,7 +336,7 @@ mungename = replace "/" "_"
 -- When there is no leading dash, "--" is prepended to the parameter.
 --
 -- Reverting the property will remove a parameter, if it's present.
-containerCfg :: String -> RevertableProperty HasInfo
+containerCfg :: String -> RevertableProperty (HasInfo + UnixLike) UnixLike
 containerCfg p = RevertableProperty (mk True) (mk False)
   where
 	mk b = pureInfoProperty ("container configuration " ++ (if b then "" else "without ") ++ p') $
@@ -348,18 +348,18 @@ containerCfg p = RevertableProperty (mk True) (mk False)
 -- | Bind mounts </etc/resolv.conf> from the host into the container.
 --
 -- This property is enabled by default. Revert it to disable it.
-resolvConfed :: RevertableProperty HasInfo
+resolvConfed :: RevertableProperty (HasInfo + UnixLike) UnixLike
 resolvConfed = containerCfg "bind=/etc/resolv.conf"
 
 -- | Link the container's journal to the host's if possible.
 -- (Only works if the host has persistent journal enabled.)
 --
 -- This property is enabled by default. Revert it to disable it.
-linkJournal :: RevertableProperty HasInfo
+linkJournal :: RevertableProperty (HasInfo + UnixLike) UnixLike
 linkJournal = containerCfg "link-journal=try-guest"
 
 -- | Disconnect networking of the container from the host.
-privateNetwork :: RevertableProperty HasInfo
+privateNetwork :: RevertableProperty (HasInfo + UnixLike) UnixLike
 privateNetwork = containerCfg "private-network"
 
 class Publishable a where
@@ -397,7 +397,7 @@ instance Publishable (Proto, Bound Port) where
 -- >	& Systemd.running Systemd.networkd
 -- >	& Systemd.publish (Port 80 ->- Port 8080)
 -- >	& Apt.installedRunning "apache2"
-publish :: Publishable p => p -> RevertableProperty HasInfo
+publish :: Publishable p => p -> RevertableProperty (HasInfo + UnixLike) UnixLike
 publish p = containerCfg $ "--port=" ++ toPublish p
 
 class Bindable a where
@@ -410,9 +410,9 @@ instance Bindable (Bound FilePath) where
 	toBind v = hostSide v ++ ":" ++ containerSide v
 
 -- | Bind mount a file or directory from the host into the container.
-bind :: Bindable p => p -> RevertableProperty HasInfo
+bind :: Bindable p => p -> RevertableProperty (HasInfo + UnixLike) UnixLike
 bind p = containerCfg $ "--bind=" ++ toBind p
 
 -- | Read-only mind mount.
-bindRo :: Bindable p => p -> RevertableProperty HasInfo
+bindRo :: Bindable p => p -> RevertableProperty (HasInfo + UnixLike) UnixLike
 bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 5f103b8a..944696dd 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -90,7 +90,7 @@ spin' mprivdata relay target hst = do
 		error "remote propellor failed"
   where
 	hn = fromMaybe target relay
-	sys = case getInfo (hostInfo hst) of
+	sys = case fromInfo (hostInfo hst) of
 		InfoVal o -> Just o
 		NoInfoVal -> Nothing
 
@@ -170,7 +170,7 @@ getSshTarget target hst
 					return ip
 
 	configips = map fromIPAddr $ mapMaybe getIPAddr $
-		S.toList $ fromDnsInfo $ getInfo $ hostInfo hst
+		S.toList $ fromDnsInfo $ fromInfo $ hostInfo hst
 
 -- Update the privdata, repo url, and git repo over the ssh
 -- connection, talking to the user's local propellor instance which is
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index ccbfd3e0..2bddfc1a 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -26,11 +26,7 @@ module Propellor.Types
 	, type (+)
 	, addInfoProperty
 	, addInfoProperty'
-	, addChildrenProperty
 	, adjustPropertySatisfy
-	, propertyInfo
-	, propertyDesc
-	, propertyChildren
 	, RevertableProperty(..)
 	, (<!>)
 	, ChildProperty
@@ -124,12 +120,15 @@ type Desc = String
 -- internally, so you needn't worry about them.
 data Property metatypes = Property metatypes Desc (Propellor Result) Info [ChildProperty]
 
+instance Show (Property metatypes) where
+	show p = "property " ++ show (getDesc p)
+
 -- | Since there are many different types of Properties, they cannot be put
 -- into a list. The simplified ChildProperty can be put into a list.
 data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
 
 instance Show ChildProperty where
-	show (ChildProperty desc _ _ _) = desc
+	show = getDesc
 
 -- | Constructs a Property, from a description and an action to run to
 -- ensure the Property is met.
@@ -170,28 +169,10 @@ addInfoProperty'
 addInfoProperty' (Property t d a oldi c) newi =
 	Property t d a (oldi <> newi) c
 
--- | Adds children to a Property.
-addChildrenProperty :: Property metatypes -> [ChildProperty] -> Property metatypes
-addChildrenProperty (Property t s a i cs) cs' = Property t s a i (cs ++ cs')
-
 -- | 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
 
-propertyInfo :: Property metatypes -> Info
-propertyInfo (Property _ _ _ i _) = i
-
-propertyDesc :: Property metatypes -> Desc
-propertyDesc (Property _ d _ _ _) = d
-
-instance Show (Property metatypes) where
-	show p = "property " ++ show (propertyDesc p)
-
--- | A Property can include a list of child properties that it also
--- satisfies. This allows them to be introspected to collect their info, etc.
-propertyChildren :: Property metatypes -> [ChildProperty]
-propertyChildren (Property _ _ _ _ c) = c
-
 -- | A property that can be reverted. The first Property is run
 -- normally and the second is run when it's reverted.
 data RevertableProperty setupmetatypes undometatypes = RevertableProperty
@@ -209,14 +190,16 @@ instance Show (RevertableProperty setupmetatypes undometatypes) where
 	-> RevertableProperty setupmetatypes undometatypes
 setup <!> undo = RevertableProperty setup undo
 
--- | Class of types that can be used as properties of a host.
 class IsProp p where
 	setDesc :: p -> Desc -> p
 	getDesc :: p -> Desc
-	modifyChildren :: p -> ([ChildProperty] -> [ChildProperty]) -> p
+	getChildren :: p -> [ChildProperty]
+	addChildren :: p -> [ChildProperty] -> p
 	-- | Gets the info of the property, combined with all info
 	-- of all children properties.
 	getInfoRecursive :: p -> Info
+	-- | Info, not including info from children.
+	getInfo :: p -> Info
 	-- | Gets a ChildProperty representing the Property.
 	-- You should not normally need to use this.
 	toChildProperty :: p -> ChildProperty
@@ -227,19 +210,23 @@ class IsProp p where
 
 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)
+	getDesc (Property _ d _ _ _) = d
+	getChildren (Property _ _ _ _ c) = c
+	addChildren (Property t d a i c) c' = Property t d a i (c ++ c')
 	getInfoRecursive (Property _ _ _ i c) =
 		i <> mconcat (map getInfoRecursive c)
+	getInfo (Property _ _ _ i _) = i
 	toChildProperty (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)
+	getChildren (ChildProperty _ _ _ c) = c
+	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
 	getInfoRecursive (ChildProperty _ _ i c) =
 		i <> mconcat (map getInfoRecursive c)
+	getInfo (ChildProperty _ _ i _) = i
 	toChildProperty = id
 	getSatisfy (ChildProperty _ a _ _) = a
 
@@ -248,9 +235,12 @@ instance IsProp (RevertableProperty setupmetatypes undometatypes) where
 	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)
+	getChildren (RevertableProperty p1 _) = getChildren p1
+	-- | Only add children to the active side.
+	addChildren (RevertableProperty p1 p2) c = RevertableProperty (addChildren p1 c) p2
 	-- | Return the Info of the currently active side.
 	getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
+	getInfo (RevertableProperty p1 _p2) = getInfo p1
 	toChildProperty (RevertableProperty p1 _p2) = toChildProperty p1
 	getSatisfy (RevertableProperty p1 _) = getSatisfy p1
 
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index bc1543e2..c7f6b82f 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -5,7 +5,7 @@ module Propellor.Types.Info (
 	IsInfo(..),
 	addInfo,
 	toInfo,
-	getInfo,
+	fromInfo,
 	mapInfo,
 	propagatableInfo,
 	InfoVal(..),
@@ -51,8 +51,8 @@ toInfo :: IsInfo v => v -> Info
 toInfo = addInfo mempty
 
 -- The list is reversed here because addInfo builds it up in reverse order.
-getInfo :: IsInfo v => Info -> v
-getInfo (Info l) = mconcat (mapMaybe extractInfoEntry (reverse l))
+fromInfo :: IsInfo v => Info -> v
+fromInfo (Info l) = mconcat (mapMaybe extractInfoEntry (reverse l))
 
 -- | Maps a function over all values stored in the Info that are of the
 -- appropriate type.
-- 
cgit v1.3-2-g0d8e


From 9d6dc29555b8499d8ae6c73c891b0b5dc19f83e5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sun, 27 Mar 2016 19:59:20 -0400
Subject: improve haddocks and move code around to make them more clear

---
 propellor.cabal                       |   1 +
 src/Propellor/Container.hs            |   4 +-
 src/Propellor/Engine.hs               |   4 +-
 src/Propellor/EnsureProperty.hs       |   1 +
 src/Propellor/Info.hs                 |  28 +++++-
 src/Propellor/PrivData.hs             |   2 +-
 src/Propellor/PropAccum.hs            |   5 +-
 src/Propellor/Property.hs             |   1 +
 src/Propellor/Property/Chroot.hs      |   3 +-
 src/Propellor/Property/Concurrent.hs  |   2 +
 src/Propellor/Property/Conductor.hs   |  13 +--
 src/Propellor/Property/Dns.hs         |   2 +-
 src/Propellor/Property/Docker.hs      |   3 +-
 src/Propellor/Property/FreeBSD/Pkg.hs |   4 +-
 src/Propellor/Property/List.hs        |   2 +
 src/Propellor/Property/Partition.hs   |   1 +
 src/Propellor/Property/Scheduled.hs   |   1 +
 src/Propellor/Types.hs                | 168 ++++++----------------------------
 src/Propellor/Types/Core.hs           | 106 +++++++++++++++++++++
 src/Propellor/Types/Info.hs           |   5 +
 20 files changed, 196 insertions(+), 160 deletions(-)
 create mode 100644 src/Propellor/Types/Core.hs

(limited to 'src/Propellor/PrivData.hs')

diff --git a/propellor.cabal b/propellor.cabal
index f11d2afe..e946f697 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -150,6 +150,7 @@ Library
     Propellor.EnsureProperty
     Propellor.Exception
     Propellor.Types
+    Propellor.Types.Core
     Propellor.Types.Chroot
     Propellor.Types.CmdLine
     Propellor.Types.Container
diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
index 4cd46ae5..c4d6f864 100644
--- a/src/Propellor/Container.hs
+++ b/src/Propellor/Container.hs
@@ -3,8 +3,10 @@
 module Propellor.Container where
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.MetaTypes
 import Propellor.Types.Info
+import Propellor.Info
 import Propellor.PrivData
 import Propellor.PropAccum
 
@@ -54,7 +56,7 @@ propagateContainer containername c prop = prop
 	convert p = 
 		let n = property (getDesc p) (getSatisfy p) :: Property UnixLike
 		    n' = n
-		    	`addInfoProperty` mapInfo (forceHostContext containername)
+		    	`setInfoProperty` mapInfo (forceHostContext containername)
 				(propagatableInfo (getInfo p))
 		   	`addChildren` map convert (getChildren p)
 		in toChildProperty n'
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 4c37e704..f0035c40 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -4,7 +4,6 @@
 module Propellor.Engine (
 	mainProperties,
 	runPropellor,
-	ensureProperty,
 	ensureChildProperties,
 	fromHost,
 	fromHost',
@@ -23,10 +22,11 @@ import Control.Applicative
 import Prelude
 
 import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Message
 import Propellor.Exception
 import Propellor.Info
-import Propellor.Property
 import Utility.Exception
 
 -- | Gets the Properties of a Host, and ensures them all,
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index f9094c5b..ce01d436 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -11,6 +11,7 @@ module Propellor.EnsureProperty
 	) where
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.MetaTypes
 import Propellor.Exception
 
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index ff0b3b5e..b87369c3 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -1,9 +1,11 @@
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PackageImports, TypeFamilies, DataKinds, PolyKinds #-}
 
 module Propellor.Info (
 	osDebian,
 	osBuntish,
 	osFreeBSD,
+	setInfoProperty,
+	addInfoProperty,
 	pureInfoProperty,
 	pureInfoProperty',
 	askInfo,
@@ -22,6 +24,7 @@ module Propellor.Info (
 
 import Propellor.Types
 import Propellor.Types.Info
+import Propellor.Types.MetaTypes
 
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
@@ -31,11 +34,32 @@ import Data.Monoid
 import Control.Applicative
 import Prelude
 
+-- | Adds info to a Property.
+--
+-- The new Property will include HasInfo in its metatypes.
+setInfoProperty
+	:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
+	=> Property metatypes
+	-> Info
+	-> Property (MetaTypes metatypes')
+setInfoProperty (Property _ d a oldi c) newi =
+	Property sing d a (oldi <> newi) c
+
+-- | Adds more info to a Property that already HasInfo.
+addInfoProperty
+	:: (IncludesInfo metatypes ~ 'True)
+	=> Property metatypes
+	-> Info
+	-> Property metatypes
+addInfoProperty (Property t d a oldi c) newi =
+	Property t d a (oldi <> newi) c
+
+-- | Makes a property that does nothing but set some `Info`.
 pureInfoProperty :: (IsInfo v) => Desc -> v -> Property (HasInfo + UnixLike)
 pureInfoProperty desc v = pureInfoProperty' desc (toInfo v)
 
 pureInfoProperty' :: Desc -> Info -> Property (HasInfo + UnixLike)
-pureInfoProperty' desc i = addInfoProperty p i
+pureInfoProperty' desc i = setInfoProperty p i
   where
 	p :: Property UnixLike
 	p = property ("has " ++ desc) (return NoChange)
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 0bc0c100..d3bb3a6d 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -127,7 +127,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 			"Fix this by running:" :
 			showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist)
 		return FailedChange
-	addinfo p = p `addInfoProperty'` (toInfo privset)
+	addinfo p = p `addInfoProperty` (toInfo privset)
 	privset = PrivInfo $ S.fromList $
 		map (\s -> (privDataField s, describePrivDataSource s, hc)) srclist
 	fieldnames = map show fieldlist
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 856f2e8e..d9fa8ec7 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -16,6 +16,7 @@ module Propellor.PropAccum
 
 import Propellor.Types
 import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Property
 
 import Data.Monoid
@@ -30,10 +31,6 @@ import Prelude
 host :: HostName -> Props metatypes -> Host
 host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps))
 
--- | Props is a combination of a list of properties, with their combined 
--- metatypes.
-data Props metatypes = Props [ChildProperty]
-
 -- | Start accumulating a list of properties.
 --
 -- Properties can be added to it using `(&)` etc.
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 70583edc..29a8ec0f 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -53,6 +53,7 @@ import Control.Applicative
 import Prelude
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.ResultCheck
 import Propellor.Types.MetaTypes
 import Propellor.Info
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 811b5baa..09047ce5 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -23,6 +23,7 @@ import Propellor.Container
 import Propellor.Types.CmdLine
 import Propellor.Types.Chroot
 import Propellor.Types.Info
+import Propellor.Types.Core
 import Propellor.Property.Chroot.Util
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Systemd.Core as Systemd
@@ -151,7 +152,7 @@ provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
 
 propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
 propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
-	p `addInfoProperty` chrootInfo c
+	p `setInfoProperty` chrootInfo c
 
 chrootInfo :: Chroot -> Info
 chrootInfo (Chroot loc _ h) = mempty `addInfo`
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index ace85a3c..e69dc17d 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -37,6 +37,8 @@ module Propellor.Property.Concurrent (
 ) where
 
 import Propellor.Base
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
 
 import Control.Concurrent
 import qualified Control.Concurrent.Async as A
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index ab747acc..8aa18d20 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -83,16 +83,17 @@ import qualified Propellor.Property.Ssh as Ssh
 import qualified Data.Set as S
 
 -- | Class of things that can be conducted.
+--
+-- There are instances for single hosts, and for lists of hosts.
+-- With a list, each listed host will be conducted in turn. Failure to conduct
+-- one host does not prevent conducting subsequent hosts in the list, but
+-- will be propagated as an overall failure of the property.
 class Conductable c where
 	conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
 
 instance Conductable Host where
-	-- | Conduct the specified host.
 	conducts h = conductorFor h <!> notConductorFor h
 
--- | Each host in the list will be conducted in turn. Failure to conduct
--- one host does not prevent conducting subsequent hosts in the list, but
--- will be propagated as an overall failure of the property.
 instance Conductable [Host] where
 	conducts hs = 
 		propertyList desc (toProps $ map (setupRevertableProperty . conducts) hs)
@@ -246,7 +247,7 @@ orchestrate' h (Conductor c l)
 -- to have any effect.
 conductorFor :: Host -> Property (HasInfo + UnixLike)
 conductorFor h = go
-	`addInfoProperty` (toInfo (ConductorFor [h]))
+	`setInfoProperty` (toInfo (ConductorFor [h]))
 	`requires` setupRevertableProperty (conductorKnownHost h)
 	`requires` Ssh.installed
   where
@@ -270,7 +271,7 @@ conductorFor h = go
 -- Reverts conductorFor.
 notConductorFor :: Host -> Property (HasInfo + UnixLike)
 notConductorFor h = (doNothing :: Property UnixLike)
-	`addInfoProperty` (toInfo (NotConductorFor [h]))
+	`setInfoProperty` (toInfo (NotConductorFor [h]))
 	`describe` desc
 	`requires` undoRevertableProperty (conductorKnownHost h)
   where
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 2b5596bd..2e2710a6 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -81,7 +81,7 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs =
 
 	(partialzone, zonewarnings) = genZone indomain hostmap domain soa
 	baseprop = primaryprop
-		`addInfoProperty` (toInfo (addNamedConf conf))
+		`setInfoProperty` (toInfo (addNamedConf conf))
 	primaryprop :: Property DebianLike
 	primaryprop = property ("dns primary for " ++ domain) $ do
 		sshfps <- concat <$> mapM (genSSHFP domain) (M.elems hostmap)
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index ddefef15..2ef97438 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -48,6 +48,7 @@ module Propellor.Property.Docker (
 import Propellor.Base hiding (init)
 import Propellor.Types.Docker
 import Propellor.Types.Container
+import Propellor.Types.Core
 import Propellor.Types.CmdLine
 import Propellor.Types.Info
 import Propellor.Container
@@ -183,7 +184,7 @@ imagePulled ctr = pulled `describe` msg
 
 propagateContainerInfo :: Container -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
 propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr $
-	p `addInfoProperty'` dockerinfo
+	p `addInfoProperty` dockerinfo
   where
 	dockerinfo = dockerInfo $
 		mempty { _dockerContainers = M.singleton cn h }
diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
index 6c775b94..704c1db9 100644
--- a/src/Propellor/Property/FreeBSD/Pkg.hs
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -51,7 +51,7 @@ update =
 		go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
 		(property "pkg update has run" go :: Property FreeBSD)
-			`addInfoProperty` (toInfo (PkgUpdate ""))
+			`setInfoProperty` (toInfo (PkgUpdate ""))
 
 newtype PkgUpgrade = PkgUpgrade String
 	deriving (Typeable, Monoid, Show)
@@ -68,7 +68,7 @@ upgrade =
 		go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
 		(property "pkg upgrade has run" go :: Property FreeBSD)
-			`addInfoProperty` (toInfo (PkgUpdate ""))
+			`setInfoProperty` (toInfo (PkgUpdate ""))
 			`requires` update
 
 type Package = String
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index a8b8347a..0eec04c7 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -13,6 +13,8 @@ module Propellor.Property.List (
 ) where
 
 import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
 import Propellor.PropAccum
 import Propellor.Engine
 import Propellor.Exception
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 291d4168..2bf5b927 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -3,6 +3,7 @@
 module Propellor.Property.Partition where
 
 import Propellor.Base
+import Propellor.Types.Core
 import qualified Propellor.Property.Apt as Apt
 import Utility.Applicative
 
diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs
index 95e4e362..729a3749 100644
--- a/src/Propellor/Property/Scheduled.hs
+++ b/src/Propellor/Property/Scheduled.hs
@@ -10,6 +10,7 @@ module Propellor.Property.Scheduled
 	) where
 
 import Propellor.Base
+import Propellor.Types.Core
 import Utility.Scheduled
 
 import Data.Time.Clock
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index d5959cbb..6d6b14ea 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -8,15 +7,18 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
-module Propellor.Types
-	( Host(..)
+module Propellor.Types (
+	-- * Core data types
+	  Host(..)
 	, Property(..)
 	, property
-	, Info
 	, Desc
-	, MetaType(..)
-	, MetaTypes
-	, TargetOS(..)
+	, RevertableProperty(..)
+	, (<!>)
+	, Propellor(..)
+	, LiftPropellor(..)
+	, Info
+	-- * Types of properties
 	, UnixLike
 	, Linux
 	, DebianLike
@@ -25,34 +27,22 @@ module Propellor.Types
 	, FreeBSD
 	, HasInfo
 	, type (+)
-	, addInfoProperty
-	, addInfoProperty'
-	, adjustPropertySatisfy
-	, RevertableProperty(..)
-	, (<!>)
-	, ChildProperty
-	, IsProp(..)
+	, TightenTargets(..)
+	-- * Combining and modifying properties
 	, Combines(..)
 	, CombinedType
 	, ResultCombiner
-	, Propellor(..)
-	, LiftPropellor(..)
-	, EndAction(..)
+	, adjustPropertySatisfy
+	-- * Other included types
 	, module Propellor.Types.OS
 	, module Propellor.Types.Dns
 	, module Propellor.Types.Result
 	, module Propellor.Types.ZFS
-	, TightenTargets(..)
-	, SingI
 	) where
 
 import Data.Monoid
-import "mtl" Control.Monad.RWS.Strict
-import Control.Monad.Catch
-import Data.Typeable
-import Control.Applicative
-import Prelude
 
+import Propellor.Types.Core
 import Propellor.Types.Info
 import Propellor.Types.OS
 import Propellor.Types.Dns
@@ -60,89 +50,38 @@ import Propellor.Types.Result
 import Propellor.Types.MetaTypes
 import Propellor.Types.ZFS
 
--- | Everything Propellor knows about a system: Its hostname,
--- properties and their collected info.
-data Host = Host
-	{ hostName :: HostName
-	, hostProperties :: [ChildProperty]
-	, hostInfo :: Info
-	}
-	deriving (Show, Typeable)
-
--- | Propellor's monad provides read-only access to info about the host
--- it's running on, and a writer to accumulate EndActions.
-newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
-	deriving
-		( Monad
-		, Functor
-		, Applicative
-		, MonadReader Host
-		, MonadWriter [EndAction]
-		, MonadIO
-		, MonadCatch
-		, MonadThrow
-		, MonadMask
-		)
-
-class LiftPropellor m where
-	liftPropellor :: m a -> Propellor a
-
-instance LiftPropellor Propellor where
-	liftPropellor = id
-
-instance LiftPropellor IO where
-	liftPropellor = liftIO
-
-instance Monoid (Propellor Result) where
-	mempty = return NoChange
-	-- | The second action is only run if the first action does not fail.
-	mappend x y = do
-		rx <- x
-		case rx of
-			FailedChange -> return FailedChange
-			_ -> do
-				ry <- y
-				return (rx <> ry)
-
--- | An action that Propellor runs at the end, after trying to satisfy all
--- properties. It's passed the combined Result of the entire Propellor run.
-data EndAction = EndAction Desc (Result -> Propellor Result)
-
-type Desc = String
-
 -- | The core data type of Propellor, this represents a property
--- that the system should have, with a descrition, an action to ensure
--- it has the property, and perhaps some Info that can be added to Hosts
+-- that the system should have, with a descrition, and an action to ensure
+-- it has the property.
 -- that have the property.
 --
--- A property has a list of `[MetaType]`, which is part of its type.
+-- There are different types of properties that target different OS's,
+-- and so have different metatypes. 
+-- For example: "Property DebianLike" and "Property FreeBSD".
 --
--- There are many instances and type families, which are mostly used
+-- Also, some properties have associated `Info`, which is indicated in
+-- their type: "Property (HasInfo + DebianLike)"
+--
+-- There are many associated type families, which are mostly used
 -- internally, so you needn't worry about them.
 data Property metatypes = Property metatypes Desc (Propellor Result) Info [ChildProperty]
 
 instance Show (Property metatypes) where
 	show p = "property " ++ show (getDesc p)
 
--- | Since there are many different types of Properties, they cannot be put
--- into a list. The simplified ChildProperty can be put into a list.
-data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
-
-instance Show ChildProperty where
-	show = getDesc
-
 -- | Constructs a Property, from a description and an action to run to
 -- ensure the Property is met.
 --
--- You can specify any metatypes that make sense to indicate what OS
--- the property targets, etc.
+-- Due to the polymorphic return type of this function, most uses will need
+-- to specify a type signature. This lets you specify what OS the property
+-- targets, etc.
 --
 -- For example:
 --
 -- > foo :: Property Debian
--- > foo = mkProperty "foo" (...)
---
--- Note that using this needs LANGUAGE PolyKinds.
+-- > foo = property "foo" $ do
+-- >	...
+-- > 	return MadeChange
 property
 	:: SingI metatypes
 	=> Desc
@@ -150,26 +89,6 @@ property
 	-> Property (MetaTypes metatypes)
 property d a = Property sing d a mempty mempty
 
--- | Adds info to a Property.
---
--- The new Property will include HasInfo in its metatypes.
-addInfoProperty
-	:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
-	=> Property metatypes
-	-> Info
-	-> Property (MetaTypes metatypes')
-addInfoProperty (Property _ d a oldi c) newi =
-	Property sing d a (oldi <> newi) c
-
--- | Adds more info to a Property that already HasInfo.
-addInfoProperty'
-	:: (IncludesInfo metatypes ~ 'True)
-	=> Property metatypes
-	-> Info
-	-> Property metatypes
-addInfoProperty' (Property t d a oldi c) newi =
-	Property t d a (oldi <> newi) c
-
 -- | 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
@@ -191,24 +110,6 @@ instance Show (RevertableProperty setupmetatypes undometatypes) where
 	-> RevertableProperty setupmetatypes undometatypes
 setup <!> undo = RevertableProperty setup undo
 
-class IsProp p where
-	setDesc :: p -> Desc -> p
-	getDesc :: p -> Desc
-	getChildren :: p -> [ChildProperty]
-	addChildren :: p -> [ChildProperty] -> p
-	-- | Gets the info of the property, combined with all info
-	-- of all children properties.
-	getInfoRecursive :: p -> Info
-	-- | Info, not including info from children.
-	getInfo :: p -> Info
-	-- | Gets a ChildProperty representing the Property.
-	-- You should not normally need to use this.
-	toChildProperty :: 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 (Property _ d _ _ _) = d
@@ -220,17 +121,6 @@ instance IsProp (Property metatypes) where
 	toChildProperty (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
-	getChildren (ChildProperty _ _ _ c) = c
-	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
-	getInfoRecursive (ChildProperty _ _ i c) =
-		i <> mconcat (map getInfoRecursive c)
-	getInfo (ChildProperty _ _ i _) = i
-	toChildProperty = id
-	getSatisfy (ChildProperty _ a _ _) = a
-
 instance IsProp (RevertableProperty setupmetatypes undometatypes) where
 	-- | Sets the description of both sides.
 	setDesc (RevertableProperty p1 p2) d =
diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs
new file mode 100644
index 00000000..fa939d2b
--- /dev/null
+++ b/src/Propellor/Types/Core.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Propellor.Types.Core where
+
+import Propellor.Types.Info
+import Propellor.Types.OS
+import Propellor.Types.Result
+
+import Data.Monoid
+import "mtl" Control.Monad.RWS.Strict
+import Control.Monad.Catch
+import Control.Applicative
+import Prelude
+
+-- | Everything Propellor knows about a system: Its hostname,
+-- properties and their collected info.
+data Host = Host
+	{ hostName :: HostName
+	, hostProperties :: [ChildProperty]
+	, hostInfo :: Info
+	}
+	deriving (Show, Typeable)
+
+-- | Propellor's monad provides read-only access to info about the host
+-- it's running on, and a writer to accumulate EndActions.
+newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
+	deriving
+		( Monad
+		, Functor
+		, Applicative
+		, MonadReader Host
+		, MonadWriter [EndAction]
+		, MonadIO
+		, MonadCatch
+		, MonadThrow
+		, MonadMask
+		)
+
+class LiftPropellor m where
+	liftPropellor :: m a -> Propellor a
+
+instance LiftPropellor Propellor where
+	liftPropellor = id
+
+instance LiftPropellor IO where
+	liftPropellor = liftIO
+
+instance Monoid (Propellor Result) where
+	mempty = return NoChange
+	-- | The second action is only run if the first action does not fail.
+	mappend x y = do
+		rx <- x
+		case rx of
+			FailedChange -> return FailedChange
+			_ -> do
+				ry <- y
+				return (rx <> ry)
+
+-- | An action that Propellor runs at the end, after trying to satisfy all
+-- properties. It's passed the combined Result of the entire Propellor run.
+data EndAction = EndAction Desc (Result -> Propellor Result)
+
+type Desc = String
+
+-- | Props is a combination of a list of properties, with their combined 
+-- metatypes.
+data Props metatypes = Props [ChildProperty]
+
+-- | Since there are many different types of Properties, they cannot be put
+-- into a list. The simplified ChildProperty can be put into a list.
+data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
+  
+instance Show ChildProperty where
+	show = getDesc
+
+class IsProp p where
+	setDesc :: p -> Desc -> p
+	getDesc :: p -> Desc
+	getChildren :: p -> [ChildProperty]
+	addChildren :: p -> [ChildProperty] -> p
+	-- | Gets the info of the property, combined with all info
+	-- of all children properties.
+	getInfoRecursive :: p -> Info
+	-- | Info, not including info from children.
+	getInfo :: p -> Info
+	-- | Gets a ChildProperty representing the Property.
+	-- You should not normally need to use this.
+	toChildProperty :: 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 ChildProperty where
+	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
+	getDesc (ChildProperty d _ _ _) = d
+	getChildren (ChildProperty _ _ _ c) = c
+	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
+	getInfoRecursive (ChildProperty _ _ i c) =
+		i <> mconcat (map getInfoRecursive c)
+	getInfo (ChildProperty _ _ i _) = i
+	toChildProperty = id
+	getSatisfy (ChildProperty _ a _ _) = a
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index c7f6b82f..2e188ae5 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -19,6 +19,9 @@ import Data.Monoid
 import Prelude
 
 -- | Information about a Host, which can be provided by its properties.
+--
+-- Many different types of data can be contained in the same Info value
+-- at the same time. See `toInfo` and `fromInfo`.
 newtype Info = Info [InfoEntry]
 	deriving (Monoid, Show)
 
@@ -47,6 +50,8 @@ class (Typeable v, Monoid v, Show v) => IsInfo v where
 addInfo :: IsInfo v => Info -> v -> Info
 addInfo (Info l) v = Info (InfoEntry v:l)
 
+-- | Converts any value in the `IsInfo` type class into an Info,
+-- which is otherwise empty.
 toInfo :: IsInfo v => v -> Info
 toInfo = addInfo mempty
 
-- 
cgit v1.3-2-g0d8e