{-# LANGUAGE ScopedTypeVariables, QuasiQuotes #-}
module QuickBench (
defaultMain
)
where
import Control.Exception
import Control.Monad
import Data.List
import Data.List.Split (splitOn)
import Data.Maybe
import Data.Time.Clock
import Data.Time.Format
import Data.Time.LocalTime
import Safe
import System.Console.Docopt
import System.Directory
import System.Environment
import System.Exit
import System.IO
import System.Process
import Text.Show.Pretty
import Text.Printf
import Text.Tabular
import qualified Text.Tabular.AsciiArt as TA
docoptpatterns :: Docopt
docoptpatterns :: Docopt
docoptpatterns = [docopt|quickbench 1.0
Run some test commands, possibly with different executables, once or more
and show their best execution times.
Commands are specified as one or more quote-enclosed arguments,
and/or one per line in CMDSFILE; or read from a default file [./bench.sh].
With -w, commands' first words are replaced with a new executable
(or multiple comma-separated executables, showing times for all).
Note: tests executable files only, not shell builtins; options must precede args.
Usage:
quickbench [options] [<cmd>...]
Options:
-f, --file CMDSFILE file containing commands, one per line (- for stdin)
-w, --with EXE[,...] replace first word of commands with these executables
-n, --iterations=N run each test this many times [default: 1]
-N, --cycles=N run the whole suite this many times [default: 1]
-p, --precision=N show times with this many decimal places [default: 2]
-v, --verbose show commands being run
-V, --more-verbose show command output
--debug show debug output for this program
-h, --help show this help
|]
defaultFile :: FilePath
defaultFile :: [Char]
defaultFile = [Char]
"bench.sh"
data Opts = Opts {
Opts -> Maybe [Char]
file :: Maybe FilePath
,Opts -> [[Char]]
executables :: [String]
,Opts -> Size
iterations :: Int
,Opts -> Size
cycles :: Int
,Opts -> Size
precision :: Int
,Opts -> Bool
verbose :: Bool
,Opts -> Bool
moreVerbose :: Bool
,Opts -> Bool
debug :: Bool
,Opts -> Bool
help :: Bool
,Opts -> [[Char]]
clicmds :: [String]
} deriving (Size -> Opts -> ShowS
[Opts] -> ShowS
Opts -> [Char]
(Size -> Opts -> ShowS)
-> (Opts -> [Char]) -> ([Opts] -> ShowS) -> Show Opts
forall a.
(Size -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Opts] -> ShowS
$cshowList :: [Opts] -> ShowS
show :: Opts -> [Char]
$cshow :: Opts -> [Char]
showsPrec :: Size -> Opts -> ShowS
$cshowsPrec :: Size -> Opts -> ShowS
Show)
getOpts :: IO Opts
getOpts :: IO Opts
getOpts = do
Arguments
dopts <- Docopt -> [[Char]] -> IO Arguments
parseArgsOrExit Docopt
docoptpatterns ([[Char]] -> IO Arguments) -> IO [[Char]] -> IO Arguments
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [[Char]]
getArgs
let
flag :: [Char] -> Bool
flag [Char]
f = Arguments
dopts Arguments -> Option -> Bool
`isPresent` [Char] -> Option
longOption [Char]
f
option :: [Char] -> Maybe [Char]
option [Char]
f = Arguments
dopts Arguments -> Option -> Maybe [Char]
`getArg` [Char] -> Option
longOption [Char]
f
readint :: [Char] -> m a
readint [Char]
s =
case [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMay [Char]
s of
Just a
a -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Maybe a
Nothing -> [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ [Char]
"could not read " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" as an integer"
([[Char]]
lateflags,[[Char]]
args) = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([Char]
"-" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ([[Char]] -> ([[Char]], [[Char]]))
-> [[Char]] -> ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ Arguments
dopts Arguments -> Option -> [[Char]]
`getAllArgs` ([Char] -> Option
argument [Char]
"cmd")
Size
iterations' <- [Char] -> IO Size
forall a (m :: * -> *). (Read a, MonadFail m) => [Char] -> m a
readint ([Char] -> IO Size) -> [Char] -> IO Size
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
option [Char]
"iterations"
Size
cycles' <- [Char] -> IO Size
forall a (m :: * -> *). (Read a, MonadFail m) => [Char] -> m a
readint ([Char] -> IO Size) -> [Char] -> IO Size
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
option [Char]
"cycles"
Size
precision' <- [Char] -> IO Size
forall a (m :: * -> *). (Read a, MonadFail m) => [Char] -> m a
readint ([Char] -> IO Size) -> [Char] -> IO Size
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
option [Char]
"precision"
let
opts :: Opts
opts = Opts :: Maybe [Char]
-> [[Char]]
-> Size
-> Size
-> Size
-> Bool
-> Bool
-> Bool
-> Bool
-> [[Char]]
-> Opts
Opts {
file :: Maybe [Char]
file = [Char] -> Maybe [Char]
option [Char]
"file"
,executables :: [[Char]]
executables = [[Char]] -> ([Char] -> [[Char]]) -> Maybe [Char] -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
",") (Maybe [Char] -> [[Char]]) -> Maybe [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
option [Char]
"with"
,iterations :: Size
iterations = Size
iterations'
,cycles :: Size
cycles = Size
cycles'
,precision :: Size
precision = Size
precision'
,verbose :: Bool
verbose = [Char] -> Bool
flag [Char]
"verbose"
,moreVerbose :: Bool
moreVerbose = [Char] -> Bool
flag [Char]
"more-verbose"
,debug :: Bool
debug = [Char] -> Bool
flag [Char]
"debug"
,help :: Bool
help = [Char] -> Bool
flag [Char]
"help"
,clicmds :: [[Char]]
clicmds = [[Char]]
args
}
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opts -> Bool
debug Opts
opts Bool -> Bool -> Bool
|| [Char]
"--debug" [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
lateflags) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> IO ()
err ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"docopts: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Arguments -> [Char]
forall a. Show a => a -> [Char]
ppShow Arguments
dopts [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Opts -> [Char]
forall a. Show a => a -> [Char]
ppShow Opts
opts [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opts -> Bool
help Opts
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn (Docopt -> [Char]
usage Docopt
docoptpatterns) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess
case ([[Char]]
lateflags, [[Char]]
args) of
([Char]
f:[[Char]]
_,[]) -> [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
forall r. PrintfType r => [Char] -> r
printf [Char]
"option %s needs a value or is unknown" (ShowS
forall a. Show a => a -> [Char]
show [Char]
f)
([Char]
f:[[Char]]
_,[Char]
a:[[Char]]
_) -> [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> ShowS
forall r. PrintfType r => [Char] -> r
printf [Char]
"option %s should appear before argument %s or is unknown" (ShowS
forall a. Show a => a -> [Char]
show [Char]
f) (ShowS
forall a. Show a => a -> [Char]
show [Char]
a)
([[Char]], [[Char]])
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Opts -> IO Opts
forall (m :: * -> *) a. Monad m => a -> m a
return Opts
opts
defaultMain :: IO (Maybe String)
defaultMain :: IO (Maybe [Char])
defaultMain =
(IO ()
runSuite IO () -> IO (Maybe [Char]) -> IO (Maybe [Char])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
IO (Maybe [Char])
-> (SomeException -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
e :: SomeException) -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$
if SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e Maybe ExitCode -> Maybe ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just ExitCode
ExitSuccess
then Maybe [Char]
forall a. Maybe a
Nothing
else [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
where
runSuite :: IO ()
runSuite = do
Opts
opts <- IO Opts
getOpts
[[Char]]
filecmds <-
(([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
istest ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines) ([Char] -> [[Char]]) -> IO [Char] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(case (Opts -> Maybe [Char]
file Opts
opts, Opts -> [[Char]]
clicmds Opts
opts) of
(Just [Char]
"-", [[Char]]
_) -> IO [Char]
getContents
(Just [Char]
f, [[Char]]
_) -> [Char] -> IO [Char]
readFile [Char]
f
(Maybe [Char]
Nothing, []) -> [Char] -> IO Bool
doesFileExist [Char]
defaultFile IO Bool -> (Bool -> IO [Char]) -> IO [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\Bool
yes -> if Bool
yes then [Char] -> IO [Char]
readFile [Char]
defaultFile else [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""
(Maybe [Char]
Nothing, [[Char]]
_) -> [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
let cmds :: [[Char]]
cmds = [[Char]]
filecmds [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Opts -> [[Char]]
clicmds Opts
opts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
cmds) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Opts -> [Char] -> IO ()
out Opts
opts [Char]
"No test commands found; provide some as arguments, with -f, or in ./bench.sh\n"
IO ()
forall a. IO a
exitSuccess
ZonedTime
now <- IO ZonedTime
getCurrentZonedTime
Opts -> [Char] -> IO ()
out Opts
opts ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Size -> Size -> [Char] -> ShowS
forall r. PrintfType r => [Char] -> r
printf [Char]
"Running %d tests %d times%s at %s:\n"
([[Char]] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [[Char]]
cmds)
(Opts -> Size
iterations Opts
opts)
(case Opts -> [[Char]]
executables Opts
opts of
[] -> [Char]
""
[[Char]]
es -> [Char] -> Size -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
" with %d executables" ([[Char]] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [[Char]]
es))
(TimeLocale -> [Char] -> ZonedTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%Y-%m-%d %T %Z" ZonedTime
now)
let
exes :: [[Char]]
exes = case Opts -> [[Char]]
executables Opts
opts of
[] -> [[Char]
""]
[[Char]]
es -> [[Char]]
es
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
[Size] -> (Size -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Size
1..Opts -> Size
cycles Opts
opts] ((Size -> IO ()) -> IO ()) -> (Size -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Size
cyc -> do
[[[Float]]]
results <- ([Char] -> IO [[Float]]) -> [[Char]] -> IO [[[Float]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Opts -> [[Char]] -> [Char] -> IO [[Float]]
runTestWithExes Opts
opts [[Char]]
exes) [[Char]]
cmds
Opts -> [[Char]] -> [[Char]] -> Size -> [[[Float]]] -> IO ()
printSummary Opts
opts [[Char]]
cmds [[Char]]
exes Size
cyc [[[Float]]]
results
getCurrentZonedTime :: IO ZonedTime
getCurrentZonedTime :: IO ZonedTime
getCurrentZonedTime = do
UTCTime
t <- IO UTCTime
getCurrentTime
TimeZone
tz <- IO TimeZone
getCurrentTimeZone
ZonedTime -> IO ZonedTime
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonedTime -> IO ZonedTime) -> ZonedTime -> IO ZonedTime
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
tz UTCTime
t
runTestWithExes :: Opts -> [String] -> String -> IO [[Float]]
runTestWithExes :: Opts -> [[Char]] -> [Char] -> IO [[Float]]
runTestWithExes Opts
opts [[Char]]
exes [Char]
cmd = ([Char] -> IO [Float]) -> [[Char]] -> IO [[Float]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Opts -> [Char] -> [Char] -> IO [Float]
runTestWithExe Opts
opts [Char]
cmd) [[Char]]
exes
runTestWithExe :: Opts -> String -> String -> IO [Float]
runTestWithExe :: Opts -> [Char] -> [Char] -> IO [Float]
runTestWithExe Opts
opts [Char]
cmd [Char]
exe = (Size -> IO Float) -> [Size] -> IO [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Opts -> [Char] -> [Char] -> Size -> IO Float
runTestOnce Opts
opts [Char]
cmd [Char]
exe) [Size
1..Opts -> Size
iterations Opts
opts]
runTestOnce :: Opts -> String -> String -> Int -> IO Float
runTestOnce :: Opts -> [Char] -> [Char] -> Size -> IO Float
runTestOnce Opts
opts [Char]
cmd [Char]
exe Size
iteration = do
let ([Char]
cmd',[Char]
exe',[[Char]]
args) = [Char] -> [Char] -> ([Char], [Char], [[Char]])
replaceExecutable [Char]
exe [Char]
cmd
Opts -> [Char] -> IO ()
dbg Opts
opts ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> ShowS
forall r. PrintfType r => [Char] -> r
printf [Char]
"replaceExecutable: %s -> %s\n" (([Char], [Char]) -> [Char]
forall a. Show a => a -> [Char]
show ([Char]
cmd,[Char]
exe)) (([Char], [Char], [[Char]]) -> [Char]
forall a. Show a => a -> [Char]
show ([Char]
cmd',[Char]
exe',[[Char]]
args))
Opts -> [Char] -> IO ()
outv Opts
opts (Size -> [Char]
forall a. Show a => a -> [Char]
show Size
iteration [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
cmd' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n")
Float
t <- Opts -> [Char] -> [[Char]] -> IO Float
time Opts
opts [Char]
exe' [[Char]]
args
Opts -> [Char] -> IO ()
outv Opts
opts ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
forall r. PrintfType r => [Char] -> r
printf [Char]
"\t[%ss]\n" (Opts -> Float -> [Char]
showtime Opts
opts Float
t)
Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
t
replaceExecutable :: String -> String -> (String,String,[String])
replaceExecutable :: [Char] -> [Char] -> ([Char], [Char], [[Char]])
replaceExecutable [Char]
exe [Char]
"" = ([Char]
exe, [Char]
exe, [])
replaceExecutable [Char]
"" [Char]
cmd = ([Char]
cmd, [Char]
w, [[Char]]
ws) where [Char]
w:[[Char]]
ws = [Char] -> [[Char]]
words ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ShowS
clean [Char]
cmd
replaceExecutable [Char]
exe [Char]
cmd = ([[Char]] -> [Char]
unwords ([Char]
exe[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
args), [Char]
exe, [[Char]]
args) where args :: [[Char]]
args = Size -> [[Char]] -> [[Char]]
forall a. Size -> [a] -> [a]
drop Size
1 ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
words ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ShowS
clean [Char]
cmd
time :: Opts -> String -> [String] -> IO Float
time :: Opts -> [Char] -> [[Char]] -> IO Float
time Opts
opts [Char]
exe [[Char]]
args = do
UTCTime
t1 <- IO UTCTime
getCurrentTime
(ExitCode
c, [Char]
o, [Char]
e) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode' [Char]
exe [[Char]]
args [Char]
""
UTCTime
t2 <- IO UTCTime
getCurrentTime
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
o) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Opts -> [Char] -> IO ()
outvv Opts
opts ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ (if Opts -> Bool
verbose Opts
opts then [Char]
"\n" else [Char]
"") [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
o
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
c ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Opts -> [Char] -> IO ()
out Opts
opts ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
" (error: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
clean [Char]
e [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
") "
Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> IO Float) -> Float -> IO Float
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> Float) -> NominalDiffTime -> Float
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t2 UTCTime
t1
readProcessWithExitCode' :: FilePath -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode' :: [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode' [Char]
exe [[Char]]
args [Char]
inp =
[Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
exe [[Char]]
args [Char]
inp
IO (ExitCode, [Char], [Char])
-> (IOException -> IO (ExitCode, [Char], [Char]))
-> IO (ExitCode, [Char], [Char])
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e :: IOException) -> (ExitCode, [Char], [Char]) -> IO (ExitCode, [Char], [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Size -> ExitCode
ExitFailure Size
1, [Char]
"", IOException -> [Char]
forall a. Show a => a -> [Char]
show IOException
e)
printSummary :: Opts -> [String] -> [String] -> Int -> [[[Float]]] -> IO ()
printSummary :: Opts -> [[Char]] -> [[Char]] -> Size -> [[[Float]]] -> IO ()
printSummary Opts
opts [[Char]]
cmds [[Char]]
exes Size
cyc [[[Float]]]
results = do
Opts -> [Char] -> IO ()
out Opts
opts ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
forall r. PrintfType r => [Char] -> r
printf [Char]
"\nBest times%s:\n" (if Opts -> Size
cycles Opts
opts Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
1 then [Char]
" "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Size -> [Char]
forall a. Show a => a -> [Char]
show Size
cyc else [Char]
"")
let t :: Table [Char] [Char] [Char]
t = Opts
-> [[Char]]
-> [[Char]]
-> [[[Float]]]
-> Table [Char] [Char] [Char]
maketable Opts
opts [[Char]]
cmds' [[Char]]
exes [[[Float]]]
results
Opts -> [Char] -> IO ()
out Opts
opts ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS -> ShowS -> ShowS -> Table [Char] [Char] [Char] -> [Char]
forall rh ch a.
(rh -> [Char])
-> (ch -> [Char]) -> (a -> [Char]) -> Table rh ch a -> [Char]
TA.render ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id Table [Char] [Char] [Char]
t
where
cmds' :: [[Char]]
cmds' =
case Opts -> [[Char]]
executables Opts
opts of
[] -> [[Char]]
cmds
[[Char]
e] -> [[Char]
c | ([Char]
c,[Char]
_,[[Char]]
_) <- ([Char] -> ([Char], [Char], [[Char]]))
-> [[Char]] -> [([Char], [Char], [[Char]])]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> ([Char], [Char], [[Char]])
replaceExecutable [Char]
e) [[Char]]
cmds]
[[Char]]
_ -> ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> [[Char]] -> [[Char]]
forall a. Size -> [a] -> [a]
drop Size
1 ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words) [[Char]]
cmds
maketable :: Opts -> [String] -> [String] -> [[[Float]]] -> Table String String String
maketable :: Opts
-> [[Char]]
-> [[Char]]
-> [[[Float]]]
-> Table [Char] [Char] [Char]
maketable Opts
opts [[Char]]
rownames [[Char]]
colnames [[[Float]]]
results = Header [Char]
-> Header [Char] -> [[[Char]]] -> Table [Char] [Char] [Char]
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header [Char]
rowhdrs Header [Char]
colhdrs [[[Char]]]
rows
where
rowhdrs :: Header [Char]
rowhdrs = Properties -> [Header [Char]] -> Header [Char]
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header [Char]] -> Header [Char])
-> [Header [Char]] -> Header [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Header [Char]) -> [[Char]] -> [Header [Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Header [Char]
forall h. h -> Header h
Header ([[Char]] -> [Header [Char]]) -> [[Char]] -> [Header [Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall (t :: * -> *) a b.
(PrintfArg (t a), PrintfType b, Foldable t) =>
[t a] -> [b]
padright [[Char]]
rownames
colhdrs :: Header [Char]
colhdrs = Properties -> [Header [Char]] -> Header [Char]
forall h. Properties -> [Header h] -> Header h
Group Properties
SingleLine ([Header [Char]] -> Header [Char])
-> [Header [Char]] -> Header [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Header [Char]) -> [[Char]] -> [Header [Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Header [Char]
forall h. h -> Header h
Header [[Char]]
colnames
rows :: [[[Char]]]
rows = ([[Float]] -> [[Char]]) -> [[[Float]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([Float] -> [Char]) -> [[Float]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Opts -> Float -> [Char]
showtime Opts
opts (Float -> [Char]) -> ([Float] -> Float) -> [Float] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum)) [[[Float]]]
results
padright :: [t a] -> [b]
padright [t a]
ss = (t a -> b) -> [t a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> t a -> b
forall r. PrintfType r => [Char] -> r
printf ([Char] -> Size -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%%-%ds" Size
w)) [t a]
ss
where w :: Size
w = [Size] -> Size
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Size] -> Size) -> [Size] -> Size
forall a b. (a -> b) -> a -> b
$ (t a -> Size) -> [t a] -> [Size]
forall a b. (a -> b) -> [a] -> [b]
map t a -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [t a]
ss
showtime :: Opts -> (Float -> String)
showtime :: Opts -> Float -> [Char]
showtime Opts
opts = [Char] -> Float -> [Char]
forall r. PrintfType r => [Char] -> r
printf ([Char] -> Float -> [Char]) -> [Char] -> Float -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"%." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Size -> [Char]
forall a. Show a => a -> [Char]
show (Opts -> Size
precision Opts
opts) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"f"
istest :: String -> Bool
istest :: [Char] -> Bool
istest [Char]
s = Bool -> Bool
not ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s' Bool -> Bool -> Bool
|| ([Char]
"#" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
s')) where s' :: [Char]
s' = ShowS
clean [Char]
s
clean :: String -> String
clean :: ShowS
clean = [[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words
out :: Opts -> String -> IO ()
out :: Opts -> [Char] -> IO ()
out Opts
_ = [Char] -> IO ()
putStr
outv :: Opts -> String -> IO ()
outv :: Opts -> [Char] -> IO ()
outv Opts
opts [Char]
s = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opts -> Bool
verbose Opts
opts Bool -> Bool -> Bool
|| Opts -> Bool
moreVerbose Opts
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr [Char]
s
outvv :: Opts -> String -> IO ()
outvv :: Opts -> [Char] -> IO ()
outvv Opts
opts [Char]
s = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opts -> Bool
moreVerbose Opts
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr [Char]
s
err :: String -> IO ()
err :: [Char] -> IO ()
err = Handle -> [Char] -> IO ()
hPutStr Handle
stderr
dbg :: Opts -> String -> IO ()
dbg :: Opts -> [Char] -> IO ()
dbg Opts
opts [Char]
s = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opts -> Bool
debug Opts
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
err [Char]
s