module Test.Maybench where
import System.Time
import System.Cmd (system)
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
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 $ snd 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)