summaryrefslogtreecommitdiff
path: root/src/Propellor/EnsureProperty.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/EnsureProperty.hs')
-rw-r--r--src/Propellor/EnsureProperty.hs41
1 files changed, 9 insertions, 32 deletions
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index 5ed0325f..ab624706 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -8,7 +8,7 @@ module Propellor.EnsureProperty
( ensureProperty
, property'
, OuterMetaTypesWitness
- , EnsurePropertyAllowed
+ , Cannot_ensureProperty_WithInfo
) where
import Propellor.Types
@@ -16,8 +16,6 @@ import Propellor.Types.Core
import Propellor.Types.MetaTypes
import Propellor.Exception
-import GHC.TypeLits
-import Data.Type.Bool
import Data.Monoid
import Prelude
@@ -43,40 +41,19 @@ ensureProperty
-- -Wredundant-constraints is turned off because
-- this constraint appears redundant, but is actually
-- crucial.
- ( EnsurePropertyAllowed inner outer ~ 'True)
+ ( Cannot_ensureProperty_WithInfo inner ~ 'True
+ , (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine
+ )
=> OuterMetaTypesWitness outer
-> Property (MetaTypes inner)
-> Propellor Result
ensureProperty _ = maybe (return NoChange) catchPropellor . getSatisfy
-type family EnsurePropertyAllowed inner outer where
- EnsurePropertyAllowed inner outer =
- (EnsurePropertyNoInfo inner)
- &&
- (EnsurePropertyTargetOSMatches inner outer)
-
-type family EnsurePropertyNoInfo (l :: [a]) :: Bool where
- EnsurePropertyNoInfo '[] = 'True
- EnsurePropertyNoInfo (t ': ts) = If (Not (t `EqT` 'WithInfo))
- (EnsurePropertyNoInfo ts)
- (TypeError ('Text "Cannot use ensureProperty with a Property that HasInfo."))
-
-type family EnsurePropertyTargetOSMatches inner outer where
- EnsurePropertyTargetOSMatches inner outer =
- If (Targets outer `IsSubset` Targets inner)
- 'True
- (IfStuck (Targets outer)
- (TypeError
- ('Text "ensureProperty outer Property type is not able to be inferred here."
- ':$$: 'Text "Consider adding a type annotation."
- )
- )
- (TypeError
- ('Text "ensureProperty inner Property is missing support for: "
- ':$$: PrettyPrintMetaTypes (Difference (Targets outer) (Targets inner))
- )
- )
- )
+-- The name of this was chosen to make type errors a bit more understandable.
+type family Cannot_ensureProperty_WithInfo (l :: [a]) :: Bool where
+ Cannot_ensureProperty_WithInfo '[] = 'True
+ Cannot_ensureProperty_WithInfo (t ': ts) =
+ Not (t `EqT` 'WithInfo) && Cannot_ensureProperty_WithInfo ts
-- | Constructs a property, like `property`, but provides its
-- `OuterMetaTypesWitness`.