{-# LANGUAGE PackageImports #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}

module Propellor.Property (
	-- * Property combinators
	  requires
	, before
	, onChange
	, onChangeFlagOnFail
	, flagFile
	, flagFile'
	, check
	, fallback
	, revert
	-- * Property descriptions
	, describe
	, (==>)
	-- * Constructing properties
	, Propellor
	, property
	, property'
	, OuterMetaTypesWitness
	, ensureProperty
	, pickOS
	, withOS
	, unsupportedOS
	, unsupportedOS'
	, makeChange
	, noChange
	, doNothing
	, impossible
	, endAction
	-- * Property result checking
	, UncheckedProperty
	, unchecked
	, changesFile
	, changesFileContent
	, isNewerThan
	, checkResult
	, Checkable
	, assume
) where

import System.FilePath
import Control.Monad
import Data.Monoid
import Control.Monad.IfElse
import "mtl" Control.Monad.RWS.Strict
import System.Posix.Files
import Data.Maybe
import Data.List
import Data.Hashable
import Control.Applicative
import GHC.Stack
import Prelude

import Propellor.Types
import Propellor.Types.Core
import Propellor.Types.ResultCheck
import Propellor.Types.MetaTypes
import Propellor.Types.Singletons
import Propellor.Info
import Propellor.Message
import Propellor.EnsureProperty
import Utility.Exception
import Utility.Monad
import Utility.Directory
import Utility.Misc

-- | 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 :: forall i. Property i -> FilePath -> Property i
flagFile Property i
p = forall i. Property i -> IO FilePath -> Property i
flagFile' Property i
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

flagFile' :: Property i -> IO FilePath -> Property i
flagFile' :: forall i. Property i -> IO FilePath -> Property i
flagFile' Property i
p IO FilePath
getflagfile = forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy Property i
p forall a b. (a -> b) -> a -> b
$ \Propellor Result
satisfy -> do
	FilePath
flagfile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getflagfile
	forall {m :: * -> *}.
MonadIO m =>
m Result -> FilePath -> Bool -> m Result
go Propellor Result
satisfy FilePath
flagfile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesFileExist FilePath
flagfile)
  where
	go :: m Result -> FilePath -> Bool -> m Result
go m Result
_ FilePath
_ Bool
True = forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
	go m Result
satisfy FilePath
flagfile Bool
False = do
		Result
r <- m Result
satisfy
		forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Eq a => a -> a -> Bool
== Result
MadeChange) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
			forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> IO Bool
doesFileExist FilePath
flagfile) forall a b. (a -> b) -> a -> b
$ do
				Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
flagfile)
				FilePath -> FilePath -> IO ()
writeFile FilePath
flagfile FilePath
""
		forall (m :: * -> *) a. Monad m => a -> m a
return Result
r

-- | Indicates that the first property depends on the second,
-- so before the first is ensured, the second must be ensured.
--
-- The combined property uses the description of the first property.
requires :: Combines x y => x -> y -> CombinedType x y
requires :: forall x y. Combines x y => x -> y -> CombinedType x y
requires = forall x y.
Combines x y =>
ResultCombiner -> ResultCombiner -> x -> y -> CombinedType x y
combineWith
	-- Run action of y, then x
	(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Semigroup a => a -> a -> a
(<>))
	-- When reverting, run in reverse order.
	forall a. Semigroup a => a -> a -> a
(<>)

-- | Combines together two properties, resulting in one property
-- that ensures the first, and if the first succeeds, ensures the second.
--
-- The combined property uses the description of the first property.
before :: Combines x y => x -> y -> CombinedType x y
before :: forall x y. Combines x y => x -> y -> CombinedType x y
before = forall x y.
Combines x y =>
ResultCombiner -> ResultCombiner -> x -> y -> CombinedType x y
combineWith
	-- Run action of x, then y
	forall a. Semigroup a => a -> a -> a
(<>)
	-- When reverting, run in reverse order.
	(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Semigroup a => a -> a -> a
(<>))

-- | Whenever a change has to be made for a Property, causes a hook
-- Property to also be run, but not otherwise.
onChange
	:: (Combines x y)
	=> x
        -> y
        -> CombinedType x y
onChange :: forall x y. Combines x y => x -> y -> CombinedType x y
onChange = forall x y.
Combines x y =>
ResultCombiner -> ResultCombiner -> x -> y -> CombinedType x y
combineWith forall {m :: * -> *}.
Monad m =>
Maybe (m Result) -> Maybe (m Result) -> Maybe (m Result)
combiner ResultCombiner
revertcombiner
  where
	combiner :: Maybe (m Result) -> Maybe (m Result) -> Maybe (m Result)
combiner (Just m Result
p) (Just m Result
hook) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
		Result
r <- m Result
p
		case Result
r of
			Result
MadeChange -> do
				Result
r' <- m Result
hook
				forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Result
r forall a. Semigroup a => a -> a -> a
<> Result
r'
			Result
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
r
	combiner (Just m Result
p) Maybe (m Result)
Nothing = forall a. a -> Maybe a
Just m Result
p
	combiner Maybe (m Result)
Nothing Maybe (m Result)
_ = forall a. Maybe a
Nothing
	revertcombiner :: ResultCombiner
revertcombiner = forall a. Semigroup a => a -> a -> a
(<>)

-- | 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 x y)
	=> FilePath
        -> x
        -> y
        -> CombinedType x y
onChangeFlagOnFail :: forall x y. Combines x y => FilePath -> x -> y -> CombinedType x y
onChangeFlagOnFail FilePath
flagfile = forall x y.
Combines x y =>
ResultCombiner -> ResultCombiner -> x -> y -> CombinedType x y
combineWith ResultCombiner
combiner ResultCombiner
revertcombiner
  where
	combiner :: ResultCombiner
combiner (Just Propellor Result
s1) Maybe (Propellor Result)
s2 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
		Result
r1 <- Propellor Result
s1
		case Result
r1 of
			Result
MadeChange -> Maybe (Propellor Result) -> Propellor Result
flagFailed Maybe (Propellor Result)
s2
			Result
_ -> forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
flagfile)
				( Maybe (Propellor Result) -> Propellor Result
flagFailed Maybe (Propellor Result)
s2
				, forall (m :: * -> *) a. Monad m => a -> m a
return Result
r1
				)
	combiner Maybe (Propellor Result)
Nothing Maybe (Propellor Result)
_ = forall a. Maybe a
Nothing

	revertcombiner :: ResultCombiner
revertcombiner = forall a. Semigroup a => a -> a -> a
(<>)

	flagFailed :: Maybe (Propellor Result) -> Propellor Result
flagFailed (Just Propellor Result
s) = do
		Result
r <- Propellor Result
s
		forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ case Result
r of
			Result
FailedChange -> IO ()
createFlagFile
			Result
_ -> IO ()
removeFlagFile
		forall (m :: * -> *) a. Monad m => a -> m a
return Result
r
	flagFailed Maybe (Propellor Result)
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange

	createFlagFile :: IO ()
createFlagFile = forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> IO Bool
doesFileExist FilePath
flagfile) forall a b. (a -> b) -> a -> b
$ do
		Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
flagfile)
		FilePath -> FilePath -> IO ()
writeFile FilePath
flagfile FilePath
""
	
	removeFlagFile :: IO ()
removeFlagFile = forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
doesFileExist FilePath
flagfile) forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
flagfile

-- | Changes the description of a property.
describe :: IsProp p => p -> Desc -> p
describe :: forall p. IsProp p => p -> FilePath -> p
describe = forall p. IsProp p => p -> FilePath -> p
setDesc

-- | Alias for @flip describe@
(==>) :: IsProp (Property i) => Desc -> Property i -> Property i
==> :: forall i.
IsProp (Property i) =>
FilePath -> Property i -> Property i
(==>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall p. IsProp p => p -> FilePath -> p
describe
infixl 1 ==>

-- | Tries the first property, but if it fails to work, instead uses
-- the second.
fallback :: (Combines p1 p2) => p1 -> p2 -> CombinedType p1 p2
fallback :: forall x y. Combines x y => x -> y -> CombinedType x y
fallback = forall x y.
Combines x y =>
ResultCombiner -> ResultCombiner -> x -> y -> CombinedType x y
combineWith forall {m :: * -> *}.
Monad m =>
Maybe (m Result) -> Maybe (m Result) -> Maybe (m Result)
combiner ResultCombiner
revertcombiner
  where
	combiner :: Maybe (m Result) -> Maybe (m Result) -> Maybe (m Result)
combiner (Just m Result
a1) (Just m Result
a2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
		Result
r <- m Result
a1
		if Result
r forall a. Eq a => a -> a -> Bool
== Result
FailedChange
			then m Result
a2
			else forall (m :: * -> *) a. Monad m => a -> m a
return Result
r
	combiner (Just m Result
a1) Maybe (m Result)
Nothing = forall a. a -> Maybe a
Just m Result
a1
	combiner Maybe (m Result)
Nothing Maybe (m Result)
_ = forall a. Maybe a
Nothing
	revertcombiner :: ResultCombiner
revertcombiner = forall a. Semigroup a => a -> a -> a
(<>)

-- | Indicates that a Property may change a particular file. When the file
-- is modified in any way (including changing its permissions or mtime),
-- the property will return MadeChange instead of NoChange.
changesFile :: Checkable p i => p i -> FilePath -> Property i
changesFile :: forall (p :: * -> *) i.
Checkable p i =>
p i -> FilePath -> Property i
changesFile p i
p FilePath
f = forall (p :: * -> *) i (m :: * -> *) a.
(Checkable p i, LiftPropellor m) =>
m a -> (a -> m Result) -> p i -> Property i
checkResult IO (Maybe FileStatus)
getstat Maybe FileStatus -> IO Result
comparestat p i
p
  where
	getstat :: IO (Maybe FileStatus)
getstat = forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileStatus
getSymbolicLinkStatus FilePath
f
	comparestat :: Maybe FileStatus -> IO Result
comparestat Maybe FileStatus
oldstat = do
		Maybe FileStatus
newstat <- IO (Maybe FileStatus)
getstat
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Maybe FileStatus -> Maybe FileStatus -> Bool
samestat Maybe FileStatus
oldstat Maybe FileStatus
newstat then Result
NoChange else Result
MadeChange
	samestat :: Maybe FileStatus -> Maybe FileStatus -> Bool
samestat Maybe FileStatus
Nothing Maybe FileStatus
Nothing = Bool
True
	samestat (Just FileStatus
a) (Just FileStatus
b) = forall (t :: * -> *). Foldable t => t Bool -> Bool
and
		-- everything except for atime
		[ FileStatus -> DeviceID
deviceID FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> DeviceID
deviceID FileStatus
b
		, FileStatus -> FileID
fileID FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> FileID
fileID FileStatus
b
		, FileStatus -> FileMode
fileMode FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> FileMode
fileMode FileStatus
b
		, FileStatus -> UserID
fileOwner FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> UserID
fileOwner FileStatus
b
		, FileStatus -> GroupID
fileGroup FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> GroupID
fileGroup FileStatus
b
		, FileStatus -> DeviceID
specialDeviceID FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> DeviceID
specialDeviceID FileStatus
b
		, FileStatus -> FileOffset
fileSize FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> FileOffset
fileSize FileStatus
b
		, FileStatus -> POSIXTime
modificationTimeHiRes FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> POSIXTime
modificationTimeHiRes FileStatus
b
		, FileStatus -> Bool
isBlockDevice FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> Bool
isBlockDevice FileStatus
b
		, FileStatus -> Bool
isCharacterDevice FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> Bool
isCharacterDevice FileStatus
b
		, FileStatus -> Bool
isNamedPipe FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> Bool
isNamedPipe FileStatus
b
		, FileStatus -> Bool
isRegularFile FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> Bool
isRegularFile FileStatus
b
		, FileStatus -> Bool
isDirectory FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> Bool
isDirectory FileStatus
b
		, FileStatus -> Bool
isSymbolicLink FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> Bool
isSymbolicLink FileStatus
b
		, FileStatus -> Bool
isSocket FileStatus
a forall a. Eq a => a -> a -> Bool
== FileStatus -> Bool
isSocket FileStatus
b
		]
	samestat Maybe FileStatus
_ Maybe FileStatus
_ = Bool
False

-- | Like `changesFile`, but compares the content of the file.
-- Changes to mtime etc that do not change file content are treated as
-- NoChange.
changesFileContent :: Checkable p i => p i -> FilePath -> Property i
changesFileContent :: forall (p :: * -> *) i.
Checkable p i =>
p i -> FilePath -> Property i
changesFileContent p i
p FilePath
f = forall (p :: * -> *) i (m :: * -> *) a.
(Checkable p i, LiftPropellor m) =>
m a -> (a -> m Result) -> p i -> Property i
checkResult IO (Maybe Int)
gethash Maybe Int -> IO Result
comparehash p i
p
  where
	gethash :: IO (Maybe Int)
gethash = forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO forall a b. (a -> b) -> a -> b
$ forall a. Hashable a => a -> Int
hash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFileStrict FilePath
f
	comparehash :: Maybe Int -> IO Result
comparehash Maybe Int
oldhash = do
		Maybe Int
newhash <- IO (Maybe Int)
gethash
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Maybe Int
oldhash forall a. Eq a => a -> a -> Bool
== Maybe Int
newhash then Result
NoChange else Result
MadeChange

-- | Determines if the first file is newer than the second file.
--
-- This can be used with `check` to only run a command when a file
-- has changed.
--
-- > check ("/etc/aliases" `isNewerThan` "/etc/aliases.db")
-- > 	(cmdProperty "newaliases" [] `assume` MadeChange) -- updates aliases.db
--
-- Or it can be used with `checkResult` to test if a command made a change.
--
-- > checkResult (return ())
-- > 	(\_ -> "/etc/aliases.db" `isNewerThan` "/etc/aliases")
-- > 	(cmdProperty "newaliases" [])
--
-- (If one of the files does not exist, the file that does exist is
-- considered to be the newer of the two.)
isNewerThan :: FilePath -> FilePath -> IO Bool
isNewerThan :: FilePath -> FilePath -> IO Bool
isNewerThan FilePath
x FilePath
y = do
	Maybe POSIXTime
mx <- FilePath -> IO (Maybe POSIXTime)
mtime FilePath
x
	Maybe POSIXTime
my <- FilePath -> IO (Maybe POSIXTime)
mtime FilePath
y
	forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe POSIXTime
mx forall a. Ord a => a -> a -> Bool
> Maybe POSIXTime
my)
  where
	mtime :: FilePath -> IO (Maybe POSIXTime)
mtime FilePath
f = forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO forall a b. (a -> b) -> a -> b
$ FileStatus -> POSIXTime
modificationTimeHiRes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileStatus
getFileStatus FilePath
f

-- | Picks one of the two input properties to use,
-- depending on the targeted OS.
--
-- If both input properties support the targeted OS, then the
-- first will be used.
--
-- The resulting property will use the description of the first property
-- no matter which property is used in the end. So, it's often a good
-- idea to change the description to something clearer.
--
-- For example:
--
-- > upgraded :: Property (DebianLike + FreeBSD)
-- > upgraded = (Apt.upgraded `pickOS` Pkg.upgraded)
-- > 	`describe` "OS upgraded"
--
-- If neither input property supports the targeted OS, calls
-- `unsupportedOS`. Using the example above on a Fedora system would
-- fail that way.
pickOS
	::
		HasCallStack =>
		( SingKind ('KProxy :: KProxy ka)
		, SingKind ('KProxy :: KProxy kb)
		, DemoteRep ('KProxy :: KProxy ka) ~ [MetaType]
		, DemoteRep ('KProxy :: KProxy kb) ~ [MetaType]
		, SingI c
		-- Would be nice to have this constraint, but
		-- union will not generate metatypes lists with the same
		-- order of OS's as is used everywhere else. So,
		-- would need a type-level sort.
		--, Union a b ~ c
		)
	=> Property (MetaTypes (a :: ka))
	-> Property (MetaTypes (b :: kb))
	-> Property (MetaTypes c)
pickOS :: forall {k} ka kb (c :: k) (a :: ka) (b :: kb).
(HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
 DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
 SingI c) =>
Property (MetaTypes a)
-> Property (MetaTypes b) -> Property (MetaTypes c)
pickOS Property (MetaTypes a)
a Property (MetaTypes b)
b = Property (MetaTypes c)
c forall p. IsProp p => p -> [ChildProperty] -> p
`addChildren` [forall p. IsProp p => p -> ChildProperty
toChildProperty Property (MetaTypes a)
a, forall p. IsProp p => p -> ChildProperty
toChildProperty Property (MetaTypes b)
b]
  where
	-- This use of getSatisfy is safe, because both a and b
	-- are added as children, so their info will propigate.
	c :: Property (MetaTypes c)
c = forall {k} (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (forall p. IsProp p => p -> FilePath
getDesc Property (MetaTypes a)
a) forall a b. (a -> b) -> a -> b
$ do
		Maybe System
o <- Propellor (Maybe System)
getOS
		if forall {k} {t :: * -> *} {a :: k}.
(DemoteRep 'KProxy ~ t MetaType, Foldable t, SingKind 'KProxy) =>
Maybe System -> Property (Sing a) -> Bool
matching Maybe System
o Property (MetaTypes a)
a
			then forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
NoChange) forall a. a -> a
id (forall p. IsProp p => p -> Maybe (Propellor Result)
getSatisfy Property (MetaTypes a)
a)
			else if forall {k} {t :: * -> *} {a :: k}.
(DemoteRep 'KProxy ~ t MetaType, Foldable t, SingKind 'KProxy) =>
Maybe System -> Property (Sing a) -> Bool
matching Maybe System
o Property (MetaTypes b)
b
				then forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
NoChange) forall a. a -> a
id (forall p. IsProp p => p -> Maybe (Propellor Result)
getSatisfy Property (MetaTypes b)
b)
				else HasCallStack => Propellor Result
unsupportedOS'
	matching :: Maybe System -> Property (Sing a) -> Bool
matching Maybe System
Nothing Property (Sing a)
_ = Bool
False
	matching (Just System
o) Property (Sing a)
p =
		TargetOS -> MetaType
Targeting (System -> TargetOS
systemToTargetOS System
o)
			forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
		forall k (kparam :: KProxy k) (a :: k).
SingKind kparam =>
Sing a -> DemoteRep kparam
fromSing (forall {metatypes}. Property metatypes -> metatypes
proptype Property (Sing a)
p)
	proptype :: Property metatypes -> metatypes
proptype (Property metatypes
t FilePath
_ Maybe (Propellor Result)
_ Info
_ [ChildProperty]
_) = metatypes
t

-- | Makes a property that is satisfied differently depending on specifics
-- of the host's operating system.
--
-- > myproperty :: Property Debian
-- > myproperty = withOS "foo installed" $ \w o -> case o of
-- > 	(Just (System (Debian kernel (Stable release)) arch)) -> ensureProperty w ...
-- > 	(Just (System (Debian kernel suite) arch)) -> ensureProperty w ...
-- >	_ -> unsupportedOS'
--
-- Note that the operating system specifics may not be declared for all hosts,
-- which is where Nothing comes in.
withOS
	:: (SingI metatypes)
	=> Desc
	-> (OuterMetaTypesWitness metatypes -> Maybe System -> Propellor Result)
	-> Property (MetaTypes metatypes)
withOS :: forall {k} (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS FilePath
desc OuterMetaTypesWitness metatypes -> Maybe System -> Propellor Result
a = forall {k} (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' FilePath
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness metatypes
w -> OuterMetaTypesWitness metatypes -> Maybe System -> Propellor Result
a OuterMetaTypesWitness metatypes
w forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Propellor (Maybe System)
getOS

-- | A property that always fails with an unsupported OS error.
unsupportedOS :: Property UnixLike
unsupportedOS :: Property UnixLike
unsupportedOS = forall {k} (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property FilePath
"unsupportedOS" HasCallStack => Propellor Result
unsupportedOS'

-- | Throws an error, for use in `withOS` when a property is lacking
-- support for an OS.
unsupportedOS' :: HasCallStack => Propellor Result
unsupportedOS' :: HasCallStack => Propellor Result
unsupportedOS' = forall {a} {a}. Show a => Maybe a -> a
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Propellor (Maybe System)
getOS
	  where
		go :: Maybe a -> a
go Maybe a
Nothing = forall a. HasCallStack => FilePath -> a
error FilePath
"Unknown host OS is not supported by this property."
		go (Just a
o) = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"This property is not implemented for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show a
o

-- | Undoes the effect of a RevertableProperty.
revert :: RevertableProperty setup undo -> RevertableProperty undo setup
revert :: forall setup undo.
RevertableProperty setup undo -> RevertableProperty undo setup
revert (RevertableProperty Property setup
p1 Property undo
p2) = forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
RevertableProperty Property undo
p2 Property setup
p1

makeChange :: IO () -> Propellor Result
makeChange :: IO () -> Propellor Result
makeChange IO ()
a = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange

noChange :: Propellor Result
noChange :: Propellor Result
noChange = forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange

-- | A no-op property.
--
-- This is the same as `mempty` from the `Monoid` instance.
doNothing :: SingI t => Property (MetaTypes t)
doNothing :: forall {k} (t :: k). SingI t => Property (MetaTypes t)
doNothing = forall a. Monoid a => a
mempty

-- | In situations where it's not possible to provide a property that
-- works, this can be used to make a property that always fails with an
-- error message you provide.
impossible :: SingI t => String -> Property (MetaTypes t)
impossible :: forall {k} (t :: k). SingI t => FilePath -> Property (MetaTypes t)
impossible FilePath
msg = forall {k} (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property FilePath
"impossible" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => FilePath -> m a
errorMessage FilePath
msg

-- | Registers an action that should be run at the very end, after
-- propellor has checks all the properties of a host.
endAction :: Desc -> (Result -> Propellor Result) -> Propellor ()
endAction :: FilePath -> (Result -> Propellor Result) -> Propellor ()
endAction FilePath
desc Result -> Propellor Result
a = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [FilePath -> (Result -> Propellor Result) -> EndAction
EndAction FilePath
desc Result -> Propellor Result
a]