propellor/src/Propellor/Property.hs

112 lines
3.3 KiB
Haskell
Raw Normal View History

{-# LANGUAGE PackageImports #-}
{-# LANGUAGE FlexibleContexts #-}
2014-03-31 03:37:54 +00:00
module Propellor.Property where
import System.Directory
import System.FilePath
import Control.Monad
2014-03-31 14:36:45 +00:00
import Data.Monoid
2014-04-10 15:02:29 +00:00
import Control.Monad.IfElse
import "mtl" Control.Monad.RWS.Strict
2014-03-31 03:37:54 +00:00
import Propellor.Types
2014-06-09 05:45:58 +00:00
import Propellor.Info
2014-03-30 05:13:53 +00:00
import Utility.Monad
-- Constructs a Property.
property :: Desc -> Propellor Result -> Property NoInfo
property d s = simpleProperty d s mempty
2014-04-08 22:41:30 +00:00
2014-03-31 14:36:45 +00:00
-- | Makes a perhaps non-idempotent Property be idempotent by using a flag
-- file to indicate whether it has run before.
-- Use with caution.
flagFile :: Property i -> FilePath -> Property i
flagFile p = flagFile' p . return
2014-04-13 01:34:25 +00:00
flagFile' :: Property i -> IO FilePath -> Property i
flagFile' p getflagfile = adjustPropertySatisfy p $ \satisfy -> do
2014-04-13 01:34:25 +00:00
flagfile <- liftIO getflagfile
go satisfy flagfile =<< liftIO (doesFileExist flagfile)
where
go _ _ True = return NoChange
go satisfy flagfile False = do
r <- satisfy
when (r == MadeChange) $ liftIO $
2014-04-13 01:34:25 +00:00
unlessM (doesFileExist flagfile) $ do
createDirectoryIfMissing True (takeDirectory flagfile)
2014-04-10 15:02:29 +00:00
writeFile flagfile ""
2014-03-30 19:31:57 +00:00
return r
2014-03-31 14:36:45 +00:00
--- | 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
(==>) :: IsProp (Property i) => Desc -> Property i -> Property i
2014-03-30 20:49:59 +00:00
(==>) = flip describe
infixl 1 ==>
-- | Makes a Property only need to do anything when a test succeeds.
check :: IO Bool -> Property i -> Property i
check c p = adjustPropertySatisfy p $ \satisfy -> ifM (liftIO c)
( satisfy
2014-03-30 19:31:57 +00:00
, return NoChange
)
2014-04-02 16:13:39 +00:00
2014-11-19 22:57:58 +00:00
-- | 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
2014-11-19 22:57:58 +00:00
2014-04-14 18:09:41 +00:00
-- | Marks a Property as trivial. It can only return FailedChange or
-- NoChange.
--
-- Useful when it's just as expensive to check if a change needs
-- to be made as it is to just idempotently assure the property is
-- satisfied. For example, chmodding a file.
trivial :: Property i -> Property i
trivial p = adjustPropertySatisfy p $ \satisfy -> do
r <- satisfy
2014-04-14 18:09:41 +00:00
if r == MadeChange
then return NoChange
else return r
doNothing :: Property NoInfo
2014-05-28 14:38:29 +00:00
doNothing = property "noop property" noChange
-- | Makes a property that is satisfied differently depending on the host's
-- operating system.
--
-- Note that the operating system may not be declared for some hosts.
withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo
withOS desc a = property desc $ a =<< getOS
2014-04-02 16:13:39 +00:00
-- | Undoes the effect of a property.
revert :: RevertableProperty -> RevertableProperty
revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
makeChange :: IO () -> Propellor Result
makeChange a = liftIO a >> return MadeChange
noChange :: Propellor Result
noChange = return NoChange
-- | Registers an action that should be run at the very end,
2014-12-06 17:21:19 +00:00
endAction :: Desc -> (Result -> Propellor Result) -> Propellor ()
endAction desc a = tell [EndAction desc a]