{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}

module System.FilePath.FilePather.Process(
  spawnProcess
, showCommandForUser
, readProcess
, proc
, callProcess
, readProcessWithExitCode
) where

import Control.Exitcode as E ( ExitcodeT )
import Control.Exception ( Exception )
import Control.Monad.Reader.Class ( MonadReader(reader) )
import Control.Monad.Except ( ExceptT )
import Control.Process( ProcessHandle, CreateProcess )
import qualified Control.Process as P
import Data.String ( String )
import System.FilePath.FilePather.ReadFilePath
    ( ReadFilePath,
      ReadFilePathT,
      successReadFilePath,
      tryReadFilePath )
import System.IO ( IO )

spawnProcess ::
  Exception e =>
  [String]
  -> ReadFilePathT e IO ProcessHandle
spawnProcess :: forall e.
Exception e =>
[String] -> ReadFilePathT e IO ProcessHandle
spawnProcess [String]
x =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (String -> [String] -> IO ProcessHandle
`P.spawnProcess` [String]
x)

showCommandForUser ::
  [String]
  -> ReadFilePath e String
showCommandForUser :: forall e. [String] -> ReadFilePath e String
showCommandForUser [String]
x =
  forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader (String -> [String] -> String
`P.showCommandForUser` [String]
x)

readProcess ::
  Exception e =>
  [String]
  -> String
  -> ReadFilePathT e IO String
readProcess :: forall e.
Exception e =>
[String] -> String -> ReadFilePathT e IO String
readProcess [String]
args String
i =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (\String
p -> String -> [String] -> String -> IO String
P.readProcess String
p [String]
args String
i)

proc ::
  [String]
  -> ReadFilePath e CreateProcess
proc :: forall e. [String] -> ReadFilePath e CreateProcess
proc [String]
s =
  forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader (String -> [String] -> CreateProcess
`P.proc` [String]
s)

callProcess ::
  Exception e =>
  [String]
  -> ReadFilePathT e IO ()
callProcess :: forall e. Exception e => [String] -> ReadFilePathT e IO ()
callProcess [String]
s =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (String -> [String] -> IO ()
`P.callProcess` [String]
s)

readProcessWithExitCode ::
  Exception e' =>
  [String]
  -> String
  -> ReadFilePathT e (ExitcodeT (ExceptT e' IO) (String, String)) (String, String)
readProcessWithExitCode :: forall e' e.
Exception e' =>
[String]
-> String
-> ReadFilePathT
     e (ExitcodeT (ExceptT e' IO) (String, String)) (String, String)
readProcessWithExitCode [String]
as String
a =
  forall (f :: * -> *) a e.
Functor f =>
(String -> f a) -> ReadFilePathT e f a
successReadFilePath (\String
p -> forall e'.
Exception e' =>
String
-> [String]
-> String
-> ExitcodeT (ExceptT e' IO) (String, String) (String, String)
P.readProcessWithExitCode String
p [String]
as String
a)