2014-11-20 18:06:55 +00:00
|
|
|
{-# LANGUAGE PackageImports #-}
|
|
|
|
|
2015-01-19 18:15:49 +00:00
|
|
|
module Propellor.PropAccum where
|
2014-11-20 18:06:55 +00:00
|
|
|
|
|
|
|
import Data.Monoid
|
|
|
|
|
|
|
|
import Propellor.Types
|
|
|
|
import Propellor.Property
|
|
|
|
|
|
|
|
-- | Starts accumulating the properties of a Host.
|
|
|
|
--
|
|
|
|
-- > host "example.com"
|
|
|
|
-- > & someproperty
|
|
|
|
-- > ! oldproperty
|
|
|
|
-- > & otherproperty
|
|
|
|
host :: HostName -> Host
|
|
|
|
host hn = Host hn [] mempty
|
|
|
|
|
|
|
|
-- | Something that can accumulate properties.
|
2015-01-19 18:15:49 +00:00
|
|
|
class PropAccum h where
|
2014-11-20 18:06:55 +00:00
|
|
|
-- | Adds a property.
|
|
|
|
--
|
|
|
|
-- Can add Properties and RevertableProperties
|
|
|
|
(&) :: IsProp p => h -> p -> h
|
|
|
|
|
|
|
|
-- | Like (&), but adds the property as the
|
|
|
|
-- first property of the host. Normally, property
|
|
|
|
-- order should not matter, but this is useful
|
|
|
|
-- when it does.
|
|
|
|
(&^) :: IsProp p => h -> p -> h
|
|
|
|
|
2015-01-19 18:15:49 +00:00
|
|
|
getProperties :: h -> [Property]
|
2014-11-20 18:06:55 +00:00
|
|
|
|
2015-01-19 18:15:49 +00:00
|
|
|
instance PropAccum Host where
|
2015-01-18 22:02:07 +00:00
|
|
|
(Host hn ps is) & p = Host hn (ps ++ [toProp p])
|
|
|
|
(is <> getInfoRecursive p)
|
|
|
|
(Host hn ps is) &^ p = Host hn ([toProp p] ++ ps)
|
|
|
|
(getInfoRecursive p <> is)
|
2015-01-19 18:15:49 +00:00
|
|
|
getProperties = hostProperties
|
2014-11-20 18:06:55 +00:00
|
|
|
|
|
|
|
-- | Adds a property in reverted form.
|
2015-01-19 18:15:49 +00:00
|
|
|
(!) :: PropAccum h => h -> RevertableProperty -> h
|
2014-11-20 18:06:55 +00:00
|
|
|
h ! p = h & revert p
|
|
|
|
|
|
|
|
infixl 1 &^
|
|
|
|
infixl 1 &
|
|
|
|
infixl 1 !
|
|
|
|
|
2015-01-18 22:02:07 +00:00
|
|
|
-- | Adjust the provided Property, adding to its
|
2015-01-19 18:15:49 +00:00
|
|
|
-- propertyChidren the properties of the provided container.
|
2015-01-19 19:55:02 +00:00
|
|
|
--
|
2015-01-18 22:02:07 +00:00
|
|
|
-- The Info of the propertyChildren is adjusted to only include
|
|
|
|
-- info that should be propigated out to the Property.
|
|
|
|
--
|
2015-01-19 18:15:49 +00:00
|
|
|
-- DNS Info is propigated, so that eg, aliases of a PropAccum
|
2015-01-18 22:02:07 +00:00
|
|
|
-- are reflected in the dns for the host where it runs.
|
2014-11-20 18:06:55 +00:00
|
|
|
--
|
2015-01-18 22:02:07 +00:00
|
|
|
-- PrivData Info is propigated, so that properties used inside a
|
2015-01-19 18:15:49 +00:00
|
|
|
-- PropAccum will have the necessary PrivData available.
|
|
|
|
propigateContainer :: PropAccum container => container -> Property -> Property
|
2015-01-24 17:59:29 +00:00
|
|
|
propigateContainer c prop = mkProperty
|
|
|
|
(propertyDesc prop)
|
|
|
|
(propertySatisfy prop)
|
|
|
|
(propertyInfo prop)
|
|
|
|
(propertyChildren prop ++ hostprops)
|
2014-11-20 18:06:55 +00:00
|
|
|
where
|
2015-01-19 18:15:49 +00:00
|
|
|
hostprops = map go $ getProperties c
|
2015-01-18 22:02:07 +00:00
|
|
|
go p =
|
|
|
|
let i = propertyInfo p
|
2015-01-24 17:59:29 +00:00
|
|
|
i' = mempty
|
|
|
|
{ _dns = _dns i
|
|
|
|
, _privData = _privData i
|
2015-01-18 22:02:07 +00:00
|
|
|
}
|
2015-01-24 17:59:29 +00:00
|
|
|
cs = map go (propertyChildren p)
|
|
|
|
in mkProperty (propertyDesc p) (propertySatisfy p) i' cs
|