cute describe operator

This commit is contained in:
Joey Hess 2014-03-30 16:49:59 -04:00
parent 3af4cc011e
commit 1dcaeb6f77
Failed to extract signature
2 changed files with 13 additions and 8 deletions

View File

@ -51,8 +51,8 @@ standardSystem suite = propertyList "standard system"
, User.sshAccountFor "joey" , User.sshAccountFor "joey"
, Apt.installed ["sudo"] , Apt.installed ["sudo"]
-- nopasswd because no password is set up for joey. -- nopasswd because no password is set up for joey.
, "/etc/sudoers" `File.containsLine` "joey ALL=(ALL:ALL) NOPASSWD:ALL" , "sudoer joey" ==>
`describe` "sudoer joey" "/etc/sudoers" `File.containsLine` "joey ALL=(ALL:ALL) NOPASSWD:ALL"
, GitHome.installedFor "joey" , GitHome.installedFor "joey"
-- I use postfix, or no MTA. -- I use postfix, or no MTA.
, Apt.removed ["exim4"] `onChange` Apt.autoRemove , Apt.removed ["exim4"] `onChange` Apt.autoRemove
@ -64,12 +64,13 @@ cleanCloudAtCost hostname = propertyList "cloudatcost cleanup"
[ User.nuked "user" [ User.nuked "user"
, Hostname.set hostname , Hostname.set hostname
, Ssh.uniqueHostKeys , Ssh.uniqueHostKeys
, "/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true" , "worked around grub/lvm boot bug #743126" ==>
"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
`onChange` cmdProperty "update-grub" [] `onChange` cmdProperty "update-grub" []
`onChange` cmdProperty "update-initramfs" [Param "-u"] `onChange` cmdProperty "update-initramfs" [Param "-u"]
`describe` "work around grub/lvm boot bug #743126" , "nuked cloudatcost cruft" ==>
, combineProperties combineProperties
[ File.notPresent "/etc/rc.local" [ File.notPresent "/etc/rc.local"
, File.notPresent "/etc/init.d/S97-setup.sh" , File.notPresent "/etc/init.d/S97-setup.sh"
] `describe` "nuked cloudatcost cruft" ]
] ]

View File

@ -89,6 +89,10 @@ x `requires` y = combineProperties [y, x] `describe` propertyDesc x
describe :: Property -> Desc -> Property describe :: Property -> Desc -> Property
describe p d = p { propertyDesc = d } describe p d = p { propertyDesc = d }
(==>) :: Desc -> Property -> Property
(==>) = flip describe
infixl 1 ==>
{- Makes a Property only be performed when a test succeeds. -} {- Makes a Property only be performed when a test succeeds. -}
check :: IO Bool -> Property -> Property check :: IO Bool -> Property -> Property
check c property = Property (propertyDesc property) $ ifM c check c property = Property (propertyDesc property) $ ifM c