Add mask_ to prevent "ghc panic" when using timeout on brittany

src/Language/Haskell/Brittany/Internal.hs

@@ -61,6 +61,11 @@ import qualified GHC.LanguageExtensions.Type as GHC
 --
 -- Note that this function ignores/resets all config values regarding
 -- debugging, i.e. it will never use `trace`/write to stderr.
+--
+-- Note that the ghc parsing function used internally currently is wrapped in
+-- `mask_`, so cannot be killed easily. If you don't control the input, you
+-- may wish to put some proper upper bound on the input's size as a timeout
+-- won't do.
 parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text)
 parsePrintModule configRaw inputText = runExceptT $ do
   let config = configRaw { _conf_debug = _conf_debug staticDefaultConfig }

src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs

@@ -37,6 +37,8 @@ import qualified Language.Haskell.GHC.ExactPrint.Preprocess as ExactPrint
 import qualified Language.Haskell.GHC.ExactPrint.Delta      as ExactPrint
 
 import qualified Data.Generics as SYB
+
+import           Control.Exception
 -- import           Data.Generics.Schemes
 
 
@@ -85,7 +87,14 @@ parseModuleFromString
   -> String
   -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
 parseModuleFromString args fp dynCheck str =
-  ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do
+  -- We mask here because otherwise using `throwTo` (i.e. for a timeout) will
+  -- produce nasty looking errors ("ghc panic"). The `mask_` makes it so we
+  -- cannot kill the parsing thread - not very nice. But i'll
+  -- optimistically assume that most of the time brittany uses noticable or
+  -- longer time, the majority of the time is not spend in parsing, but in
+  -- bridoc transformation stuff.
+  -- (reminder to update note on `parsePrintModule` if this changes.)
+  mask_ $ ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do
     dflags0                       <- lift $ ExactPrint.initDynFlagsPure fp str
     (dflags1, leftover, warnings) <- lift
       $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args)