From c742c2eb1b7141fbe0628870e899d3461a88686a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 31 May 2014 17:22:35 -0400 Subject: propellor spin --- src/Propellor/Attr.hs | 13 ++++--------- src/Propellor/Property.hs | 6 +++--- src/Propellor/Property/Docker.hs | 9 +++++---- src/Propellor/Types.hs | 10 +++++++--- 4 files changed, 19 insertions(+), 19 deletions(-) (limited to 'src') diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs index e2b64bf0..6bc4fcf1 100644 --- a/src/Propellor/Attr.hs +++ b/src/Propellor/Attr.hs @@ -83,22 +83,17 @@ sshPubKey k = pureAttrProperty ("ssh pubkey known") $ getSshPubKey :: Propellor (Maybe String) getSshPubKey = asks _sshPubKey -hostnameless :: Attr -hostnameless = newAttr (error "hostname Attr not specified") - hostAttr :: Host -> Attr -hostAttr (Host _ mkattrs) = mkattrs hostnameless +hostAttr (Host hn _ mkattrs) = mkattrs (newAttr hn) hostProperties :: Host -> [Property] -hostProperties (Host ps _) = ps +hostProperties (Host _ ps _) = ps hostMap :: [Host] -> M.Map HostName Host -hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l +hostMap l = M.fromList $ zip (map _hostName l) l hostAttrMap :: [Host] -> M.Map HostName Attr -hostAttrMap l = M.fromList $ zip (map _hostname attrs) attrs - where - attrs = map hostAttr l +hostAttrMap l = M.fromList $ zip (map _hostName l) (map hostAttr l) findHost :: [Host] -> HostName -> Maybe Host findHost l hn = M.lookup hn (hostMap l) diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 0728932e..1f602624 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -130,19 +130,19 @@ revert (RevertableProperty p1 p2) = RevertableProperty p2 p1 -- > ! oldproperty -- > & otherproperty host :: HostName -> Host -host hn = Host [] (\_ -> newAttr hn) +host hn = Host hn [] (\_ -> newAttr hn) -- | Adds a property to a Host -- -- Can add Properties and RevertableProperties (&) :: IsProp p => Host -> p -> Host -(Host ps as) & p = Host (ps ++ [toProp p]) (setAttr p . as) +(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (setAttr p . as) infixl 1 & -- | Adds a property to the Host in reverted form. (!) :: Host -> RevertableProperty -> Host -(Host ps as) ! p = Host (ps ++ [toProp q]) (setAttr q . as) +(Host hn ps as) ! p = Host hn (ps ++ [toProp q]) (setAttr q . as) where q = revert p diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 465fe0b4..c1340ad9 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -46,9 +46,10 @@ type ContainerName = String -- > & Apt.installed {"apache2"] -- > & ... container :: ContainerName -> Image -> Host -container cn image = Host [] (\_ -> attr) +container cn image = Host hn [] (\_ -> attr) where - attr = (newAttr (cn2hn cn)) { _dockerImage = Just image } + attr = (newAttr hn) { _dockerImage = Just image } + hn = cn2hn cn cn2hn :: ContainerName -> HostName cn2hn cn = cn ++ ".docker" @@ -67,7 +68,7 @@ docked -> ContainerName -> RevertableProperty docked hosts cn = RevertableProperty - (go "docked" setup) + ((maybe id exposeDnsAttrs mhost) (go "docked" setup)) (go "undocked" teardown) where go desc a = property (desc ++ " " ++ cn) $ do @@ -95,7 +96,7 @@ docked hosts cn = RevertableProperty ] exposeDnsAttrs :: Host -> Property -> Property -exposeDnsAttrs (Host _ containerattr) p = combineProperties (propertyDesc p) $ +exposeDnsAttrs (Host _ _ containerattr) p = combineProperties (propertyDesc p) $ p : map addDNS (S.toList containerdns) where containerdns = _dns $ containerattr $ newAttr undefined diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 8a4bd3dd..e5f5c1c7 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -34,9 +34,13 @@ import Propellor.Types.Attr import Propellor.Types.OS import Propellor.Types.Dns --- | Everything Propellor knows about a system: Its properties and --- attributes. -data Host = Host [Property] SetAttr +-- | Everything Propellor knows about a system: Its hostname, +-- properties and attributes. +data Host = Host + { _hostName :: HostName + , _hostProps :: [Property] + , _hostAttrs :: SetAttr + } -- | Propellor's monad provides read-only access to attributes of the -- system. -- cgit v1.2.3