{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
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.FilePath (searchPathSeparator)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
data ProgramInvocation = ProgramInvocation {
ProgramInvocation -> String
progInvokePath :: FilePath,
ProgramInvocation -> [String]
progInvokeArgs :: [String],
ProgramInvocation -> [(String, Maybe String)]
progInvokeEnv :: [(String, Maybe String)],
ProgramInvocation -> [String]
progInvokePathEnv :: [FilePath],
ProgramInvocation -> Maybe String
progInvokeCwd :: Maybe FilePath,
ProgramInvocation -> Maybe IOData
progInvokeInput :: Maybe IOData,
ProgramInvocation -> IOEncoding
progInvokeInputEncoding :: IOEncoding,
ProgramInvocation -> IOEncoding
progInvokeOutputEncoding :: IOEncoding
}
data IOEncoding = IOEncodingText
| IOEncodingUTF8
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 {
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] -> IO [(String, Maybe String)]
getExtraPathEnv [(String, Maybe String)]
envOverrides [String]
extraPath
Maybe [(String, String)]
menv <- [(String, Maybe String)] -> IO (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)
IO ExitCode -> IO ()
maybeExit (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ 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
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] -> IO [(String, Maybe String)]
getExtraPathEnv [(String, Maybe String)]
envOverrides [String]
extraPath
Maybe [(String, String)]
menv <- [(String, Maybe String)] -> IO (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)
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 ()
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 -> 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 ()
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 -> 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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)
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 -> 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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)
getProgramInvocationIODataAndErrors Verbosity
verbosity ProgramInvocation
inv IODataMode String
IODataModeText
(String, String, ExitCode) -> IO (String, String, ExitCode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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)
getProgramInvocationIODataAndErrors Verbosity
verbosity ProgramInvocation
inv IODataMode ByteString
IODataModeBinary
(String, String, ExitCode) -> IO (String, String, ExitCode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall mode.
KnownIODataMode mode =>
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] -> IO [(String, Maybe String)]
getExtraPathEnv [(String, Maybe String)]
envOverrides [String]
extraPath
Maybe [(String, String)]
menv <- [(String, Maybe String)] -> IO (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)
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
<$> Maybe IOData
minputStr
getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> IO [(String, Maybe String)]
[(String, Maybe String)]
_ [] = [(String, Maybe String)] -> IO [(String, Maybe String)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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
lookup String
"PATH" [(String, Maybe String)]
env of
Just Maybe String
x -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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)] -> IO [(String, Maybe String)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(String
"PATH", String -> Maybe String
forall a. a -> Maybe a
Just String
path')]
getEffectiveEnvironment :: [(String, Maybe String)]
-> IO (Maybe [(String, String)])
getEffectiveEnvironment :: [(String, Maybe String)] -> IO (Maybe [(String, String)])
getEffectiveEnvironment [] = Maybe [(String, String)] -> IO (Maybe [(String, String)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(String, String)]
forall a. Maybe a
Nothing
getEffectiveEnvironment [(String, Maybe String)]
overrides =
([(String, String)] -> Maybe [(String, String)])
-> IO [(String, String)] -> IO (Maybe [(String, String)])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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
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
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 b a. (b -> a -> b) -> b -> t a -> b
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
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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ProgramInvocation -> String
progInvokePath ProgramInvocation
inv)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> String -> Int) -> Int -> [String] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
s String
a -> String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
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 -> [String]
progInvokeArgs ProgramInvocation
inv)
fixedArgSize :: Int
fixedArgSize = [Int] -> Int
forall a. Ord a => [a] -> a
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 -> [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 :: forall a. 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 a. [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 :: forall a. Int -> [[a]] -> ([[a]], [[a]])
chunk Int
len ([a]
s:[[a]]
_) | [a] -> Int
forall 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 = 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' :: forall a. [[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 a. [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 :: 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!"
maxCommandLineSize :: Int
maxCommandLineSize :: Int
maxCommandLineSize = Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024