From 42a0c832483296fb111279fc3512a3dfd44f2089 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 7 Dec 2014 17:09:55 -0400 Subject: Display a warning when ensureProperty is used on a property which has Info and is so prevented from propigating it. Would much rather a type-based fixed, but this is all I have for now. --- src/Propellor/Types/Chroot.hs | 12 +++++++++++- src/Propellor/Types/Dns.hs | 4 ++++ src/Propellor/Types/Docker.hs | 7 +++++++ src/Propellor/Types/Empty.hs | 16 ++++++++++++++++ 4 files changed, 38 insertions(+), 1 deletion(-) create mode 100644 src/Propellor/Types/Empty.hs (limited to 'src/Propellor/Types') diff --git a/src/Propellor/Types/Chroot.hs b/src/Propellor/Types/Chroot.hs index b7ed7807..d37d34c7 100644 --- a/src/Propellor/Types/Chroot.hs +++ b/src/Propellor/Types/Chroot.hs @@ -2,6 +2,7 @@ module Propellor.Types.Chroot where import Data.Monoid import qualified Data.Map as M +import Propellor.Types.Empty data ChrootInfo host = ChrootInfo { _chroots :: M.Map FilePath host @@ -16,10 +17,16 @@ instance Monoid (ChrootInfo host) where , _chrootCfg = _chrootCfg old <> _chrootCfg new } +instance Empty (ChrootInfo host) where + isEmpty i = and + [ isEmpty (_chroots i) + , isEmpty (_chrootCfg i) + ] + data ChrootCfg = NoChrootCfg | SystemdNspawnCfg [(String, Bool)] - deriving (Show) + deriving (Show, Eq) instance Monoid ChrootCfg where mempty = NoChrootCfg @@ -27,3 +34,6 @@ instance Monoid ChrootCfg where mappend NoChrootCfg v = v mappend (SystemdNspawnCfg l1) (SystemdNspawnCfg l2) = SystemdNspawnCfg (l1 <> l2) + +instance Empty ChrootCfg where + isEmpty c= c == NoChrootCfg diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs index 66fbd1a4..5e9666d8 100644 --- a/src/Propellor/Types/Dns.hs +++ b/src/Propellor/Types/Dns.hs @@ -1,6 +1,7 @@ module Propellor.Types.Dns where import Propellor.Types.OS (HostName) +import Propellor.Types.Empty import Data.Word import Data.Monoid @@ -108,5 +109,8 @@ instance Monoid NamedConfMap where (Secondary, Master) -> o _ -> n +instance Empty NamedConfMap where + isEmpty (NamedConfMap m) = isEmpty m + fromNamedConfMap :: NamedConfMap -> M.Map Domain NamedConf fromNamedConfMap (NamedConfMap m) = m diff --git a/src/Propellor/Types/Docker.hs b/src/Propellor/Types/Docker.hs index 42a65923..3eafa59d 100644 --- a/src/Propellor/Types/Docker.hs +++ b/src/Propellor/Types/Docker.hs @@ -1,6 +1,7 @@ module Propellor.Types.Docker where import Propellor.Types.OS +import Propellor.Types.Empty import Data.Monoid import qualified Data.Map as M @@ -18,6 +19,12 @@ instance Monoid (DockerInfo h) where , _dockerContainers = M.union (_dockerContainers old) (_dockerContainers new) } +instance Empty (DockerInfo h) where + isEmpty i = and + [ isEmpty (_dockerRunParams i) + , isEmpty (_dockerContainers i) + ] + newtype DockerRunParam = DockerRunParam (HostName -> String) instance Show DockerRunParam where diff --git a/src/Propellor/Types/Empty.hs b/src/Propellor/Types/Empty.hs new file mode 100644 index 00000000..dcd2f4a0 --- /dev/null +++ b/src/Propellor/Types/Empty.hs @@ -0,0 +1,16 @@ +module Propellor.Types.Empty where + +import qualified Data.Map as M +import qualified Data.Set as S + +class Empty t where + isEmpty :: t -> Bool + +instance Empty [a] where + isEmpty = null + +instance Empty (M.Map k v) where + isEmpty = M.null + +instance Empty (S.Set v) where + isEmpty = S.null -- cgit v1.2.3