From 455973a8cbfcd13a91ba0ca8eecff0f5e40e186e Mon Sep 17 00:00:00 2001 From: why-not-try-calmer Date: Wed, 18 Dec 2024 15:51:29 +0100 Subject: [PATCH] Adding exception handling for those making it to the main thread --- src/Server.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/Server.hs b/src/Server.hs index 5b3684b..3a58084 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -5,12 +5,13 @@ module Server (startApp, makeConfig) where import Control.Concurrent (newChan, writeChan) -import Control.Exception (SomeException (SomeException), throwIO, try) +import Control.Exception (Exception (fromException), SomeAsyncException (SomeAsyncException), SomeException (SomeException), throwIO, try) import Control.Monad.Reader import Data.Foldable (for_) import Data.IORef (newIORef) import Data.Maybe (fromJust, fromMaybe) import qualified Data.Text as T +import GHC.IO (catch, onException) import Jobs import Mongo (setupDb) import Network.Wai @@ -151,6 +152,14 @@ startApp = do initStart config putStrLn $ "Startup completed for version " ++ T.unpack (app_version config) putStrLn $ "Running now using " ++ show port - run port $ withServer config + run port (withServer config) + `catch` ( \e -> do + let (analysis, err) = case fromException e of + Just (SomeAsyncException _) -> ("async", show e) + _ -> ("synchronous", show e) + report = "An exception (" ++ analysis ++ ") made it to the main thread, rethrowing after logging: " ++ show err + print report + throwIO e + ) where port = 8000