In this exercise you should extend the state monad in such a way it keeps track of the number of binds, returns and some other capabilities. One can read the full exercise here. In short if you have a computation like this:

doreturn 3 >> return 4

return 5

diagnostics

After running this computation in the state monad one should have a result that somewhat looks like this:

"[bind=3, diagnostics=1, return=3]"

That looks doable, but is a lot more tedious than you except at first. Anyway, a very important point you should catch is that after implementing this functionality we now do NOT abide to the monad laws anymore.

Remember the monad laws (stolen from here):

1. "Left identity": return a >>= f ≡ f a

2. "Right identity": m >>= return ≡ m

3. "Associativity": (m >>= f) >>= g ≡ m >>= (\x -> f x >>= g)

As you can see all three laws can transform an expression on the left side to an expression that contains one bind less. Therefore if we perform a computation in our state monad we would have a different number of binds after transforming and could therefore give a different result when getting out our number of binds and returns.

But let's first return to the implementation of this extension. I chose a Map with strings to int that can keep track of the number of binds and annotations. So we now have a State Monad with some extra functionality:

dataStateMonadPlus s a = StateMonadPlus {runStateMonadPlus:: (s,Map String Int) -> (a, s, Map String Int)}

This is very similar to the original definition of the State Monad. (If you forgot some parts of it you can read a part of my State Monad tutorial here.

Anyway, before defining the Monad instance we define a useful helper function for updating the Map that keeps track of the number of binds and annotations and another function that puts the diagnostics as the result of the computation.

diagnostics :: StateMonadPlus s String

diagnostics = StateMonadPlus $ \(s,m) ->

let m2 = updateMap "diagnostics" m

in ((show m2 ), s, m2)

updateMap :: Ord k => k -> Map k Int -> Map k Int

updateMap k = M.insertWith (+) k 1

And now for the Monad instance:

test1 =dodiagnostics

return 4

return 5

mget

diag = diagStateMonadPlus test1 undefined

eval = evalStateMonadPlus test1 undefined

diageval = (diag, eval)

Anyway, halfway during the implementation I got stuck on something that seemed like a bug in my program, but before spoiling everything I will first show the functions I defined for running and evaluating our freshly made State Monad.

evalStateMonadPlus :: StateMonadPlus s a -> s -> a

evalStateMonadPlus (StateMonadPlus s) st =let(a,b,c) = s (st, M.empty)ina

execStateMonadPlus :: StateMonadPlus s a -> s -> s

execStateMonadPlus (StateMonadPlus s) st =let(a,b,c) = s (st, M.empty)inb

diagStateMonadPlus :: StateMonadPlus s a -> s -> Map String Int

diagStateMonadPlus (StateMonadPlus s) st =let(a,b,c) = s (st, M.empty)incinstanceMonadState s (StateMonadPlus s)where

get = StateMonadPlus $ \(s,m) -> (s, s, m)

put a = StateMonadPlus $ \(_, m) -> ((),a, m)

mget:: StateMonadPlus s (Map String Int)

mget = StateMonadPlus $ \(s,m) -> (m, s, m)

Here the get and put functions are the familiar functions in the original state monad, and mget does something similar to diagnostics, by putting our map into the result.

Because I defined a multi parameter type class, and a flexible instance too, we will have to add some compiler pragma's to be able to use them. And we furthermore used some imports. So just add this to the start of the module:

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}moduleStateMonadExercisewhereimportControl.Monad.StateimportqualifiedData.MapasMimportData.Map(Map)

So the only part left to test this functionality is to define some tests:

test1 =doreturn 4

return 5

mget

diag = diagStateMonadPlus test1 undefined

eval = evalStateMonadPlus test1 undefined

diageval = (diag, eval)

So now we're ready to run these test right? (I've enclosed the full test module at the end of this blog post for your convenience, so you could just copy the whole code at once if you'd like.)

Anyway, after running these test, (and I think it's not a bug on my part but a (maybe) too enthusiastic optimization of GHC (6.10.4)). We get these results:

*StateMonadExercise> diag

fromList [("bind",2),("return",2)]

*StateMonadExercise> eval

fromList [("return",2)]

*StateMonadExercise> diageval

(fromList [("bind",2),("return",2)]

,fromList [("return",2)])

So here GHC just optimized away 2 binds for the result but not from the map. It serves me right though, since I'm breaking the monad laws anyway :-). So if anyone can confirm this is GHC's "fault" (or doing) and not mine I would be happy.

One final comment: I will probably post the full implementation later this month.

The full code:

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}moduleStateMonadExercisewhereimportControl.Monad.StateimportqualifiedData.MapasMimportData.Map(Map)dataStateMonadPlus s a = StateMonadPlus {runStateMonadPlus:: (s,Map String Int) -> (a, s, Map String Int)}instanceMonad (StateMonadPlus s)where

return a = StateMonadPlus $ (\ (s, m) -> (a, s, updateMap "return" m))

(StateMonadPlus s) >>= f = StateMonadPlus $ \(state, m) ->

(let(a1, st1, m1) = s (state,m)in

let(a2, st2, m2) = runStateMonadPlus (f a1) (st1,m1)

in(a2, st2, updateMap "bind" m2)

)

updateMap :: Ord k => k -> Map k Int -> Map k Int

updateMap k = M.insertWith (+) k 1

diagnostics :: StateMonadPlus s String

diagnostics = StateMonadPlus $ \(s,m) ->

letm2 = updateMap "diagnostics" m

in((show m2 ), s, m2)

evalStateMonadPlus :: StateMonadPlus s a -> s -> a

evalStateMonadPlus (StateMonadPlus s) st =let(a,b,c) = s (st, M.empty)ina

execStateMonadPlus :: StateMonadPlus s a -> s -> s

execStateMonadPlus (StateMonadPlus s) st =let(a,b,c) = s (st, M.empty)inb

diagStateMonadPlus :: StateMonadPlus s a -> s -> Map String Int

diagStateMonadPlus (StateMonadPlus s) st =let(a,b,c) = s (st, M.empty)incinstanceMonadState s (StateMonadPlus s)where

get = StateMonadPlus $ \(s,m) -> (s, s, m)

put a = StateMonadPlus $ \(_, m) -> ((),a, m)

mget:: StateMonadPlus s (Map String Int)

mget = StateMonadPlus $ \(s,m) -> (m, s, m)

test1 =doreturn 4

return 5

mget

diag = diagStateMonadPlus test1 undefined

eval = evalStateMonadPlus test1 undefined

diageval = (diag, eval){-

*StateMonadExercise> diag

fromList [("bind",2),("return",2)]

*StateMonadExercise> eval

fromList [("return",2)]

*StateMonadExercise> diageval

(fromList [("bind",2),("return",2)]

,fromList [("return",2)])

-}