summaryrefslogtreecommitdiff
path: root/src/Propellor/Types/ResultCheck.hs
blob: 6c2e1453a262fc2a928e202fc7a30e45a145a614 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
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