module Bench where

import System.CPUTime

import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad

import System.Time
import System.CPUTime
import System.Random
import Data.Tree.AVL
import Data.COrdering
import System.Environment
import System.Mem
import Data.Typeable
import Control.Monad.Trans
import Data.Trie as Trie
import Data.Tree
import Data.List

type Context = [String]

type Measure = (Context, Integer)

type Benchmark = ReaderT Context (WriterT [Measure] IO)


blift :: IO a -> Benchmark a
blift = lift . lift

__ = undefined

withLab :: String -> Benchmark a -> Benchmark a
withLab label = local (++[label])

time :: a -> Benchmark a
time value = do 
     t1 <- blift getCPUTime
     blift performGC
     t2 <- blift getCPUTime
     result <- return $! value
     t3 <- blift getCPUTime
     blift performGC
     t4 <- blift getCPUTime
     withLab "GC before" $ report (t2-t1)
     withLab "computation" $ report (t3-t2)
     withLab "GC after" $ report (t4-t3)
     return result
    
report :: Integer -> Benchmark () 
report time = do ctx <- ask
                 tell [(ctx, time)]
                 return ()

withType :: Typeable t => t -> Benchmark a -> Benchmark a
withType t = withLab (show $ typeOf t)

many :: Int -> Benchmark a -> Benchmark ()
many n bench = sequence_ (replicate n bench)

runBenchmark :: Benchmark a -> IO a
runBenchmark bench = do (a, results) <- runWriterT (runReaderT bench []) 
                        let t = Trie.fromListWith (++) [(l,[m]) | (l,m) <- results]
                            t :: Trie Context String [Integer]
                            tree = Trie.toTree "" t 
                        putStrLn $ drawTree $ fmap showNode $ tree
                        return a

average list = sum list `div` genericLength list 

showNode (label, Nothing) = label
showNode (label, Just x) = label ++ " -> " ++ show (average x)