summaryrefslogtreecommitdiff
path: root/src/Propellor/Types
diff options
context:
space:
mode:
authorJoey Hess2014-05-31 22:00:11 -0400
committerJoey Hess2014-05-31 22:00:11 -0400
commitcae7e15f569dfe672b1a667e468447f6153ea5f0 (patch)
tree88e6281704df3a85e8e46456f2c06e1173b38a6a /src/Propellor/Types
parentb0f2478bcbfcf5adc2d6f1692d667d42b108ca04 (diff)
split out DockerAttr
Diffstat (limited to 'src/Propellor/Types')
-rw-r--r--src/Propellor/Types/Attr.hs50
1 files changed, 30 insertions, 20 deletions
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))
+ ]