module THSH.Funclet
  ( Funclet (..)
  , AnyFunclet (..)
  , runFuncletWithStdHandles
  ) where

import           Control.Concurrent         (forkIO, newEmptyMVar, putMVar, takeMVar)
import           System.Exit                (ExitCode)
import           System.IO                  (Handle, stderr, stdin, stdout)
--
import           THSH.Internal.ProcessUtils (binaryCat)


-- | A funclet is an IO process that communicates through handles and returns an exit code.
class Funclet f where
  runFunclet :: f -> (ExitCode -> IO ()) -> IO (Handle, Handle, Handle)

-- | Run a funclet with standard handles
runFuncletWithStdHandles :: Funclet f => f -> IO ExitCode
runFuncletWithStdHandles :: forall f. Funclet f => f -> IO ExitCode
runFuncletWithStdHandles f
f = do
  MVar ExitCode
ecVar <- IO (MVar ExitCode)
forall a. IO (MVar a)
newEmptyMVar
  (Handle
hInW, Handle
hOutR, Handle
hErrR) <- f -> (ExitCode -> IO ()) -> IO (Handle, Handle, Handle)
forall f.
Funclet f =>
f -> (ExitCode -> IO ()) -> IO (Handle, Handle, Handle)
runFunclet f
f (MVar ExitCode -> ExitCode -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ExitCode
ecVar)
  (IO () -> IO ThreadId) -> [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ IO () -> IO ThreadId
forkIO [ Handle -> Handle -> IO ()
binaryCat Handle
stdin Handle
hInW
               , Handle -> Handle -> IO ()
binaryCat Handle
hOutR Handle
stdout
               , Handle -> Handle -> IO ()
binaryCat Handle
hErrR Handle
stderr
               ]
  ExitCode
ec <- MVar ExitCode -> IO ExitCode
forall a. MVar a -> IO a
takeMVar MVar ExitCode
ecVar
  ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ec

-- | Existential wrapper of any funclet.
data AnyFunclet = forall f. Funclet f => MkAnyFunclet f

instance Funclet AnyFunclet where
  runFunclet :: AnyFunclet -> (ExitCode -> IO ()) -> IO (Handle, Handle, Handle)
runFunclet (MkAnyFunclet f
f) = f -> (ExitCode -> IO ()) -> IO (Handle, Handle, Handle)
forall f.
Funclet f =>
f -> (ExitCode -> IO ()) -> IO (Handle, Handle, Handle)
runFunclet f
f