{-# 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 -> String
progInvokePath  :: FilePath,
       ProgramInvocation -> [String]
progInvokeArgs  :: [String],
       ProgramInvocation -> [(String, Maybe String)]
progInvokeEnv   :: [(String, Maybe String)],
       -- Extra paths to add to PATH
       ProgramInvocation -> [String]
progInvokePathEnv :: [FilePath],
       ProgramInvocation -> Maybe String
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 String
_)   = IOData
iod
encodeToIOData IOEncoding
IOEncodingUTF8 (IODataText String
str)     = ByteString -> IOData
IODataBinary (String -> ByteString
toUTF8LBS String
str)

emptyProgramInvocation :: ProgramInvocation
emptyProgramInvocation :: ProgramInvocation
emptyProgramInvocation =
  ProgramInvocation :: String
-> [String]
-> [(String, Maybe String)]
-> [String]
-> Maybe String
-> Maybe IOData
-> IOEncoding
-> IOEncoding
-> ProgramInvocation
ProgramInvocation {
    progInvokePath :: String
progInvokePath  = String
"",
    progInvokeArgs :: [String]
progInvokeArgs  = [],
    progInvokeEnv :: [(String, Maybe String)]
progInvokeEnv   = [],
    progInvokePathEnv :: [String]
progInvokePathEnv = [],
    progInvokeCwd :: Maybe String
progInvokeCwd   = Maybe String
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 :: String -> [String] -> ProgramInvocation
simpleProgramInvocation String
path [String]
args =
  ProgramInvocation
emptyProgramInvocation {
    progInvokePath :: String
progInvokePath  = String
path,
    progInvokeArgs :: [String]
progInvokeArgs  = [String]
args
  }

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


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

runProgramInvocation Verbosity
verbosity
  ProgramInvocation {
    progInvokePath :: ProgramInvocation -> String
progInvokePath  = String
path,
    progInvokeArgs :: ProgramInvocation -> [String]
progInvokeArgs  = [String]
args,
    progInvokeEnv :: ProgramInvocation -> [(String, Maybe String)]
progInvokeEnv   = [(String, Maybe String)]
envOverrides,
    progInvokePathEnv :: ProgramInvocation -> [String]
progInvokePathEnv = [String]
extraPath,
    progInvokeCwd :: ProgramInvocation -> Maybe String
progInvokeCwd   = Maybe String
mcwd,
    progInvokeInput :: ProgramInvocation -> Maybe IOData
progInvokeInput = Maybe IOData
Nothing
  } = do
    [(String, Maybe String)]
pathOverride <- [(String, Maybe String)]
-> [String] -> NoCallStackIO [(String, Maybe String)]
getExtraPathEnv [(String, Maybe String)]
envOverrides [String]
extraPath
    Maybe [(String, String)]
menv <- [(String, Maybe String)]
-> NoCallStackIO (Maybe [(String, String)])
getEffectiveEnvironment ([(String, Maybe String)]
envOverrides [(String, Maybe String)]
-> [(String, Maybe String)] -> [(String, Maybe String)]
forall a. [a] -> [a] -> [a]
++ [(String, Maybe String)]
pathOverride)
    ExitCode
exitCode <- Verbosity
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ExitCode
rawSystemIOWithEnv Verbosity
verbosity
                                   String
path [String]
args
                                   Maybe String
mcwd Maybe [(String, String)]
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 ()
External instance of the constraint type Applicative IO
when (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq ExitCode
/= 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 -> String
progInvokePath  = String
path,
    progInvokeArgs :: ProgramInvocation -> [String]
progInvokeArgs  = [String]
args,
    progInvokeEnv :: ProgramInvocation -> [(String, Maybe String)]
progInvokeEnv   = [(String, Maybe String)]
envOverrides,
    progInvokePathEnv :: ProgramInvocation -> [String]
progInvokePathEnv = [String]
extraPath,
    progInvokeCwd :: ProgramInvocation -> Maybe String
progInvokeCwd   = Maybe String
mcwd,
    progInvokeInput :: ProgramInvocation -> Maybe IOData
progInvokeInput = Just IOData
inputStr,
    progInvokeInputEncoding :: ProgramInvocation -> IOEncoding
progInvokeInputEncoding = IOEncoding
encoding
  } = do
    [(String, Maybe String)]
pathOverride <- [(String, Maybe String)]
-> [String] -> NoCallStackIO [(String, Maybe String)]
getExtraPathEnv [(String, Maybe String)]
envOverrides [String]
extraPath
    Maybe [(String, String)]
menv <- [(String, Maybe String)]
-> NoCallStackIO (Maybe [(String, String)])
getEffectiveEnvironment ([(String, Maybe String)]
envOverrides [(String, Maybe String)]
-> [(String, Maybe String)] -> [(String, Maybe String)]
forall a. [a] -> [a] -> [a]
++ [(String, Maybe String)]
pathOverride)
    (ByteString
_, String
errors, ExitCode
exitCode) <- Verbosity
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe IOData
-> IODataMode ByteString
-> IO (ByteString, String, ExitCode)
forall mode.
KnownIODataMode mode =>
Verbosity
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe IOData
-> IODataMode mode
-> IO (mode, String, ExitCode)
External instance of the constraint type KnownIODataMode ByteString
rawSystemStdInOut Verbosity
verbosity
                                    String
path [String]
args
                                    Maybe String
mcwd Maybe [(String, String)]
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 ()
External instance of the constraint type Applicative IO
when (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq ExitCode
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' exited with an error:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errors
  where
    input :: IOData
input = IOEncoding -> IOData -> IOData
encodeToIOData IOEncoding
encoding IOData
inputStr

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

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

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

getProgramInvocationIODataAndErrors
    :: KnownIODataMode mode => Verbosity -> ProgramInvocation -> IODataMode mode
    -> IO (mode, String, ExitCode)
getProgramInvocationIODataAndErrors :: Verbosity
-> ProgramInvocation
-> IODataMode mode
-> IO (mode, String, ExitCode)
getProgramInvocationIODataAndErrors
  Verbosity
verbosity
  ProgramInvocation
    { progInvokePath :: ProgramInvocation -> String
progInvokePath          = String
path
    , progInvokeArgs :: ProgramInvocation -> [String]
progInvokeArgs          = [String]
args
    , progInvokeEnv :: ProgramInvocation -> [(String, Maybe String)]
progInvokeEnv           = [(String, Maybe String)]
envOverrides
    , progInvokePathEnv :: ProgramInvocation -> [String]
progInvokePathEnv       = [String]
extraPath
    , progInvokeCwd :: ProgramInvocation -> Maybe String
progInvokeCwd           = Maybe String
mcwd
    , progInvokeInput :: ProgramInvocation -> Maybe IOData
progInvokeInput         = Maybe IOData
minputStr
    , progInvokeInputEncoding :: ProgramInvocation -> IOEncoding
progInvokeInputEncoding = IOEncoding
encoding
    }
  IODataMode mode
mode = do
    [(String, Maybe String)]
pathOverride <- [(String, Maybe String)]
-> [String] -> NoCallStackIO [(String, Maybe String)]
getExtraPathEnv [(String, Maybe String)]
envOverrides [String]
extraPath
    Maybe [(String, String)]
menv <- [(String, Maybe String)]
-> NoCallStackIO (Maybe [(String, String)])
getEffectiveEnvironment ([(String, Maybe String)]
envOverrides [(String, Maybe String)]
-> [(String, Maybe String)] -> [(String, Maybe String)]
forall a. [a] -> [a] -> [a]
++ [(String, Maybe String)]
pathOverride)
    Verbosity
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe IOData
-> IODataMode mode
-> IO (mode, String, ExitCode)
forall mode.
KnownIODataMode mode =>
Verbosity
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe IOData
-> IODataMode mode
-> IO (mode, String, ExitCode)
Evidence bound by a type signature of the constraint type KnownIODataMode mode
rawSystemStdInOut Verbosity
verbosity String
path [String]
args Maybe String
mcwd Maybe [(String, String)]
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
External instance of the constraint type Functor Maybe
<$> Maybe IOData
minputStr

getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> NoCallStackIO [(String, Maybe String)]
getExtraPathEnv :: [(String, Maybe String)]
-> [String] -> NoCallStackIO [(String, Maybe String)]
getExtraPathEnv [(String, Maybe String)]
_ [] = [(String, Maybe String)] -> NoCallStackIO [(String, Maybe String)]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return []
getExtraPathEnv [(String, Maybe String)]
env [String]
extras = do
    Maybe String
mb_path <- case String -> [(String, Maybe String)] -> Maybe (Maybe String)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
lookup String
"PATH" [(String, Maybe String)]
env of
                Just Maybe String
x  -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Maybe String
x
                Maybe (Maybe String)
Nothing -> String -> IO (Maybe String)
lookupEnv String
"PATH"
    let extra :: String
extra = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] [String]
extras
        path' :: String
path' = case Maybe String
mb_path of
                    Maybe String
Nothing   -> String
extra
                    Just String
path -> String
extra String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
searchPathSeparator Char -> String -> String
forall a. a -> [a] -> [a]
: String
path
    [(String, Maybe String)] -> NoCallStackIO [(String, Maybe String)]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return [(String
"PATH", String -> Maybe String
forall a. a -> Maybe a
Just String
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 :: [(String, Maybe String)]
-> NoCallStackIO (Maybe [(String, String)])
getEffectiveEnvironment []        = Maybe [(String, String)]
-> NoCallStackIO (Maybe [(String, String)])
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Maybe [(String, String)]
forall a. Maybe a
Nothing
getEffectiveEnvironment [(String, Maybe String)]
overrides =
    ([(String, String)] -> Maybe [(String, String)])
-> IO [(String, String)]
-> NoCallStackIO (Maybe [(String, String)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap ([(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just ([(String, String)] -> Maybe [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> Maybe [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String String -> [(String, String)])
-> ([(String, String)] -> Map String String)
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Maybe String)] -> Map String String -> Map String String
forall {t :: * -> *} {k} {a}.
(Foldable t, Ord k) =>
t (k, Maybe a) -> Map k a -> Map k a
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
External instance of the constraint type Foldable []
apply [(String, Maybe String)]
overrides (Map String String -> Map String String)
-> ([(String, String)] -> Map String String)
-> [(String, String)]
-> Map String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.fromList) IO [(String, String)]
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
Evidence bound by a type signature of the constraint type Foldable t
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
Evidence bound by a type signature of the constraint type Ord k
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
Evidence bound by a type signature of the constraint type Ord k
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
Evidence bound by a type signature of the constraint type Ord k
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)
-> [String]
-> [ProgramInvocation]
multiStageProgramInvocation ProgramInvocation
simple (ProgramInvocation
initial, ProgramInvocation
middle, ProgramInvocation
final) [String]
args =

  let argSize :: ProgramInvocation -> Int
argSize ProgramInvocation
inv  = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
External instance of the constraint type Foldable []
length (ProgramInvocation -> String
progInvokePath ProgramInvocation
inv)
                   Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ (Int -> String -> Int) -> Int -> [String] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' (\Int
s String
a -> String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
External instance of the constraint type Foldable []
length String
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s) Int
1 (ProgramInvocation -> [String]
progInvokeArgs ProgramInvocation
inv)
      fixedArgSize :: Int
fixedArgSize = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
External instance of the constraint type Ord Int
External instance of the constraint type Foldable []
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
External instance of the constraint type Num Int
- Int
fixedArgSize

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

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

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

  where
    appendArgs :: ProgramInvocation -> [String] -> ProgramInvocation
    ProgramInvocation
inv appendArgs :: ProgramInvocation -> [String] -> ProgramInvocation
`appendArgs` [String]
as = ProgramInvocation
inv { progInvokeArgs :: [String]
progInvokeArgs = ProgramInvocation -> [String]
progInvokeArgs ProgramInvocation
inv [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
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
External instance of the constraint type Foldable []
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
External instance of the constraint type Foldable []
length [a]
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
len = String -> ([[a]], [[a]])
forall a. HasCallStack => String -> a
error String
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
External instance of the constraint type Ord Int
< 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
External instance of the constraint type Num Int
-Int
len'Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1) [[a]]
ss
      where len' :: Int
len' = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
External instance of the constraint type Foldable []
length [a]
s
    chunk' [[a]]
acc Int
_   [[a]]
ss     = ([[a]] -> [[a]]
forall a. [a] -> [a]
reverse [[a]]
acc, [[a]]
ss)

    toolong :: String
toolong = String
"multiStageProgramInvocation: a single program arg is larger "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"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
External instance of the constraint type Num Int
* Int
1024