Session 33: Monads

We covered Sections 1 to 4 of Winstanley's article. Hudak's tutorial covers the topic in Chapter 9 also, but I think Winstanley presents the topic in a much more comprehensible manner.

Suppose we want to write a function numItems which takse a tree of strings and assigns numbers to each distinct string. For example:

     zero                       0
	/    \                     / \
 one      two       should   1     2
         /   \                    / \
       one   three  become       1   3
	   / \                      / \
     two one                    2 1

{-
 - definition of Tree type, member of Eq and Show classes
 -}
data Tree a = Nil | Node a (Tree a) (Tree a) deriving Eq

instance (Show a) => Show (Tree a) where
    showsPrec _ tree = let
                        showsTree Nil = ("--"++)
                        showsTree (Node info left right)
                            = ("("++) . showsTree left . (" "++) . shows info
                                . (" "++) . showsTree right . (")"++)
                       in showsTree tree

{-
 - definition of State type, member of Monad class
 -}
data State a b = State ([a] -> ([a], b))

instance Monad (State a) where
    return x = State (\table -> (table, x))
    (State st) >>= f = State (\table -> let
                                            (newTable, x) = st table
                                            (State next)  = f x
                                        in  next newTable)

-- extracts value from state
extractValue (State f) = let (_,ret) = f [] in ret

-- determines value associated with info
makeValue info
 = let
    lookup info i [] = error "not found"
    lookup info i (x:xs) = if x == info then i else lookup info (i + 1) xs
   in State (\table -> if elem info table
                       then (table, lookup info 0 table)
                       else (table ++ [info], length table))

{-
 - definition of function for numbering items found in tree
 -}
numberItems tree =
    let
        num Nil = return Nil
        num (Node info left right)
           = do newInfo <- makeValue info
                newLeft <- num left
                newRight <- num right
                return (Node newInfo newLeft newRight)
    in extractValue (num tree)

{-
 - test case illustrating how function should work:
 -
 -     zero                       0
 - one      two       should   1     2
 -       one   three  become       1   3
 -     two one                    2 1
 -}
base = Node "zero"
        (Node "one" Nil Nil)
        (Node "two"
            (Node "one" (Node "two" Nil Nil) (Node "one" Nil Nil))
            (Node "three" Nil Nil))
baseNumbered = numberItems base