Как вставлять результат действия ввода-вывода в моноидальное вычисление без ввода-вывода

У меня небольшая часть архитектурной проблемы, для которой я хотел бы увидеть, есть ли общий шаблон или абстракция, которые могут мне помочь. Я писал игровой движок, где пользователь может указать игровой цикл как монадическое вычисление формы:

gameLoop :: TimeStep -> a -> Game a

где монада Game имеет кучу точек доступа для рисования, преобразования и взаимодействия с движком в целом. Затем я также предоставляю функцию, которую пользователь вызывает для запуска моделирования

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 и обратно пользователю. Основная цель будет заключаться в том, что я решаю, когда происходит действие IO - где-то, что я ожидаю, а не в середине игрового цикла.

Одна из идей, которую я имел в виду, заключалась в том, чтобы разместить другой пользовательский трансформатор монады поверх монады Game... что-то вроде

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

Однако я считаю, что тогда указание вещей в терминах f :: ResourceT r Game a становится кошмаром API, так как мне придется поддерживать любую возможную комбинацию стеков трансформаторов монады. В идеале я также хотел бы избежать создания Game полиморфного в r, поскольку это увеличило бы многословие и переносимость базовых функций Game.

Есть ли у Haskell какие-либо абстракции или идиомы для чего-то вроде этого шаблона программирования? Я не хочу, чтобы это было невозможно?

ОТВЕТЫ

Ответ 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 может выполнять IO в модуле Game, не подвергая этот факт остальному миру, подвергая только биты IO, которые вы считаете "безопасно". В частности, вы бы не сделали Game экземпляр MonadIO (и он не может быть экземпляром MonadTrans, поскольку он имеет неправильный вид). Более того, функция IO и конструктор Game не экспортируются, поэтому пользователь не может выполнить конечный результат таким образом.

Ответ 2

Монады и особенно монадные трансформаторы исходят из попыток построить сложные программы из более простых частей. Дополнительным трансформатором для новой ответственности является идиоматический способ решения этой проблемы в Haskell.

Есть более чем один способ справиться со стеками трансформаторов. Поскольку вы уже используете mtl в своем коде, я предполагаю, что вам удобно выбирать типы стеков для проникновения в стек трансформатора.

Приведенные ниже примеры являются полным избытком для игрушечной проблемы. Весь этот пример огромен - он показывает, как части могут объединяться из монадов, определенных разными способами - с точки зрения IO с точки зрения трансформатора типа RWST и с точки зрения свободной монады от функтора.

Интерфейс

Мне нравятся полные примеры, поэтому мы начнем с полного интерфейса для игрового движка. Это будет небольшая коллекция типов, каждая из которых несет ответственность за игровой движок. Конечной целью будет предоставление функции следующего типа

{-# LANGUAGE RankNTypes #-}

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

Пока MonadGame не включает MonadIO, пользователь runGame не может использовать IO вообще. Мы все еще можем экспортировать все наши базовые типы и писать экземпляры, такие как MonadIO, и пользователь библиотеки может быть уверен, что они не допустили ошибку, пока они входят в библиотеку через runGame. Представленные здесь стили, на самом деле, являются такими же, как и свободная монада, и вам не нужно выбирать между ними.

Если по какой-то причине вам не нравится ни тип ранга 2, ни свободная монада, вы можете вместо этого создать новый тип без экземпляра 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))

Я собираюсь добавить еще одну проблему в игровой движок и устранить необходимость в (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

Определения по умолчанию для трансформаторов

Легко предоставить определение по умолчанию для всех четырех типов классов для монадных трансформаторов. Мы добавим 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 a 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 answer. Мы сделаем трансформатор именно так, чтобы у нас был тип, который должен был присоединить экземпляр для MonadGameResource to. Это полный перебор. Чтобы добавить overkill to overkill, я собираюсь 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)

Рисование

Как сказал Габриэль Гонсалес, "вы можете механически очистить любой интерфейс ввода-вывода" Мы будем использовать этот трюк для реализации MonadGameDraw. Единственная операция рисования - draw с функцией из TimeStep в следующую.

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

В сочетании со свободным трансформатором монады, это трюк, который я использую, чтобы устранить необходимость в (TimeStep -> a -> Game a). Наш трансформатор DrawT, который добавляет ответственность за привлечение к монаде с помощью 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

Ответ 3

Вы, вероятно, захотите найти MVar s: 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 ()

может использоваться для нажатия результата в конце потока. Что-то вроде (игнорируя newtypes и т.д.):

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, и экспортируйте их вместо этого.