From cae7e15f569dfe672b1a667e468447f6153ea5f0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 31 May 2014 22:00:11 -0400 Subject: split out DockerAttr --- src/Propellor/Types/Attr.hs | 50 +++++++++++++++++++++++++++------------------ 1 file changed, 30 insertions(+), 20 deletions(-) (limited to 'src/Propellor/Types') diff --git a/src/Propellor/Types/Attr.hs b/src/Propellor/Types/Attr.hs index b41a813b..e8c22a94 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)) + ] -- cgit v1.2.3