-- | Functions for runtime tests are provided. They are basically a wrapper to 
--   a call to the criterion function "Criterion.Main.defaultMainWith".
--   The measurement data (usually stored in temp.csv) is than postprocessed
--   by extracting only the mean runtime for each run and tupling it with the
--   respective input seed.
--   Results are then returned as list of tuples and optionally stored in a
--   .sbench file (see "Test.File.FileOps").

module Test.SBench.Time.Series.Test ( 
    runtimeSeries
  , runtimeSeriesWith
  , nfRuntimeSeries
  , whnfRuntimeSeries 
  , scaleRt
  ) where

import Criterion.Main ( defaultMainWith, bgroup, bench, nf, whnf )
import Criterion.Config ( Config(..), defaultConfig )
import Data.Monoid ( Last(..) ) 
import System.FilePath ( (<.>), dropExtension )
import qualified Control.DeepSeq ( NFData, deepseq )

import Test.SBench.STerm ( Algorithm, DataGen, Seed, STerm (..), (<$>) )
import Test.SBench.Options ( EvalMod (..), Title )
import Test.SBench.File.FileOps ( criterion2series, series2sbench )

type BuildOptions = String
type ExeOptions = String

scaleRt :: Double -> [(Int, Double)] -> [(Int, Double)]
scaleRt f = map (\(x,y) -> (x,f*y))

defltCriterionFile = "temp" <.> "csv"

-- | Most general function to perform runtime measurements for a series of inputs.
runtimeSeriesWith :: (Control.DeepSeq.NFData b, Show c, Real c) => 
                        Config  -- ^ see "Criterion.Config.Config"
                     -> EvalMod -- ^ Evaluation level of the input before starting the measurement.
                                --   Either weak head normal form ('WHNF') or normal form ('NF')
                     -> Maybe (BuildOptions, ExeOptions, FilePath, Title) 
                                -- ^ Choose, whether you want to create a .sbench file and if give 
                                --   meta information about build options, execution options as well
                                --   as the file name for the .sbench file and the title for the
                                --   measurements that should be stored as meta information.
                     -> Algorithm (a -> b) -- ^ The function that is to be tested.
                     -> DataGen (c -> a)   -- ^ The input data generator
                     -> [Seed c]           -- ^ Seeds to the input data generator. For each seed
                                           --   a measurement is performed. A list of seeds might
                                           --   be generated via "Test.SBench.Auxiliar.Datagen.makeGens"
                     -> IO [(c, Double)]   -- ^ series of the measurements as seed-runtime pairs.
runtimeSeriesWith cfg evalMod sbfile alg gen seeds = do
    putStrLn "enter criterion benchmarking .."
    t <- defaultMainWith cfg (return ()) benches
    putStrLn $ "finished criterion benchmarking with " ++ show t
    s <- criterion2series (map stTerm seeds) file
    case sbfile of
      Nothing -> return s
      Just (b,e,f,t)  -> series2sbench (b, e) (Just evalMod) alg gen t f s 
                         >> return s
  where
    file = case cfgSummaryFile cfg of
               Last (Just f) -> f
               _             -> defltCriterionFile
    benches = [ bgroup (dropExtension file) $ map (toBench gen) seeds ]
    toBench gen seed  = let inp = gen <$> seed in bench (stName inp) $ efun (stTerm alg) (stTerm inp)
    efun    = case evalMod of
                NF   -> nf
                WHNF -> whnf

-- | As 'runtimeSeriesWith', but "Criterion.Config.Config" is set to a default.
runtimeSeries :: (Control.DeepSeq.NFData b, Show c, Real c) => 
                    EvalMod
                 -> Maybe (BuildOptions, ExeOptions, FilePath, Title) 
                 -> Algorithm (a -> b) 
                 -> DataGen (c -> a) 
                 -> [Seed c] 
                 -> IO [(c, Double)]
runtimeSeries = runtimeSeriesWith defaultConfig {cfgSummaryFile = Last $ Just $ defltCriterionFile }


nfRuntimeSeries :: (Control.DeepSeq.NFData b, Show c, Real c) => 
                      Maybe (BuildOptions, ExeOptions, FilePath, Title) 
                   -> Algorithm (a -> b) 
                   -> DataGen (c -> a) 
                   -> [Seed c] 
                   -> IO [(c, Double)]
nfRuntimeSeries = runtimeSeries NF 

whnfRuntimeSeries :: (Control.DeepSeq.NFData b, Show c, Real c) => 
                        Maybe (BuildOptions, ExeOptions, FilePath, Title)
                     -> Algorithm (a -> b)
                     -> DataGen (c -> a)
                     -> [Seed c]
                     -> IO [(c, Double)]
whnfRuntimeSeries = runtimeSeries WHNF