Commit 09a22b44 authored by Oleg Grenrus's avatar Oleg Grenrus

Resolve issue 5570: Use PackageVersionConstraint more

parent ae3486ab
......@@ -58,6 +58,7 @@ import Distribution.Types.ForeignLib
import Distribution.Types.Component
import Distribution.Types.Dependency
import Distribution.Types.PackageName
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.UnqualComponentName
import Distribution.Types.CondTree
import Distribution.Types.Condition
......@@ -177,7 +178,7 @@ resolveWithFlags ::
-> OS -- ^ OS as returned by Distribution.System.buildOS
-> Arch -- ^ Arch as returned by Distribution.System.buildArch
-> CompilerInfo -- ^ Compiler information
-> [Dependency] -- ^ Additional constraints
-> [PackageVersionConstraint] -- ^ Additional constraints
-> [CondTree ConfVar [Dependency] PDTagged]
-> ([Dependency] -> DepTestRslt [Dependency]) -- ^ Dependency test function.
-> Either [Dependency] (TargetSet PDTagged, FlagAssignment)
......@@ -186,7 +187,10 @@ resolveWithFlags ::
resolveWithFlags dom enabled os arch impl constrs trees checkDeps =
either (Left . fromDepMapUnion) Right $ explore (build mempty dom)
where
extraConstrs = toDepMap constrs
extraConstrs = toDepMap
[ Dependency pn ver mempty
| PackageVersionConstraint pn ver <- constrs
]
-- simplify trees by (partially) evaluating all conditions and converting
-- dependencies to dependency maps.
......@@ -438,7 +442,7 @@ finalizePD ::
-- True.
-> Platform -- ^ The 'Arch' and 'OS'
-> CompilerInfo -- ^ Compiler information
-> [Dependency] -- ^ Additional constraints
-> [PackageVersionConstraint] -- ^ Additional constraints
-> GenericPackageDescription
-> Either [Dependency]
(PackageDescription, FlagAssignment)
......
......@@ -81,6 +81,7 @@ import Distribution.Simple.Utils.Json
import Distribution.System
import Distribution.Pretty
import Distribution.Verbosity
import Distribution.Version (thisVersion)
import Distribution.Compat.Graph (IsNode(..))
......@@ -535,8 +536,9 @@ testSuiteLibV09AsLibAndExe pkg_descr
, componentCompatPackageKey = compat_key
, componentExposedModules = [IPI.ExposedModule m Nothing]
}
pkgName' = mkPackageName $ prettyShow compat_name
pkg = pkg_descr {
package = (package pkg_descr) { pkgName = mkPackageName $ prettyShow compat_name }
package = (package pkg_descr) { pkgName = pkgName' }
, executables = []
, testSuites = []
, subLibraries = [lib]
......@@ -544,7 +546,10 @@ testSuiteLibV09AsLibAndExe pkg_descr
ipi = inplaceInstalledPackageInfo pwd distPref pkg (mkAbiHash "") lib lbi libClbi
testDir = buildDir lbi </> stubName test
</> stubName test ++ "-tmp"
testLibDep = thisPackageVersion $ package pkg
testLibDep = Dependency
pkgName'
(thisVersion $ pkgVersion $ package pkg_descr)
(Set.singleton LMainLibName)
exe = Executable {
exeName = mkUnqualComponentName $ stubName test,
modulePath = stubFilePath test,
......
......@@ -79,6 +79,7 @@ import Distribution.Simple.BuildTarget
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ExeDependency
import Distribution.Types.LegacyExeDependency
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.PkgconfigVersion
import Distribution.Types.PkgconfigDependency
import Distribution.Types.PkgconfigVersionRange
......@@ -450,7 +451,7 @@ configure (pkg_descr0, pbi) cfg = do
-- NB: The fact that we bundle all the constraints together means
-- that is not possible to configure a test-suite to use one
-- version of a dependency, and the executable to use another.
(allConstraints :: [Dependency],
(allConstraints :: [PackageVersionConstraint],
requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo)
<- either (die' verbosity) return $
combinedConstraints (configConstraints cfg)
......@@ -1000,7 +1001,7 @@ configureFinalizedPackage
:: Verbosity
-> ConfigFlags
-> ComponentRequestedSpec
-> [Dependency]
-> [PackageVersionConstraint]
-> (Dependency -> Bool) -- ^ tests if a dependency is satisfiable.
-- Might say it's satisfiable even when not.
-> Compiler
......@@ -1459,10 +1460,10 @@ interpretPackageDbFlags userInstall specificDBs =
-- deps in the end. So we still need to remember which installed packages to
-- pick.
combinedConstraints
:: [Dependency]
:: [PackageVersionConstraint]
-> [GivenComponent]
-> InstalledPackageIndex
-> Either String ([Dependency],
-> Either String ([PackageVersionConstraint],
Map (PackageName, ComponentName) InstalledPackageInfo)
combinedConstraints constraints dependencies installedPackages = do
......@@ -1476,9 +1477,9 @@ combinedConstraints constraints dependencies installedPackages = do
return (allConstraints, idConstraintMap)
where
allConstraints :: [Dependency]
allConstraints :: [PackageVersionConstraint]
allConstraints = constraints
++ [ thisPackageVersion (packageId pkg)
++ [ thisPackageVersionConstraint (packageId pkg)
| (_, _, _, Just pkg) <- dependenciesPkgInfo ]
idConstraintMap :: Map (PackageName, ComponentName) InstalledPackageInfo
......
......@@ -98,11 +98,11 @@ import Distribution.Simple.Program
import Distribution.Simple.InstallDirs
import Distribution.Verbosity
import Distribution.Utils.NubList
import Distribution.Types.Dependency
import Distribution.Types.ComponentId
import Distribution.Types.GivenComponent
import Distribution.Types.Module
import Distribution.Types.PackageName
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.UnqualComponentName (unUnqualComponentName)
import Distribution.Compat.Stack
......@@ -256,8 +256,8 @@ data ConfigFlags = ConfigFlags {
configSplitObjs :: Flag Bool, -- ^Enable -split-objs with GHC
configStripExes :: Flag Bool, -- ^Enable executable stripping
configStripLibs :: Flag Bool, -- ^Enable library stripping
configConstraints :: [Dependency], -- ^Additional constraints for
-- dependencies.
configConstraints :: [PackageVersionConstraint], -- ^Additional constraints for
-- dependencies.
configDependencies :: [GivenComponent],
-- ^The packages depended on.
configInstantiateWith :: [(ModuleName, Module)],
......
......@@ -6,8 +6,6 @@ module Distribution.Types.Dependency
, depPkgName
, depVerRange
, depLibraries
, thisPackageVersion
, notThisPackageVersion
, simplifyDependency
) where
......@@ -15,7 +13,7 @@ import Distribution.Compat.Prelude
import Prelude ()
import Distribution.Version
(VersionRange, anyVersion,notThisVersion, simplifyVersionRange, thisVersion)
(VersionRange, anyVersion, simplifyVersionRange )
import Distribution.Types.VersionRange (isAnyVersionLight)
import Distribution.CabalSpecVersion
......@@ -25,7 +23,6 @@ import Distribution.FieldGrammar.Described
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Types.LibraryName
import Distribution.Types.PackageId
import Distribution.Types.PackageName
import Distribution.Types.UnqualComponentName
import Text.PrettyPrint ((<+>))
......@@ -185,20 +182,6 @@ instance Described Dependency where
where
vr = RENamed "version-range" (describe (Proxy :: Proxy VersionRange))
-- mempty should never be in a Dependency-as-dependency.
-- This is only here until the Dependency-as-constraint problem is solved #5570.
-- Same for below.
--
-- Note: parser allows for empty set!
--
thisPackageVersion :: PackageIdentifier -> Dependency
thisPackageVersion (PackageIdentifier n v) =
Dependency n (thisVersion v) Set.empty
notThisPackageVersion :: PackageIdentifier -> Dependency
notThisPackageVersion (PackageIdentifier n v) =
Dependency n (notThisVersion v) Set.empty
-- | Simplify the 'VersionRange' expression in a 'Dependency'.
-- See 'simplifyVersionRange'.
--
......
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint(..)
) where
module Distribution.Types.PackageVersionConstraint (
PackageVersionConstraint(..),
thisPackageVersionConstraint,
) where
import Distribution.Compat.Prelude
import Prelude ()
......@@ -21,8 +22,8 @@ import Text.PrettyPrint ((<+>))
-- | A version constraint on a package. Different from 'ExeDependency' and
-- 'Dependency' since it does not specify the need for a component, not even
-- the main library.
-- There are a few places in the codebase where 'Dependency' is used where
-- 'PackageVersionConstraint' should be used instead (#5570).
-- There are a few places in the codebase where 'Dependency' was used where
-- 'PackageVersionConstraint' is not used instead (#5570).
data PackageVersionConstraint = PackageVersionConstraint PackageName VersionRange
deriving (Generic, Read, Show, Eq, Typeable, Data)
......@@ -69,3 +70,7 @@ instance Described PackageVersionConstraint where
-- Related https://github.com/haskell/cabal/issues/6760
, RESpaces1 <> describe (Proxy :: Proxy VersionRange)
]
thisPackageVersionConstraint :: PackageIdentifier -> PackageVersionConstraint
thisPackageVersionConstraint (PackageIdentifier pn vr) =
PackageVersionConstraint pn (thisVersion vr)
......@@ -11,7 +11,8 @@ import Distribution.SPDX.License (License)
import Distribution.Types.VersionRange (VersionRange)
#if MIN_VERSION_base(4,7,0)
import Distribution.Types.LocalBuildInfo (LocalBuildInfo)
import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
import Distribution.Types.LocalBuildInfo (LocalBuildInfo)
#endif
import UnitTests.Orphans ()
......@@ -19,10 +20,11 @@ import UnitTests.Orphans ()
tests :: TestTree
tests = testGroup "Distribution.Utils.Structured"
-- This test also verifies that structureHash doesn't loop.
[ testCase "VersionRange" $ structureHash (Proxy :: Proxy VersionRange) @?= Fingerprint 0x39396fc4f2d751aa 0xa1f94e6d843f03bd
, testCase "SPDX.License" $ structureHash (Proxy :: Proxy License) @?= Fingerprint 0xd3d4a09f517f9f75 0xbc3d16370d5a853a
[ testCase "VersionRange" $ structureHash (Proxy :: Proxy VersionRange) @?= Fingerprint 0x39396fc4f2d751aa 0xa1f94e6d843f03bd
, testCase "SPDX.License" $ structureHash (Proxy :: Proxy License) @?= Fingerprint 0xd3d4a09f517f9f75 0xbc3d16370d5a853a
-- The difference is in encoding of newtypes
#if MIN_VERSION_base(4,7,0)
, testCase "LocalBuildInfo" $ structureHash (Proxy :: Proxy LocalBuildInfo) @?= Fingerprint 0x779513b2e8a07958 0xd344652f7031f88f
, testCase "GenericPackageDescription" $ structureHash (Proxy :: Proxy GenericPackageDescription) @?= Fingerprint 0xcaf11323731bfb4a 0xdfda6dfccb716a3f
, testCase "LocalBuildInfo" $ structureHash (Proxy :: Proxy LocalBuildInfo) @?= Fingerprint 0x5a476529cf81643a 0x874574ad4ae0adbf
#endif
]
......@@ -63,12 +63,10 @@ import Distribution.Simple.PackageIndex
( InstalledPackageIndex, lookupPackageName )
import Distribution.Package
( Package(..), packageName, PackageId )
import Distribution.Types.Dependency
( thisPackageVersion )
import Distribution.Types.GivenComponent
( GivenComponent(..) )
import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint(..) )
( PackageVersionConstraint(..), thisPackageVersionConstraint )
import qualified Distribution.PackageDescription as PkgDesc
import Distribution.PackageDescription.Parsec
( readGenericPackageDescription )
......@@ -409,7 +407,7 @@ configurePackage verbosity platform comp scriptOptions configFlags
-- We generate the legacy constraints as well as the new style precise
-- deps. In the end only one set gets passed to Setup.hs configure,
-- depending on the Cabal version we are talking to.
configConstraints = [ thisPackageVersion srcid
configConstraints = [ thisPackageVersionConstraint srcid
| ConfiguredId srcid (Just (PkgDesc.CLibName PkgDesc.LMainLibName)) _uid
<- CD.nonSetupDeps deps ],
configDependencies = [ GivenComponent (packageName srcid) cname uid
......
......@@ -35,6 +35,7 @@ import Distribution.Utils.Generic(safeLast)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Exception as Exception
( Exception(toException), bracket, catches
, Handler(Handler), handleJust, IOException, SomeException )
......@@ -140,12 +141,13 @@ import Distribution.Package
, Package(..), HasMungedPackageId(..), HasUnitId(..)
, UnitId )
import Distribution.Types.Dependency
( thisPackageVersion )
( Dependency (..) )
import Distribution.Types.LibraryName (LibraryName (..))
import Distribution.Types.GivenComponent
( GivenComponent(..) )
import Distribution.Pretty ( prettyShow )
import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint(..) )
( PackageVersionConstraint(..), thisPackageVersionConstraint )
import Distribution.Types.MungedPackageId
import qualified Distribution.PackageDescription as PackageDescription
import Distribution.PackageDescription
......@@ -829,8 +831,8 @@ postInstallActions verbosity
unless oneShot $
World.insert verbosity worldFile
--FIXME: does not handle flags
[ World.WorldPkgInfo dep mempty
| UserTargetNamed dep <- targets ]
[ World.WorldPkgInfo (Dependency pn vr (Set.singleton LMainLibName)) mempty
| UserTargetNamed (PackageVersionConstraint pn vr) <- targets ]
let buildReports = BuildReports.fromInstallPlan platform (compilerId comp)
installPlan buildOutcomes
......@@ -1209,7 +1211,7 @@ installReadyPackage platform cinfo configFlags
-- We generate the legacy constraints as well as the new style precise deps.
-- In the end only one set gets passed to Setup.hs configure, depending on
-- the Cabal version we are talking to.
configConstraints = [ thisPackageVersion srcid
configConstraints = [ thisPackageVersionConstraint srcid
| ConfiguredId
srcid
(Just
......
......@@ -31,23 +31,25 @@ import Distribution.Utils.Generic
import Distribution.Package (PackageName, packageVersion)
import Distribution.PackageDescription (allBuildDepends)
import Distribution.PackageDescription.Configuration (finalizePD)
import Distribution.Pretty (prettyShow)
import Distribution.Simple.Compiler (Compiler, compilerInfo)
import Distribution.Simple.Setup
(fromFlagOrDefault, flagToMaybe)
import Distribution.Simple.Utils
(die', notice, debug, tryFindPackageDesc)
import Distribution.System (Platform)
import Distribution.Deprecated.Text (display)
import Distribution.Types.ComponentRequestedSpec
(ComponentRequestedSpec(..))
import Distribution.Types.Dependency
(Dependency(..), depPkgName, simplifyDependency)
(Dependency(..))
import Distribution.Verbosity (Verbosity, silent)
import Distribution.Version
(Version, VersionRange, LowerBound(..), UpperBound(..)
,asVersionIntervals, majorBoundVersion)
,asVersionIntervals, majorBoundVersion, simplifyVersionRange)
import Distribution.PackageDescription.Parsec
(readGenericPackageDescription)
import Distribution.Types.PackageVersionConstraint
(PackageVersionConstraint (..))
import qualified Data.Set as S
import System.Directory (getCurrentDirectory)
......@@ -91,7 +93,7 @@ outdated verbosity0 outdatedFlags repoContext comp platform = do
then depsFromNewFreezeFile verbosity mprojectFile
else depsFromPkgDesc verbosity comp platform
debug verbosity $ "Dependencies loaded: "
++ (intercalate ", " $ map display deps)
++ (intercalate ", " $ map prettyShow deps)
let outdatedDeps = listOutdated deps pkgIndex
(ListOutdatedSettings ignorePred minorPred)
when (not quiet) $
......@@ -102,25 +104,25 @@ outdated verbosity0 outdatedFlags repoContext comp platform = do
-- | Print either the list of all outdated dependencies, or a message
-- that there are none.
showResult :: Verbosity -> [(Dependency,Version)] -> Bool -> IO ()
showResult :: Verbosity -> [(PackageVersionConstraint,Version)] -> Bool -> IO ()
showResult verbosity outdatedDeps simpleOutput =
if (not . null $ outdatedDeps)
then
do when (not simpleOutput) $
notice verbosity "Outdated dependencies:"
for_ outdatedDeps $ \(d@(Dependency pn _ _), v) ->
let outdatedDep = if simpleOutput then display pn
else display d ++ " (latest: " ++ display v ++ ")"
for_ outdatedDeps $ \(d@(PackageVersionConstraint pn _), v) ->
let outdatedDep = if simpleOutput then prettyShow pn
else prettyShow d ++ " (latest: " ++ prettyShow v ++ ")"
in notice verbosity outdatedDep
else notice verbosity "All dependencies are up to date."
-- | Convert a list of 'UserConstraint's to a 'Dependency' list.
userConstraintsToDependencies :: [UserConstraint] -> [Dependency]
userConstraintsToDependencies :: [UserConstraint] -> [PackageVersionConstraint]
userConstraintsToDependencies ucnstrs =
mapMaybe (packageConstraintToDependency . userToPackageConstraint) ucnstrs
-- | Read the list of dependencies from the freeze file.
depsFromFreezeFile :: Verbosity -> IO [Dependency]
depsFromFreezeFile :: Verbosity -> IO [PackageVersionConstraint]
depsFromFreezeFile verbosity = do
cwd <- getCurrentDirectory
userConfig <- loadUserConfig verbosity cwd Nothing
......@@ -131,7 +133,7 @@ depsFromFreezeFile verbosity = do
return deps
-- | Read the list of dependencies from the new-style freeze file.
depsFromNewFreezeFile :: Verbosity -> Maybe FilePath -> IO [Dependency]
depsFromNewFreezeFile :: Verbosity -> Maybe FilePath -> IO [PackageVersionConstraint]
depsFromNewFreezeFile verbosity mprojectFile = do
projectRoot <- either throwIO return =<<
findProjectRoot Nothing mprojectFile
......@@ -147,7 +149,7 @@ depsFromNewFreezeFile verbosity mprojectFile = do
return deps
-- | Read the list of dependencies from the package description.
depsFromPkgDesc :: Verbosity -> Compiler -> Platform -> IO [Dependency]
depsFromPkgDesc :: Verbosity -> Compiler -> Platform -> IO [PackageVersionConstraint]
depsFromPkgDesc verbosity comp platform = do
cwd <- getCurrentDirectory
path <- tryFindPackageDesc verbosity cwd
......@@ -161,7 +163,9 @@ depsFromPkgDesc verbosity comp platform = do
let bd = allBuildDepends pd
debug verbosity
"Reading the list of dependencies from the package description"
return bd
return $ map toPVC bd
where
toPVC (Dependency pn vr _) = PackageVersionConstraint pn vr
-- | Various knobs for customising the behaviour of 'listOutdated'.
data ListOutdatedSettings = ListOutdatedSettings {
......@@ -172,16 +176,16 @@ data ListOutdatedSettings = ListOutdatedSettings {
}
-- | Find all outdated dependencies.
listOutdated :: [Dependency]
listOutdated :: [PackageVersionConstraint]
-> PackageIndex UnresolvedSourcePackage
-> ListOutdatedSettings
-> [(Dependency, Version)]
-> [(PackageVersionConstraint, Version)]
listOutdated deps pkgIndex (ListOutdatedSettings ignorePred minorPred) =
mapMaybe isOutdated $ map simplifyDependency deps
mapMaybe isOutdated $ map simplifyPVC deps
where
isOutdated :: Dependency -> Maybe (Dependency, Version)
isOutdated dep@(Dependency pname vr _)
| ignorePred (depPkgName dep) = Nothing
isOutdated :: PackageVersionConstraint -> Maybe (PackageVersionConstraint, Version)
isOutdated dep@(PackageVersionConstraint pname vr)
| ignorePred pname = Nothing
| otherwise =
let this = map packageVersion $ lookupDependency pkgIndex pname vr
latest = lookupLatest dep
......@@ -195,12 +199,12 @@ listOutdated deps pkgIndex (ListOutdatedSettings ignorePred minorPred) =
latest' = maximum latest
in if this' < latest' then Just latest' else Nothing
lookupLatest :: Dependency -> [Version]
lookupLatest dep@(Dependency pname vr _)
| minorPred (depPkgName dep) =
lookupLatest :: PackageVersionConstraint -> [Version]
lookupLatest (PackageVersionConstraint pname vr)
| minorPred pname =
map packageVersion $ lookupDependency pkgIndex pname (relaxMinor vr)
| otherwise =
map packageVersion $ lookupPackageName pkgIndex (depPkgName dep)
| otherwise =
map packageVersion $ lookupPackageName pkgIndex pname
relaxMinor :: VersionRange -> VersionRange
relaxMinor vr =
......@@ -210,3 +214,7 @@ listOutdated deps pkgIndex (ListOutdatedSettings ignorePred minorPred) =
case upper of
NoUpperBound -> vr
UpperBound _v1 _ -> majorBoundVersion v0
simplifyPVC :: PackageVersionConstraint -> PackageVersionConstraint
simplifyPVC (PackageVersionConstraint pn vr) =
PackageVersionConstraint pn (simplifyVersionRange vr)
......@@ -3395,7 +3395,7 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..})
configConstraints =
case elabPkgOrComp of
ElabPackage _ ->
[ thisPackageVersion srcid
[ thisPackageVersionConstraint srcid
| ConfiguredId srcid _ _uid <- elabLibDependencies elab ]
ElabComponent _ -> []
......
......@@ -109,10 +109,9 @@ import Distribution.Simple.InstallDirs
( PathTemplate, InstallDirs(..)
, toPathTemplate, fromPathTemplate, combinePathTemplate )
import Distribution.Version
( Version, mkVersion, nullVersion, anyVersion, thisVersion )
( Version, mkVersion )
import Distribution.Package
( PackageName, PackageIdentifier, packageName, packageVersion )
import Distribution.Types.Dependency
( PackageName )
import Distribution.Types.GivenComponent
( GivenComponent(..) )
import Distribution.Types.PackageVersionConstraint
......@@ -127,9 +126,7 @@ import Distribution.Deprecated.Text
import Distribution.ReadE
( ReadE(..), succeedReadE, parsecToReadE )
import qualified Distribution.Deprecated.ReadP as Parse
( ReadP, char, sepBy1, (+++) )
import Distribution.Deprecated.ParseUtils
( readPToMaybe )
( ReadP, char, sepBy1 )
import Distribution.Verbosity
( Verbosity, lessVerbose, normal, verboseNoFlags, verboseNoTimestamp )
import Distribution.Simple.Utils
......@@ -140,10 +137,10 @@ import Distribution.Client.GlobalFlags
)
import Distribution.Client.ManpageFlags (ManpageFlags, defaultManpageFlags, manpageOptions)
import Distribution.Parsec.Newtypes (SpecVersion (..))
import Distribution.Parsec (eitherParsec)
import Data.List
( deleteFirstsBy )
import qualified Data.Set as Set
import System.FilePath
( (</>) )
......@@ -2670,24 +2667,13 @@ usageFlags name pname =
"Usage: " ++ pname ++ " " ++ name ++ " [FLAGS]\n"
--TODO: do we want to allow per-package flags?
parsePackageArgs :: [String] -> Either String [Dependency]
parsePackageArgs = parsePkgArgs []
where
parsePkgArgs ds [] = Right (reverse ds)
parsePkgArgs ds (arg:args) =
case readPToMaybe parseDependencyOrPackageId arg of
Just dep -> parsePkgArgs (dep:ds) args
Nothing -> Left $
show arg ++ " is not valid syntax for a package name or"
++ " package dependency."
parseDependencyOrPackageId :: Parse.ReadP r Dependency
parseDependencyOrPackageId = parse Parse.+++ liftM pkgidToDependency parse
where
pkgidToDependency :: PackageIdentifier -> Dependency
pkgidToDependency p = case packageVersion p of
v | v == nullVersion -> Dependency (packageName p) anyVersion (Set.singleton LMainLibName)
| otherwise -> Dependency (packageName p) (thisVersion v) (Set.singleton LMainLibName)
parsePackageArgs :: [String] -> Either String [PackageVersionConstraint]
parsePackageArgs = traverse p where
p arg = case eitherParsec arg of
Right pvc -> Right pvc
Left err -> Left $
show arg ++ " is not valid syntax for a package name or"
++ " package dependency. " ++ err
showRemoteRepo :: RemoteRepo -> String
showRemoteRepo = prettyShow
......
......@@ -54,9 +54,8 @@ import Distribution.Deprecated.ParseUtils (parseFlagAssignment)
import Distribution.Package
( Package(..), PackageName, unPackageName, mkPackageName
, PackageIdentifier(..), packageName, packageVersion )
, packageName )
import Distribution.Types.Dependency
import Distribution.Types.LibraryName
import Distribution.Client.Types
( PackageLocation(..), ResolvedPkgLoc, UnresolvedSourcePackage
, PackageSpecifier(..) )
......@@ -76,14 +75,17 @@ import Distribution.Client.FetchUtils
import Distribution.Client.Utils ( tryFindPackageDesc )
import Distribution.Client.GlobalFlags
( RepoContext(..) )
import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint (..) )
import Distribution.PackageDescription
( GenericPackageDescription, nullFlagAssignment)
import Distribution.Version
( nullVersion, thisVersion, anyVersion, isAnyVersion )
( anyVersion, isAnyVersion )
import Distribution.Deprecated.Text
( Text(..), display )
import Distribution.Verbosity (Verbosity)
import Distribution.Parsec (eitherParsec)
import Distribution.Simple.Utils
( die', warn, lowercase )
......@@ -94,7 +96,6 @@ import Distribution.PackageDescription.Parsec
import Data.Either
( partitionEithers )
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Lazy as BS
import qualified Distribution.Client.GZipUtils as GZipUtils
import Control.Monad (mapM)
......@@ -125,7 +126,7 @@ data UserTarget =
-- > cabal install foo-1.0
-- > cabal install 'foo < 2'
--
UserTargetNamed Dependency
UserTargetNamed PackageVersionConstraint
-- | A special virtual package that refers to the collection of packages
-- recorded in the world file that the user specifically installed.
......@@ -190,14 +191,14 @@ data UserTargetProblem
readUserTarget :: String -> IO (Either UserTargetProblem UserTarget)
readUserTarget targetstr =
case testNamedTargets targetstr of
Just (Dependency pkgn verrange _)
case eitherParsec targetstr of
Right (PackageVersionConstraint pkgn verrange)
| pkgn == mkPackageName "world"
-> return $ if verrange == anyVersion
then Right UserTargetWorld
else Left UserTargetBadWorldPkg
Just dep -> return (Right (UserTargetNamed dep))
Nothing -> do
Right dep -> return (Right (UserTargetNamed dep))
Left _err -> do
fileTarget <- testFileTargets targetstr
case fileTarget of
Just target -> return target
......@@ -206,8 +207,6 @@ readUserTarget targetstr =
Just target -> return target
Nothing -> return (Left (UserTargetUnrecognised targetstr))
where
testNamedTargets = readPToMaybe parseDependencyOrPackageId
testFileTargets filename = do
isDir <- doesDirectoryExist filename
isFile <- doesFileExist filename
......@@ -253,16 +252,6 @@ readUserTarget targetstr =
extensionIsTarGz f = takeExtension f == ".gz"
&& takeExtension (dropExtension f) == ".tar"
parseDependencyOrPackageId :: Parse.ReadP r Dependency
parseDependencyOrPackageId = parse
+++ liftM pkgidToDependency parse
where
pkgidToDependency :: PackageIdentifier -> Dependency
pkgidToDependency p = case packageVersion p of
v | v == nullVersion -> Dependency (packageName p) anyVersion (Set.singleton LMainLibName)
| otherwise -> Dependency (packageName p) (thisVersion v) (Set.singleton LMainLibName)
reportUserTargetProblems :: Verbosity -> [UserTargetProblem] -> IO ()
reportUserTargetProblems verbosity problems = do
case [ target | UserTargetUnrecognised target <- problems ] of
......@@ -380,7 +369,7 @@ expandUserTarget :: Verbosity
-> IO [PackageTarget (PackageLocation ())]
expandUserTarget verbosity worldFile userTarget = case userTarget of