summaryrefslogtreecommitdiff
path: root/Propellor/Property.hs
diff options
context:
space:
mode:
authorJoey Hess2014-04-18 04:48:49 -0400
committerJoey Hess2014-04-18 04:48:49 -0400
commit5f6c3ad56490a8c3063f8daa1cd8b0a302b63ddd (patch)
treea05856a744c7ce6a6be69db327e5b8afec013257 /Propellor/Property.hs
parent4e4fb9ab7ca13f5148c6d4b08f53f518429530a8 (diff)
All Property combinators now combine together their Attr settings.
So Attr settings can be made inside a propertyList, for example.
Diffstat (limited to 'Propellor/Property.hs')
-rw-r--r--Propellor/Property.hs79
1 files changed, 47 insertions, 32 deletions
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index aa419069..24494654 100644
--- a/Propellor/Property.hs
+++ b/Propellor/Property.hs
@@ -5,6 +5,7 @@ module Propellor.Property where
import System.Directory
import Control.Monad
import Data.Monoid
+import Data.List
import Control.Monad.IfElse
import "mtl" Control.Monad.Reader
@@ -15,23 +16,21 @@ import Propellor.Engine
import Utility.Monad
import System.FilePath
-makeChange :: IO () -> Propellor Result
-makeChange a = liftIO a >> return MadeChange
-
-noChange :: Propellor Result
-noChange = return NoChange
+-- Constructs a Property.
+property :: Desc -> Propellor Result -> Property
+property d s = Property d s id
-- | 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
+propertyList desc ps = Property desc (ensureProperties ps) (combineSetAttrs ps)
-- | Combines a list of properties, resulting in one property that
-- ensures each in turn, stopping on failure.
combineProperties :: Desc -> [Property] -> Property
-combineProperties desc ps = property desc $ go ps NoChange
+combineProperties desc ps = Property desc (go ps NoChange) (combineSetAttrs ps)
where
go [] rs = return rs
go (l:ls) rs = do
@@ -44,11 +43,8 @@ combineProperties desc ps = property desc $ go ps NoChange
-- that ensures the first, and if the first succeeds, ensures the second.
-- The property uses the description of the first property.
before :: Property -> Property -> Property
-p1 `before` p2 = property (propertyDesc p1) $ do
- r <- ensureProperty p1
- case r of
- FailedChange -> return FailedChange
- _ -> ensureProperty p2
+p1 `before` p2 = p2 `requires` p1
+ `describe` (propertyDesc p1)
-- | Makes a perhaps non-idempotent Property be idempotent by using a flag
-- file to indicate whether it has run before.
@@ -57,13 +53,13 @@ flagFile :: Property -> FilePath -> Property
flagFile p = flagFile' p . return
flagFile' :: Property -> IO FilePath -> Property
-flagFile' p getflagfile = property (propertyDesc p) $ do
+flagFile' p getflagfile = adjustProperty p $ \satisfy -> do
flagfile <- liftIO getflagfile
- go flagfile =<< liftIO (doesFileExist flagfile)
+ go satisfy flagfile =<< liftIO (doesFileExist flagfile)
where
- go _ True = return NoChange
- go flagfile False = do
- r <- ensureProperty p
+ go _ _ True = return NoChange
+ go satisfy flagfile False = do
+ r <- satisfy
when (r == MadeChange) $ liftIO $
unlessM (doesFileExist flagfile) $ do
createDirectoryIfMissing True (takeDirectory flagfile)
@@ -73,22 +69,24 @@ flagFile' p getflagfile = property (propertyDesc p) $ do
--- | 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
-p `onChange` hook = property (propertyDesc p) $ do
- r <- ensureProperty p
- case r of
- MadeChange -> do
- r' <- ensureProperty hook
- return $ r <> r'
- _ -> return r
+p `onChange` hook = Property (propertyDesc p) satisfy (combineSetAttr p hook)
+ where
+ satisfy = do
+ r <- ensureProperty p
+ case r of
+ MadeChange -> do
+ r' <- ensureProperty hook
+ return $ r <> r'
+ _ -> return r
(==>) :: Desc -> Property -> Property
(==>) = flip describe
infixl 1 ==>
--- | Makes a Property only be performed when a test succeeds.
+-- | Makes a Property only need to do anything when a test succeeds.
check :: IO Bool -> Property -> Property
-check c p = property (propertyDesc p) $ ifM (liftIO c)
- ( ensureProperty p
+check c p = adjustProperty p $ \satisfy -> ifM (liftIO c)
+ ( satisfy
, return NoChange
)
@@ -99,8 +97,8 @@ check c p = property (propertyDesc p) $ ifM (liftIO c)
-- to be made as it is to just idempotently assure the property is
-- satisfied. For example, chmodding a file.
trivial :: Property -> Property
-trivial p = property (propertyDesc p) $ do
- r <- ensureProperty p
+trivial p = adjustProperty p $ \satisfy -> do
+ r <- satisfy
if r == MadeChange
then return NoChange
else return r
@@ -133,16 +131,33 @@ host hn = Host [] (\_ -> newAttr hn)
-- | Adds a property to a Host
--
--- Can add Properties, RevertableProperties, and AttrProperties
+-- Can add Properties and RevertableProperties
(&) :: IsProp p => Host -> p -> Host
-(Host ps as) & p = Host (ps ++ [toProp p]) (getAttr p . as)
+(Host ps as) & p = Host (ps ++ [toProp p]) (setAttr p . as)
infixl 1 &
-- | Adds a property to the Host in reverted form.
(!) :: Host -> RevertableProperty -> Host
-(Host ps as) ! p = Host (ps ++ [toProp q]) (getAttr q . as)
+(Host ps as) ! p = Host (ps ++ [toProp q]) (setAttr q . as)
where
q = revert p
infixl 1 !
+
+-- Changes the action that is performed to satisfy a property.
+adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
+adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
+
+-- Combines the Attr settings of two properties.
+combineSetAttr :: (IsProp p, IsProp q) => p -> q -> SetAttr
+combineSetAttr p q = setAttr p . setAttr q
+
+combineSetAttrs :: IsProp p => [p] -> SetAttr
+combineSetAttrs = foldl' (.) id . map setAttr
+
+makeChange :: IO () -> Propellor Result
+makeChange a = liftIO a >> return MadeChange
+
+noChange :: Propellor Result
+noChange = return NoChange