# Haskell/YAHT/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