Let's look at:
instance (Error e) => MonadTrans (ErrorT e) where
lift m = ErrorT $ do
a <- m
return (Right a)
I cannot understand why is necessary a <- m. Why we don't write just:
instance (Error e) => MonadTrans (ErrorT e) where
lift m = ErrorT $ do
return (Right m)
You're reading a <- m as "assign a the value m." That notation for assignment is common in pseudocode, but it means something different in Haskell. You can read it as "Produce a value from m and bind that value to a." To be more precise, in a do block,
a <- m
...
...
is equivalent to
m >>= \a ->
do
...
...
So applying Right to a is sensible, but applying it to m gives you a monadic action wrapped in Either, which isn't usually what you're after.
There is, however, a shorter way to write that instance:
instance Error e => MonadTrans (ErrorT e) where
lift m = ErrorT (Right <$> m)
Nota Bene: ErrorT has generally been supplanted by the more generally-useful ExceptT, which doesn't have the annoying and often-irrelevant Error context. In particular, it's very often useful to have an "exception" value that doesn't actually represent an error and isn't an instance of Show.
m :: m a
Right m :: Either e (m a)
return (Right m) :: m (Either e (m a))
ErrorT $ return (Right m) :: ErrorT e m (m a)
This has the wrong type: we wanted ErrorT e m a.
Instead, when using a <- m, we have:
a :: a
Right a :: Either e a
return (Right a) :: m (Either e a)
ErrorT $ return (Right a) :: ErrorT e m a
which is OK.
(Above some value variables have the same name of type variables on the right of :: -- this is just an incident.)
Alternatives:
instance (Error e) => MonadTrans (ErrorT e) where
lift m = ErrorT $ fmap Right m
or with applicative notation,
instance (Error e) => MonadTrans (ErrorT e) where
lift m = ErrorT $ Right <$> m
Related
How to convert StateT g (Either E) T to ExceptT E (StateT g Identity) T?
Probably, some mix of traverse and hoist could be useful here.
You can't exchange an arbitrary pair of monads. But you can exchange these two particular monads. It's easiest to understand if you expand the newtypes in the definitions of those monad transformers.
Given
newtype StateT s m a = StateT { runStateT :: s -> m (s, a) }
and
newtype ExceptT e m a = ExceptT { runExceptT :: m (Either e a) }
expanding the newtypes in your first type expression gives us the isomorphism
StateT s (Either e) a <-> s -> Either e (s, a)
whereas for the second we get
ExceptT e (StateT s Identity) a <-> s -> (s, Either e a)
Note that Either e (s, a) may or may not contain an s, whereas (s, Either e a) always does. Now, one can go from the latter to the former just by traverseing the tuple inside the function, but going the other way requires some domain-specific reasoning: if the computation throws an error then we should plumb the state through unchanged to the catcher of the error. (Is this the right thing to do? I find it rather debatable.)
stateTEitherToExceptTState :: (s -> Either e (s, a)) -> (s -> (s, Either e a))
stateTEitherToExceptTState f s =
case f s of
Left e -> (s, Left e)
Right sa -> fmap Right sa
newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
instance (Monad m, Error e) => Monad (ErrorT e m) where
m >>= k = ErrorT $ do
a <- runErrorT m
case a of
Left l -> return (Left l)
Right r -> runErrorT (k r)
ErrorT is just a value constructor ( type constructor as well) and to get instance of that type ( to get ErrorT value ) we have to call constructor with one parameter- a function ( destructor) which gets ErrorT and returns inner monad, in our case it is any m (Either e a). So, in bind function it is defined: m >>= k = ErrorT $ .... But, in its definion it calls runErrorT which is just definied. So something like recursive call. But, I suppose that there is no recursion here. That means that I misunderstand something with monad/ monad transformers. Please help :)
I think you are confused by the newtype wrapper. The newtype definition of ErrorT results in two functions being defined:
ErrorT :: m (Either e a) -> ErrorT e m a
runErrorT :: ErrorT e m a -> m (Either e a)
so in the definition of (>>=), ErrorT $ do ... refers to the constructor for the ErrorT newtype while
a <- runErrorT m
runErrorT (k r)
refer to the 'unwrapping' function to extract the underlying m (Either e a).
I was trying to write some EitherT monad transformer, as suggested from real world haskell chapter 18.
newtype EitherT e m a = EitherT {
runEitherT :: m (Either e a)
}
my EitherT will have Left error and Right result for its Either type, and will bind all computation that yields Right values while stopping at left values, keeping them as error.
my code is below(sorry for the imperative style):
bindET :: (Monad m) => (EitherT e m a) -> (a -> EitherT e m b) -> (EitherT e m b)
x `bindET` f = EitherT $ do
mx <- runEitherT x
case mx of
Right success -> runEitherT (f success)
Left error -> return (Left error)
instance (Monad m) => Monad (EitherT e m) where
return a = EitherT $ return (Right a)
(>>=) = bindET
fail e = EitherT $ return (Left e)
I thought writing Monad instances for EitherT transformer was quite simple, however I get this cryptic error message when I load the code into ghci:
EitherT.hs:30:18:
Could not deduce (e ~ [Char])
from the context (Monad m)
bound by the instance declaration at EitherT.hs:27:10-41
`e' is a rigid type variable bound by
the instance declaration at EitherT.hs:27:10
Expected type: EitherT e m a
Actual type: EitherT String m a
In the expression: EitherT $ return (Left e)
In an equation for `fail': fail e = EitherT $ return (Left e)
In the instance declaration for `Monad (EitherT e m)'
Failed, modules loaded: none.
it seems fail function is fixed to take String as an argument - well, if that's the case then my EitherT e m a will be EitherT String m a and all the Left values will be Left String. but I want EitherT monad to take any types of value as Left to indicate errors in computation. How can I achieve that?
EitherT is also an instance of MonadError, giving you throwError :: e -> EitherT e m a. If you are implementing your own EitherT for educational reasons, you can look up MonadError at the link above and figure out how to make your own ErrorT type also an instance of that.
fail is generally considered a poor interface, because a, it is tied to String as you noticed and b, because it is in Monad, forcing monads to implement it even when it doesn't make sense.
If you want to use fail in that way, you can define the monad as EitherT String m:
instance (Monad m) => Monad (EitherT String m) where
-- ...
This is not as useless as it looks, since errors are usually strings anyway.
The benefit of doing it this way is that you can handle pattern match failures. This could be handy if you want to (for example) call an action that needs to return Just
do
Just a <- lift getTheThing
lift (print a)
The downside is you get a less-than-useful error message "pattern match failure in ..." rather than something like "couldn't get the thing, try restarting the server".
If you just want to have something to call manually on failure though, use throwError like Cactus suggests.
I am trying to implement a simple FRP backend, for my own interest.
I decided to use pure functions: so, no IO in the core. The implementation is based on signal transformer.
I already have tried two ways:
newtype SF a b = SF { listen :: [a] -> [b] }
https://gist.github.com/Heimdell/9675964#file-streamer-hs-L1
and
newtype SF a b = SF { run :: a -> (b, SF a b) }
https://gist.github.com/Heimdell/9675964#file-behaviour-hs-L1 (misnamed, sorry)
Both ways make possible to make a fold/integrate :: (a -> b -> b) -> b -> SF a b combinator for signal integration.
Both ways have a problem: Seems to be impossible to make a valid ArrowApply/Monad instance.
Stream-way: we have a list of pairs (arrow, x) - or, unziped, the pair of lists (arrows, xs).
If we will map head to the result of zipWith ($) 'em, we will loose the carried-along arrow mutation.
if we make head arrows listen xs, we will freeze the state of first arrow taken.
Explicit state-way:
instance ArrowApply Behaviour where
app =
Behaviour $ \(bf, a) ->
let (bf1, c) = bf `runBehaviour` a
in (app, c)
Here we need to somehow validly inject bf1 into app returned, which is impossible (and actually injecting by (const bf1 *** id) produces invalid behaviour analoguous to the second one from other implementation.
Is there a possible way to make a SF which allows ArrowApply instance?
P.S.: The stream-way has a memory leak in the ArrowChoice, when a branch sits unused for a long time. For now, I cannot fix that. Is it ever possible to make a no-leak version of it?
P.P.S: If one need time, he could zip it with input.
I can't find any possible instance that doesn't simply discard the state of the inner container. This isn't surprising, since the return from the pure function bound to the data should return the same thing each time the input is called, regardless of if it has been called before, which you hint at in your comments.
By itself
The only Monad instances I can come up with both discard the subsequent states for the inner container.
instance Monad (SF e) where
return a = SF . const $ (a, return a)
(>>=) sa f = SF go
where
go e =
let
(a, sa') = run sa e
sb = f a
(b, _) = run sb e
in
(b, sa' >>= f)
or
join :: SF e (SF e a) -> SF e a
join ssa = SF go
where
go e =
let
(sa, ssa') = run ssa e
(a, _) = run sa e
in
(a, join ssa')
These can be expressed more succinctly using the Monad instance for functions
instance Monad (SF e) where
return a = SF . const $ (a, return a)
(>>=) sa f = SF {
run =
do
(a, sa') <- run sa
(b, _) <- run (f a)
return (b, sa' >>= f)
}
We can look elsewhere for something a little different.
Function Monad Instance
Your newtype SF e a = SF { run :: e -> (a, SF e a) } is very close to a function from e to a. For the Monad instance for functions the only sensible >>= is to pass the argument to both the inner and outer functions. This is what we've already come up with. Let's see if we can come up with something else.
StateT
Your code is somewhat similar to the StateT monad transformer applied to the Monad instance for functions. Unfortunantly, this doesn't yield what we are looking for.
Consider the following (the StateT monad transformer):
newtype StateT s m a = StateT { runStateT :: s -> m (a, s)}
Applied to the type ((->) e) of a function that takes an argument `e.
StateT s ((->) e) a has the single constructor StateT { runStateT :: s -> e -> (a, s) }.
This differs from your type in that an initial state must be provided, and the state is tracked explicitly instead of already wrapped up in the returned next value. Let's see what the Monad instance for this would be. StateT's Monad instance is
instance (Monad m) => Monad (StateT s m) where
return a = state $ \s -> (a, s)
m >>= k = StateT $ \s -> do
~(a, s') <- runStateT m s
runStateT (k a) s'
state f = StateT (return . f)
Combined with an instance for (->) e
instance Monad ((->) e) where
return = const
(>>=) x y z = y (x z) z
We'd get the following, where the do dumps the work off onto the instance for ((->) e)
instance Monad (StateT s ((->) e) where
return a = StateT (const . (\s -> (a, s)))
m >>= k = StateT $ \s e ->
let (a, s`) = runStateT m s e
in runStateT (k a) s` e
This looks quite different. We aren't losing the history of any state. What's happening here is that the state for the inner container is being passed to it from the outer container, and the two containers must have the same type for the state for this to work. This isn't what we want at all.
Something New
What happens if we try to make something like StateT from your type? We'd like to be able to pass in the type (->) e and get a structure like yours. We'll make something called SFT m a such that SFT ((-> e) a has the same structure as SF e a.
newtype SF e a = SF { run :: e -> (a, SF e a)
newtype SFT m a = SFT { unSFT :: m (a, SFT m a) }
We can substiture a type made by applying SFT to (->) e) for SF applied to e
SF e a -- is replaced by
SFT ((->) e) a
This has a single constructor
SF { run :: e -> (a, SF e a) }
SFT { unSFT :: e -> (a, SFT ((->) e) a) }
This provides no new insight, the only Monad instance I can think of for it is almost identical to the original one.
instance Monad m => Monad (SFT m) where
return a = SFT . return $ (a, return a)
(>>=) sa f = SFT {
unSFT =
do
(a, sa') <- unSFT sa
(b, _) <- unSFT (f a)
return (b, sa' >>= f)
}
I need to write a state monad that can also support error handling. I was thinking of using the Either monad for this purpose because it can also provide details about what caused the error. I found a definition for a state monad using the Maybe monad however I am unable to modify it to use Either, instead of Maybe. Here's the code:
newtype StateMonad a = StateMonad (State -> Maybe (a, State))
instance Monad StateMonad where
(StateMonad p) >>= k = StateMonad (\s0 -> case p s0 of
Just (val, s1) -> let (StateMonad q) = k val in q s1
Nothing -> Nothing)
return a = StateMonad (\s -> Just (a,s))
data State = State
{ log :: String
, a :: Int}
Consider using ExceptT from Control.Monad.Trans.Except (instead of using Either).
import Control.Monad.State
import Control.Monad.Trans.Except
import Control.Monad.Identity
data MyState = S
type MyMonadT e m a = StateT MyState (ExceptT e m) a
runMyMonadT :: (Monad m) => MyMonadT e m a -> MyState -> m (Either e a)
runMyMonadT m = runExceptT . evalStateT m
type MyMonad e a = MyMonadT e Identity a
runMyMonad m = runIdentity . runMyMonadT m
If you aren't comfortable with Monads and Monad transformers then I'd do that first! They are a huge help and programmer productivity performance win.
There are two possible solutions. The one that is closest to the code you provided above is:
newtype StateMonad e a = StateMonad (State -> Either e (a, State))
instance Monad (StateMonad e) where
(StateMonad p) >>= k =
StateMonad $ \s0 ->
case p s0 of
Right (val, s1) ->
let (StateMonad q) = k val
in q s1
Left e -> Left e
return a = StateMonad $ \s -> Right (a, s)
data State = State
{ log :: String
, a :: Int
}
The other form moves the error handling within the state handling:
newtype StateMonad e a = StateMonad (State -> (Either e a, State))
instance Monad (StateMonad e) where
(StateMonad p) >>= k =
StateMonad $ \s0 ->
case p s0 of
(Right val, s1) ->
let (StateMonad q) = k val
in q s1
(Left e, s1) -> (Left e, s1)
return a = StateMonad $ \s -> (Right a, s)
data State = State
{ log :: String
, a :: Int
}
You need a monad transformer. Monad transformer libraries such as mtl allow you to compose different monads to make a new version. Using mtl, you could define
type StateMonad e a = StateT State (Either e) a
which will allow you to access both state and error handling within your StateMonad.
I didn't see anyone here mention the paper Monad Transformers Step by Step by Martin Grabmüller
I found it to be very helpful in learning about combining monads.
Just saw examples like
type StateMonad e a = StateT State (Either e) a
and
type MyMonadT e m a = StateT MyState (ExceptT e m) a
but as far as I understand, you will lose your state in case of error, because here you add state inside Either/Except, so state will be only accessible in Right.
If you need handle error and get state, which was computed up to moment where error occurred, you can use ExceptT e (State s) a stack:
type StateExcept e s a = ExceptT e (State s) a
test :: Int -> StateExcept String String ()
test limit = do
modify (succ . head >>= (:)) -- takes first char from state and adds next one in alphabet to state
s <- get
when (length s == limit) (throwError $ "State reached limit of " ++ show limit)
runTest :: ExceptT String (State String) () -> (Either String (), [Char])
runTest se = runState (runExceptT se) "a"
λ: runTest (forever $ test 4)
(Left "State reached limit of 4","dcba")
λ: runTest (replicateM_ 2 $ test 4)
(Right (),"cba")
You can always use a ErrorT monad transformer with a State monad inside (or vice versa).
Have a look at the transformers section of all about monads.
HTH,