summaryrefslogtreecommitdiff
path: root/src/Propellor/Types
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Types')
-rw-r--r--src/Propellor/Types/ResultCheck.hs29
1 files changed, 22 insertions, 7 deletions
diff --git a/src/Propellor/Types/ResultCheck.hs b/src/Propellor/Types/ResultCheck.hs
index 09fbf73b..4c6524ee 100644
--- a/src/Propellor/Types/ResultCheck.hs
+++ b/src/Propellor/Types/ResultCheck.hs
@@ -4,15 +4,16 @@ module Propellor.Types.ResultCheck (
UncheckedProperty,
unchecked,
checkResult,
+ check,
Checkable,
assume,
) where
import Propellor.Types
import Propellor.Exception
+import Utility.Monad
import Data.Monoid
-import Control.Monad.IO.Class (liftIO)
-- | This is a `Property` but its `Result` is not accurate; in particular
-- it may return `NoChange` despite having made a change.
@@ -29,30 +30,44 @@ unchecked = UncheckedProperty
-- `UncheckedProperty` to a `Property`, but can also be used to further
-- check a `Property`.
checkResult
- :: Checkable p i
- => IO a
+ :: (Checkable p i, LiftPropellor m)
+ => m a
-- ^ Run before ensuring the property.
- -> (a -> IO Result)
+ -> (a -> m Result)
-- ^ Run after ensuring the property. Return `MadeChange` if a
-- change was detected, or `NoChange` if no change was detected.
-> p i
-> Property i
checkResult precheck postcheck p = adjustPropertySatisfy (checkedProp p) $ \satisfy -> do
- a <- liftIO precheck
+ a <- liftPropellor precheck
r <- catchPropellor satisfy
-- Always run postcheck, even if the result is already MadeChange,
-- as it may need to clean up after precheck.
- r' <- liftIO $ postcheck a
+ r' <- liftPropellor $ postcheck a
return (r <> r')
-
+
+-- | Makes a `Property` or an `UncheckedProperty` only run
+-- when a test succeeds.
+check :: (Checkable p i, LiftPropellor m) => m Bool -> p i -> Property i
+check test p = adjustPropertySatisfy (preCheckedProp p) $ \satisfy ->
+ ifM (liftPropellor test)
+ ( satisfy
+ , return NoChange
+ )
+
class Checkable p i where
checkedProp :: p i -> Property i
+ preCheckedProp :: p i -> Property i
instance Checkable Property i where
checkedProp = id
+ preCheckedProp = id
instance Checkable UncheckedProperty i where
checkedProp (UncheckedProperty p) = p
+ -- Since it was pre-checked that the property needed to be run,
+ -- if the property succeeded, we can assume it made a change.
+ preCheckedProp (UncheckedProperty p) = p `assume` MadeChange
-- | Sometimes it's not practical to test if a property made a change.
-- In such a case, it's often fine to say: