    -- | Facilities for handling Futhark benchmark results.  A Futhark
    -- benchmark program is just like a Futhark test program.
    module Futhark.Bench
      ( RunResult (..),
        DataResult (..),
        BenchResult (..),
        Result (..),
        encodeBenchResults,
        decodeBenchResults,
        binaryName,
        benchmarkDataset,
        RunOptions (..),
        prepareBenchmarkProgram,
        CompileOptions (..),
        module Futhark.Profile,
      )
    where

    import Control.Applicative
    import Control.Monad
    import Control.Monad.Except (ExceptT, MonadError (..), liftEither, runExceptT)
    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Data.Aeson qualified as JSON
    import Data.Aeson.Key qualified as JSON
    import Data.Aeson.KeyMap qualified as JSON
    import Data.ByteString.Char8 qualified as SBS
    import Data.ByteString.Lazy.Char8 qualified as LBS
    import Data.DList qualified as DL
    import Data.Map qualified as M
    import Data.Maybe
    import Data.Text qualified as T
    import Data.Time.Clock
    import Data.Vector.Unboxed qualified as U
    import Futhark.Profile
    import Futhark.Server
    import Futhark.Test
    import Futhark.Util (showText)
    import Statistics.Autocorrelation (autocorrelation)
    import Statistics.Sample (fastStdDev, mean)
    import System.Exit
    import System.FilePath
    import System.Process.ByteString (readProcessWithExitCode)
    import System.Timeout (timeout)

    -- | The runtime of a single succesful run.
    newtype RunResult = RunResult {RunResult -> Int
    runMicroseconds :: Int}
      deriving (RunResult -> RunResult -> Bool
    (RunResult -> RunResult -> Bool)
    -> (RunResult -> RunResult -> Bool) -> Eq RunResult
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: RunResult -> RunResult -> Bool
    == :: RunResult -> RunResult -> Bool
    $c/= :: RunResult -> RunResult -> Bool
    /= :: RunResult -> RunResult -> Bool
    Eq, Int -> RunResult -> ShowS
    [RunResult] -> ShowS
    RunResult -> [Char]
    (Int -> RunResult -> ShowS)
    -> (RunResult -> [Char])
    -> ([RunResult] -> ShowS)
    -> Show RunResult
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RunResult -> ShowS
    showsPrec :: Int -> RunResult -> ShowS
    $cshow :: RunResult -> [Char]
    show :: RunResult -> [Char]
    $cshowList :: [RunResult] -> ShowS
    showList :: [RunResult] -> ShowS
    Show)

    -- | The measurements resulting from various successful runs of a
    -- benchmark (same dataset).
    data Result = Result
      { -- | Runtime of every run.
        Result -> [RunResult]
    runResults :: [RunResult],
        -- | Memory usage.
        Result -> Map Text Int
    memoryMap :: M.Map T.Text Int,
        -- | The error output produced during execution.  Often 'Nothing'
        -- for space reasons, and otherwise only the output from the last
        -- run.
        Result -> Maybe Text
    stdErr :: Maybe T.Text,
        -- | Profiling report.  This will have been measured based on the
        -- last run.
        Result -> Maybe ProfilingReport
    report :: Maybe ProfilingReport
      }
      deriving (Result -> Result -> Bool
    (Result -> Result -> Bool)
    -> (Result -> Result -> Bool) -> Eq Result
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Result -> Result -> Bool
    == :: Result -> Result -> Bool
    $c/= :: Result -> Result -> Bool
    /= :: Result -> Result -> Bool
    Eq, Int -> Result -> ShowS
    [Result] -> ShowS
    Result -> [Char]
    (Int -> Result -> ShowS)
    -> (Result -> [Char]) -> ([Result] -> ShowS) -> Show Result
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Result -> ShowS
    showsPrec :: Int -> Result -> ShowS
    $cshow :: Result -> [Char]
    show :: Result -> [Char]
    $cshowList :: [Result] -> ShowS
    showList :: [Result] -> ShowS
    Show)

    -- | The results for a single named dataset is either an error message, or
    -- a result.
    data DataResult = DataResult T.Text (Either T.Text Result)
      deriving (DataResult -> DataResult -> Bool
    (DataResult -> DataResult -> Bool)
    -> (DataResult -> DataResult -> Bool) -> Eq DataResult
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DataResult -> DataResult -> Bool
    == :: DataResult -> DataResult -> Bool
    $c/= :: DataResult -> DataResult -> Bool
    /= :: DataResult -> DataResult -> Bool
    Eq, Int -> DataResult -> ShowS
    [DataResult] -> ShowS
    DataResult -> [Char]
    (Int -> DataResult -> ShowS)
    -> (DataResult -> [Char])
    -> ([DataResult] -> ShowS)
    -> Show DataResult
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DataResult -> ShowS
    showsPrec :: Int -> DataResult -> ShowS
    $cshow :: DataResult -> [Char]
    show :: DataResult -> [Char]
    $cshowList :: [DataResult] -> ShowS
    showList :: [DataResult] -> ShowS
    Show)

    -- | The results for all datasets for some benchmark program.
    data BenchResult = BenchResult
      { BenchResult -> [Char]
    benchResultProg :: FilePath,
        BenchResult -> [DataResult]
    benchResultResults :: [DataResult]
      }
      deriving (BenchResult -> BenchResult -> Bool
    (BenchResult -> BenchResult -> Bool)
    -> (BenchResult -> BenchResult -> Bool) -> Eq BenchResult
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: BenchResult -> BenchResult -> Bool
    == :: BenchResult -> BenchResult -> Bool
    $c/= :: BenchResult -> BenchResult -> Bool
    /= :: BenchResult -> BenchResult -> Bool
    Eq, Int -> BenchResult -> ShowS
    [BenchResult] -> ShowS
    BenchResult -> [Char]
    (Int -> BenchResult -> ShowS)
    -> (BenchResult -> [Char])
    -> ([BenchResult] -> ShowS)
    -> Show BenchResult
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> BenchResult -> ShowS
    showsPrec :: Int -> BenchResult -> ShowS
    $cshow :: BenchResult -> [Char]
    show :: BenchResult -> [Char]
    $cshowList :: [BenchResult] -> ShowS
    showList :: [BenchResult] -> ShowS
    Show)

    newtype DataResults = DataResults {DataResults -> [DataResult]
    unDataResults :: [DataResult]}

    newtype BenchResults = BenchResults {BenchResults -> [BenchResult]
    unBenchResults :: [BenchResult]}

    instance JSON.ToJSON Result where
      toJSON :: Result -> Value
    toJSON (Result [RunResult]
    runres Map Text Int
    memmap Maybe Text
    err Maybe ProfilingReport
    profiling) =
        ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
    -> Value
    forall a. ToJSON a => a -> Value
    JSON.toJSON ([RunResult]
    runres, Map Text Int
    memmap, Maybe Text
    err, Maybe ProfilingReport
    profiling)

    instance JSON.FromJSON Result where
      parseJSON :: Value -> Parser Result
    parseJSON = (([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
     -> Result)
    -> Parser
         ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
    -> Parser Result
    forall a b. (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
    -> Result
    f (Parser
       ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
     -> Parser Result)
    -> (Value
        -> Parser
             ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport))
    -> Value
    -> Parser Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value
    -> Parser
         ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
    forall a. FromJSON a => Value -> Parser a
    JSON.parseJSON
        where
          f :: ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
    -> Result
    f ([RunResult]
    runres, Map Text Int
    memmap, Maybe Text
    err, Maybe ProfilingReport
    profiling) = [RunResult]
    -> Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result
    Result [RunResult]
    runres Map Text Int
    memmap Maybe Text
    err Maybe ProfilingReport
    profiling

    instance JSON.ToJSON RunResult where
      toJSON :: RunResult -> Value
    toJSON = Int -> Value
    forall a. ToJSON a => a -> Value
    JSON.toJSON (Int -> Value) -> (RunResult -> Int) -> RunResult -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RunResult -> Int
    runMicroseconds

    instance JSON.FromJSON RunResult where
      parseJSON :: Value -> Parser RunResult
    parseJSON = (Int -> RunResult) -> Parser Int -> Parser RunResult
    forall a b. (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int -> RunResult
    RunResult (Parser Int -> Parser RunResult)
    -> (Value -> Parser Int) -> Value -> Parser RunResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> Parser Int
    forall a. FromJSON a => Value -> Parser a
    JSON.parseJSON

    instance JSON.ToJSON DataResults where
      toJSON :: DataResults -> Value
    toJSON (DataResults [DataResult]
    rs) =
        [Pair] -> Value
    JSON.object ([Pair] -> Value) -> [Pair] -> Value
    forall a b. (a -> b) -> a -> b
    $ (DataResult -> Pair) -> [DataResult] -> [Pair]
    forall a b. (a -> b) -> [a] -> [b]
    map DataResult -> Pair
    dataResultJSON [DataResult]
    rs
      toEncoding :: DataResults -> Encoding
    toEncoding (DataResults [DataResult]
    rs) =
        Series -> Encoding
    JSON.pairs (Series -> Encoding) -> Series -> Encoding
    forall a b. (a -> b) -> a -> b
    $ [Series] -> Series
    forall a. Monoid a => [a] -> a
    mconcat ([Series] -> Series) -> [Series] -> Series
    forall a b. (a -> b) -> a -> b
    $ (DataResult -> Series) -> [DataResult] -> [Series]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Key -> Value -> Series) -> Pair -> Series
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Key -> Value -> Series
    forall v. ToJSON v => Key -> v -> Series
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    (JSON..=) (Pair -> Series) -> (DataResult -> Pair) -> DataResult -> Series
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataResult -> Pair
    dataResultJSON) [DataResult]
    rs

    instance JSON.FromJSON DataResults where
      parseJSON :: Value -> Parser DataResults
    parseJSON = [Char]
    -> (Object -> Parser DataResults) -> Value -> Parser DataResults
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
    JSON.withObject [Char]
    "datasets" ((Object -> Parser DataResults) -> Value -> Parser DataResults)
    -> (Object -> Parser DataResults) -> Value -> Parser DataResults
    forall a b. (a -> b) -> a -> b
    $ \Object
    o ->
        [DataResult] -> DataResults
    DataResults ([DataResult] -> DataResults)
    -> Parser [DataResult] -> Parser DataResults
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Pair -> Parser DataResult) -> [Pair] -> Parser [DataResult]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Pair -> Parser DataResult
    datasetResult (Object -> [Pair]
    forall v. KeyMap v -> [(Key, v)]
    JSON.toList Object
    o)
        where
          datasetResult :: Pair -> Parser DataResult
    datasetResult (Key
    k, Value
    v) =
            Text -> Either Text Result -> DataResult
    DataResult (Key -> Text
    JSON.toText Key
    k)
              (Either Text Result -> DataResult)
    -> Parser (Either Text Result) -> Parser DataResult
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Result -> Either Text Result
    forall a b. b -> Either a b
    Right (Result -> Either Text Result)
    -> Parser Result -> Parser (Either Text Result)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Value -> Parser Result
    success Value
    v) Parser (Either Text Result)
    -> Parser (Either Text Result) -> Parser (Either Text Result)
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Text -> Either Text Result
    forall a b. a -> Either a b
    Left (Text -> Either Text Result)
    -> Parser Text -> Parser (Either Text Result)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Value -> Parser Text
    forall a. FromJSON a => Value -> Parser a
    JSON.parseJSON Value
    v))
          success :: Value -> Parser Result
    success = [Char] -> (Object -> Parser Result) -> Value -> Parser Result
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
    JSON.withObject [Char]
    "result" ((Object -> Parser Result) -> Value -> Parser Result)
    -> (Object -> Parser Result) -> Value -> Parser Result
    forall a b. (a -> b) -> a -> b
    $ \Object
    o ->
            [RunResult]
    -> Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result
    Result
              ([RunResult]
     -> Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result)
    -> Parser [RunResult]
    -> Parser
         (Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    o Object -> Key -> Parser [RunResult]
    forall a. FromJSON a => Object -> Key -> Parser a
    JSON..: Key
    "runtimes"
              Parser
      (Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result)
    -> Parser (Map Text Int)
    -> Parser (Maybe Text -> Maybe ProfilingReport -> Result)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    o Object -> Key -> Parser (Map Text Int)
    forall a. FromJSON a => Object -> Key -> Parser a
    JSON..: Key
    "bytes"
              Parser (Maybe Text -> Maybe ProfilingReport -> Result)
    -> Parser (Maybe Text) -> Parser (Maybe ProfilingReport -> Result)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    o Object -> Key -> Parser (Maybe Text)
    forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
    JSON..:? Key
    "stderr"
              Parser (Maybe ProfilingReport -> Result)
    -> Parser (Maybe ProfilingReport) -> Parser Result
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    o Object -> Key -> Parser (Maybe ProfilingReport)
    forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
    JSON..:? Key
    "profiling"

    dataResultJSON :: DataResult -> (JSON.Key, JSON.Value)
    dataResultJSON :: DataResult -> Pair
    dataResultJSON (DataResult Text
    desc (Left Text
    err)) =
      (Text -> Key
    JSON.fromText Text
    desc, Text -> Value
    forall a. ToJSON a => a -> Value
    JSON.toJSON Text
    err)
    dataResultJSON (DataResult Text
    desc (Right (Result [RunResult]
    runtimes Map Text Int
    bytes Maybe Text
    progerr_opt Maybe ProfilingReport
    profiling_opt))) =
      ( Text -> Key
    JSON.fromText Text
    desc,
        [Pair] -> Value
    JSON.object ([Pair] -> Value) -> [Pair] -> Value
    forall a b. (a -> b) -> a -> b
    $
          [ (Key
    "runtimes", [Int] -> Value
    forall a. ToJSON a => a -> Value
    JSON.toJSON ([Int] -> Value) -> [Int] -> Value
    forall a b. (a -> b) -> a -> b
    $ (RunResult -> Int) -> [RunResult] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map RunResult -> Int
    runMicroseconds [RunResult]
    runtimes),
            (Key
    "bytes", Map Text Int -> Value
    forall a. ToJSON a => a -> Value
    JSON.toJSON Map Text Int
    bytes)
          ]
            [Pair] -> [Pair] -> [Pair]
    forall a. Semigroup a => a -> a -> a
    <> case Maybe Text
    progerr_opt of
              Maybe Text
    Nothing -> []
              Just Text
    progerr -> [(Key
    "stderr", Text -> Value
    forall a. ToJSON a => a -> Value
    JSON.toJSON Text
    progerr)]
            [Pair] -> [Pair] -> [Pair]
    forall a. Semigroup a => a -> a -> a
    <> case Maybe ProfilingReport
    profiling_opt of
              Maybe ProfilingReport
    Nothing -> []
              Just ProfilingReport
    profiling -> [(Key
    "profiling", ProfilingReport -> Value
    forall a. ToJSON a => a -> Value
    JSON.toJSON ProfilingReport
    profiling)]
      )

    benchResultJSON :: BenchResult -> (JSON.Key, JSON.Value)
    benchResultJSON :: BenchResult -> Pair
    benchResultJSON (BenchResult [Char]
    prog [DataResult]
    r) =
      ( [Char] -> Key
    JSON.fromString [Char]
    prog,
        [Pair] -> Value
    JSON.object [(Key
    "datasets", DataResults -> Value
    forall a. ToJSON a => a -> Value
    JSON.toJSON (DataResults -> Value) -> DataResults -> Value
    forall a b. (a -> b) -> a -> b
    $ [DataResult] -> DataResults
    DataResults [DataResult]
    r)]
      )

    instance JSON.ToJSON BenchResults where
      toJSON :: BenchResults -> Value
    toJSON (BenchResults [BenchResult]
    rs) =
        [Pair] -> Value
    JSON.object ([Pair] -> Value) -> [Pair] -> Value
    forall a b. (a -> b) -> a -> b
    $ (BenchResult -> Pair) -> [BenchResult] -> [Pair]
    forall a b. (a -> b) -> [a] -> [b]
    map BenchResult -> Pair
    benchResultJSON [BenchResult]
    rs

    instance JSON.FromJSON BenchResults where
      parseJSON :: Value -> Parser BenchResults
    parseJSON = [Char]
    -> (Object -> Parser BenchResults) -> Value -> Parser BenchResults
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
    JSON.withObject [Char]
    "benchmarks" ((Object -> Parser BenchResults) -> Value -> Parser BenchResults)
    -> (Object -> Parser BenchResults) -> Value -> Parser BenchResults
    forall a b. (a -> b) -> a -> b
    $ \Object
    o ->
        [BenchResult] -> BenchResults
    BenchResults ([BenchResult] -> BenchResults)
    -> Parser [BenchResult] -> Parser BenchResults
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Pair -> Parser BenchResult) -> [Pair] -> Parser [BenchResult]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Pair -> Parser BenchResult
    onBenchmark (Object -> [Pair]
    forall v. KeyMap v -> [(Key, v)]
    JSON.toList Object
    o)
        where
          onBenchmark :: Pair -> Parser BenchResult
    onBenchmark (Key
    k, Value
    v) =
            [Char] -> [DataResult] -> BenchResult
    BenchResult (Key -> [Char]
    JSON.toString Key
    k)
              ([DataResult] -> BenchResult)
    -> Parser [DataResult] -> Parser BenchResult
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char]
    -> (Object -> Parser [DataResult]) -> Value -> Parser [DataResult]
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
    JSON.withObject [Char]
    "benchmark" Object -> Parser [DataResult]
    onBenchmark' Value
    v
          onBenchmark' :: Object -> Parser [DataResult]
    onBenchmark' Object
    o =
            (DataResults -> [DataResult])
    -> Parser DataResults -> Parser [DataResult]
    forall a b. (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DataResults -> [DataResult]
    unDataResults (Parser DataResults -> Parser [DataResult])
    -> (Value -> Parser DataResults) -> Value -> Parser [DataResult]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> Parser DataResults
    forall a. FromJSON a => Value -> Parser a
    JSON.parseJSON (Value -> Parser [DataResult])
    -> Parser Value -> Parser [DataResult]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Object
    o Object -> Key -> Parser Value
    forall a. FromJSON a => Object -> Key -> Parser a
    JSON..: Key
    "datasets"

    -- | Transform benchmark results to a JSON bytestring.
    encodeBenchResults :: [BenchResult] -> LBS.ByteString
    encodeBenchResults :: [BenchResult] -> ByteString
    encodeBenchResults = BenchResults -> ByteString
    forall a. ToJSON a => a -> ByteString
    JSON.encode (BenchResults -> ByteString)
    -> ([BenchResult] -> BenchResults) -> [BenchResult] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [BenchResult] -> BenchResults
    BenchResults

    -- | Decode benchmark results from a JSON bytestring.
    decodeBenchResults :: LBS.ByteString -> Either String [BenchResult]
    decodeBenchResults :: ByteString -> Either [Char] [BenchResult]
    decodeBenchResults = (BenchResults -> [BenchResult])
    -> Either [Char] BenchResults -> Either [Char] [BenchResult]
    forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BenchResults -> [BenchResult]
    unBenchResults (Either [Char] BenchResults -> Either [Char] [BenchResult])
    -> (ByteString -> Either [Char] BenchResults)
    -> ByteString
    -> Either [Char] [BenchResult]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either [Char] BenchResults
    forall a. FromJSON a => ByteString -> Either [Char] a
    JSON.eitherDecode'

    --- Running benchmarks

    -- | How to run a benchmark.
    data RunOptions = RunOptions
      { -- | Applies both to initial and convergence phase.
        RunOptions -> Int
    runMinRuns :: Int,
        RunOptions -> NominalDiffTime
    runMinTime :: NominalDiffTime,
        RunOptions -> Int
    runTimeout :: Int,
        RunOptions -> Int
    runVerbose :: Int,
        -- | If true, run the convergence phase.
        RunOptions -> Bool
    runConvergencePhase :: Bool,
        -- | Stop convergence once this much time has passed.
        RunOptions -> NominalDiffTime
    runConvergenceMaxTime :: NominalDiffTime,
        -- | Invoked for every runtime measured during the run.  Can be
        -- used to provide a progress bar.
        RunOptions -> (Int, Maybe Double) -> IO ()
    runResultAction :: (Int, Maybe Double) -> IO (),
        -- | Perform a final run at the end with profiling information
        -- enabled.
        RunOptions -> Bool
    runProfile :: Bool
      }

    -- | A list of @(autocorrelation,rse)@ pairs.  When the
    -- autocorrelation is above the first element and the RSE is above the
    -- second element, we want more runs.
    convergenceCriteria :: [(Double, Double)]
    convergenceCriteria :: [(Double, Double)]
    convergenceCriteria =
      [ (Double
    0.95, Double
    0.0010),
        (Double
    0.75, Double
    0.0015),
        (Double
    0.65, Double
    0.0025),
        (Double
    0.45, Double
    0.0050),
        (Double
    0.00, Double
    0.0100)
      ]

    -- Returns the next run count.
    nextRunCount :: Int -> Double -> Double -> Int
    nextRunCount :: Int -> Double -> Double -> Int
    nextRunCount Int
    runs Double
    rse Double
    acor = if ((Double, Double) -> Bool) -> [(Double, Double)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Double, Double) -> Bool
    check [(Double, Double)]
    convergenceCriteria then Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    div Int
    runs Int
    2 else Int
    0
      where
        check :: (Double, Double) -> Bool
    check (Double
    acor_lb, Double
    rse_lb) = Double
    acor Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    acor_lb Bool -> Bool -> Bool
    && Double
    rse Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    rse_lb

    type BenchM = ExceptT T.Text IO

    -- Do the minimum number of runs.
    runMinimum ::
      BenchM (RunResult, [T.Text]) ->
      RunOptions ->
      Int ->
      NominalDiffTime ->
      DL.DList (RunResult, [T.Text]) ->
      BenchM (DL.DList (RunResult, [T.Text]))
    runMinimum :: BenchM (RunResult, [Text])
    -> RunOptions
    -> Int
    -> NominalDiffTime
    -> DList (RunResult, [Text])
    -> BenchM (DList (RunResult, [Text]))
    runMinimum BenchM (RunResult, [Text])
    do_run RunOptions
    opts Int
    runs_done NominalDiffTime
    elapsed DList (RunResult, [Text])
    r = do
      let actions :: BenchM (RunResult, [Text])
    actions = do
            x <- BenchM (RunResult, [Text])
    do_run
            liftIO $ runResultAction opts (runMicroseconds (fst x), Nothing)
            pure x

      -- Figure out how much we have left to do.
      let todo :: Int
    todo
            | Int
    runs_done Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < RunOptions -> Int
    runMinRuns RunOptions
    opts =
                RunOptions -> Int
    runMinRuns RunOptions
    opts Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    runs_done
            | Bool
    otherwise =
                -- Guesstimate how many runs we need to reach the minimum
                -- time.
                let time_per_run :: NominalDiffTime
    time_per_run = NominalDiffTime
    elapsed NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Fractional a => a -> a -> a
    / Int -> NominalDiffTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    runs_done
                 in NominalDiffTime -> Int
    forall b. Integral b => NominalDiffTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling ((RunOptions -> NominalDiffTime
    runMinTime RunOptions
    opts NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    - NominalDiffTime
    elapsed) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Fractional a => a -> a -> a
    / NominalDiffTime
    time_per_run)

      -- Note that todo might be negative if minimum time has been exceeded.
      if Int
    todo Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0
        then DList (RunResult, [Text]) -> BenchM (DList (RunResult, [Text]))
    forall a. a -> ExceptT Text IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DList (RunResult, [Text])
    r
        else do
          before <- IO UTCTime -> ExceptT Text IO UTCTime
    forall a. IO a -> ExceptT Text IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
          r' <- DL.fromList <$> replicateM todo actions
          after <- liftIO getCurrentTime
          let elapsed' = NominalDiffTime
    elapsed NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    + UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    after UTCTime
    before
          runMinimum do_run opts (runs_done + todo) elapsed' (r <> r')

    -- Do more runs until a convergence criterion is reached.
    runConvergence ::
      BenchM (RunResult, [T.Text]) ->
      RunOptions ->
      DL.DList (RunResult, [T.Text]) ->
      BenchM (DL.DList (RunResult, [T.Text]))
    runConvergence :: BenchM (RunResult, [Text])
    -> RunOptions
    -> DList (RunResult, [Text])
    -> BenchM (DList (RunResult, [Text]))
    runConvergence BenchM (RunResult, [Text])
    do_run RunOptions
    opts DList (RunResult, [Text])
    initial_r =
      let runtimes :: Vector Double
    runtimes = [(RunResult, [Text])] -> Vector Double
    forall {b}. [(RunResult, b)] -> Vector Double
    resultRuntimes (DList (RunResult, [Text]) -> [(RunResult, [Text])]
    forall a. DList a -> [a]
    DL.toList DList (RunResult, [Text])
    initial_r)
          (Int
    n, NominalDiffTime
    _, Double
    rse, Double
    acor) = Vector Double -> (Int, NominalDiffTime, Double, Double)
    runtimesMetrics Vector Double
    runtimes
       in -- If the runtimes collected during the runMinimum phase are
          -- unstable enough that we need more in order to converge, we throw
          -- away the runMinimum runtimes.  This is because they often exhibit
          -- behaviour similar to a "warmup" period, and hence function as
          -- outliers that poison the metrics we use to determine convergence.
          -- By throwing them away we converge much faster, and still get the
          -- right result.
          case Int -> Double -> Double -> Int
    nextRunCount Int
    n Double
    rse Double
    acor of
            Int
    x
              | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0,
                RunOptions -> Bool
    runConvergencePhase RunOptions
    opts ->
                  Vector Double
    -> DList (RunResult, [Text])
    -> Double
    -> Int
    -> BenchM (DList (RunResult, [Text]))
    moreRuns Vector Double
    forall a. Monoid a => a
    mempty DList (RunResult, [Text])
    forall a. Monoid a => a
    mempty Double
    rse (Int
    x Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    `max` RunOptions -> Int
    runMinRuns RunOptions
    opts)
              | Bool
    otherwise ->
                  DList (RunResult, [Text]) -> BenchM (DList (RunResult, [Text]))
    forall a. a -> ExceptT Text IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DList (RunResult, [Text])
    initial_r
      where
        resultRuntimes :: [(RunResult, b)] -> Vector Double
    resultRuntimes =
          [Double] -> Vector Double
    forall a. Unbox a => [a] -> Vector a
    U.fromList ([Double] -> Vector Double)
    -> ([(RunResult, b)] -> [Double])
    -> [(RunResult, b)]
    -> Vector Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((RunResult, b) -> Double) -> [(RunResult, b)] -> [Double]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Double)
    -> ((RunResult, b) -> Int) -> (RunResult, b) -> Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RunResult -> Int
    runMicroseconds (RunResult -> Int)
    -> ((RunResult, b) -> RunResult) -> (RunResult, b) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RunResult, b) -> RunResult
    forall a b. (a, b) -> a
    fst)

        runtimesMetrics :: Vector Double -> (Int, NominalDiffTime, Double, Double)
    runtimesMetrics Vector Double
    runtimes =
          let n :: Int
    n = Vector Double -> Int
    forall a. Unbox a => Vector a -> Int
    U.length Vector Double
    runtimes
              rse :: Double
    rse = (Vector Double -> Double
    forall (v :: * -> *). Vector v Double => v Double -> Double
    fastStdDev Vector Double
    runtimes Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double -> Double
    forall a. Floating a => a -> a
    sqrt (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n)) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Vector Double -> Double
    forall (v :: * -> *). Vector v Double => v Double -> Double
    mean Vector Double
    runtimes
              (Vector Double
    x, Vector Double
    _, Vector Double
    _) = Vector Double -> (Vector Double, Vector Double, Vector Double)
    forall (v :: * -> *).
    (Vector v Double, Vector v Int) =>
    v Double -> (v Double, v Double, v Double)
    autocorrelation Vector Double
    runtimes
           in ( Int
    n,
                Double -> NominalDiffTime
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac (Vector Double -> Double
    forall a. (Unbox a, Num a) => Vector a -> a
    U.sum Vector Double
    runtimes) :: NominalDiffTime,
                Double
    rse,
                Double -> Maybe Double -> Double
    forall a. a -> Maybe a -> a
    fromMaybe Double
    1 (Vector Double
    x Vector Double -> Int -> Maybe Double
    forall a. Unbox a => Vector a -> Int -> Maybe a
    U.!? Int
    1)
              )

        sample :: Double -> BenchM (RunResult, [Text])
    sample Double
    rse = do
          x <- BenchM (RunResult, [Text])
    do_run
          liftIO $ runResultAction opts (runMicroseconds (fst x), Just rse)
          pure x

        moreRuns :: Vector Double
    -> DList (RunResult, [Text])
    -> Double
    -> Int
    -> BenchM (DList (RunResult, [Text]))
    moreRuns Vector Double
    runtimes DList (RunResult, [Text])
    r Double
    rse Int
    x = do
          r' <- Int
    -> BenchM (RunResult, [Text])
    -> ExceptT Text IO [(RunResult, [Text])]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    x (BenchM (RunResult, [Text])
     -> ExceptT Text IO [(RunResult, [Text])])
    -> BenchM (RunResult, [Text])
    -> ExceptT Text IO [(RunResult, [Text])]
    forall a b. (a -> b) -> a -> b
    $ Double -> BenchM (RunResult, [Text])
    sample Double
    rse
          loop (runtimes <> resultRuntimes r') (r <> DL.fromList r')

        loop :: Vector Double
    -> DList (RunResult, [Text]) -> BenchM (DList (RunResult, [Text]))
    loop Vector Double
    runtimes DList (RunResult, [Text])
    r = do
          let (Int
    n, NominalDiffTime
    total, Double
    rse, Double
    acor) = Vector Double -> (Int, NominalDiffTime, Double, Double)
    runtimesMetrics Vector Double
    runtimes
          case Int -> Double -> Double -> Int
    nextRunCount Int
    n Double
    rse Double
    acor of
            Int
    x
              | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0,
                NominalDiffTime
    total NominalDiffTime -> NominalDiffTime -> Bool
    forall a. Ord a => a -> a -> Bool
    < RunOptions -> NominalDiffTime
    runConvergenceMaxTime RunOptions
    opts ->
                  Vector Double
    -> DList (RunResult, [Text])
    -> Double
    -> Int
    -> BenchM (DList (RunResult, [Text]))
    moreRuns Vector Double
    runtimes DList (RunResult, [Text])
    r Double
    rse Int
    x
              | Bool
    otherwise ->
                  DList (RunResult, [Text]) -> BenchM (DList (RunResult, [Text]))
    forall a. a -> ExceptT Text IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DList (RunResult, [Text])
    r

    -- | Run the benchmark program on the indicated dataset.
    benchmarkDataset ::
      Server ->
      RunOptions ->
      FutharkExe ->
      FilePath ->
      T.Text ->
      Values ->
      Maybe Success ->
      FilePath ->
      IO (Either T.Text ([RunResult], T.Text, ProfilingReport))
    benchmarkDataset :: Server
    -> RunOptions
    -> FutharkExe
    -> [Char]
    -> Text
    -> Values
    -> Maybe Success
    -> [Char]
    -> IO (Either Text ([RunResult], Text, ProfilingReport))
    benchmarkDataset Server
    server RunOptions
    opts FutharkExe
    futhark [Char]
    program Text
    entry Values
    input_spec Maybe Success
    expected_spec [Char]
    ref_out = ExceptT Text IO ([RunResult], Text, ProfilingReport)
    -> IO (Either Text ([RunResult], Text, ProfilingReport))
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT Text IO ([RunResult], Text, ProfilingReport)
     -> IO (Either Text ([RunResult], Text, ProfilingReport)))
    -> ExceptT Text IO ([RunResult], Text, ProfilingReport)
    -> IO (Either Text ([RunResult], Text, ProfilingReport))
    forall a b. (a -> b) -> a -> b
    $ do
      output_types <- IO (Either CmdFailure [OutputType]) -> ExceptT Text IO [OutputType]
    forall (m :: * -> *) a.
    (MonadError Text m, MonadIO m) =>
    IO (Either CmdFailure a) -> m a
    cmdEither (IO (Either CmdFailure [OutputType])
     -> ExceptT Text IO [OutputType])
    -> IO (Either CmdFailure [OutputType])
    -> ExceptT Text IO [OutputType]
    forall a b. (a -> b) -> a -> b
    $ Server -> Text -> IO (Either CmdFailure [OutputType])
    cmdOutputs Server
    server Text
    entry
      input_types <- cmdEither $ cmdInputs server entry
      let outs = [Text
    "out" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText Int
    i | Int
    i <- [Int
    0 .. [OutputType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [OutputType]
    output_types Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]]
          ins = [Text
    "in" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText Int
    i | Int
    i <- [Int
    0 .. [InputType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [InputType]
    input_types Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]]

      cmdMaybe . liftIO $ cmdClear server

      cmdMaybe . liftIO $ cmdPauseProfiling server

      let freeOuts = IO (Maybe CmdFailure) -> ExceptT Text IO ()
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    cmdMaybe (Server -> [Text] -> IO (Maybe CmdFailure)
    cmdFree Server
    server [Text]
    outs)
          freeIns = IO (Maybe CmdFailure) -> ExceptT Text IO ()
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    cmdMaybe (Server -> [Text] -> IO (Maybe CmdFailure)
    cmdFree Server
    server [Text]
    ins)
          loadInput = Server
    -> [(Text, Text)]
    -> FutharkExe
    -> [Char]
    -> Values
    -> ExceptT Text IO ()
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    Server -> [(Text, Text)] -> FutharkExe -> [Char] -> Values -> m ()
    valuesAsVars Server
    server ([Text] -> [Text] -> [(Text, Text)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Text]
    ins ([Text] -> [(Text, Text)]) -> [Text] -> [(Text, Text)]
    forall a b. (a -> b) -> a -> b
    $ (InputType -> Text) -> [InputType] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map InputType -> Text
    inputType [InputType]
    input_types) FutharkExe
    futhark [Char]
    dir Values
    input_spec
          reloadInput = ExceptT Text IO ()
    freeIns ExceptT Text IO () -> ExceptT Text IO () -> ExceptT Text IO ()
    forall a b.
    ExceptT Text IO a -> ExceptT Text IO b -> ExceptT Text IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ExceptT Text IO ()
    loadInput

      loadInput

      let runtime Text
    l
            | Just Text
    l' <- Text -> Text -> Maybe Text
    T.stripPrefix Text
    "runtime: " Text
    l,
              [(a
    x, [Char]
    "")] <- ReadS a
    forall a. Read a => ReadS a
    reads ReadS a -> ReadS a
    forall a b. (a -> b) -> a -> b
    $ Text -> [Char]
    T.unpack Text
    l' =
                a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x
            | Bool
    otherwise =
                Maybe a
    forall a. Maybe a
    Nothing

          doRun = do
            call_lines <- IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
    forall (m :: * -> *) a.
    (MonadError Text m, MonadIO m) =>
    IO (Either CmdFailure a) -> m a
    cmdEither (Server -> Text -> [Text] -> [Text] -> IO (Either CmdFailure [Text])
    cmdCall Server
    server Text
    entry [Text]
    outs [Text]
    ins)
            when (any inputConsumed input_types) reloadInput
            case mapMaybe runtime call_lines of
              [Int
    call_runtime] -> (RunResult, [Text]) -> BenchM (RunResult, [Text])
    forall a. a -> ExceptT Text IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int -> RunResult
    RunResult Int
    call_runtime, [Text]
    call_lines)
              [] -> Text -> BenchM (RunResult, [Text])
    forall a. Text -> ExceptT Text IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError Text
    "Could not find runtime in output."
              [Int]
    ls -> Text -> BenchM (RunResult, [Text])
    forall a. Text -> ExceptT Text IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> BenchM (RunResult, [Text]))
    -> Text -> BenchM (RunResult, [Text])
    forall a b. (a -> b) -> a -> b
    $ Text
    "Ambiguous runtimes: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Int] -> Text
    forall a. Show a => a -> Text
    showText [Int]
    ls

      maybe_call_logs <- liftIO . timeout (runTimeout opts * 1000000) . runExceptT $ do
        -- First one uncounted warmup run.
        void $ cmdEither $ cmdCall server entry outs ins

        ys <- runMinimum (freeOuts *> doRun) opts 0 0 mempty

        xs <- runConvergence (freeOuts *> doRun) opts ys

        -- Possibly a profiled run at the end.
        profile_log <-
          if not (runProfile opts)
            then pure Nothing
            else do
              cmdMaybe . liftIO $ cmdUnpauseProfiling server
              profile_log <- freeOuts *> doRun
              cmdMaybe . liftIO $ cmdPauseProfiling server
              pure $ Just profile_log

        vs <- readResults server outs <* freeOuts

        pure (vs, DL.toList xs, profile_log)

      (vs, call_logs, profile_log) <- case maybe_call_logs of
        Maybe
      (Either
         Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
    Nothing ->
          Text
    -> ExceptT
         Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
    forall a. Text -> ExceptT Text IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
     -> ExceptT
          Text
          IO
          ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
    -> ([Char] -> Text)
    -> [Char]
    -> ExceptT
         Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Text
    T.pack ([Char]
     -> ExceptT
          Text
          IO
          ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
    -> [Char]
    -> ExceptT
         Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    "Execution exceeded " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show (RunOptions -> Int
    runTimeout RunOptions
    opts) [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " seconds."
        Just Either
      Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
    x -> Either
      Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
    -> ExceptT
         Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
    forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
    liftEither Either
      Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
    x

      freeIns

      report <- cmdEither $ cmdReport server

      report' <-
        maybe (throwError "Program produced invalid profiling report.") pure $
          profilingReportFromText (T.unlines report)

      maybe_expected <-
        liftIO $ maybe (pure Nothing) (fmap Just . getExpectedValues) expected_spec

      case maybe_expected of
        Just [Value]
    expected -> [Char] -> [Value] -> [Value] -> ExceptT Text IO ()
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    [Char] -> [Value] -> [Value] -> m ()
    checkResult [Char]
    program [Value]
    expected [Value]
    vs
        Maybe [Value]
    Nothing -> () -> ExceptT Text IO ()
    forall a. a -> ExceptT Text IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

      pure
        ( map fst call_logs,
          T.unlines $ snd $ fromMaybe (last call_logs) profile_log,
          report'
        )
      where
        getExpectedValues :: Success -> m [Value]
    getExpectedValues (SuccessValues Values
    vs) =
          FutharkExe -> [Char] -> Values -> m [Value]
    forall (m :: * -> *).
    (MonadFail m, MonadIO m) =>
    FutharkExe -> [Char] -> Values -> m [Value]
    getValues FutharkExe
    futhark [Char]
    dir Values
    vs
        getExpectedValues Success
    SuccessGenerateValues =
          Success -> m [Value]
    getExpectedValues (Success -> m [Value]) -> Success -> m [Value]
    forall a b. (a -> b) -> a -> b
    $ Values -> Success
    SuccessValues (Values -> Success) -> Values -> Success
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Values
    InFile [Char]
    ref_out

        dir :: [Char]
    dir = ShowS
    takeDirectory [Char]
    program

    -- | How to compile a benchmark.
    data CompileOptions = CompileOptions
      { CompileOptions -> [Char]
    compFuthark :: String,
        CompileOptions -> [Char]
    compBackend :: String,
        CompileOptions -> [[Char]]
    compOptions :: [String]
      }

    progNotFound :: String -> String
    progNotFound :: ShowS
    progNotFound [Char]
    s = [Char]
    s [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": command not found"

    -- | Compile and produce reference datasets.
    prepareBenchmarkProgram ::
      (MonadIO m) =>
      Maybe Int ->
      CompileOptions ->
      FilePath ->
      [InputOutputs] ->
      m (Either (String, Maybe SBS.ByteString) ())
    prepareBenchmarkProgram :: forall (m :: * -> *).
    MonadIO m =>
    Maybe Int
    -> CompileOptions
    -> [Char]
    -> [InputOutputs]
    -> m (Either ([Char], Maybe ByteString) ())
    prepareBenchmarkProgram Maybe Int
    concurrency CompileOptions
    opts [Char]
    program [InputOutputs]
    cases = do
      let futhark :: [Char]
    futhark = CompileOptions -> [Char]
    compFuthark CompileOptions
    opts

      ref_res <- ExceptT Text m () -> m (Either Text ())
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT Text m () -> m (Either Text ()))
    -> ExceptT Text m () -> m (Either Text ())
    forall a b. (a -> b) -> a -> b
    $ Maybe Int
    -> FutharkExe
    -> [Char]
    -> [Char]
    -> [InputOutputs]
    -> ExceptT Text m ()
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    Maybe Int
    -> FutharkExe -> [Char] -> [Char] -> [InputOutputs] -> m ()
    ensureReferenceOutput Maybe Int
    concurrency ([Char] -> FutharkExe
    FutharkExe [Char]
    futhark) [Char]
    "c" [Char]
    program [InputOutputs]
    cases
      case ref_res of
        Left Text
    err ->
          Either ([Char], Maybe ByteString) ()
    -> m (Either ([Char], Maybe ByteString) ())
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either ([Char], Maybe ByteString) ()
     -> m (Either ([Char], Maybe ByteString) ()))
    -> Either ([Char], Maybe ByteString) ()
    -> m (Either ([Char], Maybe ByteString) ())
    forall a b. (a -> b) -> a -> b
    $
            ([Char], Maybe ByteString) -> Either ([Char], Maybe ByteString) ()
    forall a b. a -> Either a b
    Left
              ( [Char]
    "Reference output generation for "
                  [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    program
                  [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    " failed:\n"
                  [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Text -> [Char]
    T.unpack Text
    err,
                Maybe ByteString
    forall a. Maybe a
    Nothing
              )
        Right () -> do
          (futcode, _, futerr) <-
            IO (ExitCode, ByteString, ByteString)
    -> m (ExitCode, ByteString, ByteString)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ExitCode, ByteString, ByteString)
     -> m (ExitCode, ByteString, ByteString))
    -> IO (ExitCode, ByteString, ByteString)
    -> m (ExitCode, ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $
              [Char]
    -> [[Char]] -> ByteString -> IO (ExitCode, ByteString, ByteString)
    readProcessWithExitCode
                [Char]
    futhark
                ( [CompileOptions -> [Char]
    compBackend CompileOptions
    opts, [Char]
    program, [Char]
    "-o", ShowS
    binaryName [Char]
    program, [Char]
    "--server"]
                    [[Char]] -> [[Char]] -> [[Char]]
    forall a. Semigroup a => a -> a -> a
    <> CompileOptions -> [[Char]]
    compOptions CompileOptions
    opts
                )
                ByteString
    ""

          case futcode of
            ExitCode
    ExitSuccess -> Either ([Char], Maybe ByteString) ()
    -> m (Either ([Char], Maybe ByteString) ())
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either ([Char], Maybe ByteString) ()
     -> m (Either ([Char], Maybe ByteString) ()))
    -> Either ([Char], Maybe ByteString) ()
    -> m (Either ([Char], Maybe ByteString) ())
    forall a b. (a -> b) -> a -> b
    $ () -> Either ([Char], Maybe ByteString) ()
    forall a b. b -> Either a b
    Right ()
            ExitFailure Int
    127 -> Either ([Char], Maybe ByteString) ()
    -> m (Either ([Char], Maybe ByteString) ())
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either ([Char], Maybe ByteString) ()
     -> m (Either ([Char], Maybe ByteString) ()))
    -> Either ([Char], Maybe ByteString) ()
    -> m (Either ([Char], Maybe ByteString) ())
    forall a b. (a -> b) -> a -> b
    $ ([Char], Maybe ByteString) -> Either ([Char], Maybe ByteString) ()
    forall a b. a -> Either a b
    Left (ShowS
    progNotFound [Char]
    futhark, Maybe ByteString
    forall a. Maybe a
    Nothing)
            ExitFailure Int
    _ -> Either ([Char], Maybe ByteString) ()
    -> m (Either ([Char], Maybe ByteString) ())
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either ([Char], Maybe ByteString) ()
     -> m (Either ([Char], Maybe ByteString) ()))
    -> Either ([Char], Maybe ByteString) ()
    -> m (Either ([Char], Maybe ByteString) ())
    forall a b. (a -> b) -> a -> b
    $ ([Char], Maybe ByteString) -> Either ([Char], Maybe ByteString) ()
    forall a b. a -> Either a b
    Left ([Char]
    "Compilation of " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    program [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " failed:\n", ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    futerr)