module System.Chatty.Spawn where

import Text.Chatty.Finalizer
import Text.Chatty.Printer
import Text.Chatty.Scanner
import Control.Monad.IO.Class
import System.Exit
import System.IO
import qualified System.Process as P

-- | Class for all (real or pseudo) process-spawning monads.
class Monad m => MonadSpawn m where
  -- | Spawn process
  mspw :: String -> [String] -> Either Handle String -> m (Int,String,[Handle])
  -- | Accept handle as input?
  mah :: String -> m Bool

instance MonadSpawn IO where
  mspw pn as (Left h) = do
    (_, Just hout, _, ph) <- P.createProcess (P.proc pn as){
      P.std_in = P.UseHandle h,
      P.std_out = P.CreatePipe }
    so <- hGetContents hout
    ec <- P.waitForProcess ph
    return (case ec of
               ExitSuccess -> 0
               ExitFailure i -> i,
            so, [hout])
  mspw pn as (Right si) = do
    (ec,so,_) <- P.readProcessWithExitCode pn as si
    return (case ec of
               ExitSuccess -> 0
               ExitFailure i -> i,
            so, [])
  mah = return $ return True

-- | Spawn process
spawn :: (MonadFinalizer m,MonadScanner m,MonadPrinter m, MonadSpawn m,Functor m) => String -> [String] -> m Int
spawn fn as = do
  ah <- mah fn
  mscanh >>= \h' -> case if ah then h' else Nothing of
    Nothing -> do
      si <- mscanL
      (i,so,hs) <- mspw fn as (Right si)
      mprint so
      mqfhs hs
      return i
    Just h -> do
      (i,so,hs) <- mspw fn as (Left h)
      mprint so
      mqfhs hs
      return i