{-
Copyright 2010 Leon P Smith
This file is provided under the Creative Commons Attribution Only license

This file demonstrates how to combine continuations with Jones and Gibbon's
breadth-first labelling algorithm.  This file is described at the following
locations:

http://blog.melding-monads.com/2009/12/30/fun-with-the-lazy-state-monad
http://blog.melding-monads.com/2010/08/25/fun-with-the-lazy-state-monad-part-2
-}

{-# LANGUAGE PackageImports #-}

import "mtl" Control.Monad.State
import "mtl" Control.Monad.Cont
import Data.Ratio(Ratio, (%), numerator, denominator)

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

fib n = fibs !! (n - 1)
  where
    fibs = Leaf 0 : Leaf 0 : zipWith3 Branch [1..] fibs (tail fibs)

sternBrocot :: Tree a (Ratio Integer)
sternBrocot = loop 0 1 1 0
   where
     loop a b x y
         = Branch (m%n) (loop a b m n) (loop m n x y)
           where
             m  = a + x
             n  = b + y

lower :: Monad m => ContT a m a -> m a
lower m = runContT m return

type FreshCC r n = ContT r (State [n])

fresh :: Num n => FreshCC r n n
fresh = lift $ do
  (n:ns) <- get
  put (n+1 : ns)
  return n

down :: FreshCC a n a -> FreshCC r n a
down m = lift $ do
  (n:ns) <- get 
  put ns 
  a <- lower m
  ns' <- get
  put (n:ns')
  return a

runFreshCC :: n -> FreshCC a n a -> a
runFreshCC n m = a
  where (a, ns) = runState (lower m) (n:ns)

renum :: Num n => Tree a b -> Tree n n
renum = runFreshCC 0 . loop 
  where
    loop (Leaf _) = do
       n <- fresh
       return (Leaf n)
    loop (Branch _ a b) = do
       n  <- fresh 
       a' <- down (loop a)
       b' <- down (loop b)
       return (Branch n a' b')