avoid needing to define Show twice

This commit is contained in:
Joey Hess 2015-01-25 13:04:39 -04:00
parent f5da1c2b23
commit f4fc24aa5c
1 changed files with 11 additions and 8 deletions

View File

@ -18,6 +18,7 @@ module Propellor.Types
, simpleProperty , simpleProperty
, adjustPropertySatisfy , adjustPropertySatisfy
, propertyInfo , propertyInfo
, propertyDesc
, propertyChildren , propertyChildren
, RevertableProperty(..) , RevertableProperty(..)
, (<!>) , (<!>)
@ -144,9 +145,7 @@ propertySatisfy :: Property i -> Propellor Result
propertySatisfy (IProperty _ a _ _) = a propertySatisfy (IProperty _ a _ _) = a
propertySatisfy (SProperty _ a _) = a propertySatisfy (SProperty _ a _) = a
instance Show (Property NoInfo) where instance Show (Property i) where
show p = "property " ++ show (propertyDesc p)
instance Show (Property HasInfo) where
show p = "property " ++ show (propertyDesc p) show p = "property " ++ show (propertyDesc p)
-- | Changes the action that is performed to satisfy a property. -- | Changes the action that is performed to satisfy a property.
@ -158,6 +157,10 @@ propertyInfo :: Property i -> Info
propertyInfo (IProperty _ _ i _) = i propertyInfo (IProperty _ _ i _) = i
propertyInfo (SProperty {}) = mempty propertyInfo (SProperty {}) = mempty
propertyDesc :: Property i -> Desc
propertyDesc (IProperty d _ _ _) = d
propertyDesc (SProperty d _ _) = d
-- | A Property can include a list of child properties that it also -- | A Property can include a list of child properties that it also
-- satisfies. This allows them to be introspected to collect their info, etc. -- satisfies. This allows them to be introspected to collect their info, etc.
propertyChildren :: Property i -> [Property i] propertyChildren :: Property i -> [Property i]
@ -175,24 +178,24 @@ p1 <!> p2 = RevertableProperty (toIProperty p1) (toIProperty p2)
class IsProp p where class IsProp p where
-- | Sets description. -- | Sets description.
describe :: p -> Desc -> p describe :: p -> Desc -> p
propertyDesc :: p -> Desc
toProp :: p -> Property HasInfo toProp :: p -> Property HasInfo
toSimpleProp :: p -> Maybe (Property NoInfo) toSimpleProp :: p -> Maybe (Property NoInfo)
getDesc :: p -> Desc
-- | Gets the info of the property, combined with all info -- | Gets the info of the property, combined with all info
-- of all children properties. -- of all children properties.
getInfoRecursive :: p -> Info getInfoRecursive :: p -> Info
instance IsProp (Property HasInfo) where instance IsProp (Property HasInfo) where
describe (IProperty _ a i cs) d = IProperty d a i cs describe (IProperty _ a i cs) d = IProperty d a i cs
propertyDesc (IProperty d _ _ _) = d
toProp = id toProp = id
toSimpleProp _ = Nothing toSimpleProp _ = Nothing
getDesc = propertyDesc
getInfoRecursive (IProperty _ _ i cs) = getInfoRecursive (IProperty _ _ i cs) =
i <> mconcat (map getInfoRecursive cs) i <> mconcat (map getInfoRecursive cs)
instance IsProp (Property NoInfo) where instance IsProp (Property NoInfo) where
describe (SProperty _ a cs) d = SProperty d a cs describe (SProperty _ a cs) d = SProperty d a cs
propertyDesc (SProperty d _ _) = d
toProp = toIProperty toProp = toIProperty
getDesc = propertyDesc
toSimpleProp = Just toSimpleProp = Just
getInfoRecursive _ = mempty getInfoRecursive _ = mempty
@ -200,7 +203,7 @@ instance IsProp RevertableProperty where
-- | Sets the description of both sides. -- | Sets the description of both sides.
describe (RevertableProperty p1 p2) d = describe (RevertableProperty p1 p2) d =
RevertableProperty (describe p1 d) (describe p2 ("not " ++ d)) RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
propertyDesc (RevertableProperty p1 _) = propertyDesc p1 getDesc (RevertableProperty p1 _) = getDesc p1
toProp (RevertableProperty p1 _) = p1 toProp (RevertableProperty p1 _) = p1
toSimpleProp = toSimpleProp . toProp toSimpleProp = toSimpleProp . toProp
-- | Return the Info of the currently active side. -- | Return the Info of the currently active side.
@ -223,7 +226,7 @@ class Combines x y where
-- that ensures the first, and if the first succeeds, ensures the second. -- that ensures the first, and if the first succeeds, ensures the second.
-- The property uses the description of the first property. -- 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 :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x
before x y = (y `requires` x) `describe` (propertyDesc x) before x y = (y `requires` x) `describe` (getDesc x)
-- | Combines together two properties, yielding a property that -- | Combines together two properties, yielding a property that
-- has the description and info of the first, and that has the second -- has the description and info of the first, and that has the second