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