summaryrefslogtreecommitdiff
path: root/src/Propellor/Types/ResultCheck.hs
diff options
context:
space:
mode:
authorJoey Hess2015-12-05 15:48:03 -0400
committerJoey Hess2015-12-05 15:48:03 -0400
commitb816e40e2618a8932144bceb7c7039adc5c44c11 (patch)
treed128d9578764bc9b87d728370ffd4bc811e3b4d2 /src/Propellor/Types/ResultCheck.hs
parentb15dd3010190700bc61a06b1a1d017b0500be28a (diff)
Added UncheckedProperty type, along with unchecked to indicate a Property needs its result checked, and checkResult and changesFile to check for changes.
Diffstat (limited to 'src/Propellor/Types/ResultCheck.hs')
-rw-r--r--src/Propellor/Types/ResultCheck.hs53
1 files changed, 53 insertions, 0 deletions
diff --git a/src/Propellor/Types/ResultCheck.hs b/src/Propellor/Types/ResultCheck.hs
new file mode 100644
index 00000000..6c2e1453
--- /dev/null
+++ b/src/Propellor/Types/ResultCheck.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+
+module Propellor.Types.ResultCheck (
+ UncheckedProperty,
+ unchecked,
+ checkResult,
+ Checkable,
+) where
+
+import Propellor.Types
+import Propellor.Exception
+
+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. However, when it
+-- returns `MadeChange`, it really did made a change, and `FailedChange`
+-- is still an error.
+data UncheckedProperty i = UncheckedProperty (Property i)
+
+-- | Use to indicate that a Property is unchecked.
+unchecked :: Property i -> UncheckedProperty i
+unchecked = UncheckedProperty
+
+-- | Checks the result of a property. Mostly used to convert a
+-- `UncheckedProperty` to a `Property`, but can also be used to further
+-- check a `Property`.
+checkResult
+ :: Checkable p i
+ => IO a
+ -- ^ Run before ensuring the property.
+ -> (a -> IO 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
+ 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
+ return (r <> r')
+
+class Checkable p i where
+ checkedProp :: p i -> Property i
+
+instance Checkable Property i where
+ checkedProp = id
+
+instance Checkable UncheckedProperty i where
+ checkedProp (UncheckedProperty p) = p