summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-10-23 17:25:31 -0400
committerJoey Hess2015-10-23 17:25:31 -0400
commit1cd7f557f0c89714c47855f38583073c313674f2 (patch)
treeeab23a5274f1d511d4c11fd680da97a34c5c6f85
parent3aee86abac10f1ad9d4b51c024f5f3c02cdbfc68 (diff)
generalize check
Hmm, do I really need my own type class for LiftPropellor? This seems like a general problem so I am probably reinventing the wheel.
-rw-r--r--debian/changelog2
-rw-r--r--src/Propellor/Property.hs11
-rw-r--r--src/Propellor/Types.hs10
3 files changed, 18 insertions, 5 deletions
diff --git a/debian/changelog b/debian/changelog
index 9976300e..e327e314 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -11,6 +11,8 @@ propellor (2.12.0) UNRELEASED; urgency=medium
Where before debootstrapped and bootstrapped took a System parameter,
the os property should now be added to the Chroot.
* Follow-on change to Systemd.container, which now takes a System parameter.
+ * Generalized Property.check so it can be used with Propellor actions as
+ well as IO actions.
-- Joey Hess <id@joeyh.name> Thu, 22 Oct 2015 20:24:18 -0400
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 342db1a5..95805054 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -142,11 +142,12 @@ ensureProperty :: Property NoInfo -> Propellor Result
ensureProperty = catchPropellor . propertySatisfy
-- | Makes a Property only need to do anything when a test succeeds.
-check :: IO Bool -> Property i -> Property i
-check c p = adjustPropertySatisfy p $ \satisfy -> ifM (liftIO c)
- ( satisfy
- , return NoChange
- )
+check :: (LiftPropellor m) => m Bool -> Property i -> Property i
+check c p = adjustPropertySatisfy p $ \satisfy ->
+ ifM (liftPropellor c)
+ ( satisfy
+ , return NoChange
+ )
-- | Tries the first property, but if it fails to work, instead uses
-- the second.
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index fc700df0..5904374e 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -29,6 +29,7 @@ module Propellor.Types
, CombinedType
, combineWith
, Propellor(..)
+ , LiftPropellor(..)
, EndAction(..)
, module Propellor.Types.OS
, module Propellor.Types.Dns
@@ -72,6 +73,15 @@ newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
, MonadMask
)
+class LiftPropellor m where
+ liftPropellor :: m a -> Propellor a
+
+instance LiftPropellor Propellor where
+ liftPropellor = id
+
+instance LiftPropellor IO where
+ liftPropellor = liftIO
+
instance Monoid (Propellor Result) where
mempty = return NoChange
-- | The second action is only run if the first action does not fail.