Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
7e296257
Commit
7e296257
authored
Apr 12, 2020
by
Oleg Grenrus
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Trim end-of-line whitespace
parent
6458e7af
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
41 additions
and
41 deletions
+41
-41
cabal-install/Distribution/Client/CmdLegacy.hs
cabal-install/Distribution/Client/CmdLegacy.hs
+4
-4
cabal-install/Distribution/Client/CmdRepl.hs
cabal-install/Distribution/Client/CmdRepl.hs
+26
-26
cabal-install/Distribution/Client/FetchUtils.hs
cabal-install/Distribution/Client/FetchUtils.hs
+1
-1
cabal-install/Distribution/Client/ProjectPlanning.hs
cabal-install/Distribution/Client/ProjectPlanning.hs
+2
-2
cabal-install/Distribution/Client/TargetSelector.hs
cabal-install/Distribution/Client/TargetSelector.hs
+1
-1
cabal-install/Distribution/Client/Targets.hs
cabal-install/Distribution/Client/Targets.hs
+5
-5
cabal-install/Distribution/Solver/Types/InstSolverPackage.hs
cabal-install/Distribution/Solver/Types/InstSolverPackage.hs
+1
-1
cabal-install/Distribution/Solver/Types/PackageConstraint.hs
cabal-install/Distribution/Solver/Types/PackageConstraint.hs
+1
-1
No files found.
cabal-install/Distribution/Client/CmdLegacy.hs
View file @
7e296257
...
...
@@ -16,7 +16,7 @@ import qualified Distribution.Simple.Setup as Setup
import
Distribution.Simple.Command
import
Distribution.Simple.Utils
(
wrapText
)
import
Distribution.Verbosity
import
Distribution.Verbosity
(
Verbosity
,
normal
)
import
Control.Exception
...
...
@@ -50,7 +50,7 @@ wrapperAction command verbosityFlag distPrefFlag =
--
class
HasVerbosity
a
where
class
HasVerbosity
a
where
verbosity
::
a
->
Verbosity
instance
HasVerbosity
(
Setup
.
Flag
Verbosity
)
where
...
...
@@ -140,7 +140,7 @@ newCmd origUi@CommandUI{..} action = [cmd defaultUi, cmd newUi, cmd origUi]
cmd
ui
=
CommandSpec
ui
(
flip
commandAddAction
action
)
NormalCommand
newMsg
=
T
.
unpack
.
T
.
replace
"v2-"
"new-"
.
T
.
pack
newUi
=
origUi
newUi
=
origUi
{
commandName
=
newMsg
commandName
,
commandUsage
=
newMsg
.
commandUsage
,
commandDescription
=
(
newMsg
.
)
<$>
commandDescription
...
...
@@ -148,7 +148,7 @@ newCmd origUi@CommandUI{..} action = [cmd defaultUi, cmd newUi, cmd origUi]
}
defaultMsg
=
T
.
unpack
.
T
.
replace
"v2-"
""
.
T
.
pack
defaultUi
=
origUi
defaultUi
=
origUi
{
commandName
=
defaultMsg
commandName
,
commandUsage
=
defaultMsg
.
commandUsage
,
commandDescription
=
(
defaultMsg
.
)
<$>
commandDescription
...
...
cabal-install/Distribution/Client/CmdRepl.hs
View file @
7e296257
...
...
@@ -31,7 +31,7 @@ import Distribution.Client.ProjectConfig
(
ProjectConfig
(
..
),
withProjectOrGlobalConfigIgn
,
projectConfigConfigFile
)
import
Distribution.Client.ProjectOrchestration
import
Distribution.Client.ProjectPlanning
import
Distribution.Client.ProjectPlanning
(
ElaboratedSharedConfig
(
..
),
ElaboratedInstallPlan
)
import
Distribution.Client.ProjectPlanning.Types
(
elabOrderExeDependencies
)
...
...
@@ -109,7 +109,7 @@ import System.FilePath
type
ReplFlags
=
[
String
]
data
EnvFlags
=
EnvFlags
data
EnvFlags
=
EnvFlags
{
envPackages
::
[
Dependency
]
,
envIncludeTransitive
::
Flag
Bool
,
envIgnoreProject
::
Flag
Bool
...
...
@@ -234,7 +234,7 @@ replAction ( configFlags, configExFlags, installFlags
ignoreProject
=
fromFlagOrDefault
False
(
envIgnoreProject
envFlags
)
with
=
withProject
cliConfig
verbosity
targetStrings
without
config
=
withoutProject
(
config
<>
cliConfig
)
verbosity
targetStrings
(
baseCtx
,
targetSelectors
,
finalizer
,
replType
)
<-
withProjectOrGlobalConfigIgn
ignoreProject
verbosity
globalConfigFlag
with
without
...
...
@@ -252,38 +252,38 @@ replAction ( configFlags, configExFlags, installFlags
withInstallPlan
(
lessVerbose
verbosity
)
baseCtx
$
\
elaboratedPlan
_
->
do
-- targets should be non-empty map, but there's no NonEmptyMap yet.
targets
<-
validatedTargets
elaboratedPlan
targetSelectors
let
(
unitId
,
_
)
=
fromMaybe
(
error
"panic: targets should be non-empty"
)
$
safeHead
$
Map
.
toList
targets
originalDeps
=
installedUnitId
<$>
InstallPlan
.
directDeps
elaboratedPlan
unitId
oci
=
OriginalComponentInfo
unitId
originalDeps
pkgId
=
fromMaybe
(
error
$
"cannot find "
++
prettyShow
unitId
)
$
packageId
<$>
InstallPlan
.
lookup
elaboratedPlan
unitId
pkgId
=
fromMaybe
(
error
$
"cannot find "
++
prettyShow
unitId
)
$
packageId
<$>
InstallPlan
.
lookup
elaboratedPlan
unitId
baseCtx'
=
addDepsToProjectTarget
(
envPackages
envFlags
)
pkgId
baseCtx
return
(
Just
oci
,
baseCtx'
)
-- Now, we run the solver again with the added packages. While the graph
-- Now, we run the solver again with the added packages. While the graph
-- won't actually reflect the addition of transitive dependencies,
-- they're going to be available already and will be offered to the REPL
-- and that's good enough.
--
-- In addition, to avoid a *third* trip through the solver, we are
-- In addition, to avoid a *third* trip through the solver, we are
-- replicating the second half of 'runProjectPreBuildPhase' by hand
-- here.
(
buildCtx
,
replFlags''
)
<-
withInstallPlan
verbosity
baseCtx'
$
\
elaboratedPlan
elaboratedShared'
->
do
let
ProjectBaseContext
{
..
}
=
baseCtx'
-- Recalculate with updated project.
targets
<-
validatedTargets
elaboratedPlan
targetSelectors
let
let
elaboratedPlan'
=
pruneInstallPlanToTargets
TargetActionRepl
targets
elaboratedPlan
includeTransitive
=
fromFlagOrDefault
True
(
envIncludeTransitive
envFlags
)
pkgsBuildStatus
<-
rebuildTargetsDryRun
distDirLayout
elaboratedShared'
elaboratedPlan'
...
...
@@ -291,26 +291,26 @@ replAction ( configFlags, configExFlags, installFlags
pkgsBuildStatus
elaboratedPlan'
debugNoWrap
verbosity
(
InstallPlan
.
showInstallPlan
elaboratedPlan''
)
let
buildCtx
=
ProjectBuildContext
let
buildCtx
=
ProjectBuildContext
{
elaboratedPlanOriginal
=
elaboratedPlan
,
elaboratedPlanToExecute
=
elaboratedPlan''
,
elaboratedShared
=
elaboratedShared'
,
pkgsBuildStatus
,
targetsMap
=
targets
}
ElaboratedSharedConfig
{
pkgConfigCompiler
=
compiler
}
=
elaboratedShared'
-- First version of GHC where GHCi supported the flag we need.
-- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html
minGhciScriptVersion
=
mkVersion
[
7
,
6
]
replFlags'
=
case
originalComponent
of
replFlags'
=
case
originalComponent
of
Just
oci
->
generateReplFlags
includeTransitive
elaboratedPlan'
oci
Nothing
->
[]
replFlags''
=
case
replType
of
GlobalRepl
scriptPath
GlobalRepl
scriptPath
|
Just
version
<-
compilerCompatVersion
GHC
compiler
,
version
>=
minGhciScriptVersion
->
(
"-ghci-script"
++
scriptPath
)
:
replFlags'
_
->
replFlags'
...
...
@@ -334,7 +334,7 @@ replAction ( configFlags, configExFlags, installFlags
mempty
-- ClientInstallFlags, not needed here
haddockFlags
testFlags
benchmarkFlags
globalConfigFlag
=
projectConfigConfigFile
(
projectConfigShared
cliConfig
)
validatedTargets
elaboratedPlan
targetSelectors
=
do
-- Interpret the targets on the command line as repl targets
-- (as opposed to say build or haddock targets).
...
...
@@ -363,7 +363,7 @@ data OriginalComponentInfo = OriginalComponentInfo
deriving
(
Show
)
-- | Tracks what type of GHCi instance we're creating.
data
ReplType
=
ProjectRepl
data
ReplType
=
ProjectRepl
|
GlobalRepl
FilePath
-- ^ The 'FilePath' argument is path to a GHCi
-- script responsible for changing to the
-- correct directory. Only works on GHC geq
...
...
@@ -397,7 +397,7 @@ withoutProject config verbosity extraArgs = do
,
packageSource
=
LocalUnpackedPackage
tempDir
,
packageDescrOverride
=
Nothing
}
genericPackageDescription
=
emptyGenericPackageDescription
genericPackageDescription
=
emptyGenericPackageDescription
&
L
.
packageDescription
.~
packageDescription
&
L
.
condLibrary
.~
Just
(
CondNode
library
[
baseDep
]
[]
)
packageDescription
=
emptyPackageDescription
...
...
@@ -414,13 +414,13 @@ withoutProject config verbosity extraArgs = do
pkgId
=
fakePackageId
writeGenericPackageDescription
(
tempDir
</>
"fake-package.cabal"
)
genericPackageDescription
let
ghciScriptPath
=
tempDir
</>
"setcwd.ghci"
cwd
<-
getCurrentDirectory
writeFile
ghciScriptPath
(
":cd "
++
cwd
)
distDirLayout
<-
establishDummyDistDirLayout
verbosity
config
tempDir
baseCtx
<-
baseCtx
<-
establishDummyProjectBaseContext
verbosity
config
...
...
@@ -438,7 +438,7 @@ addDepsToProjectTarget :: [Dependency]
->
PackageId
->
ProjectBaseContext
->
ProjectBaseContext
addDepsToProjectTarget
deps
pkgId
ctx
=
addDepsToProjectTarget
deps
pkgId
ctx
=
(
\
p
->
ctx
{
localPackages
=
p
})
.
fmap
addDeps
.
localPackages
$
ctx
where
addDeps
::
PackageSpecifier
UnresolvedSourcePackage
...
...
@@ -446,7 +446,7 @@ addDepsToProjectTarget deps pkgId ctx =
addDeps
(
SpecificSourcePackage
pkg
)
|
packageId
pkg
/=
pkgId
=
SpecificSourcePackage
pkg
|
SourcePackage
{
..
}
<-
pkg
=
SpecificSourcePackage
$
pkg
{
packageDescription
=
SpecificSourcePackage
$
pkg
{
packageDescription
=
packageDescription
&
(
\
f
->
L
.
allCondTrees
$
traverseCondTreeC
f
)
%~
(
deps
++
)
}
...
...
@@ -456,8 +456,8 @@ generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> R
generateReplFlags
includeTransitive
elaboratedPlan
OriginalComponentInfo
{
..
}
=
flags
where
exeDeps
::
[
UnitId
]
exeDeps
=
foldMap
exeDeps
=
foldMap
(
InstallPlan
.
foldPlanPackage
(
const
[]
)
elabOrderExeDependencies
)
(
InstallPlan
.
dependencyClosure
elaboratedPlan
[
ociUnitId
])
...
...
cabal-install/Distribution/Client/FetchUtils.hs
View file @
7e296257
...
...
@@ -84,7 +84,7 @@ isFetched loc = case loc of
RemoteTarballPackage
_uri
local
->
return
(
isJust
local
)
RepoTarballPackage
repo
pkgid
_
->
doesFileExist
(
packageFile
repo
pkgid
)
RemoteSourceRepoPackage
_
local
->
return
(
isJust
local
)
-- | Checks if the package has already been fetched (or does not need
-- fetching) and if so returns evidence in the form of a 'PackageLocation'
...
...
cabal-install/Distribution/Client/ProjectPlanning.hs
View file @
7e296257
...
...
@@ -2981,9 +2981,9 @@ newtype CannotPruneDependencies =
-- less than 1.23.
--
-- In cases 1 and 2 we obviously have to build an external Setup.hs script,
-- while in case 4 we can use the internal library API.
-- while in case 4 we can use the internal library API.
--
-- TODO:In case 3 we should fail. We don't know how to talk to
-- TODO:In case 3 we should fail. We don't know how to talk to
-- newer ./Setup.hs
--
-- data SetupScriptStyle = ... -- see ProjectPlanning.Types
...
...
cabal-install/Distribution/Client/TargetSelector.hs
View file @
7e296257
...
...
@@ -87,7 +87,7 @@ import qualified Data.Map.Lazy as Map.Lazy
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Set
as
Set
import
Control.Arrow
((
&&&
))
import
Control.Monad
import
Control.Monad
hiding
(
mfilter
)
import
qualified
Distribution.Deprecated.ReadP
as
Parse
import
Distribution.Deprecated.ReadP
...
...
cabal-install/Distribution/Client/Targets.hs
View file @
7e296257
...
...
@@ -515,7 +515,7 @@ readPackageTarget verbosity = traverse modifyLocation
_
->
False
parsePackageDescription'
::
BS
.
ByteString
->
Maybe
GenericPackageDescription
parsePackageDescription'
bs
=
parsePackageDescription'
bs
=
parseGenericPackageDescriptionMaybe
(
BS
.
toStrict
bs
)
-- ------------------------------------------------------------
...
...
@@ -703,7 +703,7 @@ fromUserConstraintScope (UserAnyQualifier pn) = ScopeAnyQualifier pn
data
UserConstraint
=
UserConstraint
UserConstraintScope
PackageProperty
deriving
(
Eq
,
Show
,
Generic
)
instance
Binary
UserConstraint
instance
Structured
UserConstraint
...
...
@@ -732,7 +732,7 @@ readUserConstraint str =
instance
Text
UserConstraint
where
disp
(
UserConstraint
scope
prop
)
=
dispPackageConstraint
$
PackageConstraint
(
fromUserConstraintScope
scope
)
prop
parse
=
let
parseConstraintScope
::
Parse
.
ReadP
a
UserConstraintScope
parseConstraintScope
=
...
...
@@ -765,7 +765,7 @@ instance Text UserConstraint where
-- return (UserQualExe pn pn2, pn3)
in
do
scope
<-
parseConstraintScope
-- Package property
let
keyword
str
x
=
Parse
.
skipSpaces1
>>
Parse
.
string
str
>>
return
x
prop
<-
((
parse
>>=
return
.
PackagePropertyVersion
)
...
...
@@ -783,6 +783,6 @@ instance Text UserConstraint where
<++
(
Parse
.
skipSpaces1
>>
parseFlagAssignment
>>=
return
.
PackagePropertyFlags
)
-- Result
return
(
UserConstraint
scope
prop
)
cabal-install/Distribution/Solver/Types/InstSolverPackage.hs
View file @
7e296257
{-# LANGUAGE DeriveGeneric #-}
module
Distribution.Solver.Types.InstSolverPackage
module
Distribution.Solver.Types.InstSolverPackage
(
InstSolverPackage
(
..
)
)
where
...
...
cabal-install/Distribution/Solver/Types/PackageConstraint.hs
View file @
7e296257
...
...
@@ -145,7 +145,7 @@ showPackageConstraint pc@(PackageConstraint scope prop) =
packageConstraintToDependency
::
PackageConstraint
->
Maybe
Dependency
packageConstraintToDependency
(
PackageConstraint
scope
prop
)
=
toDep
prop
where
toDep
(
PackagePropertyVersion
vr
)
=
toDep
(
PackagePropertyVersion
vr
)
=
Just
$
Dependency
(
scopeToPackageName
scope
)
vr
(
Set
.
singleton
LMainLibName
)
toDep
(
PackagePropertyInstalled
)
=
Nothing
toDep
(
PackagePropertySource
)
=
Nothing
...
...
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