{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module Propellor.Types.ResultCheck (
UncheckedProperty,
unchecked,
checkResult,
check,
Checkable,
assume,
) where
import Propellor.Types
import Propellor.Exception
import Utility.Monad
import Data.Monoid
import Prelude
data UncheckedProperty i = UncheckedProperty (Property i)
instance TightenTargets UncheckedProperty where
tightenTargets (UncheckedProperty p) = UncheckedProperty (tightenTargets p)
unchecked :: Property i -> UncheckedProperty i
unchecked = UncheckedProperty
checkResult
:: (Checkable p i, LiftPropellor m)
=> m a
-> (a -> m Result)
-> p i
-> Property i
checkResult precheck postcheck p = adjustPropertySatisfy (checkedProp p) $ \satisfy -> do
a <- liftPropellor precheck
r <- catchPropellor satisfy
r' <- liftPropellor $ postcheck a
return (r <> r')
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
preCheckedProp (UncheckedProperty p) = p `assume` MadeChange
assume :: Checkable p i => p i -> Result -> Property i
assume p result = adjustPropertySatisfy (checkedProp p) $ \satisfy -> do
r <- satisfy
return (r <> result)