CODEWITHSUNDEEP
haskellmonadsmonad-transformers
Gracjan Polak
Gracjan Polak

Reputation: 596

MonadBaseControl: how to lift simpleHTTP from Happstack?

How to use MonadBaseControl from monad-control to lift simpleHTTP function defined in happstack-server?

Current type of simpleHTTP:

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

Expected type of simpleHTTPLifted:

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

My current attempt (does not compile):

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

Note that similar puzzle is in my related question: MonadBaseControl: how to lift ThreadGroup

I'd like to understand how to in general lift such functions and what are usual steps taken when presented with such a type puzzle?

EDIT: I guess I need a function of type (StM m a -> a). restoreM is pretty close, but does not make it. I've also found an ugly version of fixTypes:

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

This relies on IO being the base monad which is not an optimal solution.

Upvotes: 3

Views: 130

Answers (1)

Cirdec
Cirdec

Reputation: 24166

I don't think you can lift this in general for any MonadBaseControl IO m. There are some ms for which we can.

In General

UnWebT m is isomorphic to WebT m which has a MonadTransControl instance. You can convert to and from WebT with mkWebT :: UnWebT m a -> WebT m a and ununWebT :: WebT m a -> UnWebT m a.

MonadBaseControl is a fancy wrapper around a stack of MonadTransControl transformers that flattens the stack so that running and restoring state happens all the way down the stack and all the way back up it again. You can understand MonadBaseControl by understanding MonadTransControl, which I'll repeat briefly here:

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)

The class says with 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." The StT type of the result says, "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."

Another way of saying approximately the same thing is, "I can temporarily unwrap the base monad". The question of implementing fixTypes is reduced to "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?" for which the answer, barring the capabilities of IO, is almost certainly "no".

IO Tricks

I suspect that there exist ms such that the "ugly" fixTypes will do horrible things like never call writeIORef and thus return undefined or execute code asynchronously and therefore call writeIORef after readIORef. I'm not sure. This is made complicated to reason about due to the possibility that the action created by liftBaseWith is never used in such degenerate cases.

For Comonads

There should be a way to lift simpleHttp without IO tricks precisely when the state of the monad m is a Comonad and therefore has a function extract :: StM m a -> a. For example, this would be the case for StateT s m which essentially has 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)
    )

In practice this isn't very useful because the newtypes defined in the older versions of monad-control don't have Comonad instances and the type synonymns in the newer versions of monad-control make no effort to have the result as the last type argument. For example, in the newest version of monad-control type StT (StateT s) a = (a, s) .

Upvotes: 1

Related Questions