    -- | @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
    (Int -> SpeedUp -> ShowS)
    -> (SpeedUp -> String) -> ([SpeedUp] -> ShowS) -> Show SpeedUp
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SpeedUp -> ShowS
    showsPrec :: Int -> SpeedUp -> ShowS
    $cshow :: SpeedUp -> String
    show :: SpeedUp -> String
    $cshowList :: [SpeedUp] -> ShowS
    showList :: [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 =
      (ByteString -> Either Text ByteString
    forall a b. b -> Either a b
    Right (ByteString -> Either Text ByteString)
    -> IO ByteString -> IO (Either Text ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO ByteString
    LBS.readFile (Text -> String
    T.unpack Text
    filepath)) IO (Either Text ByteString)
    -> (IOError -> IO (Either Text ByteString))
    -> IO (Either Text ByteString)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` IOError -> IO (Either Text ByteString)
    forall {f :: * -> *} {b}.
    Applicative f =>
    IOError -> f (Either Text b)
    couldNotRead
      where
        couldNotRead :: IOError -> f (Either Text b)
    couldNotRead IOError
    e = Either Text b -> f (Either Text b)
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either Text b -> f (Either Text b))
    -> Either Text b -> f (Either Text b)
    forall a b. (a -> b) -> a -> b
    $ Text -> Either Text b
    forall a b. a -> Either a b
    Left (Text -> Either Text b) -> Text -> Either Text b
    forall a b. (a -> b) -> a -> b
    $ IOError -> Text
    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 = [(Text, Either Text Result)] -> Map Text (Either Text Result)
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Text, Either Text Result)] -> Map Text (Either Text Result))
    -> ([DataResult] -> [(Text, Either Text Result)])
    -> [DataResult]
    -> Map Text (Either Text Result)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DataResult -> (Text, Either Text Result))
    -> [DataResult] -> [(Text, Either Text Result)]
    forall a b. (a -> b) -> [a] -> [b]
    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 = [(Text, Map Text (Either Text Result))]
    -> Map Text (Map Text (Either Text Result))
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Text, Map Text (Either Text Result))]
     -> Map Text (Map Text (Either Text Result)))
    -> ([BenchResult] -> [(Text, Map Text (Either Text Result))])
    -> [BenchResult]
    -> Map Text (Map Text (Either Text Result))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (BenchResult -> (Text, Map Text (Either Text Result)))
    -> [BenchResult] -> [(Text, Map Text (Either Text Result))]
    forall a b. (a -> b) -> [a] -> [b]
    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
      file <- Text -> IO (Either Text ByteString)
    readFileSafely Text
    path
      pure $ toBenchResultsMap <$> (file >>= (first T.pack . 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 (String -> Text) -> (Text -> String) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) ((Text -> String) -> Text -> Text)
    -> (Text -> Text -> String) -> Text -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) ((Text -> Text -> String) -> Text -> Text -> Text)
    -> (Text -> Text -> Text -> String) -> Text -> Text -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text -> Text -> Text -> String
    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 (String -> Text) -> (Text -> String) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) ((Text -> String) -> Text -> Text)
    -> (Text -> Text -> String) -> Text -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) ((Text -> Text -> String) -> Text -> Text -> Text)
    -> (Text -> Text -> Text -> String) -> Text -> Text -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) ((Text -> Text -> Text -> String) -> Text -> Text -> Text -> Text)
    -> (Text -> Text -> Text -> Text -> String)
    -> Text
    -> Text
    -> Text
    -> Text
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text -> Text -> Text -> Text -> String
    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 =
      (Text -> Text -> Text -> Text)
    -> [Text] -> [Text] -> [Text] -> [Text]
    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 = Text -> [Text]
    forall a. a -> [a]
    repeat Text
    a_path
        b_paths :: [Text]
    b_paths = Text -> [Text]
    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 =
      (Text -> Text -> Text -> Text -> Text)
    -> [Text] -> [Text] -> [Text] -> [Text] -> [Text]
    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 = Text -> [Text]
    forall a. a -> [a]
    repeat Text
    a_path
        b_paths :: [Text]
    b_paths = Text -> [Text]
    forall a. a -> [a]
    repeat Text
    b_path
        progs :: [Text]
    progs = Text -> [Text]
    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 = Map Text a -> [Text]
    forall k a. Map k a -> [k]
    M.keys Map Text a
    a_results
        b_keys :: [Text]
    b_keys = Map Text b -> [Text]
    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 ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ [Text]
    a_keys [Text] -> [Text] -> [Text]
    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 ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ [Text]
    b_keys [Text] -> [Text] -> [Text]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [Text]
    a_keys
        missing :: [Text]
    missing = [Text]
    a_missing [Text] -> [Text] -> [Text]
    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 = (Int -> Int -> Double)
    -> Map Text Int -> Map Text Int -> Map Text Double
    forall k a b c.
    Ord k =>
    (a -> b -> c) -> Map k a -> Map k b -> Map k c
    M.intersectionWith Int -> Int -> Double
    forall {a} {a} {a}.
    (Fractional a, Integral a, Integral a) =>
    a -> a -> a
    divide Map Text Int
    b (Map Text Int -> Map Text Double)
    -> Map Text Int -> Map Text Double
    forall a b. (a -> b) -> a -> b
    $ (Int -> Bool) -> Map Text Int -> Map Text Int
    forall a k. (a -> Bool) -> Map k a -> Map k a
    M.filter (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0) Map Text Int
    a
      where
        divide :: a -> a -> a
    divide a
    x a
    y = a -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x a -> a -> a
    forall a. Fractional a => a -> 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 = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Double) -> (RunResult -> Int) -> RunResult -> Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RunResult -> Int
    runMicroseconds
        toVector :: Result -> Vector Double
    toVector = [Double] -> Vector Double
    forall a. [a] -> Vector a
    V.fromList ([Double] -> Vector Double)
    -> (Result -> [Double]) -> Result -> Vector Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RunResult -> Double
    runResultToDouble (RunResult -> Double) -> [RunResult] -> [Double]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) ([RunResult] -> [Double])
    -> (Result -> [RunResult]) -> Result -> [Double]
    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 = Vector Double -> Double
    forall (v :: * -> *). Vector v Double => v Double -> Double
    S.stdDev Vector Double
    a_run_results
        b_std :: Double
    b_std = Vector Double -> Double
    forall (v :: * -> *). Vector v Double => v Double -> Double
    S.stdDev Vector Double
    b_run_results
        a_mean :: Double
    a_mean = Vector Double -> Double
    forall (v :: * -> *). Vector v Double => v Double -> Double
    S.mean Vector Double
    a_run_results
        b_mean :: Double
    b_mean = Vector Double -> Double
    forall (v :: * -> *). Vector v Double => v Double -> Double
    S.mean Vector Double
    b_run_results
        diff :: Double
    diff = Double -> Double
    forall a. Num a => a -> a
    abs (Double -> Double) -> Double -> Double
    forall a b. (a -> b) -> a -> b
    $ Double
    a_mean Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    b_mean
        speedup' :: Double
    speedup' = Double
    a_mean Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    b_mean
        significant' :: Bool
    significant' = Double
    diff Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    a_std Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    2 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Double
    b_std Double -> Double -> Double
    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 = [Either a (k, a)] -> ([a], [(k, a)])
    forall a b. [Either a b] -> ([a], [b])
    E.partitionEithers ([Either a (k, a)] -> ([a], [(k, a)]))
    -> (Map k (Either a a) -> [Either a (k, a)])
    -> Map k (Either a a)
    -> ([a], [(k, a)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((k, Either a a) -> Either a (k, a))
    -> [(k, Either a a)] -> [Either a (k, a)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (k, Either a a) -> Either a (k, a)
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => (k, m a) -> m (k, a)
    sequence ([(k, Either a a)] -> [Either a (k, a)])
    -> (Map k (Either a a) -> [(k, Either a a)])
    -> Map k (Either a a)
    -> [Either a (k, a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map k (Either a a) -> [(k, Either a a)]
    forall k a. Map k a -> [(k, a)]
    M.toList
        ([Text]
    a_errors, Map Text Result
    a_data') = ([(Text, Result)] -> Map Text Result)
    -> ([Text], [(Text, Result)]) -> ([Text], Map Text Result)
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second [(Text, Result)] -> Map Text Result
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList (([Text], [(Text, Result)]) -> ([Text], Map Text Result))
    -> ([Text], [(Text, Result)]) -> ([Text], Map Text Result)
    forall a b. (a -> b) -> a -> b
    $ Map Text (Either Text Result) -> ([Text], [(Text, Result)])
    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') = ([(Text, Result)] -> Map Text Result)
    -> ([Text], [(Text, Result)]) -> ([Text], Map Text Result)
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second [(Text, Result)] -> Map Text Result
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList (([Text], [(Text, Result)]) -> ([Text], Map Text Result))
    -> ([Text], [(Text, Result)]) -> ([Text], Map Text Result)
    forall a b. (a -> b) -> a -> b
    $ Map Text (Either Text Result) -> ([Text], [(Text, Result)])
    forall {k} {a} {a}. Map k (Either a a) -> ([a], [(k, a)])
    partition Map Text (Either Text Result)
    b_data
        missing :: [Text]
    missing = (Text -> Text -> [Text] -> [Text])
    -> Text -> Text -> Map Text Result -> Map Text Result -> [Text]
    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 = (Result -> Result -> SpeedUp)
    -> Map Text Result -> Map Text Result -> Map Text SpeedUp
    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 [Text] -> [Text] -> [Text]
    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 = (Text -> Text -> [Text] -> [Text])
    -> Text
    -> Text
    -> Map Text (Map Text (Either Text Result))
    -> Map Text (Map Text (Either Text Result))
    -> [Text]
    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 = (Text
     -> Map Text (Either Text Result)
     -> Map Text (Either Text Result)
     -> (Map Text SpeedUp, ([Text], [Text])))
    -> Map Text (Map Text (Either Text Result))
    -> Map Text (Map Text (Either Text Result))
    -> Map Text (Map Text SpeedUp, ([Text], [Text]))
    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 = (Map Text SpeedUp -> Bool)
    -> Map Text (Map Text SpeedUp) -> Map Text (Map Text SpeedUp)
    forall a k. (a -> Bool) -> Map k a -> Map k a
    M.filter (Bool -> Bool
    not (Bool -> Bool)
    -> (Map Text SpeedUp -> Bool) -> Map Text SpeedUp -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Text SpeedUp -> Bool
    forall a. Map Text a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) (Map Text (Map Text SpeedUp) -> Map Text (Map Text SpeedUp))
    -> Map Text (Map Text SpeedUp) -> Map Text (Map Text SpeedUp)
    forall a b. (a -> b) -> a -> b
    $ (Map Text SpeedUp, ([Text], [Text])) -> Map Text SpeedUp
    forall a b. (a, b) -> a
    fst ((Map Text SpeedUp, ([Text], [Text])) -> Map Text SpeedUp)
    -> Map Text (Map Text SpeedUp, ([Text], [Text]))
    -> Map Text (Map Text SpeedUp)
    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' = ([[Text]] -> [Text])
    -> ([[Text]] -> [Text]) -> ([[Text]], [[Text]]) -> ([Text], [Text])
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap [[Text]] -> [Text]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Text]] -> [Text]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (([[Text]], [[Text]]) -> ([Text], [Text]))
    -> (Map Text ([Text], [Text]) -> ([[Text]], [[Text]]))
    -> Map Text ([Text], [Text])
    -> ([Text], [Text])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [([Text], [Text])] -> ([[Text]], [[Text]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([([Text], [Text])] -> ([[Text]], [[Text]]))
    -> (Map Text ([Text], [Text]) -> [([Text], [Text])])
    -> Map Text ([Text], [Text])
    -> ([[Text]], [[Text]])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Text ([Text], [Text]) -> [([Text], [Text])]
    forall k a. Map k a -> [a]
    M.elems (Map Text ([Text], [Text]) -> ([Text], [Text]))
    -> Map Text ([Text], [Text]) -> ([Text], [Text])
    forall a b. (a -> b) -> a -> b
    $ (Map Text SpeedUp, ([Text], [Text])) -> ([Text], [Text])
    forall a b. (a, b) -> b
    snd ((Map Text SpeedUp, ([Text], [Text])) -> ([Text], [Text]))
    -> Map Text (Map Text SpeedUp, ([Text], [Text]))
    -> Map Text ([Text], [Text])
    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 = ([Text] -> [Text]) -> ([Text], [Text]) -> ([Text], [Text])
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second ([Text]
    missing [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++) ([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 Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < Double
    0.99 = Text -> Text
    forall {t}. PrintfArg t => t -> Text
    memoryFormat (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Colors -> Text
    okgreen Colors
    colors
      | Double
    value Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    1.01 = Text -> Text
    forall {t}. PrintfArg t => t -> Text
    memoryFormat (Text -> Text) -> Text -> Text
    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 (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> t -> Double -> Text -> Text -> String
    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: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    memory_text Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")"
      where
        memory_text :: Text
    memory_text = (Text -> Double -> Text -> Text) -> Text -> Map Text Double -> 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 Text -> Text -> Text
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    c = ([Text] -> Text
    T.unwords ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> [Text]
    forall a. HasCallStack => [a] -> [a]
    init ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text]
    T.words Text
    shortened) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " " Text -> Text -> 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 Int -> Int -> Int
    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 (String -> Text) -> (Text -> String) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text -> String
    forall r. PrintfType r => String -> r
    printf String
    s
      where
        s :: String
    s = String
    "%-" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall a. Show a => a -> String
    show Int
    c String -> ShowS
    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 Double -> Double -> Bool
    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 Double -> Double -> Bool
    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 (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ":") (Text -> Text) -> Text -> 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 (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> Text -> Text -> Double -> Text -> Text -> String
    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 (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> Text -> Text -> Text -> Text -> String
    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)
      ((Text, SpeedUp) -> IO ()) -> [(Text, SpeedUp)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((Text -> SpeedUp -> IO ()) -> (Text, SpeedUp) -> IO ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (Colors -> Text -> SpeedUp -> IO ()
    printSpeedUp Colors
    colors)) ([(Text, SpeedUp)] -> IO ()) -> [(Text, SpeedUp)] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Map Text SpeedUp -> [(Text, SpeedUp)]
    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
      (Text -> IO ()) -> [Text] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (String -> IO ()
    putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack) ([Text] -> IO ()) -> [Text] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text]
    forall a. Ord a => [a] -> [a]
    L.sort [Text]
    missing
      (Text -> IO ()) -> [Text] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (String -> IO ()
    putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack) ([Text] -> IO ()) -> [Text] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text]
    forall a. Ord a => [a] -> [a]
    L.sort [Text]
    errors
      ((Text, Map Text SpeedUp) -> IO ())
    -> [(Text, Map Text SpeedUp)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((Text -> Map Text SpeedUp -> IO ())
    -> (Text, Map Text SpeedUp) -> IO ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (Colors -> Text -> Map Text SpeedUp -> IO ()
    printProgSpeedUps Colors
    colors)) ([(Text, Map Text SpeedUp)] -> IO ())
    -> [(Text, Map Text SpeedUp)] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Map Text (Map Text SpeedUp) -> [(Text, Map Text SpeedUp)]
    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 = ()
    -> [FunOptDescr ()]
    -> String
    -> ([String] -> () -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    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'] () = IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    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'
          a_either <- Text -> IO (Either Text (Map Text (Map Text (Either Text Result))))
    decodeFileBenchResultsMap Text
    a_path
          b_either <- decodeFileBenchResultsMap b_path

          isTty <- hSupportsANSI stdout

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

          let comparePrint =
                ((Map Text (Map Text SpeedUp) -> ([Text], [Text]) -> IO ())
    -> (Map Text (Map Text SpeedUp), ([Text], [Text])) -> IO ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (Colors -> Map Text (Map Text SpeedUp) -> ([Text], [Text]) -> IO ()
    printComparisons Colors
    colors) ((Map Text (Map Text SpeedUp), ([Text], [Text])) -> IO ())
    -> (Map Text (Map Text (Either Text Result))
        -> (Map Text (Map Text SpeedUp), ([Text], [Text])))
    -> Map Text (Map Text (Either Text Result))
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .)
                  ((Map Text (Map Text (Either Text Result))
      -> (Map Text (Map Text SpeedUp), ([Text], [Text])))
     -> Map Text (Map Text (Either Text Result)) -> IO ())
    -> (Map Text (Map Text (Either Text Result))
        -> Map Text (Map Text (Either Text Result))
        -> (Map Text (Map Text SpeedUp), ([Text], [Text])))
    -> Map Text (Map Text (Either Text Result))
    -> Map Text (Map Text (Either Text Result))
    -> IO ()
    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 (a_either, b_either) of
            (Left Text
    a, Left Text
    b) -> String -> IO ()
    putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (Text
    a Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    b)
            (Left Text
    a, Either Text (Map Text (Map Text (Either Text Result)))
    _) -> String -> IO ()
    putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text
    a
            (Either Text (Map Text (Map Text (Either Text Result)))
    _, Left Text
    b) -> String -> IO ()
    putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack (Text -> IO ()) -> Text -> IO ()
    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]
    _ ()
    _ = Maybe (IO ())
    forall a. Maybe a
    Nothing