module Test.SBench.Space.Single.MakeExecutable
    ( make
    , makeWith
    ) 
  where

import System.FilePath ( FilePath, addExtension )
import System.Process ( system )
import System.IO ( writeFile )
import Data.Maybe ( fromMaybe )
import Control.Monad ( liftM2 )

import Test.SBench.Options ( 
    opts2string
  , Repetitions
  , CompilerOptions
  , TestOpts (..)
  , Imports
  , NormalInput
  )

import Test.SBench.STerm ( Algorithm, Data, Seed, STerm(..), getImports )
import Test.SBench.Space.OptionSet ( generalCOpts )

import Criterion.Measurement ( time )

make :: TestOpts -> Algorithm (a -> b) -> Data a -> FilePath -> IO FilePath
make topts = makeWith (nfInp topts) (reps topts) (cOpts topts)

makeWith :: NormalInput -> Maybe Repetitions -> CompilerOptions -> Algorithm (a -> b) -> Data a -> 
    FilePath -> IO FilePath
makeWith nfinp rep copts f a out =
  let source    = addExtension out "hs"
      strcopts  = opts2string $ generalCOpts ++ copts
      autoGen   = calcRepetitions nfinp copts f a
  in do
        putStrLn $ "The repetitions: " ++ show rep
        putStrLn $ "Input normalized: " ++ show nfinp
        rep' <- case rep of { Nothing -> autoGen; Just r -> return r }
        writeFile (addExtension out "hs") (makeContent nfinp rep' f a)
        putStrLn $ "running: ghc " ++ strcopts ++ " -o " ++ out ++ " " ++ source
        system $ "ghc " ++ strcopts ++ " -o " ++ out ++ " " ++ source
        return out

-- | Find a reasonable number of repetitions of the function to measure, such that 
--   the overall runtime is long enough to get enough heap samples.
--   The function is far from perfect and may need a rewrite.
calcRepetitions :: NormalInput -> CompilerOptions -> Algorithm (a -> b) -> Data a -> IO Int
calcRepetitions nfinp = calcRepetitions' nfinp 10

calcRepetitions' :: NormalInput -> Int -> CompilerOptions -> Algorithm (a -> b) -> Data a -> IO Int
calcRepetitions' nfinp rep copts f a =
  do
     writeFile "rep_check.hs" (makeContent nfinp rep f a)
     putStrLn $ "Calculating reasonable number of repetitions trying with " ++ show rep ++ " ..."
     system $ "ghc " ++ opts2string ("--make" : copts) ++ " -o rep_check rep_check.hs"
     putStrLn $ "start executing rep_check ..."
     system "chmod +x rep_check"
     (t, _) <- time $ system "./rep_check"
     putStrLn $ "... finish executing rep_check"
     putStrLn $ "Time was " ++ show t ++ " seconds."
     if t > 0.001
       then 
          do
            let reps' = truncate $ 1 * fromIntegral rep / t + 1
                reps  = max reps' 100
            putStrLn $ "Testing with " ++ show reps ++ " repetitions (expecting at least 1s runtime without profiling, but quarantee at least 100 runs)"
            return reps
       else calcRepetitions' nfinp (10 * rep) copts f a        


-- * auxiliar functions to build the program file
makeContent :: NormalInput -> Int -> Algorithm (a -> b) -> Data a -> String
makeContent nfinp rep f a =
    header 
 ++ imports 
 ++ "\n" 
 ++ makeMain nfinp rep f a
  where
    imports = (imports2string defltImport) ++ getImports f ++ getImports a
    makeMain nfinp rep f a = 
         "main = \n"
      ++ "    let dat  = " ++ stName a ++ "\n"
      ++ "        dat' = if " ++ show nfinp ++ " then deepseq dat dat else dat \n"
      ++ "        res  = map " 
         ++ stName f ++ " as \n"
      ++ "        as = take " ++ show rep ++ " (repeat dat') in \n"
      ++ "    deepseq res (putStrLn \"Done.\")"



header :: String
header = "module Main where \n"


defltImport = [ "Control.DeepSeq ( deepseq )" ]

imports2string :: Imports -> String
imports2string xs = unlines $ map ("import " ++) xs