In https://en.wikibooks.org/wiki/Haskell/Monad_transformers, I see
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
and then the instanciation of MaybeT as a monad:
instance Monad m => Monad (MaybeT m) where
return = MaybeT . return . Just
-- The signature of (>>=), specialized to MaybeT m:
-- (>>=) :: MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
x >>= f = MaybeT $ do maybe_value <- runMaybeT x
case maybe_value of
Nothing -> return Nothing
Just value -> runMaybeT $ f value
I do not understand the arg x in runMaybeT x. Shouldn't runMaybeT take an arg corresponding to a? But instead it is given x which is the entire MonadT monad
It's just standard record syntax. In a type definition such as
data Foo = Foo { a :: Int, b :: String }
it presumably does not surprise you that we automatically get functions a :: Foo -> Int and b :: Foo -> String.
It's absolutely no different for MaybeT. (It does use newtype rather than data but that doesn't matter here, the same would be true if the definition used data instead)
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
this gives us a function runMaybeT :: MaybeT m a -> m (Maybe a) for exactly the same reason that we get the functions a and b in the simpler example above. It's just what record syntax does.
Specifically in this case, as always with a newtype defined using record syntax, the runMaybeT function allows us to "unwrap" a monadic value, going from the abstract MaybeT m a to the more "concrete" representation as a value of type m (Maybe a).
This is used in the implementation of >>= for MaybeT m: since its first argument (x in your snippet) is of type MaybeT m a, we first need runMaybeT to get the "unwrapped" value of type m (Maybe a), then use the >>= of the "base monad" m (shown here with do notation) to "extract" a value of type Maybe a which is then pattern matched on in the usual way.
runMaybeT is a getter. It is a function that takes a MaybeT m a object, and returns an m (Maybe a) object, so it has signature MaybeT m a -> m (Maybe a).
Perhaps it is easier to understand however if we unpack the value with a pattern:
instance Monad m => Monad (MaybeT m) where
return = MaybeT . return . Just
MaybeT rm >>= f = MaybeT $ do
maybe_value <- rm
case maybe_value of
Nothing -> return Nothing
Just value -> runMaybeT $ f value
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 am trying to implement:
instance MonadTrans MaybeT where
lift m = m >>= \a -> MaybeT $ return (Just a)
And it gets compiler error:
Could not deduce (m ~ MaybeT m)
from the context (Monad m)
bound by the type signature for
lift :: Monad m => m a -> MaybeT m a
at MaybeTrans.hs:16:9-53
`m' is a rigid type variable bound by
the type signature for lift :: Monad m => m a -> MaybeT m a
Expected type: MaybeT m a
Actual type: m a
In the first argument of `(>>=)', namely `m'
In the expression: m >>= \ a -> MaybeT $ return (Just a)
In an equation for `lift':
lift m = m >>= \ a -> MaybeT $ return (Just a)
I cannot understand where I made a mistake.
Please help me ;)
If you specialise the type of lift to your MaybeT type you have:
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
lift :: Monad m => m a -> MaybeT m a
The type of >>= is Monad m => m a -> (a -> m b) -> m b so in your implementation:
lift m = m >>= \a -> MaybeT $ return (Just a)
you need to return a value of type m b while you return a value of type MaybeT m b, hence the error.
You now have two problems. The first is you need to move the application of MaybeT outside the application of >>=. The second is you need to construct a value of m (Maybe a) from the lamba passed to >>= i.e.
lift x = MaybeT $ x >>= \a -> return (Just a)
or simply:
lift x = MaybeT $ fmap Just x
I'm looking for a more concise / idiomatic way of writing getAorB:
getAorB = do
a <- getA
case a of
Just _ -> return a
Nothing -> getB
Does this already exist as a library function somewhere?
Note that liftM2 (<|>) getA getB is the same as:
do a <- getA
b <- getB
return $ a <|> b
which is different from getAorB since bind is always called on getB even if getA returns a Just.
You can use the maybe function (b -> (a -> b) -> Maybe a -> b) with its default value:
getAorB :: Monad m => m a
getAorB = getA >>= maybe getB return
I don't think there's a single function that does this anywhere.
Trying to use an Alternative (such as MaybeT) doesn't work well here imo as it considers the second action to be fallible as well, which your getB isn't. If it if was, you should consider using MaybeT though:
getAorB :: Monad m => m (Maybe a)
getAorB = runMaybeT $ MaybeT getA <|> MaybeT getB
Sounds like an mplus for MaybeT.
Since (<|>) gets it's powers from applicative isn't this impossible?
It feels like the type you are looking for is something like
Monad m => a ->[m (Maybe a)] -> m a
instead? Or maybe
Monad m => a -> (a -> Bool) -> [m a] -> m a
Hoogle doesn't give me anything for either.
To hide all the transformers:
import Control.Monad.Trans.Maybe
getAOrB :: m (Maybe a) -> m (Maybe a) -> m (Maybe a)
getAOrB getA getB = runMaybeT (MaybeT getA <|> MaybeT getB)
But I would probably just use MaybeT everywhere instead:
getAOrB' :: MaybeT m a -> MaybeT m a -> MaybeT m a
getAOrB' = (<|>)
Note that this type is slightly different than the type of your first implementation; it has the same type as your second implementation but better behavior.
Working in an IO computation I ended up with a staircase of case mbValue of …s and figured out that I should use the Maybe monad to simplify the code. Since it's within an IO computation and I need to get IO values, I used the MaybeT monad transformer so that I can lift IO computation into Maybe.
Now, I have always thought about values being “stripped” of their Maybeness after an values <- mbValue inside a Maybe computation, but this turns out to be too simple of a heuristic here.
As highlighted below, when using a Maybe a value as an a (here by passing it to read), it fails to type check:
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (runMaybeT)
lol :: IO (Maybe Int)
lol = return (Just 3)
lal :: IO (Maybe String)
lal = return (Just "8")
foo :: IO (Maybe Bool)
foo = do
b <- runMaybeT $ do
x <- lift lol
y <- lift lal
return (x < (read y))
return b ^-- Couldn't match type ‘Maybe String’ with ‘String’
main = foo >>= print
If I put a typed hole in for return (x < (read y)), I see that it expects a Bool, which makes sense, but also that the current bindings include
|| y :: Data.Maybe.Maybe GHC.Base.String
|| (bound at /private/tmp/test.hs:14:5)
|| x :: Data.Maybe.Maybe GHC.Types.Int
|| (bound at /private/tmp/test.hs:13:5)
I.e., y is a Maybe String. This of course explains the error, but I'm left confused. Where is my understanding wrong, and how can I fix this error?
In short: Replace lift by the MaybeT constructor.
Note that
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
and
lift :: (MonadTrans t, Monad m) => m a -> t m a
Your use of lift in
x <- lift lol
is at the type
lift :: IO (Maybe Int) -> MaybeT IO (Maybe Int)
That's why x will be a Maybe Int again. The lift adds a fresh MaybeT layer that is independent of the Maybe occurrence you already have.
But
MaybeT :: m (Maybe a) -> MaybeT m a
instead as in
x <- MaybeT lol
will be used at type
MaybeT :: IO (Maybe a) -> MaybeT IO a
and do the right thing.
When specialized to MaybeT, lift :: Monad m => m a -> MaybeT m a. Since lol :: IO (Maybe Int), m is IO and a is Maybe Int, therefore lift lol :: MaybeT IO (Maybe Int).
IO (Maybe a) is just the value contained within a MaybeT IO a newtype wrapper, so there's no need to lift it; instead use the MaybeT constructor, for example as in MaybeT lol.
But this is not how people tend to use monad transformers. Instead, just use MaybeT values and lift as needed:
import Control.Monad
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (runMaybeT, MaybeT)
lol :: MaybeT IO Int
lol = return 3
lal :: MaybeT IO String
lal = return "8"
foo :: IO (Maybe Bool)
foo =
runMaybeT $ do
x <- lol
y <- lal
_ <- lift getLine -- lift (IO String) to MaybeT IO String
_ <- return 100 -- lift any pure value
_ <- mzero -- use the MonadPlus instance to get a lifted Nothing.
return (x < (read y))
main = foo >>= print
Suppose I have a state monad such as:
data Registers = Reg {...}
data ST = ST {registers :: Registers,
memory :: Array Int Int}
newtype Op a = Op {runOp :: ST -> (ST, a)}
instance Monad Op where
return a = Op $ \st -> (st, a)
(>>=) stf f = Op $ \st -> let (st1, a1) = runOp stf st
(st2, a2) = runOp (f a1) st1
in (st2, a2)
with functions like
getState :: (ST -> a) -> Op a
getState g = Op (\st -> (st, g st)
updState :: (ST -> ST) -> Op ()
updState g = Op (\st -> (g st, ()))
and so forth. I want to combine various operations in this monad with IO actions. So I could either write an evaluation loop in which operations in this monad were performed and an IO action is executed with the result, or, I think, I should be able to do something like the following:
newtype Op a = Op {runOp :: ST -> IO (ST, a)}
Printing functions would have type Op () and other functions would have type Op a, e.g., I could read a character from the terminal using a function of type IO Char. However, I'm not sure what such a function would look like, since e.g., the following is not valid.
runOp (do x <- getLine; setMem 10 ... (read x :: Int) ... ) st
since getLine has type IO Char, but this expression would have type Op Char. In outline, how would I do this?
Use liftIO
You're already very close! Your suggestion
newtype Op a = Op {runOp :: ST -> IO (ST, a)}
is excellent and the way to go.
To be able to execute getLine in an Op context, you need to 'lift' the IO operation into the Op monad. You can do this by writing a function liftIO:
liftIO :: IO a -> Op a
liftIO io = Op $ \st -> do
x <- io
return (st, x)
You can now write:
runOp (do x <- liftIO getLine; ...
Use class MonadIO
Now the pattern of lifting an IO action into a custom monad is so common that there is a standard type class for it:
import Control.Monad.Trans
class Monad m => MonadIO m where
liftIO :: IO a -> m a
So that your version of liftIO becomes an instance of MonadIO instead:
instance MonadIO Op where
liftIO = ...
Use StateT
You've currently written your own version of the state monad, specialised to state ST. Why don't you use the standard state monad? It saves you from having to write your own Monad instance, which is always the same for the state monad.
type Op = StateT ST IO
StateT already has a Monad instance and a MonadIO instance, so you can use those immediately.
Monad transformers
StateT is a so-called monad transformer. You only want IO actions in your Op monad, so I've already specialized it with the IO monad for you (see the definition of type Op). But monad transformers allow you to stack arbitrary monads. This what intoverflow is talking about. You can read more about them here and here.
The basic approach would be to rewrite your Op monad as a monad transformer. This would allow you to use it in a "stack" of monads, the bottom of which might be IO.
Here's an example of what that might look like:
import Data.Array
import Control.Monad.Trans
data Registers = Reg { foo :: Int }
data ST = ST {registers :: Registers,
memory :: Array Int Int}
newtype Op m a = Op {runOp :: ST -> m (ST, a)}
instance Monad m => Monad (Op m) where
return a = Op $ \st -> return (st, a)
(>>=) stf f = Op $ \st -> do (st1, a1) <- runOp stf st
(st2, a2) <- runOp (f a1) st1
return (st2, a2)
instance MonadTrans Op where
lift m = Op $ \st -> do a <- m
return (st, a)
getState :: Monad m => (ST -> a) -> Op m a
getState g = Op $ \st -> return (st, g st)
updState :: Monad m => (ST -> ST) -> Op m ()
updState g = Op $ \st -> return (g st, ())
testOpIO :: Op IO String
testOpIO = do x <- lift getLine
return x
test = runOp testOpIO
The key things to observe:
The use of the MonadTrans class
The use of the lift function acting on getLine, which is used to bring the getline function from the IO monad and into the Op IO monad.
Incidentally, if you don't want the IO monad to always be present, you can replace it with the Identity monad in Control.Monad.Identity. The Op Identity monad behaves exactly the same as your original Op monad.