blob: 832faf9c5bc08d9d11f8d090eb92aca5e5d9d27c (
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
|
{-# LANGUAGE DataKinds, TypeFamilies #-}
module Propellor.Container where
import Propellor.Types
import Propellor.Types.MetaTypes
import Propellor.Types.Info
import Propellor.PrivData
class IsContainer c where
containerProperties :: c -> [ChildProperty]
containerInfo :: c -> Info
instance IsContainer Host where
containerProperties = hostProperties
containerInfo = hostInfo
-- | Adjust the provided Property, adding to its
-- propertyChidren the properties of the provided container.
--
-- The Info of the propertyChildren is adjusted to only include
-- info that should be propagated out to the Property.
--
-- Any PrivInfo that uses HostContext is adjusted to use the name
-- of the container as its context.
propagateContainer
::
-- Since the children being added probably have info,
-- require the Property's metatypes to have info.
( IncludesInfo metatypes ~ 'True
, IsContainer c
)
=> String
-> c
-> Property metatypes
-> Property metatypes
propagateContainer containername c prop = prop
`addChildren` map convert (containerProperties c)
where
convert p =
let n = property (getDesc p) (getSatisfy p) :: Property UnixLike
n' = n
`addInfoProperty` mapInfo (forceHostContext containername)
(propagatableInfo (getInfo p))
`addChildren` map convert (getChildren p)
in toChildProperty n'
|
