summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2015-11-26 08:48:10 -0400
committerJoey Hess2015-11-26 08:48:10 -0400
commitf736486013ba3d317cac808f490c1bfa956605f4 (patch)
treef20b9ff8522cf72734b0f21ea4d211ddc7f502f2 /src/Propellor
parentcb97f272633f44edb9ad53982ea9f4bdb8c7192e (diff)
Added changesFile property combinator.
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Property.hs37
1 files changed, 37 insertions, 0 deletions
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index e967cac9..063e7814 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -12,6 +12,7 @@ module Propellor.Property (
, check
, fallback
, trivial
+ , changesFile
, revert
-- * Property descriptions
, describe
@@ -33,10 +34,12 @@ import Control.Monad
import Data.Monoid
import Control.Monad.IfElse
import "mtl" Control.Monad.RWS.Strict
+import System.Posix.Files
import Propellor.Types
import Propellor.Info
import Propellor.Exception
+import Utility.Exception
import Utility.Monad
-- | Constructs a Property, from a description and an action to run to
@@ -188,6 +191,40 @@ trivial p = adjustPropertySatisfy p $ \satisfy -> do
then return NoChange
else return r
+-- | 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
+ where
+ getstat = liftIO $ catchMaybeIO $ getSymbolicLinkStatus f
+ samestat Nothing Nothing = True
+ samestat (Just a) (Just b) = and
+ -- everything except for atime
+ [ deviceID a == deviceID b
+ , fileID a == fileID b
+ , fileMode a == fileMode b
+ , fileOwner a == fileOwner b
+ , fileGroup a == fileGroup b
+ , specialDeviceID a == specialDeviceID b
+ , fileSize a == fileSize b
+ , modificationTimeHiRes a == modificationTimeHiRes b
+ , isBlockDevice a == isBlockDevice b
+ , isCharacterDevice a == isCharacterDevice b
+ , isNamedPipe a == isNamedPipe b
+ , isRegularFile a == isRegularFile b
+ , isDirectory a == isDirectory b
+ , isSymbolicLink a == isSymbolicLink b
+ , isSocket a == isSocket b
+ ]
+ samestat _ _ = False
+
-- | Makes a property that is satisfied differently depending on the host's
-- operating system.
--