summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2014-05-31 17:22:35 -0400
committerJoey Hess2014-05-31 17:22:35 -0400
commitc742c2eb1b7141fbe0628870e899d3461a88686a (patch)
tree517abf211851134fb11150393d3817165a1c7a67 /src
parent6383d8c38893c160382eb9bf69e0315c5e87269e (diff)
propellor spin
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Attr.hs13
-rw-r--r--src/Propellor/Property.hs6
-rw-r--r--src/Propellor/Property/Docker.hs9
-rw-r--r--src/Propellor/Types.hs10
4 files changed, 19 insertions, 19 deletions
diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs
index e2b64bf0..6bc4fcf1 100644
--- a/src/Propellor/Attr.hs
+++ b/src/Propellor/Attr.hs
@@ -83,22 +83,17 @@ sshPubKey k = pureAttrProperty ("ssh pubkey known") $
getSshPubKey :: Propellor (Maybe String)
getSshPubKey = asks _sshPubKey
-hostnameless :: Attr
-hostnameless = newAttr (error "hostname Attr not specified")
-
hostAttr :: Host -> Attr
-hostAttr (Host _ mkattrs) = mkattrs hostnameless
+hostAttr (Host hn _ mkattrs) = mkattrs (newAttr hn)
hostProperties :: Host -> [Property]
-hostProperties (Host ps _) = ps
+hostProperties (Host _ ps _) = ps
hostMap :: [Host] -> M.Map HostName Host
-hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l
+hostMap l = M.fromList $ zip (map _hostName l) l
hostAttrMap :: [Host] -> M.Map HostName Attr
-hostAttrMap l = M.fromList $ zip (map _hostname attrs) attrs
- where
- attrs = map hostAttr l
+hostAttrMap l = M.fromList $ zip (map _hostName l) (map hostAttr l)
findHost :: [Host] -> HostName -> Maybe Host
findHost l hn = M.lookup hn (hostMap l)
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 0728932e..1f602624 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -130,19 +130,19 @@ revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
-- > ! oldproperty
-- > & otherproperty
host :: HostName -> Host
-host hn = Host [] (\_ -> newAttr hn)
+host hn = Host hn [] (\_ -> newAttr hn)
-- | Adds a property to a Host
--
-- Can add Properties and RevertableProperties
(&) :: IsProp p => Host -> p -> Host
-(Host ps as) & p = Host (ps ++ [toProp p]) (setAttr p . as)
+(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (setAttr p . as)
infixl 1 &
-- | Adds a property to the Host in reverted form.
(!) :: Host -> RevertableProperty -> Host
-(Host ps as) ! p = Host (ps ++ [toProp q]) (setAttr q . as)
+(Host hn ps as) ! p = Host hn (ps ++ [toProp q]) (setAttr q . as)
where
q = revert p
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 465fe0b4..c1340ad9 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -46,9 +46,10 @@ type ContainerName = String
-- > & Apt.installed {"apache2"]
-- > & ...
container :: ContainerName -> Image -> Host
-container cn image = Host [] (\_ -> attr)
+container cn image = Host hn [] (\_ -> attr)
where
- attr = (newAttr (cn2hn cn)) { _dockerImage = Just image }
+ attr = (newAttr hn) { _dockerImage = Just image }
+ hn = cn2hn cn
cn2hn :: ContainerName -> HostName
cn2hn cn = cn ++ ".docker"
@@ -67,7 +68,7 @@ docked
-> ContainerName
-> RevertableProperty
docked hosts cn = RevertableProperty
- (go "docked" setup)
+ ((maybe id exposeDnsAttrs mhost) (go "docked" setup))
(go "undocked" teardown)
where
go desc a = property (desc ++ " " ++ cn) $ do
@@ -95,7 +96,7 @@ docked hosts cn = RevertableProperty
]
exposeDnsAttrs :: Host -> Property -> Property
-exposeDnsAttrs (Host _ containerattr) p = combineProperties (propertyDesc p) $
+exposeDnsAttrs (Host _ _ containerattr) p = combineProperties (propertyDesc p) $
p : map addDNS (S.toList containerdns)
where
containerdns = _dns $ containerattr $ newAttr undefined
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 8a4bd3dd..e5f5c1c7 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -34,9 +34,13 @@ import Propellor.Types.Attr
import Propellor.Types.OS
import Propellor.Types.Dns
--- | Everything Propellor knows about a system: Its properties and
--- attributes.
-data Host = Host [Property] SetAttr
+-- | Everything Propellor knows about a system: Its hostname,
+-- properties and attributes.
+data Host = Host
+ { _hostName :: HostName
+ , _hostProps :: [Property]
+ , _hostAttrs :: SetAttr
+ }
-- | Propellor's monad provides read-only access to attributes of the
-- system.