summaryrefslogtreecommitdiff
path: root/Propellor/Engine.hs
blob: a220ec77ab127dde821db88099ebf307d45d2f4a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
module Propellor.Engine where

import System.Console.ANSI
import System.Exit
import System.IO
import Data.Monoid

import Propellor.Types
import Utility.Exception

ensureProperty :: Property -> IO Result
ensureProperty = catchDefaultIO FailedChange . propertySatisfy

ensureProperties :: [Property] -> IO ()
ensureProperties ps = do
	r <- 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
  where
	ensure [] rs = return rs
	ensure (l:ls) rs = do
		setTitle $ propertyDesc l
		hFlush stdout
		r <- ensureProperty l
		clearFromCursorToLineBeginning
		setCursorColumn 0
		putStr $ propertyDesc l ++ "... "
		case r of
			FailedChange -> do
				setSGR [SetColor Foreground Vivid Red]
				putStrLn "failed"
			NoChange -> do
				setSGR [SetColor Foreground Dull Green]
				putStrLn "unchanged"
			MadeChange -> do
				setSGR [SetColor Foreground Vivid Green]
				putStrLn "done"
		setSGR []
		hFlush stdout
		ensure ls (r <> rs)

warningMessage :: String -> IO ()
warningMessage s = do
	setSGR [SetColor Foreground Vivid Red]
	putStrLn $ "** warning: " ++ s
	setSGR []
	hFlush stdout