propellor spin

(cherry picked from commit 1d02d589c7)

src/Propellor/Property.hs

@@ -121,12 +121,6 @@ doNothing = property "noop property" noChange
 withOS :: Desc -> (Maybe System -> Propellor Result) -> Property
 withOS desc a = property desc $ a =<< getOS
 
-boolProperty :: Desc -> IO Bool -> Property
-boolProperty desc a = property desc $ ifM (liftIO a)
-	( return MadeChange
-	, return FailedChange
-	)
-
 -- | Undoes the effect of a property.
 revert :: RevertableProperty -> RevertableProperty
 revert (RevertableProperty p1 p2) = RevertableProperty p2 p1

src/Propellor/Property/Cmd.hs

@@ -13,7 +13,6 @@ import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 import Propellor.Property
-import Utility.Monad
 import Utility.SafeCommand
 import Utility.Env
 
@@ -28,10 +27,7 @@ cmdProperty cmd params = cmdProperty' cmd params []
 cmdProperty' :: String -> [String] -> [(String, String)] -> Property
 cmdProperty' cmd params env = property desc $ liftIO $ do
 	env' <- addEntries env <$> getEnvironment
-	ifM (boolSystemEnv cmd (map Param params) (Just env'))
+	toResult <$> boolSystemEnv cmd (map Param params) (Just env')
-		( return MadeChange
-		, return FailedChange
-		)
   where
 	desc = unwords $ cmd : params
 

src/Propellor/Property/Docker.hs

@@ -379,7 +379,8 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
 			createDirectoryIfMissing True (takeDirectory $ identFile cid)
 		shim <- liftIO $ Shim.setup (localdir </> "propellor") Nothing (localdir </> shimdir cid)
 		liftIO $ writeFile (identFile cid) (show ident)
-		ensureProperty $ boolProperty "run" $ runContainer img
+		ensureProperty $ property "run" $ liftIO $
+			toResult <$> runContainer img
 				(runps ++ ["-i", "-d", "-t"])
 				[shim, "--continue", show (DockerInit (fromContainerId cid))]
 
@@ -466,7 +467,7 @@ stoppedContainer :: ContainerId -> Property
 stoppedContainer cid = containerDesc cid $ property desc $ 
 	ifM (liftIO $ elem cid <$> listContainers RunningContainers)
 		( liftIO cleanup `after` ensureProperty 
-			(boolProperty desc $ stopContainer cid)
+			(property desc $ liftIO $ toResult <$> stopContainer cid)
 		, return NoChange
 		)
   where

src/Propellor/Property/Firewall.hs

@@ -33,8 +33,7 @@ rule c t rs = property ("firewall rule: " <> show r) addIpTable
 		exist <- boolSystem "iptables" (chk args)
 		if exist
 			then return NoChange
-			else ifM (boolSystem "iptables" (add args))
+			else toResult <$> boolSystem "iptables" (add args)
-				( return MadeChange , return FailedChange)
 	add params = (Param "-A") : params
 	chk params = (Param "-C") : params
 

src/Propellor/Types.hs

@@ -14,6 +14,7 @@ module Propellor.Types
 	, requires
 	, Desc
 	, Result(..)
+	, ToResult(..)
 	, ActionResult(..)
 	, CmdLine(..)
 	, PrivDataField(..)
@@ -131,6 +132,13 @@ instance Monoid Result where
 	mappend _ MadeChange = MadeChange
 	mappend NoChange NoChange = NoChange
 
+class ToResult t where
+	toResult :: t -> Result
+
+instance ToResult Bool where
+	toResult False = FailedChange
+	toResult True = MadeChange
+
 -- | Results of actions, with color.
 class ActionResult a where
 	getActionResult :: a -> (String, ColorIntensity, Color)