{-# LANGUAGE CPP #-}

{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE TemplateHaskell #-}

{-# LANGUAGE OverloadedStrings #-}

#if __GLASGOW_HASKELL__ >= 800

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

#endif

-- | Execute commands within the properly configured Stack

-- environment.

module Stack.Exec where

import Control.Monad.Reader

import Control.Monad.Logger

import Control.Monad.Trans.Control (MonadBaseControl)

import Stack.Types.Config

import System.Process.Log

import Control.Exception.Lifted

import Data.Streaming.Process (ProcessExitedUnsuccessfully(..))

import System.Exit

import System.IO (stderr, stdin, stdout, hSetBuffering, BufferMode(..))

import System.Process.Run (callProcess, callProcessObserveStdout, Cmd(..))

#ifdef WINDOWS

import System.Process.Read (EnvOverride)

#else

import qualified System.Process.PID1 as PID1

import System.Process.Read (EnvOverride, envHelper, preProcess)

#endif

-- | Default @EnvSettings@ which includes locals and GHC_PACKAGE_PATH

defaultEnvSettings :: EnvSettings

defaultEnvSettings = EnvSettings

{ esIncludeLocals = True

, esIncludeGhcPackagePath = True

, esStackExe = True

, esLocaleUtf8 = False

}

-- | Environment settings which do not embellish the environment

plainEnvSettings :: EnvSettings

plainEnvSettings = EnvSettings

{ esIncludeLocals = False

, esIncludeGhcPackagePath = False

, esStackExe = False

, esLocaleUtf8 = False

}

-- | Execute a process within the Stack configured environment.

--

-- Execution will not return, because either:

--

-- 1) On non-windows, execution is taken over by execv of the

-- sub-process. This allows signals to be propagated (#527)

--

-- 2) On windows, an 'ExitCode' exception will be thrown.

exec :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)

=> EnvOverride -> String -> [String] -> m b

#ifdef WINDOWS

exec = execSpawn

#else

exec menv cmd0 args = do

setNoBuffering

cmd <- preProcess Nothing menv cmd0

$withProcessTimeLog cmd args $

liftIO $ PID1.run cmd args (envHelper menv)

#endif

-- | Like 'exec', but does not use 'execv' on non-windows. This way, there

-- is a sub-process, which is helpful in some cases (#1306)

--

-- This function only exits by throwing 'ExitCode'.

execSpawn :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)

=> EnvOverride -> String -> [String] -> m b

execSpawn menv cmd0 args = do

setNoBuffering

e <- $withProcessTimeLog cmd0 args $

try (callProcess (Cmd Nothing cmd0 menv args))

liftIO $ case e of

Left (ProcessExitedUnsuccessfully _ ec) -> exitWith ec

Right () -> exitSuccess

execObserve :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)

=> EnvOverride -> String -> [String] -> m String

execObserve menv cmd0 args = do

e <- $withProcessTimeLog cmd0 args $

try (callProcessObserveStdout (Cmd Nothing cmd0 menv args))

case e of

Left (ProcessExitedUnsuccessfully _ ec) -> liftIO $ exitWith ec

Right s -> return s

setNoBuffering :: MonadIO m => m ()

setNoBuffering = liftIO $ do

hSetBuffering stdout NoBuffering

hSetBuffering stdin NoBuffering

hSetBuffering stderr NoBuffering