From b70422c8cfb082687eaa6d4051c27d430c24f36b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Apr 2014 17:32:37 -0400 Subject: 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 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) ] diff --git a/config.hs b/config.hs index b75ef8a5..f61a01df 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 -- cgit v1.2.3