summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2015-07-21 11:18:42 -0400
committerJoey Hess2015-07-21 11:18:42 -0400
commit30c024a9db09b18fa4f17224e398d8bec695c17b (patch)
tree8f946a98886e8637e8314ea4a3b24e7791c70f47 /src
parentc35f77a72494bcceffbd1911ae2be25ad8af6a14 (diff)
parentb90f6131e0972e321be327d3134b6d7c51154f61 (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Property.hs35
1 files changed, 35 insertions, 0 deletions
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 1801902e..b90d5b86 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -54,6 +54,41 @@ onChange = combineWith $ \p hook -> do
return $ r <> r'
_ -> return r
+-- | 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
+-- is executed even if property x doesn't change.
+--
+-- With `onChange`, if y fails, the property x `onChange` y returns
+-- `FailedChange`. But if this property is applied again, it returns
+-- `NoChange`. This behavior can cause trouble...
+onChangeFlagOnFail
+ :: (Combines (Property x) (Property y))
+ => FilePath
+ -> Property x
+ -> Property y
+ -> CombinedType (Property x) (Property y)
+onChangeFlagOnFail flagfile p1 p2 =
+ combineWith go p1 p2
+ where
+ go s1 s2 = do
+ r1 <- s1
+ case r1 of
+ MadeChange -> flagFailed s2
+ _ -> ifM (liftIO $ doesFileExist flagfile)
+ (flagFailed s2
+ , return r1
+ )
+ flagFailed s = do
+ r <- s
+ liftIO $ case r of
+ FailedChange -> createFlagFile
+ _ -> removeFlagFile
+ return r
+ createFlagFile = unlessM (doesFileExist flagfile) $ do
+ createDirectoryIfMissing True (takeDirectory flagfile)
+ writeFile flagfile ""
+ removeFlagFile = whenM (doesFileExist flagfile) $ removeFile flagfile
+
-- | Alias for @flip describe@
(==>) :: IsProp (Property i) => Desc -> Property i -> Property i
(==>) = flip describe