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.
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) .
Related
I have trouble even explaining what I'm trying to do, please bear with me. I haven't really grasped type theory, or how to use forall so that is probably the reason why wording (and implementing) this is difficult for me. So basically I'm trying to replicate the behaviour of MonadIO with a MonadTransformer. MonadIO is defined as
class (Monad m) => MonadIO m where
-- | Lift a computation from the 'IO' monad.
liftIO :: IO a -> m a
-- | #since 4.9.0.0
instance MonadIO IO where
liftIO = id
This code compiles (I haven't included the Applicative and Functor instances here though, but I can):
newtype Debugable m r = Debugable { runDebugable :: (DebugState -> m (DebugState, r)) }
instance MonadTrans (Debugable) where
lift action = Debugable $ \d -> do
r <- action
return (d, r)
class (Monad i, Monad m) => MonadDebug i m where
liftDebug :: Debugable i a -> m a
instance (Monad m) => MonadDebug m (Debugable m) where
liftDebug = id
I want to write a method like this, that should work in any MonadTransformer above MonadDebug in the transformer stack:
debug :: (MonadDebug i m) => String -> m ()
debug msg = liftDebug $ doDebug msg
(doDebug operates in the Debugable monad)
Of course this does not compile because the type variable i cannot be deduced (or something like that)... I tried a few things, but I don't really understand what the debug messages mean either. I don't even know if a generalized lifting of a MonadTransformer similar to liftIO is possible... Is it?
I suggest changing your goal slightly.
The idiomatic way to make this class is to expose all of the base transformer's operations as class methods, rather than exposing a lifting transformation. Like this:
class Monad m => MonadDebugable m where
debug :: (DebugState -> (DebugState, r)) -> m r
instance Monad m => MonadDebugable (Debugable m) where
debug f = Debugable (pure . f)
instance MonadDebugable m => MonadDebugable (ReaderT r m) where
debug = lift . debug
-- and a dozen other instances for other transformers
Then you can offer derived operations, like, say,
observeCurrentState :: MonadDebugable m => m DebugState
observeCurrentState = debug (\s -> (s, s))
recordState :: MonadDebugable m => DebugState -> m ()
recordState s = debug (\_ -> (s, ()))
debugMsg :: MonadDebugable m => String -> m ()
debugMsg msg = debug (\s -> (s { messages = msg : messages s }, ())) -- or whatever
Then, in all your client code, where you would originally have written liftDebug foo, you simply write foo (but using operations like those above that are polymorphic over which exact monad stack you're using at the moment).
Of course, the obvious follow-up question is: what's the deal with MonadIO, then? Why doesn't IO follow this pattern? The answer there is that IO just has too many primitive operations to write a sensible class -- indeed, with the FFI, it's even possible for libraries and users to add new primitives. So we have to go with the slightly less desirable solution there, where we must annotate all our primitive calls with liftIO if we're not exactly in IO already. Skipping the annotations, like above, would be nicer, but we just can't have it.
I'm pulling together code from a number of different places, and I'm trying to deal with the following:
Problem
I have a transformer stack with the following simplified type:
action :: m (ReaderT r IO) a
and I'm trying to use the action in the context of a different stack, which has a different reader environment:
desired :: m (ReaderT r' IO) a
I can of course provide
f :: r' -> r
Example
things :: m (ReaderT r' IO) ()
things = do
-- ... some stuff
-- <want to use action here>
action :: m (ReaderT r IO) a -- broken
-- ... more stuff
pure ()
What I've considered
withReaderT :: (r' -> r) -> ReaderT r m a -> ReaderT r' m a
This has the problem that ReaderT is the outer monad, whilst I want to use it on an inner one.
I've also considered that this might be related to MonadBase or MonadTransControl, but I'm not familiar with their workings.
I don't think it's possible to write a function with signature:
changeReaderT :: (MonadTrans m)
=> (r -> r')
-> m (ReaderT r IO) a
-> m (ReaderT r' IO) a
the issue being that the only operation possible, in general, on the second argument is lifting it to t (m (ReaderT r IO)) a for some monad transformer t, which doesn't buy you anything.
That is, the MonadTrans m constraint alone doesn't provide enough structure to do what you want. You either need m to be an instance of a typeclass like MFunctor in the mmorph package that allows you to modify an inner layer of the monad stack in a general way by providing a function like:
hoist :: Monad m => (forall a. m a -> n a) -> t m b -> t n b
(which is what #Juan Pablo Santos was saying), or else you need an ability to dig into the structure of your m monad transformer to partially run and rebuild it (which will be transformer-specific).
The first approach (using hoist from the mmorph package) will be most convenient if your m is already made up of transformers supported by the mmorph package. For example, the following typechecks, and you don't have to write any instances:
type M n = MaybeT (StateT String n)
action :: M (ReaderT Double IO) a
action = undefined
f :: Int -> Double
f = fromIntegral
desired :: M (ReaderT Int IO) a
desired = (hoist $ hoist $ withReaderT fromIntegral) action
You'll need a hoist for each layer in M.
The second approach avoids hoist and requisite MFunctor instances but requires tailoring to your specific M. For the above type , it looks something like:
desired' :: M (ReaderT Int IO) a
desired' = MaybeT $ StateT $ \s ->
(withReaderT fromIntegral . flip runStateT s . runMaybeT) action
You basically need to run the monad down to the ReaderT layer and then rebuild it back up, treating layers like StateT with care. This is exactly what the MFunctor instances in mmorph are doing automatically.
In threads package in module Control.Concurrent.Thread.Group there is a function forkIO:
forkIO :: ThreadGroup -> IO α -> IO (ThreadId, IO (Result α))
I'd like to lift it using MonadBaseControl from monad-control. Here is my attempt:
fork :: (MonadBase IO m) => TG.ThreadGroup -> m α -> m (ThreadId, m (Result α))
fork tg action = control (\runInBase -> TG.forkIO tg (runInBase action))
and here is the error messsage:
Couldn't match type `(ThreadId, IO (Result (StM m α)))'
with `StM m (ThreadId, m (Result α))'
Expected type: IO (StM m (ThreadId, m (Result α)))
Actual type: IO (ThreadId, IO (Result (StM m α)))
In the return type of a call of `TG.forkIO'
In the expression: TG.forkIO tg (runInBase action)
In the first argument of `control', namely
`(\ runInBase -> TG.forkIO tg (runInBase action))'
What to change to make the types match?
The main problem is the IO a argument to forkIO. To fork an m a action in IO we'd need a way to run an m a to an IO a. To do this, we could try to make the class of monads that have a runBase :: MonadBase b m => m a -> b a method, but very few interesting transformers can provide that. If we consider for example the StateT transformer, it could figure out how to run something in the base monad with runStateT if it's first given an opportunity to observe its own state.
runFork :: Monad m => StateT s m a -> StateT s m (m b)
runFork x = do
s <- get
return $ do
(a, s') <- runStateT x s
return a
This suggests the type runForkBase :: MonadBase b m => m a -> m (b a), which we will settle on for the following type class.
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
import Control.Monad.Base
class (MonadBase b m) => MonadRunForkBase b m | m -> b where
runForkBase :: m a -> m (b a)
I added the word Fork to the name to emphasize that the future state changes will not in general be shared between the two futures. For this reason, the few interesting transformers like WriterT that could have provided a runBase only provide an uninteresting runBase; they produce side effects that will never be observable.
We can write something like fork for anything with the limited form of lowering provided by a MonadRunForkBase IO m instance. I'm going to lift the normal forkIO from base rather than the one from threads, which you can do the same way.
{-# LANGUAGE FlexibleContexts #-}
import Control.Concurrent
forkInIO :: (MonadRunForkBase IO m) => m () -> m ThreadId
forkInIO action = runForkBase action >>= liftBase . forkIO
Instances
This raises the question, "What transformers can we provide MonadRunForkBase instances for"? Straight off the bat, we can trivially provide them for any of the base monads that have MonadBase instances
import Control.Monad.Trans.Identity
import GHC.Conc.Sync (STM)
instance MonadRunForkBase [] [] where runForkBase = return
instance MonadRunForkBase IO IO where runForkBase = return
instance MonadRunForkBase STM STM where runForkBase = return
instance MonadRunForkBase Maybe Maybe where runForkBase = return
instance MonadRunForkBase Identity Identity where runForkBase = return
For transformers, it's usually easier to build up functionality like this step-by-step. Here's the class of transformers that can run a fork in the immediately underlying monad.
import Control.Monad.Trans.Class
class (MonadTrans t) => MonadTransRunFork t where
runFork :: Monad m => t m a -> t m (m a)
We can provide a default implementation for running all the way down in the base
runForkBaseDefault :: (Monad (t m), MonadTransRunFork t, MonadRunForkBase b m) =>
t m a -> t m (b a)
runForkBaseDefault = (>>= lift . runForkBase) . runFork
This lets us complete out a MonadRunForkBase instance for StateT in two steps. First, we'll use our runFork from above to make a MonadTransRunFork instance
import Control.Monad
import qualified Control.Monad.Trans.State.Lazy as State
instance MonadTransRunFork (State.StateT s) where
runFork x = State.get >>= return . liftM fst . State.runStateT x
Then we'll use the default to provide a MonadRunForkBase instance.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
instance (MonadRunForkBase b m) => MonadRunForkBase b (State.StateT s m) where
runForkBase = runForkBaseDefault
We can do the same thing for RWS
import qualified Control.Monad.Trans.RWS.Lazy as RWS
instance (Monoid w) => MonadTransRunFork (RWS.RWST r w s) where
runFork x = do
r <- RWS.ask
s <- RWS.get
return $ do
(a, s', w') <- RWS.runRWST x r s
return a
instance (MonadRunForkBase b m, Monoid w) => MonadRunForkBase b (RWS.RWST r w s m) where
runForkBase = runForkBaseDefault
MonadBaseControl
Unlike MonadRunForkBase which we developed in the previous two sections, the MonadBaseControl from monad-control doesn't have baked in the assumption "future state changes will not in general be shared between the two futures". MonadBaseContol and control make an effort to restore the state from branching in control structures with restoreM :: StM m a -> m a. This doesn't present a problem for the forkIO from base; using forkIO is an example provided in the MonadBaseControl documentation. This will be a slight problem for the forkIO from threads because of the extra m (Result a) returned.
The m (Result a) we want will actually be returned as an IO (Result (StM m a)). We can get rid of the IO and replace it with an m with liftBase, leaving us with m (Result (StM m a)). We could convert an StM m a into an m a that restores state and then returns a with restoreM, but it is stuck inside a Result ~ Either SomeException. Either l is a functor, so we can apply restoreM everywhere inside it, simplifying the type to m (Result (m a)). Either l is also Traversable, and for any Traversable t we can always swap it inside a Monad or Applicative with sequenceA :: t (f a) -> f (t a). In this case, we can use the special purpose mapM which is a combination of fmap and sequenceA with only a Monad constraint. This would give m (m (Result a)), and the ms would be flattened together by a join in the Monad or simply using >>=. This gives rise to
{-# LANGUAGE FlexibleContexts #-}
import Control.Concurrent
import Control.Concurrent.Thread
import qualified Control.Concurrent.Thread.Group as TG
import Control.Monad.Base
import Control.Monad.Trans.Control
import Data.Functor
import Data.Traversable
import Prelude hiding (mapM)
fork :: (MonadBaseControl IO m) =>
TG.ThreadGroup -> m a -> m (ThreadId, m (Result a))
fork tg action = do
(tid, r) <- liftBaseWith (\runInBase -> TG.forkIO tg (runInBase action))
return (tid, liftBase r >>= mapM restoreM)
When we run the m (Result a) in the original thread, it will copy the state from the forked thread to the original thread, which may be useful. If you want to restore the state of the main thread after reading the Result you'll need to capture it first. checkpoint will capture the entire state and return an action to restore it.
checkpoint :: MonadBaseControl b m => m (m ())
checkpoint = liftBaseWith (\runInBase -> runInBase (return ()))
>>= return . restoreM
A complete example will show what happens to the state from two threads. Both threads get the state from when the fork happened regardless of efforts to modify the state in the other thread. When we wait for the result in the main thread, the state in the main thread is set to the state from the forked thread. We can get the main thread's state back by running the action created by checkpoint.
import Control.Monad.State hiding (mapM)
example :: (MonadState String m, MonadBase IO m, MonadBaseControl IO m) => m ()
example = do
get >>= liftBase . putStrLn
tg <- liftBase TG.new
(_, getResult) <- fork tg (get >>= put . ("In Fork:" ++) >> return 7)
get >>= put . ("In Main:" ++)
revert <- checkpoint
result <- getResult
(liftBase . print) result
get >>= liftBase . putStrLn
revert
get >>= liftBase . putStrLn
main = do
runStateT example "Initial"
return ()
This outputs
Initial
Right 7
In Fork:Initial
In Main:Initial
I am not sure how to formulate this question scientifically exact, so I am just going to show you an example.
I am using state in a StateT transformer. Underlying is IO. Inside the StateT IO operation I need to use alloca. However, I can't lift alloca to StateT IO because it expects an argument of type (Ptr a -> IO a) while I require it to work with an argument of (Ptr a -> StateT IO MyState a).
(However, this is a generic question about monad transformers rather than specific to IO, StateT or alloca.)
I came up with the following, working solution:
-- for reference
-- alloca :: (Storable a) => (Ptr a -> IO b) -> IO b
allocaS :: (Storable a) => (Ptr a -> StateT s IO b) -> StateT s IO b
allocaS f = do
state <- get
(res, st) <- liftIO $ alloca $ \ptr -> (runStateT (f ptr) state)
put st
return res
However, it seems wrong to me that I should have to de- and reconstruct the StateT action in order to use it with alloca. Also, I have seen this pattern in some variations more than once and it's not always as simple and safe as here with StateT.
Is there a better way to do this?
This can be accomplished using MonadBaseControl in monad-control, which has been devised exactly for this purpose:
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad
import Control.Monad.Trans.Control
import qualified Foreign.Ptr as F
import qualified Foreign.Marshal.Alloc as F
import qualified Foreign.Storable as F
alloca :: (MonadBaseControl IO m, F.Storable a) => (F.Ptr a -> m b) -> m b
alloca f = control $ \runInIO -> F.alloca (runInIO . f)
This enhanced version of alloca can be used with any monad stack based on IO that implements MonadBaseControl, including StateT s IO.
Instances of MonadBaseControl allow their monadic values to be encoded in the base monad (here IO), passed to a function in the base monad (like F.alloca) and then reconstruct them back.
See also What is MonadBaseControl for?
Package lifted-base contains many of the standard IO functions lifted to MonadBaseControl IO, but alloca isn't (yet) among them.
Good afternoon,
AFAIK, there is no general way to turn a function of type (a -> m b) -> m b into (a -> t m b) -> t m b because that would imply the existence of a function of type MonadTrans t => (a -> t m b) -> (a -> m b).
Such a function cannot possibly exist, since most transformers cannot be stripped so easily from a type signature (how do you turn a MaybeT m a into an m a for all a ?). Hence, the most general way to turn (a -> m b) -> m b to (a -> t m b) -> t m b is undefined.
In the case of StateT s m, there is a loophole that allows you to define it anyway. Since StateT s m a === s -> m (s,a), we can rewrite the type equation to :
(a -> StateT s m b) -> StateT s m b
=== (a -> s -> m (s,b)) -> s -> m (s,b)
=== s -> (s -> (a -> m (s,b)) -> m (s,b) -- we reorder curried arguments
=== s -> (s -> (A -> m B)) -> m B -- where A = a, B = (s,b)
Solving this new type signature is now trivial :
liftedState f s run = f (run s)
allocaS :: Storable a => (Ptr a -> StateT IO b) -> StateT IO b
allocaS = isomorphic (liftedState alloca)
That is about the best we can do in terms of code reuse, short of defining a new subclass of MonadTrans for all monads that exhibit the same behaviour.
I hope I made myself clear enough (I didn't want to go into too much detail for fear of being confusing)
Have an excellent day :-)
I am new to Haskell. I wrote my own monad which is the State monad with error handling:
newtype MyMonad a = MyMonad (State -> Either MyError (State, a))
I use it in an interpreter of a small language. Now I want to add some IO operations to my language (reading/writing), but I don't know how to enclose IO monad inside mine. I know I could combine ErrorT, StateT, IO and achieve this result but is there other way to do it without them?
You can look at how StateT is implemented:
newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }
To combine state with IO you just put IO in place of m and get the desired type: s -> IO (a,s).
If you have errors too, this becomes something like s -> IO (Either e (a, s)) or s -> IO (Either e a, s) depending on whether you want the failed computations to affect state.
Note that you can't make s -> Either e (IO (a, s)) a monad without a time machine.
Update
It turns out you can't make it a monad even with time machine.
To show why it is impossible, let us simplify our monad by using () instead of s first: data M e a = M { runM :: Either e (IO a) }
Now, imagine the following program:
unsafePerformIO :: IO a -> a
unsafePerformIO io = fromLeft $ runM $ do
a <- M $ Right $ io
M $ Left a
Obviously, this function is impossible and thus the monad instance for M is impossible too.
What time machine could give you is the ability to treat IO exactly like one treats State. However, I didn't realise that Either e (s -> (a, s)) is not a monad.