summaryrefslogtreecommitdiff
path: root/Propellor/Property.hs
blob: ccc060ff578a2658318dd8692aaa4813c10b7b32 (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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
{-# LANGUAGE PackageImports #-}

module Propellor.Property where

import System.Directory
import Control.Monad
import Data.Monoid
import Control.Monad.IfElse
import "mtl" Control.Monad.Reader

import Propellor.Types
import Propellor.Types.Attr
import Propellor.Attr
import Propellor.Engine
import Utility.Monad

makeChange :: IO () -> Propellor Result
makeChange a = liftIO a >> return MadeChange

noChange :: Propellor 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)

-- | Combines together two properties, resulting in one property
-- that ensures the first, and if the first succeeds, ensures the second.
-- The property uses the description of the first property.
before :: Property -> Property -> Property
p1 `before` p2 = Property (propertyDesc p1) $ do
	r <- ensureProperty p1
	case r of
		FailedChange -> return FailedChange
		_ -> ensureProperty p2

-- | 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 =<< liftIO (doesFileExist flagfile)
  where
	go True = return NoChange
	go False = do
		r <- ensureProperty property
		when (r == MadeChange) $ liftIO $ 
			unlessM (doesFileExist flagfile) $
				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

(==>) :: 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 (liftIO c)
	( ensureProperty property
	, return NoChange
	)

boolProperty :: Desc -> IO Bool -> Property
boolProperty desc a = Property desc $ ifM (liftIO a)
	( return MadeChange
	, return FailedChange
	)

-- | Undoes the effect of a property.
revert :: RevertableProperty -> RevertableProperty
revert (RevertableProperty p1 p2) = RevertableProperty p2 p1

-- | Starts accumulating the properties of a Host.
--
-- > host "example.com"
-- > 	& someproperty
-- > 	! oldproperty
-- > 	& otherproperty
host :: HostName -> Host
host hn = Host [] (\_ -> newAttr hn)

-- | Adds a property to a Host
-- Can add Properties, RevertableProperties, and AttrProperties
(&) :: IsProp p => Host -> p -> Host
(Host ps as) & p = Host (ps ++ [toProp p]) (as . getAttr p)

infixl 1 &

-- | Adds a property to the Host in reverted form.
(!) :: Host -> RevertableProperty -> Host
(Host ps as) ! p = Host (ps ++ [toProp q]) (as . getAttr q)
  where
	q = revert p

infixl 1 !

-- | Makes a propertyList of a set of properties, using the same syntax
-- used by `host`.
--
-- > template "my template" $ props
-- 	& someproperty
-- 	! oldproperty
--
-- Note that none of the properties can define Attrs, because
-- they will not propigate out to the host that this is added to.
--
-- Unfortunately, this is not currently enforced at the type level, so
-- attempting to set an Attr in here will be run time error.
template :: Desc -> Host -> Property
template desc h@(Host ps _)
	| hostAttr h == hostAttr props = propertyList desc ps
	| otherwise = error $ desc ++ ": template contains Attr"

props :: Host
props = Host [] (\_ -> hostnameless)