summaryrefslogtreecommitdiff
path: root/src/Propellor/Property.hs
diff options
context:
space:
mode:
authorJoey Hess2015-01-24 22:38:10 -0400
committerJoey Hess2015-01-24 22:38:51 -0400
commit0ee04ecc43e047b00437fb660e71f7dd67dd3afc (patch)
tree621e0ebc68a2afb9410ce6f368bec865f31cc507 /src/Propellor/Property.hs
parent141a7c028bba8d5b9743f2ab1397e69c313a523c (diff)
GADT properties seem to work (untested)
* Property has been converted to a GADT, and will be Property NoInfo or Property HasInfo. This was done to make sure that ensureProperty is only used on properties that do not have Info. Transition guide: - Change all "Property" to "Property NoInfo" or "Property WithInfo" (The compiler can tell you if you got it wrong!) - To construct a RevertableProperty, it is useful to use the new (<!>) operator - Constructing a list of properties can be problimatic, since Property NoInto and Property WithInfo are different types and cannot appear in the same list. To deal with this, "props" has been added, and can built up a list of properties of different types, using the same (&) and (!) operators that are used to build up a host's properties.
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