-----------------------------------------------------------------------------
-- |
-- 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 (String -> IO ()) -> Maybe String -> IO ()
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.
      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."
      -- If there is a warning, print it together with the addition.
      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       -- 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]
_)           -> 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)] -- Component name, message.
        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 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' = 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
  -- 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] -> 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'