From 8dfae9858f6fce6791e8111cb5ad72162eff7177 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 2 Jul 2019 11:05:50 -0400 Subject: use DelayError Syrak looked at this branch and said: Cool! I'd suggest that if it's working, that's an accident! You probably want IfStuck e (DelayError err1) (DelayErrorFcf err2) rather than IfStuck e (TypeError err1) (TypeError err2) --- src/Propellor/EnsureProperty.hs | 4 ++-- src/Propellor/Types.hs | 4 ++-- src/Propellor/Types/MetaTypes.hs | 14 ++++++++++---- 3 files changed, 14 insertions(+), 8 deletions(-) (limited to 'src') diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs index 5ed0325f..4b70ffb7 100644 --- a/src/Propellor/EnsureProperty.hs +++ b/src/Propellor/EnsureProperty.hs @@ -66,12 +66,12 @@ type family EnsurePropertyTargetOSMatches inner outer where If (Targets outer `IsSubset` Targets inner) 'True (IfStuck (Targets outer) - (TypeError + (DelayError ('Text "ensureProperty outer Property type is not able to be inferred here." ':$$: 'Text "Consider adding a type annotation." ) ) - (TypeError + (DelayErrorFcf ('Text "ensureProperty inner Property is missing support for: " ':$$: PrettyPrintMetaTypes (Difference (Targets outer) (Targets inner)) ) diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 026babf0..0a3dd122 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -225,12 +225,12 @@ type family TightenTargetsAllowed untightened tightened where && NonTargets untightened `IsSubset` NonTargets tightened) 'True (IfStuck (Targets tightened) - (TypeError + (DelayError ('Text "Unable to infer desired Property type in this use of tightenTargets." ':$$: ('Text "Consider adding a type annotation.") ) ) - (TypeError + (DelayErrorFcf ('Text "This use of tightenTargets would widen, not narrow, adding: " ':$$: PrettyPrintMetaTypes (Difference (Targets tightened) (Targets untightened)) ) diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 567f533a..23c8e9d8 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -30,6 +30,8 @@ module Propellor.Types.MetaTypes ( Intersect, Difference, IfStuck, + DelayError, + DelayErrorFcf, ) where import Propellor.Types.Singletons @@ -43,6 +45,10 @@ import Type.Errors #else type family IfStuck (expr :: k) (b :: k1) (c :: k1) :: k1 where IfStuck expr b c = c +type family DelayError msg where + DelayError msg = TypeError msg +type family DelayErrorFcf msg where + DelayErrorFcf msg = TypeError msg #endif data MetaType @@ -167,12 +173,12 @@ type family CannotCombine (list1 :: [a]) (list2 :: [a]) (note :: Maybe ErrorMess CannotCombine list1 list2 note = IfStuck list1 (IfStuck list2 - (TypeError (CannotCombineMessage UnknownType UnknownType UnknownTypeNote)) - (TypeError (CannotCombineMessage UnknownType (PrettyPrintMetaTypes list2) UnknownTypeNote)) + (DelayError (CannotCombineMessage UnknownType UnknownType UnknownTypeNote)) + (DelayErrorFcf (CannotCombineMessage UnknownType (PrettyPrintMetaTypes list2) UnknownTypeNote)) ) (IfStuck list2 - (TypeError (CannotCombineMessage (PrettyPrintMetaTypes list1) UnknownType UnknownTypeNote)) - (TypeError (CannotCombineMessage (PrettyPrintMetaTypes list1) (PrettyPrintMetaTypes list2) note)) + (DelayError (CannotCombineMessage (PrettyPrintMetaTypes list1) UnknownType UnknownTypeNote)) + (DelayErrorFcf (CannotCombineMessage (PrettyPrintMetaTypes list1) (PrettyPrintMetaTypes list2) note)) ) type family UnknownType :: ErrorMessage where -- cgit v1.2.3