summaryrefslogtreecommitdiff
path: root/src/Propellor/Property.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property.hs')
-rw-r--r--src/Propellor/Property.hs100
1 files changed, 32 insertions, 68 deletions
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index faf66074..40eb5d52 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE FlexibleContexts #-}
module Propellor.Property where
@@ -11,47 +12,20 @@ import "mtl" Control.Monad.RWS.Strict
import Propellor.Types
import Propellor.Info
-import Propellor.Engine
import Utility.Monad
-- Constructs a Property.
-property :: Desc -> Propellor Result -> Property
-property d s = mkProperty d s mempty mempty
-
--- | 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 = mkProperty desc (ensureProperties ps) mempty ps
-
--- | Combines a list of properties, resulting in one property that
--- ensures each in turn. Stops if a property fails.
-combineProperties :: Desc -> [Property] -> Property
-combineProperties desc ps = mkProperty desc (go ps NoChange) mempty ps
- where
- go [] rs = return rs
- go (l:ls) rs = do
- r <- ensureProperty l
- case r of
- FailedChange -> return FailedChange
- _ -> go ls (r <> rs)
-
--- | Combines together two properties, resulting in one property
--- 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 = p2 `requires` p1
- `describe` (propertyDesc p1)
+property :: Desc -> Propellor Result -> Property NoInfo
+property d s = simpleProperty d s mempty
-- | 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 i -> FilePath -> Property i
flagFile p = flagFile' p . return
-flagFile' :: Property -> IO FilePath -> Property
-flagFile' p getflagfile = adjustProperty p $ \satisfy -> do
+flagFile' :: Property i -> IO FilePath -> Property i
+flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do
flagfile <- liftIO getflagfile
go satisfy flagfile =<< liftIO (doesFileExist flagfile)
where
@@ -66,40 +40,38 @@ flagFile' p getflagfile = adjustProperty p $ \satisfy -> 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 = mkProperty (propertyDesc p) satisfy (propertyInfo p) cs
- where
- satisfy = do
- r <- ensureProperty p
- case r of
- MadeChange -> do
- r' <- ensureProperty hook
- return $ r <> r'
- _ -> return r
- cs = propertyChildren p ++ [hook]
-
-(==>) :: Desc -> Property -> Property
+onChange
+ :: (Combines (Property x) (Property y))
+ => Property x
+ => Property y
+ => CombinedType (Property x) (Property y)
+onChange = combineWith $ \p hook -> do
+ r <- p
+ case r of
+ MadeChange -> do
+ r' <- hook
+ return $ r <> r'
+ _ -> return r
+
+(==>) :: IsProp (Property i) => Desc -> Property i -> Property i
(==>) = flip describe
infixl 1 ==>
-- | Makes a Property only need to do anything when a test succeeds.
-check :: IO Bool -> Property -> Property
-check c p = adjustProperty p $ \satisfy -> ifM (liftIO c)
+check :: IO Bool -> Property i -> Property i
+check c p = adjustPropertySatisfy p $ \satisfy -> ifM (liftIO c)
( satisfy
, return NoChange
)
-- | Tries the first property, but if it fails to work, instead uses
-- the second.
-fallback :: Property -> Property -> Property
-fallback p1 p2 = mkProperty (propertyDesc p1) satisfy (propertyInfo p1) cs
- where
- cs = p2 : propertyChildren p1
- satisfy = do
- r <- propertySatisfy p1
- if r == FailedChange
- then propertySatisfy p2
- else return r
+fallback :: (Combines (Property p1) (Property p2)) => Property p1 -> Property p2 -> Property (CInfo p1 p2)
+fallback = combineWith $ \a1 a2 -> do
+ r <- a1
+ if r == FailedChange
+ then a2
+ else return r
-- | Marks a Property as trivial. It can only return FailedChange or
-- NoChange.
@@ -107,35 +79,27 @@ fallback p1 p2 = mkProperty (propertyDesc p1) satisfy (propertyInfo p1) cs
-- Useful when it's just as expensive to check if a change needs
-- to be made as it is to just idempotently assure the property is
-- satisfied. For example, chmodding a file.
-trivial :: Property -> Property
-trivial p = adjustProperty p $ \satisfy -> do
+trivial :: Property i -> Property i
+trivial p = adjustPropertySatisfy p $ \satisfy -> do
r <- satisfy
if r == MadeChange
then return NoChange
else return r
-doNothing :: Property
+doNothing :: Property NoInfo
doNothing = property "noop property" noChange
-- | Makes a property that is satisfied differently depending on the host's
-- operating system.
--
-- Note that the operating system may not be declared for some hosts.
-withOS :: Desc -> (Maybe System -> Propellor Result) -> Property
+withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo
withOS desc a = property desc $ a =<< getOS
-- | Undoes the effect of a property.
revert :: RevertableProperty -> RevertableProperty
revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
--- | Changes the action that is performed to satisfy a property.
-adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
-adjustProperty p f = mkProperty
- (propertyDesc p)
- (f (propertySatisfy p))
- (propertyInfo p)
- (propertyChildren p)
-
makeChange :: IO () -> Propellor Result
makeChange a = liftIO a >> return MadeChange