diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 773e234..1fba6a2 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -33,7 +33,7 @@ ensureProperties ps = ensure ps NoChange ensure [] rs = return rs ensure (l:ls) rs = do hn <- getHostName - r <- actionMessage (hn ++ " " ++ propertyDesc l) (ensureProperty l) + r <- actionMessageOn hn (propertyDesc l) (ensureProperty l) ensure ls (r <> rs) ensureProperty :: Property -> Propellor Result diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index 780471c..afbed1c 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -12,7 +12,15 @@ import Propellor.Types -- | Shows a message while performing an action, with a colored status -- display. actionMessage :: (MonadIO m, ActionResult r) => Desc -> m r -> m r -actionMessage desc a = do +actionMessage = actionMessage' Nothing + +-- | Shows a message while performing an action on a specified host, +-- with a colored status display. +actionMessageOn :: (MonadIO m, ActionResult r) => HostName -> Desc -> m r -> m r +actionMessageOn = actionMessage' . Just + +actionMessage' :: (MonadIO m, ActionResult r) => Maybe HostName -> Desc -> m r -> m r +actionMessage' mhn desc a = do liftIO $ do setTitle $ "propellor: " ++ desc hFlush stdout @@ -21,12 +29,19 @@ actionMessage desc a = do liftIO $ do setTitle "propellor: running" - let (msg, intensity, color) = getActionResult r + showhn mhn putStr $ desc ++ " ... " + let (msg, intensity, color) = getActionResult r colorLine intensity color msg hFlush stdout return r + where + showhn Nothing = return () + showhn (Just hn) = do + setSGR [SetColor Foreground Dull Cyan] + putStr (hn ++ " ") + setSGR [] warningMessage :: MonadIO m => String -> m () warningMessage s = liftIO $ colorLine Vivid Magenta $ "** warning: " ++ s