summaryrefslogtreecommitdiff
path: root/src/Propellor/Types/Core.hs
blob: 88c749b360860ddea5429ee1f9d38602863a8a21 (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
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}

module Propellor.Types.Core where

import Propellor.Types.Info
import Propellor.Types.OS
import Propellor.Types.Result

import Data.Monoid
import qualified Data.Semigroup as Sem
import "mtl" Control.Monad.RWS.Strict
import Control.Monad.Catch
import Control.Applicative
import Prelude

-- | Everything Propellor knows about a system: Its hostname,
-- properties and their collected info.
data Host = Host
	{ hostName :: HostName
	, hostProperties :: [ChildProperty]
	, hostInfo :: Info
	}
	deriving (Show, Typeable)

-- | Propellor's monad provides read-only access to info about the host
-- it's running on, and a writer to accumulate EndActions.
newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
	deriving
		( Monad
		, Functor
		, Applicative
		, MonadReader Host
		, MonadWriter [EndAction]
		, MonadIO
		, MonadCatch
		, MonadThrow
		, MonadMask
		)

class LiftPropellor m where
	liftPropellor :: m a -> Propellor a

instance LiftPropellor Propellor where
	liftPropellor = id

instance LiftPropellor IO where
	liftPropellor = liftIO

-- | When two actions are appended together, the second action
-- is only run if the first action does not fail.
instance Sem.Semigroup (Propellor Result) where
	x <> y = do
		rx <- x
		case rx of
			FailedChange -> return FailedChange
			_ -> do
				ry <- y
				return (rx <> ry)
	
instance Monoid (Propellor Result) where
	mempty = return NoChange
	mappend = (Sem.<>)

-- | An action that Propellor runs at the end, after trying to satisfy all
-- properties. It's passed the combined Result of the entire Propellor run.
data EndAction = EndAction Desc (Result -> Propellor Result)

type Desc = String

-- | Props is a combination of a list of properties, with their combined 
-- metatypes.
data Props metatypes = Props [ChildProperty]

-- | Since there are many different types of Properties, they cannot be put
-- into a list. The simplified ChildProperty can be put into a list.
data ChildProperty = ChildProperty Desc (Maybe (Propellor Result)) Info [ChildProperty]
  
instance Show ChildProperty where
	show p = "property " ++ show (getDesc p)

class IsProp p where
	setDesc :: p -> Desc -> p
	getDesc :: p -> Desc
	getChildren :: p -> [ChildProperty]
	addChildren :: p -> [ChildProperty] -> p
	-- | Gets the info of the property, combined with all info
	-- of all children properties.
	getInfoRecursive :: p -> Info
	-- | Info, not including info from children.
	getInfo :: p -> Info
	-- | Gets a ChildProperty representing the Property.
	-- You should not normally need to use this.
	toChildProperty :: p -> ChildProperty
	-- | Gets the action that can be run to satisfy a Property.
	-- You should never run this action directly. Use
	-- 'Propellor.EnsureProperty.ensureProperty` instead.
	getSatisfy :: p -> Maybe (Propellor Result)

instance IsProp ChildProperty where
	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
	getDesc (ChildProperty d _ _ _) = d
	getChildren (ChildProperty _ _ _ c) = c
	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
	getInfoRecursive (ChildProperty _ _ i c) =
		i <> mconcat (map getInfoRecursive c)
	getInfo (ChildProperty _ _ i _) = i
	toChildProperty = id
	getSatisfy (ChildProperty _ a _ _) = a