module Graphics.Gnuplot.Private.Command where

import qualified Graphics.Gnuplot.Private.File as File
import qualified Graphics.Gnuplot.Execute as Exec
import System.Exit (ExitCode(ExitSuccess), )
import Control.Concurrent (forkIO, )

import System.IO.Temp (withSystemTempDirectory, )

import Control.DeepSeq (deepseq, )
import Control.Functor.HT (void, )


run ::
   (File.C file) =>
   (FilePath -> ([String], [file])) -> IO ExitCode
run :: (FilePath -> ([FilePath], [file])) -> IO ExitCode
run FilePath -> ([FilePath], [file])
render =
   FilePath -> (FilePath -> IO ExitCode) -> IO ExitCode
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> m a) -> m a
withSystemTempDirectory FilePath
"gnuplot" ((FilePath -> IO ExitCode) -> IO ExitCode)
-> (FilePath -> IO ExitCode) -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \FilePath
dir ->
   case FilePath -> ([FilePath], [file])
render FilePath
dir of
      ([FilePath]
cmds, [file]
files) -> [FilePath] -> IO ExitCode -> IO ExitCode
forall a b. NFData a => a -> b -> b
deepseq [FilePath]
cmds (IO ExitCode -> IO ExitCode) -> IO ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ do
         (file -> IO ()) -> [file] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ file -> IO ()
forall file. C file => file -> IO ()
File.write [file]
files
         [FilePath] -> [FilePath] -> IO ExitCode
Exec.simple ([FilePath]
cmds [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"pause mouse close"]) []

asyncIfInteractive :: Bool -> IO ExitCode -> IO ExitCode
asyncIfInteractive :: Bool -> IO ExitCode -> IO ExitCode
asyncIfInteractive Bool
interactive IO ExitCode
act =
   if Bool
interactive
     then (ThreadId -> ExitCode) -> IO ThreadId -> IO ExitCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExitCode -> ThreadId -> ExitCode
forall a b. a -> b -> a
const ExitCode
ExitSuccess) (IO ThreadId -> IO ExitCode) -> IO ThreadId -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO ExitCode
act
     else IO ExitCode
act