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/Engine.hs | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) (limited to 'src/Propellor/Engine.hs') diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index aa2ea4a3..dc8b2bc5 100644 --- a/src/Propellor/Engine.hs +++ b/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. -- cgit v1.2.3