How to inject the result of an IO action into a non-IO monadic computation

Question

I have a small bit of an architectural problem for which I'd like to see if there's a common pattern or abstraction that can help me. I'm writing a game engine where the user is able to specify a game loop as a monadic computation of the form:

gameLoop :: TimeStep -> a -> Game a

where the Game monad has a bunch of access points for drawing, transforming, and interfacing with the engine in general. Then, I also provide a function that the user calls to run the simulation

runGame :: (TimeStep -> a -> Game a) -> a -> IO a

One of the main design goals of the library was to not make Game an instance of the MonadIO typeclass. This is to prevent the user from shooting themselves in the foot by changing the state of the underlying graphics calls, or loading things when they're not expected. However, there are often use cases where the result of an IO a is useful after the game loop has already begun. In particular, spawning enemies with procedurally generated graphical elements comes to mind.

As a result, I'd like to allow the user to request resources using something similar to the following interface:

data ResourceRequestResult a
  = NotLoaded
  | Loaded a

newtype ResourceRequest a = ResourceRequest {
  getRequestResult :: Game (ResourceRequestResult a)
}

requestResource :: IO a -> Game (ResourceRequest a)

With this, I'd like to fork a thread to load the resource and pass the result to the context of the Game monad and back to the user. The main goal would be that I get to decide when the IO action takes place -- somewhere that I expect it to rather than in the middle of the game loop.

One idea that I had in mind was to place another user-defined monad transformer on top of the Game monad... something like

newtype ResourceT r m a = ResourceT (StateT [ResourceRequest r] m a)

However, I believe that then specifying things in terms of f :: ResourceT r Game a becomes an API nightmare, as I'd have to support any possible combination of monad transformer stacks. Ideally I'd also like to avoid making Game polymorphic in r, as it would increase the verbosity and portability of the underlying Game functions as well.

Does Haskell have any abstractions or idioms for something like this programming pattern? Is what I want not possible?

Answer 1

The simplest thing is to use module-level encapsulation. Something like this:

module Game (Game, loadResource) where

data GameState -- = ...
newtype Game = Game { runGame :: StateT GameState IO a }

io :: IO a -> Game a
io = Game . liftIO

loadResource :: IO a -> Game (Game a)
loadResource action = io $ do
    v <- newEmptyMVar
    forkIO (action >>= putMVar v)
    return . io $ takeMVar v

As seen here, you can use the fact that Game can do IO within the Game module without exposing this fact to the rest of the world, exposing only the bits of IO that you consider "safe". In particular, you would not make Game an instance of MonadIO (and it can't be made an instance of MonadTrans as it has the wrong kind). Moreover, the io function and Game constructor are not exported, so the user can't pull an end-run in that way.

Answer 2

Monads and especially monad transformers come from trying to build complicated programs out of simpler pieces. An additional transformer for the new responsibility is an idiomatic way of handling this problem in Haskell.

There's more than one way to deal with transformer stacks. Since you are already using mtl in your code, I'll assume you are comfortable with the choice of typeclasses for penetrating the transformer stack.

The examples given below are complete overkill for the toy problem. This whole example is huge - it shows how pieces can come together from monads defined in multiple different ways - in terms of IO, in terms of a transformer like RWST and in terms of free monad from a functor.

An interface

I like complete examples, so we'll start with a complete interface for a game engine. This will be a small collection of typeclasses each representing one responsibility of the game engine. The ultimate goal will be to provide a function with the following type

{-# LANGUAGE RankNTypes #-}

runGame :: (forall m. MonadGame m => m a) -> IO a

As long as MonadGame doesn't include MonadIO a user of runGame can't make use of IO in general. We can still export all of our underlying types and write instances like MonadIO and a user of the library can still be sure they didn't make a mistake as long as they enter the library through runGame. The typeclasses presented here are actually the same as a free monad, and you don't have to choose between them.

If you don't like either the rank 2 type or a free monad for some reason, you can instead make a new type with no MonadIO instance and not export the constructor as in Daniel Wagner's answer.

Our interface will consist of four type classes - MonadGameState for handling state, MonadGameResource for handling resources, MonadGameDraw for drawing, and an overarching MonadGame that includes all the other three for convenience.

The MonadGameState is a simpler version of MonadRWS from Control.Monad.RWS.Class. The only reason to define our own class is so that MonadRWS is still available for someone else to use. MonadGameState needs data types for the games configuration, how it outputs data to draw, and the state maintained.

import Data.Monoid

data GameConfig = GameConfig

newtype GameOutput = GameOutput (String -> String)
instance Monoid GameOutput where
    mempty = GameOutput id
    mappend (GameOutput a) (GameOutput b) = GameOutput (a . b)

data GameState = GameState {keys :: Maybe String}

class Monad m => MonadGameState m where
    getConfig :: m GameConfig
    output    :: GameOutput -> m ()
    getState  :: m GameState
    updateState :: (GameState -> (a, GameState)) -> m a

Resources are handled by returning an action that can be run later to get the resource if it was loaded.

class (Monad m) => MonadGameResource m where
    requestResource :: IO a -> m (m (Maybe a))

I'm going to add another concern to the game engine and eliminate the need for a (TimeStep -> a -> Game a). Instead of drawing by returning a value, my interface will draw by asking for it explicitly. The return of draw will tell us the TimeStep.

data TimeStep = TimeStep

class Monad m => MonadGameDraw m where
    draw :: m TimeStep

Finally, MonadGame will require instances for the other three type classes.

class (MonadGameState m, MonadGameDraw m, MonadGameResource m) => MonadGame m

Default definitions for transformers

It's easy to provide default definition of all four type classes for monad transformers. We'll add defaults to all three classes.

{-# LANGUAGE DefaultSignatures #-}

class Monad m => MonadGameState m where
    getConfig :: m GameConfig
    output    :: GameOutput -> m ()
    getState  :: m GameState
    updateState :: (GameState -> (a, GameState)) -> m a

    default getConfig :: (MonadTrans t, MonadGameState m) => t m GameConfig
    getConfig = lift getConfig

    default output :: (MonadTrans t, MonadGameState m) => GameOutput -> t m ()
    output = lift . output

    default getState :: (MonadTrans t, MonadGameState m) => t m GameState
    getState = lift getState

    default updateState :: (MonadTrans t, MonadGameState m) => (GameState -> (a, GameState)) -> t m a
    updateState = lift . updateState

class (Monad m) => MonadGameResource m where
    requestResource :: IO a -> m (m (Maybe a))

    default requestResource :: (Monad m, MonadTrans t, MonadGameResource m) => IO a -> t m (t m (Maybe a))
    requestResource = lift . liftM lift . requestResource
class Monad m => MonadGameDraw m where
    draw :: m TimeStep

    default draw :: (MonadTrans t, MonadGameDraw m) => t m TimeStep
    draw = lift draw

I know that I plan on using RWST for state, IdentityT for resources, and FreeT for drawing, so we'll provide instances for all of those transformers now.

import Control.Monad.RWS.Lazy
import Control.Monad.Trans.Free
import Control.Monad.Trans.Identity

instance (Monoid w, MonadGameState m) => MonadGameState (RWST r w s m)
instance (Monoid w, MonadGameDraw m) => MonadGameDraw (RWST r w s m)
instance (Monoid w, MonadGameResource m) => MonadGameResource (RWST r w s m)
instance (Monoid w, MonadGame m) => MonadGame (RWST r w s m)

instance (Functor f, MonadGameState m) => MonadGameState (FreeT f m)
instance (Functor f, MonadGameDraw m) => MonadGameDraw (FreeT f m)
instance (Functor f, MonadGameResource m) => MonadGameResource (FreeT f m)
instance (Functor f, MonadGame m) => MonadGame (FreeT f m)

instance (MonadGameState m) => MonadGameState (IdentityT m)
instance (MonadGameDraw m) => MonadGameDraw (IdentityT m)
instance (MonadGameResource m) => MonadGameResource (IdentityT m)
instance (MonadGame m) => MonadGame (IdentityT m)

Game state

We plan on building the game state from RWST, so we'll make GameT a newtype for RWST. This allows us to attach our own instances like MonadGameState. We'll derive as many classes as we can with GeneralizedNewtypeDeriving.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- Monad typeclasses from base
import Control.Applicative
import Control.Monad
import Control.Monad.Fix
-- Monad typeclasses from transformers
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
-- Monad typeclasses from mtl
import Control.Monad.Error.Class
import Control.Monad.Cont.Class

newtype GameT m a = GameT {getGameT :: RWST GameConfig GameOutput GameState m a}
    deriving (Alternative, Monad, Functor, MonadFix, MonadPlus, Applicative,
              MonadTrans, MonadIO,
              MonadError e, MonadCont,
              MonadGameDraw)

We'll also provide the underivable instance for MonadGameResource and a convenience function equivalent to runRWST

instance (MonadGameResource m) => MonadGameResource (GameT m)

runGameT :: GameT m a -> GameConfig -> GameState -> m (a, GameState, GameOutput)
runGameT = runRWST . getGameT

This lets us get to the meat of providing MonadGameState which just passes everything off onto RWST.

instance (Monad m) => MonadGameState (GameT m) where
    getConfig   = GameT ask
    output      = GameT . tell
    getState    = GameT get
    updateState = GameT . state

If we just added MonadGameState to something that already provided support for resources and drawing we just made a MonadGame.

instance (MonadGameDraw m, MonadGameResource m) => MonadGame (GameT m)

Resource handling

We can handle resources with IO and MVars as in jcast's answer. We'll make a transformer just so we have a type to attach an instance for MonadGameResource to. This is total overkill. To add overkill to overkill, I'm going to newType IdentityT just to get its MonadTrans instance. We'll derive everything we can.

newtype GameResourceT m a = GameResourceT {getGameResourceT :: IdentityT m a}
    deriving (Alternative, Monad, Functor, MonadFix, Applicative,
              MonadTrans, MonadIO,
              MonadError e, MonadReader r, MonadState s, MonadWriter w, MonadCont,
              MonadGameState, MonadGameDraw) 

runGameResourceT :: GameResourceT m a -> m a
runGameResourceT = runIdentityT . getGameResourceT

We'll add an instance for MonadGameResource. This is exactly the same as the other answers.

gameResourceIO :: (MonadIO m) => IO a -> GameResourceT m a
gameResourceIO = GameResourceT . IdentityT . liftIO

instance (MonadIO m) => MonadGameResource (GameResourceT m) where
    requestResource a = gameResourceIO $ do
        var <- newEmptyMVar
        forkIO (a >>= putMVar var)
        return (gameResourceIO . tryTakeMVar $ var)

If we just added resource handling to something that already supported drawing and state, we have a MonadGame

instance (MonadGameState m, MonadGameDraw m, MonadIO m) => MonadGame (GameResourceT m)

Drawing

Like Gabriel Gonzales pointed out, "You can purify any IO interface mechanically". We'll use this trick to implement MonadGameDraw. The only drawing operation is to Draw with a function from the TimeStep to what to do next.

newtype DrawF next = Draw (TimeStep -> next)
    deriving (Functor)

Combined with the free monad transformer, this is the trick I'm using to eliminate the need for a (TimeStep -> a -> Game a). Our DrawT transformer that adds drawing responsibility to a monad with FreeT DrawF.

newtype DrawT m a = DrawT {getDrawT :: FreeT DrawF m a}
    deriving (Alternative, Monad, Functor, MonadPlus, Applicative,
              MonadTrans, MonadIO,
              MonadError e, MonadReader r, MonadState s, MonadWriter w, MonadCont,
              MonadFree DrawF,
              MonadGameState)

Once again we'll define the default instance for MonadGameResource and another convenience function.

instance (MonadGameResource m) => MonadGameResource (DrawT m)

runDrawT :: DrawT m a -> m (FreeF DrawF a (FreeT DrawF m a))
runDrawT = runFreeT . getDrawT

The MonadGameDraw instance says we need to Free (Draw next) where the next thing to do is return the TimeStamp.

instance (Monad m) => MonadGameDraw (DrawT m) where
    draw = DrawT . FreeT . return . Free . Draw $ return

If we just added drawing to something that already handles state and resources, we have a MonadGame

instance (MonadGameState m, MonadGameResource m) => MonadGame (DrawT m)

The game engine

Drawing and the game state interact with each other - when we draw we need to get the output from the RWST to know what to draw. This is easy to do if GameT is directly under DrawT. Our toy loop is very simple; it draws the output and reads lines from the input.

runDrawIO :: (MonadIO m) => GameConfig -> GameState -> DrawT (GameT m) a -> m a
runDrawIO cfg s x = do
    (f, s, GameOutput w) <- runGameT (runDrawT x) cfg s 
    case f of 
        Pure a -> return a
        Free (Draw f) -> do
            liftIO . putStr . w $ []
            keys <- liftIO getLine
            runDrawIO cfg (GameState (Just keys)) (DrawT . f $ TimeStep)

From this we can define running a game in IO by adding GameResourceT.

runGameIO :: DrawT (GameT (GameResourceT IO)) a -> IO a
runGameIO = runGameResourceT . runDrawIO GameConfig (GameState Nothing)

Finally, we can write runGame with the signature we've wanted from the beginning.

runGame :: (forall m. MonadGame m => m a) -> IO a
runGame x = runGameIO x

Example

This example requests the reverse of the last input after 5 seconds and displays everything that has data available each frame.

example :: MonadGame m => m ()
example = go []
    where
        go handles = do
            handles <- dump handles
            state <- getState
            handles <- case keys state of
                Nothing -> return handles
                Just x  -> do
                    handle <- requestResource ((threadDelay 5000000 >>) . return . reverse $ x)
                    return ((x,handle):handles)
            draw
            go handles
        dump [] = return []
        dump ((name, handle):xs) = do
            resource <- handle
            case resource of
                Nothing -> liftM ((name,handle):) $ dump xs
                Just contents -> do
                    output . GameOutput $ (name ++) . ("\n" ++) . (contents ++) . ("\n" ++)
                    dump xs

main = runGameIO example