All Property combinators now combine together their Attr settings.

So Attr settings can be made inside a propertyList, for example.

Propellor/Attr.hs

@@ -10,7 +10,7 @@ import qualified Data.Set as S
 import qualified Data.Map as M
 import Control.Applicative
 
-pureAttrProperty :: Desc -> (Attr -> Attr) -> Property 
+pureAttrProperty :: Desc -> SetAttr -> Property 
 pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
 
 hostname :: HostName -> Property
@@ -35,7 +35,7 @@ cnameFor domain mkp =
 	let p = mkp domain
 	in p { propertyAttr = propertyAttr p . addCName domain }
 
-addCName :: HostName -> Attr -> Attr
+addCName :: HostName -> SetAttr
 addCName domain d = d { _cnames = S.insert domain (_cnames d) }
 
 sshPubKey :: String -> Property

Propellor/Engine.hs

@@ -18,7 +18,7 @@ runPropellor attr a = runReaderT (runWithAttr a) attr
 mainProperties :: Attr -> [Property] -> IO ()
 mainProperties attr ps = do
 	r <- runPropellor attr $
-		ensureProperties [property "overall" $ ensureProperties ps]
+		ensureProperties [Property "overall" (ensureProperties ps) id]
 	setTitle "propellor: done"
 	hFlush stdout
 	case r of

Propellor/Property.hs

@@ -5,6 +5,7 @@ module Propellor.Property where
 import System.Directory
 import Control.Monad
 import Data.Monoid
+import Data.List
 import Control.Monad.IfElse
 import "mtl" Control.Monad.Reader
 
@@ -15,23 +16,21 @@ import Propellor.Engine
 import Utility.Monad
 import System.FilePath
 
-makeChange :: IO () -> Propellor Result
+-- Constructs a Property.
-makeChange a = liftIO a >> return MadeChange
+property :: Desc -> Propellor Result -> Property
-
+property d s = Property d s id
-noChange :: Propellor Result
-noChange = return NoChange
 
 -- | 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 propigate overall success/failure.
 propertyList :: Desc -> [Property] -> Property
-propertyList desc ps = property desc $ ensureProperties ps
+propertyList desc ps = Property desc (ensureProperties ps) (combineSetAttrs ps)
 
 -- | Combines a list of properties, resulting in one property that
 -- ensures each in turn, stopping on failure.
 combineProperties :: Desc -> [Property] -> Property
-combineProperties desc ps = property desc $ go ps NoChange
+combineProperties desc ps = Property desc (go ps NoChange) (combineSetAttrs ps)
   where
   	go [] rs = return rs
 	go (l:ls) rs = do
@@ -44,11 +43,8 @@ combineProperties desc ps = property desc $ go ps NoChange
 -- that ensures the first, and if the first succeeds, ensures the second.
 -- The property uses the description of the first property.
 before :: Property -> Property -> Property
-p1 `before` p2 = property (propertyDesc p1) $ do
+p1 `before` p2 = p2 `requires` p1
-	r <- ensureProperty p1
+	`describe` (propertyDesc p1)
-	case r of
-		FailedChange -> return FailedChange
-		_ -> ensureProperty p2
 
 -- | Makes a perhaps non-idempotent Property be idempotent by using a flag
 -- file to indicate whether it has run before.
@@ -57,13 +53,13 @@ flagFile :: Property -> FilePath -> Property
 flagFile p = flagFile' p . return
 
 flagFile' :: Property -> IO FilePath -> Property
-flagFile' p getflagfile = property (propertyDesc p) $ do
+flagFile' p getflagfile = adjustProperty p $ \satisfy -> do
 	flagfile <- liftIO getflagfile
-	go flagfile =<< liftIO (doesFileExist flagfile)
+	go satisfy flagfile =<< liftIO (doesFileExist flagfile)
   where
-	go _ True = return NoChange
+	go _ _ True = return NoChange
-	go flagfile False = do
+	go satisfy flagfile False = do
-		r <- ensureProperty p
+		r <- satisfy
 		when (r == MadeChange) $ liftIO $ 
 			unlessM (doesFileExist flagfile) $ do
 				createDirectoryIfMissing True (takeDirectory flagfile)
@@ -73,22 +69,24 @@ flagFile' p getflagfile = property (propertyDesc p) $ do
 --- | Whenever a change has to be made for a Property, causes a hook
 -- Property to also be run, but not otherwise.
 onChange :: Property -> Property -> Property
-p `onChange` hook = property (propertyDesc p) $ do
+p `onChange` hook = Property (propertyDesc p) satisfy (combineSetAttr p hook)
-	r <- ensureProperty p
+  where
-	case r of
+	satisfy = do
-		MadeChange -> do
+		r <- ensureProperty p
-			r' <- ensureProperty hook
+		case r of
-			return $ r <> r'
+			MadeChange -> do
-		_ -> return r
+				r' <- ensureProperty hook
+				return $ r <> r'
+			_ -> return r
 
 (==>) :: Desc -> Property -> Property
 (==>) = flip describe
 infixl 1 ==>
 
--- | Makes a Property only be performed when a test succeeds.
+-- | Makes a Property only need to do anything when a test succeeds.
 check :: IO Bool -> Property -> Property
-check c p = property (propertyDesc p) $ ifM (liftIO c)
+check c p = adjustProperty p $ \satisfy -> ifM (liftIO c)
-	( ensureProperty p
+	( satisfy
 	, return NoChange
 	)
 
@@ -99,8 +97,8 @@ check c p = property (propertyDesc p) $ ifM (liftIO c)
 -- to be made as it is to just idempotently assure the property is
 -- satisfied. For example, chmodding a file.
 trivial :: Property -> Property
-trivial p = property (propertyDesc p) $ do
+trivial p = adjustProperty p $ \satisfy -> do
-	r <- ensureProperty p
+	r <- satisfy
 	if r == MadeChange
 		then return NoChange
 		else return r
@@ -133,16 +131,33 @@ host hn = Host [] (\_ -> newAttr hn)
 
 -- | Adds a property to a Host
 --
--- Can add Properties, RevertableProperties, and AttrProperties
+-- Can add Properties and RevertableProperties
 (&) :: IsProp p => Host -> p -> Host
-(Host ps as) & p = Host (ps ++ [toProp p]) (getAttr p . as)
+(Host ps as) & p = Host (ps ++ [toProp p]) (setAttr p . as)
 
 infixl 1 &
 
 -- | Adds a property to the Host in reverted form.
 (!) :: Host -> RevertableProperty -> Host
-(Host ps as) ! p = Host (ps ++ [toProp q]) (getAttr q . as)
+(Host ps as) ! p = Host (ps ++ [toProp q]) (setAttr q . as)
   where
 	q = revert p
 
 infixl 1 !
+
+-- Changes the action that is performed to satisfy a property. 
+adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
+adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
+
+-- Combines the Attr settings of two properties.
+combineSetAttr :: (IsProp p, IsProp q) => p -> q -> SetAttr
+combineSetAttr p q = setAttr p . setAttr q
+
+combineSetAttrs :: IsProp p => [p] -> SetAttr
+combineSetAttrs = foldl' (.) id . map setAttr
+
+makeChange :: IO () -> Propellor Result
+makeChange a = liftIO a >> return MadeChange
+
+noChange :: Propellor Result
+noChange = return NoChange

Propellor/Property/Apt.hs

@@ -157,8 +157,8 @@ buildDepIn dir = go `requires` installedMin ["devscripts", "equivs"]
 -- | Package installation may fail becuse the archive has changed.
 -- Run an update in that case and retry.
 robustly :: Property -> Property
-robustly p = property (propertyDesc p) $ do
+robustly p = adjustProperty p $ \satisfy -> do
-	r <- ensureProperty p
+	r <- satisfy
 	if r == FailedChange
 		then ensureProperty $ p `requires` update
 		else return r

Propellor/Property/Cmd.hs

@@ -12,6 +12,7 @@ import Data.List
 import "mtl" Control.Monad.Reader
 
 import Propellor.Types
+import Propellor.Property
 import Utility.Monad
 import Utility.SafeCommand
 import Utility.Env

Propellor/Property/Scheduled.hs

@@ -19,13 +19,13 @@ import qualified Data.Map as M
 -- This uses the description of the Property to keep track of when it was
 -- last run.
 period :: Property -> Recurrance -> Property
-period prop recurrance = property desc $ do
+period prop recurrance = flip describe desc $ adjustProperty prop $ \satisfy -> do
 	lasttime <- liftIO $ getLastChecked (propertyDesc prop)
 	nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
 	t <- liftIO localNow
 	if Just t >= nexttime
 		then do
-			r <- ensureProperty prop
+			r <- satisfy
 			liftIO $ setLastChecked t (propertyDesc prop)
 			return r
 		else noChange

Propellor/Types.hs

@@ -8,12 +8,11 @@ module Propellor.Types
 	, HostName
 	, Propellor(..)
 	, Property(..)
-	, property
 	, RevertableProperty(..)
 	, IsProp
 	, describe
 	, toProp
-	, getAttr
+	, setAttr
 	, requires
 	, Desc
 	, Result(..)
@@ -34,7 +33,7 @@ import "MonadCatchIO-transformers" Control.Monad.CatchIO
 import Propellor.Types.Attr
 import Propellor.Types.OS
 
-data Host = Host [Property] (Attr -> Attr)
+data Host = Host [Property] SetAttr
 
 -- | Propellor's monad provides read-only access to attributes of the
 -- system.
@@ -55,13 +54,10 @@ data Property = Property
 	{ propertyDesc :: Desc
 	, propertySatisfy :: Propellor Result
 	-- ^ must be idempotent; may run repeatedly
-	, propertyAttr :: Attr -> Attr
+	, propertyAttr :: SetAttr
 	-- ^ a property can affect the overall Attr
 	}
 
-property :: Desc -> Propellor Result -> Property
-property d s = Property d s id
-
 -- | A property that can be reverted.
 data RevertableProperty = RevertableProperty Property Property
 
@@ -72,12 +68,12 @@ class IsProp p where
 	-- | Indicates that the first property can only be satisfied
 	-- once the second one is.
 	requires :: p -> Property -> p
-	getAttr :: p -> (Attr -> Attr)
+	setAttr :: p -> SetAttr
 
 instance IsProp Property where
 	describe p d = p { propertyDesc = d }
 	toProp p = p
-	getAttr = propertyAttr
+	setAttr = propertyAttr
 	x `requires` y = Property (propertyDesc x) satisfy attr
 	  where
 	  	attr = propertyAttr x . propertyAttr y
@@ -95,8 +91,8 @@ instance IsProp RevertableProperty where
 	toProp (RevertableProperty p1 _) = p1
 	(RevertableProperty p1 p2) `requires` y =
 		RevertableProperty (p1 `requires` y) p2
-	-- | Gets the Attr of the currently active side.
+	-- | Return the SetAttr of the currently active side.
-	getAttr (RevertableProperty p1 _p2) = getAttr p1
+	setAttr (RevertableProperty p1 _p2) = setAttr p1
 
 type Desc = String
 

Propellor/Types/Attr.hs

@@ -42,3 +42,5 @@ newAttr hn = Attr hn S.empty Nothing Nothing Nothing []
 
 type HostName = String
 type Domain = String
+
+type SetAttr = Attr -> Attr

TODO

@@ -15,7 +15,5 @@
 * There is no way for a property of a docker container to require
   some property be met outside the container. For example, some servers
   need ntp installed for a good date source.
-* Attributes can only be set in the top level property list for a Host.
+* Docking a container in a host should add to the host any cnames that
-  If an attribute is set inside a propertyList, it won't propigate out.
+  are assigned to the container.
-  Fix this. Probably the fix involves combining AttrProperty into Property.
-  Then propertyList can gather the attributes from its list.

debian/changelog

@@ -1,7 +1,10 @@
 propellor (0.4.0) UNRELEASED; urgency=medium
 
   * Constructor of Property has changed (use property function instead).
-  * Run all cron jobs under chronic from moreutils to avoid unnecessary mails.
+  * All Property combinators now combine together their Attr settings.
+    So Attr settings can be made inside a propertyList, for example.
+  * Run all cron jobs under chronic from moreutils to avoid unnecessary
+    mails.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 17 Apr 2014 21:00:43 -0400