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
076c96dd
Commit
076c96dd
authored
Jun 26, 2018
by
Alexis Williams
Browse files
Use less ad-hoc method to detect absence of project
parent
cec2b878
Changes
1
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/CmdUpdate.hs
View file @
076c96dd
{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards, ViewPatterns,
{-# LANGUAGE CPP,
LambdaCase,
NamedFieldPuns, RecordWildCards, ViewPatterns,
TupleSections #-}
-- | cabal-install CLI command: update
...
...
@@ -17,9 +17,10 @@ import Distribution.Client.ProjectOrchestration
import
Distribution.Client.ProjectConfig
(
ProjectConfig
(
..
)
,
ProjectConfigShared
(
projectConfigProjectFile
,
projectConfigConfigFile
)
,
ProjectRoot
(
ProjectRootExplicit
)
,
projectConfigWithSolverRepoContext
,
findProjectRoot
,
readGlobalConfig
)
,
findProjectRoot
,
readGlobalConfig
,
BadPackageLocations
(
..
),
BadPackageLocation
(
..
)
,
ProjectConfigProvenance
(
..
)
)
import
Distribution.Client.Types
(
Repo
(
..
),
RemoteRepo
(
..
),
isRepoRemote
)
import
Distribution.Client.HttpUtils
...
...
@@ -52,6 +53,8 @@ import qualified Distribution.Compat.ReadP as ReadP
import
qualified
Text.PrettyPrint
as
Disp
import
Control.Monad
(
unless
,
when
)
import
Control.Exception
(
catch
,
throwIO
)
import
qualified
Data.Set
as
Set
import
qualified
Data.ByteString.Lazy
as
BS
import
Distribution.Client.GZipUtils
(
maybeDecompress
)
import
System.FilePath
((
<.>
),
dropExtension
)
...
...
@@ -117,16 +120,19 @@ updateAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
->
[
String
]
->
GlobalFlags
->
IO
()
updateAction
(
configFlags
,
configExFlags
,
installFlags
,
haddockFlags
)
extraArgs
globalFlags
=
do
let
mprojectFile
=
flagToMaybe
(
projectConfigProjectFile
.
projectConfigShared
$
cliConfig
)
eprojectRoot
<-
findProjectRoot
Nothing
mprojectFile
projectConfig
<-
case
eprojectRoot
of
Right
(
ProjectRootExplicit
_root
_config
)
->
projectConfig
<$>
establishProjectBaseContext
verbosity
cliConfig
_
->
do
let
globalConfigFlag
=
projectConfigConfigFile
(
projectConfigShared
cliConfig
)
globalConfig
<-
runRebuild
""
$
readGlobalConfig
verbosity
globalConfigFlag
return
(
globalConfig
<>
cliConfig
)
projectConfig
<-
catch
(
projectConfig
<$>
establishProjectBaseContext
verbosity
cliConfig
)
$
\
case
(
BadPackageLocations
prov
locs
)
|
prov
==
Set
.
singleton
Implicit
,
let
isGlobErr
(
BadLocGlobEmptyMatch
_
)
=
True
isGlobErr
_
=
False
,
any
isGlobErr
locs
->
do
let
globalConfigFlag
=
projectConfigConfigFile
(
projectConfigShared
cliConfig
)
globalConfig
<-
runRebuild
""
$
readGlobalConfig
verbosity
globalConfigFlag
return
(
globalConfig
<>
cliConfig
)
err
->
throwIO
err
projectConfigWithSolverRepoContext
verbosity
(
projectConfigShared
projectConfig
)
(
projectConfigBuildOnly
projectConfig
)
...
...
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