bft.hs

module Main where

main :: IO ()
main = print $ example

-- The binary tree type.
data Tree a = Tree a (Tree a) (Tree a) | Nil
  deriving (Show)

-- Breadth-first traversal
bft :: Tree a -> [a]
bft t = let q = enqueue t emptyQ
        in bft' q
  where
    bft' :: Queue (Tree a) -> [a]
    bft' q = case dequeue q of
              (Nothing, _) -> []
              (Just (Tree n t0 t1), q') -> let q_t0 = enqueue t0 q'
                                               q_t1 = enqueue t1 q_t0
                                            in (n:bft' q_t1)
              (Just Nil, q') -> bft' q'
    
-- An example tree.
example :: [Integer]
example = bft
  (Tree 1
    (Tree 2
      (Tree 3
        Nil
        Nil)
      Nil)
    (Tree 4
      Nil
      (Tree 5
        Nil
        (Tree 6
          Nil
          Nil))))

-- The queue type.
data Queue a = Queue { ready :: [a], reversed :: [a] }
  deriving (Show)

emptyQ :: Queue a
emptyQ = Queue [] []

enqueue :: a -> Queue a -> Queue a
enqueue a q = Queue (ready q) (a : (reversed q))

dequeue :: Queue a -> (Maybe a, Queue a)
dequeue (Queue [] []) = (Nothing, emptyQ)
dequeue (Queue [] rev) = dequeue (Queue (reverse rev) [])
dequeue (Queue (x:rdy) rev) = (Just x, Queue rdy rev)