simplify monoid instance with some helper types

src/Propellor/Attr.hs

@@ -15,12 +15,15 @@ import Control.Applicative
 pureAttrProperty :: Desc -> Attr -> Property 
 pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
 
+askAttr :: (Attr -> Val a) -> Propellor (Maybe a)
+askAttr f = asks (fromVal . f . hostAttr)
+
 os :: System -> Property
 os system = pureAttrProperty ("Operating " ++ show system) $
-	mempty { _os = Just system }
+	mempty { _os = Val system }
 
 getOS :: Propellor (Maybe System)
-getOS = asks (_os . hostAttr)
+getOS = askAttr _os
 
 -- | Indidate that a host has an A record in the DNS.
 --
@@ -55,10 +58,10 @@ addDNS r = pureAttrProperty (rdesc r) $
 
 sshPubKey :: String -> Property
 sshPubKey k = pureAttrProperty ("ssh pubkey known") $
-	mempty { _sshPubKey = Just k }
+	mempty { _sshPubKey = Val k }
 
 getSshPubKey :: Propellor (Maybe String)
-getSshPubKey = asks (_sshPubKey . hostAttr)
+getSshPubKey = askAttr _sshPubKey
 
 hostMap :: [Host] -> M.Map HostName Host
 hostMap l = M.fromList $ zip (map hostName l) l 

src/Propellor/Property/Docker.hs

@@ -48,7 +48,7 @@ type ContainerName = String
 container :: ContainerName -> Image -> Host
 container cn image = Host hn [] attr
   where
-	attr = mempty { _dockerImage = Just image }
+	attr = mempty { _dockerImage = Val image }
 	hn = cn2hn cn
 
 cn2hn :: ContainerName -> HostName
@@ -116,7 +116,7 @@ findContainer mhost cid cn mk = case mhost of
 
 mkContainer :: ContainerId -> Host -> Maybe Container
 mkContainer cid@(ContainerId hn _cn) h = Container
-	<$> _dockerImage attr
+	<$> fromVal (_dockerImage attr)
 	<*> pure (map (\a -> a hn) (_dockerRunParams attr))
   where
 	attr = hostAttr h'

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