{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Client.CmdTarget
( targetCommand
, targetAction
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import qualified Data.Map as Map
import Distribution.Client.CmdBuild (selectComponentTarget, selectPackageTargets)
import Distribution.Client.CmdErrorMessages
import Distribution.Client.InstallPlan
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..)
, defaultNixStyleFlags
, nixStyleOptions
)
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning
import Distribution.Client.Setup
( ConfigFlags (..)
, GlobalFlags
)
import Distribution.Client.TargetProblem
( TargetProblem'
)
import Distribution.Package
import Distribution.Simple.Command
( CommandUI (..)
, usageAlternatives
)
import Distribution.Simple.Flag (fromFlagOrDefault)
import Distribution.Simple.Utils
( noticeDoc
, safeHead
, wrapText
)
import Distribution.Verbosity
( normal
)
import Text.PrettyPrint
import qualified Text.PrettyPrint as Pretty
targetCommand :: CommandUI (NixStyleFlags ())
targetCommand :: CommandUI (NixStyleFlags ())
targetCommand =
CommandUI
{ commandName :: String
commandName = String
"v2-target"
, commandSynopsis :: String
commandSynopsis = String
"Target a subset of all targets."
, commandUsage :: String -> String
commandUsage = String -> [String] -> String -> String
usageAlternatives String
"v2-target" [String
"[TARGETS]"]
, commandDescription :: Maybe (String -> String)
commandDescription =
(String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (Doc -> String -> String) -> Doc -> Maybe (String -> String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a b. a -> b -> a
const (String -> String -> String)
-> (Doc -> String) -> Doc -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render (Doc -> Maybe (String -> String))
-> Doc -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
vcat
[ Doc
intro
, [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
"\n") [Doc
targetForms, Doc
ctypes, Doc
Pretty.empty]
, Doc
caution
, Doc
unique
]
, commandNotes :: Maybe (String -> String)
commandNotes = (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
pname -> Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ String -> Doc
examples String
pname
, 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 [])
}
where
intro :: Doc
intro =
String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
wrapText (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
String
"Discover targets in a project for use with other commands taking [TARGETS].\n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"This command, like many others, takes [TARGETS]. Taken together, these will"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" select for a set of targets in the project. When none are supplied, the"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" command acts as if 'all' was supplied."
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Targets in the returned subset are shown sorted and fully-qualified."
targetForms :: Doc
targetForms =
[Doc] -> Doc
vcat
[ String -> Doc
text String
"A [TARGETS] item can be one of these target forms:"
, Int -> Doc -> Doc
nest Int
1 (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
(Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<+>)
(Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ String -> Doc
text String
"a package target (e.g. [pkg:]package)"
, String -> Doc
text String
"a component target (e.g. [package:][ctype:]component)"
, String -> Doc
text String
"all packages (e.g. all)"
, String -> Doc
text String
"components of a particular type (e.g. package:ctypes or all:ctypes)"
, String -> Doc
text String
"a module target: (e.g. [package:][ctype:]module)"
, String -> Doc
text String
"a filepath target: (e.g. [package:][ctype:]filepath)"
]
]
ctypes :: Doc
ctypes =
[Doc] -> Doc
vcat
[ String -> Doc
text String
"The ctypes, in short form and (long form), can be one of:"
, Int -> Doc -> Doc
nest Int
1 (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
(Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<+>)
(Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Doc
"libs" Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
"libraries"
, Doc
"exes" Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
"executables"
, Doc
"tests"
, Doc
"benches" Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
"benchmarks"
, Doc
"flibs" Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
"foreign-libraries"
]
]
caution :: Doc
caution =
String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
wrapText (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
String
"WARNING: For a package, all, module or filepath target, cabal target [TARGETS] \
\ will only show 'libs' and 'exes' of the [TARGETS] by default. To also show \
\ tests and benchmarks, enable them with '--enable-tests' and \
\ '--enable-benchmarks'."
unique :: Doc
unique =
String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
wrapText (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
String
"NOTE: For commands expecting a unique TARGET, a fully-qualified target is the safe \
\ way to go but it may be convenient to type out a shorter TARGET. For example, if the \
\ set of 'cabal target all:exes' has one item then 'cabal list-bin all:exes' will \
\ work too."
examples :: String -> Doc
examples String
pname =
[Doc] -> Doc
vcat
[ String -> Doc
text String
"Examples" Doc -> Doc -> Doc
Pretty.<> Doc
colon
, Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
vcat
[ [Doc] -> Doc
vcat
[ String -> Doc
text String
pname Doc -> Doc -> Doc
<+> String -> Doc
text String
"v2-target all"
, Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Targets of the package in the current directory or all packages in the project"
]
, [Doc] -> Doc
vcat
[ String -> Doc
text String
pname Doc -> Doc -> Doc
<+> String -> Doc
text String
"v2-target pkgname"
, Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Targets of the package named pkgname in the project"
]
, [Doc] -> Doc
vcat
[ String -> Doc
text String
pname Doc -> Doc -> Doc
<+> String -> Doc
text String
"v2-target ./pkgfoo"
, Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Targets of the package in the ./pkgfoo directory"
]
, [Doc] -> Doc
vcat
[ String -> Doc
text String
pname Doc -> Doc -> Doc
<+> String -> Doc
text String
"v2-target cname"
, Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Targets of the component named cname in the project"
]
]
]
targetAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
targetAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
targetAction 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 :: ()
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
..} [String]
ts GlobalFlags
globalFlags = do
ProjectBaseContext
{ DistDirLayout
distDirLayout :: DistDirLayout
distDirLayout :: ProjectBaseContext -> DistDirLayout
distDirLayout
, CabalDirLayout
cabalDirLayout :: CabalDirLayout
cabalDirLayout :: ProjectBaseContext -> CabalDirLayout
cabalDirLayout
, ProjectConfig
projectConfig :: ProjectConfig
projectConfig :: ProjectBaseContext -> ProjectConfig
projectConfig
, [PackageSpecifier UnresolvedSourcePackage]
localPackages :: [PackageSpecifier UnresolvedSourcePackage]
localPackages :: ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages
} <-
Verbosity
-> ProjectConfig -> CurrentCommand -> IO ProjectBaseContext
establishProjectBaseContext Verbosity
verbosity ProjectConfig
cliConfig CurrentCommand
OtherCommand
(ElaboratedInstallPlan
_, ElaboratedInstallPlan
elaboratedPlan, ElaboratedSharedConfig
_, TotalIndexState
_, ActiveRepos
_) <-
Verbosity
-> DistDirLayout
-> CabalDirLayout
-> ProjectConfig
-> [PackageSpecifier UnresolvedSourcePackage]
-> Maybe InstalledPackageIndex
-> IO
(ElaboratedInstallPlan, ElaboratedInstallPlan,
ElaboratedSharedConfig, TotalIndexState, ActiveRepos)
rebuildInstallPlan
Verbosity
verbosity
DistDirLayout
distDirLayout
CabalDirLayout
cabalDirLayout
ProjectConfig
projectConfig
[PackageSpecifier UnresolvedSourcePackage]
localPackages
Maybe InstalledPackageIndex
forall a. Maybe a
Nothing
[TargetSelector]
targetSelectors <-
([TargetSelectorProblem] -> IO [TargetSelector])
-> ([TargetSelector] -> IO [TargetSelector])
-> Either [TargetSelectorProblem] [TargetSelector]
-> IO [TargetSelector]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> [TargetSelectorProblem] -> IO [TargetSelector]
forall a. Verbosity -> [TargetSelectorProblem] -> IO a
reportTargetSelectorProblems Verbosity
verbosity) [TargetSelector] -> IO [TargetSelector]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Either [TargetSelectorProblem] [TargetSelector]
-> IO [TargetSelector])
-> IO (Either [TargetSelectorProblem] [TargetSelector])
-> IO [TargetSelector]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [PackageSpecifier UnresolvedSourcePackage]
-> Maybe ComponentKindFilter
-> [String]
-> IO (Either [TargetSelectorProblem] [TargetSelector])
forall a.
[PackageSpecifier (SourcePackage (PackageLocation a))]
-> Maybe ComponentKindFilter
-> [String]
-> IO (Either [TargetSelectorProblem] [TargetSelector])
readTargetSelectors [PackageSpecifier UnresolvedSourcePackage]
localPackages Maybe ComponentKindFilter
forall a. Maybe a
Nothing [String]
targetStrings
TargetsMap
targets :: TargetsMap <-
([TargetProblem'] -> IO TargetsMap)
-> (TargetsMap -> IO TargetsMap)
-> Either [TargetProblem'] TargetsMap
-> IO TargetsMap
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> [TargetProblem'] -> IO TargetsMap
forall a. Verbosity -> [TargetProblem'] -> IO a
reportBuildTargetProblems Verbosity
verbosity) TargetsMap -> IO TargetsMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [TargetProblem'] TargetsMap -> IO TargetsMap)
-> Either [TargetProblem'] TargetsMap -> IO TargetsMap
forall a b. (a -> b) -> a -> b
$
(forall k.
TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k])
-> (forall k.
SubComponentTarget -> AvailableTarget k -> Either TargetProblem' k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem'] 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
resolveTargetsFromSolver
TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k]
forall k.
TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k]
selectPackageTargets
SubComponentTarget -> AvailableTarget k -> Either TargetProblem' k
forall k.
SubComponentTarget -> AvailableTarget k -> Either TargetProblem' k
selectComponentTarget
ElaboratedInstallPlan
elaboratedPlan
Maybe SourcePackageDb
forall a. Maybe a
Nothing
[TargetSelector]
targetSelectors
Verbosity
-> [String] -> TargetsMap -> ElaboratedInstallPlan -> IO ()
printTargetForms Verbosity
verbosity [String]
targetStrings TargetsMap
targets ElaboratedInstallPlan
elaboratedPlan
where
verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
targetStrings :: [String]
targetStrings = if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ts then [String
"all"] else [String]
ts
cliConfig :: ProjectConfig
cliConfig =
GlobalFlags
-> NixStyleFlags () -> ClientInstallFlags -> ProjectConfig
forall a.
GlobalFlags
-> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig
commandLineFlagsToProjectConfig
GlobalFlags
globalFlags
NixStyleFlags ()
flags
ClientInstallFlags
forall a. Monoid a => a
mempty
reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
reportBuildTargetProblems :: forall a. Verbosity -> [TargetProblem'] -> IO a
reportBuildTargetProblems Verbosity
verbosity = Verbosity -> String -> [TargetProblem'] -> IO a
forall a. Verbosity -> String -> [TargetProblem'] -> IO a
reportTargetProblems Verbosity
verbosity String
"target"
printTargetForms :: Verbosity -> [String] -> TargetsMap -> ElaboratedInstallPlan -> IO ()
printTargetForms :: Verbosity
-> [String] -> TargetsMap -> ElaboratedInstallPlan -> IO ()
printTargetForms Verbosity
verbosity [String]
targetStrings TargetsMap
targets ElaboratedInstallPlan
elaboratedPlan =
Verbosity -> Doc -> IO ()
noticeDoc Verbosity
verbosity (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
vcat
[ String -> Doc
text String
"Fully qualified target forms" Doc -> Doc -> Doc
Pretty.<> Doc
colon
, Int -> Doc -> Doc
nest Int
1 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [String -> Doc
text String
"-" Doc -> Doc -> Doc
<+> String -> Doc
text String
tf | String
tf <- [String]
targetForms]
, Doc
found
]
where
found :: Doc
found =
let n :: Int
n = TargetsMap -> Int
forall a. Map UnitId a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TargetsMap
targets
t :: String
t = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"target" else String
"targets"
query :: String
query = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
targetStrings
in String -> Doc
text String
"Found" Doc -> Doc -> Doc
<+> Int -> Doc
int Int
n Doc -> Doc -> Doc
<+> String -> Doc
text String
t Doc -> Doc -> Doc
<+> String -> Doc
text String
"matching" Doc -> Doc -> Doc
<+> String -> Doc
text String
query Doc -> Doc -> Doc
Pretty.<> Char -> Doc
char Char
'.'
localPkgs :: [ElaboratedConfiguredPackage]
localPkgs =
[ElaboratedConfiguredPackage
x | Configured x :: ElaboratedConfiguredPackage
x@ElaboratedConfiguredPackage{elabLocalToProject :: ElaboratedConfiguredPackage -> Bool
elabLocalToProject = Bool
True} <- ElaboratedInstallPlan
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
elaboratedPlan]
targetForm :: ComponentTarget -> ElaboratedConfiguredPackage -> String
targetForm ComponentTarget
ct ElaboratedConfiguredPackage
x =
let pkgId :: PackageId
pkgId@PackageIdentifier{pkgName :: PackageId -> PackageName
pkgName = PackageName
n} = ElaboratedConfiguredPackage -> PackageId
elabPkgSourceId ElaboratedConfiguredPackage
x
in Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
n Doc -> Doc -> Doc
Pretty.<> Doc
colon Doc -> Doc -> Doc
Pretty.<> String -> Doc
text (PackageId -> ComponentTarget -> String
showComponentTarget PackageId
pkgId ComponentTarget
ct)
targetForms :: [String]
targetForms =
[String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
[Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
[ ComponentTarget -> ElaboratedConfiguredPackage -> String
targetForm ComponentTarget
ct (ElaboratedConfiguredPackage -> String)
-> Maybe ElaboratedConfiguredPackage -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ElaboratedConfiguredPackage
pkg
| (UnitId
u :: UnitId, [(ComponentTarget, NonEmpty TargetSelector)]
xs) <- TargetsMap
-> [(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])]
forall k a. Map k a -> [(k, a)]
Map.toAscList TargetsMap
targets
, let pkg :: Maybe ElaboratedConfiguredPackage
pkg = [ElaboratedConfiguredPackage] -> Maybe ElaboratedConfiguredPackage
forall a. [a] -> Maybe a
safeHead ([ElaboratedConfiguredPackage]
-> Maybe ElaboratedConfiguredPackage)
-> [ElaboratedConfiguredPackage]
-> Maybe ElaboratedConfiguredPackage
forall a b. (a -> b) -> a -> b
$ (ElaboratedConfiguredPackage -> Bool)
-> [ElaboratedConfiguredPackage] -> [ElaboratedConfiguredPackage]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
u) (UnitId -> Bool)
-> (ElaboratedConfiguredPackage -> UnitId)
-> ElaboratedConfiguredPackage
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> UnitId
elabUnitId) [ElaboratedConfiguredPackage]
localPkgs
, (ComponentTarget
ct :: ComponentTarget, NonEmpty TargetSelector
_) <- [(ComponentTarget, NonEmpty TargetSelector)]
xs
]