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.
Related
I have function:
step :: forall m . (MonadState IntCodeState m) => m (Maybe ())
When I use do notation in the body of the function, it uses m as the monad. As you might expect, I actually want it to be using m Maybe. But, it doesn't understand that m Maybe is a monad. How do I express that to Haskell?
EDIT: This may be slightly malformed at the moment. The concrete type should be
StateT IntCodeState Maybe (), but I'm trying not to declare the concrete type, so the question is: how do I declare that?
EDIT 2: Another attempt: I've got some functions that look like this:
getValueIndex :: (MonadState IntCodeState m) => Int -> m (Maybe Int)
Here, I'm working on the level of the state monad. However, I now want to be able to act "as if" m Maybe was the monad. I was hoping this was simple but I can't figure out a way of expressing it. The code I want to write looks like this
step :: forall m . (MonadState IntCodeState m) => m (Maybe ())
step = do
full <- opCode
let len = length (snd full) + 1
process full <* (next += len)
But opCode returns a m (Maybe a) and I want full to be an a
But opCode returns a m (Maybe a) and I want full to be an a
Looks like you want to use the MaybeT monad transformer, which is m (Maybe a) under the hood, with its Monad instance doing what you need:
The MaybeT monad transformer extends a monad with the ability to exit the computation without returning a value.
A sequence of actions produces a value only if all the actions in the sequence do. If one exits, the rest of the sequence is skipped and the composite action exits.
Here are the types:
MaybeT :: m (Maybe a) -> MaybeT m a
runMaybeT :: MaybeT m a -> m (Maybe a)
This will also be helpful, specialised from MonadTrans:
lift :: m a -> MaybeT m a
So in your case:
step :: forall m . (MonadState IntCodeState m) => m (Maybe ())
step = runMaybeT $ do
full <- MaybeT opCode -- :: MaybeT opCode :: MaybeT m a, full :: a
let len = length (snd full) + 1
lift $ process full <* (next += len)
I've assumed process returns an m () and used lift to change it into MaybeT m ().
I want to lift a function like mask_ :: IO a -> IO a to create a function with this signature: lmask_ :: StateT Bool IO a -> StateT IO a.
My problem is, how to handle the callback/first parameter? Wouldn't the following code be incorrect since it would execute the callback before mask_'s code?
lmask_ :: StateT Bool IO a -> StateT Bool IO a
lmask_ m = do
r <- m
lift (mask_ (return r))
Is there some general way to do this? A helper like lift1 :: MonadTrans t => (m a -> m a) -> (t m a -> t m a)?
If we generalize lmask_ to get rid of the StateT Bool IO, we get something like this:
lift1 :: (Monad m, Monad (t m), MonadTrans t) => (m a -> m a) -> (t m a -> t m a)
lift1 f term = do
x <- term
lift (f (return x))
In general this is not possible without knowing something about the monad transformer. However, there is a way how to do this for all the standard monad transformers. See type class MonadBaseControl. It's superclass MonadBase defines what is the bottom monad in a monad transformer stack (which is IO for all stacks that include IO), and MonadBaseControl defines a way how to embed the monad into the base monad. Its instances are somewhat convoluted, but once they're defined, it's possible to lift all such functions like mask_.
In your case, package lifted-base uses the above construction to re-define the standard IO functions lifted to MonadBaseControl. In particular, there is mask_
mask_ :: MonadBaseControl IO m => m a -> m a
which can be specialized to StateT Bool IO a -> StateT Bool IO a, as StateT s has an instance of MonadBaseControl.
See also Lift a function and its argument to a different monadic context.
I met this question today while learning haskell monad transformers.
Assume I have a type instance Monad m => Monad (CustomT m).
If there's a function f :: CustomT IO Int, and there's g :: IO (Maybe Int).
How do I access the Int of g in f?
I tried something like
f = do
mVal <- g
This didn't work because f is under CustomT IO monad while g is under MaybeT IO monad.
And then I tried
f = do
mVal <- return g
This seems to work but mVal is IO (Maybe Int) type, I eventually get nested IO like CustomT IO (IO something)
Is there a way to get that Int or Maybe Int out in f?
What knowledge is involved?
Thanks in advance.
In the general case, Jeremy's answer is what you want. But let's see if we can work with your specific case here. We have f :: CustomT IO Int and g :: IO (Maybe Int), given that there exist some instances to the effect of instance Monad m => Monad (CustomT m) and instance MonadTrans CustomT.
And what you want is to get at the Int inside of a g within the context of CustomT IO. Since we're inside of CustomT, we can basically strip that layer off trivially. Like Jeremy says, use lift to get rid of that.
lift :: (MonadTrans t, Monad m) => m a -> t m a
So now we have CustomT IO (Maybe Int). Like I said, we're inside a do-block, so using Haskell's bind (<-) syntax gets rid of the monad layer temporarily. Thus, we're dealing with Maybe Int. To get from Maybe Int to Int, the usual approach is to use maybe
maybe :: b -> (a -> b) -> Maybe a -> b
This provides a default value just in case the Maybe Int is actually Nothing. So, for instance, maybe 0 id is a function that takes a Maybe Int and yields the inner Int, or 0 if the value is Nothing. So, in the end, we have:
f = do
mVal <- maybe 0 id $ lift g
-- Other code
In the Control.Monad.Trans you have this definition for monad transformers:
class MonadTrans (t :: (* -> *) -> * -> *) where
lift :: Monad m => m a -> t m a
Which means that if CustomT has been defined properly you can do this:
f = do
mVal <- lift g
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) .
While playing around with parsing based on text-icu's BreakIterator, I've got stuck on implementing a function like this
conditionalParser :: (a -> Bool) -> Parser a -> Parser a -> Parser a -> Parser a
conditionalParser f a b c = do
a' <- a
if f a'
then b
else c
but with a type
conditionalParserIO :: (a -> Bool) -> Parser (IO a) -> Parser (IO a) -> Parser (IO a) -> Parser (IO a)
Is it possible without doing unsafePerformIO?
So far I could only get to some nested dos with the final returned type being Parser (IO (Parser (IO a))), but without any idea how to collapse them.
I think what you want is to use ParsecT instead of Parser.
conditionalParserM :: Monad m => (a -> Bool) -> ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
conditionalParserM f a b c = do
a' <- a
if f a' then b else c
This function works with all types of Monads, not just IO.
I suppose it's possible to convert from a ParsecT s u IO a to a Parser (IO a) using runParsecT, depending on which Parser (this or this?) you're using. However, I would recommend that you just restructure your code to work with ParsecT instead.
Clarification
conditionalParserM can't be used as a replacement for conditionalParserIO. I'm suggesting that you need to change how your program works, because attempting to do what your doing (without unsafePerformIO, which you should almost never use) is impossible.
You're looking to compose parsers based on the result of an IO operation, which means that the parser itself will perform side effects when it is run. In order to encapsulate this in the type, you need to use a monad transformer instead.
So, to use conditionalParserM, you need to restructure your code to work with ParsecT instead of Parser.
I just wanted to comment on the difference between Parsec s u (IO a) and ParsecT s u IO a.
You correctly observed that trying to implement your function using Parsec (IO a) yields to Parser (IO (Parser (IO a)). Since both Parser and IO are monads, for both of them we have join :: m (m a) -> m a, which allows to collapse double Parser or double IO. However, in our results we have IO and Parser interleaved. What we need is some function of type IO (Parser a) -> Parser (IO a). If we had such a function f and some x :: Parser (IO (Parser (IO a)), we could use it as liftM f x :: Parser (Parser (IO (IO a))) and then use join and liftM join to collapse both parts into desired Parser (IO a).
Unfortunately there is no such general function for swapping two monads. It's not possible to construct such a function without knowing the internals of a monad, and for some monads it's not even possible at all. For example, there is no total function of type (a -> Maybe b) -> Maybe (a -> b) (the first monad being Maybe, the second one the reader monad (->) a).
And this is why we have monad transformers. A monad transformer corresponding to some monad M knows how to interleave M with another monad. For some monads, such as Reader, swapping it with another monad in the above manner is possible and its transformer is doing exactly that. ReaderT r m a is defined as r -> m a and we can construct:
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Reader
swapReader :: (Monad m) => m (Reader r a) -> Reader r (m a)
swapReader = fromReaderT . join . lift . liftM (toReaderT . liftM return)
where
-- Helpers to convert ReaderT to Reader and back
fromReaderT :: (Monad m) => ReaderT r m a -> Reader r (m a)
fromReaderT = reader . runReaderT
toReaderT :: (Monad m) => Reader r (m a) -> ReaderT r m a
toReaderT = ReaderT . runReader
We convert m (Reader r a) into ReaderT r m (ReaderT r m a) by augmenting both the inner and outer part and then just collapse it using join.
For other monads, such as MaybeT, swapping is impossible (as in the example above with the (->) a monad). So their transformers are defined differently, for example MaybeT m a is defined as m (Maybe a), not Maybe (m a). Therefore ReaderT r Maybe a is isomorphic MaybeT (ReaderT r) a! There is just one sensible way how to combine Reader and Maybe and so both transformers result in the same thing.
Luckily, we don't have to care about this stuff, once somebody defines a transformer for us.
All we need to know is that the laws hold and how to run the transformer stack at the end.
So using ParsecT s u IO a is the proper solution. ParsecT knows how to interleave parsing within another monad and allows you to combine operations from both of them, without having to deal with the internals.