module Test.Maybench where

import System.Time
import System.Cmd (system) -- ideally this should use System.Process in the future, but for the sake of a first version this will do.
import Data.Maybe (maybe, isJust, fromJust)
import Control.Monad (when)
import Control.Monad.State (MonadIO, liftIO)
import System.Directory (findExecutable)
import System.IO (putStr,hPutStr,hClose,hGetContents)
import System.Process (waitForProcess, runInteractiveProcess)

import Test.Maybench.Command (CommandModifier, Command(Cmd), modifyCmd)
import Test.BenchPress ( benchmark, mean )

data Benchmark = Benchmark {benchIters :: Int, benchTimes :: [TimeDiff]}

run :: MonadIO m => CommandModifier m -> m (String, String)
run cmd = modifyCmd cmd >>= (\m -> runC $ m (Cmd "" [] ""))

runC :: MonadIO m => Command -> m (String, String)
runC (Cmd exe' args input) = liftIO $ do
  exe <- findExecutable exe' >>= maybe (fail $ "cannot find " ++ exe') return
  putStr "Running... "
  let cmd_str = unwords $ map showSh (exe:args)
  putStrLn cmd_str
  (output, err) <- runProcessWithInput exe args input
  return (output, err)
  where showSh x | ' ' `elem` x = show x
                 | otherwise = x

runProcessWithInput :: FilePath -> [String] -> String -> IO (String, String)
runProcessWithInput cmd args input = do
    (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing
    hPutStr pin input
    hClose pin
    output <- hGetContents pout
    when (output==output) $ return ()
    err <- hGetContents perr
    when (err==err) $ return ()
    hClose pout
    hClose perr
    waitForProcess ph -- should check exit code here...
    return (output, err)

averageTime :: String -> String -> String -> Int -> IO Double
averageTime cmd setup cleanup n = do
  stats <- benchmark n (system setup)
                       (const $ system cleanup)
                       (const $ system cmd)
  return $ mean stats


showTimeDiff :: (String, TimeDiff) -> String
showTimeDiff (cmd,td) = case filter isJust [helper tdYear "years",
                                            helper tdMonth "months",
                                            helper tdDay "days",
                                            helper tdHour "hours",
                                            helper tdMin "minutes",
                                            helper tdSec "seconds"]
                        of [] -> (show cmd) ++ " took less than a second."
                           xs -> (((show cmd) ++ " took ") ++) . intercalate ", " . map fromJust $ xs
    where helper accessor string = if accessor td > 0
                                   then (Just (show (accessor td) ++ " " ++ string))
                                   else Nothing
          intercalate _ [] = []
          intercalate x (y:ys) = y++x++intercalate x ys

printTimeDiff :: (String, TimeDiff) -> IO ()
printTimeDiff = putStrLn . showTimeDiff

minute, hour, day, month, year :: Int
minute = 60
hour = minute * 60
day = hour * 24
month = day * 30
year = day * 365

timeDiffToSeconds :: TimeDiff -> Int
timeDiffToSeconds td = tdSec td + (tdMin td) * minute + (tdHour td) * hour + (tdDay td) * day + (tdMonth td) * month + (tdYear td) * year

secondsToTimeDiff :: Int -> TimeDiff
secondsToTimeDiff sec = normalizeTimeDiff $ TimeDiff 0 0 0 0 0 sec 0

compareTimes :: Fractional a => (String, a) -> (String, a) -> Maybe String
compareTimes (cmd1,t1) (cmd2,t2) =
  Just $ show cmd2 ++ " took " ++ show (t1 `percentage` t2)
         ++ "% of the time "   ++ show cmd1 ++ " took."
    where percentage x y = (100 * x / y)