module Control.Distributed.Fork.Local where

import Control.Distributed.Fork.Backend
import qualified Data.ByteString.Lazy as BL
import System.Process.Typed

-- |
-- A 'Backend' which uses local processes as executors. Useful for testing.
localProcessBackend :: Backend
localProcessBackend :: Backend
localProcessBackend =
  (ByteString -> BackendM ByteString) -> Backend
Backend ((ByteString -> BackendM ByteString) -> Backend)
-> (ByteString -> BackendM ByteString) -> Backend
forall a b. (a -> b) -> a -> b
$ \ByteString
stdin' -> do
    FilePath
executable <- IO FilePath -> BackendM FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getExecutablePath
    let conf :: ProcessConfig () () ()
conf =
          StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin (ByteString -> StreamSpec 'STInput ()
byteStringInput (ByteString -> StreamSpec 'STInput ())
-> ByteString -> StreamSpec 'STInput ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict ByteString
stdin') (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$
            FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
executable [FilePath
argExecutorMode]
    IO ByteString -> BackendM ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> BackendM ByteString)
-> (IO ByteString -> IO ByteString)
-> IO ByteString
-> BackendM ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
BL.toStrict (IO ByteString -> BackendM ByteString)
-> IO ByteString -> BackendM ByteString
forall a b. (a -> b) -> a -> b
$ ProcessConfig () () () -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ ProcessConfig () () ()
conf