{-# 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(..), 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                 (configVerbosity, fromFlagOrDefault)
import Distribution.Simple.Utils                 (die', 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 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: " forall a. [a] -> [a] -> [a]
++ [Char]
pname forall a. [a] -> [a] -> [a]
++ [Char]
" list-bin [FLAGS] TARGET\n"
    , commandDescription :: Maybe ([Char] -> [Char])
commandDescription  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \[Char]
_ -> [Char] -> [Char]
wrapText
        [Char]
"List the path to a build product."
    , commandNotes :: Maybe ([Char] -> [Char])
commandNotes = forall a. Maybe a
Nothing
    , commandDefaultFlags :: NixStyleFlags ()
commandDefaultFlags = forall a. a -> NixStyleFlags a
defaultNixStyleFlags ()
    , commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags ())]
commandOptions      = forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions (forall a b. a -> b -> a
const [])
    }

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

listbinAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
listbinAction :: NixStyleFlags () -> [[Char]] -> GlobalFlags -> IO ()
listbinAction flags :: NixStyleFlags ()
flags@NixStyleFlags{()
ConfigFlags
HaddockFlags
TestFlags
BenchmarkFlags
ProjectFlags
InstallFlags
ConfigExFlags
extraFlags :: forall a. NixStyleFlags a -> a
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
extraFlags :: ()
projectFlags :: ProjectFlags
benchmarkFlags :: BenchmarkFlags
testFlags :: TestFlags
haddockFlags :: HaddockFlags
installFlags :: InstallFlags
configExFlags :: ConfigExFlags
configFlags :: ConfigFlags
..} [[Char]]
args GlobalFlags
globalFlags = do
  -- fail early if multiple target selectors specified
  [Char]
target <- case [[Char]]
args of
      []  -> forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity [Char]
"One target is required, none provided"
      [[Char]
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x
      [[Char]]
_   -> forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity [Char]
"One target is required, given multiple"

  -- configure and elaborate target selectors
  forall a b.
AcceptNoTargets
-> Maybe ComponentKindFilter
-> NixStyleFlags a
-> [[Char]]
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO b)
-> IO b
withContextAndSelectors AcceptNoTargets
RejectNoTargets (forall a. a -> Maybe a
Just ComponentKindFilter
ExeKind) NixStyleFlags ()
flags [[Char]
target] GlobalFlags
globalFlags CurrentCommand
OtherCommand forall a b. (a -> b) -> a -> b
$ \TargetContext
targetCtx ProjectBaseContext
ctx [TargetSelector]
targetSelectors -> do
    ProjectBaseContext
baseCtx <- case TargetContext
targetCtx of
      TargetContext
ProjectContext             -> forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext
ctx
      TargetContext
GlobalContext              -> 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 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 <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Verbosity -> [ListBinTargetProblem] -> IO a
reportTargetProblems Verbosity
verbosity) forall (m :: * -> *) a. Monad m => a -> m a
return
                     forall a b. (a -> b) -> a -> b
$ 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
                         forall k.
TargetSelector
-> [AvailableTarget k] -> Either ListBinTargetProblem [k]
selectPackageTargets
                         forall k.
SubComponentTarget
-> AvailableTarget k -> Either ListBinTargetProblem k
selectComponentTarget
                         ElaboratedInstallPlan
elaboratedPlan
                         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
                   (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
            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
        (forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
"No or multiple targets given, but the run "
                       forall a. [a] -> [a] -> [a]
++ [Char]
"phase has been reached. This is a bug.")
        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 forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
selectedUnitId forall a b. (a -> b) -> a -> b
$ forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> Map UnitId (GenericPlanPackage ipkg srcpkg)
IP.toMap (ProjectBuildContext -> ElaboratedInstallPlan
elaboratedPlanOriginal ProjectBuildContext
buildCtx) of
        Maybe
  (GenericPlanPackage
     InstalledPackageInfo ElaboratedConfiguredPackage)
Nothing  -> forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity [Char]
"No or multiple targets given..."
        Just GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
gpp -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
IP.foldPlanPackage
            (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
        []     -> forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity [Char]
"No target found"
        [[Char]
exe]  -> [Char] -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ Verbosity -> [Char] -> [Char]
withOutputMarker Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [Char]
exe 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]]
_ -> forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity [Char]
"Multiple targets found"
  where
    defaultVerbosity :: Verbosity
defaultVerbosity = Verbosity -> Verbosity
verboseStderr Verbosity
silent
    verbosity :: Verbosity
verbosity = forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
defaultVerbosity (ConfigFlags -> Flag Verbosity
configVerbosity 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], [ConfiguredId])
_) <- forall a. ComponentDeps a -> [ComponentDep a]
CD.toList forall a b. (a -> b) -> a -> b
$ forall a b.
(Monoid a, Monoid b) =>
ComponentDeps a -> ComponentDeps b -> ComponentDeps (a, b)
CD.zip (ElaboratedPackage -> ComponentDeps [ConfiguredId]
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 forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [forall {a}. Pretty a => a -> [Char]
bin_file' UnqualComponentName
s]
            CD.ComponentTest UnqualComponentName
s
               | UnqualComponentName
s forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [forall {a}. Pretty a => a -> [Char]
bin_file' UnqualComponentName
s]
            CD.ComponentBench UnqualComponentName
s
               | UnqualComponentName
s forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [forall {a}. Pretty a => a -> [Char]
bin_file' UnqualComponentName
s]
            CD.ComponentFLib UnqualComponentName
s
               | UnqualComponentName
s forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [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 ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly
            then [Char]
dist_dir [Char] -> [Char] -> [Char]
</> [Char]
"build" [Char] -> [Char] -> [Char]
</> forall {a}. Pretty a => a -> [Char]
prettyShow a
s [Char] -> [Char] -> [Char]
</> forall {a}. Pretty a => a -> [Char]
prettyShow a
s [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
exeExtension Platform
plat
            else forall dir. InstallDirs dir -> dir
InstallDirs.bindir (ElaboratedConfiguredPackage -> InstallDirs [Char]
elabInstallDirs ElaboratedConfiguredPackage
elab) [Char] -> [Char] -> [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 ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly
            then [Char]
dist_dir [Char] -> [Char] -> [Char]
</> [Char]
"build" [Char] -> [Char] -> [Char]
</> forall {a}. Pretty a => a -> [Char]
prettyShow a
s [Char] -> [Char] -> [Char]
</> ([Char]
"lib" forall a. [a] -> [a] -> [a]
++ forall {a}. Pretty a => a -> [Char]
prettyShow a
s) [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
dllExtension Platform
plat
            else forall dir. InstallDirs dir -> dir
InstallDirs.bindir (ElaboratedConfiguredPackage -> InstallDirs [Char]
elabInstallDirs ElaboratedConfiguredPackage
elab) [Char] -> [Char] -> [Char]
</> ([Char]
"lib" forall a. [a] -> [a] -> [a]
++ forall {a}. Pretty a => a -> [Char]
prettyShow a
s) [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
dllExtension Platform
plat

-------------------------------------------------------------------------------
-- 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 forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetsMap -> Set (UnitId, ComponentName)
distinctTargetComponents forall a b. (a -> b) -> a -> b
$ TargetsMap
targetsMap
  of [(UnitId
unitId, CExeName UnqualComponentName
component)] -> forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
     [(UnitId
unitId, CTestName UnqualComponentName
component)] -> forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
     [(UnitId
unitId, CBenchName UnqualComponentName
component)] -> forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
     [(UnitId
unitId, CFLibName UnqualComponentName
component)] -> 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
  = 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
  = forall a b. b -> Either a b
Right [k
target]

    -- but fail if there are multiple buildable executables.
  | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
targetsExeLikesBuildable)
  = 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget ()]
targetsExeLikes')
  = forall a b. a -> Either a b
Left (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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget k]
targets)
  = 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
  = forall a b. a -> Either a b
Left (forall a. TargetSelector -> TargetProblem a
TargetProblemNoTargets TargetSelector
targetSelector)
  where
    -- Targets that are precisely executables
    targetsExes :: [AvailableTarget k]
targetsExes = forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
ExeKind [AvailableTarget k]
targets
    targetsExesBuildable :: [k]
targetsExesBuildable = forall k. [AvailableTarget k] -> [k]
selectBuildableTargets [AvailableTarget k]
targetsExes

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

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

    targetsExeLikes' :: [AvailableTarget ()]
targetsExeLikes'             = 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 forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t
    of CExeName UnqualComponentName
_ -> forall {a}. Either (TargetProblem a) k
component
       CTestName UnqualComponentName
_ -> forall {a}. Either (TargetProblem a) k
component
       CBenchName UnqualComponentName
_ -> forall {a}. Either (TargetProblem a) k
component
       CFLibName UnqualComponentName
_ -> forall {a}. Either (TargetProblem a) k
component
       ComponentName
_ -> forall a b. a -> Either a b
Left (PackageId -> ComponentName -> ListBinTargetProblem
componentNotRightKindProblem PackageId
pkgid ComponentName
cname)
    where pkgid :: PackageId
pkgid = forall k. AvailableTarget k -> PackageId
availableTargetPackageId AvailableTarget k
t
          cname :: ComponentName
cname = forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t
          component :: Either (TargetProblem a) k
component = forall k a.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic SubComponentTarget
subtarget AvailableTarget k
t

selectComponentTarget SubComponentTarget
subtarget AvailableTarget k
t
  = forall a b. a -> Either a b
Left (PackageId
-> ComponentName -> SubComponentTarget -> ListBinTargetProblem
isSubComponentProblem (forall k. AvailableTarget k -> PackageId
availableTargetPackageId AvailableTarget k
t)
           (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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBinProblem -> ListBinProblem -> Bool
$c/= :: ListBinProblem -> ListBinProblem -> Bool
== :: ListBinProblem -> ListBinProblem -> Bool
$c== :: ListBinProblem -> ListBinProblem -> Bool
Eq, Int -> ListBinProblem -> [Char] -> [Char]
[ListBinProblem] -> [Char] -> [Char]
ListBinProblem -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [ListBinProblem] -> [Char] -> [Char]
$cshowList :: [ListBinProblem] -> [Char] -> [Char]
show :: ListBinProblem -> [Char]
$cshow :: ListBinProblem -> [Char]
showsPrec :: Int -> ListBinProblem -> [Char] -> [Char]
$cshowsPrec :: Int -> ListBinProblem -> [Char] -> [Char]
Show)

type ListBinTargetProblem = TargetProblem ListBinProblem

noComponentsProblem :: TargetSelector -> ListBinTargetProblem
noComponentsProblem :: TargetSelector -> ListBinTargetProblem
noComponentsProblem = forall a. a -> TargetProblem a
CustomTargetProblem 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 = forall a. a -> TargetProblem a
CustomTargetProblem forall a b. (a -> b) -> a -> b
$
    TargetSelector -> [AvailableTarget ()] -> ListBinProblem
TargetProblemMatchesMultiple TargetSelector
selector [AvailableTarget ()]
targets

multipleTargetsProblem :: TargetsMap -> TargetProblem ListBinProblem
multipleTargetsProblem :: TargetsMap -> ListBinTargetProblem
multipleTargetsProblem = forall a. a -> TargetProblem a
CustomTargetProblem 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 = forall a. a -> TargetProblem a
CustomTargetProblem 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 = forall a. a -> TargetProblem a
CustomTargetProblem 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 =
    forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Eq a => a -> a -> Bool
/= ComponentKindFilter
ExeKind
        -> [Char]
"The list-bin command is for finding binaries, but the target '"
           forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
           forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ [Char]
"."

      Maybe ComponentKindFilter
_ -> [Char] -> TargetSelector -> [Char]
renderTargetProblemNoTargets [Char]
"list-bin" TargetSelector
targetSelector
renderListBinTargetProblem ListBinTargetProblem
problem =
    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 '"
 forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
 forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ [Char]
" which includes "
 forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
renderListCommaAnd ( ([Char]
"the "forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         ComponentName -> [Char]
showComponentName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         forall k. AvailableTarget k -> ComponentName
availableTargetComponentName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                           (\ComponentKindFilter
kind -> forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
kind [AvailableTarget ()]
targets)
                           [ComponentKindFilter
ExeKind, ComponentKindFilter
TestKind, ComponentKindFilter
BenchKind] )
 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 "
 forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
renderListCommaAnd [ [Char]
"'" forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
ts forall a. [a] -> [a] -> [a]
++ [Char]
"'"
                       | TargetSelector
ts <- TargetsMap -> [TargetSelector]
uniqueTargetSelectors TargetsMap
selectorMap ]
 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 '"
 forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
 forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ [Char]
" from the package "
 forall a. [a] -> [a] -> [a]
++ forall {a}. Pretty a => a -> [Char]
prettyShow PackageId
pkgid 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, "
 forall a. [a] -> [a] -> [a]
++ [Char]
"not files or modules within them, but the target '"
 forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
 forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector 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 '" forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
 forall a. [a] -> [a] -> [a]
++ [Char]
"' which refers to " forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
 forall a. [a] -> [a] -> [a]
++ [Char]
" because "
 forall a. [a] -> [a] -> [a]
++ forall a. Plural -> a -> a -> a
plural (TargetSelector -> Plural
targetSelectorPluralPkgs TargetSelector
targetSelector) [Char]
"it does" [Char]
"they do"
 forall a. [a] -> [a] -> [a]
++ [Char]
" not contain any executables or foreign libraries."