如何将 IO 操作的结果注入到非 IO 单子计算中

Question

我有一点架构问题，我想看看是否有一个通用模式或抽象可以帮助我。我是writing a game engine，用户可以将游戏循环指定为表单的一元计算：

gameLoop :: TimeStep -> a -> Game a

Game monad 有一堆访问点，用于绘制、转换和与引擎交互。然后，我还提供了一个用户调用来运行模拟的函数

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

该库的主要设计目标之一是不使 Game 成为 MonadIO 类型类的实例。这是为了防止用户通过更改底层图形调用的状态或在不期望的情况下加载东西来防止用户在脚上开枪。但是，在某些用例中，IO a 的结果在游戏循环已经开始后很有用。特别是，我想到了用程序生成的图形元素生成敌人。

因此，我想允许用户使用类似于以下界面的方式请求资源：

data ResourceRequestResult a
  = NotLoaded
  | Loaded a

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

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

有了这个，我想派生一个线程来加载资源并将结果传递给Game monad 的上下文并返回给用户。主要目标是让我决定 IO 操作何时发生——我期望它发生的地方，而不是在游戏循环的中间。

我想到的一个想法是在 Game monad 之上放置另一个用户定义的 monad 转换器......类似于

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

但是，我相信用 f :: ResourceT r Game a 指定事物会成为 API 的噩梦，因为我必须支持任何可能的 monad 转换器堆栈组合。理想情况下，我还想避免在r 中使Game 多态，因为这也会增加底层Game 函数的冗长性和可移植性。

Haskell 是否有类似这种编程模式的抽象或习语？我想要的东西是不可能的吗？

Answer 1

最简单的就是使用模块级封装。像这样的：

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

如此处所见，您可以使用 Game 可以在 Game 模块内执行 IO 的事实，而无需将此事实暴露给世界其他地方，仅暴露您认为的 IO 的位“安全的”。特别是，您不会将Game 设为MonadIO 的实例（也不能将其设为MonadTrans 的实例，因为它的类型错误）。而且io函数和Game构造函数没有导出，所以用户不能这样拉结束运行。

Answer 2

Monad 尤其是 monad 转换器 come from trying to build complicated programs out of simpler pieces。新职责的额外转换器是在 Haskell 中处理此问题的惯用方式。

处理变压器堆栈的方法不止一种。由于您已经在代码中使用了mtl，因此我假设您对选择用于穿透转换器堆栈的类型类感到满意。

下面给出的例子对于玩具问题来说完全是矫枉过正。整个示例非常庞大 - 它展示了如何从以多种不同方式定义的 monad 组合在一起 - 就 IO 而言，就RWST 之类的转换器而言，以及就来自函子的免费 monad 而言。

一个界面

我喜欢完整的示例，因此我们将从游戏引擎的完整界面开始。这将是一小部分类型类，每个类型类代表游戏引擎的一项职责。最终目标是提供以下类型的函数

{-# LANGUAGE RankNTypes #-}

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

只要MonadGame 不包含MonadIO，runGame 的用户通常就不能使用IO。我们仍然可以导出我们所有的底层类型并编写像MonadIO 这样的实例，并且库的用户仍然可以确定他们没有犯错，只要他们通过runGame 进入库。这里介绍的类型类实际上是same as a free monad, and you don't have to choose between them。

如果您出于某种原因不喜欢 rank 2 类型或免费 monad，则可以创建一个没有 MonadIO 实例的新类型，而不是像 Daniel Wagner's answer 那样导出构造函数。

我们的界面将包含四个类型类 - MonadGameState 用于处理状态，MonadGameResource 用于处理资源，MonadGameDraw 用于绘图，以及一个总体的 MonadGame 包括所有其他三个以方便使用。

MonadGameState 是来自Control.Monad.RWS.Class 的MonadRWS 的更简单版本。定义我们自己的类的唯一原因是MonadRWS 仍然可供其他人使用。 MonadGameState 需要游戏配置的数据类型，它如何输出要绘制的数据，以及维护的状态。

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

通过返回一个操作来处​​理资源，如果资源已加载，该操作可以稍后运行以获取资源。

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

我将向游戏引擎添加另一个问题，并消除对(TimeStep -> a -> Game a) 的需求。我的界面不是通过返回值来绘制，而是通过显式请求来绘制。 draw 的返回将告诉我们TimeStep。

data TimeStep = TimeStep

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

最后，MonadGame 将需要其他三个类型类的实例。

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

转换器的默认定义

为monad transformers 提供所有四个类型类的默认定义很容易。我们会将defaults 添加到所有三个类中。

{-# 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

我知道我打算使用RWST 表示状态，IdentityT 表示资源，FreeT 表示绘图，所以我们现在将为所有这些转换器提供实例。

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)

游戏状态

我们计划从RWST 构建游戏状态，因此我们将GameT 制作为newtype 为RWST。这允许我们附加我们自己的实例，例如MonadGameState。我们将使用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)

我们还将提供MonadGameResource 的可分解实例和等效于runRWST 的便利函数

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

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

这让我们开始提供MonadGameState，它只是将所有内容传递给RWST。

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

如果我们只是将MonadGameState 添加到已经为资源和绘图提供支持的东西上，我们就创建了一个MonadGame。

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

资源处理

我们可以使用IO 和MVars 处理资源，就像jcast's answer 一样。我们将制作一个转换器，以便我们有一个类型可以将MonadGameResource 的实例附加到。这完全是矫枉过正。为了增加过度杀伤力，我要去newType IdentityT 只是为了得到它的MonadTrans 实例。我们将推导出我们所能得到的一切。

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

我们将为MonadGameResource 添加一个实例。这与其他答案完全相同。

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)

如果我们只是将资源处理添加到已经支持绘图和状态的东西，我们有一个MonadGame

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

绘图

就像 Gabriel Gonzales 指出的那样，“你可以purify any IO interface mechanically”。我们将使用这个技巧来实现MonadGameDraw。唯一的绘图操作是到Draw 用函数从TimeStep 到下一步做什么。

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

结合免费的 monad 转换器，这是我用来消除对 (TimeStep -> a -> Game a) 需求的技巧。我们的DrawT 转换器将绘图责任添加到带有FreeT DrawF 的monad。

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)

我们将再次为MonadGameResource 和另一个便利函数定义默认实例。

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

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

MonadGameDraw 实例表示我们需要Free (Draw next)，其中next 要做的是return TimeStamp。

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

如果我们只是将绘图添加到已经处理状态和资源的东西，我们有一个MonadGame

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

游戏引擎

绘图和游戏状态相互影响——当我们绘图时，我们需要从RWST 获取输出以知道要绘制什么。如果GameT 直接在DrawT 之下，这很容易做到。我们的玩具循环非常简单；它绘制输出并从输入中读取行。

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)

由此我们可以通过添加GameResourceT 来定义在IO 中运行游戏。

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

最后，我们可以用我们一开始就想要的签名写runGame。

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

示例

此示例在 5 秒后请求最后一个输入的反转，并显示每帧有可用数据的所有内容。

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

Answer 3

您可能想查找MVars：http://hackage.haskell.org/package/base-4.7.0.1/docs/Control-Concurrent-MVar.html。

tryReadMVar :: MVar a -> IO (Maybe a)

给你你的ResourceRequest，并且

putMVar :: MVar a -> a -> IO ()

可用于在线程末尾按下结果。类似的东西（忽略新类型等）：

requestResourceImpl :: IO a -> IO (IO (Maybe a))
requestResourceImpl a = do
    mv <- newEmptyMVar
    forkIO $ do
        x <- a
        putMVar mv x
    return $ tryReadMVar mv

这不处理a 抛出异常等的情况；如果a 确实引发异常，则生成的ResourceRequest 将永远不会报告资源可用。

我强烈建议将GameMonad 设为抽象类型。您可以将其设为newtype（如有必要，您可以添加deriving MonadReader 等）。然后你不导出它的构造函数；而是定义像requestResource 这样的抽象操作并导出它们。