module Distribution.Client.Run (run, splitRunArgs)
where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Types.LocalBuildInfo (componentNameTargets')
import Distribution.Types.TargetInfo (targetCLBI)
import Distribution.Client.Utils (tryCanonicalizePath)
import Distribution.PackageDescription
( Benchmark (..)
, BuildInfo (buildable)
, Executable (..)
, PackageDescription (..)
, TestSuite (..)
)
import Distribution.Simple.Build.PathsModule (pkgPathEnvVar)
import Distribution.Simple.BuildPaths (exeExtension)
import Distribution.Simple.Compiler (CompilerFlavor (..), compilerFlavor)
import Distribution.Simple.LocalBuildInfo
( ComponentName (..)
, LocalBuildInfo (..)
, buildDir
, depLibraryPaths
)
import Distribution.Simple.Utils
( addLibraryPath
, dieWithException
, notice
, rawSystemExitWithEnv
, warn
)
import Distribution.System (Platform (..))
import Distribution.Types.UnqualComponentName
import qualified Distribution.Simple.GHCJS as GHCJS
import Distribution.Client.Errors
import Distribution.Compat.Environment (getEnvironment)
import System.Directory (getCurrentDirectory)
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 -> CabalInstallException -> IO (Executable, [String])
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO (Executable, [String]))
-> CabalInstallException -> IO (Executable, [String])
forall a b. (a -> b) -> a -> b
$ String -> CabalInstallException
SplitRunArgs String
err
Right (Bool
True, Executable
exe, [String]
xs) -> (Executable, [String]) -> IO (Executable, [String])
forall a. a -> IO a
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a. a -> IO a
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 a. a -> Either String a
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 a. a -> Either String a
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 a. a -> Either String a
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 a. a -> Either String a
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
curDir <- IO String
getCurrentDirectory
let buildPref = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi
pkg_descr = LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
lbi
dataDirEnvVar =
( PackageDescription -> String -> String
pkgPathEnvVar PackageDescription
pkg_descr String
"datadir"
, String
curDir String -> String -> String
</> PackageDescription -> String
dataDir PackageDescription
pkg_descr
)
(path, runArgs) <-
let 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 compilerFlavor (compiler 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')
script' <- String -> IO String
tryCanonicalizePath String
script
return (cmd, cmdArgs ++ [script'])
CompilerFlavor
_ -> do
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))
return (p, [])
env <- (dataDirEnvVar :) <$> getEnvironment
env' <-
if withDynExe lbi
then do
let (Platform _ os) = hostPlatform lbi
clbi <- case componentNameTargets' pkg_descr lbi (CExeName (exeName exe)) of
[TargetInfo
target] -> ComponentLocalBuildInfo -> IO ComponentLocalBuildInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target)
[] -> Verbosity -> CabalInstallException -> IO ComponentLocalBuildInfo
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
CouldNotFindExecutable
[TargetInfo]
_ -> Verbosity -> CabalInstallException -> IO ComponentLocalBuildInfo
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
FoundMultipleMatchingExes
paths <- depLibraryPaths True False lbi clbi
return (addLibraryPath os paths env)
else return env
notice verbosity $ "Running " ++ prettyShow (exeName exe) ++ "..."
rawSystemExitWithEnv verbosity path (runArgs ++ exeArgs) env'