{-# LANGUAGE BangPatterns #-}
module Main where

import Control.DeepSeq
import Control.Exception (evaluate)
import Control.Monad.Trans (liftIO)
import Criterion.Config
import Criterion.Main
import Data.List (foldl')
import qualified Data.IntMap as M
import qualified IntMap_FindGE as M
import Data.Maybe (fromMaybe)
import Prelude hiding (lookup)

main = do
    defaultMainWith
        defaultConfig
        (liftIO . evaluate $ rnf [m_even, m_odd, m_large])
        ([b f | b <- benches, f <- funs1] ++ 
         [b f | b <- benches, f <- funs2])
  where
    m_even = M.fromAscList elems_even :: M.IntMap Int
    m_odd  = M.fromAscList elems_odd :: M.IntMap Int
    m_large = M.fromAscList elems_large :: M.IntMap Int
    bound = 2^12
    elems_even  = zip evens evens
    elems_odd   = zip odds odds
    elems_large = zip large large
    evens = [2,4..bound]
    odds  = [1,3..bound]
    large = [1,100..50*bound]
    benches = 
          [ \(n,fun) -> bench (n++" present")  $ nf (fge fun evens) m_even
          , \(n,fun) -> bench (n++" absent")   $ nf (fge fun evens) m_odd
          , \(n,fun) -> bench (n++" far")      $ nf (fge fun odds)  m_large
          , \(n,fun) -> bench (n++" !present") $ nf (fge2 fun evens) m_even
          , \(n,fun) -> bench (n++" !absent")  $ nf (fge2 fun evens) m_odd
          , \(n,fun) -> bench (n++" !far")     $ nf (fge2 fun odds)  m_large
          ]
    funs1 = [("GE split",M.findGreaterEqual1)
            ,("GE Craig",M.findGreaterEqual2)
            ,("GE def",M.findGreaterEqual3)]
    funs2 = [("GT split",M.findGreater1)
            ,("GT def",M.findGreater3)]

fge :: (Int -> M.IntMap Int -> Maybe (Int,Int)) -> [Int] -> M.IntMap Int -> (Int,Int)
fge fun xs m = foldl' (\n k -> fromMaybe n (fun k m)) (0,0) xs

-- forcing values inside tuples!
fge2 :: (Int -> M.IntMap Int -> Maybe (Int,Int)) -> [Int] -> M.IntMap Int -> (Int,Int)
fge2 fun xs m = foldl' (\n@(!a,!b) k -> fromMaybe n (fun k m)) (0,0) xs