{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Distribution.Simple.Program.Run
( ProgramInvocation (..)
, IOEncoding (..)
, emptyProgramInvocation
, simpleProgramInvocation
, programInvocation
, programInvocationCwd
, multiStageProgramInvocation
, runProgramInvocation
, getProgramInvocationOutput
, getProgramInvocationLBS
, getProgramInvocationOutputAndErrors
, getProgramInvocationLBSAndErrors
, getEffectiveEnvironment
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.Compat.Environment
import Distribution.Simple.Errors
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils
import Distribution.Utils.Generic
import Distribution.Utils.Path
import Distribution.Verbosity
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 -> 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 = []
, 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 = path
, progInvokeArgs = args
}
programInvocation
:: ConfiguredProgram
-> [String]
-> ProgramInvocation
programInvocation :: ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String]
args =
ProgramInvocation
emptyProgramInvocation
{ progInvokePath = programPath prog
, progInvokeArgs =
programDefaultArgs prog
++ args
++ programOverrideArgs prog
, progInvokeEnv = programOverrideEnv prog
}
programInvocationCwd
:: forall to
. Maybe (SymbolicPath CWD (Dir to))
-> ConfiguredProgram
-> [String]
-> ProgramInvocation
programInvocationCwd :: forall to.
Maybe (SymbolicPath CWD ('Dir to))
-> ConfiguredProgram -> [String] -> ProgramInvocation
programInvocationCwd Maybe (SymbolicPath CWD ('Dir to))
mbWorkDir ConfiguredProgram
prog [String]
args =
(ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String]
args)
{ progInvokeCwd = fmap getSymbolicPath mbWorkDir
}
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 = []
, progInvokeCwd :: ProgramInvocation -> Maybe String
progInvokeCwd = Maybe String
Nothing
, progInvokeInput :: ProgramInvocation -> Maybe IOData
progInvokeInput = Maybe IOData
Nothing
} =
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Maybe a
Nothing 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
, progInvokeCwd :: ProgramInvocation -> Maybe String
progInvokeCwd = Maybe String
mcwd
, progInvokeInput :: ProgramInvocation -> Maybe IOData
progInvokeInput = Maybe IOData
Nothing
} = do
menv <- [(String, Maybe String)] -> IO (Maybe [(String, String)])
getEffectiveEnvironment [(String, Maybe String)]
envOverrides
maybeExit $
rawSystemIOWithEnv
verbosity
path
args
mcwd
menv
Nothing
Nothing
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
, progInvokeCwd :: ProgramInvocation -> Maybe String
progInvokeCwd = Maybe String
mcwd
, progInvokeInput :: ProgramInvocation -> Maybe IOData
progInvokeInput = Just IOData
inputStr
, progInvokeInputEncoding :: ProgramInvocation -> IOEncoding
progInvokeInputEncoding = IOEncoding
encoding
} = do
menv <- [(String, Maybe String)] -> IO (Maybe [(String, String)])
getEffectiveEnvironment [(String, Maybe String)]
envOverrides
(_, errors, exitCode) <-
rawSystemStdInOut
verbosity
path
args
mcwd
menv
(Just input)
IODataModeBinary
when (exitCode /= ExitSuccess) $
dieWithException verbosity $
RunProgramInvocationException path 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
(output, errors, exitCode) <- Verbosity -> ProgramInvocation -> IO (String, String, ExitCode)
getProgramInvocationOutputAndErrors Verbosity
verbosity ProgramInvocation
inv
when (exitCode /= ExitSuccess) $
die' verbosity $
"'" ++ progInvokePath inv ++ "' exited with an error:\n" ++ errors
return output
getProgramInvocationLBS :: Verbosity -> ProgramInvocation -> IO LBS.ByteString
getProgramInvocationLBS :: Verbosity -> ProgramInvocation -> IO ByteString
getProgramInvocationLBS Verbosity
verbosity ProgramInvocation
inv = do
(output, errors, 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
when (exitCode /= ExitSuccess) $
dieWithException verbosity $
GetProgramInvocationLBSException (progInvokePath inv) errors
return 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
(output, errors, 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
return (output, errors, exitCode)
IOEncoding
IOEncodingUTF8 -> do
(output', errors, 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
return (normaliseLineEndings (fromUTF8LBS output'), errors, exitCode)
getProgramInvocationLBSAndErrors
:: Verbosity
-> ProgramInvocation
-> IO (LBS.ByteString, String, ExitCode)
getProgramInvocationLBSAndErrors :: Verbosity -> ProgramInvocation -> IO (ByteString, String, ExitCode)
getProgramInvocationLBSAndErrors Verbosity
verbosity ProgramInvocation
inv =
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
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
, 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
menv <- [(String, Maybe String)] -> IO (Maybe [(String, String)])
getEffectiveEnvironment [(String, Maybe String)]
envOverrides
rawSystemStdInOut verbosity path args mcwd menv input 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
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 = progInvokeArgs inv ++ 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
len Int -> 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