MonadBaseControl:如何从 Happstack 中提取 simpleHTTP?

MonadBaseControl: how to lift simpleHTTP from Happstack?

如何使用MonadBaseControl from monad-control to lift simpleHTTP function defined in happstack-server?

simpleHTTP的当前类型:

simpleHTTP :: ToMessage a 
           => Conf -> ServerPartT IO a -> IO () 

simpleHTTPLifted 的预期类型:

simpleHTTPLifted :: (MonadBaseControl IO m, ToMessage a)
                 => Conf -> ServerPartT m a -> m ()

我目前的尝试(不编译):

simpleHTTPLifted conf action =
   liftBaseWith (\runInBase ->
              let
                  fixTypes :: UnWebT m a -> UnWebT IO a
                  fixTypes c = runInBase c
              in simpleHTTP conf (mapServerPartT fixTypes action)
           )

请注意,我的相关问题中有类似的谜题:MonadBaseControl: how to lift ThreadGroup

我想了解一般情况下如何解除此类功能以及遇到此类难题时通常采取的步骤是什么?

编辑:我想我需要一个 (StM m a -> a) 类型的函数。 restoreM 非常接近,但没有成功。我还发现了 fixTypes:

的丑陋版本
fixTypes :: UnWebT m a -> UnWebT IO a
fixTypes c = do
    x <- newIORef undefined
    _ <- runInBase (c >>= liftBase . writeIORef x)
    readIORef x

这依赖于 IO 作为基础 monad,这不是最佳解决方案。

我认为您一般无法解除任何 MonadBaseControl IO m。有一些 m 是我们可以做到的。

一般

UnWebT mWebT m which has a MonadTransControl 实例同构。您可以使用 mkWebT :: UnWebT m a -> WebT m aununWebT :: WebT m a -> UnWebT m a.

WebT 相互转换

MonadBaseControl 是围绕一堆 MonadTransControl 变换器的奇特包装器,它使堆栈变平,以便 运行 和恢复状态一直发生在堆栈中并一直返回再顶一下理解MonadTransControl就可以理解MonadBaseControl,我在这里简单重复一下:

class MonadTrans t => MonadTransControl t where
  data StT t :: * -> *
  liftWith :: Monad m => (Run t -> m a) -> t m a
  restoreT :: Monad m => m (StT t a) -> t m a

type Run t = forall n b. Monad n => t n b -> n (StT t b)

class和liftWith表示,"I'll provide a temporary way to run t ms in m, which you can use to build actions in m, which I will in turn run."结果的StT类型表示,"the results of the t m things I run in m for you aren't going to be generally available in t m; I need to save my state somewhere, and you have to give me a chance to restore my state if you want the results."

另一种说法大致相同的是,"I can temporarily unwrap the base monad"。实施 fixTypes 的问题被简化为 "Given that we can temporarily unwrap a WebT from an m and can temporarily unwrap an m from IO, can we permanently unwrap an m from an IO?",除了 IO 的能力,答案几乎肯定是 "no".

IO 技巧

我怀疑存在 m 使得 "ugly" fixTypes 会做一些可怕的事情,比如从不调用 writeIORef,因此 return undefined 或异步执行代码,因此在 readIORef 之后调用 writeIORef。我不确定。由于 liftBaseWith 创建的操作可能永远不会在这种退化的情况下使用,这使得推理变得复杂。

对于 Comonads

当 monad m 的状态是 Comonad 并且因此具有函数 extract :: StM m a -> a。例如,StateT s m 就是这种情况,它本质上具有 StM s a ~ (s, a).

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Happstack.Server.SimpleHTTP

import Control.Comonad
import Control.Monad.Base
import Control.Monad.Trans.Control

simpleHTTPLifted :: forall m a. (MonadBaseControl IO m, Comonad (StM m), ToMessage a)
                 => Conf -> ServerPartT m a -> m ()
simpleHTTPLifted conf action =
    liftBaseWith (\runInBase ->
        let
            fixTypes :: UnWebT m b -> UnWebT IO b
            fixTypes = fmap extract . runInBase
        in simpleHTTP conf (mapServerPartT fixTypes action)
    )

在实践中这不是很有用,因为在旧版本的 monad-control 中定义的 newtypes 没有 Comonad 实例,并且在新版本的 monad 中没有类型同义词-control 不努力将结果作为最后一个类型参数。例如,在最新版本的 monad-control type StT (StateT s) a = (a, s) .