From 9d348647d9d1b47d0119b3988e0ece9aa383d166 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 31 Mar 2014 01:06:44 -0400 Subject: [PATCH] propellor spin --- Propellor.hs | 35 ++++++++++++++++---------------- Propellor/Engine.hs | 47 +++++++++++++++++++++++++++++++++++++++++++ Propellor/PrivData.hs | 2 +- Propellor/Property.hs | 44 +--------------------------------------- propellor.cabal | 3 ++- 5 files changed, 69 insertions(+), 62 deletions(-) create mode 100644 Propellor/Engine.hs diff --git a/Propellor.hs b/Propellor.hs index 1ab2cbd..bc26df5 100644 --- a/Propellor.hs +++ b/Propellor.hs @@ -1,26 +1,25 @@ -- | Pulls in lots of useful modules for building and using Properties. --- +-- -- Propellor enures that the system it's run in satisfies a list of -- properties, taking action as necessary when a property is not yet met. -- -- A simple propellor program example: -- --- ---> import Propellor ---> import Propellor.CmdLine ---> import qualified Propellor.Property.File as File ---> import qualified Propellor.Property.Apt as Apt ---> ---> main :: IO () ---> main = defaultMain getProperties ---> ---> getProperties :: HostName -> Maybe [Property] ---> getProperties "example.com" = Just ---> [ Apt.installed ["mydaemon"] ---> , "/etc/mydaemon.conf" `File.containsLine` "secure=1" ---> `onChange` cmdProperty "service" ["mydaemon", "restart"]] ---> ] ---> getProperties _ = Nothing +-- > import Propellor +-- > import Propellor.CmdLine +-- > import qualified Propellor.Property.File as File +-- > import qualified Propellor.Property.Apt as Apt +-- > +-- > main :: IO () +-- > main = defaultMain getProperties +-- > +-- > getProperties :: HostName -> Maybe [Property] +-- > getProperties "example.com" = Just +-- > [ Apt.installed ["mydaemon"] +-- > , "/etc/mydaemon.conf" `File.containsLine` "secure=1" +-- > `onChange` cmdProperty "service" ["mydaemon", "restart"]] +-- > ] +-- > getProperties _ = Nothing -- -- See config.hs for a more complete example, and clone Propellor's -- git repository for a deployable system using Propellor: @@ -31,12 +30,14 @@ module Propellor ( , module Propellor.Property , module Propellor.Property.Cmd , module Propellor.PrivData + , module Propellor.Engine , module X ) where import Propellor.Types import Propellor.Property +import Propellor.Engine import Propellor.Property.Cmd import Propellor.PrivData diff --git a/Propellor/Engine.hs b/Propellor/Engine.hs new file mode 100644 index 0000000..e5f8a96 --- /dev/null +++ b/Propellor/Engine.hs @@ -0,0 +1,47 @@ +module Propellor.Engine where + +import System.Console.ANSI +import System.Exit +import System.IO + +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] + 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 + 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 [] + ensure ls (combineResult r rs) + +warningMessage :: String -> IO () +warningMessage s = do + setSGR [SetColor Foreground Vivid Red] + putStrLn $ "** warning: " ++ s + setSGR [] + hFlush stdout diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs index 27b3f77..5f0de3b 100644 --- a/Propellor/PrivData.hs +++ b/Propellor/PrivData.hs @@ -9,7 +9,7 @@ import Data.Maybe import Control.Monad import Propellor.Types -import Propellor.Property +import Propellor.Engine import Utility.Monad import Utility.PartialPrelude import Utility.Exception diff --git a/Propellor/Property.hs b/Propellor/Property.hs index 727fe25..c2e2cba 100644 --- a/Propellor/Property.hs +++ b/Propellor/Property.hs @@ -2,13 +2,10 @@ module Propellor.Property where import System.Directory import Control.Monad -import System.Console.ANSI -import System.Exit -import System.IO import Propellor.Types +import Propellor.Engine import Utility.Monad -import Utility.Exception makeChange :: IO () -> IO Result makeChange a = a >> return MadeChange @@ -82,42 +79,3 @@ check c property = Property (propertyDesc property) $ ifM c ( ensureProperty property , return NoChange ) - -ensureProperty :: Property -> IO Result -ensureProperty = catchDefaultIO FailedChange . propertySatisfy - -ensureProperties :: [Property] -> IO () -ensureProperties ps = do - r <- ensureProperties' [propertyList "overall" ps] - 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 - 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 [] - ensure ls (combineResult r rs) - -warningMessage :: String -> IO () -warningMessage s = do - setSGR [SetColor Foreground Vivid Red] - putStrLn $ "** warning: " ++ s - setSGR [] - hFlush stdout diff --git a/propellor.cabal b/propellor.cabal index f064054..6c761cb 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 0.1 +Version: 0.1.1 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess @@ -60,6 +60,7 @@ Library Propellor.Property.User Propellor.CmdLine Propellor.PrivData + Propellor.Engine Propellor.Types Other-Modules: Utility.Applicative