module Graphics.Gnuplot.Execute where

import qualified System.IO as IO
import System.IO.Temp (withSystemTempFile, )
import System.Exit (ExitCode, )
import System.Process (readProcessWithExitCode, )


tmpScript :: FilePath
tmpScript :: FilePath
tmpScript = FilePath
"curve.gp"

simple ::
      [String] {-^ The lines of the gnuplot script to be piped into gnuplot -}
   -> [String] {-^ Options for gnuplot -}
   -> IO ExitCode
simple :: [FilePath] -> [FilePath] -> IO ExitCode
simple [FilePath]
program [FilePath]
options =
   FilePath -> (FilePath -> Handle -> IO ExitCode) -> IO ExitCode
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
tmpScript ((FilePath -> Handle -> IO ExitCode) -> IO ExitCode)
-> (FilePath -> Handle -> IO ExitCode) -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \FilePath
path Handle
handle -> do
      Handle -> FilePath -> IO ()
IO.hPutStr Handle
handle ([FilePath] -> FilePath
unlines [FilePath]
program)
      Handle -> IO ()
IO.hClose Handle
handle
      -- putStrLn $ showCommandForUser "gnuplot" (options ++ [path])
      (ExitCode
exitCode, FilePath
_out, FilePath
_err) <-
         FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
"gnuplot" ([FilePath]
options [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
path]) []
      -- putStr out
      -- putStr err
      ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
exitCode