summaryrefslogtreecommitdiff
path: root/src/Propellor/Types.hs
diff options
context:
space:
mode:
authorJoey Hess2015-10-27 14:34:10 -0400
committerJoey Hess2015-10-27 14:37:02 -0400
commit56c3394144abbb9862dc67379d3253c76ae4df97 (patch)
tree7e643b1f938343f883f6379382440516e6d3a5db /src/Propellor/Types.hs
parent77e3a5d4d968f3567b1b8e62996e0e6c803ab642 (diff)
Explicit Info/NoInfo for RevertableProperty (API change)
RevertableProperty used to be assumed to contain info, but this is now made explicit, with RevertableProperty HasInfo or RevertableProperty NoInfo. Transition guide: - If you define a RevertableProperty, expect some type check failures like: "Expecting one more argument to ‘RevertableProperty’". - Change it to "RevertableProperty NoInfo" - The compiler will then tell you if it needs "HasInfo" instead. - If you have code that uses the RevertableProperty constructor that fails to type check, use the more powerful <!> operator
Diffstat (limited to 'src/Propellor/Types.hs')
-rw-r--r--src/Propellor/Types.hs130
1 files changed, 92 insertions, 38 deletions
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 06f0935d..fa24786c 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -156,12 +156,6 @@ propertySatisfy :: Property i -> Propellor Result
propertySatisfy (IProperty _ a _ _) = a
propertySatisfy (SProperty _ a _) = a
-instance Show (Property i) where
- show p = "property " ++ show (propertyDesc p)
-
-instance Show RevertableProperty where
- show (RevertableProperty p _) = "property " ++ show (propertyDesc p)
-
-- | Changes the action that is performed to satisfy a property.
adjustPropertySatisfy :: Property i -> (Propellor Result -> Propellor Result) -> Property i
adjustPropertySatisfy (IProperty d s i cs) f = IProperty d (f s) i cs
@@ -175,6 +169,9 @@ propertyDesc :: Property i -> Desc
propertyDesc (IProperty d _ _ _) = d
propertyDesc (SProperty d _ _) = d
+instance Show (Property i) where
+ show p = "property " ++ show (propertyDesc p)
+
-- | A Property can include a list of child properties that it also
-- satisfies. This allows them to be introspected to collect their info, etc.
propertyChildren :: Property i -> [Property i]
@@ -183,11 +180,23 @@ propertyChildren (SProperty _ _ cs) = cs
-- | A property that can be reverted. The first Property is run
-- normally and the second is run when it's reverted.
-data RevertableProperty = RevertableProperty (Property HasInfo) (Property HasInfo)
+data RevertableProperty i = RevertableProperty (Property i) (Property i)
+
+instance Show (RevertableProperty i) where
+ show (RevertableProperty p _) = show p
--- | Shorthand to construct a revertable property.
-(<!>) :: Property i1 -> Property i2 -> RevertableProperty
-p1 <!> p2 = RevertableProperty (toIProperty p1) (toIProperty p2)
+class MkRevertableProperty i1 i2 where
+ -- | Shorthand to construct a revertable property.
+ (<!>) :: Property i1 -> Property i2 -> RevertableProperty (CInfo i1 i2)
+
+instance MkRevertableProperty HasInfo HasInfo where
+ x <!> y = RevertableProperty x y
+instance MkRevertableProperty NoInfo NoInfo where
+ x <!> y = RevertableProperty x y
+instance MkRevertableProperty NoInfo HasInfo where
+ x <!> y = RevertableProperty (toProp x) y
+instance MkRevertableProperty HasInfo NoInfo where
+ x <!> y = RevertableProperty x (toProp y)
-- | Class of types that can be used as properties of a host.
class IsProp p where
@@ -210,35 +219,43 @@ instance IsProp (Property NoInfo) where
getDesc = propertyDesc
getInfoRecursive _ = mempty
-instance IsProp RevertableProperty where
- -- | Sets the description of both sides.
- setDesc (RevertableProperty p1 p2) d =
- RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
+instance IsProp (RevertableProperty HasInfo) where
+ setDesc = setDescR
getDesc (RevertableProperty p1 _) = getDesc p1
toProp (RevertableProperty p1 _) = p1
-- | Return the Info of the currently active side.
getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
+instance IsProp (RevertableProperty NoInfo) where
+ setDesc = setDescR
+ getDesc (RevertableProperty p1 _) = getDesc p1
+ toProp (RevertableProperty p1 _) = toProp p1
+ getInfoRecursive (RevertableProperty _ _) = mempty
+
+-- | Sets the description of both sides.
+setDescR :: IsProp (Property i) => RevertableProperty i -> Desc -> RevertableProperty i
+setDescR (RevertableProperty p1 p2) d =
+ RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
-- | Type level calculation of the type that results from combining two
-- types of properties.
type family CombinedType x y
type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
-type instance CombinedType RevertableProperty RevertableProperty = RevertableProperty
+type instance CombinedType (RevertableProperty x) (RevertableProperty y) = RevertableProperty (CInfo x y)
-- When only one of the properties is revertable, the combined property is
-- not fully revertable, so is not a RevertableProperty.
-type instance CombinedType RevertableProperty (Property NoInfo) = Property HasInfo
-type instance CombinedType RevertableProperty (Property HasInfo) = Property HasInfo
-type instance CombinedType (Property NoInfo) RevertableProperty = Property HasInfo
-type instance CombinedType (Property HasInfo) RevertableProperty = Property HasInfo
+type instance CombinedType (RevertableProperty x) (Property y) = Property (CInfo x y)
+type instance CombinedType (Property x) (RevertableProperty y) = Property (CInfo x y)
+
+type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result
class Combines x y where
-- | Combines together two properties, yielding a property that
-- has the description and info of the first, and that has the second
-- property as a child.
combineWith
- :: (Propellor Result -> Propellor Result -> Propellor Result)
+ :: ResultCombiner
-- ^ How to combine the actions to satisfy the properties.
- -> (Propellor Result -> Propellor Result -> Propellor Result)
+ -> ResultCombiner
-- ^ Used when combining revertable properties, to combine
-- their reversion actions.
-> x
@@ -261,20 +278,57 @@ instance Combines (Property NoInfo) (Property NoInfo) where
combineWith f _ (SProperty d1 a1 cs1) y@(SProperty _d2 a2 _cs2) =
SProperty d1 (f a1 a2) (y : cs1)
-instance Combines RevertableProperty RevertableProperty where
- combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
- RevertableProperty
- (combineWith sf tf s1 s2)
- (combineWith tf sf t1 t2)
-
-instance Combines RevertableProperty (Property HasInfo) where
- combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y
-
-instance Combines RevertableProperty (Property NoInfo) where
- combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y
-
-instance Combines (Property HasInfo) RevertableProperty where
- combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y
-
-instance Combines (Property NoInfo) RevertableProperty where
- combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y
+instance Combines (RevertableProperty NoInfo) (RevertableProperty NoInfo) where
+ combineWith = combineWithRR
+instance Combines (RevertableProperty HasInfo) (RevertableProperty HasInfo) where
+ combineWith = combineWithRR
+instance Combines (RevertableProperty HasInfo) (RevertableProperty NoInfo) where
+ combineWith = combineWithRR
+instance Combines (RevertableProperty NoInfo) (RevertableProperty HasInfo) where
+ combineWith = combineWithRR
+instance Combines (RevertableProperty NoInfo) (Property HasInfo) where
+ combineWith = combineWithRP
+instance Combines (RevertableProperty NoInfo) (Property NoInfo) where
+ combineWith = combineWithRP
+instance Combines (RevertableProperty HasInfo) (Property HasInfo) where
+ combineWith = combineWithRP
+instance Combines (RevertableProperty HasInfo) (Property NoInfo) where
+ combineWith = combineWithRP
+instance Combines (Property HasInfo) (RevertableProperty NoInfo) where
+ combineWith = combineWithPR
+instance Combines (Property NoInfo) (RevertableProperty NoInfo) where
+ combineWith = combineWithPR
+instance Combines (Property HasInfo) (RevertableProperty HasInfo) where
+ combineWith = combineWithPR
+instance Combines (Property NoInfo) (RevertableProperty HasInfo) where
+ combineWith = combineWithPR
+
+combineWithRR
+ :: Combines (Property x) (Property y)
+ => ResultCombiner
+ -> ResultCombiner
+ -> RevertableProperty x
+ -> RevertableProperty y
+ -> RevertableProperty (CInfo x y)
+combineWithRR sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
+ RevertableProperty
+ (combineWith sf tf s1 s2)
+ (combineWith tf sf t1 t2)
+
+combineWithRP
+ :: Combines (Property i) y
+ => (Propellor Result -> Propellor Result -> Propellor Result)
+ -> (Propellor Result -> Propellor Result -> Propellor Result)
+ -> RevertableProperty i
+ -> y
+ -> CombinedType (Property i) y
+combineWithRP sf tf (RevertableProperty x _) y = combineWith sf tf x y
+
+combineWithPR
+ :: Combines x (Property i)
+ => (Propellor Result -> Propellor Result -> Propellor Result)
+ -> (Propellor Result -> Propellor Result -> Propellor Result)
+ -> x
+ -> RevertableProperty i
+ -> CombinedType x (Property i)
+combineWithPR sf tf x (RevertableProperty y _) = combineWith sf tf x y