Add quasar monad entry points

Co-authored-by: Jan Beinke <git@janbeinke.com>

src/Quasar/Monad.hs

 module Quasar.Monad (
+  -- * Quasar
   Quasar,
   newQuasar,
 
   MonadQuasar(..),
-  askIOWorker,
-  askExceptionChannel,
-  askResourceManager,
 
   QuasarT,
   QuasarIO,
   QuasarSTM,
 
+  withQuasarGeneric,
   runQuasarIO,
   liftQuasarIO,
   quasarAtomically,
@@ -19,18 +18,37 @@ module Quasar.Monad (
   enterQuasarSTM,
 
   startShortIO_,
+
+  -- ** High-level initialization
+  runQuasarAndExit,
+  runQuasarAndExitWith,
+  runQuasarCollectExceptions,
+  runQuasarCombineExceptions,
+
+  -- ** Get quasar components
+  quasarIOWorker,
+  quasarExceptionChannel,
+  quasarResourceManager,
+  askIOWorker,
+  askExceptionChannel,
+  askResourceManager,
 ) where
 
 import Control.Concurrent.STM
 import Control.Monad.Catch
 import Control.Monad.Reader
+import Data.List.NonEmpty
 import GHC.Records (HasField(..))
 import Quasar.Async.STMHelper
+import Quasar.Awaitable
 import Quasar.Exceptions
+import Quasar.Exceptions.ExceptionChannel
 import Quasar.Prelude
 import Quasar.Resources.Disposer
-import Quasar.Awaitable
+import Quasar.Utils.Exceptions
 import Quasar.Utils.ShortIO
+import System.Exit
+import Data.Bifunctor (first)
 
 
 -- Invariant: the resource manager is disposed as soon as an exception is thrown to the channel
@@ -76,6 +94,9 @@ newQuasar = do
   ensureSTM $ newQuasarSTM worker exChan parentRM
 
 
+--withResourceScope :: MonadQuasar m => m a -> m a
+
+
 class (MonadCatch m, MonadFix m) => MonadQuasar m where
   askQuasar :: m Quasar
   maskIfRequired :: m a -> m a
@@ -172,7 +193,69 @@ quasarAtomically (QuasarSTM fn) = do
      (result <$) <$> readTVar effectAwaitableVar
 
 enterQuasarIO :: MonadIO m => Quasar -> QuasarIO () -> m ()
-enterQuasarIO = undefined
+enterQuasarIO quasar fn = runQuasarIO quasar $ redirectExceptionToSink_ fn
 
 enterQuasarSTM :: MonadQuasar m => Quasar -> QuasarSTM () -> m ()
-enterQuasarSTM = undefined
+enterQuasarSTM quasar fn = ensureQuasarSTM $ localQuasar quasar $ redirectExceptionToSink_ fn
+
+
+redirectExceptionToSink :: MonadQuasar m => m a -> m (Maybe a)
+redirectExceptionToSink fn = do
+  exChan <- askExceptionChannel
+  (Just <$> fn) `catchAll`
+    \ex -> ensureSTM (Nothing <$ throwToExceptionChannel exChan ex)
+
+redirectExceptionToSink_ :: MonadQuasar m => m a -> m ()
+redirectExceptionToSink_ fn = void $ redirectExceptionToSink fn
+
+
+-- * Quasar initialization
+
+withQuasarGeneric :: TIOWorker -> ExceptionChannel -> QuasarIO a -> IO a
+withQuasarGeneric worker exChan fn = mask \unmask -> do
+  rm <- atomically $ newUnmanagedResourceManagerSTM worker exChan
+  let quasar = Quasar worker exChan rm
+  unmask (runQuasarIO quasar fn) `finally` dispose rm
+
+
+-- * High-level entry helpers
+
+runQuasarAndExit :: QuasarIO () -> IO a
+runQuasarAndExit =
+  runQuasarAndExitWith \case
+   QuasarExitSuccess () -> ExitSuccess
+   QuasarExitAsyncException () -> ExitFailure 1
+   QuasarExitMainThreadFailed -> ExitFailure 1
+
+data QuasarExitState a = QuasarExitSuccess a | QuasarExitAsyncException a | QuasarExitMainThreadFailed
+
+runQuasarAndExitWith :: (QuasarExitState a -> ExitCode) -> QuasarIO a -> IO b
+runQuasarAndExitWith exitCodeFn fn = mask \unmask -> do
+  worker <- newTIOWorker
+  (exChan, exceptionWitness) <- atomically $ newExceptionChannelWitness (loggingExceptionChannel worker)
+  mResult <- unmask $ withQuasarGeneric worker exChan (redirectExceptionToSink fn)
+  failure <- atomically exceptionWitness
+  exitState <- case (mResult, failure) of
+    (Just result, False) -> pure $ QuasarExitSuccess result
+    (Just result, True) -> pure $ QuasarExitAsyncException result
+    (Nothing, True) -> pure QuasarExitMainThreadFailed
+    (Nothing, False) -> do
+      traceIO "Invalid code path reached: Main thread failed but no asynchronous exception was witnessed. This is a bug, please report it to the `quasar`-project."
+      pure QuasarExitMainThreadFailed
+  exitWith $ exitCodeFn exitState
+
+
+runQuasarCollectExceptions :: QuasarIO a -> IO (Either SomeException a, [SomeException])
+runQuasarCollectExceptions fn = do
+  (exChan, collectExceptions) <- atomically $ newExceptionCollector panicChannel
+  worker <- newTIOWorker
+  result <- try $ withQuasarGeneric worker exChan fn
+  exceptions <- atomically collectExceptions
+  pure (result, exceptions)
+
+runQuasarCombineExceptions :: QuasarIO a -> IO a
+runQuasarCombineExceptions fn = do
+  (result, exceptions) <- runQuasarCollectExceptions fn
+  case result of
+    Left (ex :: SomeException) -> maybe (throwM ex) (throwM . CombinedException . (ex <|)) (nonEmpty exceptions)
+    Right fnResult -> maybe (pure fnResult) (throwM . CombinedException) $ nonEmpty exceptions