summaryrefslogtreecommitdiff
path: root/Propellor/Attr.hs
blob: 4bc1c2c70ca0bb34a51a83c4870d2ee83b833e98 (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
{-# LANGUAGE PackageImports #-}

module Propellor.Attr where

import Propellor.Types
import Propellor.Types.Attr

import "mtl" Control.Monad.Reader
import qualified Data.Set as S
import qualified Data.Map as M

pureAttrProperty :: Desc -> (Attr -> Attr) -> AttrProperty 
pureAttrProperty desc = AttrProperty $ Property ("has " ++ desc)
	(return NoChange)

hostname :: HostName -> AttrProperty
hostname name = pureAttrProperty ("hostname " ++ name) $
	\d -> d { _hostname = name }

getHostName :: Propellor HostName
getHostName = asks _hostname

cname :: Domain -> AttrProperty
cname domain = pureAttrProperty ("cname " ++ domain) (addCName domain)

cnameFor :: IsProp p => Domain -> (Domain -> p) -> AttrProperty
cnameFor domain mkp =
	let p = mkp domain
	in AttrProperty p (addCName domain)

addCName :: HostName -> Attr -> Attr
addCName domain d = d { _cnames = S.insert domain (_cnames d) }

hostnameless :: Attr
hostnameless = newAttr (error "hostname Attr not specified")

hostAttr :: Host -> Attr
hostAttr (Host _ mkattrs) = mkattrs hostnameless

hostProperties :: Host -> [Property]
hostProperties (Host ps _) = ps

hostMap :: [Host] -> M.Map HostName Host
hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l 

findHost :: [Host] -> HostName -> Maybe Host
findHost l hn = M.lookup hn (hostMap l)