module B9.B9Exec
( cmd
)
where
import B9.B9Config
import B9.B9Logging
import Control.Concurrent.Async ( Concurrently(..) )
import Control.Eff
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Control ( embed_ )
import qualified Data.ByteString as Strict
import Data.Conduit ( (.|)
, runConduit
)
import qualified Data.Conduit.List as CL
import Data.Conduit.Process
import Data.Functor ( )
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Encoding.Error as Text
import System.Exit
import Text.Printf
cmd :: CommandIO e => String -> Eff e ()
cmd str = do
inheritStdIn <- isInteractive
if inheritStdIn then interactiveCmd str else nonInteractiveCmd str
interactiveCmd :: forall e . CommandIO e => String -> Eff e ()
interactiveCmd str = void (cmdWithStdIn True str :: Eff e Inherited)
nonInteractiveCmd :: forall e . CommandIO e => String -> Eff e ()
nonInteractiveCmd str = void (cmdWithStdIn False str :: Eff e Inherited)
cmdWithStdIn
:: (CommandIO e, InputSource stdin) => Bool -> String -> Eff e stdin
cmdWithStdIn toStdOut cmdStr = do
traceL $ "COMMAND: " ++ cmdStr
traceLIO <- embed_
(traceL . Text.unpack . Text.decodeUtf8With Text.lenientDecode)
errorLIO <- embed_
(errorL . Text.unpack . Text.decodeUtf8With Text.lenientDecode)
let errorLC = CL.mapM_ (liftIO . errorLIO)
let traceLC = if toStdOut
then CL.mapM_ Strict.putStr
else CL.mapM_ (liftIO . traceLIO)
(cpIn, cpOut, cpErr, cph) <- streamingProcess (shell cmdStr)
e <-
liftIO
$ runConcurrently
$ Concurrently (runConduit (cpOut .| traceLC))
*> Concurrently (runConduit (cpErr .| errorLC))
*> Concurrently (waitForStreamingProcess cph)
checkExitCode e
return cpIn
where
checkExitCode ExitSuccess =
traceL $ printf "COMMAND '%s' exited with exit code: 0" cmdStr
checkExitCode ec@(ExitFailure e) = do
errorL $ printf "COMMAND '%s' exited with exit code: %i" cmdStr e
liftIO $ exitWith ec