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
99c7c221
Commit
99c7c221
authored
Sep 21, 2016
by
Mikhail Glushenkov
Committed by
GitHub
Sep 21, 2016
Browse files
Merge pull request #3874 from 23Skidoo/user-config-init-remote-repo
'user-config init': Print the default 'remote-repo' correctly.
parents
da71f1c8
3ab7fc8e
Changes
1
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/Config.hs
View file @
99c7c221
...
...
@@ -689,21 +689,37 @@ commentSavedConfig :: IO SavedConfig
commentSavedConfig
=
do
userInstallDirs
<-
defaultInstallDirs
defaultCompiler
True
True
globalInstallDirs
<-
defaultInstallDirs
defaultCompiler
False
True
return
SavedConfig
{
savedGlobalFlags
=
defaultGlobalFlags
,
savedInstallFlags
=
defaultInstallFlags
,
savedConfigureExFlags
=
defaultConfigExFlags
,
savedConfigureFlags
=
(
defaultConfigFlags
defaultProgramDb
)
{
configUserInstall
=
toFlag
defaultUserInstall
,
configAllowNewer
=
Just
(
AllowNewer
RelaxDepsNone
),
configAllowOlder
=
Just
(
AllowOlder
RelaxDepsNone
)
},
savedUserInstallDirs
=
fmap
toFlag
userInstallDirs
,
savedGlobalInstallDirs
=
fmap
toFlag
globalInstallDirs
,
savedUploadFlags
=
commandDefaultFlags
uploadCommand
,
savedReportFlags
=
commandDefaultFlags
reportCommand
,
savedHaddockFlags
=
defaultHaddockFlags
}
let
conf0
=
mempty
{
savedGlobalFlags
=
defaultGlobalFlags
{
globalRemoteRepos
=
toNubList
[
defaultRemoteRepo
]
},
savedInstallFlags
=
defaultInstallFlags
,
savedConfigureExFlags
=
defaultConfigExFlags
,
savedConfigureFlags
=
(
defaultConfigFlags
defaultProgramDb
)
{
configUserInstall
=
toFlag
defaultUserInstall
,
configAllowNewer
=
Just
(
AllowNewer
RelaxDepsNone
),
configAllowOlder
=
Just
(
AllowOlder
RelaxDepsNone
)
},
savedUserInstallDirs
=
fmap
toFlag
userInstallDirs
,
savedGlobalInstallDirs
=
fmap
toFlag
globalInstallDirs
,
savedUploadFlags
=
commandDefaultFlags
uploadCommand
,
savedReportFlags
=
commandDefaultFlags
reportCommand
,
savedHaddockFlags
=
defaultHaddockFlags
}
conf1
<-
extendToEffectiveConfig
conf0
let
globalFlagsConf1
=
savedGlobalFlags
conf1
conf2
=
conf1
{
savedGlobalFlags
=
globalFlagsConf1
{
globalRemoteRepos
=
overNubList
(
map
removeRootKeys
)
(
globalRemoteRepos
globalFlagsConf1
)
}
}
return
conf2
where
-- Most people don't want to see default root keys, so don't print them.
removeRootKeys
::
RemoteRepo
->
RemoteRepo
removeRootKeys
r
=
r
{
remoteRepoRootKeys
=
[]
}
-- | All config file fields.
--
...
...
@@ -1015,8 +1031,8 @@ showConfig = showConfigWithComments mempty
showConfigWithComments
::
SavedConfig
->
SavedConfig
->
String
showConfigWithComments
comment
vals
=
Disp
.
render
$
case
fmap
ppRemoteRepoSection
.
fromNubList
.
globalRemoteRepos
.
savedGlobalFlags
$
vals
of
case
fmap
(
uncurry
ppRemoteRepoSection
)
(
zip
(
getRemoteRepos
comment
)
(
getRemoteRepos
vals
))
of
[]
->
Disp
.
text
""
(
x
:
xs
)
->
foldl'
(
\
r
r'
->
r
$+$
Disp
.
text
""
$+$
r'
)
x
xs
$+$
Disp
.
text
""
...
...
@@ -1036,6 +1052,7 @@ showConfigWithComments comment vals = Disp.render $
$+$
configFlagsSection
"program-default-options"
withProgramOptionsFields
configProgramArgs
where
getRemoteRepos
=
fromNubList
.
globalRemoteRepos
.
savedGlobalFlags
mcomment
=
Just
comment
installDirsSection
name
field
=
ppSection
"install-dirs"
name
installDirsFields
...
...
@@ -1053,11 +1070,9 @@ showConfigWithComments comment vals = Disp.render $
installDirsFields
::
[
FieldDescr
(
InstallDirs
(
Flag
PathTemplate
))]
installDirsFields
=
map
viewAsFieldDescr
installDirsOptions
ppRemoteRepoSection
::
RemoteRepo
->
Doc
ppRemoteRepoSection
vals
=
ppSection
"repository"
(
remoteRepoName
vals
)
remoteRepoFields
def
vals
where
def
=
Just
(
emptyRemoteRepo
"ignored"
)
{
remoteRepoSecure
=
Just
False
}
ppRemoteRepoSection
::
RemoteRepo
->
RemoteRepo
->
Doc
ppRemoteRepoSection
def
vals
=
ppSection
"repository"
(
remoteRepoName
vals
)
remoteRepoFields
(
Just
def
)
vals
remoteRepoFields
::
[
FieldDescr
RemoteRepo
]
remoteRepoFields
=
...
...
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