From 4f70fceb3a79f2c2b746407768faf363d11c11a4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 20:39:56 -0400
Subject: got rid of the Attr -> Attr SetAttr hack, and use monoids for Attr

The SetAttr hack used to be needed because the hostname was part of the
Attr, and was required to be present. Now that it's moved to Host, let's
get rid of that, since it tended to waste CPU.
---
 src/Propellor/Attr.hs | 28 ++++++----------------------
 1 file changed, 6 insertions(+), 22 deletions(-)

(limited to 'src/Propellor/Attr.hs')

diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs
index 5749a4bf..8f1c6b7c 100644
--- a/src/Propellor/Attr.hs
+++ b/src/Propellor/Attr.hs
@@ -9,9 +9,10 @@ import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
 import qualified Data.Map as M
 import Data.Maybe
+import Data.Monoid
 import Control.Applicative
 
-pureAttrProperty :: Desc -> SetAttr -> Property 
+pureAttrProperty :: Desc -> Attr -> Property 
 pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
 
 getHostName :: Propellor HostName
@@ -19,7 +20,7 @@ getHostName = asks _hostName
 
 os :: System -> Property
 os system = pureAttrProperty ("Operating " ++ show system) $
-	\d -> d { _os = Just system }
+	mempty { _os = Just system }
 
 getOS :: Propellor (Maybe System)
 getOS = asks (_os . hostAttr)
@@ -41,7 +42,7 @@ alias = addDNS . CNAME . AbsDomain
 
 addDNS :: Record -> Property
 addDNS r = pureAttrProperty (rdesc r) $
-	\d -> d { _dns = S.insert r (_dns d) }
+	mempty { _dns = S.singleton r }
   where
 	rdesc (CNAME d) = unwords ["alias", ddesc d]
 	rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]
@@ -55,32 +56,15 @@ addDNS r = pureAttrProperty (rdesc r) $
 	ddesc (RelDomain domain) = domain
 	ddesc RootDomain = "@"
 
--- | Adds a DNS NamedConf stanza.
---
--- Note that adding a Master stanza for a domain always overrides an
--- existing Secondary stanza, while a Secondary stanza is only added
--- when there is no existing Master stanza.
-addNamedConf :: NamedConf -> SetAttr
-addNamedConf conf d = d { _namedconf = new }
-  where
-	m = _namedconf d
-	domain = confDomain conf
-	new = case (confDnsServerType conf, confDnsServerType <$> M.lookup domain m) of
-		(Secondary, Just Master) -> m
-		_  -> M.insert domain conf m
-
-getNamedConf :: Propellor (M.Map Domain NamedConf)
-getNamedConf = asks (_namedconf . hostAttr)
-
 sshPubKey :: String -> Property
 sshPubKey k = pureAttrProperty ("ssh pubkey known") $
-	\d -> d { _sshPubKey = Just k }
+	mempty { _sshPubKey = Just k }
 
 getSshPubKey :: Propellor (Maybe String)
 getSshPubKey = asks (_sshPubKey . hostAttr)
 
 hostAttr :: Host -> Attr
-hostAttr (Host _ _ mkattrs) = mkattrs newAttr
+hostAttr (Host _ _ attr) = attr
 
 hostProperties :: Host -> [Property]
 hostProperties (Host _ ps _) = ps
-- 
cgit v1.3-2-g0d8e