summaryrefslogtreecommitdiff
path: root/src/Propellor/Types
diff options
context:
space:
mode:
authorJoey Hess2014-05-31 21:18:36 -0400
committerJoey Hess2014-05-31 21:18:36 -0400
commit7c4b1537391d801855e28a61c896efcc70cfaa81 (patch)
tree010b433c4f9eae6f0336ad0735f2893cf0a7498e /src/Propellor/Types
parentd1eafb12776d6487ecd48d3991838032a81181d6 (diff)
simplify monoid instance with some helper types
Diffstat (limited to 'src/Propellor/Types')
-rw-r--r--src/Propellor/Types/Attr.hs33
1 files changed, 20 insertions, 13 deletions
diff --git a/src/Propellor/Types/Attr.hs b/src/Propellor/Types/Attr.hs
index 17a02bd2..7455c3c3 100644
--- a/src/Propellor/Types/Attr.hs
+++ b/src/Propellor/Types/Attr.hs
@@ -8,12 +8,12 @@ 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
- , _dockerImage :: Maybe String
+ , _dockerImage :: Val String
, _dockerRunParams :: [HostName -> String]
}
@@ -30,19 +30,13 @@ instance Eq Attr where
]
instance Monoid Attr where
- mempty = Attr Nothing Nothing mempty mempty Nothing mempty
+ mempty = Attr mempty mempty mempty mempty mempty 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
+ { _os = _os old <> _os new
+ , _sshPubKey = _sshPubKey old <> _sshPubKey new
, _dns = _dns new <> _dns old
, _namedconf = _namedconf old <> _namedconf new
- , _dockerImage = case _dockerImage new of
- Just v -> Just v
- Nothing -> _dockerImage old
+ , _dockerImage = _dockerImage old <> _dockerImage new
, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
}
@@ -55,3 +49,16 @@ instance Show Attr where
, "docker image " ++ show (_dockerImage a)
, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams 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
+
+fromVal :: Val a -> Maybe a
+fromVal (Val a) = Just a
+fromVal NoVal = Nothing