From 2506453874aa30968d8533a603d295ac248273c5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 02:00:23 -0400 Subject: add type alias for Sing to be less confusing for users --- src/Propellor/EnsureProperty.hs | 8 ++++---- src/Propellor/Property.hs | 10 +++++----- src/Propellor/Types.hs | 26 +++++++++++++------------- src/Propellor/Types/MetaTypes.hs | 16 +++++++++------- 4 files changed, 31 insertions(+), 29 deletions(-) diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs index 00495f87..f3e79ae5 100644 --- a/src/Propellor/EnsureProperty.hs +++ b/src/Propellor/EnsureProperty.hs @@ -37,7 +37,7 @@ ensureProperty , CannotUse_ensureProperty_WithInfo inner ~ 'True ) => OuterMetaTypes outer - -> Property (Sing inner) + -> Property (MetaTypes inner) -> Propellor Result ensureProperty _ = catchPropellor . propertySatisfy @@ -53,14 +53,14 @@ property' :: SingI metatypes => Desc -> (OuterMetaTypes metatypes -> Propellor Result) - -> Property (Sing metatypes) + -> Property (MetaTypes metatypes) property' d a = let p = Property sing d (a (outerMetaTypes p)) mempty mempty in p -- | Used to provide the metatypes of a Property to calls to -- 'ensureProperty` within it. -newtype OuterMetaTypes metatypes = OuterMetaTypes (Sing metatypes) +newtype OuterMetaTypes metatypes = OuterMetaTypes (MetaTypes metatypes) -outerMetaTypes :: Property (Sing l) -> OuterMetaTypes l +outerMetaTypes :: Property (MetaTypes l) -> OuterMetaTypes l outerMetaTypes (Property metatypes _ _ _ _) = OuterMetaTypes metatypes diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index cab233d0..c665b6a0 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -260,8 +260,8 @@ tightenTargets , (NonTargets new `NotSuperset` NonTargets old) ~ CanCombineTargets , SingI new ) - => Property (Sing old) - -> Property (Sing new) + => Property (MetaTypes old) + -> Property (MetaTypes new) tightenTargets (Property old d a i c) = Property sing d a i c {- @@ -276,9 +276,9 @@ pickOS ( combined ~ Union a b , SingI combined ) - => Property (Sing a) - -> Property (Sing b) - -> Property (Sing combined) + => Property (MetaTypes a) + -> Property (MetaTypes b) + -> Property (MetaTypes combined) pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io where -- TODO pick with of ioa or iob to use based on final OS of diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 3cd5a368..f23a18dd 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -41,7 +41,7 @@ module Propellor.Types , module Propellor.Types.Result , module Propellor.Types.ZFS , propertySatisfy - , Sing + , MetaTypes ) where import Data.Monoid @@ -142,17 +142,17 @@ property :: SingI metatypes => Desc -> Propellor Result - -> Property (Sing metatypes) + -> Property (MetaTypes metatypes) property d a = Property sing d a mempty mempty -- | Adds info to a Property. -- -- The new Property will include HasInfo in its metatypes. addInfoProperty - :: (Sing metatypes' ~ (+) HasInfo metatypes, SingI metatypes') + :: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes') => Property metatypes -> Info - -> Property (Sing metatypes') + -> Property (MetaTypes metatypes') addInfoProperty (Property metatypes d a oldi c) newi = Property sing d a (oldi <> newi) c @@ -163,7 +163,7 @@ addInfoProperty (Property metatypes d a oldi c) newi = ignoreInfo :: (metatypes' ~ => Property metatypes - -> Property (Sing metatypes') + -> Property (MetaTypes metatypes') ignoreInfo = -} @@ -245,12 +245,12 @@ instance IsProp (RevertableProperty setupmetatypes undometatypes) where -- | Type level calculation of the type that results from combining two -- types of properties. type family CombinedType x y -type instance CombinedType (Property (Sing x)) (Property (Sing y)) = Property (Sing (Combine x y)) -type instance CombinedType (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) = RevertableProperty (Sing (Combine x y)) (Sing (Combine x' y')) +type instance CombinedType (Property (MetaTypes x)) (Property (MetaTypes y)) = Property (MetaTypes (Combine x y)) +type instance CombinedType (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) = RevertableProperty (MetaTypes (Combine x y)) (MetaTypes (Combine 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 (Sing x) (Sing x')) (Property (Sing y)) = Property (Sing (Combine x y)) -type instance CombinedType (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) = Property (Sing (Combine x y)) +type instance CombinedType (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) = Property (MetaTypes (Combine x y)) +type instance CombinedType (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) = Property (MetaTypes (Combine x y)) type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result @@ -268,15 +268,15 @@ class Combines x y where -> y -> CombinedType x y -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (Sing x)) (Property (Sing y)) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where combineWith f _ (Property t1 d1 a1 i1 c1) (Property _t2 d2 a2 i2 c2) = Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1) -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, CannotCombineTargets x' y' (Combine x' y') ~ 'CanCombineTargets, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (Sing x) (Sing x')) (RevertableProperty (Sing y) (Sing y')) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, CannotCombineTargets x' y' (Combine x' y') ~ 'CanCombineTargets, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) = RevertableProperty (combineWith sf tf s1 s2) (combineWith tf sf t1 t2) -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (RevertableProperty (Sing x) (Sing x')) (Property (Sing y)) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) where combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y -instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (Sing x)) (RevertableProperty (Sing y) (Sing y')) where +instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 6edea291..7dafe422 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -10,7 +10,7 @@ module Propellor.Types.MetaTypes ( FreeBSD, HasInfo, type (+), - Sing, + MetaTypes, sing, SingI, IncludesInfo, @@ -36,15 +36,17 @@ data OS deriving (Show, Eq) -- | Any unix-like system -type UnixLike = Sing '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] -type Debian = Sing '[ 'Targeting 'OSDebian ] +type UnixLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ] +type Debian = MetaTypes '[ 'Targeting 'OSDebian ] +type Buntish = MetaTypes '[ 'Targeting 'OSBuntish ] +type FreeBSD = MetaTypes '[ 'Targeting 'OSFreeBSD ] -- | Debian and derivatives. -type DebianLike = Sing '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ] -type Buntish = Sing '[ 'Targeting 'OSBuntish ] -type FreeBSD = Sing '[ 'Targeting 'OSFreeBSD ] +type DebianLike = Debian + Buntish -- | Used to indicate that a Property adds Info to the Host where it's used. -type HasInfo = Sing '[ 'WithInfo ] +type HasInfo = MetaTypes '[ 'WithInfo ] + +type MetaTypes = Sing -- | The data family of singleton types. data family Sing (x :: k) -- cgit v1.2.3