Adjust args to selectComponentTarget functions

Previously they took a TargetSelector that would always be a
TargetComponent constructor, which meant that if we were interested in
the content then we'd have to do partial pattern matching. Instead they
now take all the contents of the TargetComponent as separate args which
means no partial patterns and easy access to the parts.

Also where relevant, put the TargetComponent contents into the
TargetProblemCommon and TargetProblem constructors.

cabal-install/Distribution/Client/CmdBench.hs

@@ -129,21 +129,20 @@ selectPackageTargets _bt ts
                          <- map availableTargetStatus allbenchts ]
     allbenchts'= [ fmap (const ()) t | t <- allbenchts ]
 
-
-selectComponentTarget :: TargetSelector PackageId
+selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
                       -> AvailableTarget k -> Either TargetProblem k
-selectComponentTarget bt t
+selectComponentTarget pkgid cname subtarget t
   | CBenchName _ <- availableTargetComponentName t
   = either (Left . TargetProblemCommon) return $
-           selectComponentTargetBasic bt t
+           selectComponentTargetBasic pkgid cname subtarget t
   | otherwise
-  = Left (TargetComponentNotBenchmark (fmap (const ()) t))
+  = Left (TargetComponentNotBenchmark pkgid cname)
 
 data TargetProblem =
      TargetProblemCommon        TargetProblemCommon
    | TargetPackageNoEnabledBenchmarks [AvailableTarget ()]
    | TargetPackageNoBenchmarks        [AvailableTarget ()]
-   | TargetComponentNotBenchmark      (AvailableTarget ())
+   | TargetComponentNotBenchmark      PackageId ComponentName
   deriving (Eq, Show)
 
 reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a

cabal-install/Distribution/Client/CmdBuild.hs

@@ -143,11 +143,11 @@ selectPackageTargets bt ts
 -- For checking an individual component target, for build there's no
 -- additional checks we need beyond the basic ones.
 --
-selectComponentTarget :: TargetSelector PackageId
+selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
                       -> AvailableTarget k -> Either TargetProblem k
-selectComponentTarget bt =
+selectComponentTarget pkgid cname subtarget =
     either (Left . TargetProblemCommon) Right
-  . selectComponentTargetBasic bt
+  . selectComponentTargetBasic pkgid cname subtarget
 
 data TargetProblem =
      TargetProblemCommon       TargetProblemCommon

cabal-install/Distribution/Client/CmdHaddock.hs

@@ -136,11 +136,11 @@ selectPackageTargets haddockFlags _bt ts =
 -- For checking an individual component target, for build there's no
 -- additional checks we need beyond the basic ones.
 --
-selectComponentTarget :: TargetSelector PackageId
+selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
                       -> AvailableTarget k -> Either TargetProblem k
-selectComponentTarget bt =
+selectComponentTarget pkgid cname subtarget =
     either (Left . TargetProblemCommon) Right
-  . selectComponentTargetBasic bt
+  . selectComponentTargetBasic pkgid cname subtarget
 
 data TargetProblem =
      TargetProblemCommon       TargetProblemCommon

cabal-install/Distribution/Client/CmdRepl.hs

@@ -154,11 +154,11 @@ selectPackageTargets _bt ts
 -- For checking an individual component target, for build there's no
 -- additional checks we need beyond the basic ones.
 --
-selectComponentTarget :: TargetSelector PackageId
+selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
                       -> AvailableTarget k -> Either TargetProblem k
-selectComponentTarget bt =
+selectComponentTarget pkgid cname subtarget =
     either (Left . TargetProblemCommon) Right
-  . selectComponentTargetBasic bt
+  . selectComponentTargetBasic pkgid cname subtarget
 
 data TargetProblem =
      TargetProblemCommon       TargetProblemCommon

cabal-install/Distribution/Client/CmdRun.hs

@@ -138,21 +138,21 @@ selectPackageTargets _bt ts
     allexets = [ t | t@(AvailableTarget (CExeName _) _ _) <- ts ]
     exets    = [ k | TargetBuildable k _ <- map availableTargetStatus allexets ]
 
-selectComponentTarget :: TargetSelector PackageId
+selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
                       -> AvailableTarget k -> Either TargetProblem  k
-selectComponentTarget bt t
+selectComponentTarget pkgid cname subtarget t
   | CExeName _ <- availableTargetComponentName t
   = either (Left . TargetProblemCommon) return $
-           selectComponentTargetBasic bt t
+           selectComponentTargetBasic pkgid cname subtarget t
   | otherwise
-  = Left (TargetComponentNotExe (fmap (const ()) t))
+  = Left (TargetComponentNotExe pkgid cname)
 
 data TargetProblem =
      TargetProblemCommon       TargetProblemCommon
    | TargetPackageMultipleExes
    | TargetPackageNoBuildableExes
    | TargetPackageNoTargets
-   | TargetComponentNotExe (AvailableTarget ())
+   | TargetComponentNotExe PackageId ComponentName
    | TargetsMultiple [[ComponentTarget]] --TODO: more detail needed
   deriving (Eq, Show)
 

cabal-install/Distribution/Client/CmdTest.hs

@@ -132,20 +132,20 @@ selectPackageTargets _bt ts
                          <- map availableTargetStatus alltestts ]
     alltestts' = [ fmap (const ()) t | t <- alltestts ]
 
-selectComponentTarget :: TargetSelector PackageId
+selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
                       -> AvailableTarget k -> Either TargetProblem k
-selectComponentTarget bt t
+selectComponentTarget pkgid cname subtarget t
   | CTestName _ <- availableTargetComponentName t
   = either (Left . TargetProblemCommon) return $
-           selectComponentTargetBasic bt t
+           selectComponentTargetBasic pkgid cname subtarget t
   | otherwise
-  = Left (TargetComponentNotTest (fmap (const ()) t))
+  = Left (TargetComponentNotTest pkgid cname)
 
 data TargetProblem =
      TargetProblemCommon       TargetProblemCommon
    | TargetPackageNoEnabledTests [AvailableTarget ()]
    | TargetPackageNoTests        [AvailableTarget ()]
-   | TargetComponentNotTest      (AvailableTarget ())
+   | TargetComponentNotTest      PackageId ComponentName
   deriving (Eq, Show)
 
 reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a

cabal-install/Distribution/Client/ProjectOrchestration.hs

@@ -61,6 +61,7 @@ module Distribution.Client.ProjectOrchestration (
     TargetRequested(..),
     ComponentName(..),
     ComponentTarget(..),
+    SubComponentTarget(..),
     TargetProblemCommon(..),
     selectComponentTargetBasic,
 
@@ -380,9 +381,11 @@ runProjectPostBuildPhase verbosity
 -- a basis for their own @selectComponentTarget@ implementation.
 --
 resolveTargets :: forall err.
-                  (forall k. TargetSelector PackageId -> [AvailableTarget k]
+                  (forall k. TargetSelector PackageId
+                          -> [AvailableTarget k]
                           -> Either err [k])
-               -> (forall k. TargetSelector PackageId ->  AvailableTarget k
+               -> (forall k. PackageId -> ComponentName -> SubComponentTarget
+                          -> AvailableTarget k
                           -> Either err  k )
                -> (TargetProblemCommon -> err)
                -> ElaboratedInstallPlan
@@ -431,9 +434,10 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
             Right ts -> Right [ (unitid, ComponentTarget cname WholeComponent)
                               | (unitid, cname) <- ts ]
 
-    checkTarget bt@(TargetComponent pkgid cname subtarget)
+    checkTarget (TargetComponent pkgid cname subtarget)
       | Just ats <- Map.lookup (pkgid, cname) availableTargetsByComponent
-      = case partitionEithers (map (selectComponentTarget bt) ats) of
+      = case partitionEithers
+               (map (selectComponentTarget pkgid cname subtarget) ats) of
           (e:_,_) -> Left e
           ([],ts) -> Right [ (unitid, ctarget)
                            | let ctarget = ComponentTarget cname subtarget
@@ -477,32 +481,34 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
 -- buildable and isn't a test suite or benchmark that is disabled. This
 -- can also be used to do these basic checks as part of a custom impl that
 --
-selectComponentTargetBasic :: TargetSelector PackageId
+selectComponentTargetBasic :: PackageId
+                           -> ComponentName
+                           -> SubComponentTarget
                            -> AvailableTarget k
                            -> Either TargetProblemCommon k
-selectComponentTargetBasic buildTarget AvailableTarget{..} =
+selectComponentTargetBasic pkgid cname subtarget AvailableTarget {..} =
     case availableTargetStatus of
       TargetDisabledByUser ->
-        Left (TargetOptionalStanzaDisabledByUser buildTarget)
+        Left (TargetOptionalStanzaDisabledByUser pkgid cname subtarget)
 
       TargetDisabledBySolver ->
-        Left (TargetOptionalStanzaDisabledBySolver buildTarget)
+        Left (TargetOptionalStanzaDisabledBySolver pkgid cname subtarget)
 
       TargetNotLocal ->
-        Left (TargetComponentNotProjectLocal buildTarget)
+        Left (TargetComponentNotProjectLocal pkgid cname subtarget)
 
       TargetNotBuildable ->
-        Left (TargetComponentNotBuildable buildTarget)
+        Left (TargetComponentNotBuildable pkgid cname subtarget)
 
       TargetBuildable targetKey _ ->
         Right targetKey
 
 data TargetProblemCommon
    = TargetNotInProject                   PackageName
-   | TargetComponentNotProjectLocal       (TargetSelector PackageId)
-   | TargetComponentNotBuildable          (TargetSelector PackageId)
-   | TargetOptionalStanzaDisabledByUser   (TargetSelector PackageId)
-   | TargetOptionalStanzaDisabledBySolver (TargetSelector PackageId)
+   | TargetComponentNotProjectLocal       PackageId ComponentName SubComponentTarget
+   | TargetComponentNotBuildable          PackageId ComponentName SubComponentTarget
+   | TargetOptionalStanzaDisabledByUser   PackageId ComponentName SubComponentTarget
+   | TargetOptionalStanzaDisabledBySolver PackageId ComponentName SubComponentTarget
 
     -- The target matching stuff only returns packages local to the project,
     -- so these lookups should never fail, but if 'resolveTargets' is called