Here is an issue of gluing together monads. Not in a stack form, but in a form of needing to unwrap one monad to run the operation inside another.
Two domains: Weblog and App. But, keep in mind that the App domain will be calling into additional ones in the same way that it currently calls in to Weblog. Both have their own monad stacks. Both keep track of their own state.
newtype WeblogM a = WeblogM (ReaderT Weblog (ErrorT WeblogError IO) a)
deriving (Monad, MonadIO, Reader.MonadReader Weblog, Error.MonadError WeblogError)
newtype AppM a = AppM (ReaderT App (EitherT AppError IO) a)
deriving ( Functor, Applicative, Monad
, MonadReader App, MonadError AppError)
In order to run a WeblogM operation inside of an AppM function, I'm finding that I have to unwrap the WeblogM and rewrap it, using functions like this:
runWeblogHere :: forall a. Weblog.Weblog -> Weblog.WeblogM a -> AppM a
runWeblogHere weblog action =
runIO (left . WeblogError) (Weblog.runWeblog weblog action)
runIO :: (e -> EitherT AppError IO a) -> IO (Either e a) -> AppM a
runIO handler = AppM . lift . handleT handler . EitherT
However, that does leave my actual passthrough operations quite simple:
getPage :: Weblog.PageId -> AppM Weblog.WikiPage
getPage pageid = do
App{weblog} <- ask
runWeblogHere weblog $ Weblog.getWikiPage pageid
This bothers me already because I have other monadic libraries that I already know that I'm going to plug in to the AppM architecture, and I'm worried about writing a runXHere method, which is really boilerplate, for each one of them.
I have a suggestion to create a MonadWeblog class to correspond to WeblogM, in much the same way that MonadReader corresponds to ReaderT. That appeals to me more because I can start isolating the monad glue into my instance of MonadWeblog (or, really, MonadX).
If we ignore the newtypes, and convert both error transformers to ExceptT, the two monads stacks share a similar structure:
import Control.Monad
import Control.Monad.Trans.Except (ExceptT, catchE)
import Control.Monad.Trans.Reader
type M env err r = ReaderT env (ExceptT err IO) r
Using the withReaderT and mapReaderT functions, we we can define:
changeMonad :: (env' -> env)
-> (err -> ExceptT err' IO r)
-> M env err r
-> M env' err' r
changeMonad envLens handler = withReaderT envLens . mapReaderT (flip catchE handler)
Edit: To ease the wrapping and unwrapping of the newtypes, we can make them instances of Wrapped from the lens library, and define a more general conversion function:
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
newtype N1 r = N1 { getN1 :: M (Int,Int) String r }
$(makeWrapped ''N1)
--instance Wrapped (N1 r) where
-- type Unwrapped (N1 r) = M (Int,Int) String r
-- _Wrapped' = iso getN1 N1
newtype N2 r = N2 { getN2 :: M Int Char r }
$(makeWrapped ''N2)
changeMonad' :: (Wrapped (n1 r),
Unwrapped (n1 r) ~ M env' err' r,
Wrapped (n2 r),
Unwrapped (n2 r) ~ M env err r)
=> (env' -> env)
-> (err -> ExceptT err' IO r)
-> n2 r
-> n1 r
changeMonad' envLens handler =
view _Unwrapped' . changeMonad envLens handler . view _Wrapped'
changeN2N1 :: N2 r -> N1 r
changeN2N1 = changeMonad' fst (\c -> throwE [c])
Wrapped is a typeclass that says: "I'm actually a newtype, here's a generic way to add/remove the newtype constructor".
If the lens dependency is too heavy, the newtype package provides similar functionality.
Related
I build a project based on the ReaderT design pattern. Instead of using a typeclass approach for dependency injection, I choose to use simple injection of handlers as function arguments. This part works fine as one is able to construct a dependency tree statically and define an environment dynamically.
The environment may contain configuration as well as a logging effect :: String -> IO (), an effect of time :: IO UTCDate etc. Consider the following minified example
import Control.Monad.Reader (runReaderT, liftIO, reader, MonadReader, MonadIO)
data SomeEnv
= SomeEnv
{ a :: Int
, logger :: String -> IO ()
}
class HasLogger a where
getLogger :: a -> (String -> IO())
instance HasLogger SomeEnv where
getLogger = logger
myFun :: (MonadIO m, MonadReader e m, HasLogger e) => Int -> m Int
myFun x = do
logger <- reader getLogger
liftIO $ logger "I'm going to multiply a number by itself!"
return $ x * x
doIt :: IO Int
doIt = runReaderT (myFun 1337) (SomeEnv 13 putStrLn)
Is it possible to generalize over the effect of the logger?
logger :: String -> m ()
With the motivation to use a logger which fits into the monad stack
myFun x = do
logger <- reader getLogger
logger "I'm going to multiply a number by itself!"
return $ x * x
We could try the following changes:
Parameterize the environment record with the "base" monad.
Make HasLogger a two-parameter typeclass that relates the environment to the "base" monad.
Something like this:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneKindSignatures #-}
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Kind (Constraint, Type)
type RT m = ReaderT (SomeEnv m) m
type SomeEnv :: (Type -> Type) -> Type
data SomeEnv m = SomeEnv
{ a :: Int,
logger :: String -> RT m (),
-- I'm putting the main fuction in the record,
-- perhaps we'll want to inject it into other logic, later.
myFun :: Int -> RT m Int
}
type HasLogger :: Type -> (Type -> Type) -> Constraint
class HasLogger r m | r -> m where
getLogger :: r -> String -> m ()
instance HasLogger (SomeEnv m) (RT m) where
getLogger = logger
_myFun :: (MonadReader e m, HasLogger e m) => Int -> m Int
_myFun x = do
logger <- reader getLogger
logger "I'm going to multiply a number by itself!"
return $ x * x
Now _myFun doesn't have the MonadIO constraint.
We can create a sample environment and run myFun:
env =
SomeEnv
{ a = 13,
logger = liftIO . putStrLn,
myFun = _myFun
}
doIt :: IO Int
doIt = runReaderT (myFun env 1337) env
One disadvantage of this solution is that the function signatures in the environment become more involved, even with the RT type synonym.
Edit: In order to simplify the signatures in the environment, I tried these alternative definitions:
type SomeEnv :: (Type -> Type) -> Type
data SomeEnv m = SomeEnv
{ a :: Int,
logger :: String -> m (), -- no more annoying ReaderT here.
myFun :: Int -> m Int
}
instance HasLogger (SomeEnv m) m where
getLogger = logger
-- Yeah, scary. This newtype seems necessary to avoid an "infinite type" error.
-- Only needs to be defined once. Could we avoid it completely?
type DepT :: ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Type
newtype DepT env m r = DepT { runDepT :: ReaderT (env (DepT env m)) m r }
deriving (Functor,Applicative,Monad,MonadIO,MonadReader (env (DepT env m)))
instance MonadTrans (DepT env) where
lift = DepT . lift
env' :: SomeEnv (DepT SomeEnv IO) -- only the signature changes here
env' =
SomeEnv
{ a = 13,
logger = liftIO . putStrLn,
myFun = _myFun
}
doIt :: IO Int
doIt = runReaderT (runDepT (myFun env' 1337)) env'
DepT is basically a ReaderT, but one aware that its environment is parameterized by DeptT itself. It has the usual instances.
_myFun doesn't need to change in this alternative definition.
I want to summarize some results from applying danidiaz approach.
As my project is currently at a GHC version which does not support the second approach, I've followed the first approach. The application consists out of two sub-applications
a servant application
type RT m = ReaderT (Env m) m
an internal application
type HRT m = CFSM.HouseT (ReaderT (AutomationEnvironment m) m)
the first approach avoids infinite recursive types at the cost of a relation between the monadic stack and the environment.
As the sub-applications use different monadic stacks, specific environment had to be introduced. It seems that this is avoidable by the second approach due to the introduction of DepT.
MonadIO constraints could be removed from functions, for example
mkPostStatusService
:: (MonadIO m, MonadThrow m, MonadReader e m, HasCurrentTime e, HasRandomUUID e)
=> C.InsertStatusRepository m
-> PostStatusService m
became
mkPostStatusService
:: (MonadThrow m, MonadReader e m, HasCurrentTime e m, HasRandomUUID e m)
=> C.InsertStatusRepository m
-> PostStatusService m
Because the environment relates to the application stack, join is the substitute for liftIO
currentTime <- reader getCurrentTime >>= liftIO
-- becomes
currentTime <- join (reader getCurrentTime)
For unit testing, mock environments are constructed. Due to the removal of MonadIO, the mock environment can be constructed without side-effect monads.
An inspection of services which had MonadIO and MonadThrow were previously performed by defining mock environments like
data DummyEnvironment = DummyEnvironment (IO T.UTCTime) (IO U.UUID)
instance HasCurrentTime DummyEnvironment where
getCurrentTime (DummyEnvironment t _) = t
instance HasRandomUUID DummyEnvironment where
getRandomUUID (DummyEnvironment _ u) = u
with the new approach, the side-effects could be remove
type RT = ReaderT DummyEnvironment (CatchT Identity)
data DummyEnvironment = DummyEnvironment (RT T.UTCTime) (RT U.UUID)
instance HasCurrentTime DummyEnvironment RT where
getCurrentTime (DummyEnvironment t _) = t
instance HasRandomUUID DummyEnvironment RT where
getRandomUUID (DummyEnvironment _ u) = u
As I pointed out, the first approach connects the environment to a specific stack, thus the stack defines the environment.
Next step will be integrating the second approach as it seems to decouple the stack from the environment again using DepT.
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.
I'm learning about mtl and I wish learn the proper way to create new monads as modules (not as typical application usage).
As a simple example I have written a ZipperT monad (complete code here):
{-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
module ZipperT (
MonadZipper (..)
, ZipperT
, runZipperT
) where
import Control.Applicative
import Control.Monad.State
class Monad m => MonadZipper a m | m -> a where
pushL :: a -> m ()
pushR :: a -> m ()
...
data ZipperState s = ZipperState { left :: [s], right :: [s] }
newtype ZipperT s m a = ZipperT_ { runZipperT_ :: StateT (ZipperState s) m a }
deriving ( Functor, Applicative
, Monad, MonadIO, MonadTrans
, MonadState (ZipperState s))
instance (Monad m) => MonadZipper s (ZipperT s m) where
pushL x = modify $ \(ZipperState left right) -> ZipperState (x:left) right
pushR x = modify $ \(ZipperState left right) -> ZipperState left (x:right)
...
runZipperT :: (Monad m) => ZipperT s m a -> ([s], [s]) -> m (a, ([s], [s]))
runZipperT computation (left, right) = do
(x, ZipperState left' right') <- runStateT (runZipperT_ computation) (ZipperState left right)
return (x, (left', right'))
it's works and I can compose with other monads
import Control.Monad.Identity
import Control.Monad.State
import ZipperT
length' :: [a] -> Int
length' xs = runIdentity (execStateT (runZipperT contar ([], xs)) 0)
where contar = headR >>= \x -> case x of
Nothing -> return ()
Just _ -> do
right2left
(lift . modify) (+1)
-- ^^^^^^^
contar
But I wish to avoid the explicit lift.
What is the correct way to create modules like this?
Can I avoid the explicit lift? (I wish to hide the internal StateT structure of my ZipperT)
Thank you!
I think that if you can write an instance of MonadState for your transformer you can use modify without the lift:
instance Monad m => MonadState (ZipperT s m a) where
...
I must confess I am not sure about what part of the state modify should affect, though.
I've looked at the complete code. It seems that you already define
MonadState (ZipperState s) (ZipperT s m)
This already provides a modify which however modifies the wrong underlying state. What you actually wanted was to expose the state wrapped in m, provided that is a MonadState itself. This could theoretically be done with
instance MonadState s m => MonadState s (ZipperT s m) where
...
But now we have two MonadState instances for the same monad, causing a conflict.
I think I somehow solved this.
Here's what I did:
First, I removed the original deriving MonadState instance. I instead wrote
getZ :: Monad m => ZipperT s m (ZipperState s)
getZ = ZipperT_ get
putZ :: Monad m => ZipperState s -> ZipperT s m ()
putZ = ZipperT_ . put
modifyZ :: Monad m => (ZipperState s -> ZipperState s) -> ZipperT s m ()
modifyZ = ZipperT_ . modify
and replaced previous occurrences of get,put,modify in the ZipperT library with the above custom functions.
Then I added the new instance:
-- This requires UndecidableInstances
instance MonadState s m => MonadState s (ZipperT a m) where
get = lift get
put = lift . put
And now, the client code works without lifts:
length' :: [a] -> Int
length' xs = runIdentity (execStateT (runZipperT contar ([], xs)) 0)
where contar :: ZipperT a (StateT Int Identity) ()
contar = headR >>= \x -> case x of
Nothing -> return ()
Just _ -> do
right2left
modify (+ (1::Int))
-- ^^^^^^^
contar
I'm trying to build a UI with the VTY-UI library.
I'm also using a custom monad (a few monads stacked on top of eachother).
For regular IO functions, this is not a problem. I can just lift them into my monad. However, the VTY-UI function onActivate has this type signature:
onActivate :: Widget Edit -> (Widget Edit -> IO ()) -> IO ()
Is there a way to turn a Widget Edit -> MyMonad () function into a (Widget Edit -> IO ()) without having to wrap and unwrap my monad?
I'd rather not rewrite all the library's type signatures to be MonadIO m => m () instead of IO ().
The function liftBaseOpDiscard from monad-control seems to do the trick:
import Control.Monad.Trans.Control
type MyMonad a = ReaderT Int (StateT Int IO) a
onActivate' :: Widget Edit -> (Widget Edit -> MyMonad ()) -> MyMonad ()
onActivate' = liftBaseOpDiscard . onActivate
This function has a MonadBaseControl constraint, but ReaderT and StateT on top IO already have instances for that typeclass.
As the documentation for liftBaseOpDiscard mentions, changes to the state inside the callback will be discarded.
MonadBaseControl lets you temporarily hide the upper layers of a monad stack into a value of the base monad of the stack (liftBaseWith) and afterwards pop them again, if needed (restoreM).
Edit: If we need to preserve effects that take place inside the callback (like changes in the state) one solution is to "mimic" state by using an IORef as the environment of a ReaderT. Values written into the IORef are not discarded. The monad-unlift package is built around this idea. An example:
import Control.Monad.Trans.Unlift
import Control.Monad.Trans.RWS.Ref
import Data.IORef
-- use IORefs for the environment and the state
type MyMonad a = RWSRefT IORef IORef Int () Int IO a
onActivate' :: Widget Edit -> (Widget Edit -> MyMonad ()) -> MyMonad ()
onActivate' we f = do
-- the run function will unlift into IO
UnliftBase run <- askUnliftBase
-- There's no need to manually "restore" the stack using
-- restoreM, because the changes go through the IORefs
liftBase $ onActivate we (run . f)
The monad can be run afterwards using runRWSIORefT.
For the state part: you can use this module. Thanks to whoever realized that making get and put polymorphic was a good idea.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module IState where
import Control.Monad
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Trans.Class
import Control.Applicative
import Data.IORef
newtype IState s m a = IState (ReaderT (IORef s) m a)
runIState (IState a) s = do
sr <- liftIO $ newIORef s
runReaderT a sr
runIStateRef (IState a) r = runReaderT a r
instance (Monad m) => Monad (IState s m) where
return = IState . return
(IState a) >>= f = let
f' i = let (IState i') = f i in i'
in IState (a >>= f')
instance (Monad m,Functor m) => Applicative (IState s m) where
pure = return
(<*>) = ap
instance (Functor m) => Functor (IState s m) where
fmap f (IState a) = IState (fmap f a)
instance (MonadIO m) => MonadIO (IState s m) where
liftIO = lift . liftIO
instance (MonadState s' m) => MonadState s' (IState s m) where
get = lift get
put = lift . put
-- Because of this instance IState is almost a drop-in replacement for StateT
instance (MonadIO m) => MonadState s (IState s m) where
get = IState $ do
r <- ask
liftIO $ readIORef r
put v = IState $ do
r <- ask
liftIO $ writeIORef r v
instance MonadTrans (IState s) where
lift a = IState (lift a)
I managed to implement the suggestion mentioned in the comments of the question.
I give vty callbacks in IO that sends events down a Chan. Then i have another thread listening for those events and executing the appropriate actions in my own monad.
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) .