module Distribution.Client.Run ( run, splitRunArgs )
where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Types.TargetInfo (targetCLBI)
import Distribution.Types.LocalBuildInfo (componentNameTargets')
import Distribution.Client.Utils (tryCanonicalizePath)
import Distribution.Types.UnqualComponentName
import Distribution.PackageDescription (Executable (..),
TestSuite(..),
Benchmark(..),
PackageDescription (..),
BuildInfo(buildable))
import Distribution.Simple.Compiler (compilerFlavor, CompilerFlavor(..))
import Distribution.Simple.Build.PathsModule (pkgPathEnvVar)
import Distribution.Simple.BuildPaths (exeExtension)
import Distribution.Simple.LocalBuildInfo (ComponentName (..),
LocalBuildInfo (..),
depLibraryPaths)
import Distribution.Simple.Utils (die', notice, warn,
rawSystemExitWithEnv,
addLibraryPath)
import Distribution.System (Platform (..))
import qualified Distribution.Simple.GHCJS as GHCJS
import System.Directory (getCurrentDirectory)
import Distribution.Compat.Environment (getEnvironment)
import System.FilePath ((<.>), (</>))
splitRunArgs :: Verbosity -> LocalBuildInfo -> [String]
-> IO (Executable, [String])
splitRunArgs :: Verbosity
-> LocalBuildInfo -> [String] -> IO (Executable, [String])
splitRunArgs Verbosity
verbosity LocalBuildInfo
lbi [String]
args =
case Either String (Bool, Executable, [String])
whichExecutable of
Left String
err -> do
Verbosity -> String -> IO ()
warn Verbosity
verbosity forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
`traverse_` Maybe String
maybeWarning
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
err
Right (Bool
True, Executable
exe, [String]
xs) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Executable
exe, [String]
xs)
Right (Bool
False, Executable
exe, [String]
xs) -> do
let addition :: String
addition = String
" Interpreting all parameters to `run` as a parameter to"
forall a. [a] -> [a] -> [a]
++ String
" the default executable."
Verbosity -> String -> IO ()
warn Verbosity
verbosity forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
`traverse_` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> [a] -> [a]
++String
addition) Maybe String
maybeWarning
forall (m :: * -> *) a. Monad m => a -> m a
return (Executable
exe, [String]
xs)
where
pkg_descr :: PackageDescription
pkg_descr = LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi
whichExecutable :: Either String
( Bool
, Executable
, [String]
)
whichExecutable :: Either String (Bool, Executable, [String])
whichExecutable = case ([Executable]
enabledExes, [String]
args) of
([] , [String]
_) -> forall a b. a -> Either a b
Left String
"Couldn't find any enabled executables."
([Executable
exe], []) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Executable
exe, [])
([Executable
exe], (String
x:[String]
xs))
| String
x forall a. Eq a => a -> a -> Bool
== UnqualComponentName -> String
unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Executable
exe, [String]
xs)
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Executable
exe, [String]
args)
([Executable]
_ , []) -> forall a b. a -> Either a b
Left
forall a b. (a -> b) -> a -> b
$ String
"This package contains multiple executables. "
forall a. [a] -> [a] -> [a]
++ String
"You must pass the executable name as the first argument "
forall a. [a] -> [a] -> [a]
++ String
"to 'cabal run'."
([Executable]
_ , (String
x:[String]
xs)) ->
case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Executable
exe -> UnqualComponentName -> String
unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe) forall a. Eq a => a -> a -> Bool
== String
x) [Executable]
enabledExes of
Maybe Executable
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"No executable named '" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"'."
Just Executable
exe -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Executable
exe, [String]
xs)
where
enabledExes :: [Executable]
enabledExes = forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
buildInfo) (PackageDescription -> [Executable]
executables PackageDescription
pkg_descr)
maybeWarning :: Maybe String
maybeWarning :: Maybe String
maybeWarning = case [String]
args of
[] -> forall a. Maybe a
Nothing
(String
x:[String]
_) -> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> UnqualComponentName
mkUnqualComponentName String
x) [(UnqualComponentName, String)]
components
where
components :: [(UnqualComponentName, String)]
components :: [(UnqualComponentName, String)]
components =
[ (UnqualComponentName
name, String
"The executable '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name forall a. [a] -> [a] -> [a]
++ String
"' is disabled.")
| Executable
e <- PackageDescription -> [Executable]
executables PackageDescription
pkg_descr
, Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
buildInfo forall a b. (a -> b) -> a -> b
$ Executable
e, let name :: UnqualComponentName
name = Executable -> UnqualComponentName
exeName Executable
e]
forall a. [a] -> [a] -> [a]
++ [ (UnqualComponentName
name, String
"There is a test-suite '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name forall a. [a] -> [a] -> [a]
++ String
"',"
forall a. [a] -> [a] -> [a]
++ String
" but the `run` command is only for executables.")
| TestSuite
t <- PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg_descr
, let name :: UnqualComponentName
name = TestSuite -> UnqualComponentName
testName TestSuite
t]
forall a. [a] -> [a] -> [a]
++ [ (UnqualComponentName
name, String
"There is a benchmark '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name forall a. [a] -> [a] -> [a]
++ String
"',"
forall a. [a] -> [a] -> [a]
++ String
" but the `run` command is only for executables.")
| Benchmark
b <- PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr
, let name :: UnqualComponentName
name = Benchmark -> UnqualComponentName
benchmarkName Benchmark
b]
run :: Verbosity -> LocalBuildInfo -> Executable -> [String] -> IO ()
run :: Verbosity -> LocalBuildInfo -> Executable -> [String] -> IO ()
run Verbosity
verbosity LocalBuildInfo
lbi Executable
exe [String]
exeArgs = do
String
curDir <- IO String
getCurrentDirectory
let buildPref :: String
buildPref = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi
pkg_descr :: PackageDescription
pkg_descr = LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi
dataDirEnvVar :: (String, String)
dataDirEnvVar = (PackageDescription -> String -> String
pkgPathEnvVar PackageDescription
pkg_descr String
"datadir",
String
curDir String -> String -> String
</> PackageDescription -> String
dataDir PackageDescription
pkg_descr)
(String
path, [String]
runArgs) <-
let exeName' :: String
exeName' = forall a. Pretty a => a -> String
prettyShow forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
in case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
CompilerFlavor
GHCJS -> do
let (String
script, String
cmd, [String]
cmdArgs) =
ProgramDb -> String -> (String, String, [String])
GHCJS.runCmd (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
(String
buildPref String -> String -> String
</> String
exeName' String -> String -> String
</> String
exeName')
String
script' <- String -> IO String
tryCanonicalizePath String
script
forall (m :: * -> *) a. Monad m => a -> m a
return (String
cmd, [String]
cmdArgs forall a. [a] -> [a] -> [a]
++ [String
script'])
CompilerFlavor
_ -> do
String
p <- String -> IO String
tryCanonicalizePath forall a b. (a -> b) -> a -> b
$
String
buildPref String -> String -> String
</> String
exeName' String -> String -> String
</> (String
exeName' String -> String -> String
<.> Platform -> String
exeExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi))
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [])
[(String, String)]
env <- ((String, String)
dataDirEnvVarforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment
[(String, String)]
env' <- if LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi
then do let (Platform Arch
_ OS
os) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
ComponentLocalBuildInfo
clbi <- case PackageDescription
-> LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets' PackageDescription
pkg_descr LocalBuildInfo
lbi (UnqualComponentName -> ComponentName
CExeName (Executable -> UnqualComponentName
exeName Executable
exe)) of
[TargetInfo
target] -> forall (m :: * -> *) a. Monad m => a -> m a
return (TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target)
[] -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"run: Could not find executable in LocalBuildInfo"
[TargetInfo]
_ -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"run: Found multiple matching exes in LocalBuildInfo"
[String]
paths <- Bool
-> Bool -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [String]
depLibraryPaths Bool
True Bool
False LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
forall (m :: * -> *) a. Monad m => a -> m a
return (OS -> [String] -> [(String, String)] -> [(String, String)]
addLibraryPath OS
os [String]
paths [(String, String)]
env)
else forall (m :: * -> *) a. Monad m => a -> m a
return [(String, String)]
env
Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Running " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe) forall a. [a] -> [a] -> [a]
++ String
"..."
Verbosity -> String -> [String] -> [(String, String)] -> IO ()
rawSystemExitWithEnv Verbosity
verbosity String
path ([String]
runArgsforall a. [a] -> [a] -> [a]
++[String]
exeArgs) [(String, String)]
env'