{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Process where

import qualified Data.ByteString.Lazy as BSL
import Polysemy
import Polysemy.Input
import System.Exit (ExitCode (..))
import qualified System.Process.Typed as TP

data Process m a where
  Read_ :: TP.ProcessConfig stdin stdout stderr -> Process m (BSL.ByteString, BSL.ByteString)
  ReadInterleaved_ :: TP.ProcessConfig stdin stdout stderr -> Process m BSL.ByteString
  ReadInterleaved :: TP.ProcessConfig stdin stdout stderr -> Process m (ExitCode, BSL.ByteString)

makeSem ''Process

runIO ::
  Member (Embed IO) r =>
  Sem (Process ': r) a ->
  Sem r a
runIO :: Sem (Process : r) a -> Sem r a
runIO =
  (forall (rInitial :: EffectRow) x.
 Process (Sem rInitial) x -> Sem r x)
-> Sem (Process : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Process (Sem rInitial) x -> Sem r x)
 -> Sem (Process : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Process (Sem rInitial) x -> Sem r x)
-> Sem (Process : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
    Read_ config -> IO (ByteString, ByteString) -> Sem r (ByteString, ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (ByteString, ByteString) -> Sem r (ByteString, ByteString))
-> IO (ByteString, ByteString) -> Sem r (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ (ProcessConfig stdin stdout stderr -> IO (ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
TP.readProcess_ ProcessConfig stdin stdout stderr
config)
    ReadInterleaved_ config -> IO ByteString -> Sem r ByteString
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO ByteString -> Sem r ByteString)
-> IO ByteString -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ (ProcessConfig stdin stdout stderr -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored -> m ByteString
TP.readProcessInterleaved_ ProcessConfig stdin stdout stderr
config)
    ReadInterleaved config -> IO (ExitCode, ByteString) -> Sem r (ExitCode, ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (ExitCode, ByteString) -> Sem r (ExitCode, ByteString))
-> IO (ExitCode, ByteString) -> Sem r (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ (ProcessConfig stdin stdout stderr -> IO (ExitCode, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString)
TP.readProcessInterleaved ProcessConfig stdin stdout stderr
config)

runPure ::
  [BSL.ByteString] ->
  Sem (Process ': r) a ->
  Sem r a
runPure :: [ByteString] -> Sem (Process : r) a -> Sem r a
runPure [ByteString]
outputList =
  [ByteString] -> Sem (Input (Maybe ByteString) : r) a -> Sem r a
forall i (r :: EffectRow) a.
[i] -> Sem (Input (Maybe i) : r) a -> Sem r a
runInputList [ByteString]
outputList
    (Sem (Input (Maybe ByteString) : r) a -> Sem r a)
-> (Sem (Process : r) a -> Sem (Input (Maybe ByteString) : r) a)
-> Sem (Process : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (rInitial :: EffectRow) x.
 Process (Sem rInitial) x -> Sem (Input (Maybe ByteString) : r) x)
-> Sem (Process : r) a -> Sem (Input (Maybe ByteString) : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpret \case
      Read_ _config -> do
        ByteString
r <- ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ByteString -> ByteString
forall a. a -> a
id (Maybe ByteString -> ByteString)
-> Sem (Input (Maybe ByteString) : r) (Maybe ByteString)
-> Sem (Input (Maybe ByteString) : r) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (Input (Maybe ByteString) : r) (Maybe ByteString)
forall i (r :: EffectRow). MemberWithError (Input i) r => Sem r i
input
        (ByteString, ByteString)
-> Sem (Input (Maybe ByteString) : r) (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
r, ByteString
"")
      ReadInterleaved_ _config -> x -> (x -> x) -> Maybe x -> x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe x
"" x -> x
forall a. a -> a
id (Maybe x -> x)
-> Sem (Input (Maybe ByteString) : r) (Maybe x)
-> Sem (Input (Maybe ByteString) : r) x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (Input (Maybe ByteString) : r) (Maybe x)
forall i (r :: EffectRow). MemberWithError (Input i) r => Sem r i
input
      ReadInterleaved _config -> do
        ByteString
r <- ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ByteString -> ByteString
forall a. a -> a
id (Maybe ByteString -> ByteString)
-> Sem (Input (Maybe ByteString) : r) (Maybe ByteString)
-> Sem (Input (Maybe ByteString) : r) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (Input (Maybe ByteString) : r) (Maybe ByteString)
forall i (r :: EffectRow). MemberWithError (Input i) r => Sem r i
input
        (ExitCode, ByteString)
-> Sem (Input (Maybe ByteString) : r) (ExitCode, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, ByteString
r)