summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2015-12-05 15:48:03 -0400
committerJoey Hess2015-12-05 15:48:03 -0400
commitb816e40e2618a8932144bceb7c7039adc5c44c11 (patch)
treed128d9578764bc9b87d728370ffd4bc811e3b4d2 /src/Propellor
parentb15dd3010190700bc61a06b1a1d017b0500be28a (diff)
Added UncheckedProperty type, along with unchecked to indicate a Property needs its result checked, and checkResult and changesFile to check for changes.
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Property.hs22
-rw-r--r--src/Propellor/Property/Apt.hs3
-rw-r--r--src/Propellor/Types/ResultCheck.hs53
3 files changed, 67 insertions, 11 deletions
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 063e7814..f57fcaee 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -12,7 +12,6 @@ module Propellor.Property (
, check
, fallback
, trivial
- , changesFile
, revert
-- * Property descriptions
, describe
@@ -26,6 +25,12 @@ module Propellor.Property (
, noChange
, doNothing
, endAction
+ -- * Property result checking
+ , UncheckedProperty
+ , unchecked
+ , changesFile
+ , checkResult
+ , Checkable
) where
import System.Directory
@@ -37,6 +42,7 @@ import "mtl" Control.Monad.RWS.Strict
import System.Posix.Files
import Propellor.Types
+import Propellor.Types.ResultCheck
import Propellor.Info
import Propellor.Exception
import Utility.Exception
@@ -193,17 +199,13 @@ trivial p = adjustPropertySatisfy p $ \satisfy -> do
-- | Indicates that a Property may change a particular file. When the file
-- is modified, the property will return MadeChange instead of NoChange.
-changesFile :: Property i -> FilePath -> Property i
-changesFile p f = adjustPropertySatisfy p $ \satisfy -> do
- s <- getstat
- r <- satisfy
- if r == NoChange
- then do
- s' <- getstat
- return (if samestat s s' then NoChange else MadeChange)
- else return r
+changesFile :: Checkable p i => p i -> FilePath -> Property i
+changesFile p f = checkResult getstat comparestat p
where
getstat = liftIO $ catchMaybeIO $ getSymbolicLinkStatus f
+ comparestat oldstat = do
+ newstat <- getstat
+ return $ if samestat oldstat newstat then NoChange else MadeChange
samestat Nothing Nothing = True
samestat (Just a) (Just b) = and
-- everything except for atime
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index fd6230e8..83ad2cda 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -159,7 +159,8 @@ removed ps = check (or <$> isInstalled' ps) go
go = runApt $ ["-y", "remove"] ++ ps
buildDep :: [Package] -> Property NoInfo
-buildDep ps = robustly go
+buildDep ps = trivial (robustly go)
+ `changesFile` "/var/lib/dpkg/status"
`describe` (unwords $ "apt build-dep":ps)
where
go = runApt $ ["-y", "build-dep"] ++ ps
diff --git a/src/Propellor/Types/ResultCheck.hs b/src/Propellor/Types/ResultCheck.hs
new file mode 100644
index 00000000..6c2e1453
--- /dev/null
+++ b/src/Propellor/Types/ResultCheck.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+
+module Propellor.Types.ResultCheck (
+ UncheckedProperty,
+ unchecked,
+ checkResult,
+ Checkable,
+) where
+
+import Propellor.Types
+import Propellor.Exception
+
+import Data.Monoid
+import Control.Monad.IO.Class (liftIO)
+
+-- | This is a `Property` but its `Result` is not accurate; in particular
+-- it may return `NoChange` despite having made a change. However, when it
+-- returns `MadeChange`, it really did made a change, and `FailedChange`
+-- is still an error.
+data UncheckedProperty i = UncheckedProperty (Property i)
+
+-- | Use to indicate that a Property is unchecked.
+unchecked :: Property i -> UncheckedProperty i
+unchecked = UncheckedProperty
+
+-- | Checks the result of a property. Mostly used to convert a
+-- `UncheckedProperty` to a `Property`, but can also be used to further
+-- check a `Property`.
+checkResult
+ :: Checkable p i
+ => IO a
+ -- ^ Run before ensuring the property.
+ -> (a -> IO Result)
+ -- ^ Run after ensuring the property. Return `MadeChange` if a
+ -- change was detected, or `NoChange` if no change was detected.
+ -> p i
+ -> Property i
+checkResult precheck postcheck p = adjustPropertySatisfy (checkedProp p) $ \satisfy -> do
+ a <- liftIO precheck
+ r <- catchPropellor satisfy
+ -- Always run postcheck, even if the result is already MadeChange,
+ -- as it may need to clean up after precheck.
+ r' <- liftIO $ postcheck a
+ return (r <> r')
+
+class Checkable p i where
+ checkedProp :: p i -> Property i
+
+instance Checkable Property i where
+ checkedProp = id
+
+instance Checkable UncheckedProperty i where
+ checkedProp (UncheckedProperty p) = p