module Mit.Monad ( Mit, runMit, io, getEnv, withEnv, Goto, label, with, with_, ) where import Control.Monad qualified import Data.Unique import Mit.Prelude import Unsafe.Coerce (unsafeCoerce) newtype Mit r a = Mit (forall x. r -> (a -> IO x) -> IO x) deriving stock (forall a b. a -> Mit r b -> Mit r a forall a b. (a -> b) -> Mit r a -> Mit r b forall r a b. a -> Mit r b -> Mit r a forall r a b. (a -> b) -> Mit r a -> Mit r b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> Mit r b -> Mit r a $c<$ :: forall r a b. a -> Mit r b -> Mit r a fmap :: forall a b. (a -> b) -> Mit r a -> Mit r b $cfmap :: forall r a b. (a -> b) -> Mit r a -> Mit r b Functor) instance Applicative (Mit r) where pure :: forall a. a -> Mit r a pure a x = forall r a. (forall x. r -> (a -> IO x) -> IO x) -> Mit r a Mit \r _ a -> IO x k -> a -> IO x k a x <*> :: forall a b. Mit r (a -> b) -> Mit r a -> Mit r b (<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b ap instance Monad (Mit r) where return :: forall a. a -> Mit r a return = forall (f :: * -> *) a. Applicative f => a -> f a pure Mit forall x. r -> (a -> IO x) -> IO x mx >>= :: forall a b. Mit r a -> (a -> Mit r b) -> Mit r b >>= a -> Mit r b f = forall r a. (forall x. r -> (a -> IO x) -> IO x) -> Mit r a Mit \r r b -> IO x k -> forall x. r -> (a -> IO x) -> IO x mx r r (\a a -> forall r a x. Mit r a -> r -> (a -> IO x) -> IO x unMit (a -> Mit r b f a a) r r b -> IO x k) instance MonadIO (Mit r) where liftIO :: forall a. IO a -> Mit r a liftIO = forall a r. IO a -> Mit r a io unMit :: Mit r a -> r -> (a -> IO x) -> IO x unMit :: forall r a x. Mit r a -> r -> (a -> IO x) -> IO x unMit (Mit forall x. r -> (a -> IO x) -> IO x k) = forall x. r -> (a -> IO x) -> IO x k runMit :: r -> Mit r a -> IO a runMit :: forall r a. r -> Mit r a -> IO a runMit r r Mit r a m = forall r a x. Mit r a -> r -> (a -> IO x) -> IO x unMit Mit r a m r r forall (f :: * -> *) a. Applicative f => a -> f a pure io :: IO a -> Mit r a io :: forall a r. IO a -> Mit r a io IO a m = forall r a. (forall x. r -> (a -> IO x) -> IO x) -> Mit r a Mit \r _ a -> IO x k -> do a x <- IO a m a -> IO x k a x getEnv :: Mit r r getEnv :: forall r. Mit r r getEnv = forall r a. (forall x. r -> (a -> IO x) -> IO x) -> Mit r a Mit \r r r -> IO x k -> r -> IO x k r r withEnv :: (r -> s) -> Mit s a -> Mit r a withEnv :: forall r s a. (r -> s) -> Mit s a -> Mit r a withEnv r -> s f Mit s a m = forall r a. (forall x. r -> (a -> IO x) -> IO x) -> Mit r a Mit \r r a -> IO x k -> forall r a x. Mit r a -> r -> (a -> IO x) -> IO x unMit Mit s a m (r -> s f r r) a -> IO x k type Goto r a = forall void. a -> Mit r void label :: (Goto r a -> Mit r a) -> Mit r a label :: forall r a. (Goto r a -> Mit r a) -> Mit r a label Goto r a -> Mit r a f = forall r a. (forall x. r -> (a -> IO x) -> IO x) -> Mit r a Mit \r r a -> IO x k -> do Unique n <- IO Unique newUnique forall e a. Exception e => IO a -> IO (Either e a) try (forall r a. r -> Mit r a -> IO a runMit r r (Goto r a -> Mit r a f (\a x -> forall a r. IO a -> Mit r a io (forall e a. Exception e => e -> IO a throwIO (forall a. Unique -> a -> X X Unique n a x))))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Left err :: X err@(X Unique m a y) | Unique n forall a. Eq a => a -> a -> Bool == Unique m -> a -> IO x k (forall a b. a -> b unsafeCoerce a y) | Bool otherwise -> forall e a. Exception e => e -> IO a throwIO X err Right a x -> a -> IO x k a x data X = forall a. X Unique a instance Exception X where toException :: X -> SomeException toException = forall e. Exception e => e -> SomeException asyncExceptionToException fromException :: SomeException -> Maybe X fromException = forall e. Exception e => SomeException -> Maybe e asyncExceptionFromException instance Show X where show :: X -> String show X _ = String "" with :: (forall v. (a -> IO v) -> IO v) -> (a -> Mit r b) -> Mit r b with :: forall a r b. (forall v. (a -> IO v) -> IO v) -> (a -> Mit r b) -> Mit r b with forall v. (a -> IO v) -> IO v f a -> Mit r b action = forall r a. (forall x. r -> (a -> IO x) -> IO x) -> Mit r a Mit \r r b -> IO x k -> do b b <- forall v. (a -> IO v) -> IO v f (\a a -> forall r a. r -> Mit r a -> IO a runMit r r (a -> Mit r b action a a)) b -> IO x k b b with_ :: (forall v. IO v -> IO v) -> Mit r a -> Mit r a with_ :: forall r a. (forall v. IO v -> IO v) -> Mit r a -> Mit r a with_ forall v. IO v -> IO v f Mit r a action = forall r a. (forall x. r -> (a -> IO x) -> IO x) -> Mit r a Mit \r r a -> IO x k -> do a a <- forall v. IO v -> IO v f (forall r a. r -> Mit r a -> IO a runMit r r Mit r a action) a -> IO x k a a