{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

module Distribution.Client.CmdListBin
  ( listbinCommand
  , listbinAction

    -- * Internals exposed for testing
  , selectPackageTargets
  , selectComponentTarget
  , noComponentsProblem
  , matchesMultipleProblem
  , multipleTargetsProblem
  , componentNotRightKindProblem
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.CmdErrorMessages
  ( plural
  , renderListCommaAnd
  , renderTargetProblem
  , renderTargetProblemNoTargets
  , renderTargetSelector
  , showTargetSelector
  , targetSelectorFilter
  , targetSelectorPluralPkgs
  )
import Distribution.Client.DistDirLayout (DistDirLayout (..))
import Distribution.Client.NixStyleOptions
  ( NixStyleFlags (..)
  , defaultNixStyleFlags
  , nixStyleOptions
  )
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.ScriptUtils
  ( AcceptNoTargets (..)
  , TargetContext (..)
  , movedExePath
  , updateContextAndWriteProjectFile
  , withContextAndSelectors
  )
import Distribution.Client.Setup (GlobalFlags (..))
import Distribution.Client.TargetProblem (TargetProblem (..))
import Distribution.Simple.BuildPaths (dllExtension, exeExtension)
import Distribution.Simple.Command (CommandUI (..))
import Distribution.Simple.Setup (configCommonFlags, fromFlagOrDefault, setupVerbosity)
import Distribution.Simple.Utils (dieWithException, withOutputMarker, wrapText)
import Distribution.System (Platform)
import Distribution.Types.ComponentName (showComponentName)
import Distribution.Types.UnitId (UnitId)
import Distribution.Types.UnqualComponentName (UnqualComponentName)
import Distribution.Verbosity (silent, verboseStderr)
import System.FilePath ((<.>), (</>))

import qualified Data.Map as Map
import qualified Data.Set as Set
import Distribution.Client.Errors
import qualified Distribution.Client.InstallPlan as IP
import qualified Distribution.Simple.InstallDirs as InstallDirs
import qualified Distribution.Solver.Types.ComponentDeps as CD

-------------------------------------------------------------------------------
-- Command
-------------------------------------------------------------------------------

listbinCommand :: CommandUI (NixStyleFlags ())
listbinCommand :: CommandUI (NixStyleFlags ())
listbinCommand =
  CommandUI
    { commandName :: [Char]
commandName = [Char]
"list-bin"
    , commandSynopsis :: [Char]
commandSynopsis = [Char]
"List the path to a single executable."
    , commandUsage :: [Char] -> [Char]
commandUsage = \[Char]
pname ->
        [Char]
"Usage: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" list-bin [FLAGS] TARGET\n"
    , commandDescription :: Maybe ([Char] -> [Char])
commandDescription = ([Char] -> [Char]) -> Maybe ([Char] -> [Char])
forall a. a -> Maybe a
Just (([Char] -> [Char]) -> Maybe ([Char] -> [Char]))
-> ([Char] -> [Char]) -> Maybe ([Char] -> [Char])
forall a b. (a -> b) -> a -> b
$ \[Char]
_ ->
        [Char] -> [Char]
wrapText
          [Char]
"List the path to a build product."
    , commandNotes :: Maybe ([Char] -> [Char])
commandNotes = Maybe ([Char] -> [Char])
forall a. Maybe a
Nothing
    , commandDefaultFlags :: NixStyleFlags ()
commandDefaultFlags = () -> NixStyleFlags ()
forall a. a -> NixStyleFlags a
defaultNixStyleFlags ()
    , commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags ())]
commandOptions = (ShowOrParseArgs -> [OptionField ()])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags ())]
forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions ([OptionField ()] -> ShowOrParseArgs -> [OptionField ()]
forall a b. a -> b -> a
const [])
    }

-------------------------------------------------------------------------------
-- Action
-------------------------------------------------------------------------------

listbinAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
listbinAction :: NixStyleFlags () -> [[Char]] -> GlobalFlags -> IO ()
listbinAction flags :: NixStyleFlags ()
flags@NixStyleFlags{()
TestFlags
HaddockFlags
ConfigFlags
BenchmarkFlags
ProjectFlags
InstallFlags
ConfigExFlags
configFlags :: ConfigFlags
configExFlags :: ConfigExFlags
installFlags :: InstallFlags
haddockFlags :: HaddockFlags
testFlags :: TestFlags
benchmarkFlags :: BenchmarkFlags
projectFlags :: ProjectFlags
extraFlags :: ()
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
extraFlags :: forall a. NixStyleFlags a -> a
..} [[Char]]
args GlobalFlags
globalFlags = do
  -- fail early if multiple target selectors specified
  [Char]
target <- case [[Char]]
args of
    [] -> Verbosity -> CabalInstallException -> IO [Char]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
NoTargetProvided
    [[Char]
x] -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x
    [[Char]]
_ -> Verbosity -> CabalInstallException -> IO [Char]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
OneTargetRequired

  -- configure and elaborate target selectors
  AcceptNoTargets
-> Maybe ComponentKindFilter
-> NixStyleFlags ()
-> [[Char]]
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b.
AcceptNoTargets
-> Maybe ComponentKindFilter
-> NixStyleFlags a
-> [[Char]]
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO b)
-> IO b
withContextAndSelectors AcceptNoTargets
RejectNoTargets (ComponentKindFilter -> Maybe ComponentKindFilter
forall a. a -> Maybe a
Just ComponentKindFilter
ExeKind) NixStyleFlags ()
flags [[Char]
target] GlobalFlags
globalFlags CurrentCommand
OtherCommand ((TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO ())
 -> IO ())
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \TargetContext
targetCtx ProjectBaseContext
ctx [TargetSelector]
targetSelectors -> do
    ProjectBaseContext
baseCtx <- case TargetContext
targetCtx of
      TargetContext
ProjectContext -> ProjectBaseContext -> IO ProjectBaseContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext
ctx
      TargetContext
GlobalContext -> ProjectBaseContext -> IO ProjectBaseContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext
ctx
      ScriptContext [Char]
path Executable
exemeta -> ProjectBaseContext -> [Char] -> Executable -> IO ProjectBaseContext
updateContextAndWriteProjectFile ProjectBaseContext
ctx [Char]
path Executable
exemeta

    ProjectBuildContext
buildCtx <-
      Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan
    -> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext
runProjectPreBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx ((ElaboratedInstallPlan -> IO (ElaboratedInstallPlan, TargetsMap))
 -> IO ProjectBuildContext)
-> (ElaboratedInstallPlan
    -> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext
forall a b. (a -> b) -> a -> b
$ \ElaboratedInstallPlan
elaboratedPlan -> do
        -- Interpret the targets on the command line as build targets
        -- (as opposed to say repl or haddock targets).
        TargetsMap
targets <-
          ([ListBinTargetProblem] -> IO TargetsMap)
-> (TargetsMap -> IO TargetsMap)
-> Either [ListBinTargetProblem] TargetsMap
-> IO TargetsMap
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> [ListBinTargetProblem] -> IO TargetsMap
forall a. Verbosity -> [ListBinTargetProblem] -> IO a
reportTargetProblems Verbosity
verbosity) TargetsMap -> IO TargetsMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [ListBinTargetProblem] TargetsMap -> IO TargetsMap)
-> Either [ListBinTargetProblem] TargetsMap -> IO TargetsMap
forall a b. (a -> b) -> a -> b
$
            (forall k.
 TargetSelector
 -> [AvailableTarget k] -> Either ListBinTargetProblem [k])
-> (forall k.
    SubComponentTarget
    -> AvailableTarget k -> Either ListBinTargetProblem k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [ListBinTargetProblem] TargetsMap
forall err.
(forall k.
 TargetSelector
 -> [AvailableTarget k] -> Either (TargetProblem err) [k])
-> (forall k.
    SubComponentTarget
    -> AvailableTarget k -> Either (TargetProblem err) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
resolveTargets
              TargetSelector
-> [AvailableTarget k] -> Either ListBinTargetProblem [k]
forall k.
TargetSelector
-> [AvailableTarget k] -> Either ListBinTargetProblem [k]
selectPackageTargets
              SubComponentTarget
-> AvailableTarget k -> Either ListBinTargetProblem k
forall k.
SubComponentTarget
-> AvailableTarget k -> Either ListBinTargetProblem k
selectComponentTarget
              ElaboratedInstallPlan
elaboratedPlan
              Maybe SourcePackageDb
forall a. Maybe a
Nothing
              [TargetSelector]
targetSelectors

        -- Reject multiple targets, or at least targets in different
        -- components. It is ok to have two module/file targets in the
        -- same component, but not two that live in different components.
        --
        -- Note that we discard the target and return the whole 'TargetsMap',
        -- so this check will be repeated (and must succeed) after
        -- the 'runProjectPreBuildPhase'. Keep it in mind when modifying this.
        (UnitId, UnqualComponentName)
_ <-
          IO (UnitId, UnqualComponentName)
-> TargetsMap -> IO (UnitId, UnqualComponentName)
singleComponentOrElse
            ( Verbosity
-> [ListBinTargetProblem] -> IO (UnitId, UnqualComponentName)
forall a. Verbosity -> [ListBinTargetProblem] -> IO a
reportTargetProblems
                Verbosity
verbosity
                [TargetsMap -> ListBinTargetProblem
multipleTargetsProblem TargetsMap
targets]
            )
            TargetsMap
targets

        let elaboratedPlan' :: ElaboratedInstallPlan
elaboratedPlan' =
              TargetAction
-> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets
                TargetAction
TargetActionBuild
                TargetsMap
targets
                ElaboratedInstallPlan
elaboratedPlan
        (ElaboratedInstallPlan, TargetsMap)
-> IO (ElaboratedInstallPlan, TargetsMap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
elaboratedPlan', TargetsMap
targets)

    (UnitId
selectedUnitId, UnqualComponentName
selectedComponent) <-
      -- Slight duplication with 'runProjectPreBuildPhase'.
      IO (UnitId, UnqualComponentName)
-> TargetsMap -> IO (UnitId, UnqualComponentName)
singleComponentOrElse
        ( Verbosity
-> CabalInstallException -> IO (UnitId, UnqualComponentName)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
ThisIsABug
        )
        (TargetsMap -> IO (UnitId, UnqualComponentName))
-> TargetsMap -> IO (UnitId, UnqualComponentName)
forall a b. (a -> b) -> a -> b
$ ProjectBuildContext -> TargetsMap
targetsMap ProjectBuildContext
buildCtx

    Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO ()
printPlan Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx

    [[Char]]
binfiles <- case UnitId
-> Map
     UnitId
     (GenericPlanPackage
        InstalledPackageInfo ElaboratedConfiguredPackage)
-> Maybe
     (GenericPlanPackage
        InstalledPackageInfo ElaboratedConfiguredPackage)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
selectedUnitId (Map
   UnitId
   (GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage)
 -> Maybe
      (GenericPlanPackage
         InstalledPackageInfo ElaboratedConfiguredPackage))
-> Map
     UnitId
     (GenericPlanPackage
        InstalledPackageInfo ElaboratedConfiguredPackage)
-> Maybe
     (GenericPlanPackage
        InstalledPackageInfo ElaboratedConfiguredPackage)
forall a b. (a -> b) -> a -> b
$ ElaboratedInstallPlan
-> Map
     UnitId
     (GenericPlanPackage
        InstalledPackageInfo ElaboratedConfiguredPackage)
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> Map UnitId (GenericPlanPackage ipkg srcpkg)
IP.toMap (ProjectBuildContext -> ElaboratedInstallPlan
elaboratedPlanOriginal ProjectBuildContext
buildCtx) of
      Maybe
  (GenericPlanPackage
     InstalledPackageInfo ElaboratedConfiguredPackage)
Nothing -> Verbosity -> CabalInstallException -> IO [[Char]]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
NoOrMultipleTargetsGiven
      Just GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
gpp ->
        [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$
          (InstalledPackageInfo -> [[Char]])
-> (ElaboratedConfiguredPackage -> [[Char]])
-> GenericPlanPackage
     InstalledPackageInfo ElaboratedConfiguredPackage
-> [[Char]]
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
IP.foldPlanPackage
            ([[Char]] -> InstalledPackageInfo -> [[Char]]
forall a b. a -> b -> a
const []) -- IPI don't have executables
            (DistDirLayout
-> ElaboratedSharedConfig
-> UnqualComponentName
-> ElaboratedConfiguredPackage
-> [[Char]]
elaboratedPackage (ProjectBaseContext -> DistDirLayout
distDirLayout ProjectBaseContext
baseCtx) (ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared ProjectBuildContext
buildCtx) UnqualComponentName
selectedComponent)
            GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
gpp

    case [[Char]]
binfiles of
      [] -> Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
NoTargetFound
      [[Char]
exe] -> [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> [Char] -> [Char]
withOutputMarker Verbosity
verbosity ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
exe [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
      -- Andreas, 2023-01-13, issue #8400:
      -- Regular output of `list-bin` should go to stdout unconditionally,
      -- but for the sake of the testsuite, we want to mark it so it goes
      -- into the golden value for the test.
      -- Note: 'withOutputMarker' only checks 'isVerboseMarkOutput',
      -- thus, we can reuse @verbosity@ here, even if other components
      -- of @verbosity@ may be wrong (like 'VStderr', verbosity level etc.).
      -- Andreas, 2023-01-20:
      -- Appending the newline character here rather than using 'putStrLn'
      -- because an active 'withOutputMarker' produces text that ends
      -- in newline characters.
      [[Char]]
_ -> Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
MultipleTargetsFound
  where
    defaultVerbosity :: Verbosity
defaultVerbosity = Verbosity -> Verbosity
verboseStderr Verbosity
silent
    verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
defaultVerbosity (CommonSetupFlags -> Flag Verbosity
setupVerbosity (CommonSetupFlags -> Flag Verbosity)
-> CommonSetupFlags -> Flag Verbosity
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> CommonSetupFlags
configCommonFlags ConfigFlags
configFlags)

    -- this is copied from
    elaboratedPackage
      :: DistDirLayout
      -> ElaboratedSharedConfig
      -> UnqualComponentName
      -> ElaboratedConfiguredPackage
      -> [FilePath]
    elaboratedPackage :: DistDirLayout
-> ElaboratedSharedConfig
-> UnqualComponentName
-> ElaboratedConfiguredPackage
-> [[Char]]
elaboratedPackage DistDirLayout
distDirLayout ElaboratedSharedConfig
elaboratedSharedConfig UnqualComponentName
selectedComponent ElaboratedConfiguredPackage
elab = case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
      ElabPackage ElaboratedPackage
pkg ->
        [ [Char]
bin
        | (Component
c, ([(ConfiguredId, Bool)], [ConfiguredId])
_) <-
            ComponentDeps ([(ConfiguredId, Bool)], [ConfiguredId])
-> [(Component, ([(ConfiguredId, Bool)], [ConfiguredId]))]
forall a. ComponentDeps a -> [ComponentDep a]
CD.toList (ComponentDeps ([(ConfiguredId, Bool)], [ConfiguredId])
 -> [(Component, ([(ConfiguredId, Bool)], [ConfiguredId]))])
-> ComponentDeps ([(ConfiguredId, Bool)], [ConfiguredId])
-> [(Component, ([(ConfiguredId, Bool)], [ConfiguredId]))]
forall a b. (a -> b) -> a -> b
$
              ComponentDeps [(ConfiguredId, Bool)]
-> ComponentDeps [ConfiguredId]
-> ComponentDeps ([(ConfiguredId, Bool)], [ConfiguredId])
forall a b.
(Monoid a, Monoid b) =>
ComponentDeps a -> ComponentDeps b -> ComponentDeps (a, b)
CD.zip
                (ElaboratedPackage -> ComponentDeps [(ConfiguredId, Bool)]
pkgLibDependencies ElaboratedPackage
pkg)
                (ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgExeDependencies ElaboratedPackage
pkg)
        , [Char]
bin <- Component -> [[Char]]
bin_file Component
c
        ]
      ElabComponent ElaboratedComponent
comp -> Component -> [[Char]]
bin_file (ElaboratedComponent -> Component
compSolverName ElaboratedComponent
comp)
      where
        dist_dir :: [Char]
dist_dir = DistDirLayout -> DistDirParams -> [Char]
distBuildDirectory DistDirLayout
distDirLayout (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
elaboratedSharedConfig ElaboratedConfiguredPackage
elab)

        bin_file :: Component -> [[Char]]
bin_file Component
c = case Component
c of
          CD.ComponentExe UnqualComponentName
s
            | UnqualComponentName
s UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [UnqualComponentName -> [Char]
forall {a}. Pretty a => a -> [Char]
moved_bin_file UnqualComponentName
s]
          CD.ComponentTest UnqualComponentName
s
            | UnqualComponentName
s UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [UnqualComponentName -> [Char]
forall {a}. Pretty a => a -> [Char]
bin_file' UnqualComponentName
s]
          CD.ComponentBench UnqualComponentName
s
            | UnqualComponentName
s UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [UnqualComponentName -> [Char]
forall {a}. Pretty a => a -> [Char]
bin_file' UnqualComponentName
s]
          CD.ComponentFLib UnqualComponentName
s
            | UnqualComponentName
s UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [UnqualComponentName -> [Char]
forall {a}. Pretty a => a -> [Char]
flib_file' UnqualComponentName
s]
          Component
_ -> []

        plat :: Platform
        plat :: Platform
plat = ElaboratedSharedConfig -> Platform
pkgConfigPlatform ElaboratedSharedConfig
elaboratedSharedConfig

        -- here and in PlanOutput,
        -- use binDirectoryFor?
        bin_file' :: a -> [Char]
bin_file' a
s =
          if BuildStyle -> Bool
isInplaceBuildStyle (ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab)
            then [Char]
dist_dir [Char] -> [Char] -> [Char]
</> [Char]
"build" [Char] -> [Char] -> [Char]
</> a -> [Char]
forall {a}. Pretty a => a -> [Char]
prettyShow a
s [Char] -> [Char] -> [Char]
</> a -> [Char]
forall {a}. Pretty a => a -> [Char]
prettyShow a
s [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
exeExtension Platform
plat
            else InstallDirs [Char] -> [Char]
forall dir. InstallDirs dir -> dir
InstallDirs.bindir (ElaboratedConfiguredPackage -> InstallDirs [Char]
elabInstallDirs ElaboratedConfiguredPackage
elab) [Char] -> [Char] -> [Char]
</> a -> [Char]
forall {a}. Pretty a => a -> [Char]
prettyShow a
s [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
exeExtension Platform
plat

        flib_file' :: a -> [Char]
flib_file' a
s =
          if BuildStyle -> Bool
isInplaceBuildStyle (ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab)
            then [Char]
dist_dir [Char] -> [Char] -> [Char]
</> [Char]
"build" [Char] -> [Char] -> [Char]
</> a -> [Char]
forall {a}. Pretty a => a -> [Char]
prettyShow a
s [Char] -> [Char] -> [Char]
</> ([Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall {a}. Pretty a => a -> [Char]
prettyShow a
s) [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
dllExtension Platform
plat
            else InstallDirs [Char] -> [Char]
forall dir. InstallDirs dir -> dir
InstallDirs.bindir (ElaboratedConfiguredPackage -> InstallDirs [Char]
elabInstallDirs ElaboratedConfiguredPackage
elab) [Char] -> [Char] -> [Char]
</> ([Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall {a}. Pretty a => a -> [Char]
prettyShow a
s) [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
dllExtension Platform
plat

        moved_bin_file :: a -> [Char]
moved_bin_file a
s = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe (a -> [Char]
forall {a}. Pretty a => a -> [Char]
bin_file' a
s) (UnqualComponentName
-> DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> Maybe [Char]
movedExePath UnqualComponentName
selectedComponent DistDirLayout
distDirLayout ElaboratedSharedConfig
elaboratedSharedConfig ElaboratedConfiguredPackage
elab)

-------------------------------------------------------------------------------
-- Target Problem: the very similar to CmdRun
-------------------------------------------------------------------------------

singleComponentOrElse :: IO (UnitId, UnqualComponentName) -> TargetsMap -> IO (UnitId, UnqualComponentName)
singleComponentOrElse :: IO (UnitId, UnqualComponentName)
-> TargetsMap -> IO (UnitId, UnqualComponentName)
singleComponentOrElse IO (UnitId, UnqualComponentName)
action TargetsMap
targetsMap =
  case Set (UnitId, ComponentName) -> [(UnitId, ComponentName)]
forall a. Set a -> [a]
Set.toList (Set (UnitId, ComponentName) -> [(UnitId, ComponentName)])
-> (TargetsMap -> Set (UnitId, ComponentName))
-> TargetsMap
-> [(UnitId, ComponentName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetsMap -> Set (UnitId, ComponentName)
distinctTargetComponents (TargetsMap -> [(UnitId, ComponentName)])
-> TargetsMap -> [(UnitId, ComponentName)]
forall a b. (a -> b) -> a -> b
$ TargetsMap
targetsMap of
    [(UnitId
unitId, CExeName UnqualComponentName
component)] -> (UnitId, UnqualComponentName) -> IO (UnitId, UnqualComponentName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
    [(UnitId
unitId, CTestName UnqualComponentName
component)] -> (UnitId, UnqualComponentName) -> IO (UnitId, UnqualComponentName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
    [(UnitId
unitId, CBenchName UnqualComponentName
component)] -> (UnitId, UnqualComponentName) -> IO (UnitId, UnqualComponentName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
    [(UnitId
unitId, CFLibName UnqualComponentName
component)] -> (UnitId, UnqualComponentName) -> IO (UnitId, UnqualComponentName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
    [(UnitId, ComponentName)]
_ -> IO (UnitId, UnqualComponentName)
action

-- | This defines what a 'TargetSelector' means for the @list-bin@ command.
-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
-- or otherwise classifies the problem.
--
-- For the @list-bin@ command we select the exe or flib if there is only one
-- and it's buildable. Fail if there are no or multiple buildable exe components.
selectPackageTargets
  :: TargetSelector
  -> [AvailableTarget k]
  -> Either ListBinTargetProblem [k]
selectPackageTargets :: forall k.
TargetSelector
-> [AvailableTarget k] -> Either ListBinTargetProblem [k]
selectPackageTargets TargetSelector
targetSelector [AvailableTarget k]
targets
  -- If there is a single executable component, select that. See #7403
  | [k
target] <- [k]
targetsExesBuildable =
      [k] -> Either ListBinTargetProblem [k]
forall a b. b -> Either a b
Right [k
target]
  -- Otherwise, if there is a single executable-like component left, select that.
  | [k
target] <- [k]
targetsExeLikesBuildable =
      [k] -> Either ListBinTargetProblem [k]
forall a b. b -> Either a b
Right [k
target]
  -- but fail if there are multiple buildable executables.
  | Bool -> Bool
not ([k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
targetsExeLikesBuildable) =
      ListBinTargetProblem -> Either ListBinTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> [AvailableTarget ()] -> ListBinTargetProblem
matchesMultipleProblem TargetSelector
targetSelector [AvailableTarget ()]
targetsExeLikesBuildable')
  -- If there are executables but none are buildable then we report those
  | Bool -> Bool
not ([AvailableTarget ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget ()]
targetsExeLikes') =
      ListBinTargetProblem -> Either ListBinTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> [AvailableTarget ()] -> ListBinTargetProblem
forall a. TargetSelector -> [AvailableTarget ()] -> TargetProblem a
TargetProblemNoneEnabled TargetSelector
targetSelector [AvailableTarget ()]
targetsExeLikes')
  -- If there are no executables but some other targets then we report that
  | Bool -> Bool
not ([AvailableTarget k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget k]
targets) =
      ListBinTargetProblem -> Either ListBinTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> ListBinTargetProblem
noComponentsProblem TargetSelector
targetSelector)
  -- If there are no targets at all then we report that
  | Bool
otherwise =
      ListBinTargetProblem -> Either ListBinTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> ListBinTargetProblem
forall a. TargetSelector -> TargetProblem a
TargetProblemNoTargets TargetSelector
targetSelector)
  where
    -- Targets that are precisely executables
    targetsExes :: [AvailableTarget k]
targetsExes = ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
ExeKind [AvailableTarget k]
targets
    targetsExesBuildable :: [k]
targetsExesBuildable = [AvailableTarget k] -> [k]
forall k. [AvailableTarget k] -> [k]
selectBuildableTargets [AvailableTarget k]
targetsExes

    -- Any target that could be executed
    targetsExeLikes :: [AvailableTarget k]
targetsExeLikes =
      [AvailableTarget k]
targetsExes
        [AvailableTarget k] -> [AvailableTarget k] -> [AvailableTarget k]
forall a. [a] -> [a] -> [a]
++ ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
TestKind [AvailableTarget k]
targets
        [AvailableTarget k] -> [AvailableTarget k] -> [AvailableTarget k]
forall a. [a] -> [a] -> [a]
++ ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
BenchKind [AvailableTarget k]
targets

    ( [k]
targetsExeLikesBuildable
      , [AvailableTarget ()]
targetsExeLikesBuildable'
      ) = [AvailableTarget k] -> ([k], [AvailableTarget ()])
forall k. [AvailableTarget k] -> ([k], [AvailableTarget ()])
selectBuildableTargets' [AvailableTarget k]
targetsExeLikes

    targetsExeLikes' :: [AvailableTarget ()]
targetsExeLikes' = [AvailableTarget k] -> [AvailableTarget ()]
forall k. [AvailableTarget k] -> [AvailableTarget ()]
forgetTargetsDetail [AvailableTarget k]
targetsExeLikes

-- | For a 'TargetComponent' 'TargetSelector', check if the component can be
-- selected.
--
-- For the @run@ command we just need to check it is a executable-like
-- (an executable, a test, or a benchmark), in addition
-- to the basic checks on being buildable etc.
selectComponentTarget
  :: SubComponentTarget
  -> AvailableTarget k
  -> Either ListBinTargetProblem k
selectComponentTarget :: forall k.
SubComponentTarget
-> AvailableTarget k -> Either ListBinTargetProblem k
selectComponentTarget subtarget :: SubComponentTarget
subtarget@SubComponentTarget
WholeComponent AvailableTarget k
t =
  case AvailableTarget k -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t of
    CExeName UnqualComponentName
_ -> Either ListBinTargetProblem k
forall {a}. Either (TargetProblem a) k
component
    CTestName UnqualComponentName
_ -> Either ListBinTargetProblem k
forall {a}. Either (TargetProblem a) k
component
    CBenchName UnqualComponentName
_ -> Either ListBinTargetProblem k
forall {a}. Either (TargetProblem a) k
component
    CFLibName UnqualComponentName
_ -> Either ListBinTargetProblem k
forall {a}. Either (TargetProblem a) k
component
    ComponentName
_ -> ListBinTargetProblem -> Either ListBinTargetProblem k
forall a b. a -> Either a b
Left (PackageId -> ComponentName -> ListBinTargetProblem
componentNotRightKindProblem PackageId
pkgid ComponentName
cname)
  where
    pkgid :: PackageId
pkgid = AvailableTarget k -> PackageId
forall k. AvailableTarget k -> PackageId
availableTargetPackageId AvailableTarget k
t
    cname :: ComponentName
cname = AvailableTarget k -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t
    component :: Either (TargetProblem a) k
component = SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
forall k a.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic SubComponentTarget
subtarget AvailableTarget k
t
selectComponentTarget SubComponentTarget
subtarget AvailableTarget k
t =
  ListBinTargetProblem -> Either ListBinTargetProblem k
forall a b. a -> Either a b
Left
    ( PackageId
-> ComponentName -> SubComponentTarget -> ListBinTargetProblem
isSubComponentProblem
        (AvailableTarget k -> PackageId
forall k. AvailableTarget k -> PackageId
availableTargetPackageId AvailableTarget k
t)
        (AvailableTarget k -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t)
        SubComponentTarget
subtarget
    )

-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @run@ command.
data ListBinProblem
  = -- | The 'TargetSelector' matches targets but no executables
    TargetProblemNoRightComps TargetSelector
  | -- | A single 'TargetSelector' matches multiple targets
    TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()]
  | -- | Multiple 'TargetSelector's match multiple targets
    TargetProblemMultipleTargets TargetsMap
  | -- | The 'TargetSelector' refers to a component that is not an executable
    TargetProblemComponentNotRightKind PackageId ComponentName
  | -- | Asking to run an individual file or module is not supported
    TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget
  deriving (ListBinProblem -> ListBinProblem -> Bool
(ListBinProblem -> ListBinProblem -> Bool)
-> (ListBinProblem -> ListBinProblem -> Bool) -> Eq ListBinProblem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListBinProblem -> ListBinProblem -> Bool
== :: ListBinProblem -> ListBinProblem -> Bool
$c/= :: ListBinProblem -> ListBinProblem -> Bool
/= :: ListBinProblem -> ListBinProblem -> Bool
Eq, Int -> ListBinProblem -> [Char] -> [Char]
[ListBinProblem] -> [Char] -> [Char]
ListBinProblem -> [Char]
(Int -> ListBinProblem -> [Char] -> [Char])
-> (ListBinProblem -> [Char])
-> ([ListBinProblem] -> [Char] -> [Char])
-> Show ListBinProblem
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ListBinProblem -> [Char] -> [Char]
showsPrec :: Int -> ListBinProblem -> [Char] -> [Char]
$cshow :: ListBinProblem -> [Char]
show :: ListBinProblem -> [Char]
$cshowList :: [ListBinProblem] -> [Char] -> [Char]
showList :: [ListBinProblem] -> [Char] -> [Char]
Show)

type ListBinTargetProblem = TargetProblem ListBinProblem

noComponentsProblem :: TargetSelector -> ListBinTargetProblem
noComponentsProblem :: TargetSelector -> ListBinTargetProblem
noComponentsProblem = ListBinProblem -> ListBinTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (ListBinProblem -> ListBinTargetProblem)
-> (TargetSelector -> ListBinProblem)
-> TargetSelector
-> ListBinTargetProblem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetSelector -> ListBinProblem
TargetProblemNoRightComps

matchesMultipleProblem :: TargetSelector -> [AvailableTarget ()] -> ListBinTargetProblem
matchesMultipleProblem :: TargetSelector -> [AvailableTarget ()] -> ListBinTargetProblem
matchesMultipleProblem TargetSelector
selector [AvailableTarget ()]
targets =
  ListBinProblem -> ListBinTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (ListBinProblem -> ListBinTargetProblem)
-> ListBinProblem -> ListBinTargetProblem
forall a b. (a -> b) -> a -> b
$
    TargetSelector -> [AvailableTarget ()] -> ListBinProblem
TargetProblemMatchesMultiple TargetSelector
selector [AvailableTarget ()]
targets

multipleTargetsProblem :: TargetsMap -> TargetProblem ListBinProblem
multipleTargetsProblem :: TargetsMap -> ListBinTargetProblem
multipleTargetsProblem = ListBinProblem -> ListBinTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (ListBinProblem -> ListBinTargetProblem)
-> (TargetsMap -> ListBinProblem)
-> TargetsMap
-> ListBinTargetProblem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetsMap -> ListBinProblem
TargetProblemMultipleTargets

componentNotRightKindProblem :: PackageId -> ComponentName -> TargetProblem ListBinProblem
componentNotRightKindProblem :: PackageId -> ComponentName -> ListBinTargetProblem
componentNotRightKindProblem PackageId
pkgid ComponentName
name =
  ListBinProblem -> ListBinTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (ListBinProblem -> ListBinTargetProblem)
-> ListBinProblem -> ListBinTargetProblem
forall a b. (a -> b) -> a -> b
$
    PackageId -> ComponentName -> ListBinProblem
TargetProblemComponentNotRightKind PackageId
pkgid ComponentName
name

isSubComponentProblem
  :: PackageId
  -> ComponentName
  -> SubComponentTarget
  -> TargetProblem ListBinProblem
isSubComponentProblem :: PackageId
-> ComponentName -> SubComponentTarget -> ListBinTargetProblem
isSubComponentProblem PackageId
pkgid ComponentName
name SubComponentTarget
subcomponent =
  ListBinProblem -> ListBinTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (ListBinProblem -> ListBinTargetProblem)
-> ListBinProblem -> ListBinTargetProblem
forall a b. (a -> b) -> a -> b
$
    PackageId -> ComponentName -> SubComponentTarget -> ListBinProblem
TargetProblemIsSubComponent PackageId
pkgid ComponentName
name SubComponentTarget
subcomponent

reportTargetProblems :: Verbosity -> [ListBinTargetProblem] -> IO a
reportTargetProblems :: forall a. Verbosity -> [ListBinTargetProblem] -> IO a
reportTargetProblems Verbosity
verbosity =
  Verbosity -> CabalInstallException -> IO a
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO a)
-> ([ListBinTargetProblem] -> CabalInstallException)
-> [ListBinTargetProblem]
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> CabalInstallException
ListBinTargetException ([Char] -> CabalInstallException)
-> ([ListBinTargetProblem] -> [Char])
-> [ListBinTargetProblem]
-> CabalInstallException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> ([ListBinTargetProblem] -> [[Char]])
-> [ListBinTargetProblem]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListBinTargetProblem -> [Char])
-> [ListBinTargetProblem] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ListBinTargetProblem -> [Char]
renderListBinTargetProblem

renderListBinTargetProblem :: ListBinTargetProblem -> String
renderListBinTargetProblem :: ListBinTargetProblem -> [Char]
renderListBinTargetProblem (TargetProblemNoTargets TargetSelector
targetSelector) =
  case TargetSelector -> Maybe ComponentKindFilter
targetSelectorFilter TargetSelector
targetSelector of
    Just ComponentKindFilter
kind
      | ComponentKindFilter
kind ComponentKindFilter -> ComponentKindFilter -> Bool
forall a. Eq a => a -> a -> Bool
/= ComponentKindFilter
ExeKind ->
          [Char]
"The list-bin command is for finding binaries, but the target '"
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
    Maybe ComponentKindFilter
_ -> [Char] -> TargetSelector -> [Char]
renderTargetProblemNoTargets [Char]
"list-bin" TargetSelector
targetSelector
renderListBinTargetProblem ListBinTargetProblem
problem =
  [Char]
-> (ListBinProblem -> [Char]) -> ListBinTargetProblem -> [Char]
forall a. [Char] -> (a -> [Char]) -> TargetProblem a -> [Char]
renderTargetProblem [Char]
"list-bin" ListBinProblem -> [Char]
renderListBinProblem ListBinTargetProblem
problem

renderListBinProblem :: ListBinProblem -> String
renderListBinProblem :: ListBinProblem -> [Char]
renderListBinProblem (TargetProblemMatchesMultiple TargetSelector
targetSelector [AvailableTarget ()]
targets) =
  [Char]
"The list-bin command is for finding a single binary at once. The target '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" which includes "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
renderListCommaAnd
      ( ([Char]
"the " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
          ([Char] -> [Char])
-> (ComponentName -> [Char]) -> ComponentName -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComponentName -> [Char]
showComponentName
          (ComponentName -> [Char])
-> (AvailableTarget () -> ComponentName)
-> AvailableTarget ()
-> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AvailableTarget () -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName
          (AvailableTarget () -> [Char]) -> [AvailableTarget ()] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ComponentKindFilter -> [AvailableTarget ()])
-> [ComponentKindFilter] -> [AvailableTarget ()]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
            (\ComponentKindFilter
kind -> ComponentKindFilter -> [AvailableTarget ()] -> [AvailableTarget ()]
forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
kind [AvailableTarget ()]
targets)
            [ComponentKindFilter
ExeKind, ComponentKindFilter
TestKind, ComponentKindFilter
BenchKind]
      )
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
renderListBinProblem (TargetProblemMultipleTargets TargetsMap
selectorMap) =
  [Char]
"The list-bin command is for finding a single binary at once. The targets "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
renderListCommaAnd
      [ [Char]
"'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
ts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
      | TargetSelector
ts <- TargetsMap -> [TargetSelector]
uniqueTargetSelectors TargetsMap
selectorMap
      ]
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" refer to different executables."
renderListBinProblem (TargetProblemComponentNotRightKind PackageId
pkgid ComponentName
cname) =
  [Char]
"The list-bin command is for finding binaries, but the target '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" from the package "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PackageId -> [Char]
forall {a}. Pretty a => a -> [Char]
prettyShow PackageId
pkgid
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
  where
    targetSelector :: TargetSelector
targetSelector = PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pkgid ComponentName
cname SubComponentTarget
WholeComponent
renderListBinProblem (TargetProblemIsSubComponent PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget) =
  [Char]
"The list-bin command can only find a binary as a whole, "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"not files or modules within them, but the target '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
  where
    targetSelector :: TargetSelector
targetSelector = PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget
renderListBinProblem (TargetProblemNoRightComps TargetSelector
targetSelector) =
  [Char]
"Cannot list-bin the target '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' which refers to "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" because "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Plural -> [Char] -> [Char] -> [Char]
forall a. Plural -> a -> a -> a
plural (TargetSelector -> Plural
targetSelectorPluralPkgs TargetSelector
targetSelector) [Char]
"it does" [Char]
"they do"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not contain any executables or foreign libraries."