summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/EnsureProperty.hs4
-rw-r--r--src/Propellor/Types.hs4
-rw-r--r--src/Propellor/Types/MetaTypes.hs14
3 files changed, 14 insertions, 8 deletions
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