TLDR: New forkable monad/transformer suggestion http://pastebin.com/QNUVL12v (hpaste is down)

Hi,

There are a dozen packages on hackage defining a class for monads that can be forked, however none of these are modular enough to be useful in my opinion.

In particular the following are not addressed:
1. Cases when the child thread's monad is different from the parent's
2. Monad transformers (this is somewhat addressed with Control.Monad.Trans.Control)

I will try to demonstrate both issues with an example.

1. WebSockets

WebSockets is a monad that cannot itself be forked. This is because at any given time there should only be a single thread listening on a websocket.
However there is a reasonable monad that can be forked off, namely one that can send to the websocket - one that has access to the Sink.

So first off a "Forkable" class should not look like this:

class (MonadIO m, MonadIO n) => Forkable m where
    fork :: m () -> m ThreadId

But rather like this:

class Forkable m n where
    fork :: n () -> m ThreadId

For our example the instance would be

instance (Protocol p) => Forkable (WebSockets p) (ReaderT (Sink p) IO) where
    fork (ReaderT f) = liftIO . forkIO . f =<< getSink

Another example would be a child that should not be able to throw errors as opposed to the parent thread.

2. ReaderT

Continuing from the previous example to demonstrate the need to distinguish forkable transformers.
Say we have some shared state S that both parent and child should have access to:

type Parent p = ReaderT (TVar S) (WebSockets p)
type Child p = ReaderT (TVar S) (ReaderT (Sink p) IO)

The "forkability" of Child from Parent should be implied, however with Forkable we have to write a separate instance.

So what I suggest is a second class:

class ForkableT t where
    forkT :: (Forkable m n) => t n () -> t m ThreadId

And then:

instance ForkableT (ReaderT r) where
    forkT (ReaderT f) = ReaderT $ fork . f

We can also introduce a default for Forkable that uses a ForkableT instance:

class (MonadIO m, MonadIO n) => Forkable m n where
    fork :: n () -> m ThreadId
    default fork :: ForkableT t => t n () -> t m ThreadId
    fork = forkT

instance (Forkable m n) => Forkable (ReaderT r m) (ReaderT r n)

This means Child is automatically Forkable from Parent, no need to write a specific case for our specific monads (and if we newtype it we can use -XGeneralizedNewtypeDeriving)

Note how MonadTransControl already solves the specific problem of lifting a forking operation into ReaderT. However consider ResourceT from Control.Monad.Resource: it is basically a ReaderT, however in order to safely deallocate resources when sharing reference counting is needed. This means a simple lift would not suffice.

We can nevertheless provide a default ForkableT based on MonadTransControl:
class ForkableT t where
    forkT :: (Forkable m n) => t n () -> t m ThreadId
    default forkT :: (MonadTransControl t, Forkable m n) => t n () -> t m ThreadId
    forkT t = liftWith $ \run -> fork $ run t >> return ()

Actually resourcet's reference counting resourceForkIO also nicely demonstrates the first problem:
type Parent p = ResourceT (WebSockets p)
type Child p = ResourceT (ReaderT (Sink p) IO)

Note how we cannot use resourceForkIO without touching the underlying monads.

What do you think? Is there already an established way of modular forking? I wouldn't like to litter hackage with another unusable Forkable class:)