From 4c96b0681c554965bc2aff15a04eb7a48268b3f6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 31 May 2014 18:52:42 -0400 Subject: propellor spin --- src/Propellor/Engine.hs | 2 +- src/Propellor/Message.hs | 19 +++++++++++++++++-- 2 files changed, 18 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 773e234c..1fba6a23 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 780471c3..afbed1ca 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 -- cgit v1.2.3