summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2020-08-27 23:46:27 -0400
committerJoey Hess2020-08-27 23:46:27 -0400
commit333657b15634dfe7c75e6bba2b76bd94eb150c8a (patch)
treedc43ddea5fa4a871df6e5b18575b12fa1c54a679
parent7610baa7b8a1491f6781914fad156630ea3716cf (diff)
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.
-rw-r--r--debian/changelog3
-rw-r--r--doc/todo/avoid_ghc_memory_blow_up_for_huge_metatypes_error_messages.mdwn127
-rw-r--r--propellor.cabal2
-rw-r--r--src/Propellor/Types/MetaTypes.hs21
4 files changed, 148 insertions, 5 deletions
diff --git a/debian/changelog b/debian/changelog
index f2505f06..de1914c2 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,5 +1,8 @@
propellor (5.12) UNRELEASED; urgency=medium
+ * 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.
* Added libghc-type-errors-dev to debian/control recommends, and
install it if available when bootstrapping propellor.
* Borg: add UseUmask to BorgRepoOpt.
diff --git a/doc/todo/avoid_ghc_memory_blow_up_for_huge_metatypes_error_messages.mdwn b/doc/todo/avoid_ghc_memory_blow_up_for_huge_metatypes_error_messages.mdwn
new file mode 100644
index 00000000..d6812b89
--- /dev/null
+++ b/doc/todo/avoid_ghc_memory_blow_up_for_huge_metatypes_error_messages.mdwn
@@ -0,0 +1,127 @@
+Some simple mistakes in config.hs can make ghc use gigabytes of memory,
+apparently just to display a huge type error message.
+
+For example, add this to the beginning of
+a Host that has a few dozen other properties after it:
+
+ & Apt.setSourcesListD [] -- missing a parameter
+
+The size of the ghc error output doubles with each added property.
+With 7 it is 518 lines, with 8, 1030 lines. Once it's up to 100000 lines or
+so, it's already using almost a gigabyte of memory.
+
+The error message looks like this (when built with -f-WithTypeErrors):
+
+ executables/propellor-config.hs:175:42: error:
+ • Cannot combine Properties:
+ Property HasInfo + Debian
+ Property Propellor.Types.MetaTypes.PrettyPrintMetaTypes y0
+ ...
+ executables/propellor-config.hs:175:42: error:
+ • Cannot combine Properties:
+ Property Propellor.Types.MetaTypes.PrettyPrintMetaTypes
+ (Propellor.Types.MetaTypes.Concat
+ (Data.Type.Bool.If
+ (Propellor.Types.MetaTypes.Elem
+ 'Propellor.Types.MetaTypes.WithInfo
+ (Propellor.Types.MetaTypes.NonTargets y0))
+ (Propellor.Types.MetaTypes.NonTargets y0)
+ ('Propellor.Types.MetaTypes.WithInfo
+ : Propellor.Types.MetaTypes.NonTargets y0))
+ (Data.Type.Bool.If
+ (Propellor.Types.MetaTypes.Elem
+ ('Propellor.Types.MetaTypes.Targeting 'OSDebian)
+ (Propellor.Types.MetaTypes.Targets y0))
+ '[ 'Propellor.Types.MetaTypes.Targeting 'OSDebian]
+ '[]))
+ Property Debian + Buntish
+ ...
+ executables/propellor-config.hs:175:42: error:
+ • Cannot combine Properties:
+ Property Propellor.Types.MetaTypes.PrettyPrintMetaTypes
+ (Propellor.Types.MetaTypes.Concat
+ (Propellor.Types.MetaTypes.Union
+ (Propellor.Types.MetaTypes.NonTargets
+ (Propellor.Types.MetaTypes.Concat
+ (Data.Type.Bool.If
+ (Propellor.Types.MetaTypes.Elem
+ 'Propellor.Types.MetaTypes.WithInfo
+ (Propellor.Types.MetaTypes.NonTargets y0))
+ (Propellor.Types.MetaTypes.NonTargets y0)
+ ('Propellor.Types.MetaTypes.WithInfo
+ : Propellor.Types.MetaTypes.NonTargets y0))
+ (Data.Type.Bool.If
+ (Propellor.Types.MetaTypes.Elem
+ ('Propellor.Types.MetaTypes.Targeting 'OSDebian)
+ (Propellor.Types.MetaTypes.Targets y0))
+ '[ 'Propellor.Types.MetaTypes.Targeting 'OSDebian]
+ '[])))
+ '[])
+ (Propellor.Types.MetaTypes.Intersect
+ (Propellor.Types.MetaTypes.Targets
+ (Propellor.Types.MetaTypes.Concat
+ (Data.Type.Bool.If
+ (Propellor.Types.MetaTypes.Elem
+ 'Propellor.Types.MetaTypes.WithInfo
+ (Propellor.Types.MetaTypes.NonTargets y0))
+ (Propellor.Types.MetaTypes.NonTargets y0)
+ ('Propellor.Types.MetaTypes.WithInfo
+ : Propellor.Types.MetaTypes.NonTargets y0))
+ (Data.Type.Bool.If
+ (Propellor.Types.MetaTypes.Elem
+ ('Propellor.Types.MetaTypes.Targeting 'OSDebian)
+ (Propellor.Types.MetaTypes.Targets y0))
+ '[ 'Propellor.Types.MetaTypes.Targeting 'OSDebian]
+ '[])))
+ '[ 'Propellor.Types.MetaTypes.Targeting 'OSDebian,
+ 'Propellor.Types.MetaTypes.Targeting 'OSBuntish]))
+ Property Debian + Buntish
+
+Since the type checker is getting stuck it pretty-prints the type level
+expression it was trying to solve, all expanded out, so this can get
+arbitrarily huge.
+
+This really seems like a ghc bug, and may be worth filing? But maybe propellor
+could also avoid it. Perhaps there's some way to write the MetaTypes code
+that avoids this.
+
+Hmm, the "Cannot combine properties" custom type message includes the types
+of the two properties in question. I tried leaving those out, and the error
+message is no longer huge. (But also not comprehensible in other cases.)
+Here's how that change affected memory use:
+
+ -50.50user 4.79system 0:59.28elapsed 93%CPU (0avgtext+0avgdata 2010848maxresident)k
+ +8.70user 0.72system 0:09.41elapsed 100%CPU (0avgtext+0avgdata 964804maxresident)k
+
+Wow! (900 mb or so is what it usually takes to build my config, so there's
+no excess memory use at all really after that change.)
+
+So there are changes to propellor that basically solve this, looks like.
+Question is, how to solve it without eliminating nice things like
+
+ • Cannot combine Properties:
+ Property HasInfo + Debian
+ Property HasInfo + FreeBSD
+
+WithTypeErrors tries to detect just that case, making that message
+check if they're stuck, and not display them. That works as far
+as preventing displaying massive type errors, but ghc still
+uses too much memory despite not displaying them. Here's the
+memory use when it's enabled:
+
+ 20.48user 1.36system 0:21.96elapsed 99%CPU (0avgtext+0avgdata 1942220maxresident)k
+
+I think what's probably going on is, WithTypeErrors uses IsStuck, which
+causes ghc to do an equivilant amount of buffering as displaying the type would.
+
+Well, I can't see a way to keep the nice display of metatypes in the non-stuck
+case, while avoiding blowup in the stuck case. But on the other hand,
+it's pretty unusual to actually try to use a FreeBSD on a Debian system
+when adding properties to a host. The metatypes are really more useful
+when programming properties, to eg, avoid using Apt.installed inside
+some property that's LinuxLike and so also needs an implementation for
+non-Debian.
+
+So, ok, we'll skip displaying the metatypes when (&) is used to combine
+properties eg in a Host definition, but display it when properties are combined
+in other ways. [[done]] --[[Joey]]
diff --git a/propellor.cabal b/propellor.cabal
index e46adc40..29e6ecd4 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -36,7 +36,7 @@ Description:
It is configured using haskell.
Flag WithTypeErrors
- Description: Build with type-errors library for better error messages
+ Description: Build with type-errors library for better error messages and less memory use
Library
Default-Language: Haskell98
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 "<unknown>"