{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Distribution.Client.CmdListBin (
listbinCommand,
listbinAction,
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', 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
listbinCommand :: CommandUI (NixStyleFlags ())
listbinCommand :: CommandUI (NixStyleFlags ())
listbinCommand = CommandUI :: forall flags.
String
-> String
-> (String -> String)
-> Maybe (String -> String)
-> Maybe (String -> String)
-> flags
-> (ShowOrParseArgs -> [OptionField flags])
-> CommandUI flags
CommandUI
{ commandName :: String
commandName = String
"list-bin"
, commandSynopsis :: String
commandSynopsis = String
"List the path to a single executable."
, commandUsage :: String -> String
commandUsage = \String
pname ->
String
"Usage: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" list-bin [FLAGS] TARGET\n"
, commandDescription :: Maybe (String -> String)
commandDescription = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
_ -> String -> String
wrapText
String
"List the path to a build product."
, commandNotes :: Maybe (String -> String)
commandNotes = Maybe (String -> String)
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 [])
}
listbinAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
listbinAction :: NixStyleFlags () -> [String] -> 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
..} [String]
args GlobalFlags
globalFlags = do
String
target <- case [String]
args of
[] -> Verbosity -> String -> IO String
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"One target is required, none provided"
[String
x] -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
[String]
_ -> Verbosity -> String -> IO String
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"One target is required, given multiple"
AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags ()
-> [String]
-> GlobalFlags
-> (TargetContext
-> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b.
AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags a
-> [String]
-> GlobalFlags
-> (TargetContext
-> ProjectBaseContext -> [TargetSelector] -> IO b)
-> IO b
withContextAndSelectors AcceptNoTargets
RejectNoTargets (ComponentKind -> Maybe ComponentKind
forall a. a -> Maybe a
Just ComponentKind
ExeKind) NixStyleFlags ()
flags [String
target] GlobalFlags
globalFlags ((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 (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext
ctx
TargetContext
GlobalContext -> ProjectBaseContext -> IO ProjectBaseContext
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext
ctx
ScriptContext String
path Executable
exemeta -> ProjectBaseContext -> String -> Executable -> IO ProjectBaseContext
updateContextAndWriteProjectFile ProjectBaseContext
ctx String
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
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 (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
forall k.
TargetSelector
-> [AvailableTarget k] -> Either ListBinTargetProblem [k]
selectPackageTargets
forall k.
SubComponentTarget
-> AvailableTarget k -> Either ListBinTargetProblem k
selectComponentTarget
ElaboratedInstallPlan
elaboratedPlan
Maybe SourcePackageDb
forall a. Maybe a
Nothing
[TargetSelector]
targetSelectors
(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 (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
elaboratedPlan', TargetsMap
targets)
(UnitId
selectedUnitId, UnqualComponentName
selectedComponent) <-
IO (UnitId, UnqualComponentName)
-> TargetsMap -> IO (UnitId, UnqualComponentName)
singleComponentOrElse
(Verbosity -> String -> IO (UnitId, UnqualComponentName)
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO (UnitId, UnqualComponentName))
-> String -> IO (UnitId, UnqualComponentName)
forall a b. (a -> b) -> a -> b
$ String
"No or multiple targets given, but the run "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"phase has been reached. This is a bug.")
(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
[String]
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 -> String -> IO [String]
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"No or multiple targets given..."
Just GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
gpp -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (InstalledPackageInfo -> [String])
-> (ElaboratedConfiguredPackage -> [String])
-> GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
-> [String]
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
IP.foldPlanPackage
([String] -> InstalledPackageInfo -> [String]
forall a b. a -> b -> a
const [])
(DistDirLayout
-> ElaboratedSharedConfig
-> UnqualComponentName
-> ElaboratedConfiguredPackage
-> [String]
elaboratedPackage (ProjectBaseContext -> DistDirLayout
distDirLayout ProjectBaseContext
baseCtx) (ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared ProjectBuildContext
buildCtx) UnqualComponentName
selectedComponent)
GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
gpp
case [String]
binfiles of
[] -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"No target found"
[String
exe] -> String -> IO ()
putStrLn String
exe
[String]
_ -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"Multiple targets found"
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 (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
elaboratedPackage
:: DistDirLayout
-> ElaboratedSharedConfig
-> UnqualComponentName
-> ElaboratedConfiguredPackage
-> [FilePath]
elaboratedPackage :: DistDirLayout
-> ElaboratedSharedConfig
-> UnqualComponentName
-> ElaboratedConfiguredPackage
-> [String]
elaboratedPackage DistDirLayout
distDirLayout ElaboratedSharedConfig
elaboratedSharedConfig UnqualComponentName
selectedComponent ElaboratedConfiguredPackage
elab = case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
ElabPackage ElaboratedPackage
pkg ->
[ String
bin
| (Component
c, ([ConfiguredId], [ConfiguredId])
_) <- ComponentDeps ([ConfiguredId], [ConfiguredId])
-> [(Component, ([ConfiguredId], [ConfiguredId]))]
forall a. ComponentDeps a -> [ComponentDep a]
CD.toList (ComponentDeps ([ConfiguredId], [ConfiguredId])
-> [(Component, ([ConfiguredId], [ConfiguredId]))])
-> ComponentDeps ([ConfiguredId], [ConfiguredId])
-> [(Component, ([ConfiguredId], [ConfiguredId]))]
forall a b. (a -> b) -> a -> b
$ ComponentDeps [ConfiguredId]
-> ComponentDeps [ConfiguredId]
-> ComponentDeps ([ConfiguredId], [ConfiguredId])
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)
, String
bin <- Component -> [String]
bin_file Component
c
]
ElabComponent ElaboratedComponent
comp -> Component -> [String]
bin_file (ElaboratedComponent -> Component
compSolverName ElaboratedComponent
comp)
where
dist_dir :: String
dist_dir = DistDirLayout -> DistDirParams -> String
distBuildDirectory DistDirLayout
distDirLayout (ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
elaboratedSharedConfig ElaboratedConfiguredPackage
elab)
bin_file :: Component -> [String]
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 -> String
forall a. Pretty a => a -> String
bin_file' UnqualComponentName
s]
CD.ComponentTest UnqualComponentName
s
| UnqualComponentName
s UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [UnqualComponentName -> String
forall a. Pretty a => a -> String
bin_file' UnqualComponentName
s]
CD.ComponentBench UnqualComponentName
s
| UnqualComponentName
s UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [UnqualComponentName -> String
forall a. Pretty a => a -> String
bin_file' UnqualComponentName
s]
CD.ComponentFLib UnqualComponentName
s
| UnqualComponentName
s UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName
selectedComponent -> [UnqualComponentName -> String
forall a. Pretty a => a -> String
flib_file' UnqualComponentName
s]
Component
_ -> []
plat :: Platform
plat :: Platform
plat = ElaboratedSharedConfig -> Platform
pkgConfigPlatform ElaboratedSharedConfig
elaboratedSharedConfig
bin_file' :: a -> String
bin_file' a
s =
if ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab BuildStyle -> BuildStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly
then String
dist_dir String -> String -> String
</> String
"build" String -> String -> String
</> a -> String
forall a. Pretty a => a -> String
prettyShow a
s String -> String -> String
</> a -> String
forall a. Pretty a => a -> String
prettyShow a
s String -> String -> String
<.> Platform -> String
exeExtension Platform
plat
else InstallDirs String -> String
forall dir. InstallDirs dir -> dir
InstallDirs.bindir (ElaboratedConfiguredPackage -> InstallDirs String
elabInstallDirs ElaboratedConfiguredPackage
elab) String -> String -> String
</> a -> String
forall a. Pretty a => a -> String
prettyShow a
s String -> String -> String
<.> Platform -> String
exeExtension Platform
plat
flib_file' :: a -> String
flib_file' a
s =
if ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab BuildStyle -> BuildStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly
then String
dist_dir String -> String -> String
</> String
"build" String -> String -> String
</> a -> String
forall a. Pretty a => a -> String
prettyShow a
s String -> String -> String
</> (String
"lib" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
prettyShow a
s) String -> String -> String
<.> Platform -> String
dllExtension Platform
plat
else InstallDirs String -> String
forall dir. InstallDirs dir -> dir
InstallDirs.bindir (ElaboratedConfiguredPackage -> InstallDirs String
elabInstallDirs ElaboratedConfiguredPackage
elab) String -> String -> String
</> (String
"lib" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
prettyShow a
s) String -> String -> String
<.> Platform -> String
dllExtension Platform
plat
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 (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
[(UnitId
unitId, CTestName UnqualComponentName
component)] -> (UnitId, UnqualComponentName) -> IO (UnitId, UnqualComponentName)
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
[(UnitId
unitId, CBenchName UnqualComponentName
component)] -> (UnitId, UnqualComponentName) -> IO (UnitId, UnqualComponentName)
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
[(UnitId
unitId, CFLibName UnqualComponentName
component)] -> (UnitId, UnqualComponentName) -> IO (UnitId, UnqualComponentName)
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
[(UnitId, ComponentName)]
_ -> IO (UnitId, UnqualComponentName)
action
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either ListBinTargetProblem [k]
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either ListBinTargetProblem [k]
selectPackageTargets TargetSelector
targetSelector [AvailableTarget k]
targets
| [k
target] <- [k]
targetsExesBuildable
= [k] -> Either ListBinTargetProblem [k]
forall a b. b -> Either a b
Right [k
target]
| [k
target] <- [k]
targetsExeLikesBuildable
= [k] -> Either ListBinTargetProblem [k]
forall a b. b -> Either a b
Right [k
target]
| Bool -> Bool
not ([k] -> 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')
| Bool -> Bool
not ([AvailableTarget ()] -> 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')
| Bool -> Bool
not ([AvailableTarget k] -> 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)
| 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
targetsExes :: [AvailableTarget k]
targetsExes = ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKind
ExeKind [AvailableTarget k]
targets
targetsExesBuildable :: [k]
targetsExesBuildable = [AvailableTarget k] -> [k]
forall k. [AvailableTarget k] -> [k]
selectBuildableTargets [AvailableTarget k]
targetsExes
targetsExeLikes :: [AvailableTarget k]
targetsExeLikes = [AvailableTarget k]
targetsExes
[AvailableTarget k] -> [AvailableTarget k] -> [AvailableTarget k]
forall a. [a] -> [a] -> [a]
++ ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKind
TestKind [AvailableTarget k]
targets
[AvailableTarget k] -> [AvailableTarget k] -> [AvailableTarget k]
forall a. [a] -> [a] -> [a]
++ ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKind
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
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either ListBinTargetProblem k
selectComponentTarget :: 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)
data ListBinProblem =
TargetProblemNoRightComps TargetSelector
| TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()]
| TargetProblemMultipleTargets TargetsMap
| TargetProblemComponentNotRightKind PackageId ComponentName
| 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
/= :: ListBinProblem -> ListBinProblem -> Bool
$c/= :: ListBinProblem -> ListBinProblem -> Bool
== :: ListBinProblem -> ListBinProblem -> Bool
$c== :: ListBinProblem -> ListBinProblem -> Bool
Eq, Int -> ListBinProblem -> String -> String
[ListBinProblem] -> String -> String
ListBinProblem -> String
(Int -> ListBinProblem -> String -> String)
-> (ListBinProblem -> String)
-> ([ListBinProblem] -> String -> String)
-> Show ListBinProblem
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ListBinProblem] -> String -> String
$cshowList :: [ListBinProblem] -> String -> String
show :: ListBinProblem -> String
$cshow :: ListBinProblem -> String
showsPrec :: Int -> ListBinProblem -> String -> String
$cshowsPrec :: Int -> ListBinProblem -> String -> String
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 :: Verbosity -> [ListBinTargetProblem] -> IO a
reportTargetProblems Verbosity
verbosity =
Verbosity -> String -> IO a
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO a)
-> ([ListBinTargetProblem] -> String)
-> [ListBinTargetProblem]
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> ([ListBinTargetProblem] -> [String])
-> [ListBinTargetProblem]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListBinTargetProblem -> String)
-> [ListBinTargetProblem] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ListBinTargetProblem -> String
renderListBinTargetProblem
renderListBinTargetProblem :: ListBinTargetProblem -> String
renderListBinTargetProblem :: ListBinTargetProblem -> String
renderListBinTargetProblem (TargetProblemNoTargets TargetSelector
targetSelector) =
case TargetSelector -> Maybe ComponentKind
targetSelectorFilter TargetSelector
targetSelector of
Just ComponentKind
kind | ComponentKind
kind ComponentKind -> ComponentKind -> Bool
forall a. Eq a => a -> a -> Bool
/= ComponentKind
ExeKind
-> String
"The list-bin command is for finding binaries, but the target '"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' refers to "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
Maybe ComponentKind
_ -> String -> TargetSelector -> String
renderTargetProblemNoTargets String
"list-bin" TargetSelector
targetSelector
renderListBinTargetProblem ListBinTargetProblem
problem =
String
-> (ListBinProblem -> String) -> ListBinTargetProblem -> String
forall a. String -> (a -> String) -> TargetProblem a -> String
renderTargetProblem String
"list-bin" ListBinProblem -> String
renderListBinProblem ListBinTargetProblem
problem
renderListBinProblem :: ListBinProblem -> String
renderListBinProblem :: ListBinProblem -> String
renderListBinProblem (TargetProblemMatchesMultiple TargetSelector
targetSelector [AvailableTarget ()]
targets) =
String
"The list-bin command is for finding a single binary at once. The target '"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' refers to "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" which includes "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
renderListCommaAnd ( (String
"the "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (ComponentName -> String) -> ComponentName -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ComponentName -> String
showComponentName (ComponentName -> String)
-> (AvailableTarget () -> ComponentName)
-> AvailableTarget ()
-> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
AvailableTarget () -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName (AvailableTarget () -> String) -> [AvailableTarget ()] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(ComponentKind -> [AvailableTarget ()])
-> [ComponentKind] -> [AvailableTarget ()]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
(\ComponentKind
kind -> ComponentKind -> [AvailableTarget ()] -> [AvailableTarget ()]
forall k.
ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKind
kind [AvailableTarget ()]
targets)
[ComponentKind
ExeKind, ComponentKind
TestKind, ComponentKind
BenchKind] )
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
renderListBinProblem (TargetProblemMultipleTargets TargetsMap
selectorMap) =
String
"The list-bin command is for finding a single binary at once. The targets "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
renderListCommaAnd [ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
ts String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
| TargetSelector
ts <- TargetsMap -> [TargetSelector]
uniqueTargetSelectors TargetsMap
selectorMap ]
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" refer to different executables."
renderListBinProblem (TargetProblemComponentNotRightKind PackageId
pkgid ComponentName
cname) =
String
"The list-bin command is for finding binaries, but the target '"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' refers to "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from the package "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageId -> String
forall a. Pretty a => a -> String
prettyShow PackageId
pkgid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
where
targetSelector :: TargetSelector
targetSelector = PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pkgid ComponentName
cname SubComponentTarget
WholeComponent
renderListBinProblem (TargetProblemIsSubComponent PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget) =
String
"The list-bin command can only find a binary as a whole, "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"not files or modules within them, but the target '"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' refers to "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
where
targetSelector :: TargetSelector
targetSelector = PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget
renderListBinProblem (TargetProblemNoRightComps TargetSelector
targetSelector) =
String
"Cannot list-bin the target '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' which refers to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" because "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Plural -> String -> String -> String
forall a. Plural -> a -> a -> a
plural (TargetSelector -> Plural
targetSelectorPluralPkgs TargetSelector
targetSelector) String
"it does" String
"they do"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not contain any executables or foreign libraries."