From 30e9ed96f3a7683f6a23e689f666ef4a8948e3be Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Tue, 14 Jun 2022 18:15:40 +0200
Subject: Initial

---
 src/ExitEarly.hs | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)
 create mode 100644 src/ExitEarly.hs

(limited to 'src/ExitEarly.hs')

diff --git a/src/ExitEarly.hs b/src/ExitEarly.hs
new file mode 100644
index 0000000..2375093
--- /dev/null
+++ b/src/ExitEarly.hs
@@ -0,0 +1,40 @@
+module ExitEarly (
+  ExitEarlyT,
+  exitEarly,
+  execExitEarlyT,
+  okOrExitEarly,
+  lift,
+) where
+
+import Control.Monad (ap)
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+
+
+newtype ExitEarlyT r m a = ExitEarlyT { runExitEarlyT :: (a -> m r) -> m r }
+
+instance Functor m => Functor (ExitEarlyT r m) where
+  fmap f (ExitEarlyT g) = ExitEarlyT (\k -> g (k . f))
+
+instance Monad m => Applicative (ExitEarlyT r m) where
+  pure x = ExitEarlyT ($ x)
+  (<*>) = ap
+
+instance Monad m => Monad (ExitEarlyT r m) where
+  ExitEarlyT g >>= f = ExitEarlyT (\k -> g (($ k) . runExitEarlyT . f))
+
+instance MonadTrans (ExitEarlyT r) where
+  lift act = ExitEarlyT (act >>=)
+
+instance MonadIO m => MonadIO (ExitEarlyT r m) where
+  liftIO act = ExitEarlyT (liftIO act >>=)
+
+exitEarly :: Monad m => r -> ExitEarlyT r m a
+exitEarly r = ExitEarlyT (\_ -> return r)
+
+okOrExitEarly :: Monad m => Either e a -> (e -> ExitEarlyT r m r) -> ExitEarlyT r m a
+okOrExitEarly (Left err) f = f err >>= exitEarly
+okOrExitEarly (Right x) _ = return x
+
+execExitEarlyT :: Monad m => ExitEarlyT r m r -> m r
+execExitEarlyT (ExitEarlyT g) = g return
-- 
cgit v1.2.3-54-g00ecf