From 7ff39bb09840c27b4bd04f692dff2e4d45c83924 Mon Sep 17 00:00:00 2001 From: Antoine Eiche Date: Tue, 21 Jul 2015 11:30:40 +0200 Subject: Add operator onChangeFlagOnFail. It seems like `onChange` except that if property y fails, a flag file is generated. On next runs, 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... --- src/Propellor/Property.hs | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) (limited to 'src/Propellor') diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 1801902e..4da9acf3 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -54,6 +54,43 @@ onChange = combineWith $ \p hook -> do return $ r <> r' _ -> return r +-- | Same than `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... +-- +-- Use with caution. +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 -- cgit v1.2.3 From e4ecda210bd56cc0e233c3b635ac551d6ddce543 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jul 2015 11:15:05 -0400 Subject: remove caution comment I think this was inherited from flagFile, but the reasons to use caution when using flagFile (that it makes code to satisfy a property only run once) don't apply when using onChangeFlagOnFail. --- src/Propellor/Property.hs | 2 -- 1 file changed, 2 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 4da9acf3..339cb303 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -61,8 +61,6 @@ onChange = combineWith $ \p hook -> do -- 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... --- --- Use with caution. onChangeFlagOnFail :: (Combines (Property x) (Property y)) => FilePath -- cgit v1.2.3 From 1ea376cf10807778e693a2109154f143fc0f8d1d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jul 2015 11:17:00 -0400 Subject: fix layout to meet style --- src/Propellor/Property.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 339cb303..0fa8f17e 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -76,7 +76,8 @@ onChangeFlagOnFail flagfile p1 p2 = MadeChange -> flagFailed s2 _ -> ifM (liftIO $ doesFileExist flagfile) (flagFailed s2 - , return r1) + , return r1 + ) flagFailed s = do r <- s liftIO $ case r of @@ -88,7 +89,6 @@ onChangeFlagOnFail flagfile p1 p2 = writeFile flagfile "" removeFlagFile = whenM (doesFileExist flagfile) $ removeFile flagfile - -- | Alias for @flip describe@ (==>) :: IsProp (Property i) => Desc -> Property i -> Property i (==>) = flip describe -- cgit v1.2.3 From 512137a4d9c05534f94e22cd5c0d6157d2d0ef2b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jul 2015 11:18:15 -0400 Subject: language --- src/Propellor/Property.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 0fa8f17e..b90d5b86 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -54,7 +54,7 @@ onChange = combineWith $ \p hook -> do return $ r <> r' _ -> return r --- | Same than `onChange` except that if property y fails, a flag file +-- | 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. -- -- cgit v1.2.3