summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
authorJoey Hess2014-04-01 17:32:37 -0400
committerJoey Hess2014-04-01 17:32:37 -0400
commitb70422c8cfb082687eaa6d4051c27d430c24f36b (patch)
tree6d952c4101b1531435fe896e611b544f3a9a5962 /Propellor
parenta69b0a2cc89aa3e839e8abd2e4cec7a05d8d18cf (diff)
fix desc for combineProperties
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/Property.hs9
-rw-r--r--Propellor/Property/Docker.hs2
-rw-r--r--Propellor/Property/SiteSpecific/GitAnnexBuilder.hs2
-rw-r--r--Propellor/Property/SiteSpecific/GitHome.hs2
-rw-r--r--Propellor/Property/Ssh.hs2
5 files changed, 7 insertions, 10 deletions
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index a1b871c2..2764d614 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 a8f302e5..a16784f7 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 34e987ff..48e10977 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 b3a8deff..38e0cb97 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 2c2c54c8..28fe45f6 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)
]