{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

-- | 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 (..),
  )
where

import Control.Applicative
import Control.Monad.Except
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as SBS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.HashMap.Strict as HM
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Text as T
import Futhark.Server
import Futhark.Test
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
/= :: RunResult -> RunResult -> Bool
$c/= :: RunResult -> RunResult -> Bool
== :: RunResult -> RunResult -> Bool
$c== :: RunResult -> RunResult -> Bool
Eq, Int -> RunResult -> ShowS
[RunResult] -> ShowS
RunResult -> String
(Int -> RunResult -> ShowS)
-> (RunResult -> String)
-> ([RunResult] -> ShowS)
-> Show RunResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunResult] -> ShowS
$cshowList :: [RunResult] -> ShowS
show :: RunResult -> String
$cshow :: RunResult -> String
showsPrec :: Int -> RunResult -> ShowS
$cshowsPrec :: Int -> RunResult -> ShowS
Show)

data Result = Result
  { Result -> [RunResult]
runResults :: [RunResult],
    Result -> Map Text Int
memoryMap :: M.Map T.Text Int,
    Result -> Text
stdErr :: T.Text
  }
  deriving (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)

-- | The results for a single named dataset is either an error message, or
-- runtime measurements, the number of bytes used, and the stderr that was
-- produced.
data DataResult = DataResult String (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
/= :: DataResult -> DataResult -> Bool
$c/= :: DataResult -> DataResult -> Bool
== :: DataResult -> DataResult -> Bool
$c== :: DataResult -> DataResult -> Bool
Eq, Int -> DataResult -> ShowS
[DataResult] -> ShowS
DataResult -> String
(Int -> DataResult -> ShowS)
-> (DataResult -> String)
-> ([DataResult] -> ShowS)
-> Show DataResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataResult] -> ShowS
$cshowList :: [DataResult] -> ShowS
show :: DataResult -> String
$cshow :: DataResult -> String
showsPrec :: Int -> DataResult -> ShowS
$cshowsPrec :: Int -> DataResult -> ShowS
Show)

-- | The results for all datasets for some benchmark program.
data BenchResult = BenchResult FilePath [DataResult]
  deriving (BenchResult -> BenchResult -> Bool
(BenchResult -> BenchResult -> Bool)
-> (BenchResult -> BenchResult -> Bool) -> Eq BenchResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BenchResult -> BenchResult -> Bool
$c/= :: BenchResult -> BenchResult -> Bool
== :: BenchResult -> BenchResult -> Bool
$c== :: BenchResult -> BenchResult -> Bool
Eq, Int -> BenchResult -> ShowS
[BenchResult] -> ShowS
BenchResult -> String
(Int -> BenchResult -> ShowS)
-> (BenchResult -> String)
-> ([BenchResult] -> ShowS)
-> Show BenchResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BenchResult] -> ShowS
$cshowList :: [BenchResult] -> ShowS
show :: BenchResult -> String
$cshow :: BenchResult -> String
showsPrec :: Int -> BenchResult -> ShowS
$cshowsPrec :: Int -> 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 Text
err) = ([RunResult], Map Text Int, Text) -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON ([RunResult]
runres, Map Text Int
memmap, Text
err)

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

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 (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 ((Text -> Value -> Series) -> Pair -> Series
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 = String
-> (Object -> Parser DataResults) -> Value -> Parser DataResults
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"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)
mapM Pair -> Parser DataResult
datasetResult (Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
o)
    where
      datasetResult :: Pair -> Parser DataResult
datasetResult (Text
k, Value
v) =
        String -> Either Text Result -> DataResult
DataResult (Text -> String
T.unpack Text
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 (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 = String -> (Object -> Parser Result) -> Value -> Parser Result
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"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 -> Text -> Result
Result ([RunResult] -> Map Text Int -> Text -> Result)
-> Parser [RunResult] -> Parser (Map Text Int -> Text -> Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [RunResult]
forall a. FromJSON a => Object -> Text -> Parser a
JSON..: Text
"runtimes" Parser (Map Text Int -> Text -> Result)
-> Parser (Map Text Int) -> Parser (Text -> Result)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Map Text Int)
forall a. FromJSON a => Object -> Text -> Parser a
JSON..: Text
"bytes" Parser (Text -> Result) -> Parser Text -> Parser Result
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
JSON..: Text
"stderr"

dataResultJSON :: DataResult -> (T.Text, JSON.Value)
dataResultJSON :: DataResult -> Pair
dataResultJSON (DataResult String
desc (Left Text
err)) =
  (String -> Text
T.pack String
desc, Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
err)
dataResultJSON (DataResult String
desc (Right (Result [RunResult]
runtimes Map Text Int
bytes Text
progerr))) =
  ( String -> Text
T.pack String
desc,
    [Pair] -> Value
JSON.object
      [ (Text
"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),
        (Text
"bytes", Map Text Int -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Map Text Int
bytes),
        (Text
"stderr", Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
progerr)
      ]
  )

benchResultJSON :: BenchResult -> (T.Text, JSON.Value)
benchResultJSON :: BenchResult -> Pair
benchResultJSON (BenchResult String
prog [DataResult]
r) =
  ( String -> Text
T.pack String
prog,
    Object -> Value
JSON.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Text
"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) =
    Object -> Value
JSON.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([Pair] -> Object) -> [Pair] -> Object
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 = String
-> (Object -> Parser BenchResults) -> Value -> Parser BenchResults
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"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)
mapM Pair -> Parser BenchResult
onBenchmark (Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
o)
    where
      onBenchmark :: Pair -> Parser BenchResult
onBenchmark (Text
k, Value
v) =
        String -> [DataResult] -> BenchResult
BenchResult (Text -> String
T.unpack Text
k)
          ([DataResult] -> BenchResult)
-> Parser [DataResult] -> Parser BenchResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Object -> Parser [DataResult]) -> Value -> Parser [DataResult]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"benchmark" Object -> Parser [DataResult]
onBenchmark' Value
v
      onBenchmark' :: Object -> Parser [DataResult]
onBenchmark' Object
o =
        (DataResults -> [DataResult])
-> Parser DataResults -> Parser [DataResult]
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 -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
JSON..: Text
"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 String [BenchResult]
decodeBenchResults = (BenchResults -> [BenchResult])
-> Either String BenchResults -> Either String [BenchResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BenchResults -> [BenchResult]
unBenchResults (Either String BenchResults -> Either String [BenchResult])
-> (ByteString -> Either String BenchResults)
-> ByteString
-> Either String [BenchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String BenchResults
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecode'

--- Running benchmarks

-- | How to run a benchmark.
data RunOptions = RunOptions
  { RunOptions -> Int
runRuns :: Int,
    RunOptions -> Int
runTimeout :: Int,
    RunOptions -> Int
runVerbose :: Int,
    -- | Invoked for every runtime measured during the run.  Can be
    -- used to provide a progress bar.
    RunOptions -> Maybe (Int -> IO ())
runResultAction :: Maybe (Int -> IO ())
  }

cmdMaybe :: (MonadError T.Text m, MonadIO m) => IO (Maybe CmdFailure) -> m ()
cmdMaybe :: IO (Maybe CmdFailure) -> m ()
cmdMaybe = m () -> (CmdFailure -> m ()) -> Maybe CmdFailure -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> (CmdFailure -> Text) -> CmdFailure -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> (CmdFailure -> [Text]) -> CmdFailure -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdFailure -> [Text]
failureMsg) (Maybe CmdFailure -> m ())
-> (IO (Maybe CmdFailure) -> m (Maybe CmdFailure))
-> IO (Maybe CmdFailure)
-> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO (Maybe CmdFailure) -> m (Maybe CmdFailure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

cmdEither :: (MonadError T.Text m, MonadIO m) => IO (Either CmdFailure a) -> m a
cmdEither :: IO (Either CmdFailure a) -> m a
cmdEither = (CmdFailure -> m a) -> (a -> m a) -> Either CmdFailure a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m a) -> (CmdFailure -> Text) -> CmdFailure -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> (CmdFailure -> [Text]) -> CmdFailure -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdFailure -> [Text]
failureMsg) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CmdFailure a -> m a)
-> (IO (Either CmdFailure a) -> m (Either CmdFailure a))
-> IO (Either CmdFailure a)
-> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO (Either CmdFailure a) -> m (Either CmdFailure a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | 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))
benchmarkDataset :: Server
-> RunOptions
-> FutharkExe
-> String
-> Text
-> Values
-> Maybe Success
-> String
-> IO (Either Text ([RunResult], Text))
benchmarkDataset Server
server RunOptions
opts FutharkExe
futhark String
program Text
entry Values
input_spec Maybe Success
expected_spec String
ref_out = ExceptT Text IO ([RunResult], Text)
-> IO (Either Text ([RunResult], Text))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO ([RunResult], Text)
 -> IO (Either Text ([RunResult], Text)))
-> ExceptT Text IO ([RunResult], Text)
-> IO (Either Text ([RunResult], Text))
forall a b. (a -> b) -> a -> b
$ do
  [Text]
output_types <- IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall (m :: * -> *) a.
(MonadError Text m, MonadIO m) =>
IO (Either CmdFailure a) -> m a
cmdEither (IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text])
-> IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall a b. (a -> b) -> a -> b
$ Server -> Text -> IO (Either CmdFailure [Text])
cmdOutputs Server
server Text
entry
  [Text]
input_types <- IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall (m :: * -> *) a.
(MonadError Text m, MonadIO m) =>
IO (Either CmdFailure a) -> m a
cmdEither (IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text])
-> IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall a b. (a -> b) -> a -> b
$ Server -> Text -> IO (Either CmdFailure [Text])
cmdInputs Server
server Text
entry
  let outs :: [Text]
outs = [Text
"out" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) | Int
i <- [Int
0 .. [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
output_types Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
      ins :: [Text]
ins = [Text
"in" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) | Int
i <- [Int
0 .. [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
input_types Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
      freeOuts :: ExceptT Text IO ()
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 :: ExceptT Text IO ()
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)

  IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> (IO (Maybe CmdFailure) -> IO (Maybe CmdFailure))
-> IO (Maybe CmdFailure)
-> ExceptT Text IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe CmdFailure) -> IO (Maybe CmdFailure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ Server -> IO (Maybe CmdFailure)
cmdClear Server
server

  (Text -> ExceptT Text IO ())
-> (() -> ExceptT Text IO ())
-> Either Text ()
-> ExceptT Text IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> ExceptT Text IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError () -> ExceptT Text IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either Text () -> ExceptT Text IO ())
-> ((String -> IO (Either Text ()))
    -> ExceptT Text IO (Either Text ()))
-> (String -> IO (Either Text ()))
-> ExceptT Text IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FutharkExe
-> String
-> Values
-> (String -> IO (Either Text ()))
-> ExceptT Text IO (Either Text ())
forall (m :: * -> *) a.
MonadIO m =>
FutharkExe -> String -> Values -> (String -> IO a) -> m a
withValuesFile FutharkExe
futhark String
dir Values
input_spec
    ((String -> IO (Either Text ())) -> ExceptT Text IO ())
-> (String -> IO (Either Text ())) -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ \String
values_f ->
      ExceptT Text IO () -> IO (Either Text ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO () -> IO (Either Text ()))
-> ExceptT Text IO () -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ do
        String -> [Text] -> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
String -> [Text] -> m ()
checkValueTypes String
values_f [Text]
input_types
        IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ Server -> String -> [(Text, Text)] -> IO (Maybe CmdFailure)
cmdRestore Server
server String
values_f ([Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ins [Text]
input_types)

  let runtime :: Text -> Maybe a
runtime Text
l
        | Just Text
l' <- Text -> Text -> Maybe Text
T.stripPrefix Text
"runtime: " Text
l,
          [(a
x, String
"")] <- ReadS a
forall a. Read a => ReadS a
reads ReadS a -> ReadS a
forall a b. (a -> b) -> a -> b
$ Text -> String
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 :: ExceptT Text IO (RunResult, [Text])
doRun = do
        [Text]
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)
        case (Text -> Maybe Int) -> [Text] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Int
forall a. Read a => Text -> Maybe a
runtime [Text]
call_lines of
          [Int
call_runtime] -> do
            IO () -> ExceptT Text IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text IO ()) -> IO () -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> IO ()) -> Maybe (Int -> IO ()) -> Int -> IO ()
forall a. a -> Maybe a -> a
fromMaybe (IO () -> Int -> IO ()
forall a b. a -> b -> a
const (IO () -> Int -> IO ()) -> IO () -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (RunOptions -> Maybe (Int -> IO ())
runResultAction RunOptions
opts) Int
call_runtime
            (RunResult, [Text]) -> ExceptT Text IO (RunResult, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> RunResult
RunResult Int
call_runtime, [Text]
call_lines)
          [] -> Text -> ExceptT Text IO (RunResult, [Text])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"Could not find runtime in output."
          [Int]
ls -> Text -> ExceptT Text IO (RunResult, [Text])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> ExceptT Text IO (RunResult, [Text]))
-> Text -> ExceptT Text IO (RunResult, [Text])
forall a b. (a -> b) -> a -> b
$ Text
"Ambiguous runtimes: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([Int] -> String
forall a. Show a => a -> String
show [Int]
ls)

  Maybe (Either Text [(RunResult, [Text])])
maybe_call_logs <- IO (Maybe (Either Text [(RunResult, [Text])]))
-> ExceptT Text IO (Maybe (Either Text [(RunResult, [Text])]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either Text [(RunResult, [Text])]))
 -> ExceptT Text IO (Maybe (Either Text [(RunResult, [Text])])))
-> (ExceptT Text IO [(RunResult, [Text])]
    -> IO (Maybe (Either Text [(RunResult, [Text])])))
-> ExceptT Text IO [(RunResult, [Text])]
-> ExceptT Text IO (Maybe (Either Text [(RunResult, [Text])]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> IO (Either Text [(RunResult, [Text])])
-> IO (Maybe (Either Text [(RunResult, [Text])]))
forall a. Int -> IO a -> IO (Maybe a)
timeout (RunOptions -> Int
runTimeout RunOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000) (IO (Either Text [(RunResult, [Text])])
 -> IO (Maybe (Either Text [(RunResult, [Text])])))
-> (ExceptT Text IO [(RunResult, [Text])]
    -> IO (Either Text [(RunResult, [Text])]))
-> ExceptT Text IO [(RunResult, [Text])]
-> IO (Maybe (Either Text [(RunResult, [Text])]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Text IO [(RunResult, [Text])]
-> IO (Either Text [(RunResult, [Text])])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO [(RunResult, [Text])]
 -> ExceptT Text IO (Maybe (Either Text [(RunResult, [Text])])))
-> ExceptT Text IO [(RunResult, [Text])]
-> ExceptT Text IO (Maybe (Either Text [(RunResult, [Text])]))
forall a b. (a -> b) -> a -> b
$ do
    -- First one uncounted warmup run.
    ExceptT Text IO [Text] -> ExceptT Text IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT Text IO [Text] -> ExceptT Text IO ())
-> ExceptT Text IO [Text] -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall (m :: * -> *) a.
(MonadError Text m, MonadIO m) =>
IO (Either CmdFailure a) -> m a
cmdEither (IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text])
-> IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall a b. (a -> b) -> a -> b
$ Server -> Text -> [Text] -> [Text] -> IO (Either CmdFailure [Text])
cmdCall Server
server Text
entry [Text]
outs [Text]
ins
    ExceptT Text IO ()
freeOuts
    [(RunResult, [Text])]
xs <- Int
-> ExceptT Text IO (RunResult, [Text])
-> ExceptT Text IO [(RunResult, [Text])]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (RunOptions -> Int
runRuns RunOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (ExceptT Text IO (RunResult, [Text])
doRun ExceptT Text IO (RunResult, [Text])
-> ExceptT Text IO () -> ExceptT Text IO (RunResult, [Text])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ExceptT Text IO ()
freeOuts)
    (RunResult, [Text])
y <- ExceptT Text IO (RunResult, [Text])
doRun
    [(RunResult, [Text])] -> ExceptT Text IO [(RunResult, [Text])]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(RunResult, [Text])] -> ExceptT Text IO [(RunResult, [Text])])
-> [(RunResult, [Text])] -> ExceptT Text IO [(RunResult, [Text])]
forall a b. (a -> b) -> a -> b
$ [(RunResult, [Text])]
xs [(RunResult, [Text])]
-> [(RunResult, [Text])] -> [(RunResult, [Text])]
forall a. [a] -> [a] -> [a]
++ [(RunResult, [Text])
y]

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

  ExceptT Text IO ()
freeIns

  [Text]
report <- IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall (m :: * -> *) a.
(MonadError Text m, MonadIO m) =>
IO (Either CmdFailure a) -> m a
cmdEither (IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text])
-> IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall a b. (a -> b) -> a -> b
$ Server -> IO (Either CmdFailure [Text])
cmdReport Server
server

  [Value]
vs <- Server -> [Text] -> String -> ExceptT Text IO [Value]
forall (m :: * -> *).
(MonadIO m, MonadError Text m) =>
Server -> [Text] -> String -> m [Value]
readResults Server
server [Text]
outs String
program ExceptT Text IO [Value]
-> ExceptT Text IO () -> ExceptT Text IO [Value]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ExceptT Text IO ()
freeOuts

  Maybe [Value]
maybe_expected <-
    IO (Maybe [Value]) -> ExceptT Text IO (Maybe [Value])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Value]) -> ExceptT Text IO (Maybe [Value]))
-> IO (Maybe [Value]) -> ExceptT Text IO (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ IO (Maybe [Value])
-> (Success -> IO (Maybe [Value]))
-> Maybe Success
-> IO (Maybe [Value])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe [Value] -> IO (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Value]
forall a. Maybe a
Nothing) (([Value] -> Maybe [Value]) -> IO [Value] -> IO (Maybe [Value])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just (IO [Value] -> IO (Maybe [Value]))
-> (Success -> IO [Value]) -> Success -> IO (Maybe [Value])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Success -> IO [Value]
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
Success -> m [Value]
getExpectedValues) Maybe Success
expected_spec

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

  ([RunResult], Text) -> ExceptT Text IO ([RunResult], Text)
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( ((RunResult, [Text]) -> RunResult)
-> [(RunResult, [Text])] -> [RunResult]
forall a b. (a -> b) -> [a] -> [b]
map (RunResult, [Text]) -> RunResult
forall a b. (a, b) -> a
fst [(RunResult, [Text])]
call_logs,
      [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((RunResult, [Text]) -> Text) -> [(RunResult, [Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
T.unlines ([Text] -> Text)
-> ((RunResult, [Text]) -> [Text]) -> (RunResult, [Text]) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunResult, [Text]) -> [Text]
forall a b. (a, b) -> b
snd) [(RunResult, [Text])]
call_logs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
report
    )
  where
    getExpectedValues :: Success -> m [Value]
getExpectedValues (SuccessValues Values
vs) =
      FutharkExe -> String -> Values -> m [Value]
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FutharkExe -> String -> Values -> m [Value]
getValues FutharkExe
futhark String
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
$ String -> Values
InFile String
ref_out

    dir :: String
dir = ShowS
takeDirectory String
program

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

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

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

  Either [Text] ()
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
-> String
-> String
-> [InputOutputs]
-> ExceptT [Text] m ()
forall (m :: * -> *).
(MonadIO m, MonadError [Text] m) =>
Maybe Int
-> FutharkExe -> String -> String -> [InputOutputs] -> m ()
ensureReferenceOutput Maybe Int
concurrency (String -> FutharkExe
FutharkExe String
futhark) String
"c" String
program [InputOutputs]
cases
  case Either [Text] ()
ref_res of
    Left [Text]
err ->
      Either (String, Maybe ByteString) ()
-> m (Either (String, Maybe ByteString) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (String, Maybe ByteString) ()
 -> m (Either (String, Maybe ByteString) ()))
-> Either (String, Maybe ByteString) ()
-> m (Either (String, Maybe ByteString) ())
forall a b. (a -> b) -> a -> b
$
        (String, Maybe ByteString) -> Either (String, Maybe ByteString) ()
forall a b. a -> Either a b
Left
          ( String
"Reference output generation for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
program String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" failed:\n"
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
err),
            Maybe ByteString
forall a. Maybe a
Nothing
          )
    Right () -> do
      (ExitCode
futcode, ByteString
_, ByteString
futerr) <-
        IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
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
$
          String
-> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode
            String
futhark
            ( [CompileOptions -> String
compBackend CompileOptions
opts, String
program, String
"-o", ShowS
binaryName String
program, String
"--server"]
                [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> CompileOptions -> [String]
compOptions CompileOptions
opts
            )
            ByteString
""

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