how to implement mapAccumM? - haskell

I want mapM over something that is traversable while passing an accumulator. I came up with:
import Control.Applicative
import Data.Traversable
import Control.Monad.State
mapAccumM :: (Applicative m, Traversable t, MonadState s m)
=> (s -> a -> m (s, b)) -> s -> t a -> m (t b)
mapAccumM f acc0 xs = put acc0 >> traverse g xs
where
g x = do
oldAcc <- get
(newAcc, y) <- f oldAcc x
put newAcc
return y
How can this be done without State monad?

roconnor answered this for me on #haskell
this solves my problem but notice that accumulator is returned in the second element of the tuple instead of the first
mapAccumM :: (Monad m, Functor m, Traversable t) => (a -> b -> m (c, a)) -> a -> t b -> m (t c)
mapAccumM f = flip (evalStateT . (Data.Traversable.traverse (StateT . (flip f))))
or to also return the accumulator:
mapAccumM' :: (Monad m, Functor m, Traversable t) => (a -> b -> m (c, a)) -> a -> t b -> m (t c, a)
mapAccumM' f = flip (runStateT . (Data.Traversable.traverse (StateT . (flip f))))

Related

Why can function composition with `join` change function inputs?

I have recently started learning Haskell, and I was trying to do the following function composition (join . mapM) but got some weird types out of this function that I don't understand. I thought that either GHC would assume that t == m in the mapM type and the output of mapM would become m (m b) which would be join-able or it would not and this would error out because of type mismatch. Instead the following happened:
mapM :: (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b)
join :: Monad m => m (m a) -> m a
join . mapM :: Traversable t => (a -> t a -> b) -> t a -> t b
I don't understand how this is possible. The way I understand it, function composition should use the inputs of the first (or the second depending how you look at it) function and the outputs of the second function. But here the expected input function for mapM changes from a unary function to a binary function and I have no clue why. Even if GHC can't just make the assumption that t == m like I did, which I half expected, it should error out because of type mismatch, not change the input function type, right? What is happening here?
First you specialize mapM to:
mapM' :: Traversable t => (a -> x -> b) -> t a -> x -> t b
(since (->) x is a monad)
Then you specialize it further to:
mapM'' :: Traversable t => (a -> t a -> b) -> t a -> t a -> t b
(we're just fixing the x to be t a)
Finally we specialize join appropriately:
join' :: (x -> x -> r) -> x -> r
(again, (->) x is a monad)
And hopefully it becomes more apparent why the composition join' . mapM'' is
join' . mapM'' :: Traversable t => (a -> t a -> b) -> t a -> t b
Maybe the following will be more illuminating, instead :
flip mapT :: (Traversable t, Monad m) => t a -> (a -> m b) -> t (m b)
sequenceA :: (Traversable t, Monad m) => t (m b) -> m (t b)
flip mapM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
flip liftM :: Monad m => m a -> (a -> m b) -> m (m b)
join :: Monad m => m (m b) -> m b
(join .) . flip liftM :: Monad m => m a -> (a -> m b) -> m b
(>>=) :: Monad m => m a -> (a -> m b) -> m b
(using some more specialized types than the most general ones, here and there; also with the renamed mapT f = runIdentity . traverse (Identity . f)).
Your specific question is less interesting. Type derivation is a fully mechanical process. Some entities must be compatible for the whole expression to make sense, so their types must unify:
(join . mapM) a_mb x = -- a_mb :: a -> m b
= join (mapM a_mb) x
= join ta_mtb x -- ta_mtb :: t a -> m (t b)
To join a function is to call it twice,
= ta_mtb x x
which means x is a t a and so m is t a ->:
x :: t a
ta_mtb :: t a -> m (t b)
----------------------------
ta_mtb x :: m (t b)
~ t a -> t b
x :: t a
----------------------------
ta_mtb x x :: t b
thus a_mb :: a -> m b ~ a -> t a -> b.

Free monad and type constraints

I am looking for practical strategies or tips for dealing with constraints in haskell, as illustrated by the case below.
I have a functor Choice and I want to transform an interpreter from Choice x functor to m x to an interpreter from Free Choice x to m x.
-- Choice : endofunctor
data Choice next = Choice next next deriving (Show)
instance Functor Choice where
fmap f (Choice a b) = Choice (f a) (f b)
-- I have a function from the functor to a monad m
inter1 :: Choice x -> IO x
inter1 (Choice a b) = do
x <- readLn :: IO Bool
return $ if x then a else b
-- universal property gives me a function from the free monad to m
go1 :: Free Choice x -> IO x
go1 = interpMonad inter1
where
type Free f a = FreeT f Identity a
data FreeF f r x = FreeF (f x) | Pure r deriving (Show)
newtype FreeT f m r = MkFreeT { runFreeT :: m (FreeF f r (FreeT f m r)) }
instance Show (m (FreeF f a (FreeT f m a))) => Show (FreeT f m a) where
showsPrec d (MkFreeT m) = showParen (d > 10) $
showString "FreeT " . showsPrec 11 m
instance (Functor f, Monad m) => Functor (FreeT f m) where
fmap (f::a -> b) (x::FreeT f m a) =
MkFreeT $ liftM f' (runFreeT x)
where f' :: FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b)
f' (FreeF (fx::f (FreeT f m a))) = FreeF $ fmap (fmap f) fx
f' (Pure r) = Pure $ f r
instance (Functor f, Monad m) => Applicative (FreeT f m) where
pure a = MkFreeT . return $ Pure a
(<*>) = ap
instance (Functor f, Monad m) => Monad (FreeT f m) where
return = MkFreeT . return . Pure
(MkFreeT m) >>= (f :: a -> FreeT f m b) = MkFreeT $ -- m (FreeF f b (FreeT f m b))
m >>= -- run the effect in the underlying monad !
\case FreeF fx -> return . FreeF . fmap (>>= f) $ fx -- continue to run effects
Pure r -> runFreeT (f r) -- apply the transformation
interpMonad :: (Functor f, Functor m, Monad m) =>
(forall x . f x -> m x) ->
forall x. Free f x -> m x
interpMonad interp (MkFreeT iFfxF) = (\case
Pure x -> return x
FreeF fxF -> let mmx = interp $ fmap (interpMonad interp) fxF
in join mmx) . runIdentity $ iFfxF
All is fine until I require Show x in my interpreter.
interp2 :: Show x => Choice x -> IO x
interp2 (Choice a b) = return a -- we follow left
go2 :: Show x => Free Choice x -> IO x
go2 = interpMonad interp2 -- FAILS
Then it can not find the show constraint to apply in interp2
I suspected the quantifiers were the problem, so I simplified to
lifting :: (forall x . x -> b) ->
(forall x. x -> b)
lifting = id
lifting2 :: (forall x . Show x => x -> b) ->
(forall x . Show x => x -> b)
lifting2 = id
somefunction :: Show x => x -> String
somefunction = lifting show -- FAILS
somefunction2 :: Show x => x -> String
somefunction2 = lifting2 show -- OK
This highlight the problem : Could not deduce (Show x1) arising from a use of ‘show’ from the context (Show x) we have two distinct type variable, and constraint do not flow from one to the other.
I could write some specialized function playing with the constraints as follows (does not work btw) but my question is what are the practical strategies for dealing with this ? (the equivalent of undefined, look at the type, go on...)
interpMonad2 :: (Functor f, Functor m, Monad m) =>
(forall x . ( Show (f x)) => f x -> m x) ->
forall x. ( Show (Free f x)) => Free f x -> m x
interpMonad2 interp (MkFreeT iFfxF) = (\case
Pure x -> return x
FreeF fxF -> let mmx = interp $ fmap (interpMonad interp) fxF
in join mmx) . runIdentity $ iFfxF
edit
based on the answer provided, here is the modification for the lifting function.
lifting :: forall b c. Proxy c
-> (forall x . c x => x -> b)
-> (forall x . c x => x -> b)
lifting _ = id
somefunction3 :: Show x => x -> String
somefunction3 = lifting (Proxy :: Proxy Show) show
I don't see your interpMonad function, so I will include one possible definition here:
interpMonad :: forall f m x . (Functor f, Monad m)
=> (forall y . f y -> m y) -> Free f x -> m x
interpMonad xx = go . runIdentity . runFreeT where
go (FreeF x) = xx x >>= go . runIdentity . runFreeT
go (Pure x) = return x
In order to also have a class constraint on the inner function, you simply add the constraint to the inner function. You also need the correct constraint on the type Free, and you need the extra Proxy to help the typechecker out a bit. Otherwise, the definition of the function is identical:
interpMonadC :: forall f m x c . (Functor f, Monad m, c (Free f x))
=> Proxy c
-> (forall y . c y => f y -> m y)
-> (Free f x -> m x)
interpMonadC _ xx = go . runIdentity . runFreeT where
go (FreeF x) = xx x >>= go . runIdentity . runFreeT
go (Pure x) = return x
And now quite simply:
>:t interpMonadC (Proxy :: Proxy Show) interp2
interpMonadC (Proxy :: Proxy Show) interp2
:: Show x => Free Choice x -> IO x

Implementing Applicative's (<*>) for Monad

Applicative's has the (<*>) function:
(<*>) :: (Applicative f) => f (a -> b) -> f a -> f b
Learn You a Haskell shows the following function.
Given:
ap :: (Monad m) => m (a -> b) -> m a -> m b
ap f m = do
g <- f -- '<-' extracts f's (a -> b) from m (a -> b)
m2 <- m -- '<-' extracts a from m a
return (g m2) -- g m2 has type `b` and return makes it a Monad
How could ap be written with bind alone, i.e. >>=?
I'm not sure how to extract the (a -> b) from m (a -> b). Perhaps once I understand how <- works in do notation, I'll understand the answer to my above question.
How could ap be written with bind alone, i.e. >>= ?
This is one sample implementation I can come up with:
ap :: (Monad m) => m (a -> b) -> m a -> m b
ap xs a = xs >>= (\f -> liftM f a)
Of if you don't want to even use liftM then:
ap :: (Monad m) => m (a -> b) -> m a -> m b
ap mf ma = mf >>= (\f -> ma >>= (\a' -> return $ f a'))
Intially these are the types:
mf :: m (a -> b)
ma :: m a
Now, when you apply bind (>>=) operator to mf: mf >>= (\f-> ..., then f has the type of:
f :: (a -> b)
In the next step, ma is also applied with >>=: ma >>= (\a'-> ..., here a' has the type of:
a' :: a
So, now when you apply f a', you get the type b from that because:
f :: (a -> b)
a' :: a
f a' :: b
And you apply return over f a' which will wrap it with the monadic layer and hence the final type you get will be:
return (f a') :: m b
And hence everything typechecks.

How to modify using a monadic function with lenses?

I needed a lens function that works like over, but with monadic operations:
overM :: (Monad m) => Lens s t a b -> (a -> m b) -> (s -> m t)
While this function is easy to define (it's actually just an identity modulo WrappedMonad), I wonder are such functions defined somewhere in lens?
{-# LANGUAGE RankNTypes #-}
import Control.Applicative
import Control.Lens
overF :: (Functor f) => Lens s t a b -> (a -> f b) -> (s -> f t)
overF l = l
overM :: (Monad m) => Lens s t a b -> (a -> m b) -> (s -> m t)
overM l = (unwrapMonad .) . l . (WrapMonad .)
in Control.Lens.Traversal:
traverseOf :: Over p f s t a b -> p a (f b) -> s -> f t
traverseOf = id
mapMOf :: Profunctor p =>
Over p (WrappedMonad m) s t a b -> p a (m b) -> s -> m t
mapMOf l cmd = unwrapMonad #. l (WrapMonad #. cmd)
Example:
Prelude Control.Lens> traverseOf _1 (Just . (+2)) (2,2)
Just (4,2)
Prelude Control.Lens> mapMOf _1 (Just . (+2)) (2,2)
Just (4,2)

Monad vs Applicative in the case of Reader resp. ((->) a)

In Haskell, what does the monad instance of functions give over just applicative? Looking at their implementations, they seem almost identical:
(<*>) f g x = f x (g x)
(>>=) f g x = g (f x) x
Is there anything you can do with >>= that you can't do with just <*>?
They are equivalent in power for the function instance: flip f <*> g == g >>= f. This is not true for most types that are instances of Monad though.
It's a little more clear if we compare <*> and =<< (which is flip (>>=)) specialized to the ((->) r) instance:
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
-- Specialized to ((->) r):
(<*>) :: (r -> a -> b) -> (r -> a) -> r -> b
(=<<) :: Monad m => (a -> m b) -> m a -> m b
-- Specialized to ((->) r):
(=<<) :: (a -> r -> b) -> (r -> a) -> r -> b

Resources