blob: 2764d61498952c762d7c2eaab721aced7c34685b (
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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
module Propellor.Property where
import System.Directory
import Control.Monad
import Data.Monoid
import Propellor.Types
import Propellor.Engine
import Utility.Monad
makeChange :: IO () -> IO Result
makeChange a = a >> return MadeChange
noChange :: IO Result
noChange = return NoChange
-- | Combines a list of properties, resulting in a single property
-- that when run will run each property in the list in turn,
-- and print out the description of each as it's run. Does not stop
-- on failure; does propigate overall success/failure.
propertyList :: Desc -> [Property] -> Property
propertyList desc ps = Property desc $ ensureProperties' ps
-- | Combines a list of properties, resulting in one property that
-- ensures each in turn, stopping on failure.
combineProperties :: Desc -> [Property] -> Property
combineProperties desc ps = Property desc $ go ps NoChange
where
go [] rs = return rs
go (l:ls) rs = do
r <- ensureProperty l
case r of
FailedChange -> return FailedChange
_ -> go ls (r <> rs)
-- | Makes a perhaps non-idempotent Property be idempotent by using a flag
-- file to indicate whether it has run before.
-- Use with caution.
flagFile :: Property -> FilePath -> Property
flagFile property flagfile = Property (propertyDesc property) $
go =<< doesFileExist flagfile
where
go True = return NoChange
go False = do
r <- ensureProperty property
when (r == MadeChange) $
writeFile flagfile ""
return r
--- | Whenever a change has to be made for a Property, causes a hook
-- Property to also be run, but not otherwise.
onChange :: Property -> Property -> Property
property `onChange` hook = Property (propertyDesc property) $ do
r <- ensureProperty property
case r of
MadeChange -> do
r' <- ensureProperty hook
return $ r <> r'
_ -> return r
-- | Indicates that the first property can only be satisfied once
-- the second is.
requires :: Property -> Property -> Property
x `requires` y = combineProperties (propertyDesc x) [y, x]
describe :: Property -> Desc -> Property
describe p d = p { propertyDesc = d }
(==>) :: Desc -> Property -> Property
(==>) = flip describe
infixl 1 ==>
-- | Makes a Property only be performed when a test succeeds.
check :: IO Bool -> Property -> Property
check c property = Property (propertyDesc property) $ ifM c
( ensureProperty property
, return NoChange
)
|