{-# 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

-- | 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 make a change,
-- and `FailedChange` is still an error.
data UncheckedProperty i = UncheckedProperty (Property i)

instance TightenTargets UncheckedProperty where
	tightenTargets :: forall (untightened :: [MetaType]) (tightened :: [MetaType]).
(TightenTargetsAllowed untightened tightened, SingI tightened) =>
UncheckedProperty (MetaTypes untightened)
-> UncheckedProperty (MetaTypes tightened)
tightenTargets (UncheckedProperty Property (MetaTypes untightened)
p) = forall i. Property i -> UncheckedProperty i
UncheckedProperty (forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets Property (MetaTypes untightened)
p)

-- | Use to indicate that a Property is unchecked.
unchecked :: Property i -> UncheckedProperty i
unchecked :: forall i. Property i -> UncheckedProperty i
unchecked = forall i. Property i -> UncheckedProperty i
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, LiftPropellor m)
	=> m a
	-- ^ Run before ensuring the property.
	-> (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 :: forall (p :: * -> *) i (m :: * -> *) a.
(Checkable p i, LiftPropellor m) =>
m a -> (a -> m Result) -> p i -> Property i
checkResult m a
precheck a -> m Result
postcheck p i
p = forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy (forall (p :: * -> *) i. Checkable p i => p i -> Property i
checkedProp p i
p) forall a b. (a -> b) -> a -> b
$ \Propellor Result
satisfy -> do
	a
a <- forall (m :: * -> *) a. LiftPropellor m => m a -> Propellor a
liftPropellor m a
precheck
	Result
r <- forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
m Result -> m Result
catchPropellor Propellor Result
satisfy
	-- Always run postcheck, even if the result is already MadeChange,
	-- as it may need to clean up after precheck.
	Result
r' <- forall (m :: * -> *) a. LiftPropellor m => m a -> Propellor a
liftPropellor forall a b. (a -> b) -> a -> b
$ a -> m Result
postcheck a
a
	forall (m :: * -> *) a. Monad m => a -> m a
return (Result
r forall a. Semigroup a => a -> a -> a
<> Result
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 :: forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check m Bool
test p i
p = forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy (forall (p :: * -> *) i. Checkable p i => p i -> Property i
preCheckedProp p i
p) forall a b. (a -> b) -> a -> b
$ \Propellor Result
satisfy ->
        forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. LiftPropellor m => m a -> Propellor a
liftPropellor m Bool
test)
                ( Propellor Result
satisfy
                , 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 = forall a. a -> a
id
	preCheckedProp :: Property i -> Property i
preCheckedProp = forall a. a -> a
id

instance Checkable UncheckedProperty i where
	checkedProp :: UncheckedProperty i -> Property i
checkedProp (UncheckedProperty Property i
p) = Property i
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 i -> Property i
preCheckedProp (UncheckedProperty Property i
p) = Property i
p forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange

-- | Sometimes it's not practical to test if a property made a change.
-- In such a case, it's often fine to say:
--
-- > someprop `assume` MadeChange
--
-- However, beware assuming `NoChange`, as that will make combinators
-- like `onChange` not work.
assume :: Checkable p i => p i -> Result -> Property i
assume :: forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
assume p i
p Result
result = forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy (forall (p :: * -> *) i. Checkable p i => p i -> Property i
checkedProp p i
p) forall a b. (a -> b) -> a -> b
$ \Propellor Result
satisfy -> do
	Result
r <- Propellor Result
satisfy
	forall (m :: * -> *) a. Monad m => a -> m a
return (Result
r forall a. Semigroup a => a -> a -> a
<> Result
result)