property lists

HostProp.hs

@@ -12,11 +12,11 @@ main :: IO ()
 main = ensureProperties . getProperties =<< getHostName
 
 {- This is where the system's HostName, either as returned by uname
- - or one specified on the command line is converted into a list of
+ - or one specified on the command line, is converted into a list of
  - Properties for that system. -}
 getProperties :: HostName -> [Property]
-getProperties "clam.kitenet.net" = concat
-	[ cleanCloudAtCost
+getProperties hostname@"clam.kitenet.net" =
+	[ cleanCloudAtCost hostname
 	, standardSystem Apt.Unstable
 	-- Clam is a tor bridge.
 	, Tor.isBridge
@@ -30,18 +30,9 @@ getProperties "clam.kitenet.net" = concat
 --getProperties "foo" =
 getProperties h = error $ "Unknown host: " ++ h ++ " (perhaps you should specify the real hostname on the command line?)"
 
--- Clean up the system as installed by cloudatcost.com
-cleanCloudAtCost :: [Property]
-cleanCloudAtCost = 
-	[ User.nuked "user"
-	, Apt.removed ["exim4"] `onChange` Apt.autoRemove
-	, Hostname.set "clam.kitenet.net"
-	, Ssh.uniqueHostKeys
-	]
-
 -- This is my standard system setup
-standardSystem :: Suite -> [Property]
-standardSystem suite = 
+standardSystem :: Apt.Suite -> Property
+standardSystem suite = propertyList "standard system"
 	[ Apt.stdSourcesList suite `onChange` Apt.upgrade
 	, Apt.installed ["etckeeper"]
 	, Apt.installed ["ssh"]
@@ -59,3 +50,12 @@ standardSystem suite =
 	, lineInFile "/etc/sudoers" "joey ALL=(ALL:ALL) NOPASSWD:ALL"
 	, GitHome.installedFor "joey"
 	]
+
+-- Clean up a system as installed by cloudatcost.com
+cleanCloudAtCost :: HostName -> Property
+cleanCloudAtCost hostname = propertyList "cloudatcost cleanup"
+	[ User.nuked "user"
+	, Apt.removed ["exim4"] `onChange` Apt.autoRemove
+	, Hostname.set hostname
+	, Ssh.uniqueHostKeys
+	]

Property.hs

@@ -38,6 +38,16 @@ propertyDesc (FileProperty d _ _) = d
 propertyDesc (CmdProperty d _ _ _) = d
 propertyDesc (IOProperty d _) = d
 
+{- Combines a list of properties, resulting in a single property
+ - that when run will run each property in the list in turn,
+ - and print out the description of each as it's run. Does not stop
+ - on failure; does propigate overall success/failure.
+ -}
+propertyList :: Desc -> [Property] -> Property
+propertyList desc ps = IOProperty desc $ ensureProperties' ps
+
+{- Combines a list of properties, resulting in one property that
+ - ensures each in turn, stopping on failure. -}
 combineProperties :: Desc -> [Property] -> Property
 combineProperties desc ps = IOProperty desc $ go ps NoChange
   where
@@ -71,10 +81,13 @@ ensureProperty' (IOProperty _ a) = a
 
 ensureProperties :: [Property] -> IO ()
 ensureProperties ps = do
-	r <- ensure ps NoChange
+	r <- ensureProperties' ps
 	case r of
 		FailedChange -> exitWith (ExitFailure 1)
 		_ -> exitWith ExitSuccess
+
+ensureProperties' :: [Property] -> IO Result
+ensureProperties' ps = ensure ps NoChange
   where
 	ensure [] rs = return rs
 	ensure (l:ls) rs = do

Property/Reboot.hs

@@ -1,7 +1,6 @@
 module Property.Reboot where
 
 import Property
-import Utility.SafeCommand
 
-now -> Property
+now :: Property
 now = cmdProperty "reboot" []