summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog4
-rw-r--r--src/Propellor/Property.hs12
-rw-r--r--src/Propellor/Property/Apt.hs2
-rw-r--r--src/Propellor/Property/Firejail.hs2
-rw-r--r--src/Propellor/Types.hs32
-rw-r--r--src/Propellor/Types/Core.hs3
6 files changed, 41 insertions, 14 deletions
diff --git a/debian/changelog b/debian/changelog
index 460d468d..9168b5f9 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -24,6 +24,10 @@ propellor (3.5.0) UNRELEASED; urgency=medium
* When Nothing needs to be done to ensure a property, propellor
will avoid displaying its description at all. The doNothing property
is an example of such a property.
+ * Added Monoid instances for Property and RevertableProperty.
+ * Removed applyToList. Instead, use mconcat. (API change)
+ Eg, if you had: applyToList accountFor [User "joey", User "root"]
+ use instead: mconcat (map accountFor [User "joey", User "root"])
-- Joey Hess <id@joeyh.name> Wed, 08 Mar 2017 14:02:10 -0400
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 1a40bb75..706e684b 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -16,7 +16,6 @@ module Propellor.Property (
, check
, fallback
, revert
- , applyToList
-- * Property descriptions
, describe
, (==>)
@@ -54,7 +53,6 @@ import System.Posix.Files
import qualified Data.Hash.MD5 as MD5
import Data.List
import Control.Applicative
-import Data.Foldable hiding (and, elem)
import Prelude
import Propellor.Types
@@ -353,14 +351,6 @@ unsupportedOS' = go =<< getOS
revert :: RevertableProperty setup undo -> RevertableProperty undo setup
revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
--- | Apply a property to each element of a list.
-applyToList
- :: (Foldable t, Functor t, Combines p p, p ~ CombinedType p p)
- => (b -> p)
- -> t b
- -> p
-prop `applyToList` xs = Data.Foldable.foldr1 before $ prop <$> xs
-
makeChange :: IO () -> Propellor Result
makeChange a = liftIO a >> return MadeChange
@@ -368,7 +358,7 @@ noChange :: Propellor Result
noChange = return NoChange
doNothing :: SingI t => Property (MetaTypes t)
-doNothing = property'' "noop property" Nothing
+doNothing = mempty
-- | Registers an action that should be run at the very end, after
-- propellor has checks all the properties of a host.
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 4490aa95..c681eee6 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -265,7 +265,7 @@ pinnedTo
:: [AptPackagePref]
-> [(DebianSuite, PinPriority)]
-> RevertableProperty Debian Debian
-pinnedTo ps pins = (\p -> pinnedTo' p pins) `applyToList` ps
+pinnedTo ps pins = mconcat (map (\p -> pinnedTo' p pins) ps)
`describe` unwords (("pinned to " ++ showSuites):ps)
where
showSuites = intercalate "," $ showSuite . fst <$> pins
diff --git a/src/Propellor/Property/Firejail.hs b/src/Propellor/Property/Firejail.hs
index b7841e07..6e877683 100644
--- a/src/Propellor/Property/Firejail.hs
+++ b/src/Propellor/Property/Firejail.hs
@@ -22,7 +22,7 @@ installed = Apt.installed ["firejail"]
--
-- See "DESKTOP INTEGRATION" in firejail(1).
jailed :: [String] -> Property DebianLike
-jailed ps = (jailed' `applyToList` ps)
+jailed ps = mconcat (map jailed' ps)
`requires` installed
`describe` unwords ("firejail jailed":ps)
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 6554abd2..690c153a 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -205,3 +205,35 @@ class TightenTargets p where
instance TightenTargets Property where
tightenTargets (Property _ d a i c) = Property sing d a i c
+
+-- | Any type of Property is a monoid. When properties x and y are
+-- appended together, the resulting property has a description like
+-- "x and y". Note that when x fails to be ensured, it will not
+-- try to ensure y.
+instance SingI metatypes => Monoid (Property (MetaTypes metatypes))
+ where
+ mempty = Property sing "noop property" Nothing mempty mempty
+ mappend (Property _ d1 a1 i1 c1) (Property _ d2 a2 i2 c2) =
+ Property sing d (a1 <> a2) (i1 <> i2) (c1 <> c2)
+ where
+ -- Avoid including "noop property" in description
+ -- when using eg mconcat.
+ d = case (a1, a2) of
+ (Just _, Just _) -> d1 <> " and " <> d2
+ (Just _, Nothing) -> d1
+ (Nothing, Just _) -> d2
+ (Nothing, Nothing) -> d1
+
+-- | Any type of RevertableProperty is a monoid. When revertable
+-- properties x and y are appended together, the resulting revertable
+-- property has a description like "x and y".
+-- Note that when x fails to be ensured, it will not try to ensure y.
+instance
+ ( Monoid (Property setupmetatypes)
+ , Monoid (Property undometatypes)
+ )
+ => Monoid (RevertableProperty setupmetatypes undometatypes)
+ where
+ mempty = RevertableProperty mempty mempty
+ mappend (RevertableProperty s1 u1) (RevertableProperty s2 u2) =
+ RevertableProperty (s1 <> s2) (u2 <> u1)
diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs
index dcd206eb..a805f561 100644
--- a/src/Propellor/Types/Core.hs
+++ b/src/Propellor/Types/Core.hs
@@ -48,9 +48,10 @@ instance LiftPropellor Propellor where
instance LiftPropellor IO where
liftPropellor = liftIO
+-- | When two actions are appended together, the second action
+-- is only run if the first action does not fail.
instance Monoid (Propellor Result) where
mempty = return NoChange
- -- | The second action is only run if the first action does not fail.
mappend x y = do
rx <- x
case rx of