diff options
| author | Joey Hess <joeyh@joeyh.name> | 2016-03-26 21:38:39 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2016-03-26 21:38:39 -0400 |
| commit | 46fc5467e633a9c1f149cb0cd7ee03af1e9e0aa1 (patch) | |
| tree | 85d0136a1bc612a998259ab8690d20916d5ba704 /src/Propellor/PropAccum.hs | |
| parent | 530b0dde35e143df1ba8cb8f4828e0a3bc0b4ffb (diff) | |
ported docker
Also, implemented modifyHostProps to add properties to an existing host.
Using it bypasses some type safety. Its use in docker is safe though.
But, in Conductor, the use of it was not really safe, because it was used
with a DebianLike property. Fixed that by making Ssh.installed
target all unix's, although it will fail on non-DebianLike ones.
Diffstat (limited to 'src/Propellor/PropAccum.hs')
| -rw-r--r-- | src/Propellor/PropAccum.hs | 18 |
1 files changed, 18 insertions, 0 deletions
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index af362ca7..1212ef7a 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -12,6 +12,8 @@ module Propellor.PropAccum , (&) , (&^) , (!) + , hostProps + , modifyHostProps ) where import Propellor.Types @@ -30,6 +32,16 @@ import Prelude host :: HostName -> Props metatypes -> Host host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps)) +-- | Note that the metatype of a Host's properties is not retained, +-- so this defaults to UnixLike. So, using this with modifyHostProps can +-- add properties to a Host that conflict with properties already in it. +-- Use caution when using this. +hostProps :: Host -> Props UnixLike +hostProps = Props . hostProperties + +modifyHostProps :: Host -> Props metatypes -> Host +modifyHostProps h ps = host (hostName h) ps + -- | Props is a combination of a list of properties, with their combined -- metatypes. data Props metatypes = Props [ChildProperty] @@ -81,3 +93,9 @@ Props c &^ p = Props (toChildProperty p : c) -> RevertableProperty (MetaTypes y) (MetaTypes z) -> Props (MetaTypes (Combine x z)) Props c ! p = Props (c ++ [toChildProperty (revert p)]) + +-- addPropsHost :: Host -> [Prop] -> Host +-- addPropsHost (Host hn ps i) p = Host hn ps' i' +-- where +-- ps' = ps ++ [toChildProperty p] +-- i' = i <> getInfoRecursive p |
