# Yet Another Haskell Tutorial/Monads/Solutions

## Contents

## Do Notation[edit]

### Translation Rule 1[edit]

### Translation Rule 2[edit]

### Translation Rule 3[edit]

### Translation Rule 4[edit]

## Definition[edit]

### Law 1[edit]

### Law 2[edit]

### Law 3[edit]

## A Simple State Monad[edit]

## Common Monads[edit]

The first law is: `return a >>= f`

≡ `f a`

. In the case
of `Maybe`

, we get:

return a >>= f ==> Just a >>= \x -> f x ==> (\x -> f x) a ==> f a

The second law is: `f >>= return`

≡ `f`

. Here, we get:

f >>= return ==> f >>= \x -> return x ==> f >>= \x -> Just x

At this point, there are two cases depending on whether `f`

is
`Nothing`

or not. In the first case, we get:

==> Nothing >>= \x -> Just x ==> Nothing ==> f

In the second case, `f`

is `Just a`

. Then, we get:

==> Just a >>= \x -> Just x ==> (\x -> Just x) a ==> Just a ==> f

And the second law is shown. The third law states: ```
f >>= (\x
-> g x >>= h)
```

≡ `(f >>= g) >>= h`

.

If `f`

is `Nothing`

, then the left-hand-side clearly reduces to
`Nothing`

. The right-hand-side reduces to `Nothing >>= h`

which
in turn reduces to `Nothing`

, so they are the same.

Suppose `f`

is `Just a`

. Then the LHS reduces to `g a >>= h`

and the RHS reduces to `(Just a >>= \x -> g x) >>= h`

which in turn
reduces to `g a >>= h`

, so these two are the same.

The idea is that we wish to use the `Left`

constructor to represent
errors on the `Right`

constructor to represent successes. This
leads to an instance declaration like:

instance Monad (Either String) where return x = Right x Left s >>= _ = Left s Right x >>= f = f x fail s = Left s

If we try to use this monad to do search, we get:

**Example:**

Monads> searchAll gr 0 3 :: Either String [Int] Right [0,1,3] Monads> searchAll gr 3 0 :: Either String [Int] Left "no path"

which is exactly what we want.

## Monadic Combinators[edit]

## MonadPlus[edit]

The order to `mplus`

essentially determins the search order. When
the recursive call to `searchAll2`

comes first, we are doing
depth-first search. When the recursive call to `search'`

comes
first, we are doing breadth-first search. Thus, using the list monad,
we expect the solutions to come in the other order:

**Example:**

MPlus> searchAll3 gr 0 3 :: [[Int]] [[0,2,3],[0,1,3]]

Just as we expected.

## Monad Transformers[edit]

This is a very difficult problem; if you found that you were stuck immediately, please just read as much of this solution as you need to try it yourself.

First, we need to define a list transformer monad. This looks like:

newtype ListT m e = ListT { unListT :: m [e] }

The `ListT`

constructor simply wraps a monadic action (in monad
`m`

) which returns a list.

We now need to make this a monad:

instance Monad m => Monad (ListT m) where return x = ListT (return [x]) fail s = ListT (return [] ) ListT m >>= k = ListT $ do l <- m l' <- mapM (unListT . k) l return (concat l')

Here, success is designated by a monadic action which returns a
singleton list. Failure (like in the standard list monad) is
represented by an empty list: of course, it's actually an empty list
returned from the enclosed monad. Binding happens essentially by
running the action which will result in a list `l`

. This has type
`[e]`

. We now need to apply `k`

to each of these elements
(which will result in something of type `ListT m [e2]`

. We need to
get rid of the `ListT`

s around this (by using `unListT`

) and
then concatenate them to make a single list.

Now, we need to make it an instance of `MonadPlus`

instance Monad m => MonadPlus (ListT m) where mzero = ListT (return []) ListT m1 `mplus` ListT m2 = ListT $ do l1 <- m1 l2 <- m2 return (l1 ++ l2)

Here, the zero element is a monadic action which returns an empty list. Addition is done by executing both actions and then concatenating the results.

Finally, we need to make it an instance of `MonadTrans`

:

instance MonadTrans ListT where lift x = ListT (do a <- x; return [a])

Lifting an action into `ListT`

simply involves running it and
getting the value (in this case, `a`

) out and then returning the
singleton list.

Once we have all this together, writing `searchAll6`

is fairly
straightforward:

searchAll6 g@(Graph vl el) src dst | src == dst = do lift $ putStrLn $ "Exploring " ++ show src ++ " -> " ++ show dst return [src] | otherwise = do lift $ putStrLn $ "Exploring " ++ show src ++ " -> " ++ show dst search' el where search' [] = mzero search' ((u,v,_):es) | src == u = (do path <- searchAll6 g v dst return (u:path)) `mplus` search' es | otherwise = search' es

The only change (besides changing the recursive call to call
`searchAll6`

instead of `searchAll2`

) here is that we call
`putStrLn`

with appropriate arguments, lifted into the monad.

If we look at the type of `searchAll6`

, we see that the result
(i.e., after applying a graph and two ints) has type ```
MonadTrans t,
MonadPlus (t IO) => t IO [Int])
```

. In theory, we could use this with
any appropriate monad transformer; in our case, we want to use
`ListT`

. Thus, we can run this by:

**Example:**

MTrans> unListT (searchAll6 gr 0 3) Exploring 0 -> 3 Exploring 1 -> 3 Exploring 3 -> 3 Exploring 2 -> 3 Exploring 3 -> 3 MTrans> it [[0,1,3],[0,2,3]]

This is precisely what we were looking for.
This exercise is actually simpler than the previous one. All we need
to do is incorporate the calls to `putT`

and `getT`

into
`searchAll6`

and add an extra lift to the IO calls. This extra
lift is required because now we're stacking two transformers on top of
IO instead of just one.

searchAll7 g@(Graph vl el) src dst | src == dst = do lift $ lift $ putStrLn $ "Exploring " ++ show src ++ " -> " ++ show dst visited <- getT putT (src:visited) return [src] | otherwise = do lift $ lift $ putStrLn $ "Exploring " ++ show src ++ " -> " ++ show dst visited <- getT putT (src:visited) if src `elem` visited then mzero else search' el where search' [] = mzero search' ((u,v,_):es) | src == u = (do path <- searchAll7 g v dst return (u:path)) `mplus` search' es | otherwise = search' es

The type of this has grown significantly. After applying the graph
and two ints, this has type ```
Monad (t IO), MonadTrans t, MonadPlus
(StateT [Int] (t IO)) => StateT [Int] (t IO) [Int]
```

.

Essentially this means that we've got something that's a state
transformer wrapped on top of some other arbitrary transformer
(`t`

) which itself sits on top of `IO`

. In our case, `t`

is
going to be `ListT`

. Thus, we run this beast by saying:

**Example:**

MTrans> unListT (evalStateT (searchAll7 gr4 0 3) []) Exploring 0 -> 3 Exploring 1 -> 3 Exploring 3 -> 3 Exploring 0 -> 3 Exploring 2 -> 3 Exploring 3 -> 3 MTrans> it [[0,1,3],[0,2,3]]

And it works, even on `gr4`

.

## Parsing Monads[edit]

### A Simple Parsing Monad[edit]

First we write a function `spaces`

which will parse out
whitespaces:

spaces :: Parser () spaces = many (matchChar isSpace) >> return ()

Now, using this, we simply sprinkle calls to `spaces`

through
`intList`

to get `intListSpace`

:

intListSpace :: Parser [Int] intListSpace = do char '[' spaces intList' `mplus` (char ']' >> return []) where intList' = do i <- int spaces r <- (char ',' >> spaces >> intList') `mplus` (char ']' >> return []) return (i:r)

We can test that this works:

**Example:**

Parsing> runParser intListSpace "[1 ,2 , 4 \n\n ,5\n]" Right ("",[1,2,4,5]) Parsing> runParser intListSpace "[1 ,2 , 4 \n\n ,a\n]" Left "expecting char, got 'a'"

=== Parsec ===

We do this by replacing the state functions with push and pop functions as follows:

parseValueLet2 :: CharParser (FiniteMap Char [Int]) Int parseValueLet2 = choice [ int , do string "let " c <- letter char '=' e <- parseValueLet2 string " in " pushBinding c e v <- parseValueLet2 popBinding c return v , do c <- letter fm <- getState case lookupFM fm c of Nothing -> unexpected ("variable " ++ show c ++ " unbound") Just (i:_) -> return i , between (char '(') (char ')') $ do e1 <- parseValueLet2 op <- oneOf "+*" e2 <- parseValueLet2 case op of '+' -> return (e1 + e2) '*' -> return (e1 * e2) ] where pushBinding c v = do fm <- getState case lookupFM fm c of Nothing -> setState (addToFM fm c [v]) Just l -> setState (addToFM fm c (v:l)) popBinding c = do fm <- getState case lookupFM fm c of Just [_] -> setState (delFromFM fm c) Just (_:l) -> setState (addToFM fm c l)

The primary difference here is that instead of calling
`updateState`

, we use two local functions, `pushBinding`

and
`popBinding`

. The `pushBinding`

function takes a variable name
and a value and adds the value onto the head of the list pointed to in
the state `FiniteMap`

. The `popBinding`

function looks at the
value and if there is only one element on the stack, it completely
removes the stack from the `FiniteMap`

; otherwise it just removes
the first element. This means that if something is in the
`FiniteMap`

, the stack is never empty.

This enables us to modify only slightly the usage case; this time, we simply take the top element off the stack when we need to inspect the value of a variable.

We can test that this works:

**Example:**

ParsecI> runParser parseValueLet2 emptyFM "stdin" "((let x=2 in 3+4)*x)" Left "stdin" (line 1, column 20): unexpected variable 'x' unbound