summaryrefslogtreecommitdiff
path: root/src/Propellor/Host.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Host.hs')
-rw-r--r--src/Propellor/Host.hs64
1 files changed, 0 insertions, 64 deletions
diff --git a/src/Propellor/Host.hs b/src/Propellor/Host.hs
deleted file mode 100644
index 14d56e20..00000000
--- a/src/Propellor/Host.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{-# LANGUAGE PackageImports #-}
-
-module Propellor.Host where
-
-import Data.Monoid
-import qualified Data.Set as S
-
-import Propellor.Types
-import Propellor.Info
-import Propellor.Property
-import Propellor.PrivData
-
--- | 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.
-class Hostlike h where
- -- | 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
-
- getHost :: h -> Host
-
-instance Hostlike Host where
- (Host hn ps is) & p = Host hn (ps ++ [toProp p]) (is <> getInfo p)
- (Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) (getInfo p <> is)
- getHost h = h
-
--- | Adds a property in reverted form.
-(!) :: Hostlike h => h -> RevertableProperty -> h
-h ! p = h & revert p
-
-infixl 1 &^
-infixl 1 &
-infixl 1 !
-
--- | When eg, docking a container, some of the Info about the container
--- should propigate out to the Host it's on. This includes DNS info,
--- so that eg, aliases of the container are reflected in the dns for the
--- host where it runs.
---
--- This adjusts the Property that docks a container, to include such info
--- from the container.
-propigateInfo :: Hostlike hl => hl -> Property -> (Info -> Info) -> Property
-propigateInfo hl p f = combineProperties (propertyDesc p) $
- p' : dnsprops ++ privprops
- where
- p' = p { propertyInfo = f (propertyInfo p) }
- i = hostInfo (getHost hl)
- dnsprops = map addDNS (S.toList $ _dns i)
- privprops = map addPrivDataField (S.toList $ _privDataFields i)