summaryrefslogtreecommitdiff
path: root/src/Propellor/Types/Attr.hs
diff options
context:
space:
mode:
authorJoey Hess2014-06-05 16:52:45 -0400
committerJoey Hess2014-06-05 16:52:45 -0400
commitf8bad2726760268f1daae2a3329be5db310727b8 (patch)
treeab5db4785fee3c7e919213b97975e727e7724907 /src/Propellor/Types/Attr.hs
parent383548956354a00cf24323310e9981ccea6a1ddf (diff)
parentdbffd982bac47cebd3fc67e51b46182f7e43392d (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'src/Propellor/Types/Attr.hs')
-rw-r--r--src/Propellor/Types/Attr.hs77
1 files changed, 47 insertions, 30 deletions
diff --git a/src/Propellor/Types/Attr.hs b/src/Propellor/Types/Attr.hs
index 4c891a46..e8c22a94 100644
--- a/src/Propellor/Types/Attr.hs
+++ b/src/Propellor/Types/Attr.hs
@@ -8,50 +8,67 @@ import Data.Monoid
-- | The attributes of a host.
data Attr = Attr
- { _os :: Maybe System
- , _sshPubKey :: Maybe String
+ { _os :: Val System
+ , _sshPubKey :: Val String
, _dns :: S.Set Dns.Record
, _namedconf :: Dns.NamedConfMap
+ , _dockerattr :: DockerAttr
+ }
+ deriving (Eq)
+
+instance Monoid Attr where
+ 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
+ , _dockerattr = _dockerattr old <> _dockerattr new
+ }
+
+instance Show Attr where
+ show a = unlines
+ [ "OS " ++ show (_os a)
+ , "sshPubKey " ++ show (_sshPubKey a)
+ , "dns " ++ show (_dns a)
+ , "namedconf " ++ show (_namedconf a)
+ , show (_dockerattr a)
+ ]
+
+data Val a = Val a | NoVal
+ deriving (Eq, Show)
+
+instance Monoid (Val a) where
+ mempty = NoVal
+ mappend old new = case new of
+ NoVal -> old
+ _ -> new
- , _dockerImage :: Maybe String
+fromVal :: Val a -> Maybe a
+fromVal (Val a) = Just a
+fromVal NoVal = Nothing
+
+data DockerAttr = DockerAttr
+ { _dockerImage :: Val String
, _dockerRunParams :: [HostName -> String]
}
-instance Eq Attr where
+instance Eq DockerAttr where
x == y = and
- [ _os x == _os y
- , _dns x == _dns y
- , _namedconf x == _namedconf y
- , _sshPubKey x == _sshPubKey y
-
- , _dockerImage x == _dockerImage y
+ [ _dockerImage x == _dockerImage y
, let simpl v = map (\a -> a "") (_dockerRunParams v)
in simpl x == simpl y
]
-instance Monoid Attr where
- mempty = Attr Nothing Nothing mempty mempty Nothing mempty
- mappend old new = Attr
- { _os = case _os new of
- Just v -> Just v
- Nothing -> _os old
- , _sshPubKey = case _sshPubKey new of
- Just v -> Just v
- Nothing -> _sshPubKey old
- , _dns = _dns new <> _dns old
- , _namedconf = _namedconf new <> _namedconf old
- , _dockerImage = case _dockerImage new of
- Just v -> Just v
- Nothing -> _dockerImage old
+instance Monoid DockerAttr where
+ mempty = DockerAttr mempty mempty
+ mappend old new = DockerAttr
+ { _dockerImage = _dockerImage old <> _dockerImage new
, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
}
-instance Show Attr where
+instance Show DockerAttr where
show a = unlines
- [ "OS " ++ show (_os a)
- , "sshPubKey " ++ show (_sshPubKey a)
- , "dns " ++ show (_dns a)
- , "namedconf " ++ show (_namedconf a)
- , "docker image " ++ show (_dockerImage a)
+ [ "docker image " ++ show (_dockerImage a)
, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
]