Haskell help, /prog/!


-- create a random tree.
randomTree :: Random r => IO (BinaryTree r)
randomTree =
     -- randomly pick the left and right sides.
  do leftIO  <- pick(randomLeaf, randomBranch)
     rightIO <- pick(randomLeaf, randomBranch)
     -- "un-IO" the sides.
     left    <- leftIO
     right   <- rightIO
     -- get a random value for the top of the branch/tree.
     value   <- randomIO
     -- create branch and return.
     return (Branch left value right)
  where
    -- return left or right at random.
    pick (left, right) =
      do useLeft <- randomRIO(True, False)
         if useLeft then return left else return right
    -- create a random leaf.
    randomLeaf =
      do value <- randomIO
         let leaf = Leaf value
         return leaf
    -- setup an alias.
    randomBranch = randomTree

This code actually works fine, but I'm wondering if there's a way to simplify the "leftIO/rightIO" stuff. Is there some sort of "double arrow" that will un-Monad twice, or is this verbosity unavoidable?

>>16
>but if it takes several people and several iterations of Perl-like mess to write a simple tree algorithm
>serveral iterations
It's called refactoring. There's really only three versions: OP, >>2 and >>10

>Perl-like mess
Excuse me? >>1 and >>10 don't look like Perl, though I admit they might scare off noobs. The final version is actually quite clean and nice.

>simple tree algorithm
It only looks simple because it's in Haskell. This "function" can generate random trees of integers, characters, bools, and even *other trees.* Further, if anyone defines a new type and makes it an instance of the Random class, this function could generate random trees of that type, too, with no code changes.

It also looks simple because it's recursive, which is not a problem in since Haskell compilers optimize recursion.

BinaryTree.hs

module BinaryTree where

import Control.Monad
import Random

data BinaryTree a = Leaf a
                  | Branch (BinaryTree a) a (BinaryTree a)
                  deriving (Eq, Show)

instance Random r => Random (BinaryTree r) where
  -- create a random tree. I should probably re-write this somehow in
  -- randomR/random, but that's hard, so let's go shopping.
  randomIO = liftM3 Branch randomBranch randomIO randomBranch
    where
      randomBranch = randomRIO (0, 1) >>= ([liftM Leaf randomIO, randomIO] !!)

-- return a list of the elements of a tree from bottom-left.
elements :: BinaryTree a -> [a]
elements (Leaf a) = [a]
elements (Branch l a r) = elements l ++ [a] ++ elements r

-- get the maximum height of a tree.
height :: Integral i => BinaryTree a -> i
height (Leaf _) = 1
height (Branch l a r) = 1 + max (height l) (height r)

-- map a function onto a tree to produce a new tree.
treeMap :: (a -> b) -> BinaryTree a -> BinaryTree b
treeMap f (Leaf a) = Leaf (f a)
treeMap f (Branch l a r) = Branch (treeMap f l) (f a) (treeMap f r)

Main.hs

module Main where

import BinaryTree
import Random

main = do tree <- randomIO :: IO (BinaryTree (BinaryTree Integer)
          putStrLn $ show tree
          putStrLn $ show $ height tree