我有一点建筑问题，我想看看是否有一个可以帮助我的常见模式或抽象。我 写一个游戏引擎 用户可以将游戏循环指定为表单的monadic计算：
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动作 - 我希望它在某个地方，而不是在游戏循环的中间。
我想到的一个想法是在其上放置另一个用户定义的monad变换器 Game monad ...类似的东西
newtype ResourceT r m a = ResourceT (StateT [ResourceRequest r] m a)
但是，我相信那时用的是指定的东西 f :: ResourceT r Game a 成为API的噩梦，因为我必须支持任何可能的monad变换器堆栈组合。理想情况下，我也想避免制作 Game 多态性 r，因为它会增加底层的冗长和可移植性 Game 功能也是如此。
Haskell有没有像这种编程模式这样的抽象或习语？是我想要的不可能吗？
Monads尤其是monad变形金刚 来自于试图用更简单的部分构建复杂的程序。新职责的额外变换器是在Haskell中处理此问题的惯用方法。
处理变压器堆栈的方法不止一种。既然你已经在使用了 MTL 在你的代码中，我假设你对穿透变压器堆栈的类型类的选择感到满意。
下面给出的例子对于玩具问题是完全矫枉过正的。这整个例子非常庞大 - 它展示了如何通过多种不同方式定义的单子组合在一起 - 就IO而言，就变换器而言 RWST 以及来自仿函数的免费monad。
一个界面
我喜欢完整的示例，因此我们将从游戏引擎的完整界面开始。这将是一个小类集合，每个类型代表游戏引擎的一个责任。最终目标是提供具有以下类型的功能
{-# LANGUAGE RankNTypes #-}
runGame :: (forall m. MonadGame m => m a) -> IO a
只要 MonadGame 不包括 MonadIO 用户 runGame 无法利用 IO 一般来说。我们仍然可以导出所有底层类型并编写实例 MonadIO 并且只要他们进入图书馆，图书馆的用户仍然可以确定他们没有犯错误 runGame。这里提出的类型实际上是 与免费monad相同，你不必在它们之间做出选择。
如果由于某种原因你不喜欢等级2类型或免费的monad，你可以改为创建一个没有的新类型 MonadIO 实例，而不是导出构造函数，如 丹尼尔瓦格纳的回答。
我们的界面将包含四个类型 - MonadGameState 处理状态， MonadGameResource 处理资源， MonadGameDraw 用于绘图和总体而言 MonadGame 其中包括所有其他三个以方便使用。
该 MonadGameState 是一个更简单的版本 MonadRWS 从 Control.Monad.RWS.Class。定义我们自己的类的唯一原因是这样的 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))
我将为游戏引擎添加另一个问题，并消除对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变形金刚。我们会补充一下 default所有三个班级。
{-# 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 和 MVar如在 jcast的回答。我们将制作一个变换器，以便我们有一个类型来附加实例 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)
画画
就像加布里埃尔冈萨雷斯指出的那样，“你可以 机械地净化任何IO接口“我们将使用这个技巧来实现 MonadGameDraw。唯一的绘图操作是 Draw 具有来自的功能 TimeStep 下一步做什么
newtype DrawF next = Draw (TimeStep -> next)
deriving (Functor)
结合免费的monad变换器，这是我用来消除a的需要 (TimeStep -> a -> Game a)。我们的 DrawT 将绘图责任添加到monad的变换器 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)
我们将再次定义默认实例 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)
由此我们可以定义运行游戏 IO 通过增加 GameResourceT。
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