summaryrefslogtreecommitdiff
path: root/Propellor/Engine.hs
diff options
context:
space:
mode:
authorJoey Hess <joey@kitenet.net>2014-04-11 01:09:01 -0400
committerJoey Hess <joey@kitenet.net>2014-04-11 01:09:01 -0400
commit856ce97995bc34e35fd8e0233341f26a37b19cf5 (patch)
tree1d93492b36cd07d58437d2cb0f902ad53b3abe6e /Propellor/Engine.hs
parent07a071ac7f5b2f71e376a9a1a78a84a6bf02129b (diff)
parent47ff089f844c707eaa3ffd7255dc733721fb6adf (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'Propellor/Engine.hs')
-rw-r--r--Propellor/Engine.hs23
1 files changed, 15 insertions, 8 deletions
diff --git a/Propellor/Engine.hs b/Propellor/Engine.hs
index 1ae224ca..81d979ac 100644
--- a/Propellor/Engine.hs
+++ b/Propellor/Engine.hs
@@ -1,30 +1,37 @@
+{-# LANGUAGE PackageImports #-}
+
module Propellor.Engine where
import System.Exit
import System.IO
import Data.Monoid
import System.Console.ANSI
+import "mtl" Control.Monad.Reader
import Propellor.Types
import Propellor.Message
-import Utility.Exception
+import Propellor.Exception
-ensureProperty :: Property -> IO Result
-ensureProperty = catchDefaultIO FailedChange . propertySatisfy
+runPropellor :: Attr -> Propellor a -> IO a
+runPropellor attr a = runReaderT (runWithAttr a) attr
-ensureProperties :: [Property] -> IO ()
-ensureProperties ps = do
- r <- ensureProperties' [Property "overall" $ ensureProperties' ps]
+mainProperties :: Attr -> [Property] -> IO ()
+mainProperties attr ps = do
+ r <- runPropellor attr $
+ ensureProperties [Property "overall" $ ensureProperties ps]
setTitle "propellor: done"
hFlush stdout
case r of
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
-ensureProperties' :: [Property] -> IO Result
-ensureProperties' ps = ensure ps NoChange
+ensureProperties :: [Property] -> Propellor Result
+ensureProperties ps = ensure ps NoChange
where
ensure [] rs = return rs
ensure (l:ls) rs = do
r <- actionMessage (propertyDesc l) (ensureProperty l)
ensure ls (r <> rs)
+
+ensureProperty :: Property -> Propellor Result
+ensureProperty = catchPropellor . propertySatisfy