From 2372d6a3f8193145662e393aa61b585d8bafd32d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 10 Apr 2014 17:46:03 -0400
Subject: use HostAttr to simplify config file

---
 Propellor/Property/Docker.hs | 36 ++++++++++++++++++++----------------
 1 file changed, 20 insertions(+), 16 deletions(-)

(limited to 'Propellor/Property/Docker.hs')

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
-- 
cgit v1.3-2-g0d8e