summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
authorJoey Hess2014-04-01 14:20:59 -0400
committerJoey Hess2014-04-01 14:20:59 -0400
commit50f68604e1a3eabe7304bc62ab46fcdac41bfdb1 (patch)
treeaa94e6d930c6c24a5eb7b53c9f4f63019e623e42 /Propellor
parent5422a5b3764855bb1109648fb401a9b15bf2919c (diff)
improve display of docker container properties
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/Property/Docker.hs19
1 files changed, 11 insertions, 8 deletions
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index 784a34b9..354d67cc 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -72,14 +72,17 @@ containerProperties
-> (HostName -> Maybe [Property])
containerProperties findcontainer = \h -> case toContainerId h of
Nothing -> Nothing
- Just (ContainerId hn cn) ->
+ Just cid@(ContainerId hn cn) ->
case findcontainer hn cn of
Nothing -> Nothing
Just (Container _ cprops) ->
- Just $ fromContainerized cprops
+ Just $ map (containerDesc cid) $
+ fromContainerized cprops
-containerDesc :: ContainerId -> Desc -> Desc
-containerDesc cid d = "docker container " ++ fromContainerId cid ++ " " ++ d
+containerDesc :: ContainerId -> Property -> Property
+containerDesc cid p = p `describe` desc
+ where
+ desc = "docker container " ++ fromContainerId cid ++ " " ++ propertyDesc p
-- | Ensures that a docker container is set up and running. The container
-- has its own Properties which are handled by running propellor
@@ -91,7 +94,7 @@ hasContainer
-> Property
hasContainer hn cn findcontainer =
case findcontainer hn cn of
- Nothing -> Property (containerDesc cid "") $ do
+ Nothing -> containerDesc cid $ Property "" $ do
warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
return FailedChange
Just (Container image containerprops) ->
@@ -102,7 +105,7 @@ hasContainer hn cn findcontainer =
cid = ContainerId hn cn
runningContainer :: ContainerId -> Image -> [Containerized Property] -> Property
-runningContainer cid@(ContainerId hn cn) image containerprops = Property (containerDesc cid "running") $ do
+runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc cid $ Property "running" $ do
l <- listContainers RunningContainers
if cid `elem` l
then do
@@ -185,7 +188,7 @@ chain s = case readish s of
-- being run. So, retry connections to the client for up to
-- 1 minute.
provisionContainer :: ContainerId -> Property
-provisionContainer cid = Property (containerDesc cid "provision") $
+provisionContainer cid = containerDesc cid $ Property "provision" $
simpleShClientRetry 60 (namedPipe cid) "./propellor" ["--continue", show params] (go Nothing)
where
params = Chain $ fromContainerId cid
@@ -239,7 +242,7 @@ listContainers status =
runProp :: String -> RunParam -> Containerized Property
runProp field val =
- Containerized ["--" ++ param] (Property param (return NoChange))
+ Containerized ["--" ++ param] (Property (param) (return NoChange))
where
param = field++"="++val