{-# 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 (MetaTypes untightened)
-> UncheckedProperty (MetaTypes tightened)
tightenTargets (UncheckedProperty Property (MetaTypes untightened)
p) = Property (MetaTypes tightened)
-> UncheckedProperty (MetaTypes tightened)
forall i. Property i -> UncheckedProperty i
UncheckedProperty (Property (MetaTypes untightened) -> Property (MetaTypes tightened)
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets Property (MetaTypes untightened)
p)
unchecked :: Property i -> UncheckedProperty i
unchecked :: Property i -> UncheckedProperty i
unchecked = Property i -> UncheckedProperty i
forall i. Property i -> UncheckedProperty i
UncheckedProperty
checkResult
:: (Checkable p i, LiftPropellor m)
=> m a
-> (a -> m Result)
-> p i
-> Property i
checkResult :: m a -> (a -> m Result) -> p i -> Property i
checkResult m a
precheck a -> m Result
postcheck p i
p = Property i -> (Propellor Result -> Propellor Result) -> Property i
forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy (p i -> Property i
forall (p :: * -> *) i. Checkable p i => p i -> Property i
checkedProp p i
p) ((Propellor Result -> Propellor Result) -> Property i)
-> (Propellor Result -> Propellor Result) -> Property i
forall a b. (a -> b) -> a -> b
$ \Propellor Result
satisfy -> do
a
a <- m a -> Propellor a
forall (m :: * -> *) a. LiftPropellor m => m a -> Propellor a
liftPropellor m a
precheck
Result
r <- Propellor Result -> Propellor Result
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
m Result -> m Result
catchPropellor Propellor Result
satisfy
Result
r' <- m Result -> Propellor Result
forall (m :: * -> *) a. LiftPropellor m => m a -> Propellor a
liftPropellor (m Result -> Propellor Result) -> m Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$ a -> m Result
postcheck a
a
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result
r Result -> Result -> Result
forall a. Semigroup a => a -> a -> a
<> Result
r')
check :: (Checkable p i, LiftPropellor m) => m Bool -> p i -> Property i
check :: m Bool -> p i -> Property i
check m Bool
test p i
p = Property i -> (Propellor Result -> Propellor Result) -> Property i
forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy (p i -> Property i
forall (p :: * -> *) i. Checkable p i => p i -> Property i
preCheckedProp p i
p) ((Propellor Result -> Propellor Result) -> Property i)
-> (Propellor Result -> Propellor Result) -> Property i
forall a b. (a -> b) -> a -> b
$ \Propellor Result
satisfy ->
Propellor Bool
-> (Propellor Result, Propellor Result) -> Propellor Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (m Bool -> Propellor Bool
forall (m :: * -> *) a. LiftPropellor m => m a -> Propellor a
liftPropellor m Bool
test)
( Propellor Result
satisfy
, Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
)
class Checkable p i where
checkedProp :: p i -> Property i
preCheckedProp :: p i -> Property i
instance Checkable Property i where
checkedProp :: Property i -> Property i
checkedProp = Property i -> Property i
forall a. a -> a
id
preCheckedProp :: Property i -> Property i
preCheckedProp = Property i -> Property i
forall a. a -> a
id
instance Checkable UncheckedProperty i where
checkedProp :: UncheckedProperty i -> Property i
checkedProp (UncheckedProperty Property i
p) = Property i
p
preCheckedProp :: UncheckedProperty i -> Property i
preCheckedProp (UncheckedProperty Property i
p) = Property i
p Property i -> Result -> Property i
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
assume :: Checkable p i => p i -> Result -> Property i
assume :: p i -> Result -> Property i
assume p i
p Result
result = Property i -> (Propellor Result -> Propellor Result) -> Property i
forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy (p i -> Property i
forall (p :: * -> *) i. Checkable p i => p i -> Property i
checkedProp p i
p) ((Propellor Result -> Propellor Result) -> Property i)
-> (Propellor Result -> Propellor Result) -> Property i
forall a b. (a -> b) -> a -> b
$ \Propellor Result
satisfy -> do
Result
r <- Propellor Result
satisfy
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result
r Result -> Result -> Result
forall a. Semigroup a => a -> a -> a
<> Result
result)