summaryrefslogtreecommitdiff
path: root/src/Propellor/Property.hs
diff options
context:
space:
mode:
authorJoey Hess2015-10-26 15:38:29 -0400
committerJoey Hess2015-10-26 15:38:29 -0400
commit886705bf83f6351bc6740a07918f668cb8639197 (patch)
tree9d68eb5a2447ab91ef967d55305cde3b3859b8a6 /src/Propellor/Property.hs
parent103da27d1be08ed31574c9eb37632ac260963afe (diff)
parent77e3a5d4d968f3567b1b8e62996e0e6c803ab642 (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'src/Propellor/Property.hs')
-rw-r--r--src/Propellor/Property.hs69
1 files changed, 43 insertions, 26 deletions
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 95805054..d80d9c1f 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -66,30 +66,43 @@ flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do
-- | Indicates that the first property depends on the second,
-- so before the first is ensured, the second must be ensured.
+--
+-- The combined property uses the description of the first property.
requires :: Combines x y => x -> y -> CombinedType x y
-requires = (<<>>)
+requires = combineWith
+ -- Run action of y, then x
+ (flip (<>))
+ -- When reverting, run in reverse order.
+ (<>)
-- | Combines together two properties, resulting in one property
-- that ensures the first, and if the first succeeds, ensures the second.
--
-- The combined property uses the description of the first property.
-before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x
-before x y = (y `requires` x) `describe` getDesc x
+before :: Combines x y => x -> y -> CombinedType x y
+before = combineWith
+ -- Run action of x, then y
+ (<>)
+ -- When reverting, run in reverse order.
+ (flip (<>))
-- | Whenever a change has to be made for a Property, causes a hook
-- Property to also be run, but not otherwise.
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
+ :: (Combines x y)
+ => x
+ -> y
+ -> CombinedType x y
+onChange = combineWith combiner revertcombiner
+ where
+ combiner p hook = do
+ r <- p
+ case r of
+ MadeChange -> do
+ r' <- hook
+ return $ r <> r'
+ _ -> return r
+ revertcombiner = (<>)
-- | Same as `onChange` except that if property y fails, a flag file
-- is generated. On next run, if the flag file is present, property y
@@ -99,14 +112,14 @@ onChange = combineWith $ \p hook -> do
-- `FailedChange`. But if this property is applied again, it returns
-- `NoChange`. This behavior can cause trouble...
onChangeFlagOnFail
- :: (Combines (Property x) (Property y))
+ :: (Combines x y)
=> FilePath
- -> Property x
- -> Property y
- -> CombinedType (Property x) (Property y)
-onChangeFlagOnFail flagfile = combineWith go
+ -> x
+ -> y
+ -> CombinedType x y
+onChangeFlagOnFail flagfile = combineWith combiner revertcombiner
where
- go s1 s2 = do
+ combiner s1 s2 = do
r1 <- s1
case r1 of
MadeChange -> flagFailed s2
@@ -114,6 +127,7 @@ onChangeFlagOnFail flagfile = combineWith go
(flagFailed s2
, return r1
)
+ revertcombiner = (<>)
flagFailed s = do
r <- s
liftIO $ case r of
@@ -151,12 +165,15 @@ check c p = adjustPropertySatisfy p $ \satisfy ->
-- | Tries the first property, but if it fails to work, instead uses
-- the second.
-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
+fallback :: (Combines p1 p2) => p1 -> p2 -> CombinedType p1 p2
+fallback = combineWith combiner revertcombiner
+ where
+ combiner a1 a2 = do
+ r <- a1
+ if r == FailedChange
+ then a2
+ else return r
+ revertcombiner = (<>)
-- | Marks a Property as trivial. It can only return FailedChange or
-- NoChange.