rename HostLike to PropAccum
This is more general; it doesn't need to contain a Host. It would, for example, be possible to make Property itself be an instance of PropAccum.
This commit is contained in:
parent
db93c41f90
commit
1ae21965aa
|
@ -108,7 +108,7 @@ Library
|
||||||
Propellor.Property.SiteSpecific.GitHome
|
Propellor.Property.SiteSpecific.GitHome
|
||||||
Propellor.Property.SiteSpecific.JoeySites
|
Propellor.Property.SiteSpecific.JoeySites
|
||||||
Propellor.Property.SiteSpecific.GitAnnexBuilder
|
Propellor.Property.SiteSpecific.GitAnnexBuilder
|
||||||
Propellor.Host
|
Propellor.PropAccum
|
||||||
Propellor.CmdLine
|
Propellor.CmdLine
|
||||||
Propellor.Info
|
Propellor.Info
|
||||||
Propellor.Message
|
Propellor.Message
|
||||||
|
|
|
@ -33,7 +33,7 @@ module Propellor (
|
||||||
module Propellor.Types
|
module Propellor.Types
|
||||||
, module Propellor.Property
|
, module Propellor.Property
|
||||||
, module Propellor.Property.Cmd
|
, module Propellor.Property.Cmd
|
||||||
, module Propellor.Host
|
, module Propellor.PropAccum
|
||||||
, module Propellor.Info
|
, module Propellor.Info
|
||||||
, module Propellor.PrivData
|
, module Propellor.PrivData
|
||||||
, module Propellor.Types.PrivData
|
, module Propellor.Types.PrivData
|
||||||
|
@ -54,7 +54,7 @@ import Propellor.Types.PrivData
|
||||||
import Propellor.Message
|
import Propellor.Message
|
||||||
import Propellor.Exception
|
import Propellor.Exception
|
||||||
import Propellor.Info
|
import Propellor.Info
|
||||||
import Propellor.Host
|
import Propellor.PropAccum
|
||||||
|
|
||||||
import Utility.PartialPrelude as X
|
import Utility.PartialPrelude as X
|
||||||
import Utility.Process as X
|
import Utility.Process as X
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{-# LANGUAGE PackageImports #-}
|
{-# LANGUAGE PackageImports #-}
|
||||||
|
|
||||||
module Propellor.Host where
|
module Propellor.PropAccum where
|
||||||
|
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
|
|
||||||
|
@ -17,7 +17,7 @@ host :: HostName -> Host
|
||||||
host hn = Host hn [] mempty
|
host hn = Host hn [] mempty
|
||||||
|
|
||||||
-- | Something that can accumulate properties.
|
-- | Something that can accumulate properties.
|
||||||
class Hostlike h where
|
class PropAccum h where
|
||||||
-- | Adds a property.
|
-- | Adds a property.
|
||||||
--
|
--
|
||||||
-- Can add Properties and RevertableProperties
|
-- Can add Properties and RevertableProperties
|
||||||
|
@ -29,17 +29,17 @@ class Hostlike h where
|
||||||
-- when it does.
|
-- when it does.
|
||||||
(&^) :: IsProp p => h -> p -> h
|
(&^) :: IsProp p => h -> p -> h
|
||||||
|
|
||||||
getHost :: h -> Host
|
getProperties :: h -> [Property]
|
||||||
|
|
||||||
instance Hostlike Host where
|
instance PropAccum Host where
|
||||||
(Host hn ps is) & p = Host hn (ps ++ [toProp p])
|
(Host hn ps is) & p = Host hn (ps ++ [toProp p])
|
||||||
(is <> getInfoRecursive p)
|
(is <> getInfoRecursive p)
|
||||||
(Host hn ps is) &^ p = Host hn ([toProp p] ++ ps)
|
(Host hn ps is) &^ p = Host hn ([toProp p] ++ ps)
|
||||||
(getInfoRecursive p <> is)
|
(getInfoRecursive p <> is)
|
||||||
getHost h = h
|
getProperties = hostProperties
|
||||||
|
|
||||||
-- | Adds a property in reverted form.
|
-- | Adds a property in reverted form.
|
||||||
(!) :: Hostlike h => h -> RevertableProperty -> h
|
(!) :: PropAccum h => h -> RevertableProperty -> h
|
||||||
h ! p = h & revert p
|
h ! p = h & revert p
|
||||||
|
|
||||||
infixl 1 &^
|
infixl 1 &^
|
||||||
|
@ -47,22 +47,22 @@ infixl 1 &
|
||||||
infixl 1 !
|
infixl 1 !
|
||||||
|
|
||||||
-- | Adjust the provided Property, adding to its
|
-- | Adjust the provided Property, adding to its
|
||||||
-- propertyChidren the properties of the Hostlike.
|
-- propertyChidren the properties of the provided container.
|
||||||
|
|
||||||
-- The Info of the propertyChildren is adjusted to only include
|
-- The Info of the propertyChildren is adjusted to only include
|
||||||
-- info that should be propigated out to the Property.
|
-- info that should be propigated out to the Property.
|
||||||
--
|
--
|
||||||
-- DNS Info is propigated, so that eg, aliases of a Hostlike
|
-- DNS Info is propigated, so that eg, aliases of a PropAccum
|
||||||
-- are reflected in the dns for the host where it runs.
|
-- are reflected in the dns for the host where it runs.
|
||||||
--
|
--
|
||||||
-- PrivData Info is propigated, so that properties used inside a
|
-- PrivData Info is propigated, so that properties used inside a
|
||||||
-- Hostlike will have the necessary PrivData available.
|
-- PropAccum will have the necessary PrivData available.
|
||||||
propigateHostLike :: Hostlike hl => hl -> Property -> Property
|
propigateContainer :: PropAccum container => container -> Property -> Property
|
||||||
propigateHostLike hl prop = prop
|
propigateContainer c prop = prop
|
||||||
{ propertyChildren = propertyChildren prop ++ hostprops
|
{ propertyChildren = propertyChildren prop ++ hostprops
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
hostprops = map go $ hostProperties $ getHost hl
|
hostprops = map go $ getProperties c
|
||||||
go p =
|
go p =
|
||||||
let i = propertyInfo p
|
let i = propertyInfo p
|
||||||
in p
|
in p
|
|
@ -28,10 +28,10 @@ data BuilderConf
|
||||||
= UsingDeboostrap Debootstrap.DebootstrapConfig
|
= UsingDeboostrap Debootstrap.DebootstrapConfig
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
instance Hostlike Chroot where
|
instance PropAccum Chroot where
|
||||||
(Chroot l s c h) & p = Chroot l s c (h & p)
|
(Chroot l s c h) & p = Chroot l s c (h & p)
|
||||||
(Chroot l s c h) &^ p = Chroot l s c (h &^ p)
|
(Chroot l s c h) &^ p = Chroot l s c (h &^ p)
|
||||||
getHost (Chroot _ _ _ h) = h
|
getProperties (Chroot _ _ _ h) = hostProperties h
|
||||||
|
|
||||||
-- | Defines a Chroot at the given location, built with debootstrap.
|
-- | Defines a Chroot at the given location, built with debootstrap.
|
||||||
--
|
--
|
||||||
|
@ -76,7 +76,7 @@ provisioned' propigator c@(Chroot loc system builderconf _) systemdonly = Revert
|
||||||
teardown = toProp (revert built)
|
teardown = toProp (revert built)
|
||||||
|
|
||||||
propigateChrootInfo :: Chroot -> Property -> Property
|
propigateChrootInfo :: Chroot -> Property -> Property
|
||||||
propigateChrootInfo c p = propigateHostLike c p'
|
propigateChrootInfo c p = propigateContainer c p'
|
||||||
where
|
where
|
||||||
p' = p { propertyInfo = propertyInfo p <> chrootInfo c }
|
p' = p { propertyInfo = propertyInfo p <> chrootInfo c }
|
||||||
|
|
||||||
|
|
|
@ -77,10 +77,10 @@ type ContainerName = String
|
||||||
-- | A docker container.
|
-- | A docker container.
|
||||||
data Container = Container Image Host
|
data Container = Container Image Host
|
||||||
|
|
||||||
instance Hostlike Container where
|
instance PropAccum Container where
|
||||||
(Container i h) & p = Container i (h & p)
|
(Container i h) & p = Container i (h & p)
|
||||||
(Container i h) &^ p = Container i (h &^ p)
|
(Container i h) &^ p = Container i (h &^ p)
|
||||||
getHost (Container _ h) = h
|
getProperties (Container _ h) = hostProperties h
|
||||||
|
|
||||||
-- | Defines a Container with a given name, image, and properties.
|
-- | Defines a Container with a given name, image, and properties.
|
||||||
-- Properties can be added to configure the Container.
|
-- Properties can be added to configure the Container.
|
||||||
|
@ -134,7 +134,7 @@ docked ctr@(Container _ h) = RevertableProperty
|
||||||
]
|
]
|
||||||
|
|
||||||
propigateContainerInfo :: Container -> Property -> Property
|
propigateContainerInfo :: Container -> Property -> Property
|
||||||
propigateContainerInfo ctr@(Container _ h) p = propigateHostLike ctr p'
|
propigateContainerInfo ctr@(Container _ h) p = propigateContainer ctr p'
|
||||||
where
|
where
|
||||||
p' = p { propertyInfo = propertyInfo p <> dockerinfo }
|
p' = p { propertyInfo = propertyInfo p <> dockerinfo }
|
||||||
dockerinfo = dockerInfo $
|
dockerinfo = dockerInfo $
|
||||||
|
|
|
@ -33,10 +33,10 @@ type MachineName = String
|
||||||
data Container = Container MachineName Chroot.Chroot Host
|
data Container = Container MachineName Chroot.Chroot Host
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
instance Hostlike Container where
|
instance PropAccum Container where
|
||||||
(Container n c h) & p = Container n c (h & p)
|
(Container n c h) & p = Container n c (h & p)
|
||||||
(Container n c h) &^ p = Container n c (h &^ p)
|
(Container n c h) &^ p = Container n c (h &^ p)
|
||||||
getHost (Container _ _ h) = h
|
getProperties (Container _ _ h) = hostProperties h
|
||||||
|
|
||||||
-- | Starts a systemd service.
|
-- | Starts a systemd service.
|
||||||
started :: ServiceName -> Property
|
started :: ServiceName -> Property
|
||||||
|
|
Loading…
Reference in New Issue