From 83cd812ab5ac787769b34f59d1763f3c8648f06a Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 24 Mar 2016 17:25:58 -0400
Subject: convert ensureProperty

Moved to its own module to keep everything related in one place.
---
 src/Propellor/EnsureProperty.hs | 66 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 66 insertions(+)
 create mode 100644 src/Propellor/EnsureProperty.hs

(limited to 'src/Propellor/EnsureProperty.hs')

diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
new file mode 100644
index 00000000..c72f7ecd
--- /dev/null
+++ b/src/Propellor/EnsureProperty.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Propellor.EnsureProperty
+	( ensureProperty
+	, property'
+	, OuterMetaTypes
+	) where
+
+import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Exception
+
+-- | For when code running in the Propellor monad needs to ensure a
+-- Property.
+--
+-- Use `property'` to get the `OuterMetaTypes`. For example:
+--
+-- > foo = Property Debian
+-- > foo = property' $ \o -> do
+-- > 	ensureProperty o (aptInstall "foo")
+--
+-- The type checker will prevent using ensureProperty with a property
+-- that does not support the target OSes needed by the OuterMetaTypes.
+-- In the example above, aptInstall must support Debian, since foo
+-- is supposed to support Debian.
+--
+-- The type checker will also prevent using ensureProperty with a property
+-- with HasInfo in its MetaTypes. Doing so would cause the `Info` associated
+-- with the property to be lost.
+ensureProperty
+	::
+		( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets
+		, CannotUseEnsurePropertyWithInfo inner ~ 'True
+		)
+	=> OuterMetaTypes outer
+	-> Property (Sing inner)
+	-> Propellor Result
+ensureProperty _ = catchPropellor . propertySatisfy
+
+-- The name of this was chosen to make type errors a more understandable.
+type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool
+type instance CannotUseEnsurePropertyWithInfo '[] = 'True
+type instance CannotUseEnsurePropertyWithInfo (t ': ts) =
+	Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts
+
+-- | Constructs a property, like `property`, but provides its
+-- `OuterMetaTypes`.
+property'
+	:: SingI metatypes
+	=> Desc
+	-> (OuterMetaTypes metatypes -> Propellor Result)
+	-> Property (Sing 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)
+
+outerMetaTypes :: Property (Sing l) -> OuterMetaTypes l
+outerMetaTypes (Property metatypes _ _ _ _) = OuterMetaTypes metatypes
-- 
cgit v1.3-2-g0d8e


From 80ace2f30bea2ed850cf400a85fe68b3784751d2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 25 Mar 2016 01:11:24 -0400
Subject: improve type error

---
 src/Propellor/EnsureProperty.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

(limited to 'src/Propellor/EnsureProperty.hs')

diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index c72f7ecd..00495f87 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -34,7 +34,7 @@ import Propellor.Exception
 ensureProperty
 	::
 		( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets
-		, CannotUseEnsurePropertyWithInfo inner ~ 'True
+		, CannotUse_ensureProperty_WithInfo inner ~ 'True
 		)
 	=> OuterMetaTypes outer
 	-> Property (Sing inner)
@@ -42,10 +42,10 @@ ensureProperty
 ensureProperty _ = catchPropellor . propertySatisfy
 
 -- The name of this was chosen to make type errors a more understandable.
-type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool
-type instance CannotUseEnsurePropertyWithInfo '[] = 'True
-type instance CannotUseEnsurePropertyWithInfo (t ': ts) =
-	Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts
+type family CannotUse_ensureProperty_WithInfo (l :: [a]) :: Bool
+type instance CannotUse_ensureProperty_WithInfo '[] = 'True
+type instance CannotUse_ensureProperty_WithInfo (t ': ts) =
+	Not (t `EqT` 'WithInfo) && CannotUse_ensureProperty_WithInfo ts
 
 -- | Constructs a property, like `property`, but provides its
 -- `OuterMetaTypes`.
-- 
cgit v1.3-2-g0d8e


From 2506453874aa30968d8533a603d295ac248273c5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
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(-)

(limited to 'src/Propellor/EnsureProperty.hs')

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.3-2-g0d8e


From a7560c9677485dbecd7283aedf977c4653cfacb4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 25 Mar 2016 13:10:33 -0400
Subject: fix CheckCombinable

Was wrong when there was a non-target in the MetaTypes list.

Also, rework to improve type checker errors.
---
 src/Propellor/EnsureProperty.hs  |  2 +-
 src/Propellor/Types.hs           |  8 +++----
 src/Propellor/Types/MetaTypes.hs | 51 ++++++++++++++++++++++++----------------
 3 files changed, 36 insertions(+), 25 deletions(-)

(limited to 'src/Propellor/EnsureProperty.hs')

diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index f3e79ae5..f42003c0 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -33,7 +33,7 @@ import Propellor.Exception
 -- with the property to be lost.
 ensureProperty
 	::
-		( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets
+		( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine
 		, CannotUse_ensureProperty_WithInfo inner ~ 'True
 		)
 	=> OuterMetaTypes outer
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 23716e58..42c12492 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -269,15 +269,15 @@ class Combines x y where
 		-> y
 		-> CombinedType x y
 
-instance (CannotCombineTargets x y (Combine x y) ~ 'CanCombineTargets, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where
+instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where
 	combineWith f _ (Property _ d1 a1 i1 c1) (Property _ 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 (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
+instance (CheckCombinable x y ~ 'CanCombine, CheckCombinable x' y' ~ 'CanCombine, 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 (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) where
+instance (CheckCombinable x y ~ 'CanCombine, 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 (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
+instance (CheckCombinable x y ~ 'CanCombine, 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 4006914e..80fa454e 100644
--- a/src/Propellor/Types/MetaTypes.hs
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -17,9 +17,9 @@ module Propellor.Types.MetaTypes (
 	Targets,
 	NonTargets,
 	NotSuperset,
-	CheckCombineTargets(..),
 	Combine,
-	CannotCombineTargets,
+	CheckCombine(..),
+	CheckCombinable,
 	type (&&),
 	Not,
 	EqT,
@@ -46,6 +46,9 @@ type DebianLike = Debian + Buntish
 -- | Used to indicate that a Property adds Info to the Host where it's used.
 type HasInfo = MetaTypes '[ 'WithInfo ]
 
+type family IncludesInfo t :: Bool
+type instance IncludesInfo (MetaTypes l) = Elem 'WithInfo l
+
 type MetaTypes = Sing
 
 -- | The data family of singleton types.
@@ -98,28 +101,36 @@ type instance Combine (list1 :: [a]) (list2 :: [a]) =
 		(Targets list1 `Intersect` Targets list2)
 	)
 
-type family IncludesInfo t :: Bool
-type instance IncludesInfo (MetaTypes l) = Elem 'WithInfo l
-
--- The name of this was chosen to make type errors a more understandable.
-type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool
-type instance CannotUseEnsurePropertyWithInfo '[] = 'True
-type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts
-
--- | Detect intersection of two lists that don't have any common targets.
--- 
--- The name of this was chosen to make type errors a more understandable.
-type family CannotCombineTargets (list1 :: [a]) (list2 :: [a]) (listr :: [a]) :: CheckCombineTargets
-type instance CannotCombineTargets l1 l2 '[] = 'CannotCombineTargets
-type instance CannotCombineTargets l1 l2 (a ': rest) = 'CanCombineTargets
-
-data CheckCombineTargets = CannotCombineTargets | CanCombineTargets
+-- | Checks if two MetaTypes lists can be safely combined.
+--
+-- This should be used anywhere Combine is used, as an additional
+-- constraint. For example:
+--
+-- > foo :: (CheckCombinable x y ~ 'CanCombine) => x -> y -> Combine x y
+type family CheckCombinable (list1 :: [a]) (list2 :: [a]) :: CheckCombine
+-- As a special case, if either list is empty, let it be combined with the
+-- other. This relies on MetaTypes list always containing at least
+-- one target, so can only happen if there's already been a type error.
+-- This special case lets the type checker show only the original type
+-- error, and not an extra error due to a later CheckCombinable constraint.
+type instance CheckCombinable '[] list2 = CanCombine
+type instance CheckCombinable list1 '[] = CanCombine
+type instance CheckCombinable (l1 ': list1) (l2 ': list2) =
+	CheckCombinable' (Combine (l1 ': list1) (l2 ': list2))
+type family CheckCombinable' (combinedlist :: [a]) :: CheckCombine
+type instance CheckCombinable' '[] = 'CannotCombineTargets
+type instance CheckCombinable' (a ': rest) 
+	= If (IsTarget a)
+		'CanCombine
+		(CheckCombinable' rest)
+
+data CheckCombine = CannotCombineTargets | CanCombine
 
 -- | Every item in the subset must be in the superset.
 --
 -- The name of this was chosen to make type errors more understandable.
-type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombineTargets
-type instance NotSuperset superset '[] = 'CanCombineTargets
+type family NotSuperset (superset :: [a]) (subset :: [a]) :: CheckCombine
+type instance NotSuperset superset '[] = 'CanCombine
 type instance NotSuperset superset (s ': rest) =
 	If (Elem s superset)
 		(NotSuperset superset rest)
-- 
cgit v1.3-2-g0d8e


From 91d1833155a2e8be2c435d0a92a750cc9d2f30b5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 25 Mar 2016 14:04:40 -0400
Subject: ported Property.List

I wanted to keep propertyList [foo, bar] working, but had some difficulty
making the type class approach work. Anyway, that's unlikely to be useful,
since foo and bar probably have different types, or could easiy have their
types updated breaking it.
---
 debian/changelog                     |  34 +++++++-----
 src/Propellor/Base.hs                |   4 +-
 src/Propellor/Engine.hs              |  16 ++++--
 src/Propellor/EnsureProperty.hs      |   2 +-
 src/Propellor/PrivData.hs            |   2 +-
 src/Propellor/PropAccum.hs           |   9 +--
 src/Propellor/Property.hs            |   4 +-
 src/Propellor/Property/Chroot.hs     |   2 +-
 src/Propellor/Property/Concurrent.hs |   4 +-
 src/Propellor/Property/Docker.hs     |   2 +-
 src/Propellor/Property/List.hs       | 104 ++++++++++++-----------------------
 src/Propellor/Types.hs               |  20 ++++---
 12 files changed, 93 insertions(+), 110 deletions(-)

(limited to 'src/Propellor/EnsureProperty.hs')

diff --git a/debian/changelog b/debian/changelog
index ead6585e..b27559bd 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,37 +1,43 @@
 propellor (3.0.0) UNRELEASED; urgency=medium
 
   * Property types have been improved to indicate what systems they target.
-    This allows, eg, Property Debian to not be used on a FreeBSD system.
+    This prevents using eg, Property FreeBSD on a Debian system.
     Transition guide for this sweeping API change:
+    - Change "host name & foo & bar"
+      to     "host name $ props & foo & bar"
+    - Similarly, Chroot and Docker need `props` to be used to combine
+      together the properies used inside them.
+    - And similarly, `propertyList` and `combineProperties` need `props`
+      to be used to combine together properties; lists of properties will
+      no longer work.
     - Change "Property NoInfo" to "Property UnixLike"
     - Change "Property HasInfo" to "Property (HasInfo + UnixLike)"
     - Change "RevertableProperty NoInfo" to
       "RevertableProperty UnixLike UnixLike"
     - Change "RevertableProperty HasInfo" to
       "RevertableProperty (HasInfo + UnixLike) UnixLike"
-    - GHC needs {-# LANGUAGE TypeOperators #-} to use these new type signatures.
+    - GHC needs {-# LANGUAGE TypeOperators #-} to use these fancy types.
       This is enabled by default for all modules in propellor.cabal. But
       if you are using propellor as a library, you may need to enable it
       manually.
     - If you know a property only works on a particular OS, like Debian
       or FreeBSD, use that instead of "UnixLike". For example:
-      "Property (HasInfo + Debian)"
+      "Property Debian"
     - It's also possible make a property support a set of OS's, for example:
-      "Property (HasInfo + Debian + FreeBSD)"
-    - `ensureProperty` now needs information about the metatypes of the
-      property it's used in to be passed to it. See the documentation
-      of `ensureProperty` for an example, but basically, change
-      this:     foo = property desc $ ... ensureProperty bar
-      to this:  foo = property' desc $ \o -> ... ensureProperty o bar
+      "Property (Debian + FreeBSD)"
+    - `ensureProperty` now needs to be passed information about the
+      property it's used in.
+      change this:  foo = property desc $ ... ensureProperty bar
+      to this:      foo = property' desc $ \o -> ... ensureProperty o bar
     - General purpose properties like cmdProperty have type "Property UnixLike".
       When using that to run a command only available on Debian, you can
-      tighten the targets to only the OS that your more specific
-      property works on. For example:
+      tighten the type to only the OS that your more specific property works on.
+      For example:
         upgraded :: Property Debian
         upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"])
-    - The new `pickOS` property combinator can be used to combine different
-      properties, supporting different OS's, into one Property that chooses
-      what to do based on the Host's OS.
+  * The new `pickOS` property combinator can be used to combine different
+    properties, supporting different OS's, into one Property that chooses
+    what to do based on the Host's OS.
 
  -- Joey Hess <id@joeyh.name>  Thu, 24 Mar 2016 15:02:33 -0400
 
diff --git a/src/Propellor/Base.hs b/src/Propellor/Base.hs
index e50adf10..4afad2ab 100644
--- a/src/Propellor/Base.hs
+++ b/src/Propellor/Base.hs
@@ -9,7 +9,7 @@ module Propellor.Base (
 	, module Propellor.Property.Cmd
 	--, module Propellor.Property.List
 	, module Propellor.Types.PrivData
-	--, module Propellor.PropAccum
+	, module Propellor.PropAccum
 	, module Propellor.Info
 	, module Propellor.PrivData
 	--, module Propellor.Engine
@@ -43,7 +43,7 @@ import Propellor.Message
 import Propellor.Debug
 import Propellor.Exception
 import Propellor.Info
---import Propellor.PropAccum
+import Propellor.PropAccum
 import Propellor.Location
 import Propellor.Utilities
 
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 2e914d67..62fad5af 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -2,10 +2,10 @@
 {-# LANGUAGE GADTs #-}
 
 module Propellor.Engine (
-	mainProperties,
+	-- mainProperties,
 	runPropellor,
 	ensureProperty,
-	ensureProperties,
+	ensureChildProperties,
 	fromHost,
 	fromHost',
 	onlyProcess,
@@ -29,6 +29,8 @@ import Propellor.Info
 import Propellor.Property
 import Utility.Exception
 
+{-
+
 -- | Gets the Properties of a Host, and ensures them all,
 -- with nice display of what's being done.
 mainProperties :: Host -> IO ()
@@ -42,6 +44,8 @@ mainProperties host = do
   where
 	ps = map ignoreInfo $ hostProperties host
 
+-}
+
 -- | Runs a Propellor action with the specified host.
 --
 -- If the Result is not FailedChange, any EndActions
@@ -58,14 +62,14 @@ runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc
 	(ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host ()
 	return ret
 
--- | Ensures a list of Properties, with a display of each as it runs.
-ensureProperties :: [Property NoInfo] -> Propellor Result
-ensureProperties ps = ensure ps NoChange
+-- | Ensures the child properties, with a display of each as it runs.
+ensureChildProperties :: [ChildProperty] -> Propellor Result
+ensureChildProperties ps = ensure ps NoChange
   where
 	ensure [] rs = return rs
 	ensure (p:ls) rs = do
 		hn <- asks hostName
-		r <- actionMessageOn hn (propertyDesc p) (ensureProperty p)
+		r <- actionMessageOn hn (getDesc p) (catchPropellor $ getSatisfy p)
 		ensure ls (r <> rs)
 
 -- | Lifts an action into the context of a different host.
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index f42003c0..21f8acce 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -39,7 +39,7 @@ ensureProperty
 	=> OuterMetaTypes outer
 	-> Property (MetaTypes inner)
 	-> Propellor Result
-ensureProperty _ = catchPropellor . propertySatisfy
+ensureProperty _ = catchPropellor . getSatisfy
 
 -- The name of this was chosen to make type errors a more understandable.
 type family CannotUse_ensureProperty_WithInfo (l :: [a]) :: Bool
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index bc61c538..5e6e0869 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -129,7 +129,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 		return FailedChange
 	addinfo p = Property undefined -- FIXME: should use sing here
 		(propertyDesc p)
-		(propertySatisfy p)
+		(getSatisfy p)
 		(propertyInfo p `addInfo` privset)
 		(propertyChildren p)
 	privset = PrivInfo $ S.fromList $
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index fb38e260..8177b97b 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -36,8 +36,9 @@ host hn (Props i c) = Host hn c i
 -- metatypes and info.
 data Props metatypes = Props Info [ChildProperty]
 
--- | Start constructing a Props. Properties can then be added to it using
--- `(&)` etc.
+-- | Start accumulating a list of properties.
+--
+-- Properties can be added to it using `(&)` etc.
 props :: Props UnixLike
 props = Props mempty []
 
@@ -102,7 +103,7 @@ propagateContainer
 propagateContainer containername c prop = Property
 	undefined
 	(propertyDesc prop)
-	(propertySatisfy prop)
+	(getSatisfy prop)
 	(propertyInfo prop)
 	(propertyChildren prop ++ hostprops)
   where
@@ -111,6 +112,6 @@ propagateContainer containername c prop = Property
 		let i = mapInfo (forceHostContext containername)
 			(propagatableInfo (propertyInfo p))
 		    cs = map go (propertyChildren p)
-		in infoProperty (propertyDesc p) (propertySatisfy p) i cs
+		in infoProperty (propertyDesc p) (getSatisfy p) i cs
 
 -}
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 582b7cfb..8999d8d8 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -255,8 +255,8 @@ isNewerThan x y = do
 tightenTargets
 	:: 
 		-- Note that this uses PolyKinds
-		( (Targets old `NotSuperset` Targets new) ~ 'CanCombineTargets
-		, (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombineTargets
+		( (Targets old `NotSuperset` Targets new) ~ 'CanCombine
+		, (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombine
 		, SingI new
 		)
 	=> Property (MetaTypes old)
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 378836e8..fb05d659 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -148,7 +148,7 @@ propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c p'
   where
 	p' = infoProperty
 		(propertyDesc p)
-		(propertySatisfy p)
+		(getSatisfy p)
 		(propertyInfo p <> chrootInfo c)
 		(propertyChildren p)
 
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index 74afecc4..8d608a54 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -97,7 +97,7 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps
 			(p:rest) -> return (rest, Just p)
 		case v of
 			Nothing -> return r
-			-- This use of propertySatisfy does not lose any
+			-- This use of getSatisfy does not lose any
 			-- Info asociated with the property, because
 			-- concurrentList sets all the properties as
 			-- children, and so propigates their info.
@@ -105,7 +105,7 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps
 				hn <- asks hostName
 				r' <- actionMessageOn hn
 					(propertyDesc p)
-					(propertySatisfy p)
+					(getSatisfy p)
 				worker q (r <> r')
 
 -- | Run an action with the number of capabiities increased as necessary to
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index ebc0b301..c2c131c7 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -178,7 +178,7 @@ propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p'
   where
 	p' = infoProperty
 		(propertyDesc p)
-		(propertySatisfy p)
+		(getSatisfy p)
 		(propertyInfo p <> dockerinfo)
 		(propertyChildren p)
 	dockerinfo = dockerInfo $
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index 74aa6ca6..b4a72fa8 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -1,86 +1,54 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Propellor.Property.List (
 	props,
-	PropertyList(..),
-	PropertyListType,
-	PropList(..),
+	Props,
+	propertyList,
+	combineProperties,
 ) where
 
 import Propellor.Types
+import Propellor.Types.MetaTypes
 import Propellor.Engine
 import Propellor.PropAccum
+import Propellor.Exception
 
 import Data.Monoid
 
--- | Starts accumulating a list of properties.
+-- | 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 propagate overall success/failure.
+--
+-- For example:
 --
 -- > propertyList "foo" $ props
--- > 	& someproperty
--- > 	! oldproperty
--- > 	& otherproperty
-props :: PropList
-props = PropList []
-
-data PropList = PropList [Property HasInfo]
-
-instance PropAccum PropList where
-	PropList l `addProp` p = PropList (toProp p : l)
-	PropList l `addPropFront` p = PropList (l ++ [toProp p])
-	getProperties (PropList l) = reverse l
-
-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 propagate 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 :: 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 [RevertableProperty NoInfo] = NoInfo
-type instance PropertyListType [RevertableProperty HasInfo] = HasInfo
-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 [RevertableProperty HasInfo] where
-	propertyList desc ps = propertyList desc (map setupRevertableProperty ps)
-	combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps)
-
-instance PropertyList [RevertableProperty NoInfo] where
-	propertyList desc ps = propertyList desc (map setupRevertableProperty ps)
-	combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps)
-
-instance PropertyList PropList where
-	propertyList desc = propertyList desc . getProperties
-	combineProperties desc = combineProperties desc . getProperties
-
-combineSatisfy :: [Property i] -> Result -> Propellor Result
+-- > 	& bar
+-- > 	& baz
+propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+propertyList desc (Props _i ps) = 
+	property desc (ensureChildProperties cs)
+		`modifyChildren` (++ cs)
+  where
+	cs = map toProp ps
+
+-- | Combines a list of properties, resulting in one property that
+-- ensures each in turn. Stops if a property fails.
+combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+combineProperties desc (Props _i ps) = 
+	property desc (combineSatisfy cs NoChange)
+		`modifyChildren` (++ cs)
+  where
+	cs = map toProp ps
+
+combineSatisfy :: [ChildProperty] -> Result -> Propellor Result
 combineSatisfy [] rs = return rs
-combineSatisfy (l:ls) rs = do
-	r <- ensureProperty $ ignoreInfo l
+combineSatisfy (p:ps) rs = do
+	r <- catchPropellor $ getSatisfy p
 	case r of
 		FailedChange -> return FailedChange
-		_ -> combineSatisfy ls (r <> rs)
+		_ -> combineSatisfy ps (r <> rs)
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 42c12492..db05e100 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -14,6 +14,7 @@ module Propellor.Types
 	, Info
 	, Desc
 	, MetaType(..)
+	, MetaTypes
 	, OS(..)
 	, UnixLike
 	, Debian
@@ -41,8 +42,6 @@ module Propellor.Types
 	, module Propellor.Types.Dns
 	, module Propellor.Types.Result
 	, module Propellor.Types.ZFS
-	, propertySatisfy
-	, MetaTypes
 	) where
 
 import Data.Monoid
@@ -169,12 +168,6 @@ ignoreInfo =
 
 -}
 
--- | Gets the action that can be run to satisfy a Property.
--- You should never run this action directly. Use
--- 'Propellor.EnsureProperty.ensureProperty` instead.
-propertySatisfy :: Property metatypes -> Propellor Result
-propertySatisfy (Property _ _ a _ _) = a
-
 -- | Changes the action that is performed to satisfy a property.
 adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
 adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c
@@ -214,34 +207,45 @@ setup <!> undo = RevertableProperty setup undo
 class IsProp p where
 	setDesc :: p -> Desc -> p
 	getDesc :: p -> Desc
+	modifyChildren :: p -> ([ChildProperty] -> [ChildProperty]) -> p
 	-- | Gets the info of the property, combined with all info
 	-- of all children properties.
 	getInfoRecursive :: p -> Info
 	toProp :: p -> ChildProperty
+	-- | Gets the action that can be run to satisfy a Property.
+	-- You should never run this action directly. Use
+	-- 'Propellor.EnsureProperty.ensureProperty` instead.
+	getSatisfy :: p -> Propellor Result
 
 instance IsProp (Property metatypes) where
 	setDesc (Property t _ a i c) d = Property t d a i c
 	getDesc = propertyDesc
+	modifyChildren (Property t d a i c) f = Property t d a i (f c)
 	getInfoRecursive (Property _ _ _ i c) =
 		i <> mconcat (map getInfoRecursive c)
 	toProp (Property _ d a i c) = ChildProperty d a i c
+	getSatisfy (Property _ _ a _ _) = a
 
 instance IsProp ChildProperty where
 	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
 	getDesc (ChildProperty d _ _ _) = d
+	modifyChildren (ChildProperty d a i c) f = ChildProperty d a i (f c)
 	getInfoRecursive (ChildProperty _ _ i c) =
 		i <> mconcat (map getInfoRecursive c)
 	toProp = id
+	getSatisfy (ChildProperty _ a _ _) = a
 
 instance IsProp (RevertableProperty setupmetatypes undometatypes) where
 	-- | Sets the description of both sides.
 	setDesc (RevertableProperty p1 p2) d =
 		RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))
 	getDesc (RevertableProperty p1 _) = getDesc p1
+	modifyChildren (RevertableProperty p1 p2) f = RevertableProperty (modifyChildren p1 f) (modifyChildren p2 f)
 	-- toProp (RevertableProperty p1 _) = p1
 	-- | Return the Info of the currently active side.
 	getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
 	toProp (RevertableProperty p1 _p2) = toProp p1
+	getSatisfy (RevertableProperty p1 _) = getSatisfy p1
 
 -- | Type level calculation of the type that results from combining two
 -- types of properties.
-- 
cgit v1.3-2-g0d8e


From 1edce2b72614e2e8eceefde97436db024799ff20 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 25 Mar 2016 15:28:31 -0400
Subject: ported Property.Apt

---
 config-simple.hs                   |   4 +-
 src/Propellor/EnsureProperty.hs    |  14 ++---
 src/Propellor/Property.hs          |  54 ++++++++----------
 src/Propellor/Property/Apt.hs      | 113 +++++++++++++++++++------------------
 src/Propellor/Property/Service.hs  |  10 ++--
 src/Propellor/Types.hs             |  23 ++++++++
 src/Propellor/Types/ResultCheck.hs |   3 +
 7 files changed, 121 insertions(+), 100 deletions(-)

(limited to 'src/Propellor/EnsureProperty.hs')

diff --git a/config-simple.hs b/config-simple.hs
index 21accd18..28b38409 100644
--- a/config-simple.hs
+++ b/config-simple.hs
@@ -25,7 +25,7 @@ hosts =
 
 -- An example host.
 mybox :: Host
-mybox = host "mybox.example.com"
+mybox = host "mybox.example.com" $ props
 	& os (System (Debian Unstable) "amd64")
 	& Apt.stdSourcesList
 	& Apt.unattendedUpgrades
@@ -40,7 +40,7 @@ mybox = host "mybox.example.com"
 
 -- A generic webserver in a Docker container.
 webserverContainer :: Docker.Container
-webserverContainer = Docker.container "webserver" (Docker.latestImage "debian")
+webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") $ props
 	& os (System (Debian (Stable "jessie")) "amd64")
 	& Apt.stdSourcesList
 	& Docker.publish "80:80"
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index 21f8acce..c4b5fde1 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -7,7 +7,7 @@
 module Propellor.EnsureProperty
 	( ensureProperty
 	, property'
-	, OuterMetaTypes
+	, OuterMetaTypes(..)
 	) where
 
 import Propellor.Types
@@ -33,8 +33,8 @@ import Propellor.Exception
 -- with the property to be lost.
 ensureProperty
 	::
-		( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine
-		, CannotUse_ensureProperty_WithInfo inner ~ 'True
+		( Cannot_ensureProperty_WithInfo inner ~ 'True
+		, (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine
 		)
 	=> OuterMetaTypes outer
 	-> Property (MetaTypes inner)
@@ -42,10 +42,10 @@ ensureProperty
 ensureProperty _ = catchPropellor . getSatisfy
 
 -- The name of this was chosen to make type errors a more understandable.
-type family CannotUse_ensureProperty_WithInfo (l :: [a]) :: Bool
-type instance CannotUse_ensureProperty_WithInfo '[] = 'True
-type instance CannotUse_ensureProperty_WithInfo (t ': ts) =
-	Not (t `EqT` 'WithInfo) && CannotUse_ensureProperty_WithInfo ts
+type family Cannot_ensureProperty_WithInfo (l :: [a]) :: Bool
+type instance Cannot_ensureProperty_WithInfo '[] = 'True
+type instance Cannot_ensureProperty_WithInfo (t ': ts) =
+	Not (t `EqT` 'WithInfo) && Cannot_ensureProperty_WithInfo ts
 
 -- | Constructs a property, like `property`, but provides its
 -- `OuterMetaTypes`.
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index ba30209e..2ddec439 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -22,9 +22,9 @@ module Propellor.Property (
 	, Propellor
 	, property
 	, property'
+	, OuterMetaTypes
 	, ensureProperty
-	, tightenTargets
-	--, withOS
+	, withOS
 	, unsupportedOS
 	, makeChange
 	, noChange
@@ -243,26 +243,6 @@ isNewerThan x y = do
   where
 	mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f
 
--- | Tightens the MetaType list of a Property, to contain fewer targets.
---
--- Anything else in the MetaType list is passed through unchanged.
---
--- For example, to make a property that uses apt-get, which is only
--- available on DebianLike systems:
---
--- > upgraded :: Property DebianLike
--- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"]
-tightenTargets
-	:: 
-		-- Note that this uses PolyKinds
-		( (Targets untightened `NotSuperset` Targets tightened) ~ 'CanCombine
-		, (NonTargets tightened `NotSuperset` NonTargets untightened) ~ 'CanCombine
-		, SingI tightened
-		)
-	=> Property (MetaTypes untightened)
-	-> Property (MetaTypes tightened)
-tightenTargets (Property _old d a i c) = Property sing d a i c
-
 {-
 
 -- | Picks one of the two input properties to use,
@@ -286,17 +266,29 @@ pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io
 
 -}
 
--- | Makes a property that is satisfied differently depending on the host's
--- operating system. 
+-- | Makes a property that is satisfied differently depending on specifics
+-- of the host's operating system.
 --
--- Note that the operating system may not be declared for all hosts.
+-- > myproperty :: Property Debian
+-- > myproperty = withOS "foo installed" $ \o os -> case os of
+-- > 	(Just (System (Debian (Stable release)) arch)) -> ensureProperty o ...
+-- > 	(Just (System (Debian suite) arch)) -> ensureProperty o ...
+-- >	_ -> unsupportedOS
 --
--- > myproperty = withOS "foo installed" $ \o -> case o of
--- > 	(Just (System (Debian suite) arch)) -> ...
--- > 	(Just (System (Buntish release) arch)) -> ...
--- >	Nothing -> unsupportedOS
---withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo
---withOS desc a = property desc $ a =<< getOS
+-- Note that the operating system specifics may not be declared for all hosts,
+-- which is where Nothing comes in.
+withOS
+	:: (SingI metatypes)
+	=> Desc
+	-> (OuterMetaTypes '[] -> Maybe System -> Propellor Result)
+	-> Property (MetaTypes metatypes)
+withOS desc a = property desc $ a dummyoutermetatypes =<< getOS
+  where
+	-- Using this dummy value allows ensureProperty to be used
+	-- even though the inner property probably doesn't target everything
+	-- that the outer withOS property targets.
+	dummyoutermetatypes :: OuterMetaTypes ('[])
+	dummyoutermetatypes = OuterMetaTypes sing
 
 -- | Throws an error, for use in `withOS` when a property is lacking
 -- support for an OS.
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 7301a6ae..3dd7277e 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -80,37 +80,36 @@ securityUpdates suite
 --
 -- Since the CDN is sometimes unreliable, also adds backup lines using
 -- kernel.org.
-stdSourcesList :: Property NoInfo
-stdSourcesList = withOS "standard sources.list" $ \o ->
-	case o of
-		(Just (System (Debian suite) _)) ->
-			ensureProperty $ stdSourcesListFor suite
-		_ -> error "os is not declared to be Debian"
-
-stdSourcesListFor :: DebianSuite -> Property NoInfo
+stdSourcesList :: Property Debian
+stdSourcesList = withOS "standard sources.list" $ \o os -> case os of
+	(Just (System (Debian suite) _)) ->
+		ensureProperty o $ stdSourcesListFor suite
+	_ -> unsupportedOS
+
+stdSourcesListFor :: DebianSuite -> Property Debian
 stdSourcesListFor suite = stdSourcesList' suite []
 
 -- | Adds additional sources.list generators.
 --
 -- Note that if a Property needs to enable an apt source, it's better
 -- to do so via a separate file in </etc/apt/sources.list.d/>
-stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property NoInfo
-stdSourcesList' suite more = setSourcesList
+stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian
+stdSourcesList' suite more = tightenTargets $ setSourcesList
 	(concatMap (\gen -> gen suite) generators)
 	`describe` ("standard sources.list for " ++ show suite)
   where
 	generators = [debCdn, kernelOrg, securityUpdates] ++ more
 
-setSourcesList :: [Line] -> Property NoInfo
+setSourcesList :: [Line] -> Property DebianLike
 setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
 
-setSourcesListD :: [Line] -> FilePath -> Property NoInfo
+setSourcesListD :: [Line] -> FilePath -> Property DebianLike
 setSourcesListD ls basename = f `File.hasContent` ls `onChange` update
   where
 	f = "/etc/apt/sources.list.d/" ++ basename ++ ".list"
 
-runApt :: [String] -> UncheckedProperty NoInfo
-runApt ps = cmdPropertyEnv "apt-get" ps noninteractiveEnv
+runApt :: [String] -> UncheckedProperty DebianLike
+runApt ps = tightenTargets $ cmdPropertyEnv "apt-get" ps noninteractiveEnv
 
 noninteractiveEnv :: [(String, String)]
 noninteractiveEnv =
@@ -118,51 +117,51 @@ noninteractiveEnv =
 		, ("APT_LISTCHANGES_FRONTEND", "none")
 		]
 
-update :: Property NoInfo
+update :: Property DebianLike
 update = runApt ["update"]
 	`assume` MadeChange
 	`describe` "apt update"
 
 -- | Have apt upgrade packages, adding new packages and removing old as
 -- necessary.
-upgrade :: Property NoInfo
+upgrade :: Property DebianLike
 upgrade = upgrade' "dist-upgrade"
 
-upgrade' :: String -> Property NoInfo
-upgrade' p = combineProperties ("apt " ++ p)
-	[ pendingConfigured
-	, runApt ["-y", p]
+upgrade' :: String -> Property DebianLike
+upgrade' p = combineProperties ("apt " ++ p) $ props
+	& pendingConfigured
+	& runApt ["-y", p]
 		`assume` MadeChange
-	]
 
 -- | Have apt upgrade packages, but never add new packages or remove
 -- old packages. Not suitable for upgrading acrocess major versions
 -- of the distribution.
-safeUpgrade :: Property NoInfo
+safeUpgrade :: Property DebianLike
 safeUpgrade = upgrade' "upgrade"
 
 -- | Have dpkg try to configure any packages that are not fully configured.
-pendingConfigured :: Property NoInfo
-pendingConfigured = cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv
-	`assume` MadeChange
-	`describe` "dpkg configured pending"
+pendingConfigured :: Property DebianLike
+pendingConfigured = tightenTargets $
+	cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv
+		`assume` MadeChange
+		`describe` "dpkg configured pending"
 
 type Package = String
 
-installed :: [Package] -> Property NoInfo
+installed :: [Package] -> Property DebianLike
 installed = installed' ["-y"]
 
-installed' :: [String] -> [Package] -> Property NoInfo
+installed' :: [String] -> [Package] -> Property DebianLike
 installed' params ps = robustly $ check (isInstallable ps) go
 	`describe` unwords ("apt installed":ps)
   where
 	go = runApt (params ++ ["install"] ++ ps)
 
-installedBackport :: [Package] -> Property NoInfo
-installedBackport ps = withOS desc $ \o -> case o of
+installedBackport :: [Package] -> Property DebianLike
+installedBackport ps = withOS desc $ \o os -> case os of
 	(Just (System (Debian suite) _)) -> case backportSuite suite of
 		Nothing -> unsupportedOS
-		Just bs -> ensureProperty $
+		Just bs -> ensureProperty o $
 			runApt (["install", "-t", bs, "-y"] ++ ps)
 				`changesFile` dpkgStatus
 	_ -> unsupportedOS
@@ -170,14 +169,14 @@ installedBackport ps = withOS desc $ \o -> case o of
 	desc = unwords ("apt installed backport":ps)
 
 -- | Minimal install of package, without recommends.
-installedMin :: [Package] -> Property NoInfo
+installedMin :: [Package] -> Property DebianLike
 installedMin = installed' ["--no-install-recommends", "-y"]
 
-removed :: [Package] -> Property NoInfo
+removed :: [Package] -> Property DebianLike
 removed ps = check (or <$> isInstalled' ps) (runApt (["-y", "remove"] ++ ps))
 	`describe` unwords ("apt removed":ps)
 
-buildDep :: [Package] -> Property NoInfo
+buildDep :: [Package] -> Property DebianLike
 buildDep ps = robustly $ go
 	`changesFile` dpkgStatus
 	`describe` unwords ("apt build-dep":ps)
@@ -187,7 +186,7 @@ buildDep ps = robustly $ go
 -- | Installs the build deps for the source package unpacked
 -- in the specifed directory, with a dummy package also
 -- installed so that autoRemove won't remove them.
-buildDepIn :: FilePath -> Property NoInfo
+buildDepIn :: FilePath -> Property DebianLike
 buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv
 	`changesFile` dpkgStatus
 	`requires` installedMin ["devscripts", "equivs"]
@@ -196,13 +195,13 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv
 
 -- | Package installation may fail becuse the archive has changed.
 -- Run an update in that case and retry.
-robustly :: (Combines (Property i) (Property NoInfo)) => Property i -> Property i
+robustly :: Property DebianLike -> Property DebianLike
 robustly p = adjustPropertySatisfy p $ \satisfy -> do
 	r <- satisfy
 	if r == FailedChange
-		-- Safe to use ignoreInfo because we're re-running
-		-- the same property.
-		then ensureProperty $ ignoreInfo $ p `requires` update
+		-- Safe to use getSatisfy because we're re-running
+		-- the same property as before.
+		then getSatisfy $ p `requires` update
 		else return r
 
 isInstallable :: [Package] -> IO Bool
@@ -228,13 +227,13 @@ isInstalled' ps = (mapMaybe parse . lines) <$> policy
 		environ <- addEntry "LANG" "C" <$> getEnvironment
 		readProcessEnv "apt-cache" ("policy":ps) (Just environ)
 
-autoRemove :: Property NoInfo
+autoRemove :: Property DebianLike
 autoRemove = runApt ["-y", "autoremove"]
 	`changesFile` dpkgStatus
 	`describe` "apt autoremove"
 
 -- | Enables unattended upgrades. Revert to disable.
-unattendedUpgrades :: RevertableProperty NoInfo
+unattendedUpgrades :: RevertableProperty DebianLike DebianLike
 unattendedUpgrades = enable <!> disable
   where
 	enable = setup True
@@ -253,11 +252,12 @@ unattendedUpgrades = enable <!> disable
 			| enabled = "true"
 			| otherwise = "false"
 
-	configure = withOS "unattended upgrades configured" $ \o ->
-		case o of
+	configure :: Property DebianLike
+	configure = withOS "unattended upgrades configured" $ \o os ->
+		case os of
 			-- the package defaults to only upgrading stable
 			(Just (System (Debian suite) _))
-				| not (isStable suite) -> ensureProperty $
+				| not (isStable suite) -> ensureProperty o $
 					"/etc/apt/apt.conf.d/50unattended-upgrades"
 						`File.containsLine`
 					("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")
@@ -269,10 +269,13 @@ type DebconfTemplateValue = String
 
 -- | Preseeds debconf values and reconfigures the package so it takes
 -- effect.
-reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property NoInfo
-reConfigure package vals = reconfigure `requires` setselections
-	`describe` ("reconfigure " ++ package)
+reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property DebianLike
+reConfigure package vals = tightenTargets $ 
+	reconfigure 
+		`requires` setselections
+		`describe` ("reconfigure " ++ package)
   where
+	setselections :: Property DebianLike
 	setselections = property "preseed" $
 		if null vals
 			then noChange
@@ -289,7 +292,7 @@ reConfigure package vals = reconfigure `requires` setselections
 --
 -- Assumes that there is a 1:1 mapping between service names and apt
 -- package names.
-serviceInstalledRunning :: Package -> Property NoInfo
+serviceInstalledRunning :: Package -> Property DebianLike
 serviceInstalledRunning svc = Service.running svc `requires` installed [svc]
 
 data AptKey = AptKey
@@ -297,10 +300,10 @@ data AptKey = AptKey
 	, pubkey :: String
 	}
 
-trustsKey :: AptKey -> RevertableProperty NoInfo
+trustsKey :: AptKey -> RevertableProperty DebianLike DebianLike
 trustsKey k = trustsKey' k <!> untrustKey k
 
-trustsKey' :: AptKey -> Property NoInfo
+trustsKey' :: AptKey -> Property DebianLike
 trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
 	withHandle StdinHandle createProcessSuccess
 		(proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do
@@ -311,21 +314,21 @@ trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
 	desc = "apt trusts key " ++ keyname k
 	f = aptKeyFile k
 
-untrustKey :: AptKey -> Property NoInfo
-untrustKey = File.notPresent . aptKeyFile
+untrustKey :: AptKey -> Property DebianLike
+untrustKey = tightenTargets . File.notPresent . aptKeyFile
 
 aptKeyFile :: AptKey -> FilePath
 aptKeyFile k = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg"
 
 -- | Cleans apt's cache of downloaded packages to avoid using up disk
 -- space.
-cacheCleaned :: Property NoInfo
-cacheCleaned = cmdProperty "apt-get" ["clean"]
+cacheCleaned :: Property DebianLike
+cacheCleaned = tightenTargets $ cmdProperty "apt-get" ["clean"]
 	`assume` NoChange
 	`describe` "apt cache cleaned"
 
 -- | Add a foreign architecture to dpkg and apt.
-hasForeignArch :: String -> Property NoInfo
+hasForeignArch :: String -> Property DebianLike
 hasForeignArch arch = check notAdded (add `before` update)
 	`describe` ("dpkg has foreign architecture " ++ arch)
   where
diff --git a/src/Propellor/Property/Service.hs b/src/Propellor/Property/Service.hs
index 0e96ed4c..46f9e8ef 100644
--- a/src/Propellor/Property/Service.hs
+++ b/src/Propellor/Property/Service.hs
@@ -11,17 +11,17 @@ type ServiceName = String
 -- Note that due to the general poor state of init scripts, the best
 -- we can do is try to start the service, and if it fails, assume
 -- this means it's already running.
-running :: ServiceName -> Property NoInfo
+running :: ServiceName -> Property DebianLike
 running = signaled "start" "running"
 
-restarted :: ServiceName -> Property NoInfo
+restarted :: ServiceName -> Property DebianLike
 restarted = signaled "restart" "restarted"
 
-reloaded :: ServiceName -> Property NoInfo
+reloaded :: ServiceName -> Property DebianLike
 reloaded = signaled "reload" "reloaded"
 
-signaled :: String -> Desc -> ServiceName -> Property NoInfo
-signaled cmd desc svc = p `describe` (desc ++ " " ++ svc)
+signaled :: String -> Desc -> ServiceName -> Property DebianLike
+signaled cmd desc svc = tightenTargets $ p `describe` (desc ++ " " ++ svc)
   where
 	p = scriptProperty ["service " ++ shellEscape svc ++ " " ++ cmd ++ " >/dev/null 2>&1 || true"]
 		`assume` NoChange
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index db05e100..7098c83f 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -42,6 +42,7 @@ module Propellor.Types
 	, module Propellor.Types.Dns
 	, module Propellor.Types.Result
 	, module Propellor.Types.ZFS
+	, TightenTargets(..)
 	) where
 
 import Data.Monoid
@@ -285,3 +286,25 @@ instance (CheckCombinable x y ~ 'CanCombine, SingI (Combine x y)) => Combines (R
 	combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y
 instance (CheckCombinable x y ~ 'CanCombine, 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
+
+class TightenTargets p where
+	-- | Tightens the MetaType list of a Property (or similar),
+	-- to contain fewer targets.
+	--
+	-- For example, to make a property that uses apt-get, which is only
+	-- available on DebianLike systems:
+	--
+	-- > upgraded :: Property DebianLike
+	-- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"]
+	tightenTargets
+		:: 
+			-- Note that this uses PolyKinds
+			( (Targets untightened `NotSuperset` Targets tightened) ~ 'CanCombine
+			, (NonTargets tightened `NotSuperset` NonTargets untightened) ~ 'CanCombine
+			, SingI tightened
+			)
+		=> p (MetaTypes untightened)
+		-> p (MetaTypes tightened)
+
+instance TightenTargets Property where
+	tightenTargets (Property _ d a i c) = Property sing d a i c
diff --git a/src/Propellor/Types/ResultCheck.hs b/src/Propellor/Types/ResultCheck.hs
index 4c6524ee..f03c174f 100644
--- a/src/Propellor/Types/ResultCheck.hs
+++ b/src/Propellor/Types/ResultCheck.hs
@@ -22,6 +22,9 @@ import Data.Monoid
 -- and `FailedChange` is still an error.
 data UncheckedProperty i = UncheckedProperty (Property i)
 
+instance TightenTargets UncheckedProperty where
+	tightenTargets (UncheckedProperty p) = UncheckedProperty (tightenTargets p)
+
 -- | Use to indicate that a Property is unchecked.
 unchecked :: Property i -> UncheckedProperty i
 unchecked = UncheckedProperty
-- 
cgit v1.3-2-g0d8e


From 860d1dd77e1789a91ed61bdceab667d94c9bd345 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 25 Mar 2016 17:36:52 -0400
Subject: cleanup warnings

---
 src/Propellor/EnsureProperty.hs  | 24 ++++++++++++------------
 src/Propellor/Property.hs        | 14 +++++++-------
 src/Propellor/Property/Apt.hs    | 14 +++++++-------
 src/Propellor/Types/MetaTypes.hs |  4 ++--
 4 files changed, 28 insertions(+), 28 deletions(-)

(limited to 'src/Propellor/EnsureProperty.hs')

diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index c4b5fde1..c19dc025 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -7,7 +7,7 @@
 module Propellor.EnsureProperty
 	( ensureProperty
 	, property'
-	, OuterMetaTypes(..)
+	, OuterMetaTypesWitness(..)
 	) where
 
 import Propellor.Types
@@ -17,14 +17,14 @@ import Propellor.Exception
 -- | For when code running in the Propellor monad needs to ensure a
 -- Property.
 --
--- Use `property'` to get the `OuterMetaTypes`. For example:
+-- Use `property'` to get the `OuterMetaTypesWithness`. For example:
 --
 -- > foo = Property Debian
--- > foo = property' $ \o -> do
--- > 	ensureProperty o (aptInstall "foo")
+-- > foo = property' $ \w -> do
+-- > 	ensureProperty w (aptInstall "foo")
 --
 -- The type checker will prevent using ensureProperty with a property
--- that does not support the target OSes needed by the OuterMetaTypes.
+-- that does not support the target OSes needed by the OuterMetaTypesWitness.
 -- In the example above, aptInstall must support Debian, since foo
 -- is supposed to support Debian.
 --
@@ -36,7 +36,7 @@ ensureProperty
 		( Cannot_ensureProperty_WithInfo inner ~ 'True
 		, (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine
 		)
-	=> OuterMetaTypes outer
+	=> OuterMetaTypesWitness outer
 	-> Property (MetaTypes inner)
 	-> Propellor Result
 ensureProperty _ = catchPropellor . getSatisfy
@@ -48,19 +48,19 @@ type instance Cannot_ensureProperty_WithInfo (t ': ts) =
 	Not (t `EqT` 'WithInfo) && Cannot_ensureProperty_WithInfo ts
 
 -- | Constructs a property, like `property`, but provides its
--- `OuterMetaTypes`.
+-- `OuterMetaTypesWitness`.
 property'
 	:: SingI metatypes
 	=> Desc
-	-> (OuterMetaTypes metatypes -> Propellor Result)
+	-> (OuterMetaTypesWitness metatypes -> Propellor Result)
 	-> Property (MetaTypes metatypes)
 property' d a =
-	let p = Property sing d (a (outerMetaTypes p)) mempty mempty
+	let p = Property sing d (a (outerMetaTypesWitness p)) mempty mempty
 	in p
 
 -- | Used to provide the metatypes of a Property to calls to 
 -- 'ensureProperty` within it.
-newtype OuterMetaTypes metatypes = OuterMetaTypes (MetaTypes metatypes)
+newtype OuterMetaTypesWitness metatypes = OuterMetaTypesWitness (MetaTypes metatypes)
 
-outerMetaTypes :: Property (MetaTypes l) -> OuterMetaTypes l
-outerMetaTypes (Property metatypes _ _ _ _) = OuterMetaTypes metatypes
+outerMetaTypesWitness :: Property (MetaTypes l) -> OuterMetaTypesWitness l
+outerMetaTypesWitness (Property metatypes _ _ _ _) = OuterMetaTypesWitness metatypes
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 2ddec439..9fa29888 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -22,7 +22,7 @@ module Propellor.Property (
 	, Propellor
 	, property
 	, property'
-	, OuterMetaTypes
+	, OuterMetaTypesWitness
 	, ensureProperty
 	, withOS
 	, unsupportedOS
@@ -270,9 +270,9 @@ pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io
 -- of the host's operating system.
 --
 -- > myproperty :: Property Debian
--- > myproperty = withOS "foo installed" $ \o os -> case os of
--- > 	(Just (System (Debian (Stable release)) arch)) -> ensureProperty o ...
--- > 	(Just (System (Debian suite) arch)) -> ensureProperty o ...
+-- > myproperty = withOS "foo installed" $ \w o -> case o of
+-- > 	(Just (System (Debian (Stable release)) arch)) -> ensureProperty w ...
+-- > 	(Just (System (Debian suite) arch)) -> ensureProperty w ...
 -- >	_ -> unsupportedOS
 --
 -- Note that the operating system specifics may not be declared for all hosts,
@@ -280,15 +280,15 @@ pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io
 withOS
 	:: (SingI metatypes)
 	=> Desc
-	-> (OuterMetaTypes '[] -> Maybe System -> Propellor Result)
+	-> (OuterMetaTypesWitness '[] -> Maybe System -> Propellor Result)
 	-> Property (MetaTypes metatypes)
 withOS desc a = property desc $ a dummyoutermetatypes =<< getOS
   where
 	-- Using this dummy value allows ensureProperty to be used
 	-- even though the inner property probably doesn't target everything
 	-- that the outer withOS property targets.
-	dummyoutermetatypes :: OuterMetaTypes ('[])
-	dummyoutermetatypes = OuterMetaTypes sing
+	dummyoutermetatypes :: OuterMetaTypesWitness ('[])
+	dummyoutermetatypes = OuterMetaTypesWitness sing
 
 -- | Throws an error, for use in `withOS` when a property is lacking
 -- support for an OS.
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 9c3b05c4..c8ad92e4 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -81,9 +81,9 @@ securityUpdates suite
 -- Since the CDN is sometimes unreliable, also adds backup lines using
 -- kernel.org.
 stdSourcesList :: Property Debian
-stdSourcesList = withOS "standard sources.list" $ \o os -> case os of
+stdSourcesList = withOS "standard sources.list" $ \w o -> case o of
 	(Just (System (Debian suite) _)) ->
-		ensureProperty o $ stdSourcesListFor suite
+		ensureProperty w $ stdSourcesListFor suite
 	_ -> unsupportedOS
 
 stdSourcesListFor :: DebianSuite -> Property Debian
@@ -158,10 +158,10 @@ installed' params ps = robustly $ check (isInstallable ps) go
 	go = runApt (params ++ ["install"] ++ ps)
 
 installedBackport :: [Package] -> Property DebianLike
-installedBackport ps = withOS desc $ \o os -> case os of
+installedBackport ps = withOS desc $ \w o -> case o of
 	(Just (System (Debian suite) _)) -> case backportSuite suite of
 		Nothing -> unsupportedOS
-		Just bs -> ensureProperty o $
+		Just bs -> ensureProperty w $
 			runApt (["install", "-t", bs, "-y"] ++ ps)
 				`changesFile` dpkgStatus
 	_ -> unsupportedOS
@@ -247,11 +247,11 @@ unattendedUpgrades = enable <!> disable
 			| otherwise = "false"
 
 	configure :: Property DebianLike
-	configure = withOS "unattended upgrades configured" $ \o os ->
-		case os of
+	configure = withOS "unattended upgrades configured" $ \w o ->
+		case o of
 			-- the package defaults to only upgrading stable
 			(Just (System (Debian suite) _))
-				| not (isStable suite) -> ensureProperty o $
+				| not (isStable suite) -> ensureProperty w $
 					"/etc/apt/apt.conf.d/50unattended-upgrades"
 						`File.containsLine`
 					("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")
diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs
index 6545c924..6033ec27 100644
--- a/src/Propellor/Types/MetaTypes.hs
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -116,8 +116,8 @@ type family CheckCombinable (list1 :: [a]) (list2 :: [a]) :: CheckCombine
 -- one target, so can only happen if there's already been a type error.
 -- This special case lets the type checker show only the original type
 -- error, and not an extra error due to a later CheckCombinable constraint.
-type instance CheckCombinable '[] list2 = CanCombine
-type instance CheckCombinable list1 '[] = CanCombine
+type instance CheckCombinable '[] list2 = 'CanCombine
+type instance CheckCombinable list1 '[] = 'CanCombine
 type instance CheckCombinable (l1 ': list1) (l2 ': list2) =
 	CheckCombinable' (Combine (l1 ': list1) (l2 ': list2))
 type family CheckCombinable' (combinedlist :: [a]) :: CheckCombine
-- 
cgit v1.3-2-g0d8e


From 3deb3a622eec5e12dfaee320faaeb12c70f9c8d0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 26 Mar 2016 21:52:11 -0400
Subject: old ghc fix

---
 src/Propellor/EnsureProperty.hs | 3 +++
 1 file changed, 3 insertions(+)

(limited to 'src/Propellor/EnsureProperty.hs')

diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index c19dc025..f9094c5b 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -14,6 +14,9 @@ import Propellor.Types
 import Propellor.Types.MetaTypes
 import Propellor.Exception
 
+import Data.Monoid
+import Prelude
+
 -- | For when code running in the Propellor monad needs to ensure a
 -- Property.
 --
-- 
cgit v1.3-2-g0d8e


From 9d6dc29555b8499d8ae6c73c891b0b5dc19f83e5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sun, 27 Mar 2016 19:59:20 -0400
Subject: improve haddocks and move code around to make them more clear

---
 propellor.cabal                       |   1 +
 src/Propellor/Container.hs            |   4 +-
 src/Propellor/Engine.hs               |   4 +-
 src/Propellor/EnsureProperty.hs       |   1 +
 src/Propellor/Info.hs                 |  28 +++++-
 src/Propellor/PrivData.hs             |   2 +-
 src/Propellor/PropAccum.hs            |   5 +-
 src/Propellor/Property.hs             |   1 +
 src/Propellor/Property/Chroot.hs      |   3 +-
 src/Propellor/Property/Concurrent.hs  |   2 +
 src/Propellor/Property/Conductor.hs   |  13 +--
 src/Propellor/Property/Dns.hs         |   2 +-
 src/Propellor/Property/Docker.hs      |   3 +-
 src/Propellor/Property/FreeBSD/Pkg.hs |   4 +-
 src/Propellor/Property/List.hs        |   2 +
 src/Propellor/Property/Partition.hs   |   1 +
 src/Propellor/Property/Scheduled.hs   |   1 +
 src/Propellor/Types.hs                | 168 ++++++----------------------------
 src/Propellor/Types/Core.hs           | 106 +++++++++++++++++++++
 src/Propellor/Types/Info.hs           |   5 +
 20 files changed, 196 insertions(+), 160 deletions(-)
 create mode 100644 src/Propellor/Types/Core.hs

(limited to 'src/Propellor/EnsureProperty.hs')

diff --git a/propellor.cabal b/propellor.cabal
index f11d2afe..e946f697 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -150,6 +150,7 @@ Library
     Propellor.EnsureProperty
     Propellor.Exception
     Propellor.Types
+    Propellor.Types.Core
     Propellor.Types.Chroot
     Propellor.Types.CmdLine
     Propellor.Types.Container
diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
index 4cd46ae5..c4d6f864 100644
--- a/src/Propellor/Container.hs
+++ b/src/Propellor/Container.hs
@@ -3,8 +3,10 @@
 module Propellor.Container where
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.MetaTypes
 import Propellor.Types.Info
+import Propellor.Info
 import Propellor.PrivData
 import Propellor.PropAccum
 
@@ -54,7 +56,7 @@ propagateContainer containername c prop = prop
 	convert p = 
 		let n = property (getDesc p) (getSatisfy p) :: Property UnixLike
 		    n' = n
-		    	`addInfoProperty` mapInfo (forceHostContext containername)
+		    	`setInfoProperty` mapInfo (forceHostContext containername)
 				(propagatableInfo (getInfo p))
 		   	`addChildren` map convert (getChildren p)
 		in toChildProperty n'
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 4c37e704..f0035c40 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -4,7 +4,6 @@
 module Propellor.Engine (
 	mainProperties,
 	runPropellor,
-	ensureProperty,
 	ensureChildProperties,
 	fromHost,
 	fromHost',
@@ -23,10 +22,11 @@ import Control.Applicative
 import Prelude
 
 import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Message
 import Propellor.Exception
 import Propellor.Info
-import Propellor.Property
 import Utility.Exception
 
 -- | Gets the Properties of a Host, and ensures them all,
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index f9094c5b..ce01d436 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -11,6 +11,7 @@ module Propellor.EnsureProperty
 	) where
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.MetaTypes
 import Propellor.Exception
 
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index ff0b3b5e..b87369c3 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -1,9 +1,11 @@
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PackageImports, TypeFamilies, DataKinds, PolyKinds #-}
 
 module Propellor.Info (
 	osDebian,
 	osBuntish,
 	osFreeBSD,
+	setInfoProperty,
+	addInfoProperty,
 	pureInfoProperty,
 	pureInfoProperty',
 	askInfo,
@@ -22,6 +24,7 @@ module Propellor.Info (
 
 import Propellor.Types
 import Propellor.Types.Info
+import Propellor.Types.MetaTypes
 
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
@@ -31,11 +34,32 @@ import Data.Monoid
 import Control.Applicative
 import Prelude
 
+-- | Adds info to a Property.
+--
+-- The new Property will include HasInfo in its metatypes.
+setInfoProperty
+	:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
+	=> Property metatypes
+	-> Info
+	-> Property (MetaTypes metatypes')
+setInfoProperty (Property _ d a oldi c) newi =
+	Property sing d a (oldi <> newi) c
+
+-- | Adds more info to a Property that already HasInfo.
+addInfoProperty
+	:: (IncludesInfo metatypes ~ 'True)
+	=> Property metatypes
+	-> Info
+	-> Property metatypes
+addInfoProperty (Property t d a oldi c) newi =
+	Property t d a (oldi <> newi) c
+
+-- | Makes a property that does nothing but set some `Info`.
 pureInfoProperty :: (IsInfo v) => Desc -> v -> Property (HasInfo + UnixLike)
 pureInfoProperty desc v = pureInfoProperty' desc (toInfo v)
 
 pureInfoProperty' :: Desc -> Info -> Property (HasInfo + UnixLike)
-pureInfoProperty' desc i = addInfoProperty p i
+pureInfoProperty' desc i = setInfoProperty p i
   where
 	p :: Property UnixLike
 	p = property ("has " ++ desc) (return NoChange)
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 0bc0c100..d3bb3a6d 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -127,7 +127,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 			"Fix this by running:" :
 			showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist)
 		return FailedChange
-	addinfo p = p `addInfoProperty'` (toInfo privset)
+	addinfo p = p `addInfoProperty` (toInfo privset)
 	privset = PrivInfo $ S.fromList $
 		map (\s -> (privDataField s, describePrivDataSource s, hc)) srclist
 	fieldnames = map show fieldlist
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 856f2e8e..d9fa8ec7 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -16,6 +16,7 @@ module Propellor.PropAccum
 
 import Propellor.Types
 import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Property
 
 import Data.Monoid
@@ -30,10 +31,6 @@ import Prelude
 host :: HostName -> Props metatypes -> Host
 host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps))
 
--- | Props is a combination of a list of properties, with their combined 
--- metatypes.
-data Props metatypes = Props [ChildProperty]
-
 -- | Start accumulating a list of properties.
 --
 -- Properties can be added to it using `(&)` etc.
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 70583edc..29a8ec0f 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -53,6 +53,7 @@ import Control.Applicative
 import Prelude
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.ResultCheck
 import Propellor.Types.MetaTypes
 import Propellor.Info
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 811b5baa..09047ce5 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -23,6 +23,7 @@ import Propellor.Container
 import Propellor.Types.CmdLine
 import Propellor.Types.Chroot
 import Propellor.Types.Info
+import Propellor.Types.Core
 import Propellor.Property.Chroot.Util
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Systemd.Core as Systemd
@@ -151,7 +152,7 @@ provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
 
 propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
 propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
-	p `addInfoProperty` chrootInfo c
+	p `setInfoProperty` chrootInfo c
 
 chrootInfo :: Chroot -> Info
 chrootInfo (Chroot loc _ h) = mempty `addInfo`
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index ace85a3c..e69dc17d 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -37,6 +37,8 @@ module Propellor.Property.Concurrent (
 ) where
 
 import Propellor.Base
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
 
 import Control.Concurrent
 import qualified Control.Concurrent.Async as A
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index ab747acc..8aa18d20 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -83,16 +83,17 @@ import qualified Propellor.Property.Ssh as Ssh
 import qualified Data.Set as S
 
 -- | Class of things that can be conducted.
+--
+-- There are instances for single hosts, and for lists of hosts.
+-- With a list, each listed host will be conducted in turn. Failure to conduct
+-- one host does not prevent conducting subsequent hosts in the list, but
+-- will be propagated as an overall failure of the property.
 class Conductable c where
 	conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
 
 instance Conductable Host where
-	-- | Conduct the specified host.
 	conducts h = conductorFor h <!> notConductorFor h
 
--- | Each host in the list will be conducted in turn. Failure to conduct
--- one host does not prevent conducting subsequent hosts in the list, but
--- will be propagated as an overall failure of the property.
 instance Conductable [Host] where
 	conducts hs = 
 		propertyList desc (toProps $ map (setupRevertableProperty . conducts) hs)
@@ -246,7 +247,7 @@ orchestrate' h (Conductor c l)
 -- to have any effect.
 conductorFor :: Host -> Property (HasInfo + UnixLike)
 conductorFor h = go
-	`addInfoProperty` (toInfo (ConductorFor [h]))
+	`setInfoProperty` (toInfo (ConductorFor [h]))
 	`requires` setupRevertableProperty (conductorKnownHost h)
 	`requires` Ssh.installed
   where
@@ -270,7 +271,7 @@ conductorFor h = go
 -- Reverts conductorFor.
 notConductorFor :: Host -> Property (HasInfo + UnixLike)
 notConductorFor h = (doNothing :: Property UnixLike)
-	`addInfoProperty` (toInfo (NotConductorFor [h]))
+	`setInfoProperty` (toInfo (NotConductorFor [h]))
 	`describe` desc
 	`requires` undoRevertableProperty (conductorKnownHost h)
   where
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 2b5596bd..2e2710a6 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -81,7 +81,7 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs =
 
 	(partialzone, zonewarnings) = genZone indomain hostmap domain soa
 	baseprop = primaryprop
-		`addInfoProperty` (toInfo (addNamedConf conf))
+		`setInfoProperty` (toInfo (addNamedConf conf))
 	primaryprop :: Property DebianLike
 	primaryprop = property ("dns primary for " ++ domain) $ do
 		sshfps <- concat <$> mapM (genSSHFP domain) (M.elems hostmap)
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index ddefef15..2ef97438 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -48,6 +48,7 @@ module Propellor.Property.Docker (
 import Propellor.Base hiding (init)
 import Propellor.Types.Docker
 import Propellor.Types.Container
+import Propellor.Types.Core
 import Propellor.Types.CmdLine
 import Propellor.Types.Info
 import Propellor.Container
@@ -183,7 +184,7 @@ imagePulled ctr = pulled `describe` msg
 
 propagateContainerInfo :: Container -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
 propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr $
-	p `addInfoProperty'` dockerinfo
+	p `addInfoProperty` dockerinfo
   where
 	dockerinfo = dockerInfo $
 		mempty { _dockerContainers = M.singleton cn h }
diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
index 6c775b94..704c1db9 100644
--- a/src/Propellor/Property/FreeBSD/Pkg.hs
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -51,7 +51,7 @@ update =
 		go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
 		(property "pkg update has run" go :: Property FreeBSD)
-			`addInfoProperty` (toInfo (PkgUpdate ""))
+			`setInfoProperty` (toInfo (PkgUpdate ""))
 
 newtype PkgUpgrade = PkgUpgrade String
 	deriving (Typeable, Monoid, Show)
@@ -68,7 +68,7 @@ upgrade =
 		go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
 		(property "pkg upgrade has run" go :: Property FreeBSD)
-			`addInfoProperty` (toInfo (PkgUpdate ""))
+			`setInfoProperty` (toInfo (PkgUpdate ""))
 			`requires` update
 
 type Package = String
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index a8b8347a..0eec04c7 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -13,6 +13,8 @@ module Propellor.Property.List (
 ) where
 
 import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
 import Propellor.PropAccum
 import Propellor.Engine
 import Propellor.Exception
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 291d4168..2bf5b927 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -3,6 +3,7 @@
 module Propellor.Property.Partition where
 
 import Propellor.Base
+import Propellor.Types.Core
 import qualified Propellor.Property.Apt as Apt
 import Utility.Applicative
 
diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs
index 95e4e362..729a3749 100644
--- a/src/Propellor/Property/Scheduled.hs
+++ b/src/Propellor/Property/Scheduled.hs
@@ -10,6 +10,7 @@ module Propellor.Property.Scheduled
 	) where
 
 import Propellor.Base
+import Propellor.Types.Core
 import Utility.Scheduled
 
 import Data.Time.Clock
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index d5959cbb..6d6b14ea 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -8,15 +7,18 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
-module Propellor.Types
-	( Host(..)
+module Propellor.Types (
+	-- * Core data types
+	  Host(..)
 	, Property(..)
 	, property
-	, Info
 	, Desc
-	, MetaType(..)
-	, MetaTypes
-	, TargetOS(..)
+	, RevertableProperty(..)
+	, (<!>)
+	, Propellor(..)
+	, LiftPropellor(..)
+	, Info
+	-- * Types of properties
 	, UnixLike
 	, Linux
 	, DebianLike
@@ -25,34 +27,22 @@ module Propellor.Types
 	, FreeBSD
 	, HasInfo
 	, type (+)
-	, addInfoProperty
-	, addInfoProperty'
-	, adjustPropertySatisfy
-	, RevertableProperty(..)
-	, (<!>)
-	, ChildProperty
-	, IsProp(..)
+	, TightenTargets(..)
+	-- * Combining and modifying properties
 	, Combines(..)
 	, CombinedType
 	, ResultCombiner
-	, Propellor(..)
-	, LiftPropellor(..)
-	, EndAction(..)
+	, adjustPropertySatisfy
+	-- * Other included types
 	, module Propellor.Types.OS
 	, module Propellor.Types.Dns
 	, module Propellor.Types.Result
 	, module Propellor.Types.ZFS
-	, TightenTargets(..)
-	, SingI
 	) where
 
 import Data.Monoid
-import "mtl" Control.Monad.RWS.Strict
-import Control.Monad.Catch
-import Data.Typeable
-import Control.Applicative
-import Prelude
 
+import Propellor.Types.Core
 import Propellor.Types.Info
 import Propellor.Types.OS
 import Propellor.Types.Dns
@@ -60,89 +50,38 @@ import Propellor.Types.Result
 import Propellor.Types.MetaTypes
 import Propellor.Types.ZFS
 
--- | Everything Propellor knows about a system: Its hostname,
--- properties and their collected info.
-data Host = Host
-	{ hostName :: HostName
-	, hostProperties :: [ChildProperty]
-	, hostInfo :: Info
-	}
-	deriving (Show, Typeable)
-
--- | Propellor's monad provides read-only access to info about the host
--- it's running on, and a writer to accumulate EndActions.
-newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
-	deriving
-		( Monad
-		, Functor
-		, Applicative
-		, MonadReader Host
-		, MonadWriter [EndAction]
-		, MonadIO
-		, MonadCatch
-		, MonadThrow
-		, MonadMask
-		)
-
-class LiftPropellor m where
-	liftPropellor :: m a -> Propellor a
-
-instance LiftPropellor Propellor where
-	liftPropellor = id
-
-instance LiftPropellor IO where
-	liftPropellor = liftIO
-
-instance Monoid (Propellor Result) where
-	mempty = return NoChange
-	-- | The second action is only run if the first action does not fail.
-	mappend x y = do
-		rx <- x
-		case rx of
-			FailedChange -> return FailedChange
-			_ -> do
-				ry <- y
-				return (rx <> ry)
-
--- | An action that Propellor runs at the end, after trying to satisfy all
--- properties. It's passed the combined Result of the entire Propellor run.
-data EndAction = EndAction Desc (Result -> Propellor Result)
-
-type Desc = String
-
 -- | The core data type of Propellor, this represents a property
--- that the system should have, with a descrition, an action to ensure
--- it has the property, and perhaps some Info that can be added to Hosts
+-- that the system should have, with a descrition, and an action to ensure
+-- it has the property.
 -- that have the property.
 --
--- A property has a list of `[MetaType]`, which is part of its type.
+-- There are different types of properties that target different OS's,
+-- and so have different metatypes. 
+-- For example: "Property DebianLike" and "Property FreeBSD".
 --
--- There are many instances and type families, which are mostly used
+-- Also, some properties have associated `Info`, which is indicated in
+-- their type: "Property (HasInfo + DebianLike)"
+--
+-- There are many associated type families, which are mostly used
 -- internally, so you needn't worry about them.
 data Property metatypes = Property metatypes Desc (Propellor Result) Info [ChildProperty]
 
 instance Show (Property metatypes) where
 	show p = "property " ++ show (getDesc p)
 
--- | Since there are many different types of Properties, they cannot be put
--- into a list. The simplified ChildProperty can be put into a list.
-data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
-
-instance Show ChildProperty where
-	show = getDesc
-
 -- | Constructs a Property, from a description and an action to run to
 -- ensure the Property is met.
 --
--- You can specify any metatypes that make sense to indicate what OS
--- the property targets, etc.
+-- Due to the polymorphic return type of this function, most uses will need
+-- to specify a type signature. This lets you specify what OS the property
+-- targets, etc.
 --
 -- For example:
 --
 -- > foo :: Property Debian
--- > foo = mkProperty "foo" (...)
---
--- Note that using this needs LANGUAGE PolyKinds.
+-- > foo = property "foo" $ do
+-- >	...
+-- > 	return MadeChange
 property
 	:: SingI metatypes
 	=> Desc
@@ -150,26 +89,6 @@ property
 	-> 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
-	:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
-	=> Property metatypes
-	-> Info
-	-> Property (MetaTypes metatypes')
-addInfoProperty (Property _ d a oldi c) newi =
-	Property sing d a (oldi <> newi) c
-
--- | Adds more info to a Property that already HasInfo.
-addInfoProperty'
-	:: (IncludesInfo metatypes ~ 'True)
-	=> Property metatypes
-	-> Info
-	-> Property metatypes
-addInfoProperty' (Property t d a oldi c) newi =
-	Property t d a (oldi <> newi) c
-
 -- | Changes the action that is performed to satisfy a property.
 adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
 adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c
@@ -191,24 +110,6 @@ instance Show (RevertableProperty setupmetatypes undometatypes) where
 	-> RevertableProperty setupmetatypes undometatypes
 setup <!> undo = RevertableProperty setup undo
 
-class IsProp p where
-	setDesc :: p -> Desc -> p
-	getDesc :: p -> Desc
-	getChildren :: p -> [ChildProperty]
-	addChildren :: p -> [ChildProperty] -> p
-	-- | Gets the info of the property, combined with all info
-	-- of all children properties.
-	getInfoRecursive :: p -> Info
-	-- | Info, not including info from children.
-	getInfo :: p -> Info
-	-- | Gets a ChildProperty representing the Property.
-	-- You should not normally need to use this.
-	toChildProperty :: p -> ChildProperty
-	-- | Gets the action that can be run to satisfy a Property.
-	-- You should never run this action directly. Use
-	-- 'Propellor.EnsureProperty.ensureProperty` instead.
-	getSatisfy :: p -> Propellor Result
-
 instance IsProp (Property metatypes) where
 	setDesc (Property t _ a i c) d = Property t d a i c
 	getDesc (Property _ d _ _ _) = d
@@ -220,17 +121,6 @@ instance IsProp (Property metatypes) where
 	toChildProperty (Property _ d a i c) = ChildProperty d a i c
 	getSatisfy (Property _ _ a _ _) = a
 
-instance IsProp ChildProperty where
-	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
-	getDesc (ChildProperty d _ _ _) = d
-	getChildren (ChildProperty _ _ _ c) = c
-	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
-	getInfoRecursive (ChildProperty _ _ i c) =
-		i <> mconcat (map getInfoRecursive c)
-	getInfo (ChildProperty _ _ i _) = i
-	toChildProperty = id
-	getSatisfy (ChildProperty _ a _ _) = a
-
 instance IsProp (RevertableProperty setupmetatypes undometatypes) where
 	-- | Sets the description of both sides.
 	setDesc (RevertableProperty p1 p2) d =
diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs
new file mode 100644
index 00000000..fa939d2b
--- /dev/null
+++ b/src/Propellor/Types/Core.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Propellor.Types.Core where
+
+import Propellor.Types.Info
+import Propellor.Types.OS
+import Propellor.Types.Result
+
+import Data.Monoid
+import "mtl" Control.Monad.RWS.Strict
+import Control.Monad.Catch
+import Control.Applicative
+import Prelude
+
+-- | Everything Propellor knows about a system: Its hostname,
+-- properties and their collected info.
+data Host = Host
+	{ hostName :: HostName
+	, hostProperties :: [ChildProperty]
+	, hostInfo :: Info
+	}
+	deriving (Show, Typeable)
+
+-- | Propellor's monad provides read-only access to info about the host
+-- it's running on, and a writer to accumulate EndActions.
+newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
+	deriving
+		( Monad
+		, Functor
+		, Applicative
+		, MonadReader Host
+		, MonadWriter [EndAction]
+		, MonadIO
+		, MonadCatch
+		, MonadThrow
+		, MonadMask
+		)
+
+class LiftPropellor m where
+	liftPropellor :: m a -> Propellor a
+
+instance LiftPropellor Propellor where
+	liftPropellor = id
+
+instance LiftPropellor IO where
+	liftPropellor = liftIO
+
+instance Monoid (Propellor Result) where
+	mempty = return NoChange
+	-- | The second action is only run if the first action does not fail.
+	mappend x y = do
+		rx <- x
+		case rx of
+			FailedChange -> return FailedChange
+			_ -> do
+				ry <- y
+				return (rx <> ry)
+
+-- | An action that Propellor runs at the end, after trying to satisfy all
+-- properties. It's passed the combined Result of the entire Propellor run.
+data EndAction = EndAction Desc (Result -> Propellor Result)
+
+type Desc = String
+
+-- | Props is a combination of a list of properties, with their combined 
+-- metatypes.
+data Props metatypes = Props [ChildProperty]
+
+-- | Since there are many different types of Properties, they cannot be put
+-- into a list. The simplified ChildProperty can be put into a list.
+data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
+  
+instance Show ChildProperty where
+	show = getDesc
+
+class IsProp p where
+	setDesc :: p -> Desc -> p
+	getDesc :: p -> Desc
+	getChildren :: p -> [ChildProperty]
+	addChildren :: p -> [ChildProperty] -> p
+	-- | Gets the info of the property, combined with all info
+	-- of all children properties.
+	getInfoRecursive :: p -> Info
+	-- | Info, not including info from children.
+	getInfo :: p -> Info
+	-- | Gets a ChildProperty representing the Property.
+	-- You should not normally need to use this.
+	toChildProperty :: p -> ChildProperty
+	-- | Gets the action that can be run to satisfy a Property.
+	-- You should never run this action directly. Use
+	-- 'Propellor.EnsureProperty.ensureProperty` instead.
+	getSatisfy :: p -> Propellor Result
+
+instance IsProp ChildProperty where
+	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
+	getDesc (ChildProperty d _ _ _) = d
+	getChildren (ChildProperty _ _ _ c) = c
+	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
+	getInfoRecursive (ChildProperty _ _ i c) =
+		i <> mconcat (map getInfoRecursive c)
+	getInfo (ChildProperty _ _ i _) = i
+	toChildProperty = id
+	getSatisfy (ChildProperty _ a _ _) = a
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index c7f6b82f..2e188ae5 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -19,6 +19,9 @@ import Data.Monoid
 import Prelude
 
 -- | Information about a Host, which can be provided by its properties.
+--
+-- Many different types of data can be contained in the same Info value
+-- at the same time. See `toInfo` and `fromInfo`.
 newtype Info = Info [InfoEntry]
 	deriving (Monoid, Show)
 
@@ -47,6 +50,8 @@ class (Typeable v, Monoid v, Show v) => IsInfo v where
 addInfo :: IsInfo v => Info -> v -> Info
 addInfo (Info l) v = Info (InfoEntry v:l)
 
+-- | Converts any value in the `IsInfo` type class into an Info,
+-- which is otherwise empty.
 toInfo :: IsInfo v => v -> Info
 toInfo = addInfo mempty
 
-- 
cgit v1.3-2-g0d8e