fix desc for combineProperties

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 }

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

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"]

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

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)
 	]

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