From b70422c8cfb082687eaa6d4051c27d430c24f36b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 1 Apr 2014 17:32:37 -0400
Subject: [PATCH] fix desc for combineProperties

---
 Propellor/Property.hs                              | 9 +++------
 Propellor/Property/Docker.hs                       | 2 +-
 Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 2 +-
 Propellor/Property/SiteSpecific/GitHome.hs         | 2 +-
 Propellor/Property/Ssh.hs                          | 2 +-
 config.hs                                          | 2 +-
 6 files changed, 8 insertions(+), 11 deletions(-)

diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index a1b871c..2764d61 100644
--- a/Propellor/Property.hs
+++ b/Propellor/Property.hs
@@ -23,8 +23,8 @@ propertyList desc ps = Property desc $ ensureProperties' ps
 
 -- | Combines a list of properties, resulting in one property that
 -- ensures each in turn, stopping on failure.
-combineProperties :: [Property] -> Property
-combineProperties ps = Property desc $ go ps NoChange
+combineProperties :: Desc -> [Property] -> Property
+combineProperties desc ps = Property desc $ go ps NoChange
   where
   	go [] rs = return rs
 	go (l:ls) rs = do
@@ -32,9 +32,6 @@ combineProperties ps = Property desc $ go ps NoChange
 		case r of
 			FailedChange -> return FailedChange
 			_ -> go ls (r <> rs)
-	desc = case ps of
-		(p:_) -> propertyDesc p
-		_ -> "(empty)"
 
 -- | Makes a perhaps non-idempotent Property be idempotent by using a flag
 -- file to indicate whether it has run before.
@@ -64,7 +61,7 @@ property `onChange` hook = Property (propertyDesc property) $ do
 -- | Indicates that the first property can only be satisfied once
 -- the second is.
 requires :: Property -> Property -> Property
-x `requires` y = combineProperties [y, x] `describe` propertyDesc x
+x `requires` y = combineProperties (propertyDesc x) [y, x]
 
 describe :: Property -> Desc -> Property
 describe p d = p { propertyDesc = d }
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index a8f302e..a16784f 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -266,7 +266,7 @@ inside1 :: Property -> Containerized Property
 inside1 = Containerized []
 
 inside :: [Property] -> Containerized Property
-inside = Containerized [] . combineProperties
+inside = Containerized [] . combineProperties "provision"
 
 -- | Set custom dns server for container.
 dns :: String -> Containerized Property
diff --git a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 34e987f..48e1097 100644
--- a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -14,7 +14,7 @@ builddir :: FilePath
 builddir = "gitbuilder"
 
 builder :: Arch -> CronTimes -> Property
-builder arch crontimes = combineProperties
+builder arch crontimes = combineProperties "gitannexbuilder"
 	[ Apt.stdSourcesList Unstable
 	, Apt.buildDep ["git-annex"]
 	, Apt.installed ["git", "rsync", "liblockfile-simple-perl", "cabal"]
diff --git a/Propellor/Property/SiteSpecific/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs
index b3a8def..38e0cb9 100644
--- a/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/Propellor/Property/SiteSpecific/GitHome.hs
@@ -14,7 +14,7 @@ installedFor user = check (not <$> hasGitDir user) $
  	go Nothing = noChange
 	go (Just home) = do
 		let tmpdir = home </> "githome"
-		ensureProperty $ combineProperties
+		ensureProperty $ combineProperties "githome setup"
 			[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
 			, Property "moveout" $ makeChange $ void $
 				moveout tmpdir home
diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs
index 2c2c54c..28fe45f 100644
--- a/Propellor/Property/Ssh.hs
+++ b/Propellor/Property/Ssh.hs
@@ -13,7 +13,7 @@ sshdConfig :: FilePath
 sshdConfig = "/etc/ssh/sshd_config"
 
 setSshdConfig :: String -> Bool -> Property
-setSshdConfig setting allowed = combineProperties
+setSshdConfig setting allowed = combineProperties "sshd config"
 	[ sshdConfig `File.lacksLine` (sshline $ not allowed)
 	, sshdConfig `File.containsLine` (sshline allowed)
 	]
diff --git a/config.hs b/config.hs
index b75ef8a..f61a01d 100644
--- a/config.hs
+++ b/config.hs
@@ -109,7 +109,7 @@ cleanCloudAtCost hostname = propertyList "cloudatcost cleanup"
 		"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
 		`onChange` cmdProperty "update-grub" []
 		`onChange` cmdProperty "update-initramfs" ["-u"]
-	, "nuked cloudatcost cruft" ==> combineProperties
+	, combineProperties "nuked cloudatcost cruft"
 		[ File.notPresent "/etc/rc.local"
 		, File.notPresent "/etc/init.d/S97-setup.sh"
 		, User.nuked "user" User.YesReallyDeleteHome