summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Propellor.hs3
-rw-r--r--Propellor/Engine.hs3
-rw-r--r--Propellor/Property.hs34
-rw-r--r--Propellor/Types.hs16
4 files changed, 31 insertions, 25 deletions
diff --git a/Propellor.hs b/Propellor.hs
index bc26df58..3e7e88ad 100644
--- a/Propellor.hs
+++ b/Propellor.hs
@@ -17,7 +17,7 @@
-- > getProperties "example.com" = Just
-- > [ Apt.installed ["mydaemon"]
-- > , "/etc/mydaemon.conf" `File.containsLine` "secure=1"
--- > `onChange` cmdProperty "service" ["mydaemon", "restart"]]
+-- > `onChange` cmdProperty "service" ["mydaemon", "restart"]
-- > ]
-- > getProperties _ = Nothing
--
@@ -57,3 +57,4 @@ import Data.Maybe as X
import Data.Either as X
import Control.Applicative as X
import Control.Monad as X
+import Data.Monoid as X
diff --git a/Propellor/Engine.hs b/Propellor/Engine.hs
index 22091938..a220ec77 100644
--- a/Propellor/Engine.hs
+++ b/Propellor/Engine.hs
@@ -3,6 +3,7 @@ module Propellor.Engine where
import System.Console.ANSI
import System.Exit
import System.IO
+import Data.Monoid
import Propellor.Types
import Utility.Exception
@@ -42,7 +43,7 @@ ensureProperties' ps = ensure ps NoChange
putStrLn "done"
setSGR []
hFlush stdout
- ensure ls (combineResult r rs)
+ ensure ls (r <> rs)
warningMessage :: String -> IO ()
warningMessage s = do
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index c2e2cbab..a1b871c2 100644
--- a/Propellor/Property.hs
+++ b/Propellor/Property.hs
@@ -2,6 +2,7 @@ module Propellor.Property where
import System.Directory
import Control.Monad
+import Data.Monoid
import Propellor.Types
import Propellor.Engine
@@ -13,16 +14,15 @@ makeChange a = a >> return MadeChange
noChange :: IO Result
noChange = return NoChange
-{- | Combines a list of properties, resulting in a single property
- - that when run will run each property in the list in turn,
- - and print out the description of each as it's run. Does not stop
- - on failure; does propigate overall success/failure.
- -}
+-- | Combines a list of properties, resulting in a single property
+-- that when run will run each property in the list in turn,
+-- and print out the description of each as it's run. Does not stop
+-- on failure; does propigate overall success/failure.
propertyList :: Desc -> [Property] -> Property
propertyList desc ps = Property desc $ ensureProperties' ps
-{- | Combines a list of properties, resulting in one property that
- - ensures each in turn, stopping on failure. -}
+-- | Combines a list of properties, resulting in one property that
+-- ensures each in turn, stopping on failure.
combineProperties :: [Property] -> Property
combineProperties ps = Property desc $ go ps NoChange
where
@@ -31,14 +31,14 @@ combineProperties ps = Property desc $ go ps NoChange
r <- ensureProperty l
case r of
FailedChange -> return FailedChange
- _ -> go ls (combineResult r rs)
+ _ -> go ls (r <> rs)
desc = case ps of
(p:_) -> propertyDesc p
_ -> "(empty)"
-{- | Makes a perhaps non-idempotent Property be idempotent by using a flag
- - file to indicate whether it has run before.
- - Use with caution. -}
+-- | Makes a perhaps non-idempotent Property be idempotent by using a flag
+-- file to indicate whether it has run before.
+-- Use with caution.
flagFile :: Property -> FilePath -> Property
flagFile property flagfile = Property (propertyDesc property) $
go =<< doesFileExist flagfile
@@ -50,19 +50,19 @@ flagFile property flagfile = Property (propertyDesc property) $
writeFile flagfile ""
return r
-{- | Whenever a change has to be made for a Property, causes a hook
- - Property to also be run, but not otherwise. -}
+--- | Whenever a change has to be made for a Property, causes a hook
+-- Property to also be run, but not otherwise.
onChange :: Property -> Property -> Property
property `onChange` hook = Property (propertyDesc property) $ do
r <- ensureProperty property
case r of
MadeChange -> do
r' <- ensureProperty hook
- return $ combineResult r r'
+ return $ r <> r'
_ -> return r
-{- | Indicates that the first property can only be satisfied once
- - the second is. -}
+-- | Indicates that the first property can only be satisfied once
+-- the second is.
requires :: Property -> Property -> Property
x `requires` y = combineProperties [y, x] `describe` propertyDesc x
@@ -73,7 +73,7 @@ describe p d = p { propertyDesc = d }
(==>) = flip describe
infixl 1 ==>
-{- | Makes a Property only be performed when a test succeeds. -}
+-- | Makes a Property only be performed when a test succeeds.
check :: IO Bool -> Property -> Property
check c property = Property (propertyDesc property) $ ifM c
( ensureProperty property
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index 70ad8f9b..ec472ffe 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -1,5 +1,7 @@
module Propellor.Types where
+import Data.Monoid
+
type HostName = String
type UserName = String
@@ -14,9 +16,11 @@ type Desc = String
data Result = NoChange | MadeChange | FailedChange
deriving (Show, Eq)
-combineResult :: Result -> Result -> Result
-combineResult FailedChange _ = FailedChange
-combineResult _ FailedChange = FailedChange
-combineResult MadeChange _ = MadeChange
-combineResult _ MadeChange = MadeChange
-combineResult NoChange NoChange = NoChange
+instance Monoid Result where
+ mempty = NoChange
+
+ mappend FailedChange _ = FailedChange
+ mappend _ FailedChange = FailedChange
+ mappend MadeChange _ = MadeChange
+ mappend _ MadeChange = MadeChange
+ mappend NoChange NoChange = NoChange