{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs            #-}
{-# LANGUAGE RankNTypes       #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.Program.Run
-- Copyright   :  Duncan Coutts 2009
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module provides a data type for program invocations and functions to
-- run them.

module Distribution.Simple.Program.Run (
    ProgramInvocation(..),
    IOEncoding(..),
    emptyProgramInvocation,
    simpleProgramInvocation,
    programInvocation,
    multiStageProgramInvocation,

    runProgramInvocation,
    getProgramInvocationOutput,
    getProgramInvocationLBS,
    getProgramInvocationOutputAndErrors,

    getEffectiveEnvironment,
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Compat.Environment
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils
import Distribution.Utils.Generic
import Distribution.Verbosity

import System.Exit     (ExitCode (..), exitWith)
import System.FilePath

import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map             as Map

-- | Represents a specific invocation of a specific program.
--
-- This is used as an intermediate type between deciding how to call a program
-- and actually doing it. This provides the opportunity to the caller to
-- adjust how the program will be called. These invocations can either be run
-- directly or turned into shell or batch scripts.
--
data ProgramInvocation = ProgramInvocation {
       ProgramInvocation -> FilePath
progInvokePath  :: FilePath,
       ProgramInvocation -> [FilePath]
progInvokeArgs  :: [String],
       ProgramInvocation -> [(FilePath, Maybe FilePath)]
progInvokeEnv   :: [(String, Maybe String)],
       -- Extra paths to add to PATH
       ProgramInvocation -> [FilePath]
progInvokePathEnv :: [FilePath],
       ProgramInvocation -> Maybe FilePath
progInvokeCwd   :: Maybe FilePath,
       ProgramInvocation -> Maybe IOData
progInvokeInput :: Maybe IOData,
       ProgramInvocation -> IOEncoding
progInvokeInputEncoding  :: IOEncoding, -- ^ TODO: remove this, make user decide when constructing 'progInvokeInput'.
       ProgramInvocation -> IOEncoding
progInvokeOutputEncoding :: IOEncoding
     }

data IOEncoding = IOEncodingText   -- locale mode text
                | IOEncodingUTF8   -- always utf8

encodeToIOData :: IOEncoding -> IOData -> IOData
encodeToIOData :: IOEncoding -> IOData -> IOData
encodeToIOData IOEncoding
_              iod :: IOData
iod@(IODataBinary ByteString
_) = IOData
iod
encodeToIOData IOEncoding
IOEncodingText iod :: IOData
iod@(IODataText FilePath
_)   = IOData
iod
encodeToIOData IOEncoding
IOEncodingUTF8 (IODataText FilePath
str)     = ByteString -> IOData
IODataBinary (FilePath -> ByteString
toUTF8LBS FilePath
str)

emptyProgramInvocation :: ProgramInvocation
emptyProgramInvocation :: ProgramInvocation
emptyProgramInvocation =
  ProgramInvocation :: FilePath
-> [FilePath]
-> [(FilePath, Maybe FilePath)]
-> [FilePath]
-> Maybe FilePath
-> Maybe IOData
-> IOEncoding
-> IOEncoding
-> ProgramInvocation
ProgramInvocation {
    progInvokePath :: FilePath
progInvokePath  = FilePath
"",
    progInvokeArgs :: [FilePath]
progInvokeArgs  = [],
    progInvokeEnv :: [(FilePath, Maybe FilePath)]
progInvokeEnv   = [],
    progInvokePathEnv :: [FilePath]
progInvokePathEnv = [],
    progInvokeCwd :: Maybe FilePath
progInvokeCwd   = Maybe FilePath
forall a. Maybe a
Nothing,
    progInvokeInput :: Maybe IOData
progInvokeInput = Maybe IOData
forall a. Maybe a
Nothing,
    progInvokeInputEncoding :: IOEncoding
progInvokeInputEncoding  = IOEncoding
IOEncodingText,
    progInvokeOutputEncoding :: IOEncoding
progInvokeOutputEncoding = IOEncoding
IOEncodingText
  }

simpleProgramInvocation :: FilePath -> [String] -> ProgramInvocation
simpleProgramInvocation :: FilePath -> [FilePath] -> ProgramInvocation
simpleProgramInvocation FilePath
path [FilePath]
args =
  ProgramInvocation
emptyProgramInvocation {
    progInvokePath :: FilePath
progInvokePath  = FilePath
path,
    progInvokeArgs :: [FilePath]
progInvokeArgs  = [FilePath]
args
  }

programInvocation :: ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation :: ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [FilePath]
args =
  ProgramInvocation
emptyProgramInvocation {
    progInvokePath :: FilePath
progInvokePath = ConfiguredProgram -> FilePath
programPath ConfiguredProgram
prog,
    progInvokeArgs :: [FilePath]
progInvokeArgs = ConfiguredProgram -> [FilePath]
programDefaultArgs ConfiguredProgram
prog
                  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
args
                  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [FilePath]
programOverrideArgs ConfiguredProgram
prog,
    progInvokeEnv :: [(FilePath, Maybe FilePath)]
progInvokeEnv  = ConfiguredProgram -> [(FilePath, Maybe FilePath)]
programOverrideEnv ConfiguredProgram
prog
  }


runProgramInvocation :: Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation :: Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity
  ProgramInvocation {
    progInvokePath :: ProgramInvocation -> FilePath
progInvokePath  = FilePath
path,
    progInvokeArgs :: ProgramInvocation -> [FilePath]
progInvokeArgs  = [FilePath]
args,
    progInvokeEnv :: ProgramInvocation -> [(FilePath, Maybe FilePath)]
progInvokeEnv   = [],
    progInvokePathEnv :: ProgramInvocation -> [FilePath]
progInvokePathEnv = [],
    progInvokeCwd :: ProgramInvocation -> Maybe FilePath
progInvokeCwd   = Maybe FilePath
Nothing,
    progInvokeInput :: ProgramInvocation -> Maybe IOData
progInvokeInput = Maybe IOData
Nothing
  } =
  Verbosity -> FilePath -> [FilePath] -> IO ()
rawSystemExit Verbosity
verbosity FilePath
path [FilePath]
args

runProgramInvocation Verbosity
verbosity
  ProgramInvocation {
    progInvokePath :: ProgramInvocation -> FilePath
progInvokePath  = FilePath
path,
    progInvokeArgs :: ProgramInvocation -> [FilePath]
progInvokeArgs  = [FilePath]
args,
    progInvokeEnv :: ProgramInvocation -> [(FilePath, Maybe FilePath)]
progInvokeEnv   = [(FilePath, Maybe FilePath)]
envOverrides,
    progInvokePathEnv :: ProgramInvocation -> [FilePath]
progInvokePathEnv = [FilePath]
extraPath,
    progInvokeCwd :: ProgramInvocation -> Maybe FilePath
progInvokeCwd   = Maybe FilePath
mcwd,
    progInvokeInput :: ProgramInvocation -> Maybe IOData
progInvokeInput = Maybe IOData
Nothing
  } = do
    [(FilePath, Maybe FilePath)]
pathOverride <- [(FilePath, Maybe FilePath)]
-> [FilePath] -> NoCallStackIO [(FilePath, Maybe FilePath)]
getExtraPathEnv [(FilePath, Maybe FilePath)]
envOverrides [FilePath]
extraPath
    Maybe [(FilePath, FilePath)]
menv <- [(FilePath, Maybe FilePath)]
-> NoCallStackIO (Maybe [(FilePath, FilePath)])
getEffectiveEnvironment ([(FilePath, Maybe FilePath)]
envOverrides [(FilePath, Maybe FilePath)]
-> [(FilePath, Maybe FilePath)] -> [(FilePath, Maybe FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, Maybe FilePath)]
pathOverride)
    ExitCode
exitCode <- Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ExitCode
rawSystemIOWithEnv Verbosity
verbosity
                                   FilePath
path [FilePath]
args
                                   Maybe FilePath
mcwd Maybe [(FilePath, FilePath)]
menv
                                   Maybe Handle
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
exitCode

runProgramInvocation Verbosity
verbosity
  ProgramInvocation {
    progInvokePath :: ProgramInvocation -> FilePath
progInvokePath  = FilePath
path,
    progInvokeArgs :: ProgramInvocation -> [FilePath]
progInvokeArgs  = [FilePath]
args,
    progInvokeEnv :: ProgramInvocation -> [(FilePath, Maybe FilePath)]
progInvokeEnv   = [(FilePath, Maybe FilePath)]
envOverrides,
    progInvokePathEnv :: ProgramInvocation -> [FilePath]
progInvokePathEnv = [FilePath]
extraPath,
    progInvokeCwd :: ProgramInvocation -> Maybe FilePath
progInvokeCwd   = Maybe FilePath
mcwd,
    progInvokeInput :: ProgramInvocation -> Maybe IOData
progInvokeInput = Just IOData
inputStr,
    progInvokeInputEncoding :: ProgramInvocation -> IOEncoding
progInvokeInputEncoding = IOEncoding
encoding
  } = do
    [(FilePath, Maybe FilePath)]
pathOverride <- [(FilePath, Maybe FilePath)]
-> [FilePath] -> NoCallStackIO [(FilePath, Maybe FilePath)]
getExtraPathEnv [(FilePath, Maybe FilePath)]
envOverrides [FilePath]
extraPath
    Maybe [(FilePath, FilePath)]
menv <- [(FilePath, Maybe FilePath)]
-> NoCallStackIO (Maybe [(FilePath, FilePath)])
getEffectiveEnvironment ([(FilePath, Maybe FilePath)]
envOverrides [(FilePath, Maybe FilePath)]
-> [(FilePath, Maybe FilePath)] -> [(FilePath, Maybe FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, Maybe FilePath)]
pathOverride)
    (ByteString
_, FilePath
errors, ExitCode
exitCode) <- Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe IOData
-> IODataMode ByteString
-> IO (ByteString, FilePath, ExitCode)
forall mode.
KnownIODataMode mode =>
Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe IOData
-> IODataMode mode
-> IO (mode, FilePath, ExitCode)
rawSystemStdInOut Verbosity
verbosity
                                    FilePath
path [FilePath]
args
                                    Maybe FilePath
mcwd Maybe [(FilePath, FilePath)]
menv
                                    (IOData -> Maybe IOData
forall a. a -> Maybe a
Just IOData
input) IODataMode ByteString
IODataModeBinary
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"'" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' exited with an error:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errors
  where
    input :: IOData
input = IOEncoding -> IOData -> IOData
encodeToIOData IOEncoding
encoding IOData
inputStr

getProgramInvocationOutput :: Verbosity -> ProgramInvocation -> IO String
getProgramInvocationOutput :: Verbosity -> ProgramInvocation -> IO FilePath
getProgramInvocationOutput Verbosity
verbosity ProgramInvocation
inv = do
    (FilePath
output, FilePath
errors, ExitCode
exitCode) <- Verbosity -> ProgramInvocation -> IO (FilePath, FilePath, ExitCode)
getProgramInvocationOutputAndErrors Verbosity
verbosity ProgramInvocation
inv
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"'" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ProgramInvocation -> FilePath
progInvokePath ProgramInvocation
inv FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' exited with an error:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errors
    FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output

getProgramInvocationLBS :: Verbosity -> ProgramInvocation -> IO LBS.ByteString
getProgramInvocationLBS :: Verbosity -> ProgramInvocation -> IO ByteString
getProgramInvocationLBS Verbosity
verbosity ProgramInvocation
inv = do
    (ByteString
output, FilePath
errors, ExitCode
exitCode) <- Verbosity
-> ProgramInvocation
-> IODataMode ByteString
-> IO (ByteString, FilePath, ExitCode)
forall mode.
KnownIODataMode mode =>
Verbosity
-> ProgramInvocation
-> IODataMode mode
-> IO (mode, FilePath, ExitCode)
getProgramInvocationIODataAndErrors Verbosity
verbosity ProgramInvocation
inv IODataMode ByteString
IODataModeBinary
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"'" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ProgramInvocation -> FilePath
progInvokePath ProgramInvocation
inv FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' exited with an error:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errors
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
output

getProgramInvocationOutputAndErrors :: Verbosity -> ProgramInvocation
                                    -> IO (String, String, ExitCode)
getProgramInvocationOutputAndErrors :: Verbosity -> ProgramInvocation -> IO (FilePath, FilePath, ExitCode)
getProgramInvocationOutputAndErrors Verbosity
verbosity ProgramInvocation
inv = case ProgramInvocation -> IOEncoding
progInvokeOutputEncoding ProgramInvocation
inv of
    IOEncoding
IOEncodingText -> do
        (FilePath
output, FilePath
errors, ExitCode
exitCode) <- Verbosity
-> ProgramInvocation
-> IODataMode FilePath
-> IO (FilePath, FilePath, ExitCode)
forall mode.
KnownIODataMode mode =>
Verbosity
-> ProgramInvocation
-> IODataMode mode
-> IO (mode, FilePath, ExitCode)
getProgramInvocationIODataAndErrors Verbosity
verbosity ProgramInvocation
inv IODataMode FilePath
IODataModeText
        (FilePath, FilePath, ExitCode) -> IO (FilePath, FilePath, ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
output, FilePath
errors, ExitCode
exitCode)
    IOEncoding
IOEncodingUTF8 -> do
        (ByteString
output', FilePath
errors, ExitCode
exitCode) <- Verbosity
-> ProgramInvocation
-> IODataMode ByteString
-> IO (ByteString, FilePath, ExitCode)
forall mode.
KnownIODataMode mode =>
Verbosity
-> ProgramInvocation
-> IODataMode mode
-> IO (mode, FilePath, ExitCode)
getProgramInvocationIODataAndErrors Verbosity
verbosity ProgramInvocation
inv IODataMode ByteString
IODataModeBinary
        (FilePath, FilePath, ExitCode) -> IO (FilePath, FilePath, ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
normaliseLineEndings (ByteString -> FilePath
fromUTF8LBS ByteString
output'), FilePath
errors, ExitCode
exitCode)

getProgramInvocationIODataAndErrors
    :: KnownIODataMode mode => Verbosity -> ProgramInvocation -> IODataMode mode
    -> IO (mode, String, ExitCode)
getProgramInvocationIODataAndErrors :: Verbosity
-> ProgramInvocation
-> IODataMode mode
-> IO (mode, FilePath, ExitCode)
getProgramInvocationIODataAndErrors
  Verbosity
verbosity
  ProgramInvocation
    { progInvokePath :: ProgramInvocation -> FilePath
progInvokePath          = FilePath
path
    , progInvokeArgs :: ProgramInvocation -> [FilePath]
progInvokeArgs          = [FilePath]
args
    , progInvokeEnv :: ProgramInvocation -> [(FilePath, Maybe FilePath)]
progInvokeEnv           = [(FilePath, Maybe FilePath)]
envOverrides
    , progInvokePathEnv :: ProgramInvocation -> [FilePath]
progInvokePathEnv       = [FilePath]
extraPath
    , progInvokeCwd :: ProgramInvocation -> Maybe FilePath
progInvokeCwd           = Maybe FilePath
mcwd
    , progInvokeInput :: ProgramInvocation -> Maybe IOData
progInvokeInput         = Maybe IOData
minputStr
    , progInvokeInputEncoding :: ProgramInvocation -> IOEncoding
progInvokeInputEncoding = IOEncoding
encoding
    }
  IODataMode mode
mode = do
    [(FilePath, Maybe FilePath)]
pathOverride <- [(FilePath, Maybe FilePath)]
-> [FilePath] -> NoCallStackIO [(FilePath, Maybe FilePath)]
getExtraPathEnv [(FilePath, Maybe FilePath)]
envOverrides [FilePath]
extraPath
    Maybe [(FilePath, FilePath)]
menv <- [(FilePath, Maybe FilePath)]
-> NoCallStackIO (Maybe [(FilePath, FilePath)])
getEffectiveEnvironment ([(FilePath, Maybe FilePath)]
envOverrides [(FilePath, Maybe FilePath)]
-> [(FilePath, Maybe FilePath)] -> [(FilePath, Maybe FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, Maybe FilePath)]
pathOverride)
    Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe IOData
-> IODataMode mode
-> IO (mode, FilePath, ExitCode)
forall mode.
KnownIODataMode mode =>
Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe IOData
-> IODataMode mode
-> IO (mode, FilePath, ExitCode)
rawSystemStdInOut Verbosity
verbosity FilePath
path [FilePath]
args Maybe FilePath
mcwd Maybe [(FilePath, FilePath)]
menv Maybe IOData
input IODataMode mode
mode
  where
    input :: Maybe IOData
input = IOEncoding -> IOData -> IOData
encodeToIOData IOEncoding
encoding (IOData -> IOData) -> Maybe IOData -> Maybe IOData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IOData
minputStr

getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> NoCallStackIO [(String, Maybe String)]
getExtraPathEnv :: [(FilePath, Maybe FilePath)]
-> [FilePath] -> NoCallStackIO [(FilePath, Maybe FilePath)]
getExtraPathEnv [(FilePath, Maybe FilePath)]
_ [] = [(FilePath, Maybe FilePath)]
-> NoCallStackIO [(FilePath, Maybe FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getExtraPathEnv [(FilePath, Maybe FilePath)]
env [FilePath]
extras = do
    Maybe FilePath
mb_path <- case FilePath -> [(FilePath, Maybe FilePath)] -> Maybe (Maybe FilePath)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"PATH" [(FilePath, Maybe FilePath)]
env of
                Just Maybe FilePath
x  -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
x
                Maybe (Maybe FilePath)
Nothing -> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"PATH"
    let extra :: FilePath
extra = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] [FilePath]
extras
        path' :: FilePath
path' = case Maybe FilePath
mb_path of
                    Maybe FilePath
Nothing   -> FilePath
extra
                    Just FilePath
path -> FilePath
extra FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
searchPathSeparator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
path
    [(FilePath, Maybe FilePath)]
-> NoCallStackIO [(FilePath, Maybe FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
"PATH", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path')]

-- | Return the current environment extended with the given overrides.
-- If an entry is specified twice in @overrides@, the second entry takes
-- precedence.
--
getEffectiveEnvironment :: [(String, Maybe String)]
                        -> NoCallStackIO (Maybe [(String, String)])
getEffectiveEnvironment :: [(FilePath, Maybe FilePath)]
-> NoCallStackIO (Maybe [(FilePath, FilePath)])
getEffectiveEnvironment []        = Maybe [(FilePath, FilePath)]
-> NoCallStackIO (Maybe [(FilePath, FilePath)])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
getEffectiveEnvironment [(FilePath, Maybe FilePath)]
overrides =
    ([(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)])
-> IO [(FilePath, FilePath)]
-> NoCallStackIO (Maybe [(FilePath, FilePath)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just ([(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)])
-> ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [(FilePath, FilePath)]
-> Maybe [(FilePath, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map FilePath FilePath -> [(FilePath, FilePath)])
-> ([(FilePath, FilePath)] -> Map FilePath FilePath)
-> [(FilePath, FilePath)]
-> [(FilePath, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, Maybe FilePath)]
-> Map FilePath FilePath -> Map FilePath FilePath
forall (t :: * -> *) k a.
(Foldable t, Ord k) =>
t (k, Maybe a) -> Map k a -> Map k a
apply [(FilePath, Maybe FilePath)]
overrides (Map FilePath FilePath -> Map FilePath FilePath)
-> ([(FilePath, FilePath)] -> Map FilePath FilePath)
-> [(FilePath, FilePath)]
-> Map FilePath FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList) IO [(FilePath, FilePath)]
getEnvironment
  where
    apply :: t (k, Maybe a) -> Map k a -> Map k a
apply t (k, Maybe a)
os Map k a
env = (Map k a -> (k, Maybe a) -> Map k a)
-> Map k a -> t (k, Maybe a) -> Map k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((k, Maybe a) -> Map k a -> Map k a)
-> Map k a -> (k, Maybe a) -> Map k a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k, Maybe a) -> Map k a -> Map k a
forall k a. Ord k => (k, Maybe a) -> Map k a -> Map k a
update) Map k a
env t (k, Maybe a)
os
    update :: (k, Maybe a) -> Map k a -> Map k a
update (k
var, Maybe a
Nothing)  = k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
var
    update (k
var, Just a
val) = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
var a
val

-- | Like the unix xargs program. Useful for when we've got very long command
-- lines that might overflow an OS limit on command line length and so you
-- need to invoke a command multiple times to get all the args in.
--
-- It takes four template invocations corresponding to the simple, initial,
-- middle and last invocations. If the number of args given is small enough
-- that we can get away with just a single invocation then the simple one is
-- used:
--
-- > $ simple args
--
-- If the number of args given means that we need to use multiple invocations
-- then the templates for the initial, middle and last invocations are used:
--
-- > $ initial args_0
-- > $ middle  args_1
-- > $ middle  args_2
-- >   ...
-- > $ final   args_n
--
multiStageProgramInvocation
  :: ProgramInvocation
  -> (ProgramInvocation, ProgramInvocation, ProgramInvocation)
  -> [String]
  -> [ProgramInvocation]
multiStageProgramInvocation :: ProgramInvocation
-> (ProgramInvocation, ProgramInvocation, ProgramInvocation)
-> [FilePath]
-> [ProgramInvocation]
multiStageProgramInvocation ProgramInvocation
simple (ProgramInvocation
initial, ProgramInvocation
middle, ProgramInvocation
final) [FilePath]
args =

  let argSize :: ProgramInvocation -> Int
argSize ProgramInvocation
inv  = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ProgramInvocation -> FilePath
progInvokePath ProgramInvocation
inv)
                   Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> FilePath -> Int) -> Int -> [FilePath] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
s FilePath
a -> FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) Int
1 (ProgramInvocation -> [FilePath]
progInvokeArgs ProgramInvocation
inv)
      fixedArgSize :: Int
fixedArgSize = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((ProgramInvocation -> Int) -> [ProgramInvocation] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ProgramInvocation -> Int
argSize [ProgramInvocation
simple, ProgramInvocation
initial, ProgramInvocation
middle, ProgramInvocation
final])
      chunkSize :: Int
chunkSize    = Int
maxCommandLineSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fixedArgSize

   in case Int -> [FilePath] -> [[FilePath]]
forall a. Int -> [[a]] -> [[[a]]]
splitChunks Int
chunkSize [FilePath]
args of
        []  -> [ ProgramInvocation
simple ]

        [[FilePath]
c] -> [ ProgramInvocation
simple  ProgramInvocation -> [FilePath] -> ProgramInvocation
`appendArgs` [FilePath]
c ]

        ([FilePath]
c:[FilePath]
c2:[[FilePath]]
cs) | ([[FilePath]]
xs, [FilePath]
x) <- NonEmpty [FilePath] -> ([[FilePath]], [FilePath])
forall a. NonEmpty a -> ([a], a)
unsnocNE ([FilePath]
c2[FilePath] -> [[FilePath]] -> NonEmpty [FilePath]
forall a. a -> [a] -> NonEmpty a
:|[[FilePath]]
cs) ->
             [ ProgramInvocation
initial ProgramInvocation -> [FilePath] -> ProgramInvocation
`appendArgs` [FilePath]
c ]
          [ProgramInvocation] -> [ProgramInvocation] -> [ProgramInvocation]
forall a. [a] -> [a] -> [a]
++ [ ProgramInvocation
middle  ProgramInvocation -> [FilePath] -> ProgramInvocation
`appendArgs` [FilePath]
c'| [FilePath]
c' <- [[FilePath]]
xs ]
          [ProgramInvocation] -> [ProgramInvocation] -> [ProgramInvocation]
forall a. [a] -> [a] -> [a]
++ [ ProgramInvocation
final   ProgramInvocation -> [FilePath] -> ProgramInvocation
`appendArgs` [FilePath]
x ]

  where
    appendArgs :: ProgramInvocation -> [String] -> ProgramInvocation
    ProgramInvocation
inv appendArgs :: ProgramInvocation -> [FilePath] -> ProgramInvocation
`appendArgs` [FilePath]
as = ProgramInvocation
inv { progInvokeArgs :: [FilePath]
progInvokeArgs = ProgramInvocation -> [FilePath]
progInvokeArgs ProgramInvocation
inv [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
as }

    splitChunks :: Int -> [[a]] -> [[[a]]]
    splitChunks :: Int -> [[a]] -> [[[a]]]
splitChunks Int
len = ([[a]] -> Maybe ([[a]], [[a]])) -> [[a]] -> [[[a]]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (([[a]] -> Maybe ([[a]], [[a]])) -> [[a]] -> [[[a]]])
-> ([[a]] -> Maybe ([[a]], [[a]])) -> [[a]] -> [[[a]]]
forall a b. (a -> b) -> a -> b
$ \[[a]]
s ->
      if [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
s then Maybe ([[a]], [[a]])
forall a. Maybe a
Nothing
                else ([[a]], [[a]]) -> Maybe ([[a]], [[a]])
forall a. a -> Maybe a
Just (Int -> [[a]] -> ([[a]], [[a]])
forall a. Int -> [[a]] -> ([[a]], [[a]])
chunk Int
len [[a]]
s)

    chunk :: Int -> [[a]] -> ([[a]], [[a]])
    chunk :: Int -> [[a]] -> ([[a]], [[a]])
chunk Int
len ([a]
s:[[a]]
_) | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = FilePath -> ([[a]], [[a]])
forall a. HasCallStack => FilePath -> a
error FilePath
toolong
    chunk Int
len [[a]]
ss    = [[a]] -> Int -> [[a]] -> ([[a]], [[a]])
forall a. [[a]] -> Int -> [[a]] -> ([[a]], [[a]])
chunk' [] Int
len [[a]]
ss

    chunk' :: [[a]] -> Int -> [[a]] -> ([[a]], [[a]])
    chunk' :: [[a]] -> Int -> [[a]] -> ([[a]], [[a]])
chunk' [[a]]
acc Int
len ([a]
s:[[a]]
ss)
      | Int
len' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = [[a]] -> Int -> [[a]] -> ([[a]], [[a]])
forall a. [[a]] -> Int -> [[a]] -> ([[a]], [[a]])
chunk' ([a]
s[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
acc) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [[a]]
ss
      where len' :: Int
len' = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
s
    chunk' [[a]]
acc Int
_   [[a]]
ss     = ([[a]] -> [[a]]
forall a. [a] -> [a]
reverse [[a]]
acc, [[a]]
ss)

    toolong :: FilePath
toolong = FilePath
"multiStageProgramInvocation: a single program arg is larger "
           FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"than the maximum command line length!"


--FIXME: discover this at configure time or runtime on unix
-- The value is 32k on Windows and posix specifies a minimum of 4k
-- but all sensible unixes use more than 4k.
-- we could use getSysVar ArgumentLimit but that's in the unix lib
--
maxCommandLineSize :: Int
maxCommandLineSize :: Int
maxCommandLineSize = Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024