From cae7e15f569dfe672b1a667e468447f6153ea5f0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 22:00:11 -0400
Subject: [PATCH] split out DockerAttr

---
 src/Propellor/Property/Docker.hs | 11 ++++---
 src/Propellor/Types/Attr.hs      | 50 +++++++++++++++++++-------------
 2 files changed, 37 insertions(+), 24 deletions(-)

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index f23738b..fbf3496 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -72,7 +72,7 @@ type ContainerName = String
 container :: ContainerName -> Image -> Host
 container cn image = Host hn [] attr
   where
-	attr = mempty { _dockerImage = Val image }
+	attr = dockerAttr $ mempty { _dockerImage = Val image }
 	hn = cn2hn cn
 
 cn2hn :: ContainerName -> HostName
@@ -145,7 +145,7 @@ mkContainer cid@(ContainerId hn _cn) h = Container
 	<$> fromVal (_dockerImage attr)
 	<*> pure (map (\a -> a hn) (_dockerRunParams attr))
   where
-	attr = hostAttr h'
+	attr = _dockerattr $ hostAttr h'
   	h' = h
 		-- expose propellor directory inside the container
 		& volume (localdir++":"++localdir)
@@ -443,15 +443,18 @@ listImages :: IO [Image]
 listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
 
 runProp :: String -> RunParam -> Property
-runProp field val = pureAttrProperty (param) $
+runProp field val = pureAttrProperty (param) $ dockerAttr $
 	mempty { _dockerRunParams = [\_ -> "--"++param] }
   where
 	param = field++"="++val
 
 genProp :: String -> (HostName -> RunParam) -> Property
-genProp field mkval = pureAttrProperty field $
+genProp field mkval = pureAttrProperty field $ dockerAttr $
 	mempty { _dockerRunParams = [\hn -> "--"++field++"=" ++ mkval hn] }
 
+dockerAttr :: DockerAttr -> Attr
+dockerAttr a = mempty { _dockerattr = a }
+
 -- | The ContainerIdent of a container is written to
 -- /.propellor-ident inside it. This can be checked to see if
 -- the container has the same ident later.
diff --git a/src/Propellor/Types/Attr.hs b/src/Propellor/Types/Attr.hs
index b41a813..e8c22a9 100644
--- a/src/Propellor/Types/Attr.hs
+++ b/src/Propellor/Types/Attr.hs
@@ -12,32 +12,18 @@ data Attr = Attr
 	, _sshPubKey :: Val String
 	, _dns :: S.Set Dns.Record
 	, _namedconf :: Dns.NamedConfMap
-
-	, _dockerImage :: Val String
-	, _dockerRunParams :: [HostName -> String]
+	, _dockerattr :: DockerAttr
 	}
-
-instance Eq Attr where
-	x == y = and
-		[ _os x == _os y
-		, _dns x == _dns y
-		, _namedconf x == _namedconf y
-		, _sshPubKey x == _sshPubKey y
-
-		, _dockerImage x == _dockerImage y
-		, let simpl v = map (\a -> a "") (_dockerRunParams v)
-		  in simpl x == simpl y
-		]
+	deriving (Eq)
 
 instance Monoid Attr where
-	mempty = Attr mempty mempty mempty mempty mempty mempty
+	mempty = Attr mempty mempty mempty mempty mempty
 	mappend old new = Attr
 		{ _os = _os old <> _os new
 		, _sshPubKey = _sshPubKey old <> _sshPubKey new
 		, _dns = _dns old <> _dns new
 		, _namedconf = _namedconf old <> _namedconf new
-		, _dockerImage = _dockerImage old <> _dockerImage new
-		, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
+		, _dockerattr = _dockerattr old <> _dockerattr new
 		}
 
 instance Show Attr where
@@ -46,8 +32,7 @@ instance Show Attr where
 		, "sshPubKey " ++ show (_sshPubKey a)
 		, "dns " ++ show (_dns a)
 		, "namedconf " ++ show (_namedconf a)
-		, "docker image " ++ show (_dockerImage a)
-		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
+		, show (_dockerattr a)
 		]
 
 data Val a = Val a | NoVal
@@ -62,3 +47,28 @@ instance Monoid (Val a) where
 fromVal :: Val a -> Maybe a
 fromVal (Val a) = Just a
 fromVal NoVal = Nothing
+
+data DockerAttr = DockerAttr
+	{ _dockerImage :: Val String
+	, _dockerRunParams :: [HostName -> String]
+	}
+
+instance Eq DockerAttr where
+	x == y = and
+		[ _dockerImage x == _dockerImage y
+		, let simpl v = map (\a -> a "") (_dockerRunParams v)
+		  in simpl x == simpl y
+		]
+
+instance Monoid DockerAttr where
+	mempty = DockerAttr mempty mempty
+	mappend old new = DockerAttr
+		{ _dockerImage = _dockerImage old <> _dockerImage new
+		, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
+		}
+
+instance Show DockerAttr where
+	show a = unlines
+		[ "docker image " ++ show (_dockerImage a)
+		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
+		]