Commit b0f7a9b6 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Remove reundant args of selectComponentTarget functions

The PackageId and ComponentName are already part of the existing
AvailableTarget record argument.

We need to eliminate this redundancy because for new kinds of target
selectors we will not have the PackageId and ComponentName from the
selector, only from the AvailableTarget selected.
parent 2f8abd74
......@@ -162,17 +162,20 @@ selectPackageTargets targetSelector targets
-- For the @bench@ command we just need to check it is a benchmark, in addition
-- to the basic checks on being buildable etc.
--
selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
selectComponentTarget pkgid cname subtarget@WholeComponent t
selectComponentTarget subtarget@WholeComponent t
| CBenchName _ <- availableTargetComponentName t
= either (Left . TargetProblemCommon) return $
selectComponentTargetBasic pkgid cname subtarget t
selectComponentTargetBasic subtarget t
| otherwise
= Left (TargetProblemComponentNotBenchmark pkgid cname)
= Left (TargetProblemComponentNotBenchmark (availableTargetPackageId t)
(availableTargetComponentName t))
selectComponentTarget pkgid cname subtarget _
= Left (TargetProblemIsSubComponent pkgid cname subtarget)
selectComponentTarget subtarget t
= Left (TargetProblemIsSubComponent (availableTargetPackageId t)
(availableTargetComponentName t)
subtarget)
-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @bench@ command.
......
......@@ -159,11 +159,11 @@ selectPackageTargets targetSelector targets
--
-- For the @build@ command we just need the basic checks on being buildable etc.
--
selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
selectComponentTarget pkgid cname subtarget =
selectComponentTarget subtarget =
either (Left . TargetProblemCommon) Right
. selectComponentTargetBasic pkgid cname subtarget
. selectComponentTargetBasic subtarget
-- | The various error conditions that can occur when matching a
......
......@@ -165,11 +165,11 @@ selectPackageTargets haddockFlags targetSelector targets
-- For the @haddock@ command we just need the basic checks on being buildable
-- etc.
--
selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
selectComponentTarget pkgid cname subtarget =
selectComponentTarget subtarget =
either (Left . TargetProblemCommon) Right
. selectComponentTargetBasic pkgid cname subtarget
. selectComponentTargetBasic subtarget
-- | The various error conditions that can occur when matching a
......
......@@ -299,11 +299,11 @@ selectPackageTargets targetSelector targets
--
-- For the @build@ command we just need the basic checks on being buildable etc.
--
selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
selectComponentTarget pkgid cname subtarget =
selectComponentTarget subtarget =
either (Left . TargetProblemCommon) Right
. selectComponentTargetBasic pkgid cname subtarget
. selectComponentTargetBasic subtarget
-- | The various error conditions that can occur when matching a
......
......@@ -215,11 +215,11 @@ selectPackageTargets targetSelector targets
--
-- For the @repl@ command we just need the basic checks on being buildable etc.
--
selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
selectComponentTarget pkgid cname subtarget =
selectComponentTarget subtarget =
either (Left . TargetProblemCommon) Right
. selectComponentTargetBasic pkgid cname subtarget
. selectComponentTargetBasic subtarget
-- | The various error conditions that can occur when matching a
......
......@@ -323,17 +323,20 @@ selectPackageTargets targetSelector targets
-- For the @run@ command we just need to check it is a executable, in addition
-- to the basic checks on being buildable etc.
--
selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
selectComponentTarget pkgid cname subtarget@WholeComponent t
selectComponentTarget subtarget@WholeComponent t
| CExeName _ <- availableTargetComponentName t
= either (Left . TargetProblemCommon) return $
selectComponentTargetBasic pkgid cname subtarget t
selectComponentTargetBasic subtarget t
| otherwise
= Left (TargetProblemComponentNotExe pkgid cname)
= Left (TargetProblemComponentNotExe (availableTargetPackageId t)
(availableTargetComponentName t))
selectComponentTarget pkgid cname subtarget _
= Left (TargetProblemIsSubComponent pkgid cname subtarget)
selectComponentTarget subtarget t
= Left (TargetProblemIsSubComponent (availableTargetPackageId t)
(availableTargetComponentName t)
subtarget)
-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @run@ command.
......
......@@ -165,17 +165,20 @@ selectPackageTargets targetSelector targets
-- For the @test@ command we just need to check it is a test-suite, in addition
-- to the basic checks on being buildable etc.
--
selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
selectComponentTarget pkgid cname subtarget@WholeComponent t
selectComponentTarget subtarget@WholeComponent t
| CTestName _ <- availableTargetComponentName t
= either (Left . TargetProblemCommon) return $
selectComponentTargetBasic pkgid cname subtarget t
selectComponentTargetBasic subtarget t
| otherwise
= Left (TargetProblemComponentNotTest pkgid cname)
= Left (TargetProblemComponentNotTest (availableTargetPackageId t)
(availableTargetComponentName t))
selectComponentTarget pkgid cname subtarget _
= Left (TargetProblemIsSubComponent pkgid cname subtarget)
selectComponentTarget subtarget t
= Left (TargetProblemIsSubComponent (availableTargetPackageId t)
(availableTargetComponentName t)
subtarget)
-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @test@ command.
......
......@@ -431,7 +431,7 @@ resolveTargets :: forall err.
(forall k. TargetSelector
-> [AvailableTarget k]
-> Either err [k])
-> (forall k. PackageId -> ComponentName -> SubComponentTarget
-> (forall k. SubComponentTarget
-> AvailableTarget k
-> Either err k )
-> (TargetProblemCommon -> err)
......@@ -496,7 +496,7 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
| Just ats <- Map.lookup (pkgid, cname)
availableTargetsByPackageIdAndComponentName
= case partitionEithers
(map (selectComponentTarget pkgid cname subtarget) ats) of
(map (selectComponentTarget subtarget) ats) of
(e:_,_) -> Left e
([],ts) -> Right [ (unitid, ctarget)
| let ctarget = ComponentTarget cname subtarget
......@@ -623,12 +623,15 @@ forgetTargetsDetail = map forgetTargetDetail
-- 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 :: PackageId
-> ComponentName
-> SubComponentTarget
selectComponentTargetBasic :: SubComponentTarget
-> AvailableTarget k
-> Either TargetProblemCommon k
selectComponentTargetBasic pkgid cname subtarget AvailableTarget {..} =
selectComponentTargetBasic subtarget
AvailableTarget {
availableTargetPackageId = pkgid,
availableTargetComponentName = cname,
availableTargetStatus
} =
case availableTargetStatus of
TargetDisabledByUser ->
Left (TargetOptionalStanzaDisabledByUser pkgid cname subtarget)
......
......@@ -1218,7 +1218,7 @@ assertProjectDistinctTargets
:: forall err. (Eq err, Show err) =>
ElaboratedInstallPlan
-> (forall k. TargetSelector -> [AvailableTarget k] -> Either err [k])
-> (forall k. PackageId -> ComponentName -> SubComponentTarget -> AvailableTarget k -> Either err k )
-> (forall k. SubComponentTarget -> AvailableTarget k -> Either err k )
-> (TargetProblemCommon -> err)
-> [TargetSelector]
-> [(UnitId, ComponentName)]
......@@ -1250,7 +1250,7 @@ assertProjectTargetProblems
-> (forall k. TargetSelector
-> [AvailableTarget k]
-> Either err [k])
-> (forall k. PackageId -> ComponentName -> SubComponentTarget
-> (forall k. SubComponentTarget
-> AvailableTarget k
-> Either err k )
-> (TargetProblemCommon -> err)
......@@ -1274,7 +1274,7 @@ assertTargetProblems
:: forall err. (Eq err, Show err) =>
ElaboratedInstallPlan
-> (forall k. TargetSelector -> [AvailableTarget k] -> Either err [k])
-> (forall k. PackageId -> ComponentName -> SubComponentTarget -> AvailableTarget k -> Either err k )
-> (forall k. SubComponentTarget -> AvailableTarget k -> Either err k )
-> (TargetProblemCommon -> err)
-> [(TargetSelector -> err, TargetSelector)]
-> Assertion
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment