Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
88a95a36
Commit
88a95a36
authored
Dec 15, 2008
by
Duncan Coutts
Browse files
Use the Platform type rather than passing around the OS and Arch separately
parent
2d1f9ce5
Changes
9
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/BuildReports/Storage.hs
View file @
88a95a36
...
...
@@ -35,7 +35,7 @@ import Distribution.Client.Config
(
defaultLogsDir
)
import
Distribution.System
(
OS
,
Arch
)
(
Platform
(
Platform
)
)
import
Distribution.Compiler
(
CompilerId
)
import
Distribution.Simple.Utils
...
...
@@ -94,24 +94,23 @@ storeLocal reports = do
fromInstallPlan
::
InstallPlan
->
[(
BuildReport
,
Repo
)]
fromInstallPlan
plan
=
catMaybes
.
map
(
fromPlanPackage
os'
arch'
comp
)
.
map
(
fromPlanPackage
platform
comp
)
.
InstallPlan
.
toList
$
plan
where
os'
=
InstallPlan
.
planOS
plan
arch'
=
InstallPlan
.
planArch
plan
comp
=
InstallPlan
.
planCompiler
plan
where
platform
=
InstallPlan
.
planPlatform
plan
comp
=
InstallPlan
.
planCompiler
plan
fromPlanPackage
::
OS
->
Arch
->
CompilerId
fromPlanPackage
::
Platform
->
CompilerId
->
InstallPlan
.
PlanPackage
->
Maybe
(
BuildReport
,
Repo
)
fromPlanPackage
os'
arch
'
comp
planPackage
=
case
planPackage
of
fromPlanPackage
(
Platform
arch
os
)
comp
planPackage
=
case
planPackage
of
InstallPlan
.
Installed
pkg
@
(
ConfiguredPackage
(
AvailablePackage
{
packageSource
=
RepoTarballPackage
repo
})
_
_
)
result
->
Just
$
(
BuildReport
.
new
os
'
arch
'
comp
pkg
(
Right
result
),
repo
)
->
Just
$
(
BuildReport
.
new
os
arch
comp
pkg
(
Right
result
),
repo
)
InstallPlan
.
Failed
pkg
@
(
ConfiguredPackage
(
AvailablePackage
{
packageSource
=
RepoTarballPackage
repo
})
_
_
)
result
->
Just
$
(
BuildReport
.
new
os
'
arch
'
comp
pkg
(
Left
result
),
repo
)
->
Just
$
(
BuildReport
.
new
os
arch
comp
pkg
(
Left
result
),
repo
)
_
->
Nothing
cabal-install/Distribution/Client/Dependency.hs
View file @
88a95a36
...
...
@@ -45,7 +45,7 @@ import Distribution.Version
import
Distribution.Compiler
(
CompilerId
(
..
)
)
import
Distribution.System
(
OS
,
Arch
)
(
Platform
)
import
Distribution.Simple.Utils
(
comparing
)
import
Distribution.Client.Utils
(
mergeBy
,
MergeResult
(
..
))
...
...
@@ -105,31 +105,29 @@ data PackagesInstalledPreference =
--
|
PreferLatestForSelected
resolveDependencies
::
OS
->
Arch
resolveDependencies
::
Platform
->
CompilerId
->
Maybe
(
PackageIndex
InstalledPackageInfo
)
->
PackageIndex
AvailablePackage
->
PackagesPreference
->
[
UnresolvedDependency
]
->
Either
String
InstallPlan
resolveDependencies
os
arch
comp
installed
available
pref
deps
=
resolveDependencies
platform
comp
installed
available
pref
deps
=
foldProgress
(
flip
const
)
Left
Right
$
resolveDependenciesWithProgress
os
arch
comp
installed
available
pref
deps
resolveDependenciesWithProgress
platform
comp
installed
available
pref
deps
resolveDependenciesWithProgress
::
OS
->
Arch
resolveDependenciesWithProgress
::
Platform
->
CompilerId
->
Maybe
(
PackageIndex
InstalledPackageInfo
)
->
PackageIndex
AvailablePackage
->
PackagesPreference
->
[
UnresolvedDependency
]
->
Progress
String
String
InstallPlan
resolveDependenciesWithProgress
os
arch
comp
(
Just
installed
)
=
dependencyResolver
defaultResolver
os
arch
comp
installed
resolveDependenciesWithProgress
platform
comp
(
Just
installed
)
=
dependencyResolver
defaultResolver
platform
comp
installed
resolveDependenciesWithProgress
os
arch
comp
Nothing
=
dependencyResolver
bogusResolver
os
arch
comp
mempty
resolveDependenciesWithProgress
platform
comp
Nothing
=
dependencyResolver
bogusResolver
platform
comp
mempty
hideBrokenPackages
::
PackageFixedDeps
p
=>
PackageIndex
p
->
PackageIndex
p
hideBrokenPackages
index
=
...
...
@@ -150,13 +148,13 @@ basePackage = PackageName "base"
dependencyResolver
::
DependencyResolver
->
OS
->
Arch
->
CompilerId
->
Platform
->
CompilerId
->
PackageIndex
InstalledPackageInfo
->
PackageIndex
AvailablePackage
->
PackagesPreference
->
[
UnresolvedDependency
]
->
Progress
String
String
InstallPlan
dependencyResolver
resolver
os
arch
comp
installed
available
pref
deps
=
dependencyResolver
resolver
platform
comp
installed
available
pref
deps
=
let
installed'
=
hideBrokenPackages
installed
-- If the user is not explicitly asking to upgrade base then lets
-- prevent that from happening accidentally since it is usually not what
...
...
@@ -169,11 +167,11 @@ dependencyResolver resolver os arch comp installed available pref deps =
pkg
==
basePackage
in
fmap
toPlan
$
resolver
os
arch
comp
installed'
available'
preference
deps
$
resolver
platform
comp
installed'
available'
preference
deps
where
toPlan
pkgs
=
case
InstallPlan
.
new
os
arch
comp
(
PackageIndex
.
fromList
pkgs
)
of
case
InstallPlan
.
new
platform
comp
(
PackageIndex
.
fromList
pkgs
)
of
Right
plan
->
plan
Left
problems
->
error
$
unlines
$
"internal error: could not construct a valid install plan."
...
...
cabal-install/Distribution/Client/Dependency/Bogus.hs
View file @
88a95a36
...
...
@@ -36,6 +36,8 @@ import Distribution.Simple.Utils
(
equating
,
comparing
)
import
Distribution.Text
(
display
)
import
Distribution.System
(
Platform
(
Platform
)
)
import
Data.List
(
maximumBy
,
sortBy
,
groupBy
)
...
...
@@ -46,7 +48,7 @@ import Data.List
-- We just pretend that everything is installed and hope for the best.
--
bogusResolver
::
DependencyResolver
bogusResolver
os
arch
comp
_
available
_
=
resolveFromAvailable
[]
bogusResolver
(
Platform
arch
os
)
comp
_
available
_
=
resolveFromAvailable
[]
.
combineDependencies
where
resolveFromAvailable
chosen
[]
=
Done
chosen
...
...
cabal-install/Distribution/Client/Dependency/TopDown.hs
View file @
88a95a36
...
...
@@ -46,7 +46,7 @@ import Distribution.Version
import
Distribution.Compiler
(
CompilerId
)
import
Distribution.System
(
OS
,
Arch
)
(
Platform
(
Platform
)
)
import
Distribution.Simple.Utils
(
equating
,
comparing
)
import
Distribution.Text
...
...
@@ -224,26 +224,26 @@ search configure pref constraints =
-- the standard 'DependencyResolver' interface.
--
topDownResolver
::
DependencyResolver
topDownResolver
=
(((((
(
mapMessages
.
)
.
)
.
)
.
)
.
)
.
)
.
topDownResolver'
topDownResolver
=
(((((
mapMessages
.
)
.
)
.
)
.
)
.
)
.
topDownResolver'
where
mapMessages
::
Progress
Log
Failure
a
->
Progress
String
String
a
mapMessages
=
foldProgress
(
Step
.
showLog
)
(
Fail
.
showFailure
)
Done
-- | The native resolver with detailed structured logging and failure types.
--
topDownResolver'
::
OS
->
Arch
->
CompilerId
topDownResolver'
::
Platform
->
CompilerId
->
PackageIndex
InstalledPackageInfo
->
PackageIndex
AvailablePackage
->
(
PackageName
->
PackagePreference
)
->
[
UnresolvedDependency
]
->
Progress
Log
Failure
[
PlanPackage
]
topDownResolver'
os
arch
comp
installed
available
pref
deps
=
topDownResolver'
platform
comp
installed
available
pref
deps
=
fmap
(
uncurry
finalise
)
.
(
\
cs
->
search
configure
pref
cs
initialPkgNames
)
=<<
constrainTopLevelDeps
deps
constraints
where
configure
=
configurePackage
os
arch
comp
configure
=
configurePackage
platform
comp
constraints
=
Constraints
.
empty
(
annotateInstalledPackages
topSortNumber
installed'
)
(
annotateAvailablePackages
deps
topSortNumber
available'
)
...
...
@@ -268,8 +268,8 @@ constrainTopLevelDeps (UnresolvedDependency dep _:deps) cs =
Unsatisfiable
->
Fail
(
TopLevelDependencyUnsatisfiable
dep
)
ConflictsWith
conflicts
->
Fail
(
TopLevelDependencyConflict
dep
conflicts
)
configurePackage
::
OS
->
Arch
->
CompilerId
->
ConfigurePackage
configurePackage
os
arch
comp
available
spkg
=
case
spkg
of
configurePackage
::
Platform
->
CompilerId
->
ConfigurePackage
configurePackage
(
Platform
arch
os
)
comp
available
spkg
=
case
spkg
of
InstalledOnly
ipkg
->
Right
(
InstalledOnly
ipkg
)
AvailableOnly
apkg
->
fmap
AvailableOnly
(
configure
apkg
)
InstalledAndAvailable
ipkg
apkg
->
fmap
(
InstalledAndAvailable
ipkg
)
...
...
cabal-install/Distribution/Client/Dependency/Types.hs
View file @
88a95a36
...
...
@@ -37,7 +37,7 @@ import Distribution.Version
import
Distribution.Compiler
(
CompilerId
)
import
Distribution.System
(
OS
,
Arch
)
(
Platform
)
import
Prelude
hiding
(
fail
)
...
...
@@ -49,8 +49,7 @@ import Prelude hiding (fail)
-- solving the package dependency problem and we want to make it easy to swap
-- in alternatives.
--
type
DependencyResolver
=
OS
->
Arch
type
DependencyResolver
=
Platform
->
CompilerId
->
PackageIndex
InstalledPackageInfo
->
PackageIndex
AvailablePackage
...
...
cabal-install/Distribution/Client/Fetch.hs
View file @
88a95a36
...
...
@@ -48,7 +48,7 @@ import Distribution.Simple.Utils
(
die
,
notice
,
info
,
debug
,
setupMessage
,
copyFileVerbose
,
writeFileAtomic
)
import
Distribution.System
(
build
OS
,
buildArch
)
(
build
Platform
)
import
Distribution.Text
(
display
)
import
Distribution.Verbosity
...
...
@@ -163,7 +163,7 @@ fetch verbosity packageDB repos comp conf deps = do
[
name
|
UnresolvedDependency
(
Dependency
name
_
)
_
<-
pkgs
]
let
progress
=
resolveDependenciesWithProgress
build
OS
buildArch
(
compilerId
comp
)
build
Platform
(
compilerId
comp
)
installed'
available
(
packagesPreference
PreferLatestForSelected
versionPref
)
deps'
...
...
cabal-install/Distribution/Client/Install.hs
View file @
88a95a36
...
...
@@ -99,7 +99,7 @@ import Distribution.Simple.Utils as Utils
import
Distribution.Client.Utils
(
inDir
,
mergeBy
,
MergeResult
(
..
)
)
import
Distribution.System
(
OS
(
Windows
),
buildOS
,
Arch
,
buildArch
)
(
Platform
(
Platform
),
buildPlatform
,
OS
(
Windows
),
buildOS
)
import
Distribution.Text
(
display
)
import
Distribution.Verbosity
as
Verbosity
...
...
@@ -179,12 +179,11 @@ installWithPlanner planner verbosity packageDB repos comp conf configFlags insta
unless
dryRun
$
do
logsDir
<-
defaultLogsDir
let
os
=
InstallPlan
.
planOS
installPlan
arch
=
InstallPlan
.
planArch
installPlan
compid
=
InstallPlan
.
planCompiler
installPlan
let
platform
=
InstallPlan
.
planPlatform
installPlan
compid
=
InstallPlan
.
planCompiler
installPlan
installPlan'
<-
executeInstallPlan
installPlan
$
\
cpkg
->
installConfiguredPackage
os
arch
compid
configFlags
installConfiguredPackage
platform
compid
configFlags
cpkg
$
\
configFlags'
src
pkg
->
installAvailablePackage
verbosity
(
packageId
pkg
)
src
$
\
mpath
->
installUnpackedPackage
verbosity
(
setupScriptOptions
installed
)
...
...
@@ -286,7 +285,7 @@ planLocalPackage verbosity comp configFlags installed
depFlags
=
Cabal
.
configConfigurationsFlags
configFlags
}
return
$
resolveDependenciesWithProgress
build
OS
buildArch
(
compilerId
comp
)
return
$
resolveDependenciesWithProgress
build
Platform
(
compilerId
comp
)
installed'
available'
(
packagesPreference
PreferLatestForSelected
versionPrefs
)
[
localPkgDep
]
...
...
@@ -302,7 +301,7 @@ planRepoPackages installedPref comp installFlags deps installed
|
Cabal
.
fromFlagOrDefault
False
(
installReinstall
installFlags
)
=
fmap
(
hideGivenDeps
deps'
)
installed
|
otherwise
=
installed
return
$
resolveDependenciesWithProgress
build
OS
buildArch
(
compilerId
comp
)
return
$
resolveDependenciesWithProgress
build
Platform
(
compilerId
comp
)
installed'
available
(
packagesPreference
installedPref
versionPrefs
)
deps'
...
...
@@ -314,7 +313,7 @@ planRepoPackages installedPref comp installFlags deps installed
planUpgradePackages
::
Compiler
->
Planner
planUpgradePackages
comp
(
Just
installed
)
(
AvailablePackageDb
available
versionPrefs
)
=
return
$
resolveDependenciesWithProgress
build
OS
buildArch
(
compilerId
comp
)
resolveDependenciesWithProgress
build
Platform
(
compilerId
comp
)
(
Just
installed
)
available
(
packagesPreference
PreferAllLatest
versionPrefs
)
[
UnresolvedDependency
dep
[]
...
...
@@ -443,12 +442,12 @@ executeInstallPlan plan installPkg = case InstallPlan.ready plan of
-- versioned package dependencies. So we ignore any previous partial flag
-- assignment or dependency constraints and use the new ones.
--
installConfiguredPackage
::
OS
->
Arch
->
CompilerId
installConfiguredPackage
::
Platform
->
CompilerId
->
Cabal
.
ConfigFlags
->
ConfiguredPackage
->
(
Cabal
.
ConfigFlags
->
AvailablePackageSource
->
PackageDescription
->
a
)
->
a
installConfiguredPackage
os
arch
comp
configFlags
installConfiguredPackage
(
Platform
arch
os
)
comp
configFlags
(
ConfiguredPackage
(
AvailablePackage
_
gpkg
source
)
flags
deps
)
installPkg
=
installPkg
configFlags
{
Cabal
.
configConfigurationsFlags
=
flags
,
...
...
cabal-install/Distribution/Client/InstallPlan.hs
View file @
88a95a36
...
...
@@ -24,8 +24,7 @@ module Distribution.Client.InstallPlan (
failed
,
-- ** Query functions
planOS
,
planArch
,
planPlatform
,
planCompiler
,
-- * Checking valididy of plans
...
...
@@ -66,7 +65,7 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex
import
Distribution.Text
(
display
)
import
Distribution.System
(
OS
,
Arch
)
(
Platform
(
Platform
)
)
import
Distribution.Compiler
(
CompilerId
(
..
)
)
import
Distribution.Client.Utils
...
...
@@ -148,32 +147,30 @@ data InstallPlan = InstallPlan {
planGraphRev
::
Graph
,
planPkgOf
::
Graph
.
Vertex
->
PlanPackage
,
planVertexOf
::
PackageIdentifier
->
Graph
.
Vertex
,
planOS
::
OS
,
planArch
::
Arch
,
planPlatform
::
Platform
,
planCompiler
::
CompilerId
}
invariant
::
InstallPlan
->
Bool
invariant
plan
=
valid
(
plan
OS
plan
)
(
planArch
plan
)
(
planCompiler
plan
)
(
planIndex
plan
)
valid
(
plan
Platform
plan
)
(
planCompiler
plan
)
(
planIndex
plan
)
internalError
::
String
->
a
internalError
msg
=
error
$
"InstallPlan: internal error: "
++
msg
-- | Build an installation plan from a valid set of resolved packages.
--
new
::
OS
->
Arch
->
CompilerId
->
PackageIndex
PlanPackage
new
::
Platform
->
CompilerId
->
PackageIndex
PlanPackage
->
Either
[
PlanProblem
]
InstallPlan
new
os
arch
compiler
index
=
case
problems
os
arch
compiler
index
of
new
platform
compiler
index
=
case
problems
platform
compiler
index
of
[]
->
Right
InstallPlan
{
planIndex
=
index
,
planGraph
=
graph
,
planGraphRev
=
Graph
.
transposeG
graph
,
planPkgOf
=
vertexToPkgId
,
planVertexOf
=
fromMaybe
noSuchPkgId
.
pkgIdToVertex
,
planOS
=
os
,
planArch
=
arch
,
planPlatform
=
platform
,
planCompiler
=
compiler
}
where
(
graph
,
vertexToPkgId
,
pkgIdToVertex
)
=
...
...
@@ -279,8 +276,8 @@ checkConfiguredPackage pkg =
--
-- * if the result is @False@ use 'problems' to get a detailed list.
--
valid
::
OS
->
Arch
->
CompilerId
->
PackageIndex
PlanPackage
->
Bool
valid
os
arch
comp
index
=
null
(
problems
os
arch
comp
index
)
valid
::
Platform
->
CompilerId
->
PackageIndex
PlanPackage
->
Bool
valid
platform
comp
index
=
null
(
problems
platform
comp
index
)
data
PlanProblem
=
PackageInvalid
ConfiguredPackage
[
PackageProblem
]
...
...
@@ -329,12 +326,12 @@ showPlanProblem (PackageStateInvalid pkg pkg') =
-- error messages. This is mainly intended for debugging purposes.
-- Use 'showPlanProblem' for a human readable explanation.
--
problems
::
OS
->
Arch
->
CompilerId
problems
::
Platform
->
CompilerId
->
PackageIndex
PlanPackage
->
[
PlanProblem
]
problems
os
arch
comp
index
=
problems
platform
comp
index
=
[
PackageInvalid
pkg
packageProblems
|
Configured
pkg
<-
PackageIndex
.
allPackages
index
,
let
packageProblems
=
configuredPackageProblems
os
arch
comp
pkg
,
let
packageProblems
=
configuredPackageProblems
platform
comp
pkg
,
not
(
null
packageProblems
)
]
++
[
PackageMissingDeps
pkg
missingDeps
...
...
@@ -416,9 +413,9 @@ stateDependencyRelation _ _ = False
-- in the configuration given by the flag assignment, all the package
-- dependencies are satisfied by the specified packages.
--
configuredPackageValid
::
OS
->
Arch
->
CompilerId
->
ConfiguredPackage
->
Bool
configuredPackageValid
os
arch
comp
pkg
=
null
(
configuredPackageProblems
os
arch
comp
pkg
)
configuredPackageValid
::
Platform
->
CompilerId
->
ConfiguredPackage
->
Bool
configuredPackageValid
platform
comp
pkg
=
null
(
configuredPackageProblems
platform
comp
pkg
)
data
PackageProblem
=
DuplicateFlag
FlagName
|
MissingFlag
FlagName
...
...
@@ -456,9 +453,9 @@ showPackageProblem (InvalidDep dep pkgid) =
++
" but the configuration specifies "
++
display
pkgid
++
" which does not satisfy the dependency."
configuredPackageProblems
::
OS
->
Arch
->
CompilerId
configuredPackageProblems
::
Platform
->
CompilerId
->
ConfiguredPackage
->
[
PackageProblem
]
configuredPackageProblems
os
arch
comp
configuredPackageProblems
(
Platform
arch
os
)
comp
(
ConfiguredPackage
pkg
specifiedFlags
specifiedDeps
)
=
[
DuplicateFlag
flag
|
((
flag
,
_
)
:
_
)
<-
duplicates
specifiedFlags
]
++
[
MissingFlag
flag
|
OnlyInLeft
flag
<-
mergedFlags
]
...
...
cabal-install/Distribution/Client/InstallSymlink.hs
View file @
88a95a36
...
...
@@ -59,6 +59,8 @@ import Distribution.Simple.Setup
(
ConfigFlags
(
..
),
fromFlag
,
fromFlagOrDefault
,
flagToMaybe
)
import
qualified
Distribution.Simple.InstallDirs
as
InstallDirs
import
Distribution.Simple.PackageIndex
(
PackageIndex
)
import
Distribution.System
(
Platform
(
Platform
)
)
import
System.Posix.Files
(
getSymbolicLinkStatus
,
isSymbolicLink
,
readSymbolicLink
...
...
@@ -160,8 +162,7 @@ symlinkBinaries configFlags installFlags plan =
fromFlagTemplate
=
fromFlagOrDefault
(
InstallDirs
.
toPathTemplate
""
)
prefixTemplate
=
fromFlagTemplate
(
configProgPrefix
configFlags
)
suffixTemplate
=
fromFlagTemplate
(
configProgSuffix
configFlags
)
os
=
InstallPlan
.
planOS
plan
arch
=
InstallPlan
.
planArch
plan
(
Platform
arch
os
)
=
InstallPlan
.
planPlatform
plan
compilerId
@
(
CompilerId
compilerFlavor
_
)
=
InstallPlan
.
planCompiler
plan
symlinkBinary
::
FilePath
-- ^ The canonical path of the public bin dir
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment