-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.Run
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Implementation of the 'run' command.
-----------------------------------------------------------------------------

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                       ((<.>), (</>))


-- | Return the executable to run and any extra arguments that should be
-- forwarded to it. Die in case of error.
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 -- Either err (wasManuallyChosen, exe, paramsRest)
    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 -- If there is a warning, print it.
      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."
      -- If there is a warning, print it together with the addition.
      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       -- Error string.
                              ( Bool       -- If it was manually chosen.
                              , Executable -- The executable.
                              , [String]   -- The remaining parameters.
                              )
    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)] -- Component name, message.
        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 a given executable.
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
  -- Add (DY)LD_LIBRARY_PATH if needed
  [(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'