From 333657b15634dfe7c75e6bba2b76bd94eb150c8a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 27 Aug 2020 23:46:27 -0400 Subject: Worked around a situation where ghc uses insane amounts of memory displaying an error message about a property of a host having the wrong number of arguments This is suboptimal, and I hope ghc improves eventually. But it's a lot better than using all available memory. This commit was sponsored by Svenne Krap on Patreon. --- src/Propellor/Types/MetaTypes.hs | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Types') diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs index 055338af..7cef578e 100644 --- a/src/Propellor/Types/MetaTypes.hs +++ b/src/Propellor/Types/MetaTypes.hs @@ -169,10 +169,10 @@ type family CheckCombinableNote (list1 :: [a]) (list2 :: [a]) (note :: ErrorMess ('Just ('Text "(" ':<>: note ':<>: 'Text ")")) ) --- Checking IfStuck is to avoid massive and useless error message leaking --- type families from this module. type family CannotCombine (list1 :: [a]) (list2 :: [a]) (note :: Maybe ErrorMessage) :: Constraint where - CannotCombine list1 list2 note = + -- Checking IfStuck is to avoid ugly error + -- message leaking type families from this module. + CannotCombine list1 list2 'Nothing = IfStuck list1 (IfStuck list2 (DelayError (CannotCombineMessage UnknownType UnknownType UnknownTypeNote)) @@ -180,8 +180,21 @@ type family CannotCombine (list1 :: [a]) (list2 :: [a]) (note :: Maybe ErrorMess ) (IfStuck list2 (DelayError (CannotCombineMessage (PrettyPrintMetaTypes list1) UnknownType UnknownTypeNote)) - (DelayErrorFcf (CannotCombineMessage (PrettyPrintMetaTypes list1) (PrettyPrintMetaTypes list2) note)) + (DelayErrorFcf (CannotCombineMessage (PrettyPrintMetaTypes list1) (PrettyPrintMetaTypes list2) 'Nothing)) ) + -- When there's a note, don't display the MetaTypes at all. + -- This is because the note is used when eg, combining properties + -- in a host with (&), and in that case, it's likely that the + -- problem resulted in the type checker getting stuck, and that + -- displaying the MetaTypes would involve a massive error messsage. + -- Displaying, or even checking IfStuck in that case can result in + -- huge amounts of memory being used by ghc. So, avoid it, and let + -- the note point the user in the right direction to fixing their + -- mistake. + CannotCombine list1 list2 ('Just note) = + TypeError ('Text "Cannot combine two Properties." + ':$$: 'Text "(They may have conflicting MetaTypes, or the wrong number of arguments.)" + ':$$: note) type family UnknownType :: ErrorMessage where UnknownType = 'Text "" -- cgit v1.2.3