module Test.SBench.Space.Series.Test ( 
    makeSeries
  , maxMemSeries
  , maxMemSeriesWith
  ) where 

import Test.SBench.Options ( NormalInput, TestOpts(..) )
import Test.SBench.STerm ( Algorithm, DataGen, Seed, Data, STerm(..), (<$>) )
import Test.SBench.Space.OptionSet ( setNfInput, addCC, defltTestOpts )
import Test.SBench.Space.Single.Test ( getMaxMemWith )
import Test.SBench.Options ( opts2string, Title )
import Test.SBench.File.FileOps ( series2sbench )

import System.FilePath ( FilePath )
import Control.Monad ( liftM )

makeSeries :: (Show c, Real c, Show d, Real d) =>
                 (TestOpts -> Algorithm (a -> b) -> Data a -> FilePath -> IO d) -- ^ Function for a single test.
              -> TestOpts           
              -> (FilePath, Title)   -- ^ File where the result data should be stored and title for the
                                     --   measurement graph (stored as meta information in the .sbench file)
              -> Algorithm (a -> b)  -- ^ Function to be tested
              -> DataGen (c -> a)    -- ^ Input data generator. It is fed with the input seeds.
              -> [Seed c]            -- ^ Input seeds, given to the input data generator to produce an input.
              -> IO [(c, d)]         -- ^ List of input seed-measurement pairs.
makeSeries fun topts (outf, title) alg gen seeds = 
    let b = opts2string $ cOpts topts
        r = show $ rOpts topts
    in do
    s <- liftM (zip (map stTerm seeds)) (mapM go seeds)
    series2sbench (b, r) Nothing alg gen title outf s >> return s
  where
    tst  = fun topts alg
    go i = tst (gen <$> i) (outf ++ stName i)

-- | The function measures the maximal heap consumption of a given function over a series of different inputs
--   that are produced via an input generator given different seeds.
maxMemSeries :: (Show c, Real c) => 
                   NormalInput            -- ^ Shall input data first be normalized? (Boolean value)
                   -> (FilePath, Title)   -- ^ Output data file (will get extension .sbench) and title for the
                                          --   graph of the data stored as meta information.
                   -> Algorithm (a -> b)  -- ^ Function to benchmark
                   -> DataGen (c -> a)    -- ^  Input data generator. It is fed with the input seeds.
                   -> [Seed c]            -- ^ Input seeds, given to the input data generator to produce an input.
                   -> IO [(c, Integer)]   -- ^ List of input seed-maximal heap consumption pairs.
maxMemSeries nfinp ft alg = maxMemSeriesWith (setNfInput nfinp $ addCC alg $ defltTestOpts) ft alg

-- | The function acts similar to 'maxMemSeries', but instead of only 'NormalInput', 'TestOpts' can be set manually
--   via the first parameter.
maxMemSeriesWith :: (Show c, Real c) => TestOpts -> (FilePath, Title) -> Algorithm (a -> b) -> DataGen (c -> a) -> [Seed c] -> IO [(c, Integer)]
maxMemSeriesWith topts ft alg gen seeds =
    makeSeries getMaxMemWith topts ft alg gen seeds