{-# 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 :: forall a. (Content IO -> IO a) -> IO a
embed Content IO -> IO a
f = Content IO -> IO a
f forall a. HasCallStack => a
undefined
callback :: forall a. 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 :: forall (m :: * -> *) r b a.
EmbedIO m =>
m r -> (r -> m b) -> (r -> m a) -> m a
bracketE m r
before r -> m b
after r -> m a
during =
forall (o :: * -> *) a. EmbedIO o => (Content o -> IO a) -> o a
embed forall a b. (a -> b) -> a -> b
$ \Content m
x -> 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 = 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 = 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 = 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 :: forall (m :: * -> *) e a.
(EmbedIO m, Exception e) =>
m a -> (e -> m a) -> m a
catchE m a
action e -> m a
handler = forall (o :: * -> *) a. EmbedIO o => (Content o -> IO a) -> o a
embed forall a b. (a -> b) -> a -> b
$ \Content m
x -> 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 = 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 = 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 :: forall (m :: * -> *) e a.
(EmbedIO m, Exception e) =>
(e -> m a) -> m a -> m a
handleE = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall (m :: * -> *) e a.
(EmbedIO m, Exception e) =>
m a -> m (Either e a)
tryE m a
action = forall (o :: * -> *) a. EmbedIO o => (Content o -> IO a) -> o a
embed forall a b. (a -> b) -> a -> b
$ \Content m
x -> forall e a. Exception e => IO a -> IO (Either e a)
try (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 :: forall (m :: * -> *) e a. (EmbedIO m, Exception e) => e -> m a
throwE = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO
forkE :: EmbedIO m => m () -> m ThreadId
forkE :: forall (m :: * -> *). EmbedIO m => m () -> m ThreadId
forkE m ()
action = forall (o :: * -> *) a. EmbedIO o => (Content o -> IO a) -> o a
embed forall a b. (a -> b) -> a -> b
$ \Content m
x -> IO () -> IO ThreadId
forkIO (forall (o :: * -> *) a. EmbedIO o => o a -> Content o -> IO a
callback m ()
action Content m
x)