{-# LANGUAGE TypeFamilies, EmptyDataDecls #-}
module Control.Monad.EmbedIO
( EmbedIO(..)
, Void
, bracketE
, catchE
, handleE
, tryE
, throwE
, forkE
) where
import Control.Concurrent
import Control.Exception
import Control.Monad.IO.Class
import Prelude hiding (catch)
class (MonadIO o) => EmbedIO o where
type Content o
embed :: (Content o -> IO a) -> o a
callback :: o a -> Content o -> IO a
data Void
instance EmbedIO IO where
type Content IO = Void
embed :: (Content IO -> IO a) -> IO a
embed Content IO -> IO a
f = Content IO -> IO a
f Content IO
forall a. HasCallStack => a
undefined
callback :: IO a -> Content IO -> IO a
callback IO a
action Content IO
_ = IO a
action
bracketE :: EmbedIO m => m r -> (r -> m b) -> (r -> m a) -> m a
bracketE :: m r -> (r -> m b) -> (r -> m a) -> m a
bracketE m r
before r -> m b
after r -> m a
during =
(Content m -> IO a) -> m a
forall (o :: * -> *) a. EmbedIO o => (Content o -> IO a) -> o a
embed ((Content m -> IO a) -> m a) -> (Content m -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \Content m
x -> IO r -> (r -> IO b) -> (r -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Content m -> IO r
before' Content m
x) (\r
a -> r -> Content m -> IO b
after' r
a Content m
x) (\r
a -> r -> Content m -> IO a
during' r
a Content m
x)
where
before' :: Content m -> IO r
before' Content m
x = m r -> Content m -> IO r
forall (o :: * -> *) a. EmbedIO o => o a -> Content o -> IO a
callback m r
before Content m
x
after' :: r -> Content m -> IO b
after' r
a Content m
x = m b -> Content m -> IO b
forall (o :: * -> *) a. EmbedIO o => o a -> Content o -> IO a
callback (r -> m b
after r
a) Content m
x
during' :: r -> Content m -> IO a
during' r
a Content m
x = m a -> Content m -> IO a
forall (o :: * -> *) a. EmbedIO o => o a -> Content o -> IO a
callback (r -> m a
during r
a) Content m
x
catchE :: (EmbedIO m, Exception e) => m a -> (e -> m a) -> m a
catchE :: m a -> (e -> m a) -> m a
catchE m a
action e -> m a
handler = (Content m -> IO a) -> m a
forall (o :: * -> *) a. EmbedIO o => (Content o -> IO a) -> o a
embed ((Content m -> IO a) -> m a) -> (Content m -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \Content m
x -> IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Content m -> IO a
action' Content m
x) (\e
e -> e -> Content m -> IO a
handler' e
e Content m
x)
where
action' :: Content m -> IO a
action' Content m
x = m a -> Content m -> IO a
forall (o :: * -> *) a. EmbedIO o => o a -> Content o -> IO a
callback m a
action Content m
x
handler' :: e -> Content m -> IO a
handler' e
e Content m
x = m a -> Content m -> IO a
forall (o :: * -> *) a. EmbedIO o => o a -> Content o -> IO a
callback (e -> m a
handler e
e) Content m
x
handleE :: (EmbedIO m, Exception e) => (e -> m a) -> m a -> m a
handleE :: (e -> m a) -> m a -> m a
handleE = (m a -> (e -> m a) -> m a) -> (e -> m a) -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(EmbedIO m, Exception e) =>
m a -> (e -> m a) -> m a
catchE
tryE :: (EmbedIO m, Exception e) => m a -> m (Either e a)
tryE :: m a -> m (Either e a)
tryE m a
action = (Content m -> IO (Either e a)) -> m (Either e a)
forall (o :: * -> *) a. EmbedIO o => (Content o -> IO a) -> o a
embed ((Content m -> IO (Either e a)) -> m (Either e a))
-> (Content m -> IO (Either e a)) -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ \Content m
x -> IO a -> IO (Either e a)
forall e a. Exception e => IO a -> IO (Either e a)
try (m a -> Content m -> IO a
forall (o :: * -> *) a. EmbedIO o => o a -> Content o -> IO a
callback m a
action Content m
x)
throwE :: (EmbedIO m, Exception e) => e -> m a
throwE :: e -> m a
throwE = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (e -> IO a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall e a. Exception e => e -> IO a
throwIO
forkE :: EmbedIO m => m () -> m ThreadId
forkE :: m () -> m ThreadId
forkE m ()
action = (Content m -> IO ThreadId) -> m ThreadId
forall (o :: * -> *) a. EmbedIO o => (Content o -> IO a) -> o a
embed ((Content m -> IO ThreadId) -> m ThreadId)
-> (Content m -> IO ThreadId) -> m ThreadId
forall a b. (a -> b) -> a -> b
$ \Content m
x -> IO () -> IO ThreadId
forkIO (m () -> Content m -> IO ()
forall (o :: * -> *) a. EmbedIO o => o a -> Content o -> IO a
callback m ()
action Content m
x)