use type level functions to fix type inference for `require`

src/Propellor/Types.hs

@@ -3,22 +3,29 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Propellor.Types
 	( Host(..)
+	, Desc
 	, Property(..)
 	, HasInfo
 	, NoInfo
-	, Desc
+	, hasInfo
-	, mkProperty
+	, CInfo
-	, propertyDesc
+	, infoProperty
+	, simpleProperty
 	, propertySatisfy
+	, adjustPropertySatisfy
 	, propertyInfo
 	, propertyChildren
 	, RevertableProperty(..)
-	, mkRevertableProperty
+	, (<!>)
-	, requires
+	, Combines(..)
+	, before
+	, combineWith
 	, IsProp(..)
 	, Info(..)
 	, Propellor(..)
@@ -84,14 +91,29 @@ data Property i where
 data HasInfo
 data NoInfo
 
--- | Constructs a Property
+hasInfo :: Property i -> Bool
-mkProperty 
+hasInfo (IProperty {}) = True
+hasInfo _ = False
+
+-- | Type level calculation of the combintion of HasInfo and/or NoInfo
+type family CInfo x y
+type instance CInfo HasInfo HasInfo = HasInfo
+type instance CInfo HasInfo NoInfo = HasInfo
+type instance CInfo NoInfo HasInfo = HasInfo
+type instance CInfo NoInfo NoInfo = NoInfo
+
+-- | Constructs a Property with associated Info.
+infoProperty 
 	:: Desc -- ^ description of the property
 	-> Propellor Result -- ^ action to run to satisfy the property (must be idempotent; may run repeatedly)
 	-> Info -- ^ info associated with the property
 	-> [Property i] -- ^ child properties
 	-> Property HasInfo
-mkProperty d a i cs = IProperty d a i (map toIProperty cs)
+infoProperty d a i cs = IProperty d a i (map toIProperty cs)
+
+-- | Constructs a Property with no Info.
+simpleProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
+simpleProperty = SProperty
 
 toIProperty :: Property i -> Property HasInfo
 toIProperty p@(IProperty {}) = p
@@ -103,20 +125,23 @@ toSProperty p@(SProperty {}) = p
 
 -- | Makes a version of a Proprty without its Info.
 -- Use with caution!
-ignoreInfo :: Property HasInfo -> Property NoInfo
+ignoreInfo :: Property i -> Property NoInfo
 ignoreInfo = toSProperty
 
-instance Show (Property i) where
+instance Show (Property NoInfo) where
+        show p = "property " ++ show (propertyDesc p)
+instance Show (Property HasInfo) where
         show p = "property " ++ show (propertyDesc p)
-
-propertyDesc :: Property i -> Desc
-propertyDesc (IProperty d _ _ _) = d
-propertyDesc (SProperty d _ _) = d
 
 propertySatisfy :: Property i -> Propellor Result
 propertySatisfy (IProperty _ a _ _) = a
 propertySatisfy (SProperty _ a _) = a
 
+-- | 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
+adjustPropertySatisfy (SProperty d s cs) f = SProperty d (f s) cs
+
 propertyInfo :: Property i -> Info
 propertyInfo (IProperty _ _ i _) = i
 propertyInfo (SProperty {}) = mempty
@@ -130,12 +155,15 @@ propertyChildren (SProperty _ _ cs) = cs
 -- | A property that can be reverted.
 data RevertableProperty = RevertableProperty (Property HasInfo) (Property HasInfo)
 
-mkRevertableProperty :: Property i1 -> Property i2 -> RevertableProperty
+-- | Makes a revertable property; the first Property is run
-mkRevertableProperty p1 p2 = RevertableProperty (toIProperty p1) (toIProperty p2)
+-- normally and the second is run when it's reverted.
+(<!>) :: Property i1 -> Property i2 -> RevertableProperty
+p1 <!> p2 = RevertableProperty (toIProperty p1) (toIProperty p2)
 
 class IsProp p where
 	-- | Sets description.
 	describe :: p -> Desc -> p
+	propertyDesc :: p -> Desc
 	toProp :: p -> Property HasInfo
 	-- | Gets the info of the property, combined with all info
 	-- of all children properties.
@@ -143,11 +171,13 @@ class IsProp p where
 
 instance IsProp (Property HasInfo) where
 	describe (IProperty _ a i cs) d = IProperty d a i cs
+	propertyDesc (IProperty d _ _ _) = d
 	toProp = id
 	getInfoRecursive (IProperty _ _ i cs) = 
 		i <> mconcat (map getInfoRecursive cs)
 instance IsProp (Property NoInfo) where
 	describe (SProperty _ a cs) d = SProperty d a cs
+	propertyDesc (SProperty d _ _) = d
 	toProp = toIProperty
 	getInfoRecursive _ = mempty
 
@@ -155,39 +185,67 @@ instance IsProp RevertableProperty where
 	-- | Sets the description of both sides.
 	describe (RevertableProperty p1 p2) d = 
 		RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
+	propertyDesc (RevertableProperty p1 _) = propertyDesc p1
 	toProp (RevertableProperty p1 _) = p1
 	-- | Return the Info of the currently active side.
 	getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
 
-class Requires x y r where
+-- Type level calculation of the type that results from combining two types
-	-- Indicates that the first property depends on the second,
+-- with `requires`.
-	-- so before the first is ensured, the second will be ensured.
+type family CombinedType x y
-	requires :: x -> y -> r
+type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
+type instance CombinedType RevertableProperty (Property NoInfo) = RevertableProperty
+type instance CombinedType RevertableProperty (Property HasInfo) = RevertableProperty
+type instance CombinedType RevertableProperty RevertableProperty = RevertableProperty
 
-instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) where
+class Combines x y where
+	-- | Indicates that the first property depends on the second,
+	-- so before the first is ensured, the second will be ensured.
+	requires :: x -> y -> CombinedType x y
+	
+-- | Combines together two properties, resulting in one property
+-- that ensures the first, and if the first succeeds, ensures the second.
+-- The property uses the description of the first property.
+before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x
+before x y = (y `requires` x) `describe` (propertyDesc x)
+
+-- | 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. The two actions to satisfy the properties
+-- are passed to a function that can combine them in arbitrary ways.
+combineWith
+	:: (Combines (Property x) (Property y))
+	=> (Propellor Result -> Propellor Result -> Propellor Result)
+	-> Property x
+	-> Property y
+	-> CombinedType (Property x) (Property y)
+combineWith f x y = adjustPropertySatisfy (x `requires` y) $ \_ ->
+	f (propertySatisfy $ toSProperty x) (propertySatisfy $ toSProperty y)
+
+instance Combines (Property HasInfo) (Property HasInfo) where
 	requires (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
 		IProperty d1 (a2 `andThen` a1) i1 (y : cs1)
 
-instance Requires (Property HasInfo) (Property NoInfo) (Property HasInfo) where
+instance Combines (Property HasInfo) (Property NoInfo) where
 	requires (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) =
 		IProperty d1 (a2 `andThen` a1) i1 (toIProperty y : cs1)
 
-instance Requires (Property NoInfo) (Property HasInfo) (Property HasInfo) where
+instance Combines (Property NoInfo) (Property HasInfo) where
 	requires x y = requires y x
 
-instance Requires (Property NoInfo) (Property NoInfo) (Property NoInfo) where
+instance Combines (Property NoInfo) (Property NoInfo) where
 	requires (SProperty d1 a1  cs1) y@(SProperty _d2 a2 _cs2) =
 		SProperty d1 (a2 `andThen` a1) (y : cs1)
 
-instance Requires RevertableProperty (Property HasInfo) RevertableProperty where
+instance Combines RevertableProperty (Property HasInfo) where
 	requires (RevertableProperty p1 p2) y =
 		RevertableProperty (p1 `requires` y) p2
 
-instance Requires RevertableProperty (Property NoInfo) RevertableProperty where
+instance Combines RevertableProperty (Property NoInfo) where
 	requires (RevertableProperty p1 p2) y =
 		RevertableProperty (p1 `requires` toIProperty y) p2
 
-instance Requires RevertableProperty RevertableProperty RevertableProperty where
+instance Combines RevertableProperty RevertableProperty where
 	requires (RevertableProperty x1 x2) (RevertableProperty y1 y2) =
 		RevertableProperty
 			(x1 `requires` y1)