-- | @futhark benchcmp@
module Futhark.CLI.Benchcmp (main) where

import Control.Exception (catch)
import Data.Bifunctor (Bifunctor (bimap, first, second))
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Either qualified as E
import Data.List qualified as L
import Data.Map qualified as M
import Data.Text qualified as T
import Data.Vector qualified as V
import Futhark.Bench
import Futhark.Util (showText)
import Futhark.Util.Options (mainWithOptions)
import Statistics.Sample qualified as S
import System.Console.ANSI (hSupportsANSI)
import System.IO (stdout)
import Text.Printf (printf)

-- | Record that summerizes a comparison between two benchmarks.
data SpeedUp = SpeedUp
  { -- | What factor the benchmark is improved by.
    SpeedUp -> Double
speedup :: Double,
    -- | Memory usage.
    SpeedUp -> Map Text Double
memoryUsage :: M.Map T.Text Double,
    -- | If the speedup was significant.
    SpeedUp -> Bool
significant :: Bool
  }
  deriving (Int -> SpeedUp -> ShowS
[SpeedUp] -> ShowS
SpeedUp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpeedUp] -> ShowS
$cshowList :: [SpeedUp] -> ShowS
show :: SpeedUp -> String
$cshow :: SpeedUp -> String
showsPrec :: Int -> SpeedUp -> ShowS
$cshowsPrec :: Int -> SpeedUp -> ShowS
Show)

-- | Terminal colors used when printing the comparisons. Some of these are not
-- colors ways of emphasising text.
data Colors = Colors
  { -- | The header color.
    Colors -> Text
header :: T.Text,
    -- | Okay color
    Colors -> Text
okblue :: T.Text,
    -- | A second okay color
    Colors -> Text
okgreen :: T.Text,
    -- | Warning color.
    Colors -> Text
warning :: T.Text,
    -- | When something fails.
    Colors -> Text
failing :: T.Text,
    -- | Default color.
    Colors -> Text
endc :: T.Text,
    -- | Bold text.
    Colors -> Text
bold :: T.Text,
    -- | Underline text.
    Colors -> Text
underline :: T.Text
  }

-- | Colors to use for a terminal device.
ttyColors :: Colors
ttyColors :: Colors
ttyColors =
  Colors
    { header :: Text
header = Text
"\ESC[95m",
      okblue :: Text
okblue = Text
"\ESC[94m",
      okgreen :: Text
okgreen = Text
"\ESC[92m",
      warning :: Text
warning = Text
"\ESC[93m",
      failing :: Text
failing = Text
"\ESC[91m",
      endc :: Text
endc = Text
"\ESC[0m",
      bold :: Text
bold = Text
"\ESC[1m",
      underline :: Text
underline = Text
"\ESC[4m"
    }

-- | Colors to use for a non-terminal device.
nonTtyColors :: Colors
nonTtyColors :: Colors
nonTtyColors =
  Colors
    { header :: Text
header = Text
"",
      okblue :: Text
okblue = Text
"",
      okgreen :: Text
okgreen = Text
"",
      warning :: Text
warning = Text
"",
      failing :: Text
failing = Text
"",
      endc :: Text
endc = Text
"",
      bold :: Text
bold = Text
"",
      underline :: Text
underline = Text
""
    }

-- | Reads a file without throwing an error.
readFileSafely :: T.Text -> IO (Either T.Text LBS.ByteString)
readFileSafely :: Text -> IO (Either Text ByteString)
readFileSafely Text
filepath =
  (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
LBS.readFile (Text -> String
T.unpack Text
filepath)) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall {f :: * -> *} {b}.
Applicative f =>
IOError -> f (Either Text b)
couldNotRead
  where
    couldNotRead :: IOError -> f (Either Text b)
couldNotRead IOError
e = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
showText (IOError
e :: IOError)

-- | Converts DataResults to a Map with the text as a key.
toDataResultsMap :: [DataResult] -> M.Map T.Text (Either T.Text Result)
toDataResultsMap :: [DataResult] -> Map Text (Either Text Result)
toDataResultsMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DataResult -> (Text, Either Text Result)
toTuple
  where
    toTuple :: DataResult -> (Text, Either Text Result)
toTuple (DataResult Text
dataset Either Text Result
dataResults) = (Text
dataset, Either Text Result
dataResults)

-- | Converts BenchResults to a Map with the file path as a key.
toBenchResultsMap ::
  [BenchResult] ->
  M.Map T.Text (M.Map T.Text (Either T.Text Result))
toBenchResultsMap :: [BenchResult] -> Map Text (Map Text (Either Text Result))
toBenchResultsMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BenchResult -> (Text, Map Text (Either Text Result))
toTuple
  where
    toTuple :: BenchResult -> (Text, Map Text (Either Text Result))
toTuple (BenchResult String
path [DataResult]
dataResults) =
      (String -> Text
T.pack String
path, [DataResult] -> Map Text (Either Text Result)
toDataResultsMap [DataResult]
dataResults)

-- | Given a file path to a json file which has the form of a futhark benchmark
-- result, it will try to parse the file to a Map of Maps. The key
-- in the outer most dictionary is a file path the inner key is the dataset.
decodeFileBenchResultsMap ::
  T.Text ->
  IO (Either T.Text (M.Map T.Text (M.Map T.Text (Either T.Text Result))))
decodeFileBenchResultsMap :: Text -> IO (Either Text (Map Text (Map Text (Either Text Result))))
decodeFileBenchResultsMap Text
path = do
  Either Text ByteString
file <- Text -> IO (Either Text ByteString)
readFileSafely Text
path
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [BenchResult] -> Map Text (Map Text (Either Text Result))
toBenchResultsMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either Text ByteString
file forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String [BenchResult]
decodeBenchResults))

-- | Will return a text with an error saying there is a missing program in a
-- given result.
formatMissingProg :: T.Text -> T.Text -> T.Text -> T.Text
formatMissingProg :: Text -> Text -> Text -> Text
formatMissingProg = ((String -> Text
T.pack .) .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"In %s but not %s: program %s"

-- | Will return a text with an error saying there is a missing dataset in a
-- given result.
formatMissingData :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text
formatMissingData :: Text -> Text -> Text -> Text -> Text
formatMissingData =
  (((String -> Text
T.pack .) .) .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"In %s but not %s: program %s dataset %s"

-- | Will return texts that say there are a missing program.
formatManyMissingProg :: T.Text -> T.Text -> [T.Text] -> [T.Text]
formatManyMissingProg :: Text -> Text -> [Text] -> [Text]
formatManyMissingProg Text
a_path Text
b_path =
  forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Text -> Text -> Text -> Text
formatMissingProg [Text]
a_paths [Text]
b_paths
  where
    a_paths :: [Text]
a_paths = forall a. a -> [a]
repeat Text
a_path
    b_paths :: [Text]
b_paths = forall a. a -> [a]
repeat Text
b_path

-- | Will return texts that say there are missing datasets for a program.
formatManyMissingData :: T.Text -> T.Text -> T.Text -> [T.Text] -> [T.Text]
formatManyMissingData :: Text -> Text -> Text -> [Text] -> [Text]
formatManyMissingData Text
prog Text
a_path Text
b_path =
  forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
L.zipWith4 Text -> Text -> Text -> Text -> Text
formatMissingData [Text]
a_paths [Text]
b_paths [Text]
progs
  where
    a_paths :: [Text]
a_paths = forall a. a -> [a]
repeat Text
a_path
    b_paths :: [Text]
b_paths = forall a. a -> [a]
repeat Text
b_path
    progs :: [Text]
progs = forall a. a -> [a]
repeat Text
prog

-- | Finds the keys two Maps does not have in common and returns a appropiate
-- error based on the functioned passed.
missingResults ::
  (T.Text -> T.Text -> [T.Text] -> [T.Text]) ->
  T.Text ->
  T.Text ->
  M.Map T.Text a ->
  M.Map T.Text b ->
  [T.Text]
missingResults :: forall a b.
(Text -> Text -> [Text] -> [Text])
-> Text -> Text -> Map Text a -> Map Text b -> [Text]
missingResults Text -> Text -> [Text] -> [Text]
toMissingMap Text
a_path Text
b_path Map Text a
a_results Map Text b
b_results = [Text]
missing
  where
    a_keys :: [Text]
a_keys = forall k a. Map k a -> [k]
M.keys Map Text a
a_results
    b_keys :: [Text]
b_keys = forall k a. Map k a -> [k]
M.keys Map Text b
b_results
    a_missing :: [Text]
a_missing = Text -> Text -> [Text] -> [Text]
toMissingMap Text
a_path Text
b_path forall a b. (a -> b) -> a -> b
$ [Text]
a_keys forall a. Eq a => [a] -> [a] -> [a]
L.\\ [Text]
b_keys
    b_missing :: [Text]
b_missing = Text -> Text -> [Text] -> [Text]
toMissingMap Text
b_path Text
a_path forall a b. (a -> b) -> a -> b
$ [Text]
b_keys forall a. Eq a => [a] -> [a] -> [a]
L.\\ [Text]
a_keys
    missing :: [Text]
missing = [Text]
a_missing forall a. Eq a => [a] -> [a] -> [a]
`L.union` [Text]
b_missing

-- | Compares the memory usage of two results.
computeMemoryUsage ::
  M.Map T.Text Int ->
  M.Map T.Text Int ->
  M.Map T.Text Double
computeMemoryUsage :: Map Text Int -> Map Text Int -> Map Text Double
computeMemoryUsage Map Text Int
a Map Text Int
b = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith forall {a} {a} {a}.
(Fractional a, Integral a, Integral a) =>
a -> a -> a
divide Map Text Int
b forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (forall a. Eq a => a -> a -> Bool
/= Int
0) Map Text Int
a
  where
    divide :: a -> a -> a
divide a
x a
y = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y

-- | Compares two results and thereby computes the Speed Up records.
compareResult :: Result -> Result -> SpeedUp
compareResult :: Result -> Result -> SpeedUp
compareResult Result
a Result
b =
  SpeedUp
    { speedup :: Double
speedup = Double
speedup',
      significant :: Bool
significant = Bool
significant',
      memoryUsage :: Map Text Double
memoryUsage = Map Text Double
memory_usage
    }
  where
    runResultToDouble :: RunResult -> Double
    runResultToDouble :: RunResult -> Double
runResultToDouble = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunResult -> Int
runMicroseconds
    toVector :: Result -> Vector Double
toVector = forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunResult -> Double
runResultToDouble <$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> [RunResult]
runResults
    a_memory_usage :: Map Text Int
a_memory_usage = Result -> Map Text Int
memoryMap Result
a
    b_memory_usage :: Map Text Int
b_memory_usage = Result -> Map Text Int
memoryMap Result
b
    a_run_results :: Vector Double
a_run_results = Result -> Vector Double
toVector Result
a
    b_run_results :: Vector Double
b_run_results = Result -> Vector Double
toVector Result
b
    a_std :: Double
a_std = forall (v :: * -> *). Vector v Double => v Double -> Double
S.stdDev Vector Double
a_run_results
    b_std :: Double
b_std = forall (v :: * -> *). Vector v Double => v Double -> Double
S.stdDev Vector Double
b_run_results
    a_mean :: Double
a_mean = forall (v :: * -> *). Vector v Double => v Double -> Double
S.mean Vector Double
a_run_results
    b_mean :: Double
b_mean = forall (v :: * -> *). Vector v Double => v Double -> Double
S.mean Vector Double
b_run_results
    diff :: Double
diff = forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ Double
a_mean forall a. Num a => a -> a -> a
- Double
b_mean
    speedup' :: Double
speedup' = Double
a_mean forall a. Fractional a => a -> a -> a
/ Double
b_mean
    significant' :: Bool
significant' = Double
diff forall a. Ord a => a -> a -> Bool
> Double
a_std forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ Double
b_std forall a. Fractional a => a -> a -> a
/ Double
2
    memory_usage :: Map Text Double
memory_usage = Map Text Int -> Map Text Int -> Map Text Double
computeMemoryUsage Map Text Int
a_memory_usage Map Text Int
b_memory_usage

-- | Given two Maps containing datasets as keys and results as values, compare
-- the results and return the errors in a tuple.
compareDataResults ::
  T.Text ->
  T.Text ->
  T.Text ->
  M.Map T.Text (Either T.Text Result) ->
  M.Map T.Text (Either T.Text Result) ->
  (M.Map T.Text SpeedUp, ([T.Text], [T.Text]))
compareDataResults :: Text
-> Text
-> Text
-> Map Text (Either Text Result)
-> Map Text (Either Text Result)
-> (Map Text SpeedUp, ([Text], [Text]))
compareDataResults Text
prog Text
a_path Text
b_path Map Text (Either Text Result)
a_data Map Text (Either Text Result)
b_data = (Map Text SpeedUp, ([Text], [Text]))
result
  where
    formatMissing :: Text -> Text -> [Text] -> [Text]
formatMissing = Text -> Text -> Text -> [Text] -> [Text]
formatManyMissingData Text
prog
    partition :: Map k (Either a a) -> ([a], [(k, a)])
partition = forall a b. [Either a b] -> ([a], [b])
E.partitionEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList
    ([Text]
a_errors, Map Text Result
a_data') = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall {k} {a} {a}. Map k (Either a a) -> ([a], [(k, a)])
partition Map Text (Either Text Result)
a_data
    ([Text]
b_errors, Map Text Result
b_data') = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall {k} {a} {a}. Map k (Either a a) -> ([a], [(k, a)])
partition Map Text (Either Text Result)
b_data
    missing :: [Text]
missing = forall a b.
(Text -> Text -> [Text] -> [Text])
-> Text -> Text -> Map Text a -> Map Text b -> [Text]
missingResults Text -> Text -> [Text] -> [Text]
formatMissing Text
a_path Text
b_path Map Text Result
a_data' Map Text Result
b_data'
    exists :: Map Text SpeedUp
exists = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith Result -> Result -> SpeedUp
compareResult Map Text Result
a_data' Map Text Result
b_data'
    errors :: [Text]
errors = [Text]
a_errors forall a. [a] -> [a] -> [a]
++ [Text]
b_errors
    result :: (Map Text SpeedUp, ([Text], [Text]))
result = (Map Text SpeedUp
exists, ([Text]
errors, [Text]
missing))

-- | Given two Maps containing program file paths as keys and values as datasets
-- with results. Compare the results for each dataset in each program and
-- return the errors in a tuple.
compareBenchResults ::
  T.Text ->
  T.Text ->
  M.Map T.Text (M.Map T.Text (Either T.Text Result)) ->
  M.Map T.Text (M.Map T.Text (Either T.Text Result)) ->
  (M.Map T.Text (M.Map T.Text SpeedUp), ([T.Text], [T.Text]))
compareBenchResults :: Text
-> Text
-> Map Text (Map Text (Either Text Result))
-> Map Text (Map Text (Either Text Result))
-> (Map Text (Map Text SpeedUp), ([Text], [Text]))
compareBenchResults Text
a_path Text
b_path Map Text (Map Text (Either Text Result))
a_bench Map Text (Map Text (Either Text Result))
b_bench = (Map Text (Map Text SpeedUp)
exists, ([Text], [Text])
errors_missing)
  where
    missing :: [Text]
missing = forall a b.
(Text -> Text -> [Text] -> [Text])
-> Text -> Text -> Map Text a -> Map Text b -> [Text]
missingResults Text -> Text -> [Text] -> [Text]
formatManyMissingProg Text
a_path Text
b_path Map Text (Map Text (Either Text Result))
a_bench Map Text (Map Text (Either Text Result))
b_bench
    result :: Map Text (Map Text SpeedUp, ([Text], [Text]))
result = forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWithKey Text
-> Map Text (Either Text Result)
-> Map Text (Either Text Result)
-> (Map Text SpeedUp, ([Text], [Text]))
auxiliary Map Text (Map Text (Either Text Result))
a_bench Map Text (Map Text (Either Text Result))
b_bench
    auxiliary :: Text
-> Map Text (Either Text Result)
-> Map Text (Either Text Result)
-> (Map Text SpeedUp, ([Text], [Text]))
auxiliary Text
prog = Text
-> Text
-> Text
-> Map Text (Either Text Result)
-> Map Text (Either Text Result)
-> (Map Text SpeedUp, ([Text], [Text]))
compareDataResults Text
prog Text
a_path Text
b_path
    exists :: Map Text (Map Text SpeedUp)
exists = forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Map Text SpeedUp, ([Text], [Text]))
result
    errors_missing' :: ([Text], [Text])
errors_missing' = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Map Text SpeedUp, ([Text], [Text]))
result
    errors_missing :: ([Text], [Text])
errors_missing = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([Text]
missing ++) ([Text], [Text])
errors_missing'

-- | Formats memory usage such that it is human readable. If the memory usage
-- is not significant an empty text is returned.
memoryFormatter :: Colors -> T.Text -> Double -> T.Text
memoryFormatter :: Colors -> Text -> Double -> Text
memoryFormatter Colors
colors Text
key Double
value
  | Double
value forall a. Ord a => a -> a -> Bool
< Double
0.99 = forall {t}. PrintfArg t => t -> Text
memoryFormat forall a b. (a -> b) -> a -> b
$ Colors -> Text
okgreen Colors
colors
  | Double
value forall a. Ord a => a -> a -> Bool
> Double
1.01 = forall {t}. PrintfArg t => t -> Text
memoryFormat forall a b. (a -> b) -> a -> b
$ Colors -> Text
failing Colors
colors
  | Bool
otherwise = Text
""
  where
    memoryFormat :: t -> Text
memoryFormat t
c = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%s%4.2fx@%s%s" t
c Double
value Text
key Text
endc'
    endc' :: Text
endc' = Colors -> Text
endc Colors
colors

-- | Given a SpeedUp record the memory usage will be formatted to a colored
-- human readable text.
toMemoryText :: Colors -> SpeedUp -> T.Text
toMemoryText :: Colors -> SpeedUp -> Text
toMemoryText Colors
colors SpeedUp
data_result
  | Text -> Bool
T.null Text
memory_text = Text
""
  | Bool
otherwise = Text
" (mem: " forall a. Semigroup a => a -> a -> a
<> Text
memory_text forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    memory_text :: Text
memory_text = forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey Text -> Double -> Text -> Text
formatFolder Text
"" Map Text Double
memory
    memory :: Map Text Double
memory = SpeedUp -> Map Text Double
memoryUsage SpeedUp
data_result
    formatFolder :: Text -> Double -> Text -> Text
formatFolder Text
key Double
value Text
lst = Text
lst forall a. Semigroup a => a -> a -> a
<> Colors -> Text -> Double -> Text
memoryFormatter Colors
colors Text
key Double
value

-- | Given a text shorten it to a given length and add a suffix as the last
-- word.
shorten :: Int -> T.Text -> T.Text -> T.Text
shorten :: Int -> Text -> Text -> Text
shorten Int
c Text
end Text
string
  | Text -> Int
T.length Text
string forall a. Ord a => a -> a -> Bool
> Int
c = ([Text] -> Text
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
shortened) forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
end
  | Bool
otherwise = Text
string
  where
    end_len :: Int
end_len = Text -> Int
T.length Text
end
    (Text
shortened, Text
_) = Int -> Text -> (Text, Text)
T.splitAt (Int
c forall a. Num a => a -> a -> a
- Int
end_len) Text
string

-- | Given a text add padding to the right of the text in form of spaces.
rightPadding :: Int -> T.Text -> T.Text
rightPadding :: Int -> Text -> Text
rightPadding Int
c = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
s
  where
    s :: String
s = String
"%-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
c forall a. Semigroup a => a -> a -> a
<> String
"s"

-- | Given a SpeedUp record print the SpeedUp in a human readable manner.
printSpeedUp :: Colors -> T.Text -> SpeedUp -> IO ()
printSpeedUp :: Colors -> Text -> SpeedUp -> IO ()
printSpeedUp Colors
colors Text
dataset SpeedUp
data_result = do
  let color :: Text
color
        | SpeedUp -> Bool
significant SpeedUp
data_result Bool -> Bool -> Bool
&& SpeedUp -> Double
speedup SpeedUp
data_result forall a. Ord a => a -> a -> Bool
> Double
1.01 = Colors -> Text
okgreen Colors
colors
        | SpeedUp -> Bool
significant SpeedUp
data_result Bool -> Bool -> Bool
&& SpeedUp -> Double
speedup SpeedUp
data_result forall a. Ord a => a -> a -> Bool
< Double
0.99 = Colors -> Text
failing Colors
colors
        | Bool
otherwise = Text
""
  let short_dataset :: Text
short_dataset = Int -> Text -> Text
rightPadding Int
64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> Text
":") forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text -> Text
shorten Int
63 Text
"[...]" Text
dataset
  let memoryText :: Text
memoryText = Colors -> SpeedUp -> Text
toMemoryText Colors
colors SpeedUp
data_result
  let speedup' :: Double
speedup' = SpeedUp -> Double
speedup SpeedUp
data_result
  let endc' :: Text
endc' = Colors -> Text
endc Colors
colors
  let format :: String
format = String
"  %s%s%10.2fx%s%s"
  String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
format Text
short_dataset Text
color Double
speedup' Text
endc' Text
memoryText

-- | Given a Map of SpeedUp records where the key is the program, print the
-- SpeedUp in a human readable manner.
printProgSpeedUps :: Colors -> T.Text -> M.Map T.Text SpeedUp -> IO ()
printProgSpeedUps :: Colors -> Text -> Map Text SpeedUp -> IO ()
printProgSpeedUps Colors
colors Text
prog Map Text SpeedUp
bench_result = do
  String -> IO ()
putStrLn String
""
  String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%s%s%s%s" (Colors -> Text
header Colors
colors) (Colors -> Text
bold Colors
colors) Text
prog (Colors -> Text
endc Colors
colors)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Colors -> Text -> SpeedUp -> IO ()
printSpeedUp Colors
colors)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Text SpeedUp
bench_result

-- | Given a Map of programs with dataset speedups and relevant errors, print
-- the errors and print the speedups in a human readable manner.
printComparisons ::
  Colors ->
  M.Map T.Text (M.Map T.Text SpeedUp) ->
  ([T.Text], [T.Text]) ->
  IO ()
printComparisons :: Colors -> Map Text (Map Text SpeedUp) -> ([Text], [Text]) -> IO ()
printComparisons Colors
colors Map Text (Map Text SpeedUp)
speedups ([Text]
errors, [Text]
missing) = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
L.sort [Text]
missing
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
L.sort [Text]
errors
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Colors -> Text -> Map Text SpeedUp -> IO ()
printProgSpeedUps Colors
colors)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Text (Map Text SpeedUp)
speedups

-- | Run @futhark benchcmp@
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"<file> <file>" [String] -> () -> Maybe (IO ())
f
  where
    f :: [String] -> () -> Maybe (IO ())
f [String
a_path', String
b_path'] () = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
      let a_path :: Text
a_path = String -> Text
T.pack String
a_path'
      let b_path :: Text
b_path = String -> Text
T.pack String
b_path'
      Either Text (Map Text (Map Text (Either Text Result)))
a_either <- Text -> IO (Either Text (Map Text (Map Text (Either Text Result))))
decodeFileBenchResultsMap Text
a_path
      Either Text (Map Text (Map Text (Either Text Result)))
b_either <- Text -> IO (Either Text (Map Text (Map Text (Either Text Result))))
decodeFileBenchResultsMap Text
b_path

      Bool
isTty <- Handle -> IO Bool
hSupportsANSI Handle
stdout

      let colors :: Colors
colors =
            if Bool
isTty
              then Colors
ttyColors
              else Colors
nonTtyColors

      let comparePrint :: Map Text (Map Text (Either Text Result))
-> Map Text (Map Text (Either Text Result)) -> IO ()
comparePrint =
            (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Colors -> Map Text (Map Text SpeedUp) -> ([Text], [Text]) -> IO ()
printComparisons Colors
colors) .)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Text
-> Map Text (Map Text (Either Text Result))
-> Map Text (Map Text (Either Text Result))
-> (Map Text (Map Text SpeedUp), ([Text], [Text]))
compareBenchResults Text
a_path Text
b_path

      case (Either Text (Map Text (Map Text (Either Text Result)))
a_either, Either Text (Map Text (Map Text (Either Text Result)))
b_either) of
        (Left Text
a, Left Text
b) -> String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ (Text
a forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
b)
        (Left Text
a, Either Text (Map Text (Map Text (Either Text Result)))
_) -> String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
a
        (Either Text (Map Text (Map Text (Either Text Result)))
_, Left Text
b) -> String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
b
        (Right Map Text (Map Text (Either Text Result))
a, Right Map Text (Map Text (Either Text Result))
b) -> Map Text (Map Text (Either Text Result))
-> Map Text (Map Text (Either Text Result)) -> IO ()
comparePrint Map Text (Map Text (Either Text Result))
a Map Text (Map Text (Either Text Result))
b
    f [String]
_ ()
_ = forall a. Maybe a
Nothing