summaryrefslogtreecommitdiff
path: root/src/Propellor/EnsureProperty.hs
diff options
context:
space:
mode:
authorJoey Hess2019-07-02 00:43:40 -0400
committerJoey Hess2019-07-02 00:43:40 -0400
commit665ea0d3d9e1b0e90278fd659dee0ef8642030da (patch)
tree9969435c0c78c046c4dcc45ec9726229025701ed /src/Propellor/EnsureProperty.hs
parente20662e6a8881db55394a6366be17ca4e509bc2a (diff)
Revert "custom type error messages"
This reverts commits 14f6ae30809d8bbdb10b91cc59757e865a365df8 de21ef26861db458b0dfb0212cf501f9f8ed459b e20662e6a8881db55394a6366be17ca4e509bc2a Until this bug is resolved, these custom error types hide more basic errors. https://gitlab.haskell.org/ghc/ghc/issues/16894
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`.