{-|
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

-- base module
import           Control.Concurrent         (forkIO, newEmptyMVar, putMVar, takeMVar)
import           Control.Exception          (bracket)
import           System.Exit                (ExitCode)
import           System.IO                  (BufferMode (NoBuffering), Handle, hClose, hSetBuffering, stderr, stdin,
                                             stdout)
--
import           System.Process             (createPipe)
--
import           THSH.Internal.ProcessUtils (binaryCat)


-- | A funclet is an IO process that communicates through handles and calls back with an exit code.
class Funclet f where
  {-# MINIMAL runFunclet | runFuncletWithHandles #-}

  -- | Run the funclet which creates a set of handles itself.
  runFunclet :: f -> (ExitCode -> IO ()) -> IO (Handle, Handle, Handle)
  -- ^ It has a default implementation that calls `runFuncletWithHandles` with created pipes.
  runFunclet f
f ExitCode -> IO ()
cb = do
    handles <- IO (MVar (Handle, Handle, Handle))
forall a. IO (MVar a)
newEmptyMVar
    _ <- forkIO $ bracket
      (do
          (hInR, hInW)   <- createPipe
          (hOutR, hOutW) <- createPipe
          (hErrR, hErrW) <- createPipe
          mapM_ (`hSetBuffering` NoBuffering) [hInR, hInW, hOutR, hOutW, hErrR, hErrW]
          putMVar handles (hInW, hOutR, hErrR)
          pure (hInR, hOutW, hErrW)
      )
      (\(Handle
hInR, Handle
hOutW, Handle
hErrW) -> (Handle -> IO ()) -> [Handle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Handle -> IO ()
hClose [Handle
hInR, Handle
hOutW, Handle
hErrW])
      (\(Handle
hInR, Handle
hOutW, Handle
hErrW) -> f -> (ExitCode -> IO ()) -> (Handle, Handle, Handle) -> IO ()
forall f.
Funclet f =>
f -> (ExitCode -> IO ()) -> (Handle, Handle, Handle) -> IO ()
runFuncletWithHandles f
f ExitCode -> IO ()
cb (Handle
hInR, Handle
hOutW, Handle
hErrW))
    takeMVar handles

  -- | Run the funclet with the set of handles provided.
  runFuncletWithHandles :: f -> (ExitCode -> IO ()) -> (Handle, Handle, Handle) -> IO ()
  -- ^ It has a default implementation that simply piping data between `runFunclet` and the provided handles.
  runFuncletWithHandles f
f ExitCode -> IO ()
cb (Handle
hInR, Handle
hOutW, Handle
hErrW) = do
    (hInW, hOutR, hErrR) <- f -> (ExitCode -> IO ()) -> IO (Handle, Handle, Handle)
forall f.
Funclet f =>
f -> (ExitCode -> IO ()) -> IO (Handle, Handle, Handle)
runFunclet f
f ExitCode -> IO ()
cb
    mapM_ forkIO [ binaryCat hInR hInW
                 , binaryCat hOutR hOutW
                 , binaryCat hErrR hErrW
               ]

-- | Run a 'Funclet' with standard handles synchronously.
runFuncletWithStdHandles :: Funclet f => f -> IO ExitCode
runFuncletWithStdHandles :: forall f. Funclet f => f -> IO ExitCode
runFuncletWithStdHandles f
f = do
  mExitCode <- IO (MVar ExitCode)
forall a. IO (MVar a)
newEmptyMVar
  runFuncletWithHandles f (putMVar mExitCode) (stdin, stdout, stderr)
  takeMVar mExitCode

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

-- | 'AnyFunclet' is of course also a 'Funclet'.
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