Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
f0a513bf
Commit
f0a513bf
authored
Jul 30, 2015
by
Mikhail Glushenkov
Browse files
Whitespace, 80-col violations.
parent
628a5d55
Changes
9
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/BuildReports/Storage.hs
View file @
f0a513bf
...
...
@@ -75,7 +75,8 @@ storeAnonymous reports = sequence_
.
onlyRemote
repoName
(
_
,
_
,
rrepo
)
=
remoteRepoName
rrepo
onlyRemote
::
[(
BuildReport
,
Maybe
Repo
)]
->
[(
BuildReport
,
Repo
,
RemoteRepo
)]
onlyRemote
::
[(
BuildReport
,
Maybe
Repo
)]
->
[(
BuildReport
,
Repo
,
RemoteRepo
)]
onlyRemote
rs
=
[
(
report
,
repo
,
remoteRepo
)
|
(
report
,
Just
repo
@
Repo
{
repoKind
=
Left
remoteRepo
})
<-
rs
]
...
...
@@ -147,7 +148,8 @@ fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
_
->
Nothing
where
extractRepo
(
SourcePackage
{
packageSource
=
RepoTarballPackage
repo
_
_
})
=
Just
repo
extractRepo
(
SourcePackage
{
packageSource
=
RepoTarballPackage
repo
_
_
})
=
Just
repo
extractRepo
_
=
Nothing
fromPlanningFailure
::
Platform
->
CompilerId
...
...
cabal-install/Distribution/Client/Configure.hs
View file @
f0a513bf
...
...
@@ -112,8 +112,8 @@ configure verbosity packageDBs repos comp platform conf
"Warning: solver failed to find a solution:
\n
"
++
message
++
"Trying configure anyway."
setupWrapper
verbosity
(
setupScriptOptions
installedPkgIndex
Nothing
)
Nothing
configureCommand
(
const
configFlags
)
extraArgs
setupWrapper
verbosity
(
setupScriptOptions
installedPkgIndex
Nothing
)
Nothing
configureCommand
(
const
configFlags
)
extraArgs
Right
installPlan
->
case
InstallPlan
.
ready
installPlan
of
[
pkg
@
(
ReadyPackage
...
...
@@ -230,10 +230,12 @@ planLocalPackage :: Verbosity -> Compiler
->
InstalledPackageIndex
->
SourcePackageDb
->
IO
(
Progress
String
String
InstallPlan
)
planLocalPackage
verbosity
comp
platform
configFlags
configExFlags
installedPkgIndex
planLocalPackage
verbosity
comp
platform
configFlags
configExFlags
installedPkgIndex
(
SourcePackageDb
_
packagePrefs
)
=
do
pkg
<-
readPackageDescription
verbosity
=<<
defaultPackageDesc
verbosity
solver
<-
chooseSolver
verbosity
(
fromFlag
$
configSolver
configExFlags
)
(
compilerInfo
comp
)
solver
<-
chooseSolver
verbosity
(
fromFlag
$
configSolver
configExFlags
)
(
compilerInfo
comp
)
let
-- We create a local package and ask to resolve a dependency on it
localPkg
=
SourcePackage
{
...
...
cabal-install/Distribution/Client/Dependency.hs
View file @
f0a513bf
...
...
@@ -151,9 +151,11 @@ debugDepResolverParams :: DepResolverParams -> String
debugDepResolverParams
p
=
"targets: "
++
intercalate
", "
(
map
display
(
depResolverTargets
p
))
++
"
\n
constraints: "
++
concatMap
((
"
\n
"
++
)
.
debugPackageConstraint
)
(
depResolverConstraints
p
)
++
concatMap
((
"
\n
"
++
)
.
debugPackageConstraint
)
(
depResolverConstraints
p
)
++
"
\n
preferences: "
++
concatMap
((
"
\n
"
++
)
.
debugPackagePreference
)
(
depResolverPreferences
p
)
++
concatMap
((
"
\n
"
++
)
.
debugPackagePreference
)
(
depResolverPreferences
p
)
++
"
\n
strategy: "
++
show
(
depResolverPreferenceDefault
p
)
-- | A package selection preference for a particular package.
...
...
@@ -701,7 +703,8 @@ configuredPackageProblems platform cinfo
++
[
MissingFlag
flag
|
OnlyInLeft
flag
<-
mergedFlags
]
++
[
ExtraFlag
flag
|
OnlyInRight
flag
<-
mergedFlags
]
++
[
DuplicateDeps
pkgs
|
pkgs
<-
CD
.
nonSetupDeps
(
fmap
(
duplicatesBy
(
comparing
packageName
))
specifiedDeps
)
]
|
pkgs
<-
CD
.
nonSetupDeps
(
fmap
(
duplicatesBy
(
comparing
packageName
))
specifiedDeps
)
]
++
[
MissingDep
dep
|
OnlyInLeft
dep
<-
mergedDeps
]
++
[
ExtraDep
pkgid
|
OnlyInRight
pkgid
<-
mergedDeps
]
++
[
InvalidDep
dep
pkgid
|
InBoth
dep
pkgid
<-
mergedDeps
...
...
@@ -724,7 +727,8 @@ configuredPackageProblems platform cinfo
mergedDeps
::
[
MergeResult
Dependency
PackageId
]
mergedDeps
=
mergeDeps
requiredDeps
(
CD
.
flatDeps
specifiedDeps
)
mergeDeps
::
[
Dependency
]
->
[
PackageId
]
->
[
MergeResult
Dependency
PackageId
]
mergeDeps
::
[
Dependency
]
->
[
PackageId
]
->
[
MergeResult
Dependency
PackageId
]
mergeDeps
required
specified
=
let
sortNubOn
f
=
nubBy
((
==
)
`
on
`
f
)
.
sortBy
(
compare
`
on
`
f
)
in
mergeBy
...
...
@@ -732,13 +736,13 @@ configuredPackageProblems platform cinfo
(
sortNubOn
dependencyName
required
)
(
sortNubOn
packageName
specified
)
-- TODO: It would be nicer to use ComponentDeps here so we can be more
precise
-- in our checks. That's a bit tricky though, as this currently
relies on
-- the 'buildDepends' field of 'PackageDescription'. (OTOH, that
field is
-- deprecated and should be removed anyway.)
--
As long as we _do_
use a flat list here, we have to allow for duplicates
--
when we fold
specifiedDeps; once we have proper ComponentDeps here we
--
should get rid
of the `nubOn` in `mergeDeps`.
-- TODO: It would be nicer to use ComponentDeps here so we can be more
--
precise
in our checks. That's a bit tricky though, as this currently
--
relies on
the 'buildDepends' field of 'PackageDescription'. (OTOH, that
--
field is
deprecated and should be removed anyway.)
As long as we _do_
-- use a flat list here, we have to allow for duplicates
when we fold
-- specifiedDeps; once we have proper ComponentDeps here we
should get rid
-- of the `nubOn` in `mergeDeps`.
requiredDeps
::
[
Dependency
]
requiredDeps
=
--TODO: use something lower level than finalizePackageDescription
...
...
cabal-install/Distribution/Client/Freeze.hs
View file @
f0a513bf
...
...
@@ -89,7 +89,8 @@ freeze verbosity packageDBs repos comp platform conf mSandboxPkgInfo
installedPkgIndex
<-
getInstalledPackages
verbosity
comp
packageDBs
conf
sourcePkgDb
<-
getSourcePackages
verbosity
repos
transport
<-
configureTransport
verbosity
(
flagToMaybe
(
globalHttpTransport
globalFlags
))
transport
<-
configureTransport
verbosity
(
flagToMaybe
(
globalHttpTransport
globalFlags
))
pkgSpecifiers
<-
resolveUserTargets
verbosity
transport
(
fromFlag
$
globalWorldFile
globalFlags
)
...
...
cabal-install/Distribution/Client/Install.hs
View file @
f0a513bf
...
...
@@ -230,7 +230,8 @@ install verbosity packageDBs repos comp platform conf useSandbox mSandboxPkgInfo
-- TODO: Make InstallContext a proper data type with documented fields.
-- | Common context for makeInstallPlan and processInstallPlan.
type
InstallContext
=
(
InstalledPackageIndex
,
SourcePackageDb
,
[
UserTarget
],
[
PackageSpecifier
SourcePackage
],
HttpTransport
)
,
[
UserTarget
],
[
PackageSpecifier
SourcePackage
]
,
HttpTransport
)
-- TODO: Make InstallArgs a proper data type with documented fields or just get
-- rid of it completely.
...
...
@@ -257,7 +258,8 @@ makeInstallContext verbosity
installedPkgIndex
<-
getInstalledPackages
verbosity
comp
packageDBs
conf
sourcePkgDb
<-
getSourcePackages
verbosity
repos
transport
<-
configureTransport
verbosity
(
flagToMaybe
(
globalHttpTransport
globalFlags
))
transport
<-
configureTransport
verbosity
(
flagToMaybe
(
globalHttpTransport
globalFlags
))
(
userTargets
,
pkgSpecifiers
)
<-
case
mUserTargets
of
Nothing
->
...
...
@@ -277,7 +279,8 @@ makeInstallContext verbosity
userTargets
return
(
userTargets
,
pkgSpecifiers
)
return
(
installedPkgIndex
,
sourcePkgDb
,
userTargets
,
pkgSpecifiers
,
transport
)
return
(
installedPkgIndex
,
sourcePkgDb
,
userTargets
,
pkgSpecifiers
,
transport
)
-- | Make an install plan given install context and install arguments.
makeInstallPlan
::
Verbosity
->
InstallArgs
->
InstallContext
...
...
@@ -508,7 +511,8 @@ checkPrintPlan verbosity installed installPlan sourcePkgDb
:
map
(
display
.
Installed
.
sourcePackageId
)
newBrokenPkgs
++
if
overrideReinstall
then
if
dryRun
then
[]
else
[
"Continuing even though the plan contains dangerous reinstalls."
]
[
"Continuing even though "
++
"the plan contains dangerous reinstalls."
]
else
[
"Use --force-reinstalls if you want to install anyway."
]
else
unless
dryRun
$
warn
verbosity
...
...
@@ -591,8 +595,10 @@ packageStatus installedPkgIndex cpkg =
->
[
MergeResult
PackageIdentifier
PackageIdentifier
]
changes
pkg
pkg'
=
filter
changed
$
mergeBy
(
comparing
packageName
)
(
resolveInstalledIds
$
Installed
.
depends
pkg
)
-- deps of installed pkg
(
resolveInstalledIds
$
CD
.
nonSetupDeps
(
depends
pkg'
))
-- deps of configured pkg
-- deps of installed pkg
(
resolveInstalledIds
$
Installed
.
depends
pkg
)
-- deps of configured pkg
(
resolveInstalledIds
$
CD
.
nonSetupDeps
(
depends
pkg'
))
-- convert to source pkg ids via index
resolveInstalledIds
::
[
InstalledPackageId
]
->
[
PackageIdentifier
]
...
...
@@ -690,7 +696,8 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
-- | Report a solver failure. This works slightly differently to
-- 'postInstallActions', as (by definition) we don't have an install plan.
reportPlanningFailure
::
Verbosity
->
InstallArgs
->
InstallContext
->
String
->
IO
()
reportPlanningFailure
::
Verbosity
->
InstallArgs
->
InstallContext
->
String
->
IO
()
reportPlanningFailure
verbosity
(
_
,
_
,
comp
,
platform
,
_
,
_
,
_
,
_
,
configFlags
,
_
,
installFlags
,
_
)
...
...
@@ -700,12 +707,13 @@ reportPlanningFailure verbosity
when
reportFailure
$
do
-- Only create reports for explicitly named packages
let
pkgids
=
filter
(
SourcePackageIndex
.
elemByPackageId
(
packageIndex
sourcePkgDb
))
$
let
pkgids
=
filter
(
SourcePackageIndex
.
elemByPackageId
(
packageIndex
sourcePkgDb
))
$
mapMaybe
theSpecifiedPackage
pkgSpecifiers
buildReports
=
BuildReports
.
fromPlanningFailure
platform
(
compilerId
comp
)
pkgids
(
configConfigurationsFlags
configFlags
)
buildReports
=
BuildReports
.
fromPlanningFailure
platform
(
compilerId
comp
)
pkgids
(
configConfigurationsFlags
configFlags
)
when
(
not
(
null
buildReports
))
$
info
verbosity
$
...
...
@@ -714,7 +722,8 @@ reportPlanningFailure verbosity
-- Save reports
BuildReports
.
storeLocal
(
compilerInfo
comp
)
(
fromNubList
$
installSummaryFile
installFlags
)
buildReports
platform
(
fromNubList
$
installSummaryFile
installFlags
)
buildReports
platform
-- Save solver log
case
logFile
of
...
...
@@ -734,7 +743,8 @@ reportPlanningFailure verbosity
-- So we fail.
dummyLibraryName
=
error
"reportPlanningFailure: library name not available"
-- | If a 'PackageSpecifier' refers to a single package, return Just that package.
-- | If a 'PackageSpecifier' refers to a single package, return Just that
-- package.
theSpecifiedPackage
::
Package
pkg
=>
PackageSpecifier
pkg
->
Maybe
PackageId
theSpecifiedPackage
pkgSpec
=
case
pkgSpec
of
...
...
@@ -1031,7 +1041,8 @@ performInstallations verbosity
installLock
<-
newLock
-- serialise installation
cacheLock
<-
newLock
-- serialise access to setup exe cache
transport
<-
configureTransport
verbosity
(
flagToMaybe
(
globalHttpTransport
globalFlags
))
transport
<-
configureTransport
verbosity
(
flagToMaybe
(
globalHttpTransport
globalFlags
))
executeInstallPlan
verbosity
comp
jobControl
useLogFile
installPlan
$
\
rpkg
->
-- Calculate the package key (ToDo: Is this right for source install)
...
...
@@ -1042,8 +1053,10 @@ performInstallations verbosity
installLocalPackage
verbosity
buildLimit
(
packageId
pkg
)
src'
distPref
$
\
mpath
->
installUnpackedPackage
verbosity
buildLimit
installLock
numJobs
libname
(
setupScriptOptions
installedPkgIndex
cacheLock
rpkg
)
miscOptions
configFlags'
installFlags
haddockFlags
(
setupScriptOptions
installedPkgIndex
cacheLock
rpkg
)
miscOptions
configFlags'
installFlags
haddockFlags
cinfo
platform
pkg
pkgoverride
mpath
useLogFile
where
...
...
@@ -1108,7 +1121,8 @@ performInstallations verbosity
|
parallelInstall
=
False
|
otherwise
=
False
substLogFileName
::
PathTemplate
->
PackageIdentifier
->
LibraryName
->
FilePath
substLogFileName
::
PathTemplate
->
PackageIdentifier
->
LibraryName
->
FilePath
substLogFileName
template
pkg
libname
=
fromPathTemplate
.
substPathTemplate
env
$
template
...
...
@@ -1416,7 +1430,8 @@ installUnpackedPackage verbosity buildLimit installLock numJobs libname
maybePkgConf
<-
maybeGenPkgConf
mLogPath
-- Actual installation
withWin32SelfUpgrade
verbosity
libname
configFlags
cinfo
platform
pkg
$
do
withWin32SelfUpgrade
verbosity
libname
configFlags
cinfo
platform
pkg
$
do
case
rootCmd
miscOptions
of
(
Just
cmd
)
->
reexec
cmd
Nothing
->
do
...
...
@@ -1588,4 +1603,5 @@ withWin32SelfUpgrade verbosity libname configFlags cinfo platform pkg action = d
platform
templateDirs
substTemplate
=
InstallDirs
.
fromPathTemplate
.
InstallDirs
.
substPathTemplate
env
where
env
=
InstallDirs
.
initialPathTemplateEnv
pkgid
libname
cinfo
platform
where
env
=
InstallDirs
.
initialPathTemplateEnv
pkgid
libname
cinfo
platform
cabal-install/Distribution/Client/InstallPlan.hs
View file @
f0a513bf
...
...
@@ -215,7 +215,8 @@ showInstallPlan :: (HasInstalledPackageId ipkg, HasInstalledPackageId srcpkg)
=>
GenericInstallPlan
ipkg
srcpkg
iresult
ifailure
->
String
showInstallPlan
plan
=
showPlanIndex
(
planIndex
plan
)
++
"
\n
"
++
"fake map:
\n
"
++
intercalate
"
\n
"
(
map
showKV
(
Map
.
toList
(
planFakeMap
plan
)))
"fake map:
\n
"
++
intercalate
"
\n
"
(
map
showKV
(
Map
.
toList
(
planFakeMap
plan
)))
where
showKV
(
k
,
v
)
=
display
k
++
" -> "
++
display
v
showPlanPackageTag
::
GenericPlanPackage
ipkg
srcpkg
iresult
ifailure
->
String
...
...
@@ -239,7 +240,8 @@ new indepGoals index =
let
isPreExisting
(
PreExisting
_
)
=
True
isPreExisting
_
=
False
fakeMap
=
Map
.
fromList
.
map
(
\
p
->
(
fakeInstalledPackageId
(
packageId
p
),
installedPackageId
p
))
.
map
(
\
p
->
(
fakeInstalledPackageId
(
packageId
p
)
,
installedPackageId
p
))
.
filter
isPreExisting
$
PackageIndex
.
allPackages
index
in
case
problems
fakeMap
indepGoals
index
of
...
...
@@ -307,9 +309,11 @@ ready plan = assert check readyPackages
isInstalledDep
::
InstalledPackageId
->
Maybe
ipkg
isInstalledDep
pkgid
=
-- NB: Need to check if the ID has been updated in planFakeMap, in which case we
-- might be dealing with an old pointer
case
PlanIndex
.
fakeLookupInstalledPackageId
(
planFakeMap
plan
)
(
planIndex
plan
)
pkgid
of
-- NB: Need to check if the ID has been updated in planFakeMap, in which
-- case we might be dealing with an old pointer
case
PlanIndex
.
fakeLookupInstalledPackageId
(
planFakeMap
plan
)
(
planIndex
plan
)
pkgid
of
Just
(
PreExisting
ipkg
)
->
Just
ipkg
Just
(
Configured
_
)
->
Nothing
Just
(
Processing
_
)
->
Nothing
...
...
@@ -413,7 +417,8 @@ lookupProcessingPackage plan pkgid =
-- planFakeMap
case
PackageIndex
.
lookupInstalledPackageId
(
planIndex
plan
)
pkgid
of
Just
(
Processing
pkg
)
->
pkg
_
->
internalError
$
"not in processing state or no such pkg "
++
display
pkgid
_
->
internalError
$
"not in processing state or no such pkg "
++
display
pkgid
-- | Check a package that we expect to be in the configured or failed state.
--
...
...
@@ -494,18 +499,24 @@ problems :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
->
[
PlanProblem
ipkg
srcpkg
iresult
ifailure
]
problems
fakeMap
indepGoals
index
=
[
PackageMissingDeps
pkg
(
catMaybes
(
map
(
fmap
packageId
.
PlanIndex
.
fakeLookupInstalledPackageId
fakeMap
index
)
missingDeps
))
[
PackageMissingDeps
pkg
(
catMaybes
(
map
(
fmap
packageId
.
PlanIndex
.
fakeLookupInstalledPackageId
fakeMap
index
)
missingDeps
))
|
(
pkg
,
missingDeps
)
<-
PlanIndex
.
brokenPackages
fakeMap
index
]
++
[
PackageCycle
cycleGroup
|
cycleGroup
<-
PlanIndex
.
dependencyCycles
fakeMap
index
]
++
[
PackageInconsistency
name
inconsistencies
|
(
name
,
inconsistencies
)
<-
PlanIndex
.
dependencyInconsistencies
fakeMap
indepGoals
index
]
|
(
name
,
inconsistencies
)
<-
PlanIndex
.
dependencyInconsistencies
fakeMap
indepGoals
index
]
++
[
PackageStateInvalid
pkg
pkg'
|
pkg
<-
PackageIndex
.
allPackages
index
,
Just
pkg'
<-
map
(
PlanIndex
.
fakeLookupInstalledPackageId
fakeMap
index
)
(
CD
.
nonSetupDeps
(
depends
pkg
))
,
Just
pkg'
<-
map
(
PlanIndex
.
fakeLookupInstalledPackageId
fakeMap
index
)
(
CD
.
nonSetupDeps
(
depends
pkg
))
,
not
(
stateDependencyRelation
pkg
pkg'
)
]
-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
...
...
@@ -590,8 +601,10 @@ dependencyClosure :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
HasInstalledPackageId
srcpkg
,
PackageFixedDeps
srcpkg
)
=>
GenericInstallPlan
ipkg
srcpkg
iresult
ifailure
->
[
PackageIdentifier
]
->
Either
[(
GenericPlanPackage
ipkg
srcpkg
iresult
ifailure
,
[
InstalledPackageId
])]
(
PackageIndex
(
GenericPlanPackage
ipkg
srcpkg
iresult
ifailure
))
->
Either
[(
GenericPlanPackage
ipkg
srcpkg
iresult
ifailure
,
[
InstalledPackageId
])]
(
PackageIndex
(
GenericPlanPackage
ipkg
srcpkg
iresult
ifailure
))
dependencyClosure
installPlan
pids
=
PlanIndex
.
dependencyClosure
(
planFakeMap
installPlan
)
...
...
cabal-install/Distribution/Client/InstallSymlink.hs
View file @
f0a513bf
...
...
@@ -131,7 +131,8 @@ symlinkBinaries platform comp configFlags installFlags plan =
|
(
ReadyPackage
(
ConfiguredPackage
_
_flags
_
_
)
deps
,
pkg
,
exe
)
<-
exes
,
let
pkgid
=
packageId
pkg
pkg_key
=
mkPackageKey
(
packageKeySupported
comp
)
pkgid
(
map
Installed
.
libraryName
(
CD
.
nonSetupDeps
deps
))
(
map
Installed
.
libraryName
(
CD
.
nonSetupDeps
deps
))
libname
=
packageKeyLibraryName
pkgid
pkg_key
publicExeName
=
PackageDescription
.
exeName
exe
privateExeName
=
prefix
++
publicExeName
++
suffix
...
...
cabal-install/Distribution/Client/Utils/LabeledGraph.hs
View file @
f0a513bf
...
...
@@ -51,8 +51,10 @@ graphFromEdges edges0 =
sorted_edges
=
sortBy
lt
edges0
edges1
=
zipWith
(,)
[
0
..
]
sorted_edges
graph
=
array
bounds0
[(
v
,
(
mapMaybe
mk_edge
ks
))
|
(
v
,
(
_
,
_
,
ks
))
<-
edges1
]
key_map
=
array
bounds0
[(
v
,
k
)
|
(
v
,
(
_
,
k
,
_
))
<-
edges1
]
graph
=
array
bounds0
[(
v
,
(
mapMaybe
mk_edge
ks
))
|
(
v
,
(
_
,
_
,
ks
))
<-
edges1
]
key_map
=
array
bounds0
[(
v
,
k
)
|
(
v
,
(
_
,
k
,
_
))
<-
edges1
]
vertex_map
=
array
bounds0
edges1
(
_
,
k1
,
_
)
`
lt
`
(
_
,
k2
,
_
)
=
k1
`
compare
`
k2
...
...
cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs
View file @
f0a513bf
...
...
@@ -20,7 +20,8 @@ import qualified Data.Map as Map
-- Cabal
import
qualified
Distribution.Compiler
as
C
import
qualified
Distribution.InstalledPackageInfo
as
C
import
qualified
Distribution.Package
as
C
hiding
(
HasInstalledPackageId
(
..
))
import
qualified
Distribution.Package
as
C
hiding
(
HasInstalledPackageId
(
..
))
import
qualified
Distribution.PackageDescription
as
C
import
qualified
Distribution.Simple.PackageIndex
as
C.PackageIndex
import
qualified
Distribution.System
as
C
...
...
@@ -102,8 +103,10 @@ data ExampleAvailable = ExAv {
,
exAvDeps
::
ComponentDeps
[
ExampleDependency
]
}
exAv
::
ExamplePkgName
->
ExamplePkgVersion
->
[
ExampleDependency
]
->
ExampleAvailable
exAv
n
v
ds
=
ExAv
{
exAvName
=
n
,
exAvVersion
=
v
,
exAvDeps
=
CD
.
fromLibraryDeps
ds
}
exAv
::
ExamplePkgName
->
ExamplePkgVersion
->
[
ExampleDependency
]
->
ExampleAvailable
exAv
n
v
ds
=
ExAv
{
exAvName
=
n
,
exAvVersion
=
v
,
exAvDeps
=
CD
.
fromLibraryDeps
ds
}
withSetupDeps
::
ExampleAvailable
->
[
ExampleDependency
]
->
ExampleAvailable
withSetupDeps
ex
setupDeps
=
ex
{
...
...
@@ -117,7 +120,8 @@ data ExampleInstalled = ExInst {
,
exInstBuildAgainst
::
[
ExampleInstalled
]
}
exInst
::
ExamplePkgName
->
ExamplePkgVersion
->
ExamplePkgHash
->
[
ExampleInstalled
]
->
ExampleInstalled
exInst
::
ExamplePkgName
->
ExamplePkgVersion
->
ExamplePkgHash
->
[
ExampleInstalled
]
->
ExampleInstalled
exInst
=
ExInst
type
ExampleDb
=
[
Either
ExampleInstalled
ExampleAvailable
]
...
...
@@ -146,10 +150,12 @@ exAvSrcPkg ex =
C
.
setupDepends
=
mkSetupDeps
(
CD
.
setupDeps
(
exAvDeps
ex
))
}
}
,
C
.
genPackageFlags
=
concatMap
extractFlags
(
CD
.
libraryDeps
(
exAvDeps
ex
))
,
C
.
genPackageFlags
=
concatMap
extractFlags
(
CD
.
libraryDeps
(
exAvDeps
ex
))
,
C
.
condLibrary
=
Just
$
mkCondTree
libraryDeps
,
C
.
condExecutables
=
[]
,
C
.
condTestSuites
=
map
(
\
(
t
,
deps
)
->
(
t
,
mkCondTree
deps
))
testSuites
,
C
.
condTestSuites
=
map
(
\
(
t
,
deps
)
->
(
t
,
mkCondTree
deps
))
testSuites
,
C
.
condBenchmarks
=
[]
}
}
...
...
@@ -159,10 +165,12 @@ exAvSrcPkg ex =
,
[(
ExampleTestName
,
[
ExampleDependency
])]
)
splitTopLevel
[]
=
(
[]
,
[]
)
splitTopLevel
(
ExTest
t
a
:
deps
)
=
let
(
other
,
testSuites
)
=
splitTopLevel
deps
in
(
other
,
(
t
,
a
)
:
testSuites
)
splitTopLevel
(
dep
:
deps
)
=
let
(
other
,
testSuites
)
=
splitTopLevel
deps
in
(
dep
:
other
,
testSuites
)
splitTopLevel
(
ExTest
t
a
:
deps
)
=
let
(
other
,
testSuites
)
=
splitTopLevel
deps
in
(
other
,
(
t
,
a
)
:
testSuites
)
splitTopLevel
(
dep
:
deps
)
=
let
(
other
,
testSuites
)
=
splitTopLevel
deps
in
(
dep
:
other
,
testSuites
)
extractFlags
::
ExampleDependency
->
[
C
.
Flag
]
extractFlags
(
ExAny
_
)
=
[]
...
...
@@ -193,7 +201,8 @@ exAvSrcPkg ex =
mkFlagged
::
Monoid
a
=>
(
ExampleFlagName
,
[
ExampleDependency
],
[
ExampleDependency
])
->
(
C
.
Condition
C
.
ConfVar
,
DependencyTree
a
,
Maybe
(
DependencyTree
a
))
->
(
C
.
Condition
C
.
ConfVar
,
DependencyTree
a
,
Maybe
(
DependencyTree
a
))
mkFlagged
(
f
,
a
,
b
)
=
(
C
.
Var
(
C
.
Flag
(
C
.
FlagName
f
))
,
mkCondTree
a
,
Just
(
mkCondTree
b
)
...
...
@@ -274,7 +283,8 @@ exResolve db targets indepGoals = runProgress $
packageIndex
=
exAvIdx
avai
,
packagePreferences
=
Map
.
empty
}
enableTests
=
map
(
\
p
->
PackageConstraintStanzas
(
C
.
PackageName
p
)
[
TestStanzas
])
enableTests
=
map
(
\
p
->
PackageConstraintStanzas
(
C
.
PackageName
p
)
[
TestStanzas
])
(
exDbPkgs
db
)
targets'
=
map
(
\
p
->
NamedPackage
(
C
.
PackageName
p
)
[]
)
targets
params
=
addConstraints
enableTests
...
...
@@ -292,7 +302,8 @@ extractInstallPlan = catMaybes . map confPkg . CI.InstallPlan.toList
srcPkg
::
ConfiguredPackage
->
(
String
,
Int
)
srcPkg
(
ConfiguredPackage
pkg
_flags
_stanzas
_deps
)
=
let
C
.
PackageIdentifier
(
C
.
PackageName
p
)
(
Version
(
n
:
_
)
_
)
=
packageInfoId
pkg
let
C
.
PackageIdentifier
(
C
.
PackageName
p
)
(
Version
(
n
:
_
)
_
)
=
packageInfoId
pkg
in
(
p
,
n
)
{-------------------------------------------------------------------------------
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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