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.

debian/changelog

@@ -1,3 +1,10 @@
+propellor (1.1.1) UNRELEASED; urgency=medium
+
+  * Display a warning when ensureProperty is used on a property which has
+    Info and is so prevented from propigating it.
+
+ -- Joey Hess <id@joeyh.name>  Sun, 07 Dec 2014 17:08:55 -0400
+
 propellor (1.1.0) unstable; urgency=medium
 
   * --spin target --via relay causes propellor to bounce through an

propellor.cabal

@@ -118,6 +118,7 @@ Library
     Propellor.Types.Chroot
     Propellor.Types.Docker
     Propellor.Types.Dns
+    Propellor.Types.Empty
     Propellor.Types.OS
     Propellor.Types.PrivData
   Other-Modules:

src/Propellor/Engine.hs

@@ -1,6 +1,14 @@
 {-# LANGUAGE PackageImports #-}
 
-module Propellor.Engine where
+module Propellor.Engine (
+	mainProperties,
+	runPropellor,
+	ensureProperty,
+	ensureProperties,
+	fromHost,
+	onlyProcess,
+	processChainOutput,
+) where
 
 import System.Exit
 import System.IO
@@ -15,6 +23,7 @@ import System.FilePath
 import System.Directory
 
 import Propellor.Types
+import Propellor.Types.Empty
 import Propellor.Message
 import Propellor.Exception
 import Propellor.Info
@@ -27,7 +36,7 @@ import Utility.Monad
 mainProperties :: Host -> IO ()
 mainProperties host = do
 	ret <- runPropellor host $
-		ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
+		ensureProperties [Property "overall" (ensurePropertiesWith ensureProperty' $ hostProperties host) mempty]
 	h <- mkMessageHandle
         whenConsole h $
 		setTitle "propellor: done"
@@ -57,18 +66,27 @@ runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc
 --
 -- Note that any info of the Property is not propigated out to
 -- the enclosing Property, and so will not be available for propellor to
--- use.
+-- use. A warning message will be printed if this is detected.
 ensureProperty :: Property -> Propellor Result
-ensureProperty = catchPropellor . propertySatisfy
+ensureProperty p = do
+	unless (isEmpty (getInfo p)) $
+		warningMessage $ "ensureProperty called on " ++ show p ++ "; will not propigate its info: " ++ show (getInfo p)
+	ensureProperty' p
+
+ensureProperty' :: Property -> Propellor Result
+ensureProperty' = catchPropellor . propertySatisfy
 
 -- | Ensures a list of Properties, with a display of each as it runs.
 ensureProperties :: [Property] -> Propellor Result
-ensureProperties ps = ensure ps NoChange
+ensureProperties = ensurePropertiesWith ensureProperty
+
+ensurePropertiesWith :: (Property -> Propellor Result) -> [Property] -> Propellor Result
+ensurePropertiesWith a ps = ensure ps NoChange
   where
 	ensure [] rs = return rs
-	ensure (l:ls) rs = do
+	ensure (p:ls) rs = do
 		hn <- asks hostName
-		r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
+		r <- actionMessageOn hn (propertyDesc p) (a p)
 		ensure ls (r <> rs)
 
 -- | Lifts an action into a different host.

src/Propellor/Types.hs

@@ -43,6 +43,7 @@ import Propellor.Types.Chroot
 import Propellor.Types.Dns
 import Propellor.Types.Docker
 import Propellor.Types.PrivData
+import Propellor.Types.Empty
 
 -- | Everything Propellor knows about a system: Its hostname,
 -- properties and other info.
@@ -188,6 +189,18 @@ instance Monoid Info where
 		, _chrootinfo = _chrootinfo old <> _chrootinfo new
 		}
 
+instance Empty Info where
+	isEmpty i = and
+		[ isEmpty (_os i)
+		, isEmpty (_privDataFields i)
+		, isEmpty (_sshPubKey i)
+		, isEmpty (_aliases i)
+		, isEmpty (_dns i)
+		, isEmpty (_namedconf i)
+		, isEmpty (_dockerinfo i)
+		, isEmpty (_chrootinfo i)
+		]
+
 data Val a = Val a | NoVal
 	deriving (Eq, Show)
 
@@ -197,6 +210,10 @@ instance Monoid (Val a) where
 		NoVal -> old
 		_ -> new
 
+instance Empty (Val a) where
+	isEmpty NoVal = True
+	isEmpty _ = False
+
 fromVal :: Val a -> Maybe a
 fromVal (Val a) = Just a
 fromVal NoVal = Nothing

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

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

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

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