summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2017-03-15 15:36:29 -0400
committerJoey Hess2017-03-15 15:39:18 -0400
commit472759eef32534fd1f1e14bb05f5cb97b18de760 (patch)
tree062b3e66071660571d32256b4882d1ed3127a54e
parent52ca81661f156122a3a5d4a438fea83e067215ac (diff)
Added Monoid instances for Property and RevertableProperty.
* 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"]) mappend x y is basically the same as x `before` y. In particular, if x fails to be ensured, it won't ensure y. This seems to make sense, since applyToList had that behavior, and so does the Monoid for Propellor Result. The alternative would be to try to ensure both and combine the results. However, I don't see any reason to do it that way. It would be nice if the description of both properties were displayed when ensuring the combination. But then, it would need to display eg: ensuring x..ok ensuring y..failed ensuring x and ensuring y..failed Without a way to get rid of that redundant last line, I don't want to do that. Note that the haddocks for the Monoid instances need a really wide screen to display! This is IMHO an infelicity in haddock, and I can't do anything about it really. This commit was sponsored by Fernando Jimenez on Patreon.
-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