Commit 11872e57 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Don't paramaterise the TargetSelector type

Previously the TargetSelector type had a type param for the type of the
package that it referred to. In particular we used it with types like:

type Matcher  = ... -> Match (TargetSelector KnownPackage)
type Renderer = TargetSelector PackageId -> ...

However we are about to extend the TargetSelector so that it does not
just refer to one form of package (e.g. KnownPackage) but can refer to
packages via various different forms and partial information. So it no
longer makes sense to have TargetSelector be paramaterised by the
different states of the one kind of package it refers to, as there are
now many kinds. So in preparation for that we simplify it so that it is
equivalent to always using TargetSelector PackageId, and we remove the
type paramater.
parent 9724c46c
......@@ -127,7 +127,7 @@ benchAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, had
-- For the @bench@ command we select all buildable benchmarks,
-- or fail if there are no benchmarks or no buildable benchmarks.
--
selectPackageTargets :: TargetSelector PackageId
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
selectPackageTargets targetSelector targets
......@@ -181,13 +181,13 @@ data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches benchmarks but none are buildable
| TargetProblemNoneEnabled (TargetSelector PackageId) [AvailableTarget ()]
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets (TargetSelector PackageId)
| TargetProblemNoTargets TargetSelector
-- | The 'TargetSelector' matches targets but no benchmarks
| TargetProblemNoBenchmarks (TargetSelector PackageId)
| TargetProblemNoBenchmarks TargetSelector
-- | The 'TargetSelector' refers to a component that is not a benchmark
| TargetProblemComponentNotBenchmark PackageId ComponentName
......
......@@ -126,7 +126,7 @@ buildAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, had
-- For the @build@ command select all components except non-buildable and disabled
-- tests\/benchmarks, fail if there are no such components
--
selectPackageTargets :: TargetSelector PackageId
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
selectPackageTargets targetSelector targets
......@@ -173,10 +173,10 @@ data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches targets but none are buildable
| TargetProblemNoneEnabled (TargetSelector PackageId) [AvailableTarget ()]
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets (TargetSelector PackageId)
| TargetProblemNoTargets TargetSelector
deriving (Eq, Show)
reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a
......
......@@ -84,7 +84,7 @@ sortGroupOn key = map (\xs@(x:_) -> (key x, xs))
-- Renderering for a few project and package types
--
renderTargetSelector :: TargetSelector PackageId -> String
renderTargetSelector :: TargetSelector -> String
renderTargetSelector (TargetPackage _ pkgid Nothing) =
"the package " ++ display pkgid
......@@ -129,20 +129,20 @@ optionalStanza _ = Nothing
-- | Does the 'TargetSelector' potentially refer to one package or many?
--
targetSelectorPluralPkgs :: TargetSelector a -> Plural
targetSelectorPluralPkgs :: TargetSelector -> Plural
targetSelectorPluralPkgs (TargetAllPackages _) = Plural
targetSelectorPluralPkgs (TargetPackage _ _ _) = Singular
targetSelectorPluralPkgs (TargetComponent _ _ _) = Singular
targetSelectorPluralPkgs (TargetPackageName _) = Singular
-- | Does the 'TargetSelector' refer to
targetSelectorRefersToPkgs :: TargetSelector a -> Bool
targetSelectorRefersToPkgs :: TargetSelector -> Bool
targetSelectorRefersToPkgs (TargetAllPackages mkfilter) = isNothing mkfilter
targetSelectorRefersToPkgs (TargetPackage _ _ mkfilter) = isNothing mkfilter
targetSelectorRefersToPkgs (TargetComponent _ _ _) = False
targetSelectorRefersToPkgs (TargetPackageName _) = True
targetSelectorFilter :: TargetSelector a -> Maybe ComponentKindFilter
targetSelectorFilter :: TargetSelector -> Maybe ComponentKindFilter
targetSelectorFilter (TargetPackage _ _ mkfilter) = mkfilter
targetSelectorFilter (TargetAllPackages mkfilter) = mkfilter
targetSelectorFilter (TargetComponent _ _ _) = Nothing
......@@ -238,7 +238,7 @@ renderTargetProblemCommon verb (TargetProblemNoSuchComponent pkgid cname) =
-- This renders an error message for those cases.
--
renderTargetProblemNoneEnabled :: String
-> TargetSelector PackageId
-> TargetSelector
-> [AvailableTarget ()]
-> String
renderTargetProblemNoneEnabled verb targetSelector targets =
......@@ -300,7 +300,7 @@ renderTargetProblemNoneEnabled verb targetSelector targets =
-- | Several commands have a @TargetProblemNoTargets@ problem constructor.
-- This renders an error message for those cases.
--
renderTargetProblemNoTargets :: String -> TargetSelector PackageId -> String
renderTargetProblemNoTargets :: String -> TargetSelector -> String
renderTargetProblemNoTargets verb targetSelector =
"Cannot " ++ verb ++ " " ++ renderTargetSelector targetSelector
++ " because " ++ reason targetSelector ++ ". "
......
......@@ -122,7 +122,7 @@ haddockAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, h
-- depending on the @--executables@ flag we also select all the buildable exes.
-- We do similarly for test-suites, benchmarks and foreign libs.
--
selectPackageTargets :: HaddockFlags -> TargetSelector PackageId
selectPackageTargets :: HaddockFlags -> TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
selectPackageTargets haddockFlags targetSelector targets
......@@ -179,10 +179,10 @@ data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches targets but none are buildable
| TargetProblemNoneEnabled (TargetSelector PackageId) [AvailableTarget ()]
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets (TargetSelector PackageId)
| TargetProblemNoTargets TargetSelector
deriving (Eq, Show)
reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a
......
......@@ -191,7 +191,7 @@ symlinkBuiltPackage :: (UnitId -> FilePath) -- ^ A function to get an UnitId's
-- store directory
-> FilePath -- ^ Where to put the symlink
-> ( UnitId
, [(ComponentTarget, [TargetSelector PackageId])] )
, [(ComponentTarget, [TargetSelector])] )
-> IO ()
symlinkBuiltPackage mkSourceBinDir destDir (pkg, components) =
traverse_ (symlinkBuiltExe (mkSourceBinDir pkg) destDir) exes
......@@ -265,7 +265,7 @@ establishDummyProjectBaseContext verbosity cliConfig tmpDir localPackages = do
-- For the @build@ command select all components except non-buildable and disabled
-- tests\/benchmarks, fail if there are no such components
--
selectPackageTargets :: TargetSelector PackageId
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
selectPackageTargets targetSelector targets
......@@ -312,10 +312,10 @@ data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches targets but none are buildable
| TargetProblemNoneEnabled (TargetSelector PackageId) [AvailableTarget ()]
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets (TargetSelector PackageId)
| TargetProblemNoTargets TargetSelector
deriving (Eq, Show)
reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a
......
......@@ -153,7 +153,7 @@ replAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, hadd
-- Fail if there are no buildable lib\/exe components, or if there are
-- multiple libs or exes.
--
selectPackageTargets :: TargetSelector PackageId
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
selectPackageTargets targetSelector targets
......@@ -229,13 +229,13 @@ data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches targets but none are buildable
| TargetProblemNoneEnabled (TargetSelector PackageId) [AvailableTarget ()]
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets (TargetSelector PackageId)
| TargetProblemNoTargets TargetSelector
-- | A single 'TargetSelector' matches multiple targets
| TargetProblemMatchesMultiple (TargetSelector PackageId) [AvailableTarget ()]
| TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()]
-- | Multiple 'TargetSelector's match multiple targets
| TargetProblemMultipleTargets TargetsMap
......
......@@ -283,7 +283,7 @@ matchingPackagesByUnitId uid =
-- For the @run@ command we select the exe if there is only one and it's
-- buildable. Fail if there are no or multiple buildable exe components.
--
selectPackageTargets :: TargetSelector PackageId
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
selectPackageTargets targetSelector targets
......@@ -341,16 +341,16 @@ selectComponentTarget pkgid cname subtarget _
data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches targets but none are buildable
| TargetProblemNoneEnabled (TargetSelector PackageId) [AvailableTarget ()]
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets (TargetSelector PackageId)
| TargetProblemNoTargets TargetSelector
-- | The 'TargetSelector' matches targets but no executables
| TargetProblemNoExes (TargetSelector PackageId)
| TargetProblemNoExes TargetSelector
-- | A single 'TargetSelector' matches multiple targets
| TargetProblemMatchesMultiple (TargetSelector PackageId) [AvailableTarget ()]
| TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()]
-- | Multiple 'TargetSelector's match multiple targets
| TargetProblemMultipleTargets TargetsMap
......
......@@ -130,7 +130,7 @@ testAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, hadd
-- For the @test@ command we select all buildable test-suites,
-- or fail if there are no test-suites or no buildable test-suites.
--
selectPackageTargets :: TargetSelector PackageId
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
selectPackageTargets targetSelector targets
......@@ -184,13 +184,13 @@ data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches targets but none are buildable
| TargetProblemNoneEnabled (TargetSelector PackageId) [AvailableTarget ()]
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets (TargetSelector PackageId)
| TargetProblemNoTargets TargetSelector
-- | The 'TargetSelector' matches targets but no test-suites
| TargetProblemNoTests (TargetSelector PackageId)
| TargetProblemNoTests TargetSelector
-- | The 'TargetSelector' refers to a component that is not a test-suite
| TargetProblemComponentNotTest PackageId ComponentName
......
......@@ -393,7 +393,7 @@ runProjectPostBuildPhase verbosity
-- possible to for different selectors to match the same target. This extra
-- information is primarily to help make helpful error messages.
--
type TargetsMap = Map UnitId [(ComponentTarget, [TargetSelector PackageId])]
type TargetsMap = Map UnitId [(ComponentTarget, [TargetSelector])]
-- | Given a set of 'TargetSelector's, resolve which 'UnitId's and
-- 'ComponentTarget's they ought to refer to.
......@@ -428,7 +428,7 @@ type TargetsMap = Map UnitId [(ComponentTarget, [TargetSelector PackageId])]
-- a basis for their own @selectComponentTarget@ implementation.
--
resolveTargets :: forall err.
(forall k. TargetSelector PackageId
(forall k. TargetSelector
-> [AvailableTarget k]
-> Either err [k])
-> (forall k. PackageId -> ComponentName -> SubComponentTarget
......@@ -436,7 +436,7 @@ resolveTargets :: forall err.
-> Either err k )
-> (TargetProblemCommon -> err)
-> ElaboratedInstallPlan
-> [TargetSelector PackageId]
-> [TargetSelector]
-> Either [err] TargetsMap
resolveTargets selectPackageTargets selectComponentTarget liftProblem
installPlan targetSelectors =
......@@ -462,8 +462,7 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
-- TODO [required eventually] currently all build targets refer to packages
-- inside the project. Ultimately this has to be generalised to allow
-- referring to other packages and targets.
checkTarget :: TargetSelector PackageId
-> Either err [(UnitId, ComponentTarget)]
checkTarget :: TargetSelector -> Either err [(UnitId, ComponentTarget)]
-- We can ask to build any whole package, project-local or a dependency
checkTarget bt@(TargetPackage _ pkgid mkfilter)
......
......@@ -289,13 +289,13 @@ testTargetSelectorAmbiguous reportSubCase = do
reportSubCase "ambiguous: cwd-pkg filter vs pkg"
assertAmbiguous "libs"
[ mkTargetPackage "libs"
, TargetPackage TargetImplicitCwd "dummyPackageInfo" (Just LibKind) ]
, TargetPackage TargetImplicitCwd "dummyKnownPackage" (Just LibKind) ]
[mkpkg "libs" []]
reportSubCase "ambiguous: filter vs cwd component"
assertAmbiguous "exes"
[ mkTargetComponent "other" (CExeName "exes")
, TargetPackage TargetImplicitCwd "dummyPackageInfo" (Just ExeKind) ]
, TargetPackage TargetImplicitCwd "dummyKnownPackage" (Just ExeKind) ]
[mkpkg "other" [mkexe "exes"]]
-- but filters are not ambiguous with non-cwd components, modules or files
......@@ -367,7 +367,7 @@ testTargetSelectorAmbiguous reportSubCase = do
]
where
assertAmbiguous :: String
-> [TargetSelector PackageId]
-> [TargetSelector]
-> [SourcePackage (PackageLocation a)]
-> Assertion
assertAmbiguous str tss pkgs = do
......@@ -382,7 +382,7 @@ testTargetSelectorAmbiguous reportSubCase = do
++ "got " ++ show res
assertUnambiguous :: String
-> TargetSelector PackageId
-> TargetSelector
-> [SourcePackage (PackageLocation a)]
-> Assertion
assertUnambiguous str ts pkgs = do
......@@ -439,23 +439,23 @@ testTargetSelectorAmbiguous reportSubCase = do
exe { buildInfo = (buildInfo exe) { cSources = files } }
mkTargetPackage :: PackageId -> TargetSelector PackageId
mkTargetPackage :: PackageId -> TargetSelector
mkTargetPackage pkgid =
TargetPackage TargetExplicitNamed pkgid Nothing
mkTargetComponent :: PackageId -> ComponentName -> TargetSelector PackageId
mkTargetComponent :: PackageId -> ComponentName -> TargetSelector
mkTargetComponent pkgid cname =
TargetComponent pkgid cname WholeComponent
mkTargetModule :: PackageId -> ComponentName -> ModuleName -> TargetSelector PackageId
mkTargetModule :: PackageId -> ComponentName -> ModuleName -> TargetSelector
mkTargetModule pkgid cname mname =
TargetComponent pkgid cname (ModuleTarget mname)
mkTargetFile :: PackageId -> ComponentName -> String -> TargetSelector PackageId
mkTargetFile :: PackageId -> ComponentName -> String -> TargetSelector
mkTargetFile pkgid cname fname =
TargetComponent pkgid cname (FileTarget fname)
mkTargetAllPackages :: TargetSelector PackageId
mkTargetAllPackages :: TargetSelector
mkTargetAllPackages = TargetAllPackages Nothing
instance IsString PackageIdentifier where
......@@ -516,8 +516,8 @@ testTargetProblemsCommon config0 = do
[ (packageName p, packageId p)
| p <- InstallPlan.toList elaboratedPlan ]
cases :: [( TargetSelector PackageId -> CmdBuild.TargetProblem
, TargetSelector PackageId
cases :: [( TargetSelector -> CmdBuild.TargetProblem
, TargetSelector
)]
cases =
[ -- Cannot resolve packages outside of the project
......@@ -1217,10 +1217,10 @@ testTargetProblemsHaddock config reportSubCase = do
assertProjectDistinctTargets
:: forall err. (Eq err, Show err) =>
ElaboratedInstallPlan
-> (forall k. TargetSelector PackageId -> [AvailableTarget k] -> Either err [k])
-> (forall k. TargetSelector -> [AvailableTarget k] -> Either err [k])
-> (forall k. PackageId -> ComponentName -> SubComponentTarget -> AvailableTarget k -> Either err k )
-> (TargetProblemCommon -> err)
-> [TargetSelector PackageId]
-> [TargetSelector]
-> [(UnitId, ComponentName)]
-> Assertion
assertProjectDistinctTargets elaboratedPlan
......@@ -1247,14 +1247,14 @@ assertProjectDistinctTargets elaboratedPlan
assertProjectTargetProblems
:: forall err. (Eq err, Show err) =>
FilePath -> ProjectConfig
-> (forall k. TargetSelector PackageId
-> (forall k. TargetSelector
-> [AvailableTarget k]
-> Either err [k])
-> (forall k. PackageId -> ComponentName -> SubComponentTarget
-> AvailableTarget k
-> Either err k )
-> (TargetProblemCommon -> err)
-> [(TargetSelector PackageId -> err, TargetSelector PackageId)]
-> [(TargetSelector -> err, TargetSelector)]
-> Assertion
assertProjectTargetProblems testdir config
selectPackageTargets
......@@ -1273,10 +1273,10 @@ assertProjectTargetProblems testdir config
assertTargetProblems
:: forall err. (Eq err, Show err) =>
ElaboratedInstallPlan
-> (forall k. TargetSelector PackageId -> [AvailableTarget k] -> Either err [k])
-> (forall k. TargetSelector -> [AvailableTarget k] -> Either err [k])
-> (forall k. PackageId -> ComponentName -> SubComponentTarget -> AvailableTarget k -> Either err k )
-> (TargetProblemCommon -> err)
-> [(TargetSelector PackageId -> err, TargetSelector PackageId)]
-> [(TargetSelector -> err, TargetSelector)]
-> Assertion
assertTargetProblems elaboratedPlan
selectPackageTargets
......
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