diff options
| author | Joey Hess <joey@kitenet.net> | 2014-04-10 17:46:03 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-04-10 17:46:03 -0400 |
| commit | 2372d6a3f8193145662e393aa61b585d8bafd32d (patch) | |
| tree | 1738d2d20b28a7abd3e9aa5e292ab3fef4b7db12 /Propellor/Property/Docker.hs | |
| parent | 25942fb0cca0ca90933026bf959506e099ff95a4 (diff) | |
use HostAttr to simplify config file
Diffstat (limited to 'Propellor/Property/Docker.hs')
| -rw-r--r-- | Propellor/Property/Docker.hs | 36 |
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 |