module System.Process.Ext ( waitProcess ) where import Control.Monad.Reader (ask) import CPkgPrelude import Package.C.Monad import Package.C.Type.Verbosity import System.Exit (ExitCode (ExitSuccess), exitWith) import System.Process handleExit :: ExitCode -> IO () handleExit :: ExitCode -> IO () handleExit ExitCode ExitSuccess = IO () forall a. Monoid a => a mempty handleExit ExitCode x = ExitCode -> IO () forall a. ExitCode -> IO a exitWith ExitCode x verbosityErr :: Verbosity -> StdStream verbosityErr :: Verbosity -> StdStream verbosityErr Verbosity v | Verbosity v Verbosity -> Verbosity -> Bool forall a. Ord a => a -> a -> Bool >= Verbosity Verbose = StdStream Inherit verbosityErr Verbosity _ = StdStream CreatePipe waitProcess :: CreateProcess -> PkgM () waitProcess :: CreateProcess -> PkgM () waitProcess CreateProcess proc' = do Verbosity v <- StateT InstallDb (ReaderT Verbosity IO) Verbosity forall r (m :: * -> *). MonadReader r m => m r ask if Verbosity v Verbosity -> Verbosity -> Bool forall a. Ord a => a -> a -> Bool >= Verbosity Loud then do (Maybe Handle _, Maybe Handle _, Maybe Handle _, ProcessHandle r) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> StateT InstallDb (ReaderT Verbosity IO) (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> StateT InstallDb (ReaderT Verbosity IO) (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)) -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> StateT InstallDb (ReaderT Verbosity IO) (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) forall a b. (a -> b) -> a -> b $ CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) createProcess (CreateProcess proc' { std_out = Inherit, std_err = Inherit }) IO () -> PkgM () forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (ExitCode -> IO () handleExit (ExitCode -> IO ()) -> IO ExitCode -> IO () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< ProcessHandle -> IO ExitCode waitForProcess ProcessHandle r) else StateT InstallDb (ReaderT Verbosity IO) String -> PkgM () forall (f :: * -> *) a. Functor f => f a -> f () void (StateT InstallDb (ReaderT Verbosity IO) String -> PkgM ()) -> StateT InstallDb (ReaderT Verbosity IO) String -> PkgM () forall a b. (a -> b) -> a -> b $ IO String -> StateT InstallDb (ReaderT Verbosity IO) String forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO String -> StateT InstallDb (ReaderT Verbosity IO) String) -> IO String -> StateT InstallDb (ReaderT Verbosity IO) String forall a b. (a -> b) -> a -> b $ CreateProcess -> String -> IO String readCreateProcess (CreateProcess proc' { std_err = verbosityErr v }) String forall a. Monoid a => a mempty