{-|
Module      : THSH.Funclet
Description : Funclet definition.
Copyright   : (c) Miao ZhiCheng, 2024
License     : MIT
Maintainer  : zhicheng.miao@gmail.com
Stability   : experimental
Portability : POSIX
-}

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
  ecVar <- IO (MVar ExitCode)
forall a. IO (MVar a)
newEmptyMVar
  (hInW, hOutR, hErrR) <- runFunclet f (putMVar ecVar)
  mapM_ forkIO [ binaryCat stdin hInW
               , binaryCat hOutR stdout
               , binaryCat hErrR stderr
               ]
  ec <- takeMVar ecVar
  pure 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