-- | Compiling Futhark programs and running them as servers, as needed for
-- testing and benchmarking, but also by anything else that runs compiled
-- programs.
module Futhark.Test.Compile
  ( FutharkExe (..),
    binaryName,
    compileProgram,
    futharkServerCfg,
  )
where

import Control.Monad.Except (MonadError (..))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString qualified as SBS
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Futhark.Server
import Futhark.Util (isEnvVarAtLeast)
import System.Exit
import System.FilePath
import System.Process.ByteString (readProcessWithExitCode)

-- | The @futhark@ executable we are using.  This is merely a wrapper
-- around the underlying file path, because we will be using a lot of
-- different file paths here, and it is easy to mix them up.
newtype FutharkExe = FutharkExe FilePath
  deriving (FutharkExe -> FutharkExe -> Bool
(FutharkExe -> FutharkExe -> Bool)
-> (FutharkExe -> FutharkExe -> Bool) -> Eq FutharkExe
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FutharkExe -> FutharkExe -> Bool
== :: FutharkExe -> FutharkExe -> Bool
$c/= :: FutharkExe -> FutharkExe -> Bool
/= :: FutharkExe -> FutharkExe -> Bool
Eq, Eq FutharkExe
Eq FutharkExe =>
(FutharkExe -> FutharkExe -> Ordering)
-> (FutharkExe -> FutharkExe -> Bool)
-> (FutharkExe -> FutharkExe -> Bool)
-> (FutharkExe -> FutharkExe -> Bool)
-> (FutharkExe -> FutharkExe -> Bool)
-> (FutharkExe -> FutharkExe -> FutharkExe)
-> (FutharkExe -> FutharkExe -> FutharkExe)
-> Ord FutharkExe
FutharkExe -> FutharkExe -> Bool
FutharkExe -> FutharkExe -> Ordering
FutharkExe -> FutharkExe -> FutharkExe
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FutharkExe -> FutharkExe -> Ordering
compare :: FutharkExe -> FutharkExe -> Ordering
$c< :: FutharkExe -> FutharkExe -> Bool
< :: FutharkExe -> FutharkExe -> Bool
$c<= :: FutharkExe -> FutharkExe -> Bool
<= :: FutharkExe -> FutharkExe -> Bool
$c> :: FutharkExe -> FutharkExe -> Bool
> :: FutharkExe -> FutharkExe -> Bool
$c>= :: FutharkExe -> FutharkExe -> Bool
>= :: FutharkExe -> FutharkExe -> Bool
$cmax :: FutharkExe -> FutharkExe -> FutharkExe
max :: FutharkExe -> FutharkExe -> FutharkExe
$cmin :: FutharkExe -> FutharkExe -> FutharkExe
min :: FutharkExe -> FutharkExe -> FutharkExe
Ord, Int -> FutharkExe -> FilePath -> FilePath
[FutharkExe] -> FilePath -> FilePath
FutharkExe -> FilePath
(Int -> FutharkExe -> FilePath -> FilePath)
-> (FutharkExe -> FilePath)
-> ([FutharkExe] -> FilePath -> FilePath)
-> Show FutharkExe
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> FutharkExe -> FilePath -> FilePath
showsPrec :: Int -> FutharkExe -> FilePath -> FilePath
$cshow :: FutharkExe -> FilePath
show :: FutharkExe -> FilePath
$cshowList :: [FutharkExe] -> FilePath -> FilePath
showList :: [FutharkExe] -> FilePath -> FilePath
Show)

-- | The name we use for compiled programs.
binaryName :: FilePath -> FilePath
binaryName :: FilePath -> FilePath
binaryName = FilePath -> FilePath
dropExtension

-- | @compileProgram extra_options futhark backend program@ compiles
-- @program@ with the command @futhark backend extra-options...@, and
-- returns stdout and stderr of the compiler.  Throws an IO exception
-- containing stderr if compilation fails.
compileProgram ::
  (MonadIO m, MonadError T.Text m) =>
  [String] ->
  FutharkExe ->
  String ->
  FilePath ->
  m (SBS.ByteString, SBS.ByteString)
compileProgram :: forall (m :: * -> *).
(MonadIO m, MonadError Text m) =>
[FilePath]
-> FutharkExe -> FilePath -> FilePath -> m (ByteString, ByteString)
compileProgram [FilePath]
extra_options (FutharkExe FilePath
futhark) FilePath
backend FilePath
program = do
  (futcode, stdout, stderr) <- 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
$ FilePath
-> [FilePath]
-> ByteString
-> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode FilePath
futhark (FilePath
backend FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
options) ByteString
""
  case futcode of
    ExitFailure Int
127 -> Text -> m ()
forall a. Text -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
progNotFound (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
futhark
    ExitFailure Int
_ -> Text -> m ()
forall a. Text -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
stderr
    ExitCode
ExitSuccess -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pure (stdout, stderr)
  where
    binOutputf :: FilePath
binOutputf = FilePath -> FilePath
binaryName FilePath
program
    options :: [FilePath]
options = [FilePath
program, FilePath
"-o", FilePath
binOutputf] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
extra_options
    progNotFound :: a -> a
progNotFound a
s = a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
": command not found"

-- | Create a Futhark server configuration suitable for use when
-- testing/benchmarking Futhark programs.
futharkServerCfg :: FilePath -> [String] -> ServerCfg
futharkServerCfg :: FilePath -> [FilePath] -> ServerCfg
futharkServerCfg FilePath
prog [FilePath]
opts =
  (FilePath -> [FilePath] -> ServerCfg
newServerCfg FilePath
prog [FilePath]
opts)
    { cfgDebug = isEnvVarAtLeast "FUTHARK_COMPILER_DEBUGGING" 1
    }