From 665ea0d3d9e1b0e90278fd659dee0ef8642030da Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 2 Jul 2019 00:43:40 -0400 Subject: 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 --- src/Propellor/EnsureProperty.hs | 41 +++++++++-------------------------------- 1 file changed, 9 insertions(+), 32 deletions(-) (limited to 'src/Propellor/EnsureProperty.hs') 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`. -- cgit v1.2.3