diff options
| author | Joey Hess <id@joeyh.name> | 2014-12-07 12:04:58 -0400 |
|---|---|---|
| committer | Joey Hess <id@joeyh.name> | 2014-12-07 12:04:58 -0400 |
| commit | 322ae878bbaef94736fdc4cae60b6c3b8c17a54d (patch) | |
| tree | 4113593f21d964ad8f821ebbd408a528011f1398 /src/Propellor/Engine.hs | |
| parent | b7da90a91516c0d496c44459ed03009e58f39233 (diff) | |
| parent | dd40a05ced3b7c50a3a7751c66ad5a253056459e (diff) | |
Merge branch 'joeyconfig'
Conflicts:
privdata.joey/privdata.gpg
Diffstat (limited to 'src/Propellor/Engine.hs')
| -rw-r--r-- | src/Propellor/Engine.hs | 37 |
1 files changed, 29 insertions, 8 deletions
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 81cc2397..44b10cab 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -7,7 +7,7 @@ import System.IO import Data.Monoid import Control.Applicative import System.Console.ANSI -import "mtl" Control.Monad.Reader +import "mtl" Control.Monad.RWS.Strict import Control.Exception (bracket) import System.PosixCompat import System.Posix.IO @@ -22,21 +22,37 @@ import Utility.Exception import Utility.PartialPrelude import Utility.Monad -runPropellor :: Host -> Propellor a -> IO a -runPropellor host a = runReaderT (runWithHost a) host - +-- | Gets the Properties of a Host, and ensures them all, +-- with nice display of what's being done. mainProperties :: Host -> IO () mainProperties host = do - r <- runPropellor host $ + ret <- runPropellor host $ ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty] h <- mkMessageHandle whenConsole h $ setTitle "propellor: done" hFlush stdout - case r of + case ret of FailedChange -> exitWith (ExitFailure 1) _ -> exitWith ExitSuccess +-- | Runs a Propellor action with the specified host. +-- +-- If the Result is not FailedChange, any EndActions +-- that were accumulated while running the action +-- are then also run. +runPropellor :: Host -> Propellor Result -> IO Result +runPropellor host a = do + (res, _s, endactions) <- runRWST (runWithHost a) host () + endres <- mapM (runEndAction host res) endactions + return $ mconcat (res:endres) + +runEndAction :: Host -> Result -> EndAction -> IO Result +runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc $ do + (ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host () + return ret + +-- | Ensures a list of Properties, with a display of each as it runs. ensureProperties :: [Property] -> Propellor Result ensureProperties ps = ensure ps NoChange where @@ -46,6 +62,8 @@ ensureProperties ps = ensure ps NoChange r <- actionMessageOn hn (propertyDesc l) (ensureProperty l) ensure ls (r <> rs) +-- | For when code running in the Propellor monad needs to ensure a +-- Property. ensureProperty :: Property -> Propellor Result ensureProperty = catchPropellor . propertySatisfy @@ -55,8 +73,11 @@ ensureProperty = catchPropellor . propertySatisfy fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a) fromHost l hn getter = case findHost l hn of Nothing -> return Nothing - Just h -> liftIO $ Just <$> - runReaderT (runWithHost getter) h + Just h -> do + (ret, _s, runlog) <- liftIO $ + runRWST (runWithHost getter) h () + tell runlog + return (Just ret) onlyProcess :: FilePath -> IO a -> IO a onlyProcess lockfile a = bracket lock unlock (const a) |
