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 (String -> IO ()) -> Maybe String -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
`traverse_` Maybe String
maybeWarning
Verbosity -> String -> IO (Executable, [String])
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
err
Right (Bool
True, Executable
exe, [String]
xs) -> (Executable, [String]) -> IO (Executable, [String])
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"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" the default executable."
Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> Maybe String -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
`traverse_` (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
addition) Maybe String
maybeWarning
(Executable, [String]) -> IO (Executable, [String])
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]
_) -> String -> Either String (Bool, Executable, [String])
forall a b. a -> Either a b
Left String
"Couldn't find any enabled executables."
([Executable
exe], []) -> (Bool, Executable, [String])
-> Either String (Bool, Executable, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Executable
exe, [])
([Executable
exe], (String
x:[String]
xs))
| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName -> String
unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe) -> (Bool, Executable, [String])
-> Either String (Bool, Executable, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Executable
exe, [String]
xs)
| Bool
otherwise -> (Bool, Executable, [String])
-> Either String (Bool, Executable, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Executable
exe, [String]
args)
([Executable]
_ , []) -> String -> Either String (Bool, Executable, [String])
forall a b. a -> Either a b
Left
(String -> Either String (Bool, Executable, [String]))
-> String -> Either String (Bool, Executable, [String])
forall a b. (a -> b) -> a -> b
$ String
"This package contains multiple executables. "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"You must pass the executable name as the first argument "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"to 'cabal run'."
([Executable]
_ , (String
x:[String]
xs)) ->
case (Executable -> Bool) -> [Executable] -> Maybe Executable
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Executable
exe -> UnqualComponentName -> String
unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x) [Executable]
enabledExes of
Maybe Executable
Nothing -> String -> Either String (Bool, Executable, [String])
forall a b. a -> Either a b
Left (String -> Either String (Bool, Executable, [String]))
-> String -> Either String (Bool, Executable, [String])
forall a b. (a -> b) -> a -> b
$ String
"No executable named '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'."
Just Executable
exe -> (Bool, Executable, [String])
-> Either String (Bool, Executable, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Executable
exe, [String]
xs)
where
enabledExes :: [Executable]
enabledExes = (Executable -> Bool) -> [Executable] -> [Executable]
forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable (BuildInfo -> Bool)
-> (Executable -> BuildInfo) -> Executable -> Bool
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
[] -> Maybe String
forall a. Maybe a
Nothing
(String
x:[String]
_) -> UnqualComponentName
-> [(UnqualComponentName, String)] -> Maybe 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 '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is disabled.")
| Executable
e <- PackageDescription -> [Executable]
executables PackageDescription
pkg_descr
, Bool -> Bool
not (Bool -> Bool) -> (Executable -> Bool) -> Executable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> Bool
buildable (BuildInfo -> Bool)
-> (Executable -> BuildInfo) -> Executable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
buildInfo (Executable -> Bool) -> Executable -> Bool
forall a b. (a -> b) -> a -> b
$ Executable
e, let name :: UnqualComponentName
name = Executable -> UnqualComponentName
exeName Executable
e]
[(UnqualComponentName, String)]
-> [(UnqualComponentName, String)]
-> [(UnqualComponentName, String)]
forall a. [a] -> [a] -> [a]
++ [ (UnqualComponentName
name, String
"There is a test-suite '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"',"
String -> String -> 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]
[(UnqualComponentName, String)]
-> [(UnqualComponentName, String)]
-> [(UnqualComponentName, String)]
forall a. [a] -> [a] -> [a]
++ [ (UnqualComponentName
name, String
"There is a benchmark '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"',"
String -> String -> 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' = UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (UnqualComponentName -> String) -> UnqualComponentName -> String
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
(String, [String]) -> IO (String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
cmd, [String]
cmdArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
script'])
CompilerFlavor
_ -> do
String
p <- String -> IO String
tryCanonicalizePath (String -> IO String) -> String -> IO String
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))
(String, [String]) -> IO (String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, [])
[(String, String)]
env <- ((String, String)
dataDirEnvVar(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:) ([(String, String)] -> [(String, String)])
-> IO [(String, String)] -> IO [(String, String)]
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] -> ComponentLocalBuildInfo -> IO ComponentLocalBuildInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target)
[] -> Verbosity -> String -> IO ComponentLocalBuildInfo
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"run: Could not find executable in LocalBuildInfo"
[TargetInfo]
_ -> Verbosity -> String -> IO ComponentLocalBuildInfo
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
[(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (OS -> [String] -> [(String, String)] -> [(String, String)]
addLibraryPath OS
os [String]
paths [(String, String)]
env)
else [(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String, String)]
env
Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Running " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
Verbosity -> String -> [String] -> [(String, String)] -> IO ()
rawSystemExitWithEnv Verbosity
verbosity String
path ([String]
runArgs[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
exeArgs) [(String, String)]
env'