MonadBaseControl: как поднять simpleHTTP из Happstack?

Я не думаю, что вы можете поднять это вообще для любого MonadBaseControl IO m. Есть несколько m, для которых мы можем.

В целом

UnWebT m изоморфен WebT m с MonadTransControl экземпляр. Вы можете конвертировать в WebT и обратно с помощью mkWebT :: UnWebT m a -> WebT m a и ununWebT :: WebT m a -> UnWebT m a.

MonadBaseControl — это причудливая обертка вокруг стека из MonadTransControl преобразователей, которая сглаживает стек, так что состояние выполнения и восстановления происходит на всем пути вниз по стеку и обратно на всем пути вверх. Вы можете понять MonadBaseControl, поняв MonadTransControl, что я кратко повторю здесь:

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)

Класс говорит с liftWith: «Я предоставлю временный способ запуска t ms в m, который вы можете использовать для создания действий в m, которые я, в свою очередь, запущу». Тип результата StT говорит: «Результаты t m вещей, которые я выполняю в m для вас, не будут общедоступными в t m; мне нужно где-то сохранить свое состояние, и вы должны дать мне возможность восстановить мое состояние, если вам нужны результаты».

Другой способ сказать примерно то же самое: «Я могу временно развернуть базовую монаду». Вопрос реализации fixTypes сводится к «Учитывая, что мы можем временно развернуть WebT из m и можем временно развернуть m из IO, можем ли мы навсегда развернуть m из IO?» для которого ответ, за исключением возможностей IO, почти наверняка "нет".

IO трюки

Я подозреваю, что существуют m, такие, что "уродливый" fixTypes будет делать ужасные вещи, например, никогда не вызывать writeIORef и, таким образом, возвращать undefined или выполнять код асинхронно и, следовательно, вызывать writeIORef после readIORef. Я не уверен. Это усложняется из-за возможности того, что действие, созданное liftBaseWith, никогда не используется в таких вырожденных случаях.

Комонады

Должен быть способ поднять simpleHttp без IO уловок именно тогда, когда состояние монады 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)
    )

На практике это не очень полезно, потому что newtypes, определенные в более старых версиях monad-control, не имеют экземпляров Comonad, а синонимы типов в более новых версиях monad-control не прилагают усилий, чтобы результат был последним аргументом типа. . Например, в новейшей версии monad-control type StT (StateT s) a = (a, s).