summaryrefslogtreecommitdiff
path: root/Propellor/Property/Docker.hs
diff options
context:
space:
mode:
authorJoey Hess2014-04-10 17:46:03 -0400
committerJoey Hess2014-04-10 17:46:03 -0400
commit2372d6a3f8193145662e393aa61b585d8bafd32d (patch)
tree1738d2d20b28a7abd3e9aa5e292ab3fef4b7db12 /Propellor/Property/Docker.hs
parent25942fb0cca0ca90933026bf959506e099ff95a4 (diff)
use HostAttr to simplify config file
Diffstat (limited to 'Propellor/Property/Docker.hs')
-rw-r--r--Propellor/Property/Docker.hs36
1 files changed, 20 insertions, 16 deletions
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index 1df34251..3828535c 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -40,36 +40,40 @@ installed = Apt.installed ["docker.io"]
-- removed.
docked
:: (HostName -> ContainerName -> Maybe (Container))
- -> HostName
-> ContainerName
-> RevertableProperty
-docked findc hn cn = findContainer findc hn cn $
- \(Container image containerprops) ->
- let setup = provisionContainer cid
- `requires`
- runningContainer cid image containerprops
- `requires`
- installed
- teardown = combineProperties ("undocked " ++ fromContainerId cid)
- [ stoppedContainer cid
+docked findc cn = RevertableProperty (go "docked" setup) (go "undocked" teardown)
+ where
+ go desc a = Property (desc ++ " " ++ cn) $ do
+ hn <- getHostName
+ let cid = ContainerId hn cn
+ ensureProperties [findContainer findc hn cn $ a cid]
+
+ setup cid (Container image containerprops) =
+ provisionContainer cid
+ `requires`
+ runningContainer cid image containerprops
+ `requires`
+ installed
+
+ teardown cid (Container image _) =
+ combineProperties ("undocked " ++ fromContainerId cid)
+ [ stoppedContainer cid
, Property ("cleaned up " ++ fromContainerId cid) $
liftIO $ report <$> mapM id
[ removeContainer cid
, removeImage image
]
]
- in RevertableProperty setup teardown
- where
- cid = ContainerId hn cn
findContainer
:: (HostName -> ContainerName -> Maybe (Container))
-> HostName
-> ContainerName
- -> (Container -> RevertableProperty)
- -> RevertableProperty
+ -> (Container -> Property)
+ -> Property
findContainer findc hn cn mk = case findc hn cn of
- Nothing -> RevertableProperty cantfind cantfind
+ Nothing -> cantfind
Just container -> mk container
where
cid = ContainerId hn cn