{-# LANGUAGE TemplateHaskell, CPP #-}
module Main where

import NoSlow.Main.TH
import NoSlow.Main.Tree
import NoSlow.Main.Util ( (>++<) )
import NoSlow.Util.Base ( Sort(..) )
import NoSlow.Util.Tag
import qualified NoSlow.Util.Opts as O

import Criterion
import Criterion.Config
import Criterion.Monad  ( withConfig )
import Criterion.Environment ( measureEnvironment )

import System.Console.GetOpt
import System.Environment       ( getArgs, getProgName )
import System.Exit              ( ExitCode(..) )
import Data.Monoid              ( Last(..) )
import Data.Version             ( showVersion )

import Paths_NoSlow ( version )

import qualified NoSlow.Micro.Kernels as Micro
import qualified NoSlow.Mini.Kernels as Mini

import qualified NoSlow.Micro.List
import qualified NoSlow.Micro.List.Double

#ifdef USE_DPH_PRIM_SEQ
import qualified NoSlow.Micro.DPH.Prim.Seq
import qualified NoSlow.Micro.DPH.Prim.Seq.Double
#endif

#ifdef USE_VECTOR
import qualified NoSlow.Micro.Vector.Unsafe.Unboxed
import qualified NoSlow.Micro.Vector.Unsafe.Unboxed.Double
import qualified NoSlow.Micro.Vector.Unsafe.Primitive
import qualified NoSlow.Micro.Vector.Unsafe.Primitive.Double
import qualified NoSlow.Micro.Vector.Unsafe.Storable
import qualified NoSlow.Micro.Vector.Unsafe.Storable.Double
import qualified NoSlow.Micro.Vector.Unsafe.Boxed
import qualified NoSlow.Micro.Vector.Unsafe.Boxed.Double
import qualified NoSlow.Micro.Vector.Unboxed
import qualified NoSlow.Micro.Vector.Unboxed.Double
import qualified NoSlow.Micro.Vector.Primitive
import qualified NoSlow.Micro.Vector.Primitive.Double
import qualified NoSlow.Micro.Vector.Storable
import qualified NoSlow.Micro.Vector.Storable.Double
import qualified NoSlow.Micro.Vector.Boxed
import qualified NoSlow.Micro.Vector.Boxed.Double
#endif

#ifdef USE_UVECTOR
import qualified NoSlow.Micro.Uvector
import qualified NoSlow.Micro.Uvector.Double
#endif

#ifdef USE_STORABLEVECTOR
import qualified NoSlow.Micro.StorableVector
import qualified NoSlow.Micro.StorableVector.Double
#endif

import qualified NoSlow.Mini.List

#ifdef USE_DPH_PRIM_SEQ
import qualified NoSlow.Mini.DPH.Prim.Seq
#endif

#ifdef USE_VECTOR
import qualified NoSlow.Mini.Vector.Unsafe.Unboxed
import qualified NoSlow.Mini.Vector.Unsafe.Primitive
import qualified NoSlow.Mini.Vector.Unsafe.Storable
import qualified NoSlow.Mini.Vector.Unsafe.Boxed
import qualified NoSlow.Mini.Vector.Unboxed
import qualified NoSlow.Mini.Vector.Primitive
import qualified NoSlow.Mini.Vector.Storable
import qualified NoSlow.Mini.Vector.Boxed
#endif

#ifdef USE_UVECTOR
import qualified NoSlow.Mini.Uvector
#endif

#ifdef USE_STORABLEVECTOR
import qualified NoSlow.Mini.StorableVector
#endif

all_kernels = $(benchtrees "*Double" Generic     [t|Double|] Micro.kernels micro_tree)
         >++< $(benchtrees "Double"  Specialised [t|Double|] Micro.kernels micro_tree)

         >++< $(benchtrees "mini"    Generic     [t|()|]     Mini.kernels  mini_tree)

main = do
         opts <- O.parseAll defaultOpts allOptions =<< getArgs
         writeFile (optOutputFile opts) "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB\n"
         withConfig (optsToConfig opts) $
           do
             env <- measureEnvironment
             let shouldRun s = case reads s of
                                 [(tag, "")] -> optShouldRun opts tag
             runAndAnalyse shouldRun env
                        $ bgroup ""
                        $ all_kernels 10000

data Opts = Opts {
              optConfInterval :: Double
            , optPerformGC    :: Bool
            , optResamples    :: Int
            , optSamples      :: Int
            , optVerbosity    :: Verbosity
            , optOutputFile   :: String
            , optShouldRun    :: Tag -> Bool
            }

defaultOpts :: Opts
defaultOpts = Opts {
                optConfInterval = from_config cfgConfInterval
              , optPerformGC    = True
              , optResamples    = from_config cfgResamples
              , optSamples      = from_config cfgSamples
              , optVerbosity    = Normal
              , optOutputFile   = "noslow.log"
              , optShouldRun    = const True
              }
  where
    from_config :: (Config -> Last a) -> a
    from_config f = case f defaultConfig of
                      Last (Just x) -> x

addFilter :: (Tag -> Bool) -> Opts -> Opts
addFilter f opts@(Opts { optShouldRun = p })
  = opts { optShouldRun = \t -> p t && f t }

optsToConfig :: Opts -> Config
optsToConfig opts = defaultConfig {
                      cfgConfInterval = ljust $ optConfInterval opts
                    , cfgPerformGC    = ljust $ optPerformGC opts
                    , cfgResamples    = ljust $ optResamples opts
                    , cfgSamples      = ljust $ optSamples opts
                    , cfgVerbosity    = ljust $ optVerbosity opts
                    , cfgSummaryFile  = ljust $ optOutputFile opts
                    , cfgBanner       = ljust $ showVersion version
                    }

type OptM = O.OptM Opts

allOptions :: [OptDescr OptM]
allOptions = [
   Option ['b'] ["bench"]
          (O.selArg O.matchName addFilter "LIST")
          "only run some benchmarks"
 , Option ['l'] ["lib"]
          (O.selArg O.matchLib addFilter "LIST")
          "only benchmark the specified libraries"
 , Option ['g'] ["group"]
          (O.selArg O.matchGroup addFilter "LIST")
          "only run benchmarks from the specified benchmark group"
 , Option ['o'] ["output"]
          (O.reqArg (\s opt -> opt { optOutputFile = s }) "FILE")
          "store benchmark results in this file"
 , Option [] ["gc"]
          (O.noArg $ \opt -> opt { optPerformGC = True })
          "collect garbage between iterations"
 , Option [] ["no-gc"]
          (O.noArg $ \opt -> opt { optPerformGC = False })
          "do not collect garbage between iterations"
 , Option ['I'] ["ci"]
          (O.readArg "confidence interval"
                     (\(CI ci) -> ci > 0 && ci < 1)
                     (\(CI ci) opt -> opt { optConfInterval = ci }) "CI")
          "bootstrap confidence interval"
 , Option ['r'] ["resamples"]
          (O.readArg "resample count" (>0)
                     (\n opt -> opt { optResamples = n }) "N")
          "number of bootstrap resamples to perform"
 , Option ['s'] ["samples"]
          (O.readArg "sample count" (>0)
                     (\n opt -> opt { optSamples = n }) "N")
          "number of samples to collect"
 , Option ['v'] ["verbose"]
          (O.noArg $ \opt -> opt { optVerbosity = Verbose })
          "print more output"
 , Option ['q'] ["quiet"]
          (O.noArg $ \opt -> opt { optVerbosity = Quiet })
          "print less output"
 , Option ['V'] ["version"]
          (O.helpArg printVersion)
          "output version, then exit"
 , Option ['h','?'] ["help"]
          (O.helpArg printUsage)
          "output help"
 ]

newtype CI = CI Double

instance Read CI where
  readsPrec n s = map upd (readsPrec n s')
    where
      upd (d,'%':t) = (CI (d/100),t)
      upd (d,t)     = (CI d,t)

      s' = case s of
             '.' : _ -> '0':s
             _       -> s

printVersion :: IO ()
printVersion = putStrLn (showVersion version)

printUsage :: IO ()
printUsage = do
  p <- getProgName
  putStrLn (usageInfo ("Usage: " ++ p ++ " [OPTIONS]") allOptions)