summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/List.hs
diff options
context:
space:
mode:
authorJoey Hess2015-01-24 22:38:10 -0400
committerJoey Hess2015-01-24 22:38:51 -0400
commit0ee04ecc43e047b00437fb660e71f7dd67dd3afc (patch)
tree621e0ebc68a2afb9410ce6f368bec865f31cc507 /src/Propellor/Property/List.hs
parent141a7c028bba8d5b9743f2ab1397e69c313a523c (diff)
GADT properties seem to work (untested)
* Property has been converted to a GADT, and will be Property NoInfo or Property HasInfo. This was done to make sure that ensureProperty is only used on properties that do not have Info. Transition guide: - Change all "Property" to "Property NoInfo" or "Property WithInfo" (The compiler can tell you if you got it wrong!) - To construct a RevertableProperty, it is useful to use the new (<!>) operator - Constructing a list of properties can be problimatic, since Property NoInto and Property WithInfo are different types and cannot appear in the same list. To deal with this, "props" has been added, and can built up a list of properties of different types, using the same (&) and (!) operators that are used to build up a host's properties.
Diffstat (limited to 'src/Propellor/Property/List.hs')
-rw-r--r--src/Propellor/Property/List.hs63
1 files changed, 63 insertions, 0 deletions
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
new file mode 100644
index 00000000..283c5ec7
--- /dev/null
+++ b/src/Propellor/Property/List.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Propellor.Property.List (
+ PropertyList(..),
+ PropertyListType,
+) where
+
+import Propellor.Types
+import Propellor.Engine
+import Propellor.PropAccum
+
+import Data.Monoid
+
+class PropertyList l where
+ -- | Combines a list of properties, resulting in a single property
+ -- that when run will run each property in the list in turn,
+ -- and print out the description of each as it's run. Does not stop
+ -- on failure; does propigate overall success/failure.
+ --
+ -- Note that Property HasInfo and Property NoInfo are not the same
+ -- type, and so cannot be mixed in a list. To make a list of
+ -- mixed types, which can also include RevertableProperty,
+ -- use `props`:
+ --
+ -- > propertyList "foo" $ props
+ -- > & someproperty
+ -- > ! oldproperty
+ -- > & otherproperty
+ propertyList :: Desc -> l -> Property (PropertyListType l)
+
+ -- | Combines a list of properties, resulting in one property that
+ -- ensures each in turn. Stops if a property fails.
+ combineProperties :: Desc -> l -> Property (PropertyListType l)
+
+-- | Type level function to calculate whether a PropertyList has Info.
+type family PropertyListType t
+type instance PropertyListType [Property HasInfo] = HasInfo
+type instance PropertyListType [Property NoInfo] = NoInfo
+type instance PropertyListType PropList = HasInfo
+
+instance PropertyList [Property NoInfo] where
+ propertyList desc ps = simpleProperty desc (ensureProperties ps) ps
+ combineProperties desc ps = simpleProperty desc (combineSatisfy ps NoChange) ps
+
+instance PropertyList [Property HasInfo] where
+ -- It's ok to use ignoreInfo here, because the ps are made the
+ -- child properties of the property, and so their info is visible
+ -- that way.
+ propertyList desc ps = infoProperty desc (ensureProperties $ map ignoreInfo ps) mempty ps
+ combineProperties desc ps = infoProperty desc (combineSatisfy ps NoChange) mempty ps
+
+instance PropertyList PropList where
+ propertyList desc = propertyList desc . getProperties
+ combineProperties desc = combineProperties desc . getProperties
+
+combineSatisfy :: [Property i] -> Result -> Propellor Result
+combineSatisfy [] rs = return rs
+combineSatisfy (l:ls) rs = do
+ r <- ensureProperty $ ignoreInfo l
+ case r of
+ FailedChange -> return FailedChange
+ _ -> combineSatisfy ls (r <> rs)