summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergeiTrofimovich <>2016-04-20 20:44:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-04-20 20:44:00 (GMT)
commit284b06fdf5a77ec02bb15958b721d6dab5578c94 (patch)
treea97e04cde0f92465a96bf2b4eb371e35f9d851df
parenta821d8e8e582926c6f6398527a85a83c59fa9077 (diff)
version 0.50.5
-rw-r--r--Cabal2Ebuild.hs17
-rw-r--r--CacheFile.hs12
-rw-r--r--Diff.hs188
-rw-r--r--DistroMap.hs158
-rw-r--r--HackPort/GlobalFlags.hs47
-rw-r--r--Hackage.hs35
-rw-r--r--Main-GuessGHC.hs27
-rw-r--r--Main.hs259
-rw-r--r--Merge.hs30
-rw-r--r--Merge/Dependencies.hs22
-rw-r--r--Overlays.hs10
-rw-r--r--Portage/EBuild.hs32
-rw-r--r--Portage/GHCCore.hs3
-rw-r--r--Portage/Host.hs10
-rw-r--r--Portage/PackageId.hs7
-rw-r--r--Progress.hs61
-rw-r--r--README.rst1
-rw-r--r--Setup.hs2
-rw-r--r--Status.hs26
-rw-r--r--Util.hs8
-rw-r--r--cabal/.arcconfig4
-rw-r--r--cabal/.travis.yml67
-rw-r--r--cabal/Cabal/Cabal.cabal184
-rw-r--r--cabal/Cabal/Distribution/Compat/Binary/Class.hs14
-rw-r--r--cabal/Cabal/Distribution/Compat/CopyFile.hs15
-rw-r--r--cabal/Cabal/Distribution/Compat/Internal/TempFile.hs (renamed from cabal/Cabal/Distribution/Compat/TempFile.hs)14
-rw-r--r--cabal/Cabal/Distribution/Compat/MonadFail.hs36
-rw-r--r--cabal/Cabal/Distribution/Compat/ReadP.hs42
-rw-r--r--cabal/Cabal/Distribution/Compat/Semigroup.hs171
-rw-r--r--cabal/Cabal/Distribution/Compiler.hs8
-rw-r--r--cabal/Cabal/Distribution/InstalledPackageInfo.hs129
-rw-r--r--cabal/Cabal/Distribution/Lex.hs10
-rw-r--r--cabal/Cabal/Distribution/License.hs8
-rw-r--r--cabal/Cabal/Distribution/Make.hs11
-rw-r--r--cabal/Cabal/Distribution/ModuleName.hs9
-rw-r--r--cabal/Cabal/Distribution/Package.hs282
-rw-r--r--cabal/Cabal/Distribution/PackageDescription.hs361
-rw-r--r--cabal/Cabal/Distribution/PackageDescription/Check.hs159
-rw-r--r--cabal/Cabal/Distribution/PackageDescription/Configuration.hs362
-rw-r--r--cabal/Cabal/Distribution/PackageDescription/Parse.hs235
-rw-r--r--cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs43
-rw-r--r--cabal/Cabal/Distribution/ParseUtils.hs27
-rw-r--r--cabal/Cabal/Distribution/Simple.hs129
-rw-r--r--cabal/Cabal/Distribution/Simple/Bench.hs27
-rw-r--r--cabal/Cabal/Distribution/Simple/Build.hs271
-rw-r--r--cabal/Cabal/Distribution/Simple/Build/Macros.hs50
-rw-r--r--cabal/Cabal/Distribution/Simple/Build/PathsModule.hs26
-rw-r--r--cabal/Cabal/Distribution/Simple/BuildPaths.hs33
-rw-r--r--cabal/Cabal/Distribution/Simple/BuildTarget.hs148
-rw-r--r--cabal/Cabal/Distribution/Simple/CCompiler.hs26
-rw-r--r--cabal/Cabal/Distribution/Simple/Command.hs37
-rw-r--r--cabal/Cabal/Distribution/Simple/Compiler.hs32
-rw-r--r--cabal/Cabal/Distribution/Simple/Configure.hs1733
-rw-r--r--cabal/Cabal/Distribution/Simple/GHC.hs403
-rw-r--r--cabal/Cabal/Distribution/Simple/GHC/IPI641.hs106
-rw-r--r--cabal/Cabal/Distribution/Simple/GHC/IPI642.hs54
-rw-r--r--cabal/Cabal/Distribution/Simple/GHC/IPIConvert.hs50
-rw-r--r--cabal/Cabal/Distribution/Simple/GHC/ImplInfo.hs40
-rw-r--r--cabal/Cabal/Distribution/Simple/GHC/Internal.hs236
-rw-r--r--cabal/Cabal/Distribution/Simple/GHCJS.hs153
-rw-r--r--cabal/Cabal/Distribution/Simple/Haddock.hs237
-rw-r--r--cabal/Cabal/Distribution/Simple/HaskellSuite.hs26
-rw-r--r--cabal/Cabal/Distribution/Simple/Install.hs178
-rw-r--r--cabal/Cabal/Distribution/Simple/InstallDirs.hs78
-rw-r--r--cabal/Cabal/Distribution/Simple/JHC.hs46
-rw-r--r--cabal/Cabal/Distribution/Simple/LHC.hs100
-rw-r--r--cabal/Cabal/Distribution/Simple/LocalBuildInfo.hs421
-rw-r--r--cabal/Cabal/Distribution/Simple/PackageIndex.hs215
-rw-r--r--cabal/Cabal/Distribution/Simple/PreProcess.hs101
-rw-r--r--cabal/Cabal/Distribution/Simple/Program.hs14
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/Ar.hs4
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/Builtin.hs21
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/Db.hs72
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/Find.hs147
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/GHC.hs229
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/HcPkg.hs248
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/Hpc.hs13
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/Run.hs7
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/Script.hs2
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/Strip.hs16
-rw-r--r--cabal/Cabal/Distribution/Simple/Program/Types.hs29
-rw-r--r--cabal/Cabal/Distribution/Simple/Register.hs231
-rw-r--r--cabal/Cabal/Distribution/Simple/Setup.hs624
-rw-r--r--cabal/Cabal/Distribution/Simple/SrcDist.hs60
-rw-r--r--cabal/Cabal/Distribution/Simple/Test.hs20
-rw-r--r--cabal/Cabal/Distribution/Simple/Test/ExeV10.hs51
-rw-r--r--cabal/Cabal/Distribution/Simple/Test/LibV09.hs64
-rw-r--r--cabal/Cabal/Distribution/Simple/Test/Log.hs22
-rw-r--r--cabal/Cabal/Distribution/Simple/UHC.hs71
-rw-r--r--cabal/Cabal/Distribution/Simple/UserHooks.hs15
-rw-r--r--cabal/Cabal/Distribution/Simple/Utils.hs172
-rw-r--r--cabal/Cabal/Distribution/System.hs44
-rw-r--r--cabal/Cabal/Distribution/Text.hs32
-rw-r--r--cabal/Cabal/Distribution/Utils/NubList.hs18
-rw-r--r--cabal/Cabal/Distribution/Verbosity.hs5
-rw-r--r--cabal/Cabal/Distribution/Version.hs99
-rw-r--r--cabal/Cabal/Language/Haskell/Extension.hs56
-rw-r--r--cabal/Cabal/Makefile14
-rw-r--r--cabal/Cabal/Setup.hs3
-rw-r--r--cabal/Cabal/changelog39
-rw-r--r--cabal/Cabal/doc/developing-packages.markdown120
-rw-r--r--cabal/Cabal/doc/index.markdown1
-rw-r--r--cabal/Cabal/doc/installing-packages.markdown169
-rwxr-xr-xcabal/Cabal/misc/gen-extra-source-files.sh23
-rwxr-xr-xcabal/Cabal/misc/travis-diff-files.sh3
-rw-r--r--cabal/HACKING.md18
-rw-r--r--cabal/Paths_Cabal.hs2
-rw-r--r--cabal/Paths_cabal_install.hs2
-rw-r--r--cabal/README.md2
-rw-r--r--cabal/appveyor.yml28
-rw-r--r--cabal/cabal-install/Distribution/Client/BuildReports/Anonymous.hs1
-rw-r--r--cabal/cabal-install/Distribution/Client/BuildReports/Storage.hs8
-rw-r--r--cabal/cabal-install/Distribution/Client/BuildReports/Types.hs8
-rw-r--r--cabal/cabal-install/Distribution/Client/BuildReports/Upload.hs22
-rw-r--r--cabal/cabal-install/Distribution/Client/Compat/Time.hs179
-rw-r--r--cabal/cabal-install/Distribution/Client/ComponentDeps.hs70
-rw-r--r--cabal/cabal-install/Distribution/Client/Config.hs234
-rw-r--r--cabal/cabal-install/Distribution/Client/Configure.hs81
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency.hs236
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular.hs13
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs77
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs21
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Configured.hs4
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs25
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Cycles.hs73
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs165
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Explore.hs171
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Flag.hs20
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Index.hs7
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs211
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Linking.hs6
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Log.hs162
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Message.hs82
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/PSQ.hs154
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Package.hs130
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs169
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs63
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs54
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs44
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Modular/Version.hs21
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/TopDown.hs54
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs25
-rw-r--r--cabal/cabal-install/Distribution/Client/Dependency/Types.hs93
-rw-r--r--cabal/cabal-install/Distribution/Client/DistDirLayout.hs134
-rw-r--r--cabal/cabal-install/Distribution/Client/Exec.hs21
-rw-r--r--cabal/cabal-install/Distribution/Client/Fetch.hs42
-rw-r--r--cabal/cabal-install/Distribution/Client/FetchUtils.hs54
-rw-r--r--cabal/cabal-install/Distribution/Client/FileMonitor.hs1101
-rw-r--r--cabal/cabal-install/Distribution/Client/Freeze.hs98
-rw-r--r--cabal/cabal-install/Distribution/Client/GenBounds.hs159
-rw-r--r--cabal/cabal-install/Distribution/Client/Get.hs28
-rw-r--r--cabal/cabal-install/Distribution/Client/Glob.hs276
-rw-r--r--cabal/cabal-install/Distribution/Client/GlobalFlags.hs260
-rw-r--r--cabal/cabal-install/Distribution/Client/Haddock.hs5
-rw-r--r--cabal/cabal-install/Distribution/Client/HttpUtils.hs298
-rw-r--r--cabal/cabal-install/Distribution/Client/IndexUtils.hs400
-rw-r--r--cabal/cabal-install/Distribution/Client/Init.hs31
-rw-r--r--cabal/cabal-install/Distribution/Client/Init/Types.hs72
-rw-r--r--cabal/cabal-install/Distribution/Client/Install.hs386
-rw-r--r--cabal/cabal-install/Distribution/Client/InstallPlan.hs384
-rw-r--r--cabal/cabal-install/Distribution/Client/InstallSymlink.hs38
-rw-r--r--cabal/cabal-install/Distribution/Client/List.hs57
-rw-r--r--cabal/cabal-install/Distribution/Client/Manpage.hs171
-rw-r--r--cabal/cabal-install/Distribution/Client/PackageHash.hs226
-rw-r--r--cabal/cabal-install/Distribution/Client/PackageIndex.hs14
-rw-r--r--cabal/cabal-install/Distribution/Client/PackageUtils.hs12
-rw-r--r--cabal/cabal-install/Distribution/Client/ParseUtils.hs241
-rw-r--r--cabal/cabal-install/Distribution/Client/PkgConfigDb.hs103
-rw-r--r--cabal/cabal-install/Distribution/Client/PlanIndex.hs180
-rw-r--r--cabal/cabal-install/Distribution/Client/ProjectBuilding.hs1284
-rw-r--r--cabal/cabal-install/Distribution/Client/ProjectConfig.hs676
-rw-r--r--cabal/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs1251
-rw-r--r--cabal/cabal-install/Distribution/Client/ProjectConfig/Types.hs333
-rw-r--r--cabal/cabal-install/Distribution/Client/ProjectPlanning.hs2333
-rw-r--r--cabal/cabal-install/Distribution/Client/RebuildMonad.hs135
-rw-r--r--cabal/cabal-install/Distribution/Client/Sandbox.hs145
-rw-r--r--cabal/cabal-install/Distribution/Client/Sandbox/Index.hs135
-rw-r--r--cabal/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs56
-rw-r--r--cabal/cabal-install/Distribution/Client/Sandbox/Timestamp.hs67
-rw-r--r--cabal/cabal-install/Distribution/Client/Sandbox/Types.hs17
-rw-r--r--cabal/cabal-install/Distribution/Client/Security/HTTP.hs174
-rw-r--r--cabal/cabal-install/Distribution/Client/Setup.hs549
-rw-r--r--cabal/cabal-install/Distribution/Client/SetupWrapper.hs147
-rw-r--r--cabal/cabal-install/Distribution/Client/SrcDist.hs7
-rw-r--r--cabal/cabal-install/Distribution/Client/Tar.hs933
-rw-r--r--cabal/cabal-install/Distribution/Client/Targets.hs130
-rw-r--r--cabal/cabal-install/Distribution/Client/Types.hs250
-rw-r--r--cabal/cabal-install/Distribution/Client/Update.hs65
-rw-r--r--cabal/cabal-install/Distribution/Client/Upload.hs169
-rw-r--r--cabal/cabal-install/Distribution/Client/Utils.hs56
-rw-r--r--cabal/cabal-install/Main.hs462
-rw-r--r--cabal/cabal-install/Setup.hs65
-rw-r--r--cabal/cabal-install/bash-completion/cabal19
-rwxr-xr-xcabal/cabal-install/bootstrap.sh113
-rw-r--r--cabal/cabal-install/cabal-install.cabal245
-rw-r--r--cabal/cabal-install/cbits/getnumcores.c46
-rw-r--r--cabal/cabal-install/changelog38
-rw-r--r--cabal/cabal-install/tests/IntegrationTests.hs319
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/common.sh12
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/custom/plain.err2
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/custom/plain.sh4
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/custom/plain/A.hs1
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/custom/plain/Setup.hs3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/custom/plain/plain.cabal12
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/Foo.hs (renamed from cabal/cabal-install/tests/PackageTests/Exec/Foo.hs)0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/My.hs (renamed from cabal/cabal-install/tests/PackageTests/Exec/My.hs)0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/adds_sandbox_bin_directory_to_path.out1
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/adds_sandbox_bin_directory_to_path.sh10
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/auto_configures_on_exec.out4
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/auto_configures_on_exec.sh2
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/can_run_executables_installed_in_sandbox.out1
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/can_run_executables_installed_in_sandbox.sh9
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/configures_cabal_to_use_sandbox.sh14
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/configures_ghc_to_use_sandbox.sh13
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/exit_with_failure_without_args.err1
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/exit_with_failure_without_args.sh3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/my.cabal (renamed from cabal/cabal-install/tests/PackageTests/Exec/my.cabal)0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/runs_given_command.out1
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/exec/runs_given_command.sh3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/disable_benchmarks_freezes_bench_deps.sh3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/disable_tests_freezes_test_deps.sh3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/does_not_freeze_nondeps.sh5
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/does_not_freeze_self.sh3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/dry_run_does_not_create_config.sh3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/enable_benchmarks_freezes_bench_deps.sh4
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/enable_tests_freezes_test_deps.sh3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/freezes_direct_dependencies.sh3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/freezes_transitive_dependencies.sh3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/my.cabal (renamed from cabal/cabal-install/tests/PackageTests/Freeze/my.cabal)0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/freeze/runs_without_error.sh2
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/internal-libs/internal_lib_basic.sh5
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/internal-libs/internal_lib_shadow.sh6
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/internal-libs/p/Foo.hs2
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/internal-libs/p/p.cabal23
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/internal-libs/p/p/P.hs2
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/internal-libs/p/q/Q.hs2
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/internal-libs/q/Q.hs2
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/internal-libs/q/q.cabal12
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/manpage/outputs_manpage.sh11
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/multiple-source/finds_second_source_of_multiple_source.sh11
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/multiple-source/p/LICENSE (renamed from cabal/cabal-install/tests/PackageTests/MultipleSource/q/LICENSE)0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/multiple-source/p/Setup.hs (renamed from cabal/cabal-install/tests/PackageTests/MultipleSource/q/Setup.hs)0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/multiple-source/p/p.cabal (renamed from cabal/cabal-install/tests/PackageTests/MultipleSource/p/p.cabal)0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/multiple-source/q/LICENSE (renamed from cabal/cabal-install/tests/PackageTests/MultipleSource/p/LICENSE)0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/multiple-source/q/Setup.hs (renamed from cabal/cabal-install/tests/PackageTests/MultipleSource/p/Setup.hs)0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/multiple-source/q/q.cabal (renamed from cabal/cabal-install/tests/PackageTests/MultipleSource/q/q.cabal)0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/fail_removing_source_thats_not_registered.err3
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/fail_removing_source_thats_not_registered.sh10
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/p/LICENSE0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/p/Setup.hs2
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/p/p.cabal11
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/q/LICENSE0
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/q/Setup.hs2
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/q/q.cabal11
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/remove_nonexistent_source.sh22
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/report_success_removing_source.out6
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/sandbox-sources/report_success_removing_source.sh11
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/user-config/cabal-config182
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/user-config/common.sh9
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/user-config/doesnt_overwrite_without_f.err1
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/user-config/doesnt_overwrite_without_f.sh5
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/user-config/overwrites_with_f.out2
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/user-config/overwrites_with_f.sh9
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/user-config/runs_without_error.out1
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/user-config/runs_without_error.sh7
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/user-config/uses_CABAL_CONFIG.out1
-rw-r--r--cabal/cabal-install/tests/IntegrationTests/user-config/uses_CABAL_CONFIG.sh5
-rw-r--r--cabal/cabal-install/tests/PackageTests.hs95
-rw-r--r--cabal/cabal-install/tests/PackageTests/Exec/Check.hs145
-rw-r--r--cabal/cabal-install/tests/PackageTests/Freeze/Check.hs116
-rw-r--r--cabal/cabal-install/tests/PackageTests/MultipleSource/Check.hs28
-rw-r--r--cabal/cabal-install/tests/PackageTests/PackageTester.hs232
-rw-r--r--cabal/cabal-install/tests/README1
-rw-r--r--cabal/cabal-install/tests/README.md27
-rw-r--r--cabal/cabal-install/tests/SolverQuickCheck.hs16
-rw-r--r--cabal/cabal-install/tests/UnitTests.hs117
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs172
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/Compat/Time.hs49
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs279
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/QuickCheck.hs291
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs326
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs769
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/Glob.hs202
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs610
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/Sandbox/Timestamp.hs63
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs75
-rw-r--r--cabal/cabal-install/tests/UnitTests/Distribution/Client/UserConfig.hs81
-rw-r--r--cabal/cabal-install/tests/UnitTests/Options.hs41
-rwxr-xr-xcabal/setup-dev.sh64
-rwxr-xr-xcabal/travis-script.sh91
-rw-r--r--hackage-security/.travis.yml125
-rw-r--r--hackage-security/README.md694
-rw-r--r--hackage-security/example-client/LICENSE30
-rw-r--r--hackage-security/example-client/example-client.cabal48
-rw-r--r--hackage-security/example-client/src/ExampleClient/Options.hs171
-rw-r--r--hackage-security/example-client/src/Main.hs182
-rw-r--r--hackage-security/example-client/src/Prelude.hs27
-rw-r--r--hackage-security/hackage-repo-tool/ChangeLog.md13
-rw-r--r--hackage-security/hackage-repo-tool/LICENSE30
-rw-r--r--hackage-security/hackage-repo-tool/Setup.hs2
-rw-r--r--hackage-security/hackage-repo-tool/hackage-repo-tool.cabal69
-rw-r--r--hackage-security/hackage-repo-tool/src/Hackage/Security/RepoTool/Layout.hs89
-rw-r--r--hackage-security/hackage-repo-tool/src/Hackage/Security/RepoTool/Layout/Keys.hs44
-rw-r--r--hackage-security/hackage-repo-tool/src/Hackage/Security/RepoTool/Options.hs198
-rw-r--r--hackage-security/hackage-repo-tool/src/Hackage/Security/RepoTool/Paths.hs33
-rw-r--r--hackage-security/hackage-repo-tool/src/Hackage/Security/RepoTool/Util/IO.hs112
-rw-r--r--hackage-security/hackage-repo-tool/src/Main.hs673
-rw-r--r--hackage-security/hackage-repo-tool/src/Prelude.hs27
-rw-r--r--hackage-security/hackage-root-tool/ChangeLog.md4
-rw-r--r--hackage-security/hackage-root-tool/LICENSE30
-rw-r--r--hackage-security/hackage-root-tool/Main.hs159
-rw-r--r--hackage-security/hackage-root-tool/Setup.hs2
-rw-r--r--hackage-security/hackage-root-tool/hackage-root-tool.cabal34
-rw-r--r--hackage-security/hackage-security-HTTP/ChangeLog.md17
-rw-r--r--hackage-security/hackage-security-HTTP/LICENSE30
-rw-r--r--hackage-security/hackage-security-HTTP/Setup.hs2
-rw-r--r--hackage-security/hackage-security-HTTP/hackage-security-HTTP.cabal55
-rw-r--r--hackage-security/hackage-security-HTTP/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs274
-rw-r--r--hackage-security/hackage-security-curl/LICENSE30
-rw-r--r--hackage-security/hackage-security-curl/Setup.hs2
-rw-r--r--hackage-security/hackage-security-curl/hackage-security-curl.cabal33
-rw-r--r--hackage-security/hackage-security-curl/src/Hackage/Security/Client/Repository/HttpLib/Curl.hs70
-rw-r--r--hackage-security/hackage-security-http-client/ChangeLog.md7
-rw-r--r--hackage-security/hackage-security-http-client/LICENSE30
-rw-r--r--hackage-security/hackage-security-http-client/Setup.hs2
-rw-r--r--hackage-security/hackage-security-http-client/hackage-security-http-client.cabal39
-rw-r--r--hackage-security/hackage-security-http-client/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs164
-rw-r--r--hackage-security/hackage-security/ChangeLog.md58
-rw-r--r--hackage-security/hackage-security/LICENSE30
-rw-r--r--hackage-security/hackage-security/Setup.hs2
-rw-r--r--hackage-security/hackage-security/hackage-security.cabal232
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Client.hs1031
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Client/Formats.hs116
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Client/Repository.hs462
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Cache.hs204
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Client/Repository/HttpLib.hs142
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Local.hs99
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Client/Repository/Remote.hs717
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Client/Verify.hs103
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/JSON.hs323
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Key.hs298
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Key/Env.hs90
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Server.hs29
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF.hs41
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Common.hs53
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/FileInfo.hs103
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/FileMap.hs134
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Header.hs119
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Layout/Cache.hs64
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Layout/Index.hs116
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Layout/Repo.hs79
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Mirrors.hs103
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Paths.hs72
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Patterns.hs346
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Root.hs117
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Signed.hs238
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Snapshot.hs100
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Targets.hs130
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/TUF/Timestamp.hs74
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Trusted.hs58
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Trusted/TCB.hs320
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Util/Base64.hs31
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Util/Checked.hs102
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Util/IO.hs61
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Util/JSON.hs212
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Util/Lens.hs48
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Util/Path.hs459
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Util/Pretty.hs8
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Util/Some.hs102
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Util/Stack.hs8
-rw-r--r--hackage-security/hackage-security/src/Hackage/Security/Util/TypedEmbedded.hs38
-rw-r--r--hackage-security/hackage-security/src/Prelude.hs32
-rw-r--r--hackage-security/hackage-security/src/Text/JSON/Canonical.hs272
-rw-r--r--hackage-security/hackage-security/tests/TestSuite.hs434
-rw-r--r--hackage-security/hackage-security/tests/TestSuite/HttpMem.hs70
-rw-r--r--hackage-security/hackage-security/tests/TestSuite/InMemCache.hs149
-rw-r--r--hackage-security/hackage-security/tests/TestSuite/InMemRepo.hs262
-rw-r--r--hackage-security/hackage-security/tests/TestSuite/InMemRepository.hs63
-rw-r--r--hackage-security/hackage-security/tests/TestSuite/PrivateKeys.hs69
-rw-r--r--hackage-security/hackage-security/tests/TestSuite/Util/StrictMVar.hs27
-rw-r--r--hackage-security/precompute-fileinfo/LICENSE30
-rw-r--r--hackage-security/precompute-fileinfo/Setup.hs2
-rw-r--r--hackage-security/precompute-fileinfo/precompute-fileinfo.cabal27
-rw-r--r--hackage-security/precompute-fileinfo/src/Main.hs196
-rw-r--r--hackage-security/stack.yaml13
-rw-r--r--hackage-security/testscripts/squid.conf4
-rw-r--r--hackage-security/testscripts/test-outdated-index.log440
-rwxr-xr-xhackage-security/testscripts/test-outdated-index.sh67
-rw-r--r--hackage-security/testscripts/test-outdated-timestamp.log280
-rwxr-xr-xhackage-security/testscripts/test-outdated-timestamp.sh60
-rwxr-xr-xhackage-security/testscripts/test-range-request.sh13
-rw-r--r--hackport.cabal112
392 files changed, 36350 insertions, 10094 deletions
diff --git a/Cabal2Ebuild.hs b/Cabal2Ebuild.hs
index 4b4f07f..3fd9c32 100644
--- a/Cabal2Ebuild.hs
+++ b/Cabal2Ebuild.hs
@@ -51,17 +51,22 @@ cabal2ebuild cat pkg = Portage.ebuildTemplate {
else Cabal.description pkg,
E.homepage = thisHomepage,
E.license = Portage.convertLicense $ Cabal.license pkg,
- E.slot = (E.slot E.ebuildTemplate) ++ maybe [] (const "/${PV}") (Cabal.library pkg),
+ E.slot = (E.slot E.ebuildTemplate) ++ (if hasLibs then "/${PV}" else ""),
E.my_pn = if any isUpper cabalPkgName then Just cabalPkgName else Nothing,
E.features = E.features E.ebuildTemplate
- ++ (if hasExe then ["bin"] else [])
- ++ maybe [] (const (["lib","profile","haddock","hoogle"]
- ++ if cabalPkgName == "hscolour" then [] else ["hscolour"])
- ) (Cabal.library pkg) -- hscolour can't colour its own sources
- ++ (if hasTests then ["test-suite"] else [])
+ ++ (if hasExe then ["bin"]
+ else [])
+ ++ (if hasLibs then (["lib","profile","haddock","hoogle"]
+ ++ if cabalPkgName == "hscolour"
+ then []
+ else ["hscolour"])
+ else [])
+ ++ (if hasTests then ["test-suite"]
+ else [])
} where
cabal_pn = Cabal.pkgName $ Cabal.package pkg
cabalPkgName = display cabal_pn
+ hasLibs = Cabal.libraries pkg /= []
hasExe = (not . null) (Cabal.executables pkg)
hasTests = (not . null) (Cabal.testSuites pkg)
thisHomepage = if (null $ Cabal.homepage pkg)
diff --git a/CacheFile.hs b/CacheFile.hs
deleted file mode 100644
index 4569ca3..0000000
--- a/CacheFile.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module CacheFile where
-
-import System.FilePath
-
-indexFile :: String
-indexFile = "00-index.tar.gz"
-
-hackportDir :: String
-hackportDir = ".hackport"
-
-cacheFile :: FilePath -> FilePath
-cacheFile tree = tree </> hackportDir </> indexFile
diff --git a/Diff.hs b/Diff.hs
deleted file mode 100644
index 9f1559e..0000000
--- a/Diff.hs
+++ /dev/null
@@ -1,188 +0,0 @@
-module Diff
- ( runDiff
- , DiffMode(..)
- ) where
-
-import Control.Monad ( mplus )
-import Control.Exception ( assert )
-import Data.Maybe ( fromJust, listToMaybe )
-import Data.List ( sortBy, groupBy )
-import Data.Ord ( comparing )
-
-import qualified Portage.Overlay as Portage
-import qualified Portage.Cabal as Portage
-import qualified Portage.PackageId as Portage
-
-import qualified Data.Version as Cabal
-
--- cabal
-import Distribution.Verbosity
-import Distribution.Text(display)
-import qualified Distribution.Package as Cabal
-import qualified Distribution.Client.PackageIndex as Index
-import Distribution.Simple.Utils (equating)
-
--- cabal-install
-import qualified Distribution.Client.IndexUtils as Index (getSourcePackages)
-import qualified Distribution.Client.Types as Cabal
-import Distribution.Client.Utils (mergeBy, MergeResult(..))
-
-data DiffMode
- = ShowAll
- | ShowMissing
- | ShowAdditions
- | ShowNewer
- | ShowCommon
- | ShowPackages [String]
- deriving Eq
-
-
-{-
-type DiffState a = MergeResult a a
-tabs :: String -> String
-tabs str = let len = length str in str++(if len < 3*8
- then replicate (3*8-len) ' '
- else "")
-
-
--- TODO: is the new showPackageCompareInfo showing the packages in the same
--- way as showDiffState did?
-
-showDiffState :: Cabal.PackageName -> DiffState Portage.Version -> String
-showDiffState pkg st = (tabs (display pkg)) ++ " [" ++ (case st of
- InBoth x y -> display x ++ (case compare x y of
- EQ -> "="
- GT -> ">"
- LT -> "<") ++ display y
- OnlyInLeft x -> display x ++ ">none"
- OnlyInRight y -> "none<" ++ display y) ++ "]"
--}
-
-runDiff :: Verbosity -> FilePath -> DiffMode -> Cabal.Repo -> IO ()
-runDiff verbosity overlayPath dm repo = do
- -- get package list from hackage
- pkgDB <- Index.getSourcePackages verbosity [ repo ]
- let (Cabal.SourcePackageDb hackageIndex _) = pkgDB
-
- -- get package list from the overlay
- overlay0 <- (Portage.loadLazy overlayPath)
- let overlayIndex = Portage.fromOverlay (Portage.reduceOverlay overlay0)
-
- let (subHackage, subOverlay)
- = case dm of
- ShowPackages pkgs ->
- (concatMap (concatMap snd . Index.searchByNameSubstring hackageIndex) pkgs
- ,concatMap (concatMap snd . Index.searchByNameSubstring overlayIndex) pkgs)
- _ ->
- (Index.allPackages hackageIndex
- ,Index.allPackages overlayIndex)
- diff subHackage subOverlay dm
-
-data PackageCompareInfo = PackageCompareInfo {
- name :: Cabal.PackageName,
--- hackageVersions :: [ Cabal.Version ],
--- overlayVersions :: [ Cabal.Version ]
- hackageVersion :: Maybe Cabal.Version,
- overlayVersion :: Maybe Cabal.Version
- } deriving Show
-
-showPackageCompareInfo :: PackageCompareInfo -> String
-showPackageCompareInfo pkgCmpInfo =
- display (name pkgCmpInfo) ++ " ["
- ++ hackageS ++ sign ++ overlayS ++ "]"
- where
- overlay = overlayVersion pkgCmpInfo
- hackage = hackageVersion pkgCmpInfo
- hackageS = maybe "none" display hackage
- overlayS = maybe "none" display overlay
- sign = case compare hackage overlay of
- EQ -> "="
- GT -> ">"
- LT -> "<"
-
-diff :: [Cabal.SourcePackage]
- -> [Portage.ExistingEbuild]
- -> DiffMode
- -> IO ()
-diff hackage overlay dm = do
- mapM_ (putStrLn . showPackageCompareInfo) pkgCmpInfos
- where
- merged = mergePackages (map (Portage.normalizeCabalPackageId . Cabal.packageId) hackage)
- (map Portage.ebuildCabalId overlay)
- pkgCmpInfos = filter pkgFilter (map (uncurry mergePackageInfo) merged)
- pkgFilter :: PackageCompareInfo -> Bool
- pkgFilter pkgCmpInfo =
- let om = overlayVersion pkgCmpInfo
- hm = hackageVersion pkgCmpInfo
- st = case (om,hm) of
- (Just ov, Just hv) -> InBoth ov hv
- (Nothing, Just hv) -> OnlyInRight hv
- (Just ov, Nothing) -> OnlyInLeft ov
- _ -> error "impossible"
- in
- case dm of
- ShowAll -> True
- ShowPackages _ -> True -- already filtered
- ShowNewer -> case st of
- InBoth o h -> h>o
- _ -> False
- ShowMissing -> case st of
- OnlyInLeft _ -> False
- InBoth x y -> x < y
- OnlyInRight _ -> True
- ShowAdditions -> case st of
- OnlyInLeft _ -> True
- InBoth x y -> x > y
- OnlyInRight _ -> False
- ShowCommon -> case st of
- OnlyInLeft _ -> False
- InBoth x y -> x == y
- OnlyInRight _ -> False
-
--- | We get the 'PackageCompareInfo' by combining the info for the overlay
--- and hackage versions of a package.
---
--- * We're building info about a various versions of a single named package so
--- the input package info records are all supposed to refer to the same
--- package name.
---
-mergePackageInfo :: [Cabal.PackageIdentifier]
- -> [Cabal.PackageIdentifier]
- -> PackageCompareInfo
-mergePackageInfo hackage overlay =
- assert (length overlay + length hackage > 0) $
- PackageCompareInfo {
- name = combine Cabal.pkgName latestHackage
- Cabal.pkgName latestOverlay,
--- hackageVersions = map Cabal.pkgVersion hackage,
--- overlayVersions = map Cabal.pkgVersion overlay
- hackageVersion = fmap Cabal.pkgVersion latestHackage,
- overlayVersion = fmap Cabal.pkgVersion latestOverlay
- }
- where
- combine f x g y = fromJust (fmap f x `mplus` fmap g y)
- latestHackage = latestOf hackage
- latestOverlay = latestOf overlay
- latestOf :: [Cabal.PackageIdentifier] -> Maybe Cabal.PackageIdentifier
- latestOf = listToMaybe . reverse . sortBy (comparing Cabal.pkgVersion)
-
--- | Rearrange installed and available packages into groups referring to the
--- same package by name. In the result pairs, the lists are guaranteed to not
--- both be empty.
---
-mergePackages :: [Cabal.PackageIdentifier] -> [Cabal.PackageIdentifier]
- -> [([Cabal.PackageIdentifier], [Cabal.PackageIdentifier])]
-mergePackages hackage overlay =
- map collect
- $ mergeBy (\i a -> fst i `compare` fst a)
- (groupOn Cabal.pkgName hackage)
- (groupOn Cabal.pkgName overlay)
- where
- collect (OnlyInLeft (_,is) ) = (is, [])
- collect ( InBoth (_,is) (_,as)) = (is, as)
- collect (OnlyInRight (_,as)) = ([], as)
-
-groupOn :: Ord key => (a -> key) -> [a] -> [(key,[a])]
-groupOn key = map (\xs -> (key (head xs), xs))
- . groupBy (equating key)
- . sortBy (comparing key)
diff --git a/DistroMap.hs b/DistroMap.hs
deleted file mode 100644
index 52b16d5..0000000
--- a/DistroMap.hs
+++ /dev/null
@@ -1,158 +0,0 @@
-{-# OPTIONS -XPatternGuards #-}
-{-
-Generate a distromap, like these:
-http://hackage.haskell.org/packages/archive/00-distromap/
-Format:
-
-("xmobar","0.8",Just "http://packages.gentoo.org/package/x11-misc/xmobar")
-("xmobar","0.9",Just "http://packages.gentoo.org/package/x11-misc/xmobar")
-("xmobar","0.9.2",Just "http://packages.gentoo.org/package/x11-misc/xmobar")
-("xmonad","0.5",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
-("xmonad","0.6",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
-("xmonad","0.7",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
-("xmonad","0.8",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
-("xmonad","0.8.1",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
-("xmonad","0.9",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
-("xmonad","0.9.1",Just "http://en.gentoo-wiki.com/wiki/Haskell/overlay")
-
-Multiple entries for each package is allowed, given that there are different versions.
-
-
-Setup:
- Join all packages from portage and the overlay into a big map;
- From Portage.PackageId: PackageName = category/package
- PVULine = (packagename, versionstring, url)
- Create such a map: Map PackageName DistroLine
- Only one PVULine per version, and prefer portage over the overlay.
-
-Algorithm;
- 1. Take a package from hackage
- 2. Look for it in the map
- a. For each version:
- find a match in the list of versions:
- yield the PVULine
--}
-
-module DistroMap
- ( distroMap ) where
-
-import Control.Applicative
-import qualified Data.List as List ( nub )
-import qualified Data.Map as Map
-import Data.Map ( Map )
-import System.FilePath ( (</>) )
-import Debug.Trace ( trace )
-import Data.Maybe ( fromJust )
-
-import Distribution.Verbosity
-import Distribution.Text ( display )
-import Distribution.Client.Types ( Repo, SourcePackageDb(..), SourcePackage(..) )
-import Distribution.Simple.Utils ( info )
-
-import qualified Data.Version as Cabal
-import qualified Distribution.Package as Cabal
-import qualified Distribution.Client.PackageIndex as CabalInstall
-import qualified Distribution.Client.IndexUtils as CabalInstall
-
-import Portage.Overlay ( readOverlayByPackage, getDirectoryTree )
-import qualified Portage.PackageId as Portage
-import qualified Portage.Version as Portage
-
-type PVU = (Cabal.PackageName, Cabal.Version, Maybe String)
-type PVU_Map = Map Portage.PackageName [(Cabal.Version, Maybe String)]
-
-distroMap :: Verbosity -> Repo -> FilePath -> FilePath -> [String] -> IO ()
-distroMap verbosity repo portagePath overlayPath args = do
- info verbosity "distro map called"
- info verbosity ("verbosity: " ++ show verbosity)
- info verbosity ("portage: " ++ portagePath)
- info verbosity ("overlay: " ++ overlayPath)
- info verbosity ("args: " ++ show args)
-
- portage <- readOverlayByPackage <$> getDirectoryTree portagePath
- overlay <- readOverlayByPackage <$> getDirectoryTree overlayPath
-
- info verbosity ("portage packages: " ++ show (length portage))
- info verbosity ("overlay packages: " ++ show (length overlay))
-
- let portageMap = buildPortageMap portage
- overlayMap = buildOverlayMap overlay
- completeMap = unionMap portageMap overlayMap
-
- info verbosity ("portage map: " ++ show (Map.size portageMap))
- info verbosity ("overlay map: " ++ show (Map.size overlayMap))
- info verbosity ("complete map: " ++ show (Map.size completeMap))
-
- SourcePackageDb { packageIndex = packageIndex } <-
- CabalInstall.getSourcePackages verbosity [repo]
-
- let pkgs0 = map (map packageInfoId) (CabalInstall.allPackagesByName packageIndex)
- hackagePkgs = [ (Cabal.pkgName (head p), map Cabal.pkgVersion p) | p <- pkgs0 ]
-
- info verbosity ("cabal packages: " ++ show (length hackagePkgs))
-
- let pvus = concat $ map (\(p,vs) -> lookupPVU completeMap p vs) hackagePkgs
- info verbosity ("found pvus: " ++ show (length pvus))
-
- mapM_ (putStrLn . showPVU) pvus
- return ()
-
-
-showPVU :: PVU -> String
-showPVU (p,v,u) = show $ (display p, display v, u)
-
--- building the PVU_Map
-
-reduceVersion :: Portage.Version -> Portage.Version
-reduceVersion (Portage.Version ns _ _ _) = Portage.Version ns Nothing [] 0
-
-reduceVersions :: [Portage.Version] -> [Portage.Version]
-reduceVersions = List.nub . map reduceVersion
-
-buildMap :: [(Portage.PackageName, [Portage.Version])]
- -> (Portage.PackageName -> Portage.Version -> Maybe String)
- -> PVU_Map
-buildMap pvs f = Map.mapWithKey (\p vs -> [ (fromJust $ Portage.toCabalVersion v, f p v)
- | v <- reduceVersions vs ])
- (Map.fromList pvs)
-
-buildPortageMap :: [(Portage.PackageName, [Portage.Version])] -> PVU_Map
-buildPortageMap lst = buildMap lst $ \ (Portage.PackageName c p) _v ->
- Just $ "http://packages.gentoo.org/package" </> display c </> display p
-
-buildOverlayMap :: [(Portage.PackageName, [Portage.Version])] -> PVU_Map
-buildOverlayMap lst = buildMap lst $ \_ _ -> Just "http://en.gentoo-wiki.com/wiki/Haskell/overlay"
-
-unionMap :: PVU_Map -> PVU_Map -> PVU_Map
-unionMap = Map.unionWith f
- where
- f :: [(Cabal.Version, Maybe String)]
- -> [(Cabal.Version, Maybe String)]
- -> [(Cabal.Version, Maybe String)]
- f vas vbs = Map.toList (Map.union (Map.fromList vas) (Map.fromList vbs))
-
-
--- resolving Cabal.PackageName to Portage.PackageName
-
-lookupPVU :: PVU_Map -> Cabal.PackageName -> [Cabal.Version] -> [PVU]
-lookupPVU pvu_map pn cvs =
- case findItems (Portage.normalizeCabalPackageName pn) of
- [] -> []
- [item] -> ret item
- items | [item] <- preferableItem items -> ret item
- | otherwise -> trace (noDefaultText items) []
- where
- noDefaultText is = unlines $ ("no default for package: " ++ display pn)
- : [ " * " ++ (display cat)
- | (Portage.PackageName cat _, _) <- is]
-
- ret (_, vs) = [ (pn, v, u) | (v, u) <- vs, v `elem` cvs ]
- preferableItem items =
- [ item
- | item@(Portage.PackageName cat _pn, _vs) <- items
- , cat == Portage.Category "dev-haskell"]
- findItems cpn = Map.toList $ Map.filterWithKey f pvu_map
- where
- f (Portage.PackageName _cat _pn) _vs = cpn == pn
-
-
diff --git a/HackPort/GlobalFlags.hs b/HackPort/GlobalFlags.hs
new file mode 100644
index 0000000..0a4b284
--- /dev/null
+++ b/HackPort/GlobalFlags.hs
@@ -0,0 +1,47 @@
+module HackPort.GlobalFlags
+ ( GlobalFlags(..)
+ , defaultGlobalFlags
+ , withHackPortContext
+ ) where
+
+import qualified Distribution.Verbosity as DV
+import qualified Distribution.Simple.Setup as DSS
+import qualified Distribution.Client.GlobalFlags as DCG
+import qualified Distribution.Client.Types as DCT
+import qualified Distribution.Utils.NubList as DUN
+
+import qualified Network.URI as NU
+
+import System.FilePath ((</>))
+
+import qualified Overlays
+
+data GlobalFlags =
+ GlobalFlags { globalVersion :: DSS.Flag Bool
+ , globalNumericVersion :: DSS.Flag Bool
+ , globalPathToOverlay :: DSS.Flag (Maybe FilePath)
+ , globalPathToPortage :: DSS.Flag (Maybe FilePath)
+ }
+
+defaultGlobalFlags :: GlobalFlags
+defaultGlobalFlags =
+ GlobalFlags { globalVersion = DSS.Flag False
+ , globalNumericVersion = DSS.Flag False
+ , globalPathToOverlay = DSS.Flag Nothing
+ , globalPathToPortage = DSS.Flag Nothing
+ }
+
+defaultRemoteRepo :: DCT.RemoteRepo
+defaultRemoteRepo = (DCT.emptyRemoteRepo name) { DCT.remoteRepoURI = uri }
+ where
+ Just uri = NU.parseURI "https://hackage.haskell.org/"
+ name = "hackage.haskell.org"
+
+withHackPortContext :: DV.Verbosity -> GlobalFlags -> (DCG.RepoContext -> IO a) -> IO a
+withHackPortContext verbosity global_flags callback = do
+ overlayPath <- Overlays.getOverlayPath verbosity (DSS.fromFlag $ globalPathToOverlay global_flags)
+ let flags = DCG.defaultGlobalFlags {
+ DCG.globalRemoteRepos = DUN.toNubList [defaultRemoteRepo]
+ , DCG.globalCacheDir = DSS.Flag $ overlayPath </> ".hackport"
+ }
+ DCG.withRepoContext verbosity flags callback
diff --git a/Hackage.hs b/Hackage.hs
deleted file mode 100644
index 99f62dc..0000000
--- a/Hackage.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-{-|
- Author : Sergei Trofimovich <slyfox@gentoo.org>
- Stability : experimental
- Portability : haskell98
-
- Utilities to work with hackage-alike repositories
--}
-module Hackage
- ( defaultRepo
- , defaultRepoURI
- ) where
-
-import Distribution.Client.Types (Repo(..), RemoteRepo(..))
-import Network.URI (URI(..), URIAuth(..))
-import System.FilePath
-
-defaultRepo :: FilePath -> Repo
-defaultRepo overlayPath =
- Repo {
- repoKind = Left defaultRemoteRepo,
- repoLocalDir = overlayPath </> ".hackport"
- }
-
--- A copy from cabal-install/Distribution.Client.Config
-defaultRemoteRepo :: RemoteRepo
-defaultRemoteRepo = RemoteRepo name uri () False
- where
- name = "hackage.haskell.org"
- uri = URI "http:" (Just (URIAuth "" name "")) "/" "" ""
-
-defaultRepoURI :: FilePath -> URI
-defaultRepoURI overlayPath =
- case repoKind (defaultRepo overlayPath) of
- Left (RemoteRepo { remoteRepoURI = uri }) -> uri
- Right _ -> error $ "defaultRepoURI: unable to get URI for " ++ overlayPath
diff --git a/Main-GuessGHC.hs b/Main-GuessGHC.hs
deleted file mode 100644
index 3eaf317..0000000
--- a/Main-GuessGHC.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module Main where
-
-import System.Environment
-
-import Distribution.PackageDescription
-import Distribution.PackageDescription.Parse
-
-import Distribution.Text
-import Distribution.Verbosity
-
-import Portage.GHCCore
-
-main :: IO ()
-main = do
- args <- getArgs
- gpds <- mapM (readPackageDescription silent) args
- mapM_ guess gpds
-
-guess :: GenericPackageDescription -> IO ()
-guess gpd = do
- let pkg = package . packageDescription $ gpd
- let mghc = minimumGHCVersionToBuildPackage gpd
- putStr (display pkg)
- putStr "\t\t"
- putStrLn $ case mghc of
- Nothing -> "Unknown"
- Just (compiler, _pkgs) -> display compiler
diff --git a/Main.hs b/Main.hs
index 2da6200..bf75383 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,4 +1,4 @@
-module Main where
+module Main (main) where
import Control.Applicative
import Control.Monad
@@ -11,10 +11,9 @@ import Data.Monoid
import Distribution.Simple.Setup
( Flag(..), fromFlag
, trueArg
- , flagToList
, optionVerbosity
)
-import Distribution.ReadE ( succeedReadE )
+
import Distribution.Simple.Command -- commandsRun
import Distribution.Simple.Utils ( die, cabalVersion, warn )
import qualified Distribution.PackageDescription.Parse as Cabal
@@ -24,29 +23,24 @@ import Distribution.Text (display, simpleParse)
import Distribution.Client.Types
import Distribution.Client.Update
-import qualified Distribution.Client.HttpUtils as DCH
-
import qualified Distribution.Client.PackageIndex as Index
import qualified Distribution.Client.IndexUtils as Index
-import Hackage (defaultRepo, defaultRepoURI)
-
import Portage.Overlay as Overlay ( loadLazy, inOverlay )
import Portage.Host as Host ( getInfo, portage_dir )
import Portage.PackageId ( normalizeCabalPackageId )
-import Network.URI ( URI(..), parseURI )
import System.Environment ( getArgs, getProgName )
import System.Directory ( doesDirectoryExist )
import System.Exit ( exitFailure )
import System.FilePath ( (</>) )
-import Diff
+import qualified HackPort.GlobalFlags as H
+
import Error
import Status
import Overlays
import Merge
-import DistroMap ( distroMap )
import qualified Paths_cabal_install
import qualified Paths_hackport
@@ -57,37 +51,30 @@ import qualified Paths_hackport
data ListFlags = ListFlags {
listVerbosity :: Flag Verbosity
- -- , listOverlayPath :: Flag FilePath
- -- , listServerURI :: Flag String
}
instance Monoid ListFlags where
mempty = ListFlags {
listVerbosity = mempty
- -- , listOverlayPath = mempty
- -- , listServerURI = mempty
}
mappend a b = ListFlags {
listVerbosity = combine listVerbosity
- -- , listOverlayPath = combine listOverlayPath
- -- , listServerURI = combine listServerURI
}
where combine field = field a `mappend` field b
defaultListFlags :: ListFlags
defaultListFlags = ListFlags {
listVerbosity = Flag normal
- -- , listOverlayPath = NoFlag
- -- , listServerURI = Flag defaultHackageServerURI
}
listCommand :: CommandUI ListFlags
listCommand = CommandUI {
commandName = "list",
- commandSynopsis = "List packages",
- commandDescription = Just $ \_pname ->
- "TODO: this is the commandDescription for listCommand\n",
+ commandSynopsis = "List package versions matching pattern",
commandUsage = usagePackages "list",
+ commandDescription = Nothing,
+ commandNotes = Nothing,
+
commandDefaultFlags = defaultListFlags,
commandOptions = \_showOrParseArgs ->
[ optionVerbosity listVerbosity (\v flags -> flags { listVerbosity = v })
@@ -100,12 +87,12 @@ listCommand = CommandUI {
]
}
-listAction :: ListFlags -> [String] -> GlobalFlags -> IO ()
+listAction :: ListFlags -> [String] -> H.GlobalFlags -> IO ()
listAction flags extraArgs globalFlags = do
- let verbosity = fromFlag (listVerbosity flags)
- overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)
- let repo = defaultRepo overlayPath
- index <- fmap packageIndex (Index.getSourcePackages verbosity [ repo ])
+ let verbosity = fromFlag (listVerbosity flags)
+ H.withHackPortContext verbosity globalFlags $ \repoContext -> do
+ overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)
+ index <- fmap packageIndex (Index.getSourcePackages verbosity repoContext)
overlay <- Overlay.loadLazy overlayPath
let pkgs | null extraArgs = Index.allPackages index
| otherwise = concatMap (concatMap snd . Index.searchByNameSubstring index) extraArgs
@@ -146,7 +133,7 @@ defaultMakeEbuildFlags = MakeEbuildFlags {
, makeEbuildCabalFlags = Flag Nothing
}
-makeEbuildAction :: MakeEbuildFlags -> [String] -> GlobalFlags -> IO ()
+makeEbuildAction :: MakeEbuildFlags -> [String] -> H.GlobalFlags -> IO ()
makeEbuildAction flags args globalFlags = do
(catstr,cabals) <- case args of
(category:cabal1:cabaln) -> return (category, cabal1:cabaln)
@@ -155,7 +142,7 @@ makeEbuildAction flags args globalFlags = do
Just c -> return c
Nothing -> throwEx (ArgumentError ("could not parse category: " ++ catstr))
let verbosity = fromFlag (makeEbuildVerbosity flags)
- overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)
+ overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)
forM_ cabals $ \cabalFileName -> do
pkg <- Cabal.readPackageDescription normal cabalFileName
mergeGenericPackageDescription verbosity overlayPath cat pkg False (fromFlag $ makeEbuildCabalFlags flags)
@@ -164,9 +151,10 @@ makeEbuildCommand :: CommandUI MakeEbuildFlags
makeEbuildCommand = CommandUI {
commandName = "make-ebuild",
commandSynopsis = "Make an ebuild from a .cabal file",
- commandDescription = Just $ \_pname ->
- "TODO: this is the commandDescription for makeEbuildCommand\n",
commandUsage = \_ -> [],
+ commandDescription = Nothing,
+ commandNotes = Nothing,
+
commandDefaultFlags = defaultMakeEbuildFlags,
commandOptions = \_showOrParseArgs ->
[ optionVerbosity makeEbuildVerbosity (\v flags -> flags { makeEbuildVerbosity = v })
@@ -182,106 +170,35 @@ makeEbuildCommand = CommandUI {
}
-----------------------------------------------------------------------
--- Diff
------------------------------------------------------------------------
-
-data DiffFlags = DiffFlags {
- -- diffMode :: Flag String, -- DiffMode,
- diffVerbosity :: Flag Verbosity
- -- , diffServerURI :: Flag String
- }
-
-instance Monoid DiffFlags where
- mempty = DiffFlags {
- -- diffMode = mempty,
- diffVerbosity = mempty
- -- , diffServerURI = mempty
- }
- mappend a b = DiffFlags {
- -- diffMode = combine diffMode,
- diffVerbosity = combine diffVerbosity
- -- , diffServerURI = combine diffServerURI
- }
- where combine field = field a `mappend` field b
-
-defaultDiffFlags :: DiffFlags
-defaultDiffFlags = DiffFlags {
- -- diffMode = Flag "all",
- diffVerbosity = Flag normal
- -- , diffServerURI = Flag defaultHackageServerURI
- }
-
-diffCommand :: CommandUI DiffFlags
-diffCommand = CommandUI {
- commandName = "diff",
- commandSynopsis = "Run diff",
- commandDescription = Just $ \_pname ->
- "TODO: this is the commandDescription for diffCommand\n",
- commandUsage = usagePackages "diff",
- commandDefaultFlags = defaultDiffFlags,
- commandOptions = \_showOrParseArgs ->
- [ optionVerbosity diffVerbosity (\v flags -> flags { diffVerbosity = v })
- {-
- , option [] ["mode"]
- "Diff mode, one of: all, newer, missing, additions, common"
- diffMode (\v flags -> flags { diffMode = v })
- (reqArgFlag "MODE") -- I don't know how to map it strictly to DiffMode
- -}
- ]
- }
-
-diffAction :: DiffFlags -> [String] -> GlobalFlags -> IO ()
-diffAction flags args globalFlags = do
- let verbosity = fromFlag (diffVerbosity flags)
- -- dm0 = fromFlag (diffMode flags)
- dm <- case args of
- [] -> return ShowAll
- ["all"] -> return ShowAll
- ["missing"] -> return ShowMissing
- ["additions"] -> return ShowAdditions
- ["newer"] -> return ShowNewer
- ["common"] -> return ShowCommon
- ("package": pkgs) -> return (ShowPackages pkgs)
- -- TODO: ["package",packagePattern] ->
- -- return ShowPackagePattern packagePattern
- _ -> die $ "Unknown mode: " ++ unwords args
- overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)
- let repo = defaultRepo overlayPath
- runDiff verbosity overlayPath dm repo
-
------------------------------------------------------------------------
-- Update
-----------------------------------------------------------------------
data UpdateFlags = UpdateFlags {
updateVerbosity :: Flag Verbosity
- -- , updateServerURI :: Flag String
}
instance Monoid UpdateFlags where
mempty = UpdateFlags {
updateVerbosity = mempty
- -- , updateServerURI = mempty
}
mappend a b = UpdateFlags {
updateVerbosity = combine updateVerbosity
- -- , updateServerURI = combine updateServerURI
}
where combine field = field a `mappend` field b
defaultUpdateFlags :: UpdateFlags
defaultUpdateFlags = UpdateFlags {
updateVerbosity = Flag normal
- -- , updateServerURI = Flag defaultHackageServerURI
}
updateCommand :: CommandUI UpdateFlags
updateCommand = CommandUI {
commandName = "update",
- commandSynopsis = "Update the local cache",
- commandDescription = Just $ \_pname ->
- "TODO: this is the commandDescription for updateCommand\n",
+ commandSynopsis = "Update the local package database",
commandUsage = usageFlags "update",
+ commandDescription = Nothing,
+ commandNotes = Nothing,
+
commandDefaultFlags = defaultUpdateFlags,
commandOptions = \_ ->
[ optionVerbosity updateVerbosity (\v flags -> flags { updateVerbosity = v })
@@ -295,15 +212,14 @@ updateCommand = CommandUI {
]
}
-updateAction :: UpdateFlags -> [String] -> GlobalFlags -> IO ()
+updateAction :: UpdateFlags -> [String] -> H.GlobalFlags -> IO ()
updateAction flags extraArgs globalFlags = do
unless (null extraArgs) $
die $ "'update' doesn't take any extra arguments: " ++ unwords extraArgs
let verbosity = fromFlag (updateVerbosity flags)
- overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)
- http_transport <- DCH.configureTransport verbosity Nothing
- update http_transport verbosity [ defaultRepo overlayPath ]
-
+
+ H.withHackPortContext verbosity globalFlags $ \repoContext ->
+ update verbosity repoContext
-----------------------------------------------------------------------
-- Status
@@ -323,10 +239,11 @@ defaultStatusFlags = StatusFlags {
statusCommand :: CommandUI StatusFlags
statusCommand = CommandUI {
commandName = "status",
- commandSynopsis = "Show status(??)",
- commandDescription = Just $ \_pname ->
- "TODO: this is the commandDescription for statusCommand\n",
+ commandSynopsis = "Show up-to-date status against other repos (hackage, ::gentoo)",
commandUsage = usagePackages "status",
+ commandDescription = Nothing,
+ commandNotes = Nothing,
+
commandDefaultFlags = defaultStatusFlags,
commandOptions = \_ ->
[ optionVerbosity statusVerbosity (\v flags -> flags { statusVerbosity = v })
@@ -341,13 +258,15 @@ statusCommand = CommandUI {
]
}
-statusAction :: StatusFlags -> [String] -> GlobalFlags -> IO ()
+statusAction :: StatusFlags -> [String] -> H.GlobalFlags -> IO ()
statusAction flags args globalFlags = do
let verbosity = fromFlag (statusVerbosity flags)
direction = fromFlag (statusDirection flags)
portagePath <- getPortageDir verbosity globalFlags
- overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)
- runStatus verbosity portagePath overlayPath direction args
+ overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)
+
+ H.withHackPortContext verbosity globalFlags $ \repoContext ->
+ runStatus verbosity portagePath overlayPath direction args repoContext
-----------------------------------------------------------------------
-- Merge
@@ -379,9 +298,10 @@ mergeCommand :: CommandUI MergeFlags
mergeCommand = CommandUI {
commandName = "merge",
commandSynopsis = "Make an ebuild out of hackage package",
- commandDescription = Just $ \_pname ->
- "TODO: this is the commandDescription for mergeCommand\n",
commandUsage = usagePackages "merge",
+ commandDescription = Nothing,
+ commandNotes = Nothing,
+
commandDefaultFlags = defaultMergeFlags,
commandOptions = \_showOrParseArgs ->
[ optionVerbosity mergeVerbosity (\v flags -> flags { mergeVerbosity = v })
@@ -396,71 +316,18 @@ mergeCommand = CommandUI {
]
}
-mergeAction :: MergeFlags -> [String] -> GlobalFlags -> IO ()
+mergeAction :: MergeFlags -> [String] -> H.GlobalFlags -> IO ()
mergeAction flags extraArgs globalFlags = do
let verbosity = fromFlag (mergeVerbosity flags)
- overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)
- let repo = defaultRepo overlayPath
- merge verbosity repo (defaultRepoURI overlayPath) extraArgs overlayPath (fromFlag $ mergeCabalFlags flags)
-
------------------------------------------------------------------------
--- DistroMap
------------------------------------------------------------------------
-
-data DistroMapFlags = DistroMapFlags {
- distroMapVerbosity :: Flag Verbosity
- }
-
-instance Monoid DistroMapFlags where
- mempty = DistroMapFlags {
- distroMapVerbosity = mempty
- -- , mergeServerURI = mempty
- }
- mappend a b = DistroMapFlags {
- distroMapVerbosity = combine distroMapVerbosity
- }
- where combine field = field a `mappend` field b
-
-defaultDistroMapFlags :: DistroMapFlags
-defaultDistroMapFlags = DistroMapFlags {
- distroMapVerbosity = Flag normal
- }
-
-distroMapCommand :: CommandUI DistroMapFlags
-distroMapCommand = CommandUI {
- commandName = "distromap",
- commandSynopsis = "Build a distromap file",
- commandDescription = Just $ \_pname ->
- "TODO: this is the commandDescription for distroMapCommand\n",
- commandUsage = usagePackages "distromap",
- commandDefaultFlags = defaultDistroMapFlags,
- commandOptions = \_showOrParseArgs ->
- [ optionVerbosity distroMapVerbosity (\v flags -> flags { distroMapVerbosity = v })
- ]
- }
+ overlayPath <- getOverlayPath verbosity (fromFlag $ H.globalPathToOverlay globalFlags)
-distroMapAction :: DistroMapFlags-> [String] -> GlobalFlags -> IO ()
-distroMapAction flags extraArgs globalFlags = do
- let verbosity = fromFlag (distroMapVerbosity flags)
- overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)
- let repo = defaultRepo overlayPath
- portagePath <- getPortageDir verbosity globalFlags
- distroMap verbosity repo portagePath overlayPath extraArgs
+ H.withHackPortContext verbosity globalFlags $ \repoContext ->
+ merge verbosity repoContext extraArgs overlayPath (fromFlag $ mergeCabalFlags flags)
-----------------------------------------------------------------------
-- Utils
-----------------------------------------------------------------------
-getServerURI :: String -> IO URI
-getServerURI str =
- case parseURI str of
- Just uri -> return uri
- Nothing -> throwEx (InvalidServer str)
-
-reqArgFlag :: ArgPlaceHolder -> SFlags -> LFlags -> Description ->
- (b -> Flag String) -> (Flag String -> b -> b) -> OptDescr b
-reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList
-
usagePackages :: String -> String -> String
usagePackages op_name pname =
"Usage: " ++ pname ++ " " ++ op_name ++ " [FLAGS] [PACKAGE]\n\n"
@@ -471,9 +338,9 @@ usageFlags flag_name pname =
"Usage: " ++ pname ++ " " ++ flag_name ++ " [FLAGS]\n\n"
++ "Flags for " ++ flag_name ++ ":"
-getPortageDir :: Verbosity -> GlobalFlags -> IO FilePath
+getPortageDir :: Verbosity -> H.GlobalFlags -> IO FilePath
getPortageDir verbosity globalFlags = do
- let portagePathM = fromFlag (globalPathToPortage globalFlags)
+ let portagePathM = fromFlag (H.globalPathToPortage globalFlags)
portagePath <- case portagePathM of
Nothing -> Host.portage_dir <$> Host.getInfo
Just path -> return path
@@ -486,45 +353,31 @@ getPortageDir verbosity globalFlags = do
-- Main
-----------------------------------------------------------------------
-data GlobalFlags =
- GlobalFlags { globalVersion :: Flag Bool
- , globalNumericVersion :: Flag Bool
- , globalPathToOverlay :: Flag (Maybe FilePath)
- , globalPathToPortage :: Flag (Maybe FilePath)
- }
-
-defaultGlobalFlags :: GlobalFlags
-defaultGlobalFlags =
- GlobalFlags { globalVersion = Flag False
- , globalNumericVersion = Flag False
- , globalPathToOverlay = Flag Nothing
- , globalPathToPortage = Flag Nothing
- }
-
-globalCommand :: CommandUI GlobalFlags
+globalCommand :: CommandUI H.GlobalFlags
globalCommand = CommandUI {
commandName = "",
commandSynopsis = "",
- commandDescription = Just $ \_pname ->
- "TODO: this is the commandDescription for globalCommand\n",
+ commandDescription = Nothing,
+ commandNotes = Nothing,
commandUsage = \_ -> [],
- commandDefaultFlags = defaultGlobalFlags,
+
+ commandDefaultFlags = H.defaultGlobalFlags,
commandOptions = \_showOrParseArgs ->
[ option ['V'] ["version"]
"Print version information"
- globalVersion (\v flags -> flags { globalVersion = v })
+ H.globalVersion (\v flags -> flags { H.globalVersion = v })
trueArg
, option [] ["numeric-version"]
"Print just the version number"
- globalNumericVersion (\v flags -> flags { globalNumericVersion = v })
+ H.globalNumericVersion (\v flags -> flags { H.globalNumericVersion = v })
trueArg
, option ['p'] ["overlay-path"]
"Override search path list where .hackport/ lives (default list: ['.', paludis-ovls or emerge-ovls])"
- globalPathToOverlay (\ovrl_path flags -> flags { globalPathToOverlay = ovrl_path })
+ H.globalPathToOverlay (\ovrl_path flags -> flags { H.globalPathToOverlay = ovrl_path })
(reqArg' "PATH" (Flag . Just) (\(Flag ms) -> catMaybes [ms]))
, option [] ["portage-path"]
"Override path to your portage tree"
- globalPathToPortage (\port_path flags -> flags { globalPathToPortage = port_path })
+ H.globalPathToPortage (\port_path flags -> flags { H.globalPathToPortage = port_path })
(reqArg' "PATH" (Flag . Just) (\(Flag ms) -> catMaybes [ms]))
]
}
@@ -537,8 +390,8 @@ mainWorker args =
CommandErrors errs -> printErrors errs
CommandReadyToGo (globalflags, commandParse) -> do
case commandParse of
- _ | fromFlag (globalVersion globalflags) -> printVersion
- | fromFlag (globalNumericVersion globalflags) -> printNumericVersion
+ _ | fromFlag (H.globalVersion globalflags) -> printVersion
+ | fromFlag (H.globalNumericVersion globalflags) -> printNumericVersion
CommandHelp help -> printHelp help
CommandList opts -> printOptionsList opts
CommandErrors errs -> printErrors errs
@@ -563,10 +416,8 @@ mainWorker args =
[ listCommand `commandAddAction` listAction
, makeEbuildCommand `commandAddAction` makeEbuildAction
, statusCommand `commandAddAction` statusAction
- , diffCommand `commandAddAction` diffAction
, updateCommand `commandAddAction` updateAction
, mergeCommand `commandAddAction` mergeAction
- , distroMapCommand `commandAddAction` distroMapAction
]
main :: IO ()
diff --git a/Merge.hs b/Merge.hs
index 171e483..f25dc85 100644
--- a/Merge.hs
+++ b/Merge.hs
@@ -31,10 +31,12 @@ import Distribution.Simple.Utils
-- cabal-install
import Distribution.Client.IndexUtils ( getSourcePackages )
+import qualified Distribution.Client.GlobalFlags as CabalInstall
import qualified Distribution.Client.PackageIndex as Index
import Distribution.Client.Types
-- others
+import qualified Data.List.Split as DLS
import System.Directory ( getCurrentDirectory
, setCurrentDirectory
, createDirectoryIfMissing
@@ -49,8 +51,6 @@ import qualified Portage.EBuild as E
import qualified Portage.EMeta as EM
import Error as E
-import Network.URI
-
import qualified Portage.Cabal as Portage
import qualified Portage.PackageId as Portage
import qualified Portage.Version as Portage
@@ -64,9 +64,6 @@ import qualified Portage.GHCCore as GHCCore
import qualified Merge.Dependencies as Merge
-import qualified Util as U
-
-
(<.>) :: String -> String -> String
a <.> b = a ++ '.':b
@@ -98,14 +95,14 @@ readPackageString args = do
-- | Given a list of available packages, and maybe a preferred version,
-- return the available package with that version. Latest version is chosen
-- if no preference.
-resolveVersion :: [SourcePackage] -> Maybe Cabal.Version -> Maybe SourcePackage
+resolveVersion :: [UnresolvedSourcePackage] -> Maybe Cabal.Version -> Maybe UnresolvedSourcePackage
resolveVersion avails Nothing = Just $ L.maximumBy (comparing (Cabal.pkgVersion . packageInfoId)) avails
resolveVersion avails (Just ver) = listToMaybe (filter match avails)
where
match avail = ver == Cabal.pkgVersion (packageInfoId avail)
-merge :: Verbosity -> Repo -> URI -> [String] -> FilePath -> Maybe String -> IO ()
-merge verbosity repo _serverURI args overlayPath users_cabal_flags = do
+merge :: Verbosity -> CabalInstall.RepoContext -> [String] -> FilePath -> Maybe String -> IO ()
+merge verbosity repoContext args overlayPath users_cabal_flags = do
(m_category, user_pName, m_version) <-
case readPackageString args of
Left err -> throwEx err
@@ -125,7 +122,7 @@ merge verbosity repo _serverURI args overlayPath users_cabal_flags = do
overlay <- Overlay.loadLazy overlayPath
-- portage_path <- Host.portage_dir `fmap` Host.getInfo
-- portage <- Overlay.loadLazy portage_path
- index <- fmap packageIndex $ getSourcePackages verbosity [ repo ]
+ index <- fmap packageIndex $ getSourcePackages verbosity repoContext
-- find all packages that maches the user specified package name
availablePkgs <-
@@ -186,7 +183,7 @@ mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch us
user_renames = [ (cfn, ein)
| ((Cabal.FlagName cfn, ein), Nothing) <- cn_in_mb
]
- cn_in_mb = map read_fa $ U.split (== ',') user_fas_s
+ cn_in_mb = map read_fa $ DLS.splitOn "," user_fas_s
read_fa :: String -> ((Cabal.FlagName, String), Maybe Bool)
read_fa [] = error $ "read_fas: empty flag?"
read_fa (op:flag) =
@@ -196,7 +193,7 @@ mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch us
_ -> (get_rename (op:flag), Nothing)
where get_rename :: String -> (Cabal.FlagName, String)
get_rename s =
- case U.split (== ':') s of
+ case DLS.splitOn ":" s of
[cabal_flag_name] -> (Cabal.FlagName cabal_flag_name, cabal_flag_name)
[cabal_flag_name, iuse_name] -> (Cabal.FlagName cabal_flag_name, iuse_name)
_ -> error $ "get_rename: too many components" ++ show (s)
@@ -356,14 +353,6 @@ mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch us
icalate _s [x] = [x]
icalate s (x:xs) = (x ++ s) : icalate s xs
- gamesFlags :: [String]
- gamesFlags = ["--prefix=\"${GAMES_PREFIX}\""]
-
- addGamesFlags :: [String] -> [String]
- addGamesFlags xs
- | Portage.is_games_cat cat = xs ++ gamesFlags
- | otherwise = xs
-
build_configure_call :: [String] -> [String]
build_configure_call [] = []
build_configure_call conf_args = icalate " \\" $
@@ -386,7 +375,8 @@ mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch us
. (\e -> e { E.depend_extra = S.toList $ Merge.dep_e tdeps } )
. (\e -> e { E.rdepend = Merge.rdep tdeps} )
. (\e -> e { E.rdepend_extra = S.toList $ Merge.rdep_e tdeps } )
- . (\e -> e { E.src_configure = build_configure_call $ addGamesFlags $ selected_flags (active_flags, user_specified_fas) } )
+ . (\e -> e { E.src_configure = build_configure_call $
+ selected_flags (active_flags, user_specified_fas) } )
. (\e -> e { E.iuse = E.iuse e ++ map to_iuse active_flag_descs })
. ( case requested_cabal_flags of
Nothing -> id
diff --git a/Merge/Dependencies.hs b/Merge/Dependencies.hs
index 4581b4b..a9cc01b 100644
--- a/Merge/Dependencies.hs
+++ b/Merge/Dependencies.hs
@@ -114,7 +114,7 @@ resolveDependencies overlay pkg compiler_info ghc_package_names merged_cabal_pkg
where
-- hasBuildableExes p = any (buildable . buildInfo) . executables $ p
treatAsLibrary :: Bool
- treatAsLibrary = isJust (Cabal.library pkg)
+ treatAsLibrary = Cabal.libraries pkg /= []
-- without slot business
raw_haskell_deps :: Portage.Dependency
raw_haskell_deps = PN.normalize_depend $ Portage.DependAllOf $ haskellDependencies overlay (buildDepends pkg)
@@ -230,14 +230,14 @@ compilerInfoToDependency ~(Cabal.CompilerInfo {
---------------------------------------------------------------
findCLibs :: PackageDescription -> [Portage.Dependency]
-findCLibs (PackageDescription { library = lib, executables = exes }) =
+findCLibs (PackageDescription { libraries = libs, executables = exes }) =
[ trace ("WARNING: This package depends on a C library we don't know the portage name for: " ++ p ++ ". Check the generated ebuild.")
(any_c_p "unknown-c-lib" p)
| p <- notFound
] ++
found
where
- libE = maybe [] (extraLibs.libBuildInfo) lib
+ libE = concatMap (extraLibs . libBuildInfo) libs
exeE = concatMap extraLibs (filter buildable (map buildInfo exes))
allE = libE ++ exeE
@@ -357,6 +357,7 @@ staticTranslateExtraLib lib = lookup lib m
, ("SDL_gfx", any_c_p "media-libs" "sdl-gfx")
, ("SDL_image", any_c_p "media-libs" "sdl-image")
, ("SDL_ttf", any_c_p "media-libs" "sdl-ttf")
+ , ("odbc", any_c_p "dev-db" "unixODBC")
]
---------------------------------------------------------------
@@ -364,7 +365,7 @@ staticTranslateExtraLib lib = lookup lib m
---------------------------------------------------------------
buildToolsDependencies :: PackageDescription -> [Portage.Dependency]
-buildToolsDependencies (PackageDescription { library = lib, executables = exes }) = nub $
+buildToolsDependencies (PackageDescription { libraries = libs, executables = exes }) = nub $
[ case pkg of
Just p -> p
Nothing -> trace ("WARNING: Unknown build tool '" ++ pn ++ "'. Check the generated ebuild.")
@@ -374,7 +375,7 @@ buildToolsDependencies (PackageDescription { library = lib, executables = exes }
]
where
cabalDeps = filter notProvided $ depL ++ depE
- depL = maybe [] (buildTools.libBuildInfo) lib
+ depL = concatMap (buildTools . libBuildInfo) libs
depE = concatMap buildTools (filter buildable (map buildInfo exes))
notProvided (Cabal.Dependency (Cabal.PackageName pn) _range) = pn `notElem` buildToolsProvided
@@ -405,10 +406,10 @@ buildToolsProvided = ["hsc2hs"]
---------------------------------------------------------------
pkgConfigDependencies :: Portage.Overlay -> PackageDescription -> [Portage.Dependency]
-pkgConfigDependencies overlay (PackageDescription { library = lib, executables = exes }) = nub $ resolvePkgConfigs overlay cabalDeps
+pkgConfigDependencies overlay (PackageDescription { libraries = libs, executables = exes }) = nub $ resolvePkgConfigs overlay cabalDeps
where
cabalDeps = depL ++ depE
- depL = maybe [] (pkgconfigDepends.libBuildInfo) lib
+ depL = concatMap (pkgconfigDepends . libBuildInfo) libs
depE = concatMap pkgconfigDepends (filter buildable (map buildInfo exes))
resolvePkgConfigs :: Portage.Overlay -> [Cabal.Dependency] -> [Portage.Dependency]
@@ -517,4 +518,11 @@ pkgconfig_table =
,("libpq", ("dev-db", "postgresql", Portage.AnySlot))
,("poppler-glib", ("app-text", "poppler", Portage.AnySlot))
,("gsl", ("sci-libs", "gsl", Portage.AnySlot))
+ ,("libvirt", ("app-emulation", "libvirt", Portage.AnySlot))
+
+ ,("Qt5Core", ("dev-qt", "qtcore", Portage.GivenSlot "5"))
+ ,("Qt5Gui", ("dev-qt", "qtgui", Portage.GivenSlot "5"))
+ ,("Qt5Qml", ("dev-qt", "qtdeclarative", Portage.GivenSlot "5"))
+ ,("Qt5Quick", ("dev-qt", "qtdeclarative", Portage.GivenSlot "5"))
+ ,("Qt5Widgets", ("dev-qt", "qtwidgets", Portage.GivenSlot "5"))
]
diff --git a/Overlays.hs b/Overlays.hs
index 6a4614a..c034b5f 100644
--- a/Overlays.hs
+++ b/Overlays.hs
@@ -5,11 +5,10 @@ module Overlays
import Control.Monad
import Data.List (nub, inits)
import Data.Maybe (maybeToList, listToMaybe, isJust, fromJust)
-import System.Directory
+import qualified System.Directory as SD
import System.FilePath ((</>), splitPath, joinPath)
import Error
-import CacheFile
import Portage.Host
-- cabal
@@ -32,7 +31,7 @@ getOverlayPath verbosity override_overlay = do
let loop [] = throwEx (MultipleOverlays mul)
loop (x:xs) = do
info verbosity $ "Checking '" ++ x ++ "'..."
- found <- doesFileExist (cacheFile x)
+ found <- SD.doesDirectoryExist (x </> ".hackport")
if found
then do
info verbosity "OK!"
@@ -62,10 +61,9 @@ getOverlays = do
getLocalOverlay :: IO (Maybe FilePath)
getLocalOverlay = do
- curDir <- getCurrentDirectory
+ curDir <- SD.getCurrentDirectory
let lookIn = map joinPath . reverse . inits . splitPath $ curDir
fmap listToMaybe (filterM probe lookIn)
where
- probe dir = doesDirectoryExist (dir </> "dev-haskell")
-
+ probe dir = SD.doesDirectoryExist (dir </> "dev-haskell")
diff --git a/Portage/EBuild.hs b/Portage/EBuild.hs
index e68b8c7..96b53d7 100644
--- a/Portage/EBuild.hs
+++ b/Portage/EBuild.hs
@@ -7,7 +7,6 @@ module Portage.EBuild
) where
import Portage.Dependency
-import qualified Portage.PackageId as PI
import qualified Portage.Dependency.Normalize as PN
import Data.String.Utils
@@ -18,9 +17,7 @@ import qualified Data.List as L
import Data.Version(Version(..))
import qualified Paths_hackport(version)
-#if MIN_VERSION_time(1,5,0)
-import qualified System.Locale as SL
-#else
+#if ! MIN_VERSION_time(1,5,0)
import qualified System.Locale as TC
#endif
@@ -96,13 +93,13 @@ showEBuild now ebuild =
ss "# Distributed under the terms of the GNU General Public License v2". nl.
ss "# $Id$". nl.
nl.
- ss "EAPI=5". nl.
+ ss "EAPI=6". nl.
nl.
ss ("# ebuild generated by hackport " ++ hackportVersion ebuild). nl.
sconcat (map (\(k, v) -> ss "#hackport: " . ss k . ss ": " . ss v . nl) $ used_options ebuild).
nl.
ss "CABAL_FEATURES=". quote' (sepBy " " $ features ebuild). nl.
- ss "inherit haskell-cabal". if_games (ss " games") . nl.
+ ss "inherit haskell-cabal". nl.
nl.
(case my_pn ebuild of
Nothing -> id
@@ -125,11 +122,6 @@ showEBuild now ebuild =
Nothing -> id
Just _ -> nl. ss "S=". quote ("${WORKDIR}/${MY_P}"). nl).
- if_games (nl . ss "pkg_setup() {" . nl.
- ss (tabify_line " games_pkg_setup") . nl.
- ss (tabify_line " haskell-cabal_pkg_setup") . nl.
- ss "}" . nl).
-
verbatim (nl . ss "src_prepare() {" . nl)
(src_prepare ebuild)
(ss "}" . nl).
@@ -138,20 +130,6 @@ showEBuild now ebuild =
(src_configure ebuild)
(ss "}" . nl).
- if_games (nl . ss "src_compile() {" . nl.
- ss (tabify_line " haskell-cabal_src_compile") . nl.
- ss "}" . nl).
-
- if_games (nl . ss "src_install() {" . nl.
- ss (tabify_line " haskell-cabal_src_install") . nl.
- ss (tabify_line " prepgamesdirs") . nl.
- ss "}" . nl).
-
- if_games (nl . ss "pkg_postinst() {" . nl.
- ss (tabify_line " haskell-cabal_pkg_postinst") . nl.
- ss (tabify_line " games_pkg_postinst") . nl.
- ss "}" . nl).
-
id $ []
where
expandVars = replaceMultiVars [ ( name ebuild, "${PN}")
@@ -162,10 +140,6 @@ showEBuild now ebuild =
toHttps = replace "http://github.com/" "https://github.com/"
this_year :: String
this_year = TC.formatTime TC.defaultTimeLocale "%Y" now
- if_games :: DString -> DString
- if_games ds = if PI.is_games_cat (PI.Category (category ebuild))
- then ds
- else id
-- "+a" -> "a"
-- "b" -> "b"
diff --git a/Portage/GHCCore.hs b/Portage/GHCCore.hs
index 93bb2e2..8a98edc 100644
--- a/Portage/GHCCore.hs
+++ b/Portage/GHCCore.hs
@@ -95,8 +95,7 @@ minimumGHCVersionToBuildPackage gpd user_specified_fas =
mkIndex :: [PackageIdentifier] -> InstalledPackageIndex
mkIndex pids = fromList
[ emptyInstalledPackageInfo
- { IPI.installedPackageId = InstalledPackageId $ display name ++ "-" ++ display version
- , sourcePackageId = pindex
+ { sourcePackageId = pindex
, exposed = True
}
| pindex@(PackageIdentifier name version) <- pids ]
diff --git a/Portage/Host.hs b/Portage/Host.hs
index e1fb598..3b23033 100644
--- a/Portage/Host.hs
+++ b/Portage/Host.hs
@@ -4,6 +4,7 @@ module Portage.Host
) where
import Util (run_cmd)
+import qualified Data.List.Split as DLS
import Data.Maybe (fromJust, isJust, catMaybes)
import Control.Applicative ( (<$>) )
@@ -73,7 +74,7 @@ getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "cave info"
parsePaludisInfo :: String -> LocalInfo
parsePaludisInfo text =
- let chunks = splitBy (=="") . lines $ text
+ let chunks = DLS.splitOn [""] . lines $ text
repositories = catMaybes (map parseRepository chunks)
in fromJust (mkLocalInfo repositories)
where
@@ -98,13 +99,6 @@ parsePaludisInfo text =
, overlay_list = overlays
})
-splitBy :: (a -> Bool) -> [a] -> [[a]]
-splitBy _ [] = []
-splitBy c lst =
- let (x,xs) = break c lst
- (_,xs') = span c xs
- in x : splitBy c xs'
-
---------
-- Emerge
---------
diff --git a/Portage/PackageId.hs b/Portage/PackageId.hs
index e1bad7d..a337b17 100644
--- a/Portage/PackageId.hs
+++ b/Portage/PackageId.hs
@@ -12,12 +12,10 @@ module Portage.PackageId (
normalizeCabalPackageName,
normalizeCabalPackageId,
packageIdToFilePath,
- cabal_pn_to_PN,
- is_games_cat
+ cabal_pn_to_PN
) where
import Data.Char
-import qualified Data.List as L
import qualified Distribution.Package as Cabal
import Distribution.Text (Text(..))
@@ -131,6 +129,3 @@ parseFriendlyPackage str =
cabal_pn_to_PN :: Cabal.PackageName -> String
cabal_pn_to_PN = map toLower . display
-
-is_games_cat :: Category -> Bool
-is_games_cat = L.isPrefixOf "games" . unCategory
diff --git a/Progress.hs b/Progress.hs
deleted file mode 100644
index d18fa10..0000000
--- a/Progress.hs
+++ /dev/null
@@ -1,61 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Progress
--- Copyright : (c) Duncan Coutts 2008
--- License : BSD-like
---
--- Portability : portable
---
--- Common types for dependency resolution.
------------------------------------------------------------------------------
-module Progress (
- Progress(..),
- fold, unfold, fromList,
- ) where
-
-import Prelude hiding (fail)
-
--- | A type to represent the unfolding of an expensive long running
--- calculation that may fail. We may get intermediate steps before the final
--- retult which may be used to indicate progress and\/or logging messages.
---
-data Progress step fail done = Step step (Progress step fail done)
- | Fail fail
- | Done done
-
--- | Consume a 'Progress' calculation. Much like 'foldr' for lists but with
--- two base cases, one for a final result and one for failure.
---
--- Eg to convert into a simple 'Either' result use:
---
--- > foldProgress (flip const) Left Right
---
-fold :: (step -> a -> a) -> (fail -> a) -> (done -> a)
- -> Progress step fail done -> a
-fold step fail done = go
- where
- go (Step s p) = step s (go p)
- go (Fail f) = fail f
- go (Done r) = done r
-
-unfold :: (s -> Either (Either fail done) (step, s))
- -> s -> Progress step fail done
-unfold f = go
- where
- go s = case f s of
- Left (Left fail) -> Fail fail
- Left (Right done) -> Done done
- Right (step, s') -> Step step (go s')
-
-fromList :: [a] -> Progress () b [a]
-fromList xs0 = unfold next xs0
- where
- next [] = Left (Right xs0)
- next (_:xs) = Right ((), xs)
-
-instance Functor (Progress step fail) where
- fmap f = fold Step Fail (Done . f)
-
-instance Monad (Progress step fail) where
- return a = Done a
- p >>= f = fold Step Fail f p
diff --git a/README.rst b/README.rst
index 28898aa..1a758c7 100644
--- a/README.rst
+++ b/README.rst
@@ -23,6 +23,7 @@ Quick start
$ cd ~/overlays
$ git clone git://github.com/gentoo-haskell/gentoo-haskell.git
$ cd gentoo-haskell
+ $ mkdir .hackport
$ hackport update
$ ls -1 .hackport/
00-index.tar
diff --git a/Setup.hs b/Setup.hs
index 36c3aa9..e15fd03 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,5 +1,5 @@
#!/usr/bin/runhaskell
-module Main where
+module Main (main) where
import Distribution.Simple
diff --git a/Status.hs b/Status.hs
index c3260b7..fe77248 100644
--- a/Status.hs
+++ b/Status.hs
@@ -28,16 +28,15 @@ import Control.Applicative
import Control.Monad
-- cabal
-import Distribution.Client.Types ( Repo, SourcePackageDb(..), SourcePackage(..) )
+import Distribution.Client.Types ( SourcePackageDb(..), SourcePackage(..) )
import Distribution.Verbosity
import Distribution.Package (pkgName)
import Distribution.Simple.Utils (comparing, die, equating)
import Distribution.Text ( display, simpleParse )
-import qualified Distribution.Client.PackageIndex as CabalInstall
+import qualified Distribution.Client.GlobalFlags as CabalInstall
import qualified Distribution.Client.IndexUtils as CabalInstall
-
-import Hackage (defaultRepo)
+import qualified Distribution.Client.PackageIndex as CabalInstall
data StatusDirection
= PortagePlusOverlay
@@ -76,9 +75,9 @@ fromStatus fs =
-loadHackage :: Verbosity -> Distribution.Client.Types.Repo -> Overlay -> IO [[PackageId]]
-loadHackage verbosity repo overlay = do
- SourcePackageDb { packageIndex = pindex } <- CabalInstall.getSourcePackages verbosity [repo]
+loadHackage :: Verbosity -> CabalInstall.RepoContext -> Overlay -> IO [[PackageId]]
+loadHackage verbosity repoContext overlay = do
+ SourcePackageDb { packageIndex = pindex } <- CabalInstall.getSourcePackages verbosity repoContext
let get_cat cabal_pkg = case resolveCategories overlay (pkgName cabal_pkg) of
[] -> Category "dev-haskell"
[cat] -> cat
@@ -89,11 +88,10 @@ loadHackage verbosity repo overlay = do
(CabalInstall.allPackagesByName pindex)
return pkg_infos
-status :: Verbosity -> FilePath -> FilePath -> IO (Map PackageName [FileStatus ExistingEbuild])
-status verbosity portdir overlaydir = do
- let repo = defaultRepo overlaydir
+status :: Verbosity -> FilePath -> FilePath -> CabalInstall.RepoContext -> IO (Map PackageName [FileStatus ExistingEbuild])
+status verbosity portdir overlaydir repoContext = do
overlay <- loadLazy overlaydir
- hackage <- loadHackage verbosity repo overlay
+ hackage <- loadHackage verbosity repoContext overlay
portage <- filterByEmail ("haskell@gentoo.org" `elem`) <$> loadLazy portdir
let (over, both, port) = portageDiff (overlayMap overlay) (overlayMap portage)
@@ -132,8 +130,8 @@ lookupEbuildWith overlay pkgid = do
ebuilds <- Map.lookup (packageId pkgid) overlay
List.find (\e -> ebuildId e == pkgid) ebuilds
-runStatus :: Verbosity -> FilePath -> FilePath -> StatusDirection -> [String] -> IO ()
-runStatus verbosity portdir overlaydir direction pkgs = do
+runStatus :: Verbosity -> FilePath -> FilePath -> StatusDirection -> [String] -> CabalInstall.RepoContext -> IO ()
+runStatus verbosity portdir overlaydir direction pkgs repoContext = do
let pkgFilter = case direction of
OverlayToPortage -> toPortageFilter
PortagePlusOverlay -> id
@@ -142,7 +140,7 @@ runStatus verbosity portdir overlaydir direction pkgs = do
case simpleParse p of
Nothing -> die ("Could not parse package name: " ++ p ++ ". Format cat/pkg")
Just pn -> return pn
- tree0 <- status verbosity portdir overlaydir
+ tree0 <- status verbosity portdir overlaydir repoContext
let tree = pkgFilter tree0
if (null pkgs')
then statusPrinter tree
diff --git a/Util.hs b/Util.hs
index 209eace..95f5d88 100644
--- a/Util.hs
+++ b/Util.hs
@@ -8,7 +8,6 @@
module Util
( run_cmd -- :: String -> IO (Maybe String)
- , split -- :: (a -> Bool) -> [a] -> [[a]]
) where
import System.IO
@@ -30,10 +29,3 @@ run_cmd cmd = do (hI, hO, hE, hProcess) <- runInteractiveCommand cmd
return $ if (output == "" || exitCode /= ExitSuccess)
then Nothing
else Just output
-
-split :: Eq a => (a -> Bool) -> [a] -> [[a]]
-split _ [] = []
-split p xs =
- case break p xs of
- (l, []) -> [l]
- (l, _:r) -> l: split p r
diff --git a/cabal/.arcconfig b/cabal/.arcconfig
new file mode 100644
index 0000000..5a888cd
--- /dev/null
+++ b/cabal/.arcconfig
@@ -0,0 +1,4 @@
+{
+ "repository.callsign" : "CABAL",
+ "phabricator.uri" : "https://phabricator.haskell.org"
+}
diff --git a/cabal/.travis.yml b/cabal/.travis.yml
index 5f5f3f6..67f87a4 100644
--- a/cabal/.travis.yml
+++ b/cabal/.travis.yml
@@ -1,70 +1,37 @@
# NB: don't set `language: haskell` here
-# The following enables several GHC versions to be tested; often it's enough to test only against the last release in a major GHC version. Feel free to omit lines listings versions you don't need/want testing for.
+# The following enables several GHC versions to be tested; often it's enough to
+# test only against the last release in a major GHC version. Feel free to omit
+# lines listings versions you don't need/want testing for.
env:
- GHCVER=7.4.2
- GHCVER=7.6.3
- GHCVER=7.8.4
- - GHCVER=7.10.1
+ - GHCVER=7.10.3
+ - GHCVER=8.0.1 TEST_OLDER=YES
+ # TODO add PARSEC_BUNDLED=YES when it's so
- GHCVER=head
# Note: the distinction between `before_install` and `install` is not important.
before_install:
- travis_retry sudo add-apt-repository -y ppa:hvr/ghc
- travis_retry sudo apt-get update
- - travis_retry sudo apt-get install cabal-install-1.22 ghc-$GHCVER-prof ghc-$GHCVER-dyn happy
- - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.22/bin:$PATH
+ - travis_retry sudo apt-get install cabal-install-1.24 ghc-$GHCVER-prof ghc-$GHCVER-dyn happy
+ - if [ "$TEST_OLDER" == "YES" ]; then travis_retry sudo apt-get install ghc-7.0.4-prof ghc-7.0.4-dyn ghc-7.2.2-prof ghc-7.2.2-dyn; fi
+ - export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/1.24/bin:$PATH
+ - git version
install:
- cabal update
-# We intentionally do not install anything before trying to build Cabal because
-# it should build with each supported GHC version out-of-the-box.
+ # We intentionally do not install anything before trying to build Cabal because
+ # it should build with each supported GHC version out-of-the-box.
-# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail.
-# Using ./dist/setup/setup here instead of cabal-install to avoid breakage
-# when the build config format changed
+# Here starts the actual work to be performed for the package under test; any
+# command which exits with a non-zero exit code causes the build to fail. Using
+# ./dist/setup/setup here instead of cabal-install to avoid breakage when the
+# build config format changed.
script:
- - cd Cabal
- - mkdir -p ./dist/setup
- - cp Setup.hs ./dist/setup/setup.hs
-# Should be able to build setup without extra dependencies
- - /opt/ghc/$GHCVER/bin/ghc --make -odir ./dist/setup -hidir ./dist/setup -i -i. ./dist/setup/setup.hs -o ./dist/setup/setup -Wall -Werror -threaded # the command cabal-install would use to build setup
-
-# Need extra dependencies for test suite
- - cabal install --only-dependencies --enable-tests
- - sudo /opt/ghc/$GHCVER/bin/ghc-pkg recache
- - /opt/ghc/$GHCVER/bin/ghc-pkg recache --user
-
- - ./dist/setup/setup configure --user --enable-tests --enable-benchmarks --ghc-option=-Werror -v2 # -v2 provides useful information for debugging
- - ./dist/setup/setup build # this builds all libraries and executables (including tests/benchmarks)
- - ./dist/setup/setup haddock # see #2198
- - ./dist/setup/setup test --show-details=streaming
- - cabal check
- - cabal sdist # tests that a source-distribution can be generated
-
-# The following scriptlet checks that the resulting source distribution can be built & installed
- - function install_from_tarball {
- export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
- if [ -f "dist/$SRC_TGZ" ]; then
- cabal install "dist/$SRC_TGZ" -v2;
- else
- echo "expected 'dist/$SRC_TGZ' not found";
- exit 1;
- fi
- }
- - install_from_tarball
-
-# Also build cabal-install.
- - cd ../cabal-install
- - cabal sandbox init
- - cabal sandbox add-source ../Cabal
- - cabal install --dependencies-only --enable-tests
- - cabal configure --enable-tests --ghc-option=-Werror
- - cabal build
- - cabal test
- - cabal check
- - cabal sdist
- - install_from_tarball
+ - ./travis-script.sh
matrix:
allow_failures:
diff --git a/cabal/Cabal/Cabal.cabal b/cabal/Cabal/Cabal.cabal
index d94e964..47dd82d 100644
--- a/cabal/Cabal/Cabal.cabal
+++ b/cabal/Cabal/Cabal.cabal
@@ -1,5 +1,5 @@
name: Cabal
-version: 1.23.0.0
+version: 1.25.0.0
copyright: 2003-2006, Isaac Jones
2005-2011, Duncan Coutts
license: BSD3
@@ -19,9 +19,9 @@ description:
organizing, and cataloging Haskell libraries and tools.
category: Distribution
cabal-version: >=1.10
-build-type: Custom
--- Even though we do use the default Setup.lhs it's vital to bootstrapping
--- that we build Setup.lhs using our own local Cabal source code.
+build-type: Simple
+-- If we use a new Cabal feature, this needs to be changed to Custom so
+-- we can bootstrap.
extra-source-files:
README.md tests/README.md changelog
@@ -29,7 +29,13 @@ extra-source-files:
doc/installing-packages.markdown
doc/misc.markdown
- -- Generated with 'misc/gen-extra-source-files.sh' & 'M-x sort-lines':
+ -- Generated with 'misc/gen-extra-source-files.sh'
+ -- Do NOT edit this section manually; instead, run the script.
+ -- BEGIN gen-extra-source-files
+ tests/PackageTests/AllowNewer/AllowNewer.cabal
+ tests/PackageTests/AllowNewer/benchmarks/Bench.hs
+ tests/PackageTests/AllowNewer/src/Foo.hs
+ tests/PackageTests/AllowNewer/tests/Test.hs
tests/PackageTests/BenchmarkExeV10/Foo.hs
tests/PackageTests/BenchmarkExeV10/benchmarks/bench-Foo.hs
tests/PackageTests/BenchmarkExeV10/my.cabal
@@ -74,18 +80,78 @@ extra-source-files:
tests/PackageTests/BuildDeps/TargetSpecificDeps3/MyLibrary.hs
tests/PackageTests/BuildDeps/TargetSpecificDeps3/lemon.hs
tests/PackageTests/BuildDeps/TargetSpecificDeps3/my.cabal
+ tests/PackageTests/BuildTestSuiteDetailedV09/Dummy2.hs
+ tests/PackageTests/BuildableField/BuildableField.cabal
+ tests/PackageTests/BuildableField/Main.hs
tests/PackageTests/CMain/Bar.hs
- tests/PackageTests/CMain/Setup.hs
tests/PackageTests/CMain/foo.c
tests/PackageTests/CMain/my.cabal
+ tests/PackageTests/Configure/A.hs
+ tests/PackageTests/Configure/Setup.hs
+ tests/PackageTests/Configure/X11.cabal
+ tests/PackageTests/CopyComponent/Exe/Main.hs
+ tests/PackageTests/CopyComponent/Exe/Main2.hs
+ tests/PackageTests/CopyComponent/Exe/myprog.cabal
+ tests/PackageTests/CopyComponent/Lib/Main.hs
+ tests/PackageTests/CopyComponent/Lib/p.cabal
+ tests/PackageTests/CopyComponent/Lib/src/P.hs
+ tests/PackageTests/CustomPreProcess/Hello.hs
+ tests/PackageTests/CustomPreProcess/MyCustomPreprocessor.hs
+ tests/PackageTests/CustomPreProcess/Setup.hs
+ tests/PackageTests/CustomPreProcess/internal-preprocessor-test.cabal
tests/PackageTests/DeterministicAr/Lib.hs
tests/PackageTests/DeterministicAr/my.cabal
+ tests/PackageTests/DuplicateModuleName/DuplicateModuleName.cabal
+ tests/PackageTests/DuplicateModuleName/src/Foo.hs
+ tests/PackageTests/DuplicateModuleName/tests/Foo.hs
+ tests/PackageTests/DuplicateModuleName/tests2/Foo.hs
tests/PackageTests/EmptyLib/empty/empty.cabal
+ tests/PackageTests/GhcPkgGuess/SameDirectory/SameDirectory.cabal
+ tests/PackageTests/GhcPkgGuess/SameDirectory/ghc
+ tests/PackageTests/GhcPkgGuess/SameDirectory/ghc-pkg
+ tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/SameDirectory.cabal
+ tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/ghc-7.10
+ tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/ghc-pkg-ghc-7.10
+ tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/SameDirectory.cabal
+ tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/ghc-7.10
+ tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/ghc-pkg-7.10
+ tests/PackageTests/GhcPkgGuess/Symlink/SameDirectory.cabal
+ tests/PackageTests/GhcPkgGuess/Symlink/bin/ghc
+ tests/PackageTests/GhcPkgGuess/Symlink/bin/ghc-pkg
+ tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/SameDirectory.cabal
+ tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/bin/ghc-7.10
+ tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/bin/ghc-pkg-7.10
+ tests/PackageTests/GhcPkgGuess/SymlinkVersion/SameDirectory.cabal
+ tests/PackageTests/GhcPkgGuess/SymlinkVersion/bin/ghc-7.10
+ tests/PackageTests/GhcPkgGuess/SymlinkVersion/bin/ghc-pkg-ghc-7.10
tests/PackageTests/Haddock/CPP.hs
tests/PackageTests/Haddock/Literate.lhs
tests/PackageTests/Haddock/NoCPP.hs
tests/PackageTests/Haddock/Simple.hs
tests/PackageTests/Haddock/my.cabal
+ tests/PackageTests/HaddockNewline/A.hs
+ tests/PackageTests/HaddockNewline/HaddockNewline.cabal
+ tests/PackageTests/HaddockNewline/Setup.hs
+ tests/PackageTests/InternalLibraries/Executable/exe/Main.hs
+ tests/PackageTests/InternalLibraries/Executable/foo.cabal
+ tests/PackageTests/InternalLibraries/Executable/src/Foo.hs
+ tests/PackageTests/InternalLibraries/Library/fooexe/Main.hs
+ tests/PackageTests/InternalLibraries/Library/fooexe/fooexe.cabal
+ tests/PackageTests/InternalLibraries/Library/foolib/Foo.hs
+ tests/PackageTests/InternalLibraries/Library/foolib/foolib.cabal
+ tests/PackageTests/InternalLibraries/Library/foolib/private/Internal.hs
+ tests/PackageTests/InternalLibraries/p/Foo.hs
+ tests/PackageTests/InternalLibraries/p/p.cabal
+ tests/PackageTests/InternalLibraries/p/p/P.hs
+ tests/PackageTests/InternalLibraries/p/q/Q.hs
+ tests/PackageTests/InternalLibraries/q/Q.hs
+ tests/PackageTests/InternalLibraries/q/q.cabal
+ tests/PackageTests/Macros/A.hs
+ tests/PackageTests/Macros/B.hs
+ tests/PackageTests/Macros/Main.hs
+ tests/PackageTests/Macros/macros.cabal
+ tests/PackageTests/Macros/src/C.hs
+ tests/PackageTests/Options.hs
tests/PackageTests/OrderFlags/Foo.hs
tests/PackageTests/OrderFlags/my.cabal
tests/PackageTests/PathsModule/Executable/Main.hs
@@ -94,6 +160,9 @@ extra-source-files:
tests/PackageTests/PreProcess/Foo.hsc
tests/PackageTests/PreProcess/Main.hs
tests/PackageTests/PreProcess/my.cabal
+ tests/PackageTests/PreProcessExtraSources/Foo.hsc
+ tests/PackageTests/PreProcessExtraSources/Main.hs
+ tests/PackageTests/PreProcessExtraSources/my.cabal
tests/PackageTests/ReexportedModules/ReexportedModules.cabal
tests/PackageTests/TemplateHaskell/dynamic/Exe.hs
tests/PackageTests/TemplateHaskell/dynamic/Lib.hs
@@ -107,20 +176,33 @@ extra-source-files:
tests/PackageTests/TemplateHaskell/vanilla/Lib.hs
tests/PackageTests/TemplateHaskell/vanilla/TH.hs
tests/PackageTests/TemplateHaskell/vanilla/my.cabal
+ tests/PackageTests/TestNameCollision/child/Child.hs
+ tests/PackageTests/TestNameCollision/child/child.cabal
+ tests/PackageTests/TestNameCollision/child/tests/Test.hs
+ tests/PackageTests/TestNameCollision/parent/Parent.hs
+ tests/PackageTests/TestNameCollision/parent/parent.cabal
tests/PackageTests/TestOptions/TestOptions.cabal
tests/PackageTests/TestOptions/test-TestOptions.hs
tests/PackageTests/TestStanza/my.cabal
tests/PackageTests/TestSuiteTests/ExeV10/Foo.hs
tests/PackageTests/TestSuiteTests/ExeV10/my.cabal
tests/PackageTests/TestSuiteTests/ExeV10/tests/test-Foo.hs
- tests/PackageTests/TestSuiteTests/LibV09/LibV09.cabal
+ tests/PackageTests/TestSuiteTests/ExeV10/tests/test-Short.hs
tests/PackageTests/TestSuiteTests/LibV09/Lib.hs
+ tests/PackageTests/TestSuiteTests/LibV09/LibV09.cabal
tests/PackageTests/TestSuiteTests/LibV09/tests/Deadlock.hs
+ tests/PackageTests/Tests.hs
+ tests/PackageTests/UniqueIPID/P1/M.hs
+ tests/PackageTests/UniqueIPID/P1/my.cabal
+ tests/PackageTests/UniqueIPID/P2/M.hs
+ tests/PackageTests/UniqueIPID/P2/my.cabal
+ tests/PackageTests/multInst/my.cabal
tests/Setup.hs
tests/hackage/check.sh
tests/hackage/download.sh
tests/hackage/unpack.sh
tests/misc/ghc-supported-languages.hs
+ -- END gen-extra-source-files
source-repository head
type: git
@@ -132,21 +214,21 @@ flag bundled-binary-generic
library
build-depends:
- base >= 4.4 && < 5,
- deepseq >= 1.3 && < 1.5,
- filepath >= 1 && < 1.5,
- directory >= 1 && < 1.3,
- process >= 1.1.0.1 && < 1.4,
- time >= 1.1 && < 1.6,
- containers >= 0.1 && < 0.6,
array >= 0.1 && < 0.6,
- pretty >= 1 && < 1.2,
- bytestring >= 0.9
+ base >= 4.5 && < 5,
+ bytestring >= 0.9 && < 1,
+ containers >= 0.4 && < 0.6,
+ deepseq >= 1.3 && < 1.5,
+ directory >= 1.1 && < 1.3,
+ filepath >= 1.3 && < 1.5,
+ pretty >= 1.1 && < 1.2,
+ process >= 1.1.0.1 && < 1.5,
+ time >= 1.4 && < 1.7
if flag(bundled-binary-generic)
build-depends: binary >= 0.5 && < 0.7
else
- build-depends: binary >= 0.7 && < 0.8
+ build-depends: binary >= 0.7 && < 0.9
-- Needed for GHC.Generics before GHC 7.6
if impl(ghc < 7.6)
@@ -154,15 +236,24 @@ library
if !os(windows)
build-depends:
- unix >= 2.0 && < 2.8
+ unix >= 2.5 && < 2.8
+
+ if os(windows)
+ build-depends:
+ Win32 >= 2.2 && < 2.4
ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs
+ if impl(ghc >= 8.0)
+ ghc-options: -Wcompat -Wnoncanonical-monad-instances
+ -Wnoncanonical-monadfail-instances
exposed-modules:
Distribution.Compat.CreatePipe
Distribution.Compat.Environment
Distribution.Compat.Exception
+ Distribution.Compat.Internal.TempFile
Distribution.Compat.ReadP
+ Distribution.Compat.Semigroup
Distribution.Compiler
Distribution.InstalledPackageInfo
Distribution.License
@@ -232,16 +323,16 @@ library
Distribution.Verbosity
Distribution.Version
Language.Haskell.Extension
+ Distribution.Compat.Binary
other-modules:
- Distribution.Compat.Binary
Distribution.Compat.CopyFile
- Distribution.Compat.TempFile
+ Distribution.Compat.MonadFail
Distribution.GetOpt
Distribution.Lex
Distribution.Simple.GHC.Internal
- Distribution.Simple.GHC.IPI641
Distribution.Simple.GHC.IPI642
+ Distribution.Simple.GHC.IPIConvert
Distribution.Simple.GHC.ImplInfo
Paths_Cabal
@@ -251,25 +342,33 @@ library
Distribution.Compat.Binary.Generic
default-language: Haskell98
- default-extensions: CPP
+ -- starting with GHC 7.0, rely on {-# LANGUAGE CPP #-} instead
+ if !impl(ghc >= 7.0)
+ default-extensions: CPP
-- Small, fast running tests.
test-suite unit-tests
type: exitcode-stdio-1.0
hs-source-dirs: tests
other-modules:
+ Test.Laws
+ Test.QuickCheck.Utils
UnitTests.Distribution.Compat.CreatePipe
UnitTests.Distribution.Compat.ReadP
UnitTests.Distribution.Simple.Program.Internal
+ UnitTests.Distribution.Simple.Utils
+ UnitTests.Distribution.System
UnitTests.Distribution.Utils.NubList
+ UnitTests.Distribution.Version
main-is: UnitTests.hs
build-depends:
base,
+ directory,
tasty,
tasty-hunit,
tasty-quickcheck,
pretty,
- QuickCheck < 2.9,
+ QuickCheck >= 2.7 && < 2.9,
Cabal
ghc-options: -Wall
default-language: Haskell98
@@ -279,57 +378,28 @@ test-suite package-tests
type: exitcode-stdio-1.0
main-is: PackageTests.hs
other-modules:
- PackageTests.BenchmarkExeV10.Check
- PackageTests.BenchmarkOptions.Check
PackageTests.BenchmarkStanza.Check
- PackageTests.BuildDeps.GlobalBuildDepsNotAdditive1.Check
- PackageTests.BuildDeps.GlobalBuildDepsNotAdditive2.Check
- PackageTests.BuildDeps.InternalLibrary0.Check
- PackageTests.BuildDeps.InternalLibrary1.Check
- PackageTests.BuildDeps.InternalLibrary2.Check
- PackageTests.BuildDeps.InternalLibrary3.Check
- PackageTests.BuildDeps.InternalLibrary4.Check
- PackageTests.BuildDeps.SameDepsAllRound.Check
- PackageTests.BuildDeps.TargetSpecificDeps1.Check
- PackageTests.BuildDeps.TargetSpecificDeps2.Check
- PackageTests.BuildDeps.TargetSpecificDeps3.Check
- PackageTests.CMain.Check
- PackageTests.DeterministicAr.Check
- PackageTests.EmptyLib.Check
- PackageTests.Haddock.Check
- PackageTests.OrderFlags.Check
- PackageTests.PackageTester
- PackageTests.PathsModule.Executable.Check
- PackageTests.PathsModule.Library.Check
- PackageTests.PreProcess.Check
- PackageTests.PreProcessExtraSources.Check
- PackageTests.ReexportedModules.Check
- PackageTests.TemplateHaskell.Check
- PackageTests.TestOptions.Check
PackageTests.TestStanza.Check
+ PackageTests.DeterministicAr.Check
PackageTests.TestSuiteTests.ExeV10.Check
- PackageTests.TestSuiteTests.LibV09.Check
- Test.Distribution.Version
- Test.Laws
- Test.QuickCheck.Utils
+ PackageTests.PackageTester
hs-source-dirs: tests
build-depends:
base,
containers,
+ tagged,
tasty,
- tasty-quickcheck,
tasty-hunit,
- QuickCheck >= 2.1.0.1 && < 2.9,
+ transformers,
Cabal,
process,
directory,
filepath,
- extensible-exceptions,
bytestring,
regex-posix,
old-time
if !os(windows)
build-depends: unix
- ghc-options: -Wall
+ ghc-options: -Wall -rtsopts
default-extensions: CPP
default-language: Haskell98
diff --git a/cabal/Cabal/Distribution/Compat/Binary/Class.hs b/cabal/Cabal/Distribution/Compat/Binary/Class.hs
index 9c4ef55..117c1d3 100644
--- a/cabal/Cabal/Distribution/Compat/Binary/Class.hs
+++ b/cabal/Cabal/Distribution/Compat/Binary/Class.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DefaultSignatures #-}
-----------------------------------------------------------------------------
@@ -53,13 +53,8 @@ import Data.Array.Unboxed
import GHC.Generics
---
--- This isn't available in older Hugs or older GHC
---
-#if __GLASGOW_HASKELL__ >= 606
import qualified Data.Sequence as Seq
import qualified Data.Foldable as Fold
-#endif
------------------------------------------------------------------------
@@ -467,11 +462,6 @@ instance (Binary e) => Binary (IntMap.IntMap e) where
------------------------------------------------------------------------
-- Queues and Sequences
-#if __GLASGOW_HASKELL__ >= 606
---
--- This is valid Hugs, but you need the most recent Hugs
---
-
instance (Binary e) => Binary (Seq.Seq e) where
put s = put (Seq.length s) >> Fold.mapM_ put s
get = do n <- get :: Get Int
@@ -481,8 +471,6 @@ instance (Binary e) => Binary (Seq.Seq e) where
x <- g
rep (xs Seq.|> x) (n-1) g
-#endif
-
------------------------------------------------------------------------
-- Floating point
diff --git a/cabal/Cabal/Distribution/Compat/CopyFile.hs b/cabal/Cabal/Distribution/Compat/CopyFile.hs
index f8a183b..486a209 100644
--- a/cabal/Cabal/Distribution/Compat/CopyFile.hs
+++ b/cabal/Cabal/Distribution/Compat/CopyFile.hs
@@ -11,24 +11,22 @@ module Distribution.Compat.CopyFile (
setDirOrdinary,
) where
+import Distribution.Compat.Exception
+import Distribution.Compat.Internal.TempFile
import Control.Monad
( when, unless )
import Control.Exception
- ( bracket, bracketOnError, throwIO )
+ ( bracketOnError, throwIO )
import qualified Data.ByteString.Lazy as BSL
-import Distribution.Compat.Exception
- ( catchIO )
import System.IO.Error
( ioeSetLocation )
import System.Directory
( doesFileExist, renameFile, removeFile )
-import Distribution.Compat.TempFile
- ( openBinaryTempFile )
import System.FilePath
( takeDirectory )
import System.IO
- ( openBinaryFile, IOMode(ReadMode), hClose, hGetBuf, hPutBuf
+ ( IOMode(ReadMode), hClose, hGetBuf, hPutBuf
, withBinaryFile )
import Foreign
( allocaBytes )
@@ -69,7 +67,7 @@ copyFile :: FilePath -> FilePath -> IO ()
copyFile fromFPath toFPath =
copy
`catchIO` (\ioe -> throwIO (ioeSetLocation ioe "copyFile"))
- where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
+ where copy = withBinaryFile fromFPath ReadMode $ \hFrom ->
bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
do allocaBytes bufferSize $ copyContents hFrom hTmp
hClose hTmp
@@ -100,8 +98,7 @@ filesEqual :: FilePath -> FilePath -> IO Bool
filesEqual f1 f2 = do
ex1 <- doesFileExist f1
ex2 <- doesFileExist f2
- if not (ex1 && ex2) then return False else do
-
+ if not (ex1 && ex2) then return False else
withBinaryFile f1 ReadMode $ \h1 ->
withBinaryFile f2 ReadMode $ \h2 -> do
c1 <- BSL.hGetContents h1
diff --git a/cabal/Cabal/Distribution/Compat/TempFile.hs b/cabal/Cabal/Distribution/Compat/Internal/TempFile.hs
index 5892340..edb2b88 100644
--- a/cabal/Cabal/Distribution/Compat/TempFile.hs
+++ b/cabal/Cabal/Distribution/Compat/Internal/TempFile.hs
@@ -1,29 +1,25 @@
{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
-module Distribution.Compat.TempFile (
+module Distribution.Compat.Internal.TempFile (
openTempFile,
openBinaryTempFile,
openNewBinaryFile,
createTempDirectory,
) where
+import Distribution.Compat.Exception
import System.FilePath ((</>))
-import Foreign.C (eEXIST)
+import Foreign.C (CInt, eEXIST, getErrno, errnoToIOError)
import System.IO (Handle, openTempFile, openBinaryTempFile)
import Data.Bits ((.|.))
import System.Posix.Internals (c_open, c_close, o_CREAT, o_EXCL, o_RDWR,
- o_BINARY, o_NONBLOCK, o_NOCTTY)
+ o_BINARY, o_NONBLOCK, o_NOCTTY,
+ withFilePath, c_getpid)
import System.IO.Error (isAlreadyExistsError)
-import System.Posix.Internals (withFilePath)
-import Foreign.C (CInt)
import GHC.IO.Handle.FD (fdToHandle)
-import Distribution.Compat.Exception (tryIO)
import Control.Exception (onException)
-import Foreign.C (getErrno, errnoToIOError)
-
-import System.Posix.Internals (c_getpid)
#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS)
import System.Directory ( createDirectory )
diff --git a/cabal/Cabal/Distribution/Compat/MonadFail.hs b/cabal/Cabal/Distribution/Compat/MonadFail.hs
new file mode 100644
index 0000000..a17e0d4
--- /dev/null
+++ b/cabal/Cabal/Distribution/Compat/MonadFail.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE CPP #-}
+
+-- | Compatibility layer for "Control.Monad.Fail"
+module Distribution.Compat.MonadFail ( MonadFail(fail) ) where
+#if __GLASGOW_HASKELL__ >= 800
+-- provided by base-4.9.0.0 and later
+import Control.Monad.Fail (MonadFail(fail))
+#else
+-- the following code corresponds to
+-- http://hackage.haskell.org/package/fail-4.9.0.0
+import qualified Prelude as P
+import Prelude hiding (fail)
+
+import Text.ParserCombinators.ReadP
+import Text.ParserCombinators.ReadPrec
+
+class Monad m => MonadFail m where
+ fail :: String -> m a
+
+-- instances provided by base-4.9
+
+instance MonadFail Maybe where
+ fail _ = Nothing
+
+instance MonadFail [] where
+ fail _ = []
+
+instance MonadFail IO where
+ fail = P.fail
+
+instance MonadFail ReadPrec where
+ fail = P.fail -- = P (\_ -> fail s)
+
+instance MonadFail ReadP where
+ fail = P.fail
+#endif
diff --git a/cabal/Cabal/Distribution/Compat/ReadP.hs b/cabal/Cabal/Distribution/Compat/ReadP.hs
index 3a50838..b4a3a09 100644
--- a/cabal/Cabal/Distribution/Compat/ReadP.hs
+++ b/cabal/Cabal/Distribution/Compat/ReadP.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Compat.ReadP
@@ -70,12 +69,11 @@ module Distribution.Compat.ReadP
)
where
-import Control.Monad( MonadPlus(..), liftM, liftM2, ap )
+import qualified Distribution.Compat.MonadFail as Fail
+
+import Control.Monad( MonadPlus(..), liftM, liftM2, replicateM, ap, (>=>) )
import Data.Char (isSpace)
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative (Applicative(..))
-#endif
-import Control.Applicative (Alternative(empty, (<|>)))
+import Control.Applicative as AP (Applicative(..), Alternative(empty, (<|>)))
infixr 5 +++, <++
@@ -96,18 +94,21 @@ instance Functor (P s) where
fmap = liftM
instance Applicative (P s) where
- pure = return
+ pure x = Result x Fail
(<*>) = ap
instance Monad (P s) where
- return x = Result x Fail
+ return = AP.pure
- (Get f) >>= k = Get (\c -> f c >>= k)
- (Look f) >>= k = Look (\s -> f s >>= k)
+ (Get f) >>= k = Get (f >=> k)
+ (Look f) >>= k = Look (f >=> k)
Fail >>= _ = Fail
(Result x p) >>= k = k x `mplus` (p >>= k)
(Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
+ fail = Fail.fail
+
+instance Fail.MonadFail (P s) where
fail _ = Fail
instance Alternative (P s) where
@@ -155,14 +156,17 @@ instance Functor (Parser r s) where
fmap h (R f) = R (\k -> f (k . h))
instance Applicative (Parser r s) where
- pure = return
+ pure x = R (\k -> k x)
(<*>) = ap
instance Monad (Parser r s) where
- return x = R (\k -> k x)
- fail _ = R (\_ -> Fail)
+ return = AP.pure
+ fail = Fail.fail
R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
+instance Fail.MonadFail (Parser r s) where
+ fail _ = R (const Fail)
+
--instance MonadPlus (Parser r s) where
-- mzero = pfail
-- mplus = (+++)
@@ -197,7 +201,7 @@ look = R Look
pfail :: ReadP r a
-- ^ Always fails.
-pfail = R (\_ -> Fail)
+pfail = R (const Fail)
(+++) :: ReadP r a -> ReadP r a -> ReadP r a
-- ^ Symmetric choice.
@@ -230,7 +234,7 @@ gather (R m) =
where
gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
gath _ Fail = Fail
- gath l (Look f) = Look (\s -> gath l (f s))
+ gath l (Look f) = Look (gath l . f)
gath l (Result k p) = k (l []) `mplus` gath l p
gath _ (Final _) = error "do not use readS_to_P in gather!"
@@ -250,9 +254,9 @@ string :: String -> ReadP r String
-- ^ Parses and returns the specified string.
string this = do s <- look; scan this s
where
- scan [] _ = do return this
- scan (x:xs) (y:ys) | x == y = do get >> scan xs ys
- scan _ _ = do pfail
+ scan [] _ = return this
+ scan (x:xs) (y:ys) | x == y = get >> scan xs ys
+ scan _ _ = pfail
munch :: (Char -> Bool) -> ReadP r String
-- ^ Parses the first zero or more characters satisfying the predicate.
@@ -288,7 +292,7 @@ skipSpaces =
count :: Int -> ReadP r a -> ReadP r [a]
-- ^ @ count n p @ parses @n@ occurrences of @p@ in sequence. A list of
-- results is returned.
-count n p = sequence (replicate n p)
+count n p = replicateM n p
between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r a
-- ^ @ between open close p @ parses @open@, followed by @p@ and finally
diff --git a/cabal/Cabal/Distribution/Compat/Semigroup.hs b/cabal/Cabal/Distribution/Compat/Semigroup.hs
new file mode 100644
index 0000000..d50a93c
--- /dev/null
+++ b/cabal/Cabal/Distribution/Compat/Semigroup.hs
@@ -0,0 +1,171 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeOperators #-}
+
+-- | Compatibility layer for "Data.Semigroup"
+module Distribution.Compat.Semigroup
+ ( Semigroup((<>))
+ , Mon.Monoid(..)
+ , All(..)
+ , Any(..)
+
+ , Last'(..)
+
+ , gmappend
+ , gmempty
+ ) where
+
+import Distribution.Compat.Binary (Binary)
+
+import Control.Applicative as App
+import GHC.Generics
+#if __GLASGOW_HASKELL__ >= 711
+-- Data.Semigroup is available since GHC 8.0/base-4.9
+import Data.Semigroup
+import qualified Data.Monoid as Mon
+#else
+-- provide internal simplified non-exposed class for older GHCs
+import Data.Monoid as Mon (Monoid(..), All(..), Any(..), Dual(..))
+-- containers
+import Data.Set (Set)
+import Data.IntSet (IntSet)
+import Data.Map (Map)
+import Data.IntMap (IntMap)
+
+
+class Semigroup a where
+ (<>) :: a -> a -> a
+
+-- several primitive instances
+instance Semigroup () where
+ _ <> _ = ()
+
+instance Semigroup [a] where
+ (<>) = (++)
+
+instance Semigroup a => Semigroup (Dual a) where
+ Dual a <> Dual b = Dual (b <> a)
+
+instance Semigroup a => Semigroup (Maybe a) where
+ Nothing <> b = b
+ a <> Nothing = a
+ Just a <> Just b = Just (a <> b)
+
+instance Semigroup (Either a b) where
+ Left _ <> b = b
+ a <> _ = a
+
+instance Semigroup Ordering where
+ LT <> _ = LT
+ EQ <> y = y
+ GT <> _ = GT
+
+instance Semigroup b => Semigroup (a -> b) where
+ f <> g = \a -> f a <> g a
+
+instance Semigroup All where
+ All a <> All b = All (a && b)
+
+instance Semigroup Any where
+ Any a <> Any b = Any (a || b)
+
+instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
+ (a,b) <> (a',b') = (a<>a',b<>b')
+
+instance (Semigroup a, Semigroup b, Semigroup c)
+ => Semigroup (a, b, c) where
+ (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')
+
+instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)
+ => Semigroup (a, b, c, d) where
+ (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')
+
+instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)
+ => Semigroup (a, b, c, d, e) where
+ (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')
+
+-- containers instances
+instance Semigroup IntSet where
+ (<>) = mappend
+
+instance Ord a => Semigroup (Set a) where
+ (<>) = mappend
+
+instance Semigroup (IntMap v) where
+ (<>) = mappend
+
+instance Ord k => Semigroup (Map k v) where
+ (<>) = mappend
+#endif
+
+-- | Cabal's own 'Data.Monoid.Last' copy to avoid requiring an orphan
+-- 'Binary' instance.
+--
+-- Once the oldest `binary` version we support provides a 'Binary'
+-- instance for 'Data.Monoid.Last' we can remove this one here.
+--
+-- NB: 'Data.Semigroup.Last' is defined differently and not a 'Monoid'
+newtype Last' a = Last' { getLast' :: Maybe a }
+ deriving (Eq, Ord, Read, Show, Binary,
+ Functor, App.Applicative, Generic)
+
+instance Semigroup (Last' a) where
+ x <> Last' Nothing = x
+ _ <> x = x
+
+instance Monoid (Last' a) where
+ mempty = Last' Nothing
+ mappend = (<>)
+
+-------------------------------------------------------------------------------
+-------------------------------------------------------------------------------
+-- Stolen from Edward Kmett's BSD3-licensed `semigroups` package
+
+-- | Generically generate a 'Semigroup' ('<>') operation for any type
+-- implementing 'Generic'. This operation will append two values
+-- by point-wise appending their component fields. It is only defined
+-- for product types.
+--
+-- @
+-- 'gmappend' a ('gmappend' b c) = 'gmappend' ('gmappend' a b) c
+-- @
+gmappend :: (Generic a, GSemigroup (Rep a)) => a -> a -> a
+gmappend x y = to (gmappend' (from x) (from y))
+
+class GSemigroup f where
+ gmappend' :: f p -> f p -> f p
+
+instance Semigroup a => GSemigroup (K1 i a) where
+ gmappend' (K1 x) (K1 y) = K1 (x <> y)
+
+instance GSemigroup f => GSemigroup (M1 i c f) where
+ gmappend' (M1 x) (M1 y) = M1 (gmappend' x y)
+
+instance (GSemigroup f, GSemigroup g) => GSemigroup (f :*: g) where
+ gmappend' (x1 :*: x2) (y1 :*: y2) = gmappend' x1 y1 :*: gmappend' x2 y2
+
+-- | Generically generate a 'Monoid' 'mempty' for any product-like type
+-- implementing 'Generic'.
+--
+-- It is only defined for product types.
+--
+-- @
+-- 'gmappend' 'gmempty' a = a = 'gmappend' a 'gmempty'
+-- @
+
+gmempty :: (Generic a, GMonoid (Rep a)) => a
+gmempty = to gmempty'
+
+class GSemigroup f => GMonoid f where
+ gmempty' :: f p
+
+instance (Semigroup a, Monoid a) => GMonoid (K1 i a) where
+ gmempty' = K1 mempty
+
+instance GMonoid f => GMonoid (M1 i c f) where
+ gmempty' = M1 gmempty'
+
+instance (GMonoid f, GMonoid g) => GMonoid (f :*: g) where
+ gmempty' = gmempty' :*: gmempty'
diff --git a/cabal/Cabal/Distribution/Compiler.hs b/cabal/Cabal/Distribution/Compiler.hs
index dc99b2f..4e84d79 100644
--- a/cabal/Cabal/Distribution/Compiler.hs
+++ b/cabal/Cabal/Distribution/Compiler.hs
@@ -42,15 +42,15 @@ module Distribution.Compiler (
AbiTag(..), abiTagString
) where
-import Distribution.Compat.Binary (Binary)
+import Distribution.Compat.Binary
+import Language.Haskell.Extension
+
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Maybe (fromMaybe)
import Distribution.Version (Version(..))
import GHC.Generics (Generic)
-import Language.Haskell.Extension (Language, Extension)
-
import qualified System.Info (compilerName, compilerVersion)
import Distribution.Text (Text(..), display)
import qualified Distribution.Compat.ReadP as Parse
@@ -180,7 +180,7 @@ instance Binary CompilerInfo
data AbiTag
= NoAbiTag
| AbiTag String
- deriving (Generic, Show, Read)
+ deriving (Eq, Generic, Show, Read)
instance Binary AbiTag
diff --git a/cabal/Cabal/Distribution/InstalledPackageInfo.hs b/cabal/Cabal/Distribution/InstalledPackageInfo.hs
index 2ca113f..08e197b 100644
--- a/cabal/Cabal/Distribution/InstalledPackageInfo.hs
+++ b/cabal/Cabal/Distribution/InstalledPackageInfo.hs
@@ -28,8 +28,9 @@
module Distribution.InstalledPackageInfo (
InstalledPackageInfo(..),
- libraryName,
- OriginalModule(..), ExposedModule(..),
+ installedComponentId,
+ installedPackageId,
+ ExposedModule(..),
ParseResult(..), PError(..), PWarning,
emptyInstalledPackageInfo,
parseInstalledPackageInfo,
@@ -40,43 +41,30 @@ module Distribution.InstalledPackageInfo (
) where
import Distribution.ParseUtils
- ( FieldDescr(..), ParseResult(..), PError(..), PWarning
- , simpleField, listField, parseLicenseQ
- , showFields, showSingleNamedField, showSimpleSingleNamedField
- , parseFieldsFlat
- , parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ
- , showFilePath, showToken, boolField, parseOptVersion
- , parseFreeText, showFreeText, parseOptCommaList )
-import Distribution.License ( License(..) )
-import Distribution.Package
- ( PackageName(..), PackageIdentifier(..)
- , PackageId, InstalledPackageId(..)
- , packageName, packageVersion, PackageKey(..)
- , LibraryName(..) )
+import Distribution.License
+import Distribution.Package hiding (installedUnitId, installedPackageId)
import qualified Distribution.Package as Package
import Distribution.ModuleName
- ( ModuleName )
import Distribution.Version
- ( Version(..) )
import Distribution.Text
- ( Text(disp, parse) )
-import Text.PrettyPrint as Disp
import qualified Distribution.Compat.ReadP as Parse
+import Distribution.Compat.Binary
-import Distribution.Compat.Binary (Binary)
+import Text.PrettyPrint as Disp
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
-- -----------------------------------------------------------------------------
-- The InstalledPackageInfo type
-
+-- For BC reasons, we continue to name this record an InstalledPackageInfo;
+-- but it would more accurately be called an InstalledUnitInfo with Backpack
data InstalledPackageInfo
= InstalledPackageInfo {
-- these parts are exactly the same as PackageDescription
- installedPackageId :: InstalledPackageId,
- sourcePackageId :: PackageId,
- packageKey :: PackageKey,
+ sourcePackageId :: PackageId,
+ installedUnitId :: UnitId,
+ compatPackageKey :: String,
license :: License,
copyright :: String,
maintainer :: String,
@@ -88,9 +76,9 @@ data InstalledPackageInfo
description :: String,
category :: String,
-- these parts are required by an installed package only:
+ abiHash :: AbiHash,
exposed :: Bool,
exposedModules :: [ExposedModule],
- instantiatedWith :: [(ModuleName, OriginalModule)],
hiddenModules :: [ModuleName],
trusted :: Bool,
importDirs :: [FilePath],
@@ -101,7 +89,7 @@ data InstalledPackageInfo
extraGHCiLibraries:: [String], -- overrides extraLibraries for GHCi
includeDirs :: [FilePath],
includes :: [String],
- depends :: [InstalledPackageId],
+ depends :: [UnitId],
ccOptions :: [String],
ldOptions :: [String],
frameworkDirs :: [FilePath],
@@ -110,18 +98,24 @@ data InstalledPackageInfo
haddockHTMLs :: [FilePath],
pkgRoot :: Maybe FilePath
}
- deriving (Generic, Read, Show)
+ deriving (Eq, Generic, Read, Show)
-libraryName :: InstalledPackageInfo -> LibraryName
-libraryName ipi = Package.packageKeyLibraryName (sourcePackageId ipi) (packageKey ipi)
+installedComponentId :: InstalledPackageInfo -> ComponentId
+installedComponentId ipi = case installedUnitId ipi of
+ SimpleUnitId cid -> cid
+
+{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}
+-- | Backwards compatibility with Cabal pre-1.24.
+installedPackageId :: InstalledPackageInfo -> UnitId
+installedPackageId = installedUnitId
instance Binary InstalledPackageInfo
instance Package.Package InstalledPackageInfo where
packageId = sourcePackageId
-instance Package.HasInstalledPackageId InstalledPackageInfo where
- installedPackageId = installedPackageId
+instance Package.HasUnitId InstalledPackageInfo where
+ installedUnitId = installedUnitId
instance Package.PackageInstalled InstalledPackageInfo where
installedDepends = depends
@@ -129,10 +123,9 @@ instance Package.PackageInstalled InstalledPackageInfo where
emptyInstalledPackageInfo :: InstalledPackageInfo
emptyInstalledPackageInfo
= InstalledPackageInfo {
- installedPackageId = InstalledPackageId "",
- sourcePackageId = PackageIdentifier (PackageName "") noVersion,
- packageKey = OldPackageKey (PackageIdentifier
- (PackageName "") noVersion),
+ sourcePackageId = PackageIdentifier (PackageName "") (Version [] []),
+ installedUnitId = mkUnitId "",
+ compatPackageKey = "",
license = UnspecifiedLicense,
copyright = "",
maintainer = "",
@@ -143,10 +136,10 @@ emptyInstalledPackageInfo
synopsis = "",
description = "",
category = "",
+ abiHash = AbiHash "",
exposed = False,
exposedModules = [],
hiddenModules = [],
- instantiatedWith = [],
trusted = False,
importDirs = [],
libraryDirs = [],
@@ -166,45 +159,22 @@ emptyInstalledPackageInfo
pkgRoot = Nothing
}
-noVersion :: Version
-noVersion = Version [] []
-
-- -----------------------------------------------------------------------------
-- Exposed modules
-data OriginalModule
- = OriginalModule {
- originalPackageId :: InstalledPackageId,
- originalModuleName :: ModuleName
- }
- deriving (Generic, Eq, Read, Show)
-
data ExposedModule
= ExposedModule {
exposedName :: ModuleName,
- exposedReexport :: Maybe OriginalModule,
- exposedSignature :: Maybe OriginalModule -- This field is unused for now.
+ exposedReexport :: Maybe Module
}
- deriving (Generic, Read, Show)
-
-instance Text OriginalModule where
- disp (OriginalModule ipi m) =
- disp ipi <> Disp.char ':' <> disp m
- parse = do
- ipi <- parse
- _ <- Parse.char ':'
- m <- parse
- return (OriginalModule ipi m)
+ deriving (Eq, Generic, Read, Show)
instance Text ExposedModule where
- disp (ExposedModule m reexport signature) =
+ disp (ExposedModule m reexport) =
Disp.sep [ disp m
, case reexport of
Just m' -> Disp.sep [Disp.text "from", disp m']
Nothing -> Disp.empty
- , case signature of
- Just m' -> Disp.sep [Disp.text "is", disp m']
- Nothing -> Disp.empty
]
parse = do
m <- parseModuleNameQ
@@ -213,15 +183,8 @@ instance Text ExposedModule where
_ <- Parse.string "from"
Parse.skipSpaces
fmap Just parse
- Parse.skipSpaces
- signature <- Parse.option Nothing $ do
- _ <- Parse.string "is"
- Parse.skipSpaces
- fmap Just parse
- return (ExposedModule m reexport signature)
-
+ return (ExposedModule m reexport)
-instance Binary OriginalModule
instance Binary ExposedModule
@@ -234,7 +197,7 @@ showExposedModules :: [ExposedModule] -> Disp.Doc
showExposedModules xs
| all isExposedModule xs = fsep (map disp xs)
| otherwise = fsep (Disp.punctuate comma (map disp xs))
- where isExposedModule (ExposedModule _ Nothing Nothing) = True
+ where isExposedModule (ExposedModule _ Nothing) = True
isExposedModule _ = False
parseExposedModules :: Parse.ReadP r [ExposedModule]
@@ -248,14 +211,6 @@ parseInstalledPackageInfo =
parseFieldsFlat (fieldsInstalledPackageInfo ++ deprecatedFieldDescrs)
emptyInstalledPackageInfo
-parseInstantiatedWith :: Parse.ReadP r (ModuleName, OriginalModule)
-parseInstantiatedWith = do k <- parse
- _ <- Parse.char '='
- n <- parse
- _ <- Parse.char '@'
- p <- parse
- return (k, OriginalModule p n)
-
-- -----------------------------------------------------------------------------
-- Pretty-printing
@@ -268,9 +223,6 @@ showInstalledPackageInfoField = showSingleNamedField fieldsInstalledPackageInfo
showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
showSimpleInstalledPackageInfoField = showSimpleSingleNamedField fieldsInstalledPackageInfo
-showInstantiatedWith :: (ModuleName, OriginalModule) -> Doc
-showInstantiatedWith (k, OriginalModule p m) = disp k <> text "=" <> disp m <> text "@" <> disp p
-
-- -----------------------------------------------------------------------------
-- Description of the fields, for parsing/printing
@@ -287,10 +239,11 @@ basicFieldDescrs =
packageVersion (\ver pkg -> pkg{sourcePackageId=(sourcePackageId pkg){pkgVersion=ver}})
, simpleField "id"
disp parse
- installedPackageId (\ipid pkg -> pkg{installedPackageId=ipid})
+ installedUnitId (\pk pkg -> pkg{installedUnitId=pk})
+ -- NB: parse these as component IDs
, simpleField "key"
- disp parse
- packageKey (\pk pkg -> pkg{packageKey=pk})
+ (disp . ComponentId) (fmap (\(ComponentId s) -> s) parse)
+ compatPackageKey (\pk pkg -> pkg{compatPackageKey=pk})
, simpleField "license"
disp parseLicenseQ
license (\l pkg -> pkg{license=l})
@@ -333,9 +286,9 @@ installedFieldDescrs = [
, listField "hidden-modules"
disp parseModuleNameQ
hiddenModules (\xs pkg -> pkg{hiddenModules=xs})
- , listField "instantiated-with"
- showInstantiatedWith parseInstantiatedWith
- instantiatedWith (\xs pkg -> pkg{instantiatedWith=xs})
+ , simpleField "abi"
+ disp parse
+ abiHash (\abi pkg -> pkg{abiHash=abi})
, boolField "trusted"
trusted (\val pkg -> pkg{trusted=val})
, listField "import-dirs"
diff --git a/cabal/Cabal/Distribution/Lex.hs b/cabal/Cabal/Distribution/Lex.hs
index 2da9de8..bfecf47 100644
--- a/cabal/Cabal/Distribution/Lex.hs
+++ b/cabal/Cabal/Distribution/Lex.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
@@ -15,9 +14,7 @@ module Distribution.Lex (
) where
import Data.Char (isSpace)
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid
-#endif
+import Distribution.Compat.Semigroup as Semi
newtype DList a = DList ([a] -> [a])
@@ -29,7 +26,10 @@ singleton a = DList (a:)
instance Monoid (DList a) where
mempty = DList id
- DList a `mappend` DList b = DList (a . b)
+ mappend = (Semi.<>)
+
+instance Semigroup (DList a) where
+ DList a <> DList b = DList (a . b)
tokenizeQuotedWords :: String -> [String]
tokenizeQuotedWords = filter (not . null) . go False mempty
diff --git a/cabal/Cabal/Distribution/License.hs b/cabal/Cabal/Distribution/License.hs
index 1d06e4a..dc3515c 100644
--- a/cabal/Cabal/Distribution/License.hs
+++ b/cabal/Cabal/Distribution/License.hs
@@ -47,13 +47,13 @@ module Distribution.License (
knownLicenses,
) where
-import Distribution.Version (Version(Version))
-
-import Distribution.Text (Text(..), display)
+import Distribution.Version
+import Distribution.Text
import qualified Distribution.Compat.ReadP as Parse
+import Distribution.Compat.Binary
+
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>))
-import Distribution.Compat.Binary (Binary)
import qualified Data.Char as Char (isAlphaNum)
import Data.Data (Data)
import Data.Typeable (Typeable)
diff --git a/cabal/Cabal/Distribution/Make.hs b/cabal/Cabal/Distribution/Make.hs
index 4826e7d..c29a073 100644
--- a/cabal/Cabal/Distribution/Make.hs
+++ b/cabal/Cabal/Distribution/Make.hs
@@ -62,22 +62,19 @@ module Distribution.Make (
-- local
import Distribution.Compat.Exception
-import Distribution.Package --must not specify imports, since we're exporting moule.
-import Distribution.Simple.Program(defaultProgramConfiguration)
+import Distribution.Package
+import Distribution.Simple.Program
import Distribution.PackageDescription
import Distribution.Simple.Setup
import Distribution.Simple.Command
-import Distribution.Simple.Utils (rawSystemExit, cabalVersion)
+import Distribution.Simple.Utils
-import Distribution.License (License(..))
+import Distribution.License
import Distribution.Version
- ( Version(..) )
import Distribution.Text
- ( display )
import System.Environment (getArgs, getProgName)
-import Data.List (intercalate)
import System.Exit
defaultMain :: IO ()
diff --git a/cabal/Cabal/Distribution/ModuleName.hs b/cabal/Cabal/Distribution/ModuleName.hs
index 9d04513..c2e1b62 100644
--- a/cabal/Cabal/Distribution/ModuleName.hs
+++ b/cabal/Cabal/Distribution/ModuleName.hs
@@ -22,14 +22,14 @@ module Distribution.ModuleName (
) where
import Distribution.Text
- ( Text(..) )
+import Distribution.Compat.Binary
+import qualified Distribution.Compat.ReadP as Parse
-import Distribution.Compat.Binary (Binary)
import qualified Data.Char as Char
( isAlphaNum, isUpper )
+import Control.DeepSeq
import Data.Data (Data)
import Data.Typeable (Typeable)
-import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
import Data.List
( intercalate, intersperse )
@@ -44,6 +44,9 @@ newtype ModuleName = ModuleName [String]
instance Binary ModuleName
+instance NFData ModuleName where
+ rnf (ModuleName ms) = rnf ms
+
instance Text ModuleName where
disp (ModuleName ms) =
Disp.hcat (intersperse (Disp.char '.') (map Disp.text ms))
diff --git a/cabal/Cabal/Distribution/Package.hs b/cabal/Cabal/Distribution/Package.hs
index 56682c3..1fec1c8 100644
--- a/cabal/Cabal/Distribution/Package.hs
+++ b/cabal/Cabal/Distribution/Package.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
@@ -21,19 +22,19 @@ module Distribution.Package (
PackageIdentifier(..),
PackageId,
- -- * Installed package identifiers
- InstalledPackageId(..),
+ -- * Package keys/installed package IDs (used for linker symbols)
+ ComponentId(..),
+ UnitId(..),
+ mkUnitId,
+ mkLegacyUnitId,
+ getHSLibraryName,
+ InstalledPackageId, -- backwards compat
- -- * Package keys (used for linker symbols)
- PackageKey(..),
- mkPackageKey,
- packageKeyHash,
- packageKeyLibraryName,
+ -- * Modules
+ Module(..),
- -- * Library name (used for install path, package key)
- LibraryName(..),
- emptyLibraryName,
- getHSLibraryName,
+ -- * ABI hash
+ AbiHash(..),
-- * Package source dependencies
Dependency(..),
@@ -43,7 +44,8 @@ module Distribution.Package (
-- * Package classes
Package(..), packageName, packageVersion,
- HasInstalledPackageId(..),
+ HasUnitId(..),
+ installedPackageId,
PackageInstalled(..),
) where
@@ -51,22 +53,20 @@ import Distribution.Version
( Version(..), VersionRange, anyVersion, thisVersion
, notThisVersion, simplifyVersionRange )
-import Distribution.Text (Text(..), display)
import qualified Distribution.Compat.ReadP as Parse
-import Distribution.Compat.ReadP ((<++))
import qualified Text.PrettyPrint as Disp
+import Distribution.Compat.ReadP
+import Distribution.Compat.Binary
+import Distribution.Text
+import Distribution.ModuleName
import Control.DeepSeq (NFData(..))
-import Distribution.Compat.Binary (Binary)
import qualified Data.Char as Char
- ( isDigit, isAlphaNum, isUpper, isLower, ord, chr )
+ ( isDigit, isAlphaNum, )
import Data.Data ( Data )
-import Data.List ( intercalate, foldl', sort )
+import Data.List ( intercalate )
import Data.Typeable ( Typeable )
-import Data.Word ( Word64 )
-import GHC.Fingerprint ( Fingerprint(..), fingerprintString )
import GHC.Generics (Generic)
-import Numeric ( showIntAtBase )
import Text.PrettyPrint ((<>), (<+>), text)
newtype PackageName = PackageName { unPackageName :: String }
@@ -115,189 +115,71 @@ instance Text PackageIdentifier where
instance NFData PackageIdentifier where
rnf (PackageIdentifier name version) = rnf name `seq` rnf version
--- ------------------------------------------------------------
--- * Installed Package Ids
--- ------------------------------------------------------------
-
--- | An InstalledPackageId uniquely identifies an instance of an installed
--- package. There can be at most one package with a given 'InstalledPackageId'
--- in a package database, or overlay of databases.
---
-newtype InstalledPackageId = InstalledPackageId String
- deriving (Generic, Read,Show,Eq,Ord,Typeable,Data)
-
-instance Binary InstalledPackageId
+-- | A module identity uniquely identifies a Haskell module by
+-- qualifying a 'ModuleName' with the 'UnitId' which defined
+-- it. This type distinguishes between two packages
+-- which provide a module with the same name, or a module
+-- from the same package compiled with different dependencies.
+-- There are a few cases where Cabal needs to know about
+-- module identities, e.g., when writing out reexported modules in
+-- the 'InstalledPackageInfo'.
+data Module =
+ Module { moduleUnitId :: UnitId,
+ moduleName :: ModuleName }
+ deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
-instance Text InstalledPackageId where
- disp (InstalledPackageId str) = text str
+instance Binary Module
- parse = InstalledPackageId `fmap` Parse.munch1 abi_char
- where abi_char c = Char.isAlphaNum c || c `elem` "-_."
+instance Text Module where
+ disp (Module uid mod_name) =
+ disp uid <> Disp.text ":" <> disp mod_name
+ parse = do
+ uid <- parse
+ _ <- Parse.char ':'
+ mod_name <- parse
+ return (Module uid mod_name)
--- ------------------------------------------------------------
--- * Package Keys
--- ------------------------------------------------------------
+instance NFData Module where
+ rnf (Module uid mod_name) = rnf uid `seq` rnf mod_name
--- | A 'PackageKey' is the notion of "package ID" which is visible to the
--- compiler. Why is this not a 'PackageId'? The 'PackageId' is a user-visible
--- concept written explicity in Cabal files; on the other hand, a 'PackageKey'
--- may contain, for example, information about the transitive dependency
--- tree of a package. Why is this not an 'InstalledPackageId'? A 'PackageKey'
--- should be stable so that we can incrementally recompile after a source edit;
--- however, an 'InstalledPackageId' may change even with source.
+-- | A 'ComponentId' uniquely identifies the transitive source
+-- code closure of a component. For non-Backpack components, it also
+-- serves as the basis for install paths, symbols, etc.
--
--- Package keys may be generated either by Cabal or GHC. In particular,
--- ordinary, "old-style" packages which don't use Backpack features can
--- have their package keys generated directly by Cabal and coincide with
--- 'LibraryName's. However, Backpack keys are generated by GHC may exhibit
--- more variation than a 'LibraryName'.
---
-data PackageKey
- -- | Modern package key which is a hash of the PackageId and the transitive
- -- dependency key. It's manually inlined here so we can get the instances
- -- we need. There's an optional prefix for compatibility with GHC 7.10.
- = PackageKey (Maybe String) {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
- -- | Old-style package key which is just a 'PackageId'. Required because
- -- old versions of GHC assume that the 'sourcePackageId' recorded for an
- -- installed package coincides with the package key it was compiled with.
- | OldPackageKey !PackageId
+data ComponentId
+ = ComponentId String
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
-instance Binary PackageKey
-
--- | Convenience function which converts a fingerprint into a new-style package
--- key.
-fingerprintPackageKey :: Fingerprint -> PackageKey
-fingerprintPackageKey (Fingerprint a b) = PackageKey Nothing a b
-
--- | Generates a 'PackageKey' from a 'PackageId', sorted package keys of the
--- immediate dependencies.
-mkPackageKey :: Bool -- are modern style package keys supported?
- -> PackageId
- -> [LibraryName] -- dependencies
- -> PackageKey
-mkPackageKey True pid deps =
- fingerprintPackageKey . fingerprintString $
- display pid ++ "\n" ++
- concat [ display dep ++ "\n" | dep <- sort deps ]
-mkPackageKey False pid _ = OldPackageKey pid
-
--- The base-62 code is based off of 'locators'
--- ((c) Operational Dynamics Consulting, BSD3 licensed)
-
--- Note: Instead of base-62 encoding a single 128-bit integer
--- (ceil(21.49) characters), we'll base-62 a pair of 64-bit integers
--- (2 * ceil(10.75) characters). Luckily for us, it's the same number of
--- characters! In the long term, this should go in GHC.Fingerprint,
--- but not now...
-
--- | Size of a 64-bit word when written as a base-62 string
-word64Base62Len :: Int
-word64Base62Len = 11
-
--- | Converts a 64-bit word into a base-62 string
-toBase62 :: Word64 -> String
-toBase62 w = pad ++ str
- where
- pad = replicate len '0'
- len = word64Base62Len - length str -- 11 == ceil(64 / lg 62)
- str = showIntAtBase 62 represent w ""
- represent :: Int -> Char
- represent x
- | x < 10 = Char.chr (48 + x)
- | x < 36 = Char.chr (65 + x - 10)
- | x < 62 = Char.chr (97 + x - 36)
- | otherwise = error ("represent (base 62): impossible!")
-
--- | Parses a base-62 string into a 64-bit word
-fromBase62 :: String -> Word64
-fromBase62 ss = foldl' multiply 0 ss
- where
- value :: Char -> Int
- value c
- | Char.isDigit c = Char.ord c - 48
- | Char.isUpper c = Char.ord c - 65 + 10
- | Char.isLower c = Char.ord c - 97 + 36
- | otherwise = error ("value (base 62): impossible!")
-
- multiply :: Word64 -> Char -> Word64
- multiply acc c = acc * 62 + (fromIntegral $ value c)
-
--- | Parses a base-62 string into a fingerprint.
-readBase62Fingerprint :: String -> Fingerprint
-readBase62Fingerprint s = Fingerprint w1 w2
- where (s1,s2) = splitAt word64Base62Len s
- w1 = fromBase62 s1
- w2 = fromBase62 (take word64Base62Len s2)
-
--- | Compute the hash (without a prefix) of a package key. In GHC 7.12
--- this is equivalent to display.
-packageKeyHash :: PackageKey -> String
-packageKeyHash (PackageKey _ w1 w2) = toBase62 w1 ++ toBase62 w2
-packageKeyHash (OldPackageKey pid) = display pid
-
--- | Legacy function for GHC 7.10 to compute a LibraryName based on
--- the package key.
-packageKeyLibraryName :: PackageId -> PackageKey -> LibraryName
-packageKeyLibraryName pid (PackageKey _ w1 w2) =
- LibraryName (display pid ++ "-" ++ toBase62 w1 ++ toBase62 w2)
-packageKeyLibraryName _ (OldPackageKey pid) = LibraryName (display pid)
-
-instance Text PackageKey where
- disp (PackageKey mb_prefix w1 w2)
- = maybe Disp.empty (\r -> Disp.text r <> Disp.char '_') mb_prefix <>
- Disp.text (toBase62 w1) <> Disp.text (toBase62 w2)
- disp (OldPackageKey pid) = disp pid
-
- parse = parseNewWithAnnot <++ parseNew <++ parseOld
- where parseNew = do
- fmap (fingerprintPackageKey . readBase62Fingerprint)
- . Parse.count (word64Base62Len * 2)
- $ Parse.satisfy Char.isAlphaNum
- parseNewWithAnnot = do
- -- this is ignored
- prefix <- Parse.munch1 (\c -> Char.isAlphaNum c || c `elem` "-")
- _ <- Parse.char '_' -- if we use '-' it's ambiguous
- PackageKey _ w1 w2 <- parseNew
- return (PackageKey (Just prefix) w1 w2)
- parseOld = do pid <- parse
- return (OldPackageKey pid)
-
-instance NFData PackageKey where
- rnf (PackageKey mb _ _) = rnf mb
- rnf (OldPackageKey pid) = rnf pid
+{-# DEPRECATED InstalledPackageId "Use UnitId instead" #-}
+type InstalledPackageId = UnitId
--- ------------------------------------------------------------
--- * Library names
--- ------------------------------------------------------------
+instance Binary ComponentId
--- | A library name consists of not only a source package
--- id ('PackageId') but also the library names of all textual
--- dependencies; thus, a library name uniquely identifies an
--- installed package up to the dependency resolution done by Cabal.
--- Create using 'packageKeyLibraryName'. Library names are opaque,
--- Cabal-defined strings.
-newtype LibraryName
- = LibraryName String
- deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
+instance Text ComponentId where
+ disp (ComponentId str) = text str
-instance Binary LibraryName
+ parse = ComponentId `fmap` Parse.munch1 abi_char
+ where abi_char c = Char.isAlphaNum c || c `elem` "-_."
--- | Default library name for when it is not known.
-emptyLibraryName :: LibraryName
-emptyLibraryName = LibraryName ""
+instance NFData ComponentId where
+ rnf (ComponentId pk) = rnf pk
-- | Returns library name prefixed with HS, suitable for filenames
-getHSLibraryName :: LibraryName -> String
-getHSLibraryName (LibraryName s) = "HS" ++ s
+getHSLibraryName :: UnitId -> String
+getHSLibraryName (SimpleUnitId (ComponentId s)) = "HS" ++ s
-instance Text LibraryName where
- disp (LibraryName s) = Disp.text s
- parse = LibraryName `fmap` Parse.munch1 hash_char
- where hash_char c = Char.isAlphaNum c || c `elem` "-_."
+-- | For now, there is no distinction between component IDs
+-- and unit IDs in Cabal.
+newtype UnitId = SimpleUnitId ComponentId
+ deriving (Generic, Read, Show, Eq, Ord, Typeable, Data, Binary, Text, NFData)
-instance NFData LibraryName where
- rnf (LibraryName s) = rnf s
+-- | Makes a simple-style UnitId from a string.
+mkUnitId :: String -> UnitId
+mkUnitId = SimpleUnitId . ComponentId
+
+-- | Make an old-style UnitId from a package identifier
+mkLegacyUnitId :: PackageId -> UnitId
+mkLegacyUnitId = SimpleUnitId . ComponentId . display
-- ------------------------------------------------------------
-- * Package source dependencies
@@ -358,8 +240,13 @@ instance Package PackageIdentifier where
packageId = id
-- | Packages that have an installed package ID
-class Package pkg => HasInstalledPackageId pkg where
- installedPackageId :: pkg -> InstalledPackageId
+class Package pkg => HasUnitId pkg where
+ installedUnitId :: pkg -> UnitId
+
+{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}
+-- | Compatibility wrapper for Cabal pre-1.24.
+installedPackageId :: HasUnitId pkg => pkg -> UnitId
+installedPackageId = installedUnitId
-- | Class of installed packages.
--
@@ -367,5 +254,16 @@ class Package pkg => HasInstalledPackageId pkg where
-- 'InstalledPackageInfo', but when we are doing install plans in Cabal install
-- we may have other, installed package-like things which contain more metadata.
-- Installed packages have exact dependencies 'installedDepends'.
-class HasInstalledPackageId pkg => PackageInstalled pkg where
- installedDepends :: pkg -> [InstalledPackageId]
+class (HasUnitId pkg) => PackageInstalled pkg where
+ installedDepends :: pkg -> [UnitId]
+
+-- -----------------------------------------------------------------------------
+-- ABI hash
+
+newtype AbiHash = AbiHash String
+ deriving (Eq, Show, Read, Generic)
+instance Binary AbiHash
+
+instance Text AbiHash where
+ disp (AbiHash abi) = Disp.text abi
+ parse = fmap AbiHash (Parse.munch Char.isAlphaNum)
diff --git a/cabal/Cabal/Distribution/PackageDescription.hs b/cabal/Cabal/Distribution/PackageDescription.hs
index 17e10c1..72fb378 100644
--- a/cabal/Cabal/Distribution/PackageDescription.hs
+++ b/cabal/Cabal/Distribution/PackageDescription.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NoMonoLocalBinds #-}
-----------------------------------------------------------------------------
-- |
@@ -44,6 +44,7 @@ module Distribution.PackageDescription (
ModuleReexport(..),
emptyLibrary,
withLib,
+ hasPublicLib,
hasLibs,
libModules,
@@ -90,6 +91,8 @@ module Distribution.PackageDescription (
hcSharedOptions,
-- ** Supplementary build information
+ ComponentName(..),
+ defaultLibName,
HookedBuildInfo,
emptyHookedBuildInfo,
updatePackageDescription,
@@ -110,43 +113,34 @@ module Distribution.PackageDescription (
SetupBuildInfo(..),
) where
-import Distribution.Compat.Binary (Binary)
+import Distribution.Compat.Binary
+import qualified Distribution.Compat.Semigroup as Semi ((<>))
+import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup, gmempty, gmappend)
+import qualified Distribution.Compat.ReadP as Parse
+import Distribution.Compat.ReadP ((<++))
+import Distribution.Package
+import Distribution.ModuleName
+import Distribution.Version
+import Distribution.License
+import Distribution.Compiler
+import Distribution.System
+import Distribution.Text
+import Language.Haskell.Extension
+
import Data.Data (Data)
-import Data.Foldable (traverse_)
import Data.List (nub, intercalate)
import Data.Maybe (fromMaybe, maybeToList)
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative (Applicative((<*>), pure))
-import Data.Monoid (Monoid(mempty, mappend))
-import Data.Foldable (Foldable(foldMap))
-import Data.Traversable (Traversable(traverse))
-#endif
+import Data.Foldable as Fold (Foldable(foldMap))
+import Data.Traversable as Trav (Traversable(traverse))
import Data.Typeable ( Typeable )
-import Control.Applicative (Alternative(..))
+import Control.Applicative as AP (Alternative(..), Applicative(..))
import Control.Monad (MonadPlus(mplus,mzero), ap)
import GHC.Generics (Generic)
import Text.PrettyPrint as Disp
-import qualified Distribution.Compat.ReadP as Parse
-import Distribution.Compat.ReadP ((<++))
import qualified Data.Char as Char (isAlphaNum, isDigit, toLower)
import qualified Data.Map as Map
import Data.Map (Map)
-import Distribution.Package
- ( PackageName(PackageName), PackageIdentifier(PackageIdentifier)
- , Dependency, Package(..), PackageName, packageName )
-import Distribution.ModuleName ( ModuleName )
-import Distribution.Version
- ( Version(Version), VersionRange, anyVersion, orLaterVersion
- , asVersionIntervals, LowerBound(..) )
-import Distribution.License (License(UnspecifiedLicense))
-import Distribution.Compiler (CompilerFlavor)
-import Distribution.System (OS, Arch)
-import Distribution.Text
- ( Text(..), display )
-import Language.Haskell.Extension
- ( Language, Extension )
-
-- -----------------------------------------------------------------------------
-- The PackageDescription type
@@ -177,6 +171,7 @@ data PackageDescription
customFieldsPD :: [(String,String)], -- ^Custom fields starting
-- with x-, stored in a
-- simple assoc-list.
+
-- | YOU PROBABLY DON'T WANT TO USE THIS FIELD. This field is
-- special! Depending on how far along processing the
-- PackageDescription we are, the contents of this field are
@@ -197,7 +192,7 @@ data PackageDescription
buildType :: Maybe BuildType,
setupBuildInfo :: Maybe SetupBuildInfo,
-- components
- library :: Maybe Library,
+ libraries :: [Library],
executables :: [Executable],
testSuites :: [TestSuite],
benchmarks :: [Benchmark],
@@ -264,7 +259,7 @@ emptyPackageDescription
category = "",
customFieldsPD = [],
setupBuildInfo = Nothing,
- library = Nothing,
+ libraries = [],
executables = [],
testSuites = [],
benchmarks = [],
@@ -322,14 +317,12 @@ data SetupBuildInfo = SetupBuildInfo {
instance Binary SetupBuildInfo
-instance Monoid SetupBuildInfo where
- mempty = SetupBuildInfo {
- setupDepends = mempty
- }
- mappend a b = SetupBuildInfo {
- setupDepends = combine setupDepends
- }
- where combine field = field a `mappend` field b
+instance Semi.Monoid SetupBuildInfo where
+ mempty = gmempty
+ mappend = (Semi.<>)
+
+instance Semigroup SetupBuildInfo where
+ (<>) = gmappend
-- ---------------------------------------------------------------------------
-- Module renaming
@@ -352,9 +345,12 @@ lookupRenaming = Map.findWithDefault defaultRenaming . packageName
instance Binary ModuleRenaming where
instance Monoid ModuleRenaming where
- ModuleRenaming b rns `mappend` ModuleRenaming b' rns'
- = ModuleRenaming (b || b') (rns ++ rns') -- ToDo: dedupe?
mempty = ModuleRenaming False []
+ mappend = (Semi.<>)
+
+instance Semigroup ModuleRenaming where
+ ModuleRenaming b rns <> ModuleRenaming b' rns'
+ = ModuleRenaming (b || b') (rns ++ rns') -- TODO: dedupe?
-- NB: parentheses are mandatory, because later we may extend this syntax
-- to allow "hiding (A, B)" or other modifier words.
@@ -394,6 +390,7 @@ instance Text ModuleRenaming where
-- The Library type
data Library = Library {
+ libName :: String,
exposedModules :: [ModuleName],
reexportedModules :: [ModuleReexport],
requiredSignatures:: [ModuleName], -- ^ What sigs need implementations?
@@ -407,6 +404,7 @@ instance Binary Library
instance Monoid Library where
mempty = Library {
+ libName = mempty,
exposedModules = mempty,
reexportedModules = mempty,
requiredSignatures = mempty,
@@ -414,7 +412,11 @@ instance Monoid Library where
libExposed = True,
libBuildInfo = mempty
}
- mappend a b = Library {
+ mappend = (Semi.<>)
+
+instance Semigroup Library where
+ a <> b = Library {
+ libName = combine' libName,
exposedModules = combine exposedModules,
reexportedModules = combine reexportedModules,
requiredSignatures = combine requiredSignatures,
@@ -423,26 +425,31 @@ instance Monoid Library where
libBuildInfo = combine libBuildInfo
}
where combine field = field a `mappend` field b
+ combine' field = case (field a, field b) of
+ ("","") -> ""
+ ("", x) -> x
+ (x, "") -> x
+ (x, y) -> error $ "Ambiguous values for library field: '"
+ ++ x ++ "' and '" ++ y ++ "'"
emptyLibrary :: Library
emptyLibrary = mempty
--- |does this package have any libraries?
-hasLibs :: PackageDescription -> Bool
-hasLibs p = maybe False (buildable . libBuildInfo) (library p)
+-- | Does this package have a PUBLIC library?
+hasPublicLib :: PackageDescription -> Bool
+hasPublicLib p = any f (libraries p)
+ where f lib = buildable (libBuildInfo lib) &&
+ libName lib == display (packageName (package p))
--- |'Maybe' version of 'hasLibs'
-maybeHasLibs :: PackageDescription -> Maybe Library
-maybeHasLibs p =
- library p >>= \lib -> if buildable (libBuildInfo lib)
- then Just lib
- else Nothing
+-- | Does this package have any libraries?
+hasLibs :: PackageDescription -> Bool
+hasLibs p = any (buildable . libBuildInfo) (libraries p)
-- |If the package description has a library section, call the given
-- function with the library build info as argument.
withLib :: PackageDescription -> (Library -> IO ()) -> IO ()
withLib pkg_descr f =
- traverse_ f (maybeHasLibs pkg_descr)
+ sequence_ [f lib | lib <- libraries pkg_descr, buildable (libBuildInfo lib)]
-- | Get all the module names from the library (exposed and internal modules)
-- which need to be compiled. (This does not include reexports, which
@@ -499,12 +506,11 @@ data Executable = Executable {
instance Binary Executable
instance Monoid Executable where
- mempty = Executable {
- exeName = mempty,
- modulePath = mempty,
- buildInfo = mempty
- }
- mappend a b = Executable{
+ mempty = gmempty
+ mappend = (Semi.<>)
+
+instance Semigroup Executable where
+ a <> b = Executable{
exeName = combine' exeName,
modulePath = combine modulePath,
buildInfo = combine buildInfo
@@ -589,8 +595,10 @@ instance Monoid TestSuite where
testBuildInfo = mempty,
testEnabled = False
}
+ mappend = (Semi.<>)
- mappend a b = TestSuite {
+instance Semigroup TestSuite where
+ a <> b = TestSuite {
testName = combine' testName,
testInterface = combine testInterface,
testBuildInfo = combine testBuildInfo,
@@ -605,8 +613,11 @@ instance Monoid TestSuite where
instance Monoid TestSuiteInterface where
mempty = TestSuiteUnsupported (TestTypeUnknown mempty (Version [] []))
- mappend a (TestSuiteUnsupported _) = a
- mappend _ b = b
+ mappend = (Semi.<>)
+
+instance Semigroup TestSuiteInterface where
+ a <> (TestSuiteUnsupported _) = a
+ _ <> b = b
emptyTestSuite :: TestSuite
emptyTestSuite = mempty
@@ -722,8 +733,10 @@ instance Monoid Benchmark where
benchmarkBuildInfo = mempty,
benchmarkEnabled = False
}
+ mappend = (Semi.<>)
- mappend a b = Benchmark {
+instance Semigroup Benchmark where
+ a <> b = Benchmark {
benchmarkName = combine' benchmarkName,
benchmarkInterface = combine benchmarkInterface,
benchmarkBuildInfo = combine benchmarkBuildInfo,
@@ -738,8 +751,11 @@ instance Monoid Benchmark where
instance Monoid BenchmarkInterface where
mempty = BenchmarkUnsupported (BenchmarkTypeUnknown mempty (Version [] []))
- mappend a (BenchmarkUnsupported _) = a
- mappend _ b = b
+ mappend = (Semi.<>)
+
+instance Semigroup BenchmarkInterface where
+ a <> (BenchmarkUnsupported _) = a
+ _ <> b = b
emptyBenchmark :: Benchmark
emptyBenchmark = mempty
@@ -800,6 +816,7 @@ data BuildInfo = BuildInfo {
ldOptions :: [String], -- ^ options for linker
pkgconfigDepends :: [Dependency], -- ^ pkg-config packages that are used
frameworks :: [String], -- ^support frameworks for Mac OS X
+ extraFrameworkDirs:: [String], -- ^ extra locations to find frameworks.
cSources :: [FilePath],
jsSources :: [FilePath],
hsSourceDirs :: [FilePath], -- ^ where to look for the Haskell module hierarchy
@@ -832,63 +849,68 @@ instance Binary BuildInfo
instance Monoid BuildInfo where
mempty = BuildInfo {
- buildable = True,
- buildTools = [],
- cppOptions = [],
- ccOptions = [],
- ldOptions = [],
- pkgconfigDepends = [],
- frameworks = [],
- cSources = [],
- jsSources = [],
- hsSourceDirs = [],
- otherModules = [],
- defaultLanguage = Nothing,
- otherLanguages = [],
- defaultExtensions = [],
- otherExtensions = [],
- oldExtensions = [],
- extraLibs = [],
- extraGHCiLibs = [],
- extraLibDirs = [],
- includeDirs = [],
- includes = [],
- installIncludes = [],
- options = [],
- profOptions = [],
- sharedOptions = [],
- customFieldsBI = [],
- targetBuildDepends = [],
+ buildable = True,
+ buildTools = [],
+ cppOptions = [],
+ ccOptions = [],
+ ldOptions = [],
+ pkgconfigDepends = [],
+ frameworks = [],
+ extraFrameworkDirs = [],
+ cSources = [],
+ jsSources = [],
+ hsSourceDirs = [],
+ otherModules = [],
+ defaultLanguage = Nothing,
+ otherLanguages = [],
+ defaultExtensions = [],
+ otherExtensions = [],
+ oldExtensions = [],
+ extraLibs = [],
+ extraGHCiLibs = [],
+ extraLibDirs = [],
+ includeDirs = [],
+ includes = [],
+ installIncludes = [],
+ options = [],
+ profOptions = [],
+ sharedOptions = [],
+ customFieldsBI = [],
+ targetBuildDepends = [],
targetBuildRenaming = Map.empty
}
- mappend a b = BuildInfo {
- buildable = buildable a && buildable b,
- buildTools = combine buildTools,
- cppOptions = combine cppOptions,
- ccOptions = combine ccOptions,
- ldOptions = combine ldOptions,
- pkgconfigDepends = combine pkgconfigDepends,
- frameworks = combineNub frameworks,
- cSources = combineNub cSources,
- jsSources = combineNub jsSources,
- hsSourceDirs = combineNub hsSourceDirs,
- otherModules = combineNub otherModules,
- defaultLanguage = combineMby defaultLanguage,
- otherLanguages = combineNub otherLanguages,
- defaultExtensions = combineNub defaultExtensions,
- otherExtensions = combineNub otherExtensions,
- oldExtensions = combineNub oldExtensions,
- extraLibs = combine extraLibs,
- extraGHCiLibs = combine extraGHCiLibs,
- extraLibDirs = combineNub extraLibDirs,
- includeDirs = combineNub includeDirs,
- includes = combineNub includes,
- installIncludes = combineNub installIncludes,
- options = combine options,
- profOptions = combine profOptions,
- sharedOptions = combine sharedOptions,
- customFieldsBI = combine customFieldsBI,
- targetBuildDepends = combineNub targetBuildDepends,
+ mappend = (Semi.<>)
+
+instance Semigroup BuildInfo where
+ a <> b = BuildInfo {
+ buildable = buildable a && buildable b,
+ buildTools = combine buildTools,
+ cppOptions = combine cppOptions,
+ ccOptions = combine ccOptions,
+ ldOptions = combine ldOptions,
+ pkgconfigDepends = combine pkgconfigDepends,
+ frameworks = combineNub frameworks,
+ extraFrameworkDirs = combineNub extraFrameworkDirs,
+ cSources = combineNub cSources,
+ jsSources = combineNub jsSources,
+ hsSourceDirs = combineNub hsSourceDirs,
+ otherModules = combineNub otherModules,
+ defaultLanguage = combineMby defaultLanguage,
+ otherLanguages = combineNub otherLanguages,
+ defaultExtensions = combineNub defaultExtensions,
+ otherExtensions = combineNub otherExtensions,
+ oldExtensions = combineNub oldExtensions,
+ extraLibs = combine extraLibs,
+ extraGHCiLibs = combine extraGHCiLibs,
+ extraLibDirs = combineNub extraLibDirs,
+ includeDirs = combineNub includeDirs,
+ includes = combineNub includes,
+ installIncludes = combineNub installIncludes,
+ options = combine options,
+ profOptions = combine profOptions,
+ sharedOptions = combine sharedOptions,
+ customFieldsBI = combine customFieldsBI,
+ targetBuildDepends = combineNub targetBuildDepends,
targetBuildRenaming = combineMap targetBuildRenaming
}
where
@@ -904,7 +926,7 @@ emptyBuildInfo = mempty
-- all buildable executables, test suites and benchmarks. Useful for gathering
-- dependencies.
allBuildInfo :: PackageDescription -> [BuildInfo]
-allBuildInfo pkg_descr = [ bi | Just lib <- [library pkg_descr]
+allBuildInfo pkg_descr = [ bi | lib <- libraries pkg_descr
, let bi = libBuildInfo lib
, buildable bi ]
++ [ bi | exe <- executables pkg_descr
@@ -939,10 +961,22 @@ usedExtensions :: BuildInfo -> [Extension]
usedExtensions bi = oldExtensions bi
++ defaultExtensions bi
-type HookedBuildInfo = (Maybe BuildInfo, [(String, BuildInfo)])
+-- Libraries live in a separate namespace, so must distinguish
+data ComponentName = CLibName String
+ | CExeName String
+ | CTestName String
+ | CBenchName String
+ deriving (Eq, Generic, Ord, Read, Show)
+
+instance Binary ComponentName
+
+defaultLibName :: PackageIdentifier -> ComponentName
+defaultLibName pid = CLibName (display (pkgName pid))
+
+type HookedBuildInfo = [(ComponentName, BuildInfo)]
emptyHookedBuildInfo :: HookedBuildInfo
-emptyHookedBuildInfo = (Nothing, [])
+emptyHookedBuildInfo = []
-- |Select options for a particular Haskell compiler.
hcOptions :: CompilerFlavor -> BuildInfo -> [String]
@@ -1098,28 +1132,38 @@ lowercase = map Char.toLower
-- ------------------------------------------------------------
updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription
-updatePackageDescription (mb_lib_bi, exe_bi) p
- = p{ executables = updateExecutables exe_bi (executables p)
- , library = updateLibrary mb_lib_bi (library p)
- }
+updatePackageDescription hooked_bis p
+ = p{ executables = updateMany (CExeName . exeName) updateExecutable (executables p)
+ , libraries = updateMany (CLibName . libName) updateLibrary (libraries p)
+ , benchmarks = updateMany (CBenchName . benchmarkName) updateBenchmark (benchmarks p)
+ , testSuites = updateMany (CTestName . testName) updateTestSuite (testSuites p)
+ }
where
- updateLibrary :: Maybe BuildInfo -> Maybe Library -> Maybe Library
- updateLibrary (Just bi) (Just lib) = Just (lib{libBuildInfo = bi `mappend` libBuildInfo lib})
- updateLibrary Nothing mb_lib = mb_lib
- updateLibrary (Just _) Nothing = Nothing
-
- updateExecutables :: [(String, BuildInfo)] -- ^[(exeName, new buildinfo)]
- -> [Executable] -- ^list of executables to update
- -> [Executable] -- ^list with exeNames updated
- updateExecutables exe_bi' executables' = foldr updateExecutable executables' exe_bi'
-
- updateExecutable :: (String, BuildInfo) -- ^(exeName, new buildinfo)
- -> [Executable] -- ^list of executables to update
- -> [Executable] -- ^list with exeName updated
- updateExecutable _ [] = []
- updateExecutable exe_bi'@(name,bi) (exe:exes)
- | exeName exe == name = exe{buildInfo = bi `mappend` buildInfo exe} : exes
- | otherwise = exe : updateExecutable exe_bi' exes
+ updateMany :: (a -> ComponentName) -- ^ get 'ComponentName' from @a@
+ -> (BuildInfo -> a -> a) -- ^ @updateExecutable@, @updateLibrary@, etc
+ -> [a] -- ^list of components to update
+ -> [a] -- ^list with updated components
+ updateMany name update cs' = foldr (updateOne name update) cs' hooked_bis
+
+ updateOne :: (a -> ComponentName) -- ^ get 'ComponentName' from @a@
+ -> (BuildInfo -> a -> a) -- ^ @updateExecutable@, @updateLibrary@, etc
+ -> (ComponentName, BuildInfo) -- ^(name, new buildinfo)
+ -> [a] -- ^list of components to update
+ -> [a] -- ^list with name component updated
+ updateOne _ _ _ [] = []
+ updateOne name_sel update hooked_bi'@(name,bi) (c:cs)
+ | name_sel c == name ||
+ -- Special case: an empty name means "please update the BuildInfo for
+ -- the public library, i.e. the one with the same name as the
+ -- package." See 'parseHookedBuildInfo'.
+ name == CLibName "" && name_sel c == defaultLibName (package p)
+ = update bi c : cs
+ | otherwise = c : updateOne name_sel update hooked_bi' cs
+
+ updateExecutable bi exe = exe{buildInfo = bi `mappend` buildInfo exe}
+ updateLibrary bi lib = lib{libBuildInfo = bi `mappend` libBuildInfo lib}
+ updateBenchmark bi ben = ben{benchmarkBuildInfo = bi `mappend` benchmarkBuildInfo ben}
+ updateTestSuite bi test = test{testBuildInfo = bi `mappend` testBuildInfo test}
-- ---------------------------------------------------------------------------
-- The GenericPackageDescription type
@@ -1128,17 +1172,17 @@ data GenericPackageDescription =
GenericPackageDescription {
packageDescription :: PackageDescription,
genPackageFlags :: [Flag],
- condLibrary :: Maybe (CondTree ConfVar [Dependency] Library),
+ condLibraries :: [(String, CondTree ConfVar [Dependency] Library)],
condExecutables :: [(String, CondTree ConfVar [Dependency] Executable)],
condTestSuites :: [(String, CondTree ConfVar [Dependency] TestSuite)],
condBenchmarks :: [(String, CondTree ConfVar [Dependency] Benchmark)]
}
- deriving (Show, Eq, Typeable, Data)
+ deriving (Show, Eq, Typeable, Data, Generic)
instance Package GenericPackageDescription where
packageId = packageId . packageDescription
---TODO: make PackageDescription an instance of Text.
+instance Binary GenericPackageDescription
-- | A flag can represent a feature to be included, or a way of linking
-- a target against its dependencies, or in fact whatever you can think of.
@@ -1148,7 +1192,9 @@ data Flag = MkFlag
, flagDefault :: Bool
, flagManual :: Bool
}
- deriving (Show, Eq, Typeable, Data)
+ deriving (Show, Eq, Typeable, Data, Generic)
+
+instance Binary Flag
-- | A 'FlagName' is the name of a user-defined configuration flag
newtype FlagName = FlagName String
@@ -1168,7 +1214,9 @@ data ConfVar = OS OS
| Arch Arch
| Flag FlagName
| Impl CompilerFlavor VersionRange
- deriving (Eq, Show, Typeable, Data)
+ deriving (Eq, Show, Typeable, Data, Generic)
+
+instance Binary ConfVar
-- | A boolean expression parameterized over the variable type used.
data Condition c = Var c
@@ -1176,7 +1224,7 @@ data Condition c = Var c
| CNot (Condition c)
| COr (Condition c) (Condition c)
| CAnd (Condition c) (Condition c)
- deriving (Show, Eq, Typeable, Data)
+ deriving (Show, Eq, Typeable, Data, Generic)
cNot :: Condition a -> Condition a
cNot (Lit b) = Lit (not b)
@@ -1193,23 +1241,23 @@ instance Functor Condition where
instance Foldable Condition where
f `foldMap` Var c = f c
_ `foldMap` Lit _ = mempty
- f `foldMap` CNot c = foldMap f c
+ f `foldMap` CNot c = Fold.foldMap f c
f `foldMap` COr c d = foldMap f c `mappend` foldMap f d
f `foldMap` CAnd c d = foldMap f c `mappend` foldMap f d
instance Traversable Condition where
f `traverse` Var c = Var `fmap` f c
_ `traverse` Lit c = pure $ Lit c
- f `traverse` CNot c = CNot `fmap` traverse f c
+ f `traverse` CNot c = CNot `fmap` Trav.traverse f c
f `traverse` COr c d = COr `fmap` traverse f c <*> traverse f d
f `traverse` CAnd c d = CAnd `fmap` traverse f c <*> traverse f d
instance Applicative Condition where
- pure = return
+ pure = Var
(<*>) = ap
instance Monad Condition where
- return = Var
+ return = AP.pure
-- Terminating cases
(>>=) (Lit x) _ = Lit x
(>>=) (Var x) f = f x
@@ -1220,7 +1268,10 @@ instance Monad Condition where
instance Monoid (Condition a) where
mempty = Lit False
- mappend = COr
+ mappend = (Semi.<>)
+
+instance Semigroup (Condition a) where
+ (<>) = COr
instance Alternative Condition where
empty = mempty
@@ -1230,6 +1281,8 @@ instance MonadPlus Condition where
mzero = mempty
mplus = mappend
+instance Binary c => Binary (Condition c)
+
data CondTree v c a = CondNode
{ condTreeData :: a
, condTreeConstraints :: c
@@ -1237,4 +1290,6 @@ data CondTree v c a = CondNode
, CondTree v c a
, Maybe (CondTree v c a))]
}
- deriving (Show, Eq, Typeable, Data)
+ deriving (Show, Eq, Typeable, Data, Generic)
+
+instance (Binary v, Binary c, Binary a) => Binary (CondTree v c a)
diff --git a/cabal/Cabal/Distribution/PackageDescription/Check.hs b/cabal/Cabal/Distribution/PackageDescription/Check.hs
index 283c93c..add824c 100644
--- a/cabal/Cabal/Distribution/PackageDescription/Check.hs
+++ b/cabal/Cabal/Distribution/PackageDescription/Check.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NoMonoLocalBinds #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.PackageDescription.Check
@@ -33,50 +34,30 @@ module Distribution.PackageDescription.Check (
checkPackageFileNames,
) where
-import Data.Maybe
- ( isNothing, isJust, catMaybes, maybeToList, fromMaybe )
-import Data.List (sort, group, isPrefixOf, nub, find)
-import Control.Monad
- ( filterM, liftM )
-import qualified System.Directory as System
- ( doesFileExist, doesDirectoryExist )
-import qualified Data.Map as Map
-
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
- ( flattenPackageDescription, finalizePackageDescription )
import Distribution.Compiler
- ( CompilerFlavor(..), buildCompilerFlavor, CompilerId(..)
- , unknownCompilerInfo, AbiTag(..) )
import Distribution.System
- ( OS(..), Arch(..), buildPlatform )
import Distribution.License
- ( License(..), knownLicenses )
import Distribution.Simple.CCompiler
- ( filenameCDialect )
-import Distribution.Simple.Utils
- ( cabalVersion, intercalate, parseFileGlob, FileGlob(..), lowercase, startsWithBOM, fromUTF8 )
-
+import Distribution.Simple.Utils hiding (findPackageDesc, notice)
import Distribution.Version
- ( Version(..)
- , VersionRange(..), foldVersionRange'
- , anyVersion, noVersion, thisVersion, laterVersion, earlierVersion
- , orLaterVersion, orEarlierVersion
- , unionVersionRanges, intersectVersionRanges
- , asVersionIntervals, UpperBound(..), isNoVersion )
import Distribution.Package
- ( PackageName(PackageName), packageName, packageVersion
- , Dependency(..), pkgName )
-
import Distribution.Text
- ( display, disp )
+import Language.Haskell.Extension
+
+import Data.Maybe
+ ( isNothing, isJust, catMaybes, mapMaybe, fromMaybe )
+import Data.List (sort, group, isPrefixOf, nub, find)
+import Control.Monad
+ ( filterM, liftM )
+import qualified System.Directory as System
+ ( doesFileExist, doesDirectoryExist )
+import qualified Data.Map as Map
+
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>), (<+>))
-import qualified Language.Haskell.Extension as Extension (deprecatedExtensions)
-import Language.Haskell.Extension
- ( Language(UnknownLanguage), knownLanguages
- , Extension(..), KnownExtension(..) )
import qualified System.Directory (getDirectoryContents)
import System.IO (openBinaryFile, IOMode(ReadMode), hGetContents)
import System.FilePath
@@ -111,7 +92,7 @@ data PackageCheck =
| PackageDistSuspicious { explanation :: String }
-- | Like PackageDistSuspicious but will only display warnings
- -- rather than causing abnormal exit.
+ -- rather than causing abnormal exit when you run 'cabal check'.
| PackageDistSuspiciousWarn { explanation :: String }
-- | An issue that is OK in the author's environment but is almost
@@ -193,19 +174,19 @@ checkSanity pkg =
, check (all ($ pkg) [ null . executables
, null . testSuites
, null . benchmarks
- , isNothing . library ]) $
+ , null . libraries ]) $
PackageBuildImpossible
"No executables, libraries, tests, or benchmarks found. Nothing to do."
, check (not (null duplicateNames)) $
PackageBuildImpossible $ "Duplicate sections: " ++ commaSep duplicateNames
- ++ ". The name of every executable, test suite, and benchmark section in"
+ ++ ". The name of every library, executable, test suite, and benchmark section in"
++ " the package must be unique."
]
--TODO: check for name clashes case insensitively: windows file systems cannot
--cope.
- ++ maybe [] (checkLibrary pkg) (library pkg)
+ ++ concatMap (checkLibrary pkg) (libraries pkg)
++ concatMap (checkExecutable pkg) (executables pkg)
++ concatMap (checkTestSuite pkg) (testSuites pkg)
++ concatMap (checkBenchmark pkg) (benchmarks pkg)
@@ -219,10 +200,15 @@ checkSanity pkg =
++ "tool only supports up to version " ++ display cabalVersion ++ "."
]
where
+ -- The public library gets special dispensation, because it
+ -- is common practice to export a library and name the executable
+ -- the same as the package. We always put the public library
+ -- in the top-level directory in dist, so no conflicts either.
+ libNames = filter (/= unPackageName (packageName pkg)) . map libName $ libraries pkg
exeNames = map exeName $ executables pkg
testNames = map testName $ testSuites pkg
bmNames = map benchmarkName $ benchmarks pkg
- duplicateNames = dups $ exeNames ++ testNames ++ bmNames
+ duplicateNames = dups $ libNames ++ exeNames ++ testNames ++ bmNames
checkLibrary :: PackageDescription -> Library -> [PackageCheck]
checkLibrary pkg lib =
@@ -317,14 +303,6 @@ checkTestSuite pkg test =
PackageDistInexcusable $
"The package uses a C/C++/obj-C source file for the 'main-is' field. "
++ "To use this feature you must specify 'cabal-version: >= 1.18'."
-
- -- Test suites might be built as (internal) libraries named after
- -- the test suite and thus their names must not clash with the
- -- name of the package.
- , check libNameClash $
- PackageBuildImpossible $
- "The test suite " ++ testName test
- ++ " has the same name as the package."
]
where
moduleDuplicates = dups $ testModules test
@@ -337,13 +315,8 @@ checkTestSuite pkg test =
TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
_ -> False
- libNameClash = testName test `elem` [ libName
- | _lib <- maybeToList (library pkg)
- , let PackageName libName =
- pkgName (package pkg) ]
-
checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck]
-checkBenchmark pkg bm =
+checkBenchmark _pkg bm =
catMaybes [
case benchmarkInterface bm of
@@ -369,12 +342,6 @@ checkBenchmark pkg bm =
PackageBuildImpossible $
"The 'main-is' field must specify a '.hs' or '.lhs' file "
++ "(even if it is generated by a preprocessor)."
-
- -- See comment for similar check on test suites.
- , check libNameClash $
- PackageBuildImpossible $
- "The benchmark " ++ benchmarkName bm
- ++ " has the same name as the package."
]
where
moduleDuplicates = dups $ benchmarkModules bm
@@ -383,11 +350,6 @@ checkBenchmark pkg bm =
BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
_ -> False
- libNameClash = benchmarkName bm `elem` [ libName
- | _lib <- maybeToList (library pkg)
- , let PackageName libName =
- pkgName (package pkg) ]
-
-- ------------------------------------------------------------
-- * Additional pure checks
-- ------------------------------------------------------------
@@ -403,6 +365,11 @@ checkFields pkg =
++ "need to convert package names to file names so using this name "
++ "would cause problems."
+ , check ((isPrefixOf "z-") . display . packageName $ pkg) $
+ PackageDistInexcusable $
+ "Package names with the prefix 'z-' are reserved by Cabal and "
+ ++ "cannot be used."
+
, check (isNothing (buildType pkg)) $
PackageBuildWarning $
"No 'build-type' specified. If you do not need a custom Setup.hs or "
@@ -442,14 +409,14 @@ checkFields pkg =
++ ". Languages must be specified in either the 'default-language' "
++ " or the 'other-languages' field."
- , check (not (null deprecatedExtensions)) $
+ , check (not (null ourDeprecatedExtensions)) $
PackageDistSuspicious $
"Deprecated extensions: "
- ++ commaSep (map (quote . display . fst) deprecatedExtensions)
+ ++ commaSep (map (quote . display . fst) ourDeprecatedExtensions)
++ ". " ++ unwords
[ "Instead of '" ++ display ext
++ "' use '" ++ display replacement ++ "'."
- | (ext, Just replacement) <- deprecatedExtensions ]
+ | (ext, Just replacement) <- ourDeprecatedExtensions ]
, check (null (category pkg)) $
PackageDistSuspicious "No 'category' field."
@@ -491,8 +458,8 @@ checkFields pkg =
unknownExtensions = [ name | bi <- allBuildInfo pkg
, UnknownExtension name <- allExtensions bi
, name `notElem` map display knownLanguages ]
- deprecatedExtensions = nub $ catMaybes
- [ find ((==ext) . fst) Extension.deprecatedExtensions
+ ourDeprecatedExtensions = nub $ catMaybes
+ [ find ((==ext) . fst) deprecatedExtensions
| bi <- allBuildInfo pkg
, ext <- allExtensions bi ]
languagesUsedAsExtensions =
@@ -624,7 +591,7 @@ checkGhcOptions pkg =
PackageBuildWarning $
"'ghc-options: -prof' is not necessary and will lead to problems "
++ "when used on a library. Use the configure flag "
- ++ "--enable-library-profiling and/or --enable-executable-profiling."
+ ++ "--enable-library-profiling and/or --enable-profiling."
, checkFlags ["-o"] $
PackageBuildWarning $
@@ -713,12 +680,21 @@ checkGhcOptions pkg =
, checkAlternatives "ghc-options" "extra-lib-dirs"
[ (flag, dir) | flag@('-':'L':dir) <- all_ghc_options ]
+
+ , checkAlternatives "ghc-options" "frameworks"
+ [ (flag, fmwk) | (flag@"-framework", fmwk) <-
+ zip all_ghc_options (safeTail all_ghc_options) ]
+
+ , checkAlternatives "ghc-options" "extra-framework-dirs"
+ [ (flag, dir) | (flag@"-framework-path", dir) <-
+ zip all_ghc_options (safeTail all_ghc_options) ]
]
where
all_ghc_options = concatMap get_ghc_options (allBuildInfo pkg)
- lib_ghc_options = maybe [] (get_ghc_options . libBuildInfo) (library pkg)
+ lib_ghc_options = concatMap (get_ghc_options . libBuildInfo) (libraries pkg)
get_ghc_options bi = hcOptions GHC bi ++ hcProfOptions GHC bi
+ ++ hcSharedOptions GHC bi
checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkFlags flags = check (any (`elem` flags) all_ghc_options)
@@ -939,9 +915,18 @@ checkCabalVersion pkg =
++ "different modules then list the other ones in the "
++ "'other-languages' field."
+ , checkVersion [1,23]
+ (case libraries pkg of
+ [lib] -> libName lib /= unPackageName (packageName pkg)
+ [] -> False
+ _ -> True) $
+ PackageDistInexcusable $
+ "To use multiple 'library' sections or a named library section "
+ ++ "the package needs to specify at least 'cabal-version >= 1.23'."
+
-- check use of reexported-modules sections
, checkVersion [1,21]
- (maybe False (not.null.reexportedModules) (library pkg)) $
+ (any (not.null.reexportedModules) (libraries pkg)) $
PackageDistInexcusable $
"To use the 'reexported-module' field the package needs to specify "
++ "at least 'cabal-version: >= 1.21'."
@@ -955,6 +940,13 @@ checkCabalVersion pkg =
++ ". To use this new syntax, the package needs to specify at least"
++ "'cabal-version: >= 1.21'."
+ -- check use of 'extra-framework-dirs' field
+ , checkVersion [1,23] (any (not . null) (buildInfoField extraFrameworkDirs)) $
+ -- Just a warning, because this won't break on old Cabal versions.
+ PackageDistSuspiciousWarn $
+ "To use the 'extra-framework-dirs' field the package needs to specify"
+ ++ " at least 'cabal-version: >= 1.23'."
+
-- check use of default-extensions field
-- don't need to do the equivalent check for other-extensions
, checkVersion [1,10] (any (not . null) (buildInfoField defaultExtensions)) $
@@ -1080,7 +1072,7 @@ checkCabalVersion pkg =
, check (specVersion pkg < Version [1,23] []
&& isNothing (setupBuildInfo pkg)
&& buildType pkg == Just Custom) $
- PackageDistSuspicious $
+ PackageDistSuspiciousWarn $
"From version 1.23 cabal supports specifiying explicit dependencies "
++ "for Custom setup scripts. Consider using cabal-version >= 1.23 and "
++ "adding a 'custom-setup' section with a 'setup-depends' field "
@@ -1152,8 +1144,7 @@ checkCabalVersion pkg =
depsUsingThinningRenamingSyntax =
[ name
| bi <- allBuildInfo pkg
- , (name, rns) <- Map.toList (targetBuildRenaming bi)
- , rns /= ModuleRenaming True [] ]
+ , (name, _) <- Map.toList (targetBuildRenaming bi) ]
testedWithUsingWildcardSyntax =
[ Dependency (PackageName (display compiler)) vr
@@ -1341,10 +1332,10 @@ checkConditionals pkg =
unknownOSs = [ os | OS (OtherOS os) <- conditions ]
unknownArches = [ arch | Arch (OtherArch arch) <- conditions ]
unknownImpls = [ impl | Impl (OtherCompiler impl) _ <- conditions ]
- conditions = maybe [] freeVars (condLibrary pkg)
- ++ concatMap (freeVars . snd) (condExecutables pkg)
- freeVars (CondNode _ _ ifs) = concatMap compfv ifs
- compfv (c, ct, mct) = condfv c ++ freeVars ct ++ maybe [] freeVars mct
+ conditions = concatMap (fvs . snd) (condLibraries pkg)
+ ++ concatMap (fvs . snd) (condExecutables pkg)
+ fvs (CondNode _ _ ifs) = concatMap compfv ifs -- free variables
+ compfv (c, ct, mct) = condfv c ++ fvs ct ++ maybe [] fvs mct
condfv c = case c of
Var v -> [v]
Lit _ -> []
@@ -1408,6 +1399,7 @@ checkDevelopmentOnlyFlagsBuildInfo bi =
has_Wall = "-Wall" `elem` ghc_options
has_W = "-W" `elem` ghc_options
ghc_options = hcOptions GHC bi ++ hcProfOptions GHC bi
+ ++ hcSharedOptions GHC bi
checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkFlags flags = check (any (`elem` flags) ghc_options)
@@ -1444,8 +1436,8 @@ checkDevelopmentOnlyFlags pkg =
allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]
allConditionalBuildInfo =
- concatMap (collectCondTreePaths libBuildInfo)
- (maybeToList (condLibrary pkg))
+ concatMap (collectCondTreePaths libBuildInfo . snd)
+ (condLibraries pkg)
++ concatMap (collectCondTreePaths buildInfo . snd)
(condExecutables pkg)
@@ -1538,7 +1530,8 @@ checkCabalFileBOM ops = do
pdfile ++ " starts with an Unicode byte order mark (BOM). This may cause problems with older cabal versions."
-- |Find a package description file in the given directory. Looks for
--- @.cabal@ files.
+-- @.cabal@ files. Like 'Distribution.Simple.Utils.findPackageDesc',
+-- but generalized over monads.
findPackageDesc :: Monad m => CheckPackageContentOps m
-> m (Either PackageCheck FilePath) -- ^<pkgname>.cabal
findPackageDesc ops
@@ -1610,6 +1603,8 @@ checkLocalPathsExist ops pkg = do
| bi <- allBuildInfo pkg
, (dir, kind) <-
[ (dir, "extra-lib-dirs") | dir <- extraLibDirs bi ]
+ ++ [ (dir, "extra-framework-dirs")
+ | dir <- extraFrameworkDirs bi ]
++ [ (dir, "include-dirs") | dir <- includeDirs bi ]
++ [ (dir, "hs-source-dirs") | dir <- hsSourceDirs bi ]
, isRelative dir ]
@@ -1658,8 +1653,8 @@ repoTypeDirname _ = []
--
checkPackageFileNames :: [FilePath] -> [PackageCheck]
checkPackageFileNames files =
- (take 1 . catMaybes . map checkWindowsPath $ files)
- ++ (take 1 . catMaybes . map checkTarPath $ files)
+ (take 1 . mapMaybe checkWindowsPath $ files)
+ ++ (take 1 . mapMaybe checkTarPath $ files)
-- If we get any of these checks triggering then we're likely to get
-- many, and that's probably not helpful, so return at most one.
diff --git a/cabal/Cabal/Distribution/PackageDescription/Configuration.hs b/cabal/Cabal/Distribution/PackageDescription/Configuration.hs
index 3e18aba..70fee23 100644
--- a/cabal/Cabal/Distribution/PackageDescription/Configuration.hs
+++ b/cabal/Cabal/Distribution/PackageDescription/Configuration.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
-- -fno-warn-deprecations for use of Map.foldWithKey
{-# OPTIONS_GHC -fno-warn-deprecations #-}
-----------------------------------------------------------------------------
@@ -23,46 +22,34 @@ module Distribution.PackageDescription.Configuration (
-- Utils
parseCondition,
freeVars,
+ extractCondition,
+ addBuildableCondition,
mapCondTree,
mapTreeData,
mapTreeConds,
mapTreeConstrs,
+ transformAllBuildInfos,
+ transformAllBuildDepends,
) where
import Distribution.Package
- ( PackageName, Dependency(..) )
import Distribution.PackageDescription
- ( GenericPackageDescription(..), PackageDescription(..)
- , Library(..), Executable(..), BuildInfo(..)
- , Flag(..), FlagName(..), FlagAssignment
- , Benchmark(..), CondTree(..), ConfVar(..), Condition(..)
- , TestSuite(..) )
import Distribution.PackageDescription.Utils
- ( cabalBug, userBug )
import Distribution.Version
- ( VersionRange, anyVersion, intersectVersionRanges, withinRange )
import Distribution.Compiler
- ( CompilerId(CompilerId) )
import Distribution.System
- ( Platform(..), OS, Arch )
import Distribution.Simple.Utils
- ( currentDir, lowercase )
-import Distribution.Simple.Compiler
- ( CompilerInfo(..) )
-
import Distribution.Text
- ( Text(parse) )
import Distribution.Compat.ReadP as ReadP hiding ( char )
-import Control.Arrow (first)
import qualified Distribution.Compat.ReadP as ReadP ( char )
+import Distribution.Compat.Semigroup as Semi
+import Control.Arrow (first)
import Data.Char ( isAlphaNum )
-import Data.Maybe ( catMaybes, maybeToList )
+import Data.Maybe ( mapMaybe, maybeToList )
import Data.Map ( Map, fromListWith, toList )
import qualified Data.Map as Map
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid
-#endif
+import Data.Tree ( Tree(Node) )
------------------------------------------------------------------------------
@@ -185,14 +172,14 @@ mapTreeData f = mapCondTree f id id
-- clarity.
data DepTestRslt d = DepOk | MissingDeps d
-instance Monoid d => Monoid (DepTestRslt d) where
+instance Semigroup d => Monoid (DepTestRslt d) where
mempty = DepOk
- mappend DepOk x = x
- mappend x DepOk = x
- mappend (MissingDeps d) (MissingDeps d') = MissingDeps (d `mappend` d')
-
+ mappend = (Semi.<>)
-data BT a = BTN a | BTB (BT a) (BT a) -- very simple binary tree
+instance Semigroup d => Semigroup (DepTestRslt d) where
+ DepOk <> x = x
+ x <> DepOk = x
+ (MissingDeps d) <> (MissingDeps d') = MissingDeps (d <> d')
-- | Try to find a flag assignment that satisfies the constraints of all trees.
@@ -201,8 +188,9 @@ data BT a = BTN a | BTB (BT a) (BT a) -- very simple binary tree
-- resulting data, the associated dependencies, and the chosen flag
-- assignments.
--
--- In case of failure, the _smallest_ number of of missing dependencies is
--- returned. [TODO: Could also be specified with a function argument.]
+-- In case of failure, the union of the dependencies that led to backtracking
+-- on all branches is returned.
+-- [TODO: Could also be specified with a function argument.]
--
-- TODO: The current algorithm is rather naive. A better approach would be to:
--
@@ -228,64 +216,131 @@ resolveWithFlags ::
-- ^ Either the missing dependencies (error case), or a pair of
-- (set of build targets with dependencies, chosen flag assignments)
resolveWithFlags dom os arch impl constrs trees checkDeps =
- case try dom [] of
- Right r -> Right r
- Left dbt -> Left $ findShortest dbt
+ either (Left . fromDepMapUnion) Right $ explore (build [] dom)
where
extraConstrs = toDepMap constrs
-- simplify trees by (partially) evaluating all conditions and converting
-- dependencies to dependency maps.
+ simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged]
simplifiedTrees = map ( mapTreeConstrs toDepMap -- convert to maps
+ . addBuildableCondition pdTaggedBuildInfo
. mapTreeConds (fst . simplifyWithSysParams os arch impl))
trees
- -- @try@ recursively tries all possible flag assignments in the domain and
- -- either succeeds or returns a binary tree with the missing dependencies
- -- encountered in each run. Since the tree is constructed lazily, we
- -- avoid some computation overhead in the successful case.
- try [] flags =
+ -- @explore@ searches a tree of assignments, backtracking whenever a flag
+ -- introduces a dependency that cannot be satisfied. If there is no
+ -- solution, @explore@ returns the union of all dependencies that caused
+ -- it to backtrack. Since the tree is constructed lazily, we avoid some
+ -- computation overhead in the successful case.
+ explore :: Tree FlagAssignment
+ -> Either DepMapUnion (TargetSet PDTagged, FlagAssignment)
+ explore (Node flags ts) =
let targetSet = TargetSet $ flip map simplifiedTrees $
-- apply additional constraints to all dependencies
first (`constrainBy` extraConstrs) .
simplifyCondTree (env flags)
deps = overallDependencies targetSet
in case checkDeps (fromDepMap deps) of
- DepOk -> Right (targetSet, flags)
- MissingDeps mds -> Left (BTN mds)
-
- try ((n, vals):rest) flags =
- tryAll $ map (\v -> try rest ((n, v):flags)) vals
-
+ DepOk | null ts -> Right (targetSet, flags)
+ | otherwise -> tryAll $ map explore ts
+ MissingDeps mds -> Left (toDepMapUnion mds)
+
+ -- Builds a tree of all possible flag assignments. Internal nodes
+ -- have only partial assignments.
+ build :: FlagAssignment -> [(FlagName, [Bool])] -> Tree FlagAssignment
+ build assigned [] = Node assigned []
+ build assigned ((fn, vals) : unassigned) =
+ Node assigned $ map (\v -> build ((fn, v) : assigned) unassigned) vals
+
+ tryAll :: [Either DepMapUnion a] -> Either DepMapUnion a
tryAll = foldr mp mz
-- special version of `mplus' for our local purposes
- mp (Left xs) (Left ys) = (Left (BTB xs ys))
- mp (Left _) m@(Right _) = m
+ mp :: Either DepMapUnion a -> Either DepMapUnion a -> Either DepMapUnion a
mp m@(Right _) _ = m
+ mp _ m@(Right _) = m
+ mp (Left xs) (Left ys) =
+ let union = Map.foldrWithKey (Map.insertWith' combine)
+ (unDepMapUnion xs) (unDepMapUnion ys)
+ combine x y = simplifyVersionRange $ unionVersionRanges x y
+ in union `seq` Left (DepMapUnion union)
-- `mzero'
- mz = Left (BTN [])
+ mz :: Either DepMapUnion a
+ mz = Left (DepMapUnion Map.empty)
+ env :: FlagAssignment -> FlagName -> Either FlagName Bool
env flags flag = (maybe (Left flag) Right . lookup flag) flags
- -- for the error case we inspect our lazy tree of missing dependencies and
- -- pick the shortest list of missing dependencies
- findShortest (BTN x) = x
- findShortest (BTB lt rt) =
- let l = findShortest lt
- r = findShortest rt
- in case (l,r) of
- ([], xs) -> xs -- [] is too short
- (xs, []) -> xs
- ([x], _) -> [x] -- single elem is optimum
- (_, [x]) -> [x]
- (xs, ys) -> if lazyLengthCmp xs ys
- then xs else ys
- -- lazy variant of @\xs ys -> length xs <= length ys@
- lazyLengthCmp [] _ = True
- lazyLengthCmp _ [] = False
- lazyLengthCmp (_:xs) (_:ys) = lazyLengthCmp xs ys
+ pdTaggedBuildInfo :: PDTagged -> BuildInfo
+ pdTaggedBuildInfo (Lib _ l) = libBuildInfo l
+ pdTaggedBuildInfo (Exe _ e) = buildInfo e
+ pdTaggedBuildInfo (Test _ t) = testBuildInfo t
+ pdTaggedBuildInfo (Bench _ b) = benchmarkBuildInfo b
+ pdTaggedBuildInfo PDNull = mempty
+
+-- | Transforms a 'CondTree' by putting the input under the "then" branch of a
+-- conditional that is True when Buildable is True. If 'addBuildableCondition'
+-- can determine that Buildable is always True, it returns the input unchanged.
+-- If Buildable is always False, it returns the empty 'CondTree'.
+addBuildableCondition :: (Eq v, Monoid a, Monoid c) => (a -> BuildInfo)
+ -> CondTree v c a
+ -> CondTree v c a
+addBuildableCondition getInfo t =
+ case extractCondition (buildable . getInfo) t of
+ Lit True -> t
+ Lit False -> CondNode mempty mempty []
+ c -> CondNode mempty mempty [(c, t, Nothing)]
+
+-- | Extract buildable condition from a cond tree.
+--
+-- Background: If the conditions in a cond tree lead to Buildable being set to False,
+-- then none of the dependencies for this cond tree should actually be taken into
+-- account. On the other hand, some of the flags may only be decided in the solver,
+-- so we cannot necessarily make the decision whether a component is Buildable or not
+-- prior to solving.
+--
+-- What we are doing here is to partially evaluate a condition tree in order to extract
+-- the condition under which Buildable is True. The predicate determines whether data
+-- under a 'CondTree' is buildable.
+extractCondition :: Eq v => (a -> Bool) -> CondTree v c a -> Condition v
+extractCondition p = go
+ where
+ go (CondNode x _ cs) | not (p x) = Lit False
+ | otherwise = goList cs
+
+ goList [] = Lit True
+ goList ((c, t, e) : cs) =
+ let
+ ct = go t
+ ce = maybe (Lit True) go e
+ in
+ ((c `cand` ct) `cor` (CNot c `cand` ce)) `cand` goList cs
+
+ cand (Lit False) _ = Lit False
+ cand _ (Lit False) = Lit False
+ cand (Lit True) x = x
+ cand x (Lit True) = x
+ cand x y = CAnd x y
+
+ cor (Lit True) _ = Lit True
+ cor _ (Lit True) = Lit True
+ cor (Lit False) x = x
+ cor x (Lit False) = x
+ cor c (CNot d)
+ | c == d = Lit True
+ cor x y = COr x y
+
+-- | A map of dependencies that combines version ranges using 'unionVersionRanges'.
+newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName VersionRange }
+
+toDepMapUnion :: [Dependency] -> DepMapUnion
+toDepMapUnion ds =
+ DepMapUnion $ fromListWith unionVersionRanges [ (p,vr) | Dependency p vr <- ds ]
+
+fromDepMapUnion :: DepMapUnion -> [Dependency]
+fromDepMapUnion m = [ Dependency p vr | (p,vr) <- toList (unDepMapUnion m) ]
-- | A map of dependencies. Newtyped since the default monoid instance is not
-- appropriate. The monoid instance uses 'intersectVersionRanges'.
@@ -294,7 +349,10 @@ newtype DependencyMap = DependencyMap { unDependencyMap :: Map PackageName Versi
instance Monoid DependencyMap where
mempty = DependencyMap Map.empty
- (DependencyMap a) `mappend` (DependencyMap b) =
+ mappend = (Semi.<>)
+
+instance Semigroup DependencyMap where
+ (DependencyMap a) <> (DependencyMap b) =
DependencyMap (Map.unionWith intersectVersionRanges a b)
toDepMap :: [Dependency] -> DependencyMap
@@ -304,18 +362,20 @@ toDepMap ds =
fromDepMap :: DependencyMap -> [Dependency]
fromDepMap m = [ Dependency p vr | (p,vr) <- toList (unDependencyMap m) ]
+-- | Flattens a CondTree using a partial flag assignment. When a condition
+-- cannot be evaluated, both branches are ignored.
simplifyCondTree :: (Monoid a, Monoid d) =>
(v -> Either v Bool)
-> CondTree v d a
-> (d, a)
simplifyCondTree env (CondNode a d ifs) =
- mconcat $ (d, a) : catMaybes (map simplifyIf ifs)
+ mconcat $ (d, a) : mapMaybe simplifyIf ifs
where
simplifyIf (cnd, t, me) =
case simplifyCondition cnd env of
(Lit True, _) -> Just $ simplifyCondTree env t
(Lit False, _) -> fmap (simplifyCondTree env) me
- _ -> error $ "Environment not defined for all free vars"
+ _ -> Nothing
-- | Flatten a CondTree. This will resolve the CondTree by taking all
-- possible paths into account. Note that since branches represent exclusive
@@ -350,11 +410,11 @@ overallDependencies (TargetSet targets) = mconcat depss
where
(depss, _) = unzip $ filter (removeDisabledSections . snd) targets
removeDisabledSections :: PDTagged -> Bool
- removeDisabledSections (Lib _) = True
- removeDisabledSections (Exe _ _) = True
- removeDisabledSections (Test _ t) = testEnabled t
- removeDisabledSections (Bench _ b) = benchmarkEnabled b
- removeDisabledSections PDNull = True
+ removeDisabledSections (Lib _ l) = buildable (libBuildInfo l)
+ removeDisabledSections (Exe _ e) = buildable (buildInfo e)
+ removeDisabledSections (Test _ t) = testEnabled t && buildable (testBuildInfo t)
+ removeDisabledSections (Bench _ b) = benchmarkEnabled b && buildable (benchmarkBuildInfo b)
+ removeDisabledSections PDNull = True
-- Apply extra constraints to a dependency map.
-- Combines dependencies where the result will only contain keys from the left
@@ -375,50 +435,53 @@ constrainBy left extra =
-- | Collect up the targets in a TargetSet of tagged targets, storing the
-- dependencies as we go.
flattenTaggedTargets :: TargetSet PDTagged ->
- (Maybe Library, [(String, Executable)], [(String, TestSuite)]
+ ([(String, Library)], [(String, Executable)], [(String, TestSuite)]
, [(String, Benchmark)])
-flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], []) targets
+flattenTaggedTargets (TargetSet targets) = foldr untag ([], [], [], []) targets
where
- untag (_, Lib _) (Just _, _, _, _) = userBug "Only one library expected"
- untag (deps, Lib l) (Nothing, exes, tests, bms) =
- (Just l', exes, tests, bms)
+ untag (deps, Lib n l) (libs, exes, tests, bms)
+ | any ((== n) . fst) libs =
+ userBug $ "There exist several libs with the same name: '" ++ n ++ "'"
+ -- NB: libraries live in a different namespace than everything else
+ -- TODO: no, (new-style) TESTS live in same namespace!!
+ | otherwise = ((n, l'):libs, exes, tests, bms)
where
l' = l {
libBuildInfo = (libBuildInfo l) { targetBuildDepends = fromDepMap deps }
}
- untag (deps, Exe n e) (mlib, exes, tests, bms)
+ untag (deps, Exe n e) (libs, exes, tests, bms)
| any ((== n) . fst) exes =
userBug $ "There exist several exes with the same name: '" ++ n ++ "'"
| any ((== n) . fst) tests =
userBug $ "There exists a test with the same name as an exe: '" ++ n ++ "'"
| any ((== n) . fst) bms =
userBug $ "There exists a benchmark with the same name as an exe: '" ++ n ++ "'"
- | otherwise = (mlib, (n, e'):exes, tests, bms)
+ | otherwise = (libs, (n, e'):exes, tests, bms)
where
e' = e {
buildInfo = (buildInfo e) { targetBuildDepends = fromDepMap deps }
}
- untag (deps, Test n t) (mlib, exes, tests, bms)
+ untag (deps, Test n t) (libs, exes, tests, bms)
| any ((== n) . fst) tests =
userBug $ "There exist several tests with the same name: '" ++ n ++ "'"
| any ((== n) . fst) exes =
userBug $ "There exists an exe with the same name as the test: '" ++ n ++ "'"
| any ((== n) . fst) bms =
userBug $ "There exists a benchmark with the same name as the test: '" ++ n ++ "'"
- | otherwise = (mlib, exes, (n, t'):tests, bms)
+ | otherwise = (libs, exes, (n, t'):tests, bms)
where
t' = t {
testBuildInfo = (testBuildInfo t)
{ targetBuildDepends = fromDepMap deps }
}
- untag (deps, Bench n b) (mlib, exes, tests, bms)
+ untag (deps, Bench n b) (libs, exes, tests, bms)
| any ((== n) . fst) bms =
userBug $ "There exist several benchmarks with the same name: '" ++ n ++ "'"
| any ((== n) . fst) exes =
userBug $ "There exists an exe with the same name as the benchmark: '" ++ n ++ "'"
| any ((== n) . fst) tests =
userBug $ "There exists a test with the same name as the benchmark: '" ++ n ++ "'"
- | otherwise = (mlib, exes, tests, (n, b'):bms)
+ | otherwise = (libs, exes, tests, (n, b'):bms)
where
b' = b {
benchmarkBuildInfo = (benchmarkBuildInfo b)
@@ -431,7 +494,7 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], []) tar
-- Convert GenericPackageDescription to PackageDescription
--
-data PDTagged = Lib Library
+data PDTagged = Lib String Library
| Exe String Executable
| Test String TestSuite
| Bench String Benchmark
@@ -440,13 +503,16 @@ data PDTagged = Lib Library
instance Monoid PDTagged where
mempty = PDNull
- PDNull `mappend` x = x
- x `mappend` PDNull = x
- Lib l `mappend` Lib l' = Lib (l `mappend` l')
- Exe n e `mappend` Exe n' e' | n == n' = Exe n (e `mappend` e')
- Test n t `mappend` Test n' t' | n == n' = Test n (t `mappend` t')
- Bench n b `mappend` Bench n' b' | n == n' = Bench n (b `mappend` b')
- _ `mappend` _ = cabalBug "Cannot combine incompatible tags"
+ mappend = (Semi.<>)
+
+instance Semigroup PDTagged where
+ PDNull <> x = x
+ x <> PDNull = x
+ Lib n l <> Lib n' l' | n == n' = Lib n (l <> l')
+ Exe n e <> Exe n' e' | n == n' = Exe n (e <> e')
+ Test n t <> Test n' t' | n == n' = Test n (t <> t')
+ Bench n b <> Bench n' b' | n == n' = Bench n (b <> b')
+ _ <> _ = cabalBug "Cannot combine incompatible tags"
-- | Create a package description with all configurations resolved.
--
@@ -465,9 +531,10 @@ instance Monoid PDTagged where
--
-- This function will fail if it cannot find a flag assignment that leads to
-- satisfiable dependencies. (It will not try alternative assignments for
--- explicitly specified flags.) In case of failure it will return a /minimum/
--- number of dependencies that could not be satisfied. On success, it will
--- return the package description and the full flag assignment chosen.
+-- explicitly specified flags.) In case of failure it will return the missing
+-- dependencies that it encountered when trying different flag assignments.
+-- On success, it will return the package description and the full flag
+-- assignment chosen.
--
finalizePackageDescription ::
FlagAssignment -- ^ Explicitly specified flag assignments
@@ -484,25 +551,21 @@ finalizePackageDescription ::
-- description along with the flag assignments chosen.
finalizePackageDescription userflags satisfyDep
(Platform arch os) impl constraints
- (GenericPackageDescription pkg flags mlib0 exes0 tests0 bms0) =
+ (GenericPackageDescription pkg flags libs0 exes0 tests0 bms0) =
case resolveFlags of
- Right ((mlib, exes', tests', bms'), targetSet, flagVals) ->
- Right ( pkg { library = mlib
+ Right ((libs', exes', tests', bms'), targetSet, flagVals) ->
+ Right ( pkg { libraries = libs'
, executables = exes'
, testSuites = tests'
, benchmarks = bms'
, buildDepends = fromDepMap (overallDependencies targetSet)
- --TODO: we need to find a way to avoid pulling in deps
- -- for non-buildable components. However cannot simply
- -- filter at this stage, since if the package were not
- -- available we would have failed already.
}
, flagVals )
Left missing -> Left missing
where
-- Combine lib, exes, and tests into one list of @CondTree@s with tagged data
- condTrees = maybeToList (fmap (mapTreeData Lib) mlib0 )
+ condTrees = map (\(name,tree) -> mapTreeData (Lib name) tree) libs0
++ map (\(name,tree) -> mapTreeData (Exe name) tree) exes0
++ map (\(name,tree) -> mapTreeData (Test name) tree) tests0
++ map (\(name,tree) -> mapTreeData (Bench name) tree) bms0
@@ -510,8 +573,8 @@ finalizePackageDescription userflags satisfyDep
resolveFlags =
case resolveWithFlags flagChoices os arch impl constraints condTrees check of
Right (targetSet, fs) ->
- let (mlib, exes, tests, bms) = flattenTaggedTargets targetSet in
- Right ( (fmap libFillInDefaults mlib,
+ let (libs, exes, tests, bms) = flattenTaggedTargets targetSet in
+ Right ( (map (\(n,l) -> (libFillInDefaults l) { libName = n }) libs,
map (\(n,e) -> (exeFillInDefaults e) { exeName = n }) exes,
map (\(n,t) -> (testFillInDefaults t) { testName = n }) tests,
map (\(n,b) -> (benchFillInDefaults b) { benchmarkName = n }) bms),
@@ -554,21 +617,21 @@ resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribu
-- default path will be missing from the package description returned by this
-- function.
flattenPackageDescription :: GenericPackageDescription -> PackageDescription
-flattenPackageDescription (GenericPackageDescription pkg _ mlib0 exes0 tests0 bms0) =
- pkg { library = mlib
+flattenPackageDescription (GenericPackageDescription pkg _ libs0 exes0 tests0 bms0) =
+ pkg { libraries = reverse libs
, executables = reverse exes
, testSuites = reverse tests
, benchmarks = reverse bms
- , buildDepends = ldeps ++ reverse edeps ++ reverse tdeps ++ reverse bdeps
+ , buildDepends = reverse ldeps ++ reverse edeps ++ reverse tdeps ++ reverse bdeps
}
where
- (mlib, ldeps) = case mlib0 of
- Just lib -> let (l,ds) = ignoreConditions lib in
- (Just (libFillInDefaults l), ds)
- Nothing -> (Nothing, [])
+ (libs, ldeps) = foldr flattenLib ([],[]) libs0
(exes, edeps) = foldr flattenExe ([],[]) exes0
(tests, tdeps) = foldr flattenTst ([],[]) tests0
(bms, bdeps) = foldr flattenBm ([],[]) bms0
+ flattenLib (n, t) (es, ds) =
+ let (e, ds') = ignoreConditions t in
+ ( (libFillInDefaults $ e { libName = n }) : es, ds' ++ ds )
flattenExe (n, t) (es, ds) =
let (e, ds') = ignoreConditions t in
( (exeFillInDefaults $ e { exeName = n }) : es, ds' ++ ds )
@@ -607,3 +670,82 @@ biFillInDefaults bi =
if null (hsSourceDirs bi)
then bi { hsSourceDirs = [currentDir] }
else bi
+
+-- Walk a 'GenericPackageDescription' and apply @onBuildInfo@/@onSetupBuildInfo@
+-- to all nested 'BuildInfo'/'SetupBuildInfo' values.
+transformAllBuildInfos :: (BuildInfo -> BuildInfo)
+ -> (SetupBuildInfo -> SetupBuildInfo)
+ -> GenericPackageDescription
+ -> GenericPackageDescription
+transformAllBuildInfos onBuildInfo onSetupBuildInfo gpd = gpd'
+ where
+ onLibrary lib = lib { libBuildInfo = onBuildInfo $ libBuildInfo lib }
+ onExecutable exe = exe { buildInfo = onBuildInfo $ buildInfo exe }
+ onTestSuite tst = tst { testBuildInfo = onBuildInfo $ testBuildInfo tst }
+ onBenchmark bmk = bmk { benchmarkBuildInfo =
+ onBuildInfo $ benchmarkBuildInfo bmk }
+
+ pd = packageDescription gpd
+ pd' = pd {
+ libraries = map onLibrary (libraries pd),
+ executables = map onExecutable (executables pd),
+ testSuites = map onTestSuite (testSuites pd),
+ benchmarks = map onBenchmark (benchmarks pd),
+ setupBuildInfo = fmap onSetupBuildInfo (setupBuildInfo pd)
+ }
+
+ gpd' = transformAllCondTrees onLibrary onExecutable
+ onTestSuite onBenchmark id
+ $ gpd { packageDescription = pd' }
+
+-- | Walk a 'GenericPackageDescription' and apply @f@ to all nested
+-- @build-depends@ fields.
+transformAllBuildDepends :: (Dependency -> Dependency)
+ -> GenericPackageDescription
+ -> GenericPackageDescription
+transformAllBuildDepends f gpd = gpd'
+ where
+ onBI bi = bi { targetBuildDepends = map f $ targetBuildDepends bi }
+ onSBI stp = stp { setupDepends = map f $ setupDepends stp }
+ onPD pd = pd { buildDepends = map f $ buildDepends pd }
+
+ pd' = onPD $ packageDescription gpd
+ gpd' = transformAllCondTrees id id id id (map f)
+ . transformAllBuildInfos onBI onSBI
+ $ gpd { packageDescription = pd' }
+
+-- | Walk all 'CondTree's inside a 'GenericPackageDescription' and apply
+-- appropriate transformations to all nodes. Helper function used by
+-- 'transformAllBuildDepends' and 'transformAllBuildInfos'.
+transformAllCondTrees :: (Library -> Library)
+ -> (Executable -> Executable)
+ -> (TestSuite -> TestSuite)
+ -> (Benchmark -> Benchmark)
+ -> ([Dependency] -> [Dependency])
+ -> GenericPackageDescription -> GenericPackageDescription
+transformAllCondTrees onLibrary onExecutable
+ onTestSuite onBenchmark onDepends gpd = gpd'
+ where
+ gpd' = gpd {
+ condLibraries = condLibs',
+ condExecutables = condExes',
+ condTestSuites = condTests',
+ condBenchmarks = condBenchs'
+ }
+
+ condLibs = condLibraries gpd
+ condExes = condExecutables gpd
+ condTests = condTestSuites gpd
+ condBenchs = condBenchmarks gpd
+
+ condLibs' = map (mapSnd $ onCondTree onLibrary) condLibs
+ condExes' = map (mapSnd $ onCondTree onExecutable) condExes
+ condTests' = map (mapSnd $ onCondTree onTestSuite) condTests
+ condBenchs' = map (mapSnd $ onCondTree onBenchmark) condBenchs
+
+ mapSnd :: (a -> b) -> (c,a) -> (c,b)
+ mapSnd = fmap
+
+ onCondTree :: (a -> b) -> CondTree v [Dependency] a
+ -> CondTree v [Dependency] b
+ onCondTree g = mapCondTree g onDepends id
diff --git a/cabal/Cabal/Distribution/PackageDescription/Parse.hs b/cabal/Cabal/Distribution/PackageDescription/Parse.hs
index d32548c..28d9884 100644
--- a/cabal/Cabal/Distribution/PackageDescription/Parse.hs
+++ b/cabal/Cabal/Distribution/PackageDescription/Parse.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
@@ -41,8 +42,20 @@ module Distribution.PackageDescription.Parse (
flagFieldDescrs
) where
+import Distribution.ParseUtils hiding (parseFields)
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Utils
+import Distribution.Package
+import Distribution.ModuleName
+import Distribution.Version
+import Distribution.Verbosity
+import Distribution.Compiler
+import Distribution.PackageDescription.Configuration
+import Distribution.Simple.Utils
+import Distribution.Text
+import Distribution.Compat.ReadP hiding (get)
+
import Data.Char (isSpace)
-import Data.Foldable (traverse_)
import Data.Maybe (listToMaybe, isJust)
import Data.List (nub, unfoldr, partition, (\\))
import Control.Monad (liftM, foldM, when, unless, ap)
@@ -53,35 +66,9 @@ import Control.Applicative (Applicative(..))
import Control.Arrow (first)
import System.Directory (doesFileExist)
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
-import Data.Typeable
-import Data.Data
-import qualified Data.Map as Map
-import Distribution.Text
- ( Text(disp, parse), display, simpleParse )
-import Distribution.Compat.ReadP
- ((+++), option)
-import qualified Distribution.Compat.ReadP as Parse
import Text.PrettyPrint
-import Distribution.ParseUtils hiding (parseFields)
-import Distribution.PackageDescription
-import Distribution.PackageDescription.Utils
- ( cabalBug, userBug )
-import Distribution.Package
- ( PackageIdentifier(..), Dependency(..), packageName, packageVersion )
-import Distribution.ModuleName ( ModuleName )
-import Distribution.Version
- ( Version(Version), orLaterVersion
- , LowerBound(..), asVersionIntervals )
-import Distribution.Verbosity (Verbosity)
-import Distribution.Compiler (CompilerFlavor(..))
-import Distribution.PackageDescription.Configuration (parseCondition, freeVars)
-import Distribution.Simple.Utils
- ( die, dieWithLocation, warn, intercalate, lowercase, cabalVersion
- , withFileContents, withUTF8FileContents
- , writeFileAtomic, writeUTF8File )
-
-- -----------------------------------------------------------------------------
-- The PackageDescription type
@@ -402,8 +389,7 @@ binfoFieldDescrs =
buildTools (\xs binfo -> binfo{buildTools=xs})
, commaListFieldWithSep vcat "build-depends"
disp parse
- buildDependsWithRenaming
- setBuildDependsWithRenaming
+ targetBuildDepends (\xs binfo -> binfo{targetBuildDepends=xs})
, spaceListField "cpp-options"
showToken parseTokenQ'
cppOptions (\val binfo -> binfo{cppOptions=val})
@@ -419,6 +405,9 @@ binfoFieldDescrs =
, listField "frameworks"
showToken parseTokenQ
frameworks (\val binfo -> binfo{frameworks=val})
+ , listField "extra-framework-dirs"
+ showToken parseFilePathQ
+ extraFrameworkDirs (\val binfo -> binfo{extraFrameworkDirs=val})
, listFieldWithSep vcat "c-sources"
showFilePath parseFilePathQ
cSources (\paths binfo -> binfo{cSources=paths})
@@ -597,7 +586,8 @@ mapSimpleFields f = mapM walk
-- prop_isMapM fs = mapSimpleFields return fs == return fs
--- names of fields that represents dependencies, thus consrca
+-- names of fields that represents dependencies
+-- TODO: maybe build-tools should go here too?
constraintFieldNames :: [String]
constraintFieldNames = ["build-depends"]
@@ -605,9 +595,9 @@ constraintFieldNames = ["build-depends"]
-- they add and define an accessor that specifies what the dependencies
-- are. This way we would completely reuse the parsing knowledge from the
-- field descriptor.
-parseConstraint :: Field -> ParseResult [DependencyWithRenaming]
+parseConstraint :: Field -> ParseResult [Dependency]
parseConstraint (F l n v)
- | n == "build-depends" = runP l n (parseCommaList parse) v
+ | n `elem` constraintFieldNames = runP l n (parseCommaList parse) v
parseConstraint f = userBug $ "Constraint was expected (got: " ++ show f ++ ")"
{-
@@ -640,12 +630,14 @@ instance (Monad m) => Applicative (StT s m) where
#else
instance (Monad m, Functor m) => Applicative (StT s m) where
#endif
- pure = return
+ pure a = StT (\s -> return (a,s))
(<*>) = ap
instance Monad m => Monad (StT s m) where
+#if __GLASGOW_HASKELL__ < 710
return a = StT (\s -> return (a,s))
+#endif
StT f >>= g = StT $ \s -> do
(a,s') <- f s
runStT (g a) s'
@@ -749,14 +741,14 @@ parsePackageDescription file = do
-- 'getBody' assumes that the remaining fields only consist of
-- flags, lib and exe sections.
- (repos, flags, mcsetup, mlib, exes, tests, bms) <- getBody
+ (repos, flags, mcsetup, libs, exes, tests, bms) <- getBody pkg
warnIfRest -- warn if getBody did not parse up to the last field.
-- warn about using old/new syntax with wrong cabal-version:
maybeWarnCabalVersion (not $ oldSyntax fields0) pkg
- checkForUndefinedFlags flags mlib exes tests
+ checkForUndefinedFlags flags libs exes tests
return $ GenericPackageDescription
pkg { sourceRepos = repos, setupBuildInfo = mcsetup }
- flags mlib exes tests bms
+ flags libs exes tests bms
where
oldSyntax = all isSimpleField
@@ -856,17 +848,18 @@ parsePackageDescription file = do
_ -> return (reverse acc)
--
- -- body ::= { repo | flag | library | executable | test }+ -- at most one lib
+ -- body ::= { repo | flag | library | executable | test }+
--
-- The body consists of an optional sequence of declarations of flags and
- -- an arbitrary number of executables and at most one library.
- getBody :: PM ([SourceRepo], [Flag]
+ -- an arbitrary number of libraries/executables/tests.
+ getBody :: PackageDescription
+ -> PM ([SourceRepo], [Flag]
,Maybe SetupBuildInfo
- ,Maybe (CondTree ConfVar [Dependency] Library)
+ ,[(String, CondTree ConfVar [Dependency] Library)]
,[(String, CondTree ConfVar [Dependency] Executable)]
,[(String, CondTree ConfVar [Dependency] TestSuite)]
,[(String, CondTree ConfVar [Dependency] Benchmark)])
- getBody = peekField >>= \mf -> case mf of
+ getBody pkg = peekField >>= \mf -> case mf of
Just (Section line_no sec_type sec_label sec_fields)
| sec_type == "executable" -> do
when (null sec_label) $ lift $ syntaxError line_no
@@ -874,7 +867,7 @@ parsePackageDescription file = do
exename <- lift $ runP line_no "executable" parseTokenQ sec_label
flds <- collectFields parseExeFields sec_fields
skipField
- (repos, flags, csetup, lib, exes, tests, bms) <- getBody
+ (repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg
return (repos, flags, csetup, lib, (exename, flds): exes, tests, bms)
| sec_type == "test-suite" -> do
@@ -904,7 +897,6 @@ parsePackageDescription file = do
-- Does the current node specify a test type?
hasTestType = testInterface ts'
/= testInterface emptyTestSuite
- components = condTreeComponents ct
-- If the current level of the tree specifies a type,
-- then we are done. If not, then one of the conditional
-- branches below the current node must specify a type.
@@ -912,11 +904,11 @@ parsePackageDescription file = do
-- only one need one to specify a type because the
-- configure step uses 'mappend' to join together the
-- results of flag resolution.
- in hasTestType || any checkComponent components
+ in hasTestType || any checkComponent (condTreeComponents ct)
if checkTestType emptyTestSuite flds
then do
skipField
- (repos, flags, csetup, lib, exes, tests, bms) <- getBody
+ (repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg
return (repos, flags, csetup, lib, exes,
(testname, flds) : tests, bms)
else lift $ syntaxError line_no $
@@ -953,7 +945,6 @@ parsePackageDescription file = do
-- Does the current node specify a benchmark type?
hasBenchmarkType = benchmarkInterface ts'
/= benchmarkInterface emptyBenchmark
- components = condTreeComponents ct
-- If the current level of the tree specifies a type,
-- then we are done. If not, then one of the conditional
-- branches below the current node must specify a type.
@@ -961,11 +952,11 @@ parsePackageDescription file = do
-- only one need one to specify a type because the
-- configure step uses 'mappend' to join together the
-- results of flag resolution.
- in hasBenchmarkType || any checkComponent components
+ in hasBenchmarkType || any checkComponent (condTreeComponents ct)
if checkBenchmarkType emptyBenchmark flds
then do
skipField
- (repos, flags, csetup, lib, exes, tests, bms) <- getBody
+ (repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg
return (repos, flags, csetup, lib, exes,
tests, (benchname, flds) : bms)
else lift $ syntaxError line_no $
@@ -976,14 +967,15 @@ parsePackageDescription file = do
++ intercalate ", " (map display knownBenchmarkTypes)
| sec_type == "library" -> do
- unless (null sec_label) $ lift $
- syntaxError line_no "'library' expects no argument"
+ libname <- if null sec_label
+ then return (unPackageName (packageName pkg))
+ -- TODO: relax this parsing so that scoping is handled
+ -- correctly
+ else lift $ runP line_no "library" parseTokenQ sec_label
flds <- collectFields parseLibFields sec_fields
skipField
- (repos, flags, csetup, lib, exes, tests, bms) <- getBody
- when (isJust lib) $ lift $ syntaxError line_no
- "There can only be one library section in a package description."
- return (repos, flags, csetup, Just flds, exes, tests, bms)
+ (repos, flags, csetup, libs, exes, tests, bms) <- getBody pkg
+ return (repos, flags, csetup, (libname, flds) : libs, exes, tests, bms)
| sec_type == "flag" -> do
when (null sec_label) $ lift $
@@ -994,7 +986,7 @@ parsePackageDescription file = do
(MkFlag (FlagName (lowercase sec_label)) "" True False)
sec_fields
skipField
- (repos, flags, csetup, lib, exes, tests, bms) <- getBody
+ (repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg
return (repos, flag:flags, csetup, lib, exes, tests, bms)
| sec_type == "source-repository" -> do
@@ -1019,7 +1011,7 @@ parsePackageDescription file = do
}
sec_fields
skipField
- (repos, flags, csetup, lib, exes, tests, bms) <- getBody
+ (repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg
return (repo:repos, flags, csetup, lib, exes, tests, bms)
| sec_type == "custom-setup" -> do
@@ -1031,7 +1023,7 @@ parsePackageDescription file = do
mempty
sec_fields
skipField
- (repos, flags, csetup0, lib, exes, tests, bms) <- getBody
+ (repos, flags, csetup0, lib, exes, tests, bms) <- getBody pkg
when (isJust csetup0) $ lift $ syntaxError line_no
"There can only be one 'custom-setup' section in a package description."
return (repos, flags, Just flds, lib, exes, tests, bms)
@@ -1039,18 +1031,18 @@ parsePackageDescription file = do
| otherwise -> do
lift $ warning $ "Ignoring unknown section type: " ++ sec_type
skipField
- getBody
+ getBody pkg
Just f@(F {}) -> do
_ <- lift $ syntaxError (lineNo f) $
"Plain fields are not allowed in between stanzas: " ++ show f
skipField
- getBody
+ getBody pkg
Just f@(IfBlock {}) -> do
_ <- lift $ syntaxError (lineNo f) $
"If-blocks are not allowed in between stanzas: " ++ show f
skipField
- getBody
- Nothing -> return ([], [], Nothing, Nothing, [], [], [])
+ getBody pkg
+ Nothing -> return ([], [], Nothing, [], [], [], [])
-- Extracts all fields in a block and returns a 'CondTree'.
--
@@ -1064,17 +1056,29 @@ parsePackageDescription file = do
condFlds = [ f | f@IfBlock{} <- allflds ]
sections = [ s | s@Section{} <- allflds ]
- -- Put these through the normal parsing pass too, so that we
- -- collect the ModRenamings
- let depFlds = filter isConstraint simplFlds
-
mapM_
(\(Section l n _ _) -> lift . warning $
"Unexpected section '" ++ n ++ "' on line " ++ show l)
sections
a <- parser simplFlds
- deps <- liftM concat . mapM (lift . fmap (map dependency) . parseConstraint) $ depFlds
+
+ -- Dependencies must be treated specially: when we
+ -- parse into a CondTree, not only do we parse them into
+ -- the targetBuildDepends/etc field inside the
+ -- PackageDescription, but we also have to put the
+ -- combined dependencies into CondTree.
+ --
+ -- This information is, in principle, redundant, but
+ -- putting it here makes it easier for the constraint
+ -- solver to pick a flag assignment which supports
+ -- all of the dependencies (because it only has
+ -- to check the CondTree, rather than grovel everywhere
+ -- inside the conditional bits).
+ deps <- liftM concat
+ . mapM (lift . parseConstraint)
+ . filter isConstraint
+ $ simplFlds
ifs <- mapM processIfs condFlds
@@ -1115,13 +1119,13 @@ parsePackageDescription file = do
checkForUndefinedFlags ::
[Flag] ->
- Maybe (CondTree ConfVar [Dependency] Library) ->
+ [(String, CondTree ConfVar [Dependency] Library)] ->
[(String, CondTree ConfVar [Dependency] Executable)] ->
[(String, CondTree ConfVar [Dependency] TestSuite)] ->
PM ()
- checkForUndefinedFlags flags mlib exes tests = do
+ checkForUndefinedFlags flags libs exes tests = do
let definedFlags = map flagName flags
- traverse_ (checkCondTreeFlags definedFlags) mlib
+ mapM_ (checkCondTreeFlags definedFlags . snd) libs
mapM_ (checkCondTreeFlags definedFlags . snd) exes
mapM_ (checkCondTreeFlags definedFlags . snd) tests
@@ -1198,24 +1202,39 @@ deprecField _ = cabalBug "'deprecField' called on a non-field"
parseHookedBuildInfo :: String -> ParseResult HookedBuildInfo
parseHookedBuildInfo inp = do
fields <- readFields inp
- let ss@(mLibFields:exes) = stanzas fields
+ let (mLibFields:rest) = stanzas fields
mLib <- parseLib mLibFields
- biExes <- mapM parseExe (maybe ss (const exes) mLib)
- return (mLib, biExes)
+ foldM parseStanza mLib rest
where
- parseLib :: [Field] -> ParseResult (Maybe BuildInfo)
+ -- For backwards compatibility, if you have a bare stanza,
+ -- we assume it's part of the public library. We don't
+ -- know what the name is, so the people using the HookedBuildInfo
+ -- have to handle this carefully.
+ parseLib :: [Field] -> ParseResult [(ComponentName, BuildInfo)]
parseLib (bi@(F _ inFieldName _:_))
- | lowercase inFieldName /= "executable" = liftM Just (parseBI bi)
- parseLib _ = return Nothing
-
- parseExe :: [Field] -> ParseResult (String, BuildInfo)
- parseExe (F line inFieldName mName:bi)
- | lowercase inFieldName == "executable"
- = do bis <- parseBI bi
- return (mName, bis)
- | otherwise = syntaxError line "expecting 'executable' at top of stanza"
- parseExe (_:_) = cabalBug "`parseExe' called on a non-field"
- parseExe [] = syntaxError 0 "error in parsing buildinfo file. Expected executable stanza"
+ | lowercase inFieldName /= "executable" &&
+ lowercase inFieldName /= "library" &&
+ lowercase inFieldName /= "benchmark" &&
+ lowercase inFieldName /= "test-suite"
+ = liftM (\bis -> [(CLibName "", bis)]) (parseBI bi)
+ parseLib _ = return []
+
+ parseStanza :: HookedBuildInfo -> [Field] -> ParseResult HookedBuildInfo
+ parseStanza bis (F line inFieldName mName:bi)
+ | Just k <- case lowercase inFieldName of
+ "executable" -> Just CExeName
+ "library" -> Just CLibName
+ "benchmark" -> Just CBenchName
+ "test-suite" -> Just CTestName
+ _ -> Nothing
+ = do bi' <- parseBI bi
+ return ((k mName, bi'):bis)
+ | otherwise
+ = syntaxError line $
+ "expecting 'executable', 'library', 'benchmark' or 'test-suite' " ++
+ "at top of stanza, but got '" ++ inFieldName ++ "'"
+ parseStanza _ (_:_) = cabalBug "`parseStanza' called on a non-field"
+ parseStanza _ [] = syntaxError 0 "error in parsing buildinfo file. Expected stanza"
parseBI st = parseFields binfoFieldDescrs storeXFieldsBI emptyBuildInfo st
@@ -1231,9 +1250,7 @@ showPackageDescription :: PackageDescription -> String
showPackageDescription pkg = render $
ppPackage pkg
$$ ppCustomFields (customFieldsPD pkg)
- $$ (case library pkg of
- Nothing -> empty
- Just lib -> ppLibrary lib)
+ $$ vcat [ space $$ ppLibrary lib | lib <- libraries pkg ]
$$ vcat [ space $$ ppExecutable exe | exe <- executables pkg ]
where
ppPackage = ppFields pkgDescrFieldDescrs
@@ -1251,15 +1268,16 @@ writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack
. showHookedBuildInfo
showHookedBuildInfo :: HookedBuildInfo -> String
-showHookedBuildInfo (mb_lib_bi, ex_bis) = render $
- (case mb_lib_bi of
- Nothing -> empty
- Just bi -> ppBuildInfo bi)
- $$ vcat [ space
- $$ text "executable:" <+> text name
+showHookedBuildInfo bis = render $
+ vcat [ space
+ $$ ppName name
$$ ppBuildInfo bi
- | (name, bi) <- ex_bis ]
+ | (name, bi) <- bis ]
where
+ ppName (CLibName name) = text "library:" <+> text name
+ ppName (CExeName name) = text "executable:" <+> text name
+ ppName (CTestName name) = text "test-suite:" <+> text name
+ ppName (CBenchName name) = text "benchmark:" <+> text name
ppBuildInfo bi = ppFields binfoFieldDescrs bi
$$ ppCustomFields (customFieldsBI bi)
@@ -1278,32 +1296,3 @@ findIndentTabs = concatMap checkLine
--test_findIndentTabs = findIndentTabs $ unlines $
-- [ "foo", " bar", " \t baz", "\t biz\t", "\t\t \t mib" ]
-
--- | Dependencies plus module renamings. This is what users specify; however,
--- renaming information is not used for dependency resolution.
-data DependencyWithRenaming = DependencyWithRenaming Dependency ModuleRenaming
- deriving (Read, Show, Eq, Typeable, Data)
-
-dependency :: DependencyWithRenaming -> Dependency
-dependency (DependencyWithRenaming dep _) = dep
-
-instance Text DependencyWithRenaming where
- disp (DependencyWithRenaming d rns) = disp d <+> disp rns
- parse = do d <- parse
- Parse.skipSpaces
- rns <- parse
- Parse.skipSpaces
- return (DependencyWithRenaming d rns)
-
-buildDependsWithRenaming :: BuildInfo -> [DependencyWithRenaming]
-buildDependsWithRenaming pkg =
- map (\dep@(Dependency n _) ->
- DependencyWithRenaming dep
- (Map.findWithDefault defaultRenaming n (targetBuildRenaming pkg)))
- (targetBuildDepends pkg)
-
-setBuildDependsWithRenaming :: [DependencyWithRenaming] -> BuildInfo -> BuildInfo
-setBuildDependsWithRenaming deps pkg = pkg {
- targetBuildDepends = map dependency deps,
- targetBuildRenaming = Map.fromList (map (\(DependencyWithRenaming (Dependency n _) rns) -> (n, rns)) deps)
- }
diff --git a/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs
index bca9cc3..2972197 100644
--- a/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs
+++ b/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.PackageDescription.PrettyPrint
@@ -18,27 +17,18 @@ module Distribution.PackageDescription.PrettyPrint (
showGenericPackageDescription,
) where
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid (Monoid(mempty))
-#endif
import Distribution.PackageDescription
- ( Benchmark(..), BenchmarkInterface(..), benchmarkType
- , TestSuite(..), TestSuiteInterface(..), testType
- , SourceRepo(..),
- customFieldsBI, CondTree(..), Condition(..), cNot,
- FlagName(..), ConfVar(..), Executable(..), Library(..),
- Flag(..), PackageDescription(..),
- GenericPackageDescription(..))
+import Distribution.Simple.Utils
+import Distribution.ParseUtils
+import Distribution.PackageDescription.Parse
+import Distribution.Package
+import Distribution.Text
+
+import Data.Monoid as Mon (Monoid(mempty))
+import Data.Maybe (isJust)
import Text.PrettyPrint
(hsep, parens, char, nest, empty, isEmpty, ($$), (<+>),
colon, (<>), text, vcat, ($+$), Doc, render)
-import Distribution.Simple.Utils (writeUTF8File)
-import Distribution.ParseUtils (showFreeText, FieldDescr(..), indentWith, ppField, ppFields)
-import Distribution.PackageDescription.Parse (pkgDescrFieldDescrs,binfoFieldDescrs,libFieldDescrs,
- sourceRepoFieldDescrs,flagFieldDescrs)
-import Distribution.Package (Dependency(..))
-import Distribution.Text (Text(..))
-import Data.Maybe (isJust)
-- | Recompile with false for regression testing
simplifiedPrinting :: Bool
@@ -56,7 +46,8 @@ ppGenericPackageDescription :: GenericPackageDescription -> Doc
ppGenericPackageDescription gpd =
ppPackageDescription (packageDescription gpd)
$+$ ppGenPackageFlags (genPackageFlags gpd)
- $+$ ppLibrary (condLibrary gpd)
+ $+$ ppLibraries (unPackageName (packageName (packageDescription gpd)))
+ (condLibraries gpd)
$+$ ppExecutables (condExecutables gpd)
$+$ ppTestSuites (condTestSuites gpd)
$+$ ppBenchmarks (condBenchmarks gpd)
@@ -116,10 +107,10 @@ ppFlag flag@(MkFlag name _ _ _) =
where
fields = ppFieldsFiltered flagDefaults flagFieldDescrs flag
-ppLibrary :: (Maybe (CondTree ConfVar [Dependency] Library)) -> Doc
-ppLibrary Nothing = empty
-ppLibrary (Just condTree) =
- emptyLine $ text "library" $+$ nest indentWith (ppCondTree condTree Nothing ppLib)
+ppLibraries :: String -> [(String, CondTree ConfVar [Dependency] Library)] -> Doc
+ppLibraries pn libs =
+ vcat [emptyLine $ text (if n == pn then "library" else "library " ++ n)
+ $+$ nest indentWith (ppCondTree condTree Nothing ppLib)| (n,condTree) <- libs]
where
ppLib lib Nothing = ppFieldsFiltered libDefaults libFieldDescrs lib
$$ ppCustomFields (customFieldsBI (libBuildInfo lib))
@@ -236,9 +227,9 @@ ppIf' :: a -> (a -> Maybe a -> Doc)
-> Condition ConfVar
-> CondTree ConfVar [Dependency] a
-> Doc
-ppIf' it ppIt c thenTree =
+ppIf' it ppIt c thenTree =
if isEmpty thenDoc
- then mempty
+ then Mon.mempty
else ppIfCondition c $$ nest indentWith thenDoc
where thenDoc = ppCondTree thenTree (if simplifiedPrinting then (Just it) else Nothing) ppIt
@@ -249,7 +240,7 @@ ppIfElse :: a -> (a -> Maybe a -> Doc)
-> Doc
ppIfElse it ppIt c thenTree elseTree =
case (isEmpty thenDoc, isEmpty elseDoc) of
- (True, True) -> mempty
+ (True, True) -> Mon.mempty
(False, True) -> ppIfCondition c $$ nest indentWith thenDoc
(True, False) -> ppIfCondition (cNot c) $$ nest indentWith elseDoc
(False, False) -> (ppIfCondition c $$ nest indentWith thenDoc)
diff --git a/cabal/Cabal/Distribution/ParseUtils.hs b/cabal/Cabal/Distribution/ParseUtils.hs
index 62011f4..d3d649a 100644
--- a/cabal/Cabal/Distribution/ParseUtils.hs
+++ b/cabal/Cabal/Distribution/ParseUtils.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.ParseUtils
@@ -40,21 +39,17 @@ module Distribution.ParseUtils (
UnrecFieldParser, warnUnrec, ignoreUnrec,
) where
-import Distribution.Compiler (CompilerFlavor, parseCompilerFlavorCompat)
+import Distribution.Compiler
import Distribution.License
import Distribution.Version
- ( Version(..), VersionRange, anyVersion )
-import Distribution.Package ( PackageName(..), Dependency(..) )
-import Distribution.ModuleName (ModuleName)
+import Distribution.Package
+import Distribution.ModuleName
+import qualified Distribution.Compat.MonadFail as Fail
import Distribution.Compat.ReadP as ReadP hiding (get)
import Distribution.ReadE
import Distribution.Text
- ( Text(..) )
import Distribution.Simple.Utils
- ( comparing, dropWhileEndLE, intercalate, lowercase
- , normaliseLineEndings )
import Language.Haskell.Extension
- ( Language, Extension )
import Text.PrettyPrint hiding (braces)
import Data.Char (isSpace, toLower, isAlphaNum, isDigit)
@@ -62,9 +57,7 @@ import Data.Maybe (fromMaybe)
import Data.Tree as Tree (Tree(..), flatten)
import qualified Data.Map as Map
import Control.Monad (foldM, ap)
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative (Applicative(..))
-#endif
+import Control.Applicative as AP (Applicative(..))
import System.FilePath (normalise)
import Data.List (sortBy)
@@ -98,16 +91,19 @@ instance Functor ParseResult where
fmap f (ParseOk ws x) = ParseOk ws $ f x
instance Applicative ParseResult where
- pure = return
+ pure = ParseOk []
(<*>) = ap
instance Monad ParseResult where
- return = ParseOk []
+ return = AP.pure
ParseFailed err >>= _ = ParseFailed err
ParseOk ws x >>= f = case f x of
ParseFailed err -> ParseFailed err
ParseOk ws' x' -> ParseOk (ws'++ws) x'
+ fail = Fail.fail
+
+instance Fail.MonadFail ParseResult where
fail s = ParseFailed (FromString s Nothing)
catchParseError :: ParseResult a -> (PError -> ParseResult a)
@@ -660,8 +656,7 @@ parseVersionRangeQ = parseQuoted parse <++ parse
parseOptVersion :: ReadP r Version
parseOptVersion = parseQuoted ver <++ ver
where ver :: ReadP r Version
- ver = parse <++ return noVersion
- noVersion = Version [] []
+ ver = parse <++ return (Version [] [])
parseTestedWithQ :: ReadP r (CompilerFlavor,VersionRange)
parseTestedWithQ = parseQuoted tw <++ tw
diff --git a/cabal/Cabal/Distribution/Simple.hs b/cabal/Cabal/Distribution/Simple.hs
index 68eec9b..3937a56 100644
--- a/cabal/Cabal/Distribution/Simple.hs
+++ b/cabal/Cabal/Distribution/Simple.hs
@@ -56,64 +56,47 @@ module Distribution.Simple (
-- local
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.UserHooks
-import Distribution.Package --must not specify imports, since we're exporting module.
-import Distribution.PackageDescription
- ( PackageDescription(..), GenericPackageDescription, Executable(..)
- , updatePackageDescription, hasLibs
- , HookedBuildInfo, emptyHookedBuildInfo )
+import Distribution.Package
+import Distribution.PackageDescription hiding (Flag)
import Distribution.PackageDescription.Parse
- ( readPackageDescription, readHookedBuildInfo )
import Distribution.PackageDescription.Configuration
- ( flattenPackageDescription )
import Distribution.Simple.Program
- ( defaultProgramConfiguration, addKnownPrograms, builtinPrograms
- , restoreProgramConfiguration, reconfigurePrograms )
-import Distribution.Simple.PreProcess (knownSuffixHandlers, PPSuffixHandler)
+import Distribution.Simple.Program.Db
+import Distribution.Simple.PreProcess
import Distribution.Simple.Setup
import Distribution.Simple.Command
-import Distribution.Simple.Build ( build, repl )
-import Distribution.Simple.SrcDist ( sdist )
+import Distribution.Simple.Build
+import Distribution.Simple.SrcDist
import Distribution.Simple.Register
- ( register, unregister )
import Distribution.Simple.Configure
- ( getPersistBuildConfig, maybeGetPersistBuildConfig
- , writePersistBuildConfig, checkPersistBuildConfigOutdated
- , configure, checkForeignDeps, findDistPrefOrDefault )
-
-import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
-import Distribution.Simple.Bench (bench)
-import Distribution.Simple.BuildPaths ( srcPref)
-import Distribution.Simple.Test (test)
-import Distribution.Simple.Install (install)
-import Distribution.Simple.Haddock (haddock, hscolour)
+
+import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.Bench
+import Distribution.Simple.BuildPaths
+import Distribution.Simple.Test
+import Distribution.Simple.Install
+import Distribution.Simple.Haddock
import Distribution.Simple.Utils
- (die, notice, info, warn, setupMessage, chattyTry,
- defaultPackageDesc, defaultHookedPackageDesc,
- rawSystemExitWithEnv, cabalVersion, topHandler )
-import Distribution.System
- ( OS(..), buildOS )
+import Distribution.Utils.NubList
import Distribution.Verbosity
import Language.Haskell.Extension
import Distribution.Version
import Distribution.License
import Distribution.Text
- ( display )
-- Base
import System.Environment(getArgs, getProgName)
import System.Directory(removeFile, doesFileExist,
doesDirectoryExist, removeDirectoryRecursive)
import System.Exit (exitWith,ExitCode(..))
-import System.IO.Error (isDoesNotExistError)
-import Control.Exception (throwIO)
+import System.FilePath(searchPathSeparator)
import Distribution.Compat.Environment (getEnvironment)
-import Distribution.Compat.Exception (catchIO)
import Control.Monad (when)
import Data.Foldable (traverse_)
-import Data.List (intercalate, unionBy, nub, (\\))
+import Data.List (unionBy)
-- | A simple implementation of @main@ for a Cabal setup script.
-- It reads the package description file using IO, and performs the
@@ -322,7 +305,7 @@ copyAction hooks flags args = do
flags' = flags { copyDistPref = toFlag distPref }
hookedAction preCopy copyHook postCopy
(getBuildConfig hooks verbosity distPref)
- hooks flags' args
+ hooks flags' { copyArgs = args } args
installAction :: UserHooks -> InstallFlags -> Args -> IO ()
installAction hooks flags args = do
@@ -424,19 +407,15 @@ hookedActionWithArgs pre_hook cmd_hook post_hook get_build_config hooks flags ar
post_hook hooks args flags pkg_descr localbuildinfo
sanityCheckHookedBuildInfo :: PackageDescription -> HookedBuildInfo -> IO ()
-sanityCheckHookedBuildInfo PackageDescription { library = Nothing } (Just _,_)
- = die $ "The buildinfo contains info for a library, "
- ++ "but the package does not have a library."
-
-sanityCheckHookedBuildInfo pkg_descr (_, hookExes)
- | not (null nonExistant)
- = die $ "The buildinfo contains info for an executable called '"
- ++ head nonExistant ++ "' but the package does not have a "
- ++ "executable with that name."
+sanityCheckHookedBuildInfo pkg_descr hooked_bis
+ | not (null nonExistentComponents)
+ = die $ "The buildinfo contains info for these non-existent components:"
+ ++ intercalate ", " (map showComponentName nonExistentComponents)
where
- pkgExeNames = nub (map exeName (executables pkg_descr))
- hookExeNames = nub (map fst hookExes)
- nonExistant = hookExeNames \\ pkgExeNames
+ nonExistentComponents =
+ [ cname
+ | (cname, _) <- hooked_bis
+ , Nothing <- [lookupComponent pkg_descr cname] ]
sanityCheckHookedBuildInfo _ _ = return ()
@@ -470,9 +449,9 @@ getBuildConfig hooks verbosity distPref = do
-- Since the list of unconfigured programs is not serialized,
-- restore it to the same value as normally used at the beginning
-- of a configure run:
- configPrograms = restoreProgramConfiguration
+ configPrograms_ = restoreProgramConfiguration
(builtinPrograms ++ hookedPrograms hooks)
- (configPrograms cFlags),
+ `fmap` configPrograms_ cFlags,
-- Use the current, not saved verbosity level:
configVerbosity = Flag verbosity
@@ -587,12 +566,9 @@ autoconfUserHooks
= simpleUserHooks
{
postConf = defaultPostConf,
- preBuild = \_ flags ->
- -- not using 'readHook' here because 'build' takes
- -- extra args
- getHookedBuildInfo $ fromFlag $ buildVerbosity flags,
+ preBuild = readHookWithArgs buildVerbosity,
+ preCopy = readHookWithArgs copyVerbosity,
preClean = readHook cleanVerbosity,
- preCopy = readHook copyVerbosity,
preInst = readHook installVerbosity,
preHscolour = readHook hscolourVerbosity,
preHaddock = readHook haddockVerbosity,
@@ -616,6 +592,12 @@ autoconfUserHooks
backwardsCompatHack = False
+ readHookWithArgs :: (a -> Flag Verbosity) -> Args -> a -> IO HookedBuildInfo
+ readHookWithArgs get_verbosity _ flags = do
+ getHookedBuildInfo verbosity
+ where
+ verbosity = fromFlag (get_verbosity flags)
+
readHook :: (a -> Flag Verbosity) -> Args -> a -> IO HookedBuildInfo
readHook get_verbosity a flags = do
noExtraFlags a
@@ -626,7 +608,6 @@ autoconfUserHooks
runConfigureScript :: Verbosity -> Bool -> ConfigFlags -> LocalBuildInfo
-> IO ()
runConfigureScript verbosity backwardsCompatHack flags lbi = do
-
env <- getEnvironment
let programConfig = withPrograms lbi
(ccProg, ccFlags) <- configureCCompiler verbosity programConfig
@@ -636,32 +617,25 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
-- to ccFlags
-- We don't try and tell configure which ld to use, as we don't have
-- a way to pass its flags too
- let env' = appendToEnvironment ("CFLAGS", unwords ccFlags)
- env
- args' = args ++ ["--with-gcc=" ++ ccProg]
- handleNoWindowsSH $
- rawSystemExitWithEnv verbosity "sh" args' env'
+ let extraPath = fromNubList $ configProgramPathExtra flags
+ let cflagsEnv = maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags)) $ lookup "CFLAGS" env
+ spSep = [searchPathSeparator]
+ pathEnv = maybe (intercalate spSep extraPath) ((intercalate spSep extraPath ++ spSep)++) $ lookup "PATH" env
+ overEnv = ("CFLAGS", Just cflagsEnv) : [("PATH", Just pathEnv) | not (null extraPath)]
+ args' = args ++ ["CC=" ++ ccProg]
+ shProg = simpleProgram "sh"
+ progDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb
+ shConfiguredProg <- lookupProgram shProg `fmap` configureProgram verbosity shProg progDb
+ case shConfiguredProg of
+ Just sh -> runProgramInvocation verbosity (programInvocation (sh {programOverrideEnv = overEnv}) args')
+ Nothing -> die notFoundMsg
where
args = "./configure" : configureArgs backwardsCompatHack flags
- appendToEnvironment (key, val) [] = [(key, val)]
- appendToEnvironment (key, val) (kv@(k, v) : rest)
- | key == k = (key, v ++ " " ++ val) : rest
- | otherwise = kv : appendToEnvironment (key, val) rest
-
- handleNoWindowsSH action
- | buildOS /= Windows
- = action
-
- | otherwise
- = action
- `catchIO` \ioe -> if isDoesNotExistError ioe
- then die notFoundMsg
- else throwIO ioe
-
- notFoundMsg = "The package has a './configure' script. This requires a "
- ++ "Unix compatibility toolchain such as MinGW+MSYS or Cygwin."
+ notFoundMsg = "The package has a './configure' script. If you are on Windows, This requires a "
+ ++ "Unix compatibility toolchain such as MinGW+MSYS or Cygwin. "
+ ++ "If you are not on Windows, ensure that an 'sh' command is discoverable in your path."
getHookedBuildInfo :: Verbosity -> IO HookedBuildInfo
getHookedBuildInfo verbosity = do
@@ -714,6 +688,5 @@ defaultRegHook :: PackageDescription -> LocalBuildInfo
defaultRegHook pkg_descr localbuildinfo _ flags =
if hasLibs pkg_descr
then register pkg_descr localbuildinfo flags
- else setupMessage verbosity
+ else setupMessage (fromFlag (regVerbosity flags))
"Package contains no library to register:" (packageId pkg_descr)
- where verbosity = fromFlag (regVerbosity flags)
diff --git a/cabal/Cabal/Distribution/Simple/Bench.hs b/cabal/Cabal/Distribution/Simple/Bench.hs
index aceb238..f4f255a 100644
--- a/cabal/Cabal/Distribution/Simple/Bench.hs
+++ b/cabal/Cabal/Distribution/Simple/Bench.hs
@@ -16,22 +16,17 @@ module Distribution.Simple.Bench
) where
import qualified Distribution.PackageDescription as PD
- ( PackageDescription(..), BuildInfo(buildable)
- , Benchmark(..), BenchmarkInterface(..), benchmarkType, hasBenchmarks )
-import Distribution.Simple.BuildPaths ( exeExtension )
-import Distribution.Simple.Compiler ( compilerInfo )
+import Distribution.Simple.BuildPaths
+import Distribution.Simple.Compiler
import Distribution.Simple.InstallDirs
- ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)
- , substPathTemplate , toPathTemplate, PathTemplate )
import qualified Distribution.Simple.LocalBuildInfo as LBI
- ( LocalBuildInfo(..), localLibraryName )
-import Distribution.Simple.Setup ( BenchmarkFlags(..), fromFlag )
-import Distribution.Simple.UserHooks ( Args )
-import Distribution.Simple.Utils ( die, notice, rawSystemExitCode )
+import Distribution.Simple.Setup
+import Distribution.Simple.UserHooks
+import Distribution.Simple.Utils
import Distribution.Text
-import Control.Monad ( when, unless )
-import System.Exit ( ExitCode(..), exitFailure, exitWith )
+import Control.Monad ( when, unless, forM )
+import System.Exit ( ExitCode(..), exitFailure, exitSuccess )
import System.Directory ( doesFileExist )
import System.FilePath ( (</>), (<.>) )
@@ -78,9 +73,9 @@ bench args pkg_descr lbi flags = do
++ show (disp $ PD.benchmarkType bm)
exitFailure
- when (not $ PD.hasBenchmarks pkg_descr) $ do
+ unless (PD.hasBenchmarks pkg_descr) $ do
notice verbosity "Package has no benchmarks."
- exitWith ExitSuccess
+ exitSuccess
when (PD.hasBenchmarks pkg_descr && null enabledBenchmarks) $
die $ "No benchmarks enabled. Did you remember to configure with "
@@ -88,7 +83,7 @@ bench args pkg_descr lbi flags = do
bmsToRun <- case benchmarkNames of
[] -> return enabledBenchmarks
- names -> flip mapM names $ \bmName ->
+ names -> forM names $ \bmName ->
let benchmarkMap = zip enabledNames enabledBenchmarks
enabledNames = map PD.benchmarkName enabledBenchmarks
allNames = map PD.benchmarkName pkgBenchmarks
@@ -123,6 +118,6 @@ benchOption pkg_descr lbi bm template =
fromPathTemplate $ substPathTemplate env template
where
env = initialPathTemplateEnv
- (PD.package pkg_descr) (LBI.localLibraryName lbi)
+ (PD.package pkg_descr) (LBI.localUnitId lbi)
(compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi) ++
[(BenchmarkNameVar, toPathTemplate $ PD.benchmarkName bm)]
diff --git a/cabal/Cabal/Distribution/Simple/Build.hs b/cabal/Cabal/Distribution/Simple/Build.hs
index 61d73b8..9b3e3d6 100644
--- a/cabal/Cabal/Distribution/Simple/Build.hs
+++ b/cabal/Cabal/Distribution/Simple/Build.hs
@@ -23,6 +23,7 @@ module Distribution.Simple.Build (
writeAutogenFiles,
) where
+import Distribution.Package
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.JHC as JHC
@@ -32,66 +33,39 @@ import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import qualified Distribution.Simple.Build.Macros as Build.Macros
import qualified Distribution.Simple.Build.PathsModule as Build.PathsModule
+import qualified Distribution.Simple.Program.HcPkg as HcPkg
-import Distribution.Package
- ( Package(..), PackageName(..), PackageIdentifier(..)
- , Dependency(..), thisPackageVersion, PackageKey(..), packageName
- , LibraryName(..) )
-import Distribution.Simple.Compiler
- ( Compiler, CompilerFlavor(..), compilerFlavor
- , PackageDB(..), PackageDBStack )
-import Distribution.PackageDescription
- ( PackageDescription(..), BuildInfo(..), Library(..), Executable(..)
- , TestSuite(..), TestSuiteInterface(..), Benchmark(..)
- , BenchmarkInterface(..), allBuildInfo, defaultRenaming )
+import Distribution.Simple.Compiler hiding (Flag)
+import Distribution.PackageDescription hiding (Flag)
import qualified Distribution.InstalledPackageInfo as IPI
import qualified Distribution.ModuleName as ModuleName
-import Distribution.ModuleName (ModuleName)
import Distribution.Simple.Setup
- ( Flag(..), BuildFlags(..), ReplFlags(..), fromFlag )
import Distribution.Simple.BuildTarget
- ( BuildTarget(..), readBuildTargets )
import Distribution.Simple.PreProcess
- ( preprocessComponent, preprocessExtras, PPSuffixHandler )
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(compiler, buildDir, withPackageDB, withPrograms)
- , Component(..), componentName, getComponent, componentBuildInfo
- , ComponentLocalBuildInfo(..), pkgEnabledComponents
- , withComponentsInBuildOrder, componentsInBuildOrder
- , ComponentName(..), showComponentName
- , ComponentDisabledReason(..), componentDisabledReason
- , inplacePackageId )
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Db
-import qualified Distribution.Simple.Program.HcPkg as HcPkg
import Distribution.Simple.BuildPaths
- ( autogenModulesDir, autogenModuleName, cppHeaderName, exeExtension )
+import Distribution.Simple.Configure
import Distribution.Simple.Register
- ( registerPackage, inplaceInstalledPackageInfo )
-import Distribution.Simple.Test.LibV09 ( stubFilePath, stubName )
+import Distribution.Simple.Test.LibV09
import Distribution.Simple.Utils
- ( createDirectoryIfMissingVerbose, rewriteFile
- , die, info, debug, warn, setupMessage )
-import Distribution.Verbosity
- ( Verbosity )
+import Distribution.System
import Distribution.Text
- ( display )
+import Distribution.Verbosity
import qualified Data.Map as Map
import qualified Data.Set as Set
-import Data.Either
- ( partitionEithers )
import Data.List
- ( intersect, intercalate )
+ ( intersect )
import Control.Monad
- ( when, unless, forM_ )
+ ( when, unless )
import System.FilePath
( (</>), (<.>) )
import System.Directory
- ( getCurrentDirectory, removeDirectoryRecursive, removeFile
- , doesDirectoryExist, doesFileExist )
+ ( getCurrentDirectory )
-- -----------------------------------------------------------------------------
-- |Build the libraries and executables in this package.
@@ -107,26 +81,27 @@ build pkg_descr lbi flags suffixes = do
targets <- readBuildTargets pkg_descr (buildArgs flags)
targets' <- checkBuildTargets verbosity pkg_descr targets
- let componentsToBuild = map fst (componentsInBuildOrder lbi (map fst targets'))
+ let componentsToBuild = componentsInBuildOrder lbi (map fst targets')
info verbosity $ "Component build order: "
- ++ intercalate ", " (map showComponentName componentsToBuild)
+ ++ intercalate ", " (map (showComponentName . componentLocalName) componentsToBuild)
- initialBuildSteps distPref pkg_descr lbi verbosity
when (null targets) $
-- Only bother with this message if we're building the whole package
setupMessage verbosity "Building" (packageId pkg_descr)
internalPackageDB <- createInternalPackageDB verbosity lbi distPref
- withComponentsInBuildOrder pkg_descr lbi componentsToBuild $ \comp clbi ->
+ -- TODO: we're computing this twice, do it once!
+ withComponentsInBuildOrder pkg_descr lbi (map fst targets') $ \comp clbi -> do
+ initialBuildSteps distPref pkg_descr lbi clbi verbosity
let bi = componentBuildInfo comp
progs' = addInternalBuildTools pkg_descr lbi bi (withPrograms lbi)
lbi' = lbi {
withPrograms = progs',
withPackageDB = withPackageDB lbi ++ [internalPackageDB]
}
- in buildComponent verbosity (buildNumJobs flags) pkg_descr
- lbi' suffixes comp clbi distPref
+ buildComponent verbosity (buildNumJobs flags) pkg_descr
+ lbi' suffixes comp clbi distPref
repl :: PackageDescription -- ^ Mostly information from the .cabal file
@@ -149,9 +124,7 @@ repl pkg_descr lbi flags suffixes args = do
componentForRepl = last componentsToBuild
debug verbosity $ "Component build order: "
++ intercalate ", "
- [ showComponentName c | (c,_) <- componentsToBuild ]
-
- initialBuildSteps distPref pkg_descr lbi verbosity
+ [ showComponentName (componentLocalName clbi) | clbi <- componentsToBuild ]
internalPackageDB <- createInternalPackageDB verbosity lbi distPref
@@ -164,25 +137,30 @@ repl pkg_descr lbi flags suffixes args = do
-- build any dependent components
sequence_
- [ let comp = getComponent pkg_descr cname
- lbi' = lbiForComponent comp lbi
- in buildComponent verbosity NoFlag
- pkg_descr lbi' suffixes comp clbi distPref
- | (cname, clbi) <- init componentsToBuild ]
+ [ do let cname = componentLocalName clbi
+ comp = getComponent pkg_descr cname
+ lbi' = lbiForComponent comp lbi
+ initialBuildSteps distPref pkg_descr lbi clbi verbosity
+ buildComponent verbosity NoFlag
+ pkg_descr lbi' suffixes comp clbi distPref
+ | clbi <- init componentsToBuild ]
-- REPL for target components
- let (cname, clbi) = componentForRepl
+ let clbi = componentForRepl
+ cname = componentLocalName clbi
comp = getComponent pkg_descr cname
lbi' = lbiForComponent comp lbi
- in replComponent verbosity pkg_descr lbi' suffixes comp clbi distPref
+ initialBuildSteps distPref pkg_descr lbi clbi verbosity
+ replComponent verbosity pkg_descr lbi' suffixes comp clbi distPref
-- | Start an interpreter without loading any package files.
-startInterpreter :: Verbosity -> ProgramDb -> Compiler -> PackageDBStack -> IO ()
-startInterpreter verbosity programDb comp packageDBs =
+startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform
+ -> PackageDBStack -> IO ()
+startInterpreter verbosity programDb comp platform packageDBs =
case compilerFlavor comp of
- GHC -> GHC.startInterpreter verbosity programDb comp packageDBs
- GHCJS -> GHCJS.startInterpreter verbosity programDb comp packageDBs
+ GHC -> GHC.startInterpreter verbosity programDb comp platform packageDBs
+ GHCJS -> GHCJS.startInterpreter verbosity programDb comp platform packageDBs
_ -> die "A REPL is not supported with this compiler."
buildComponent :: Verbosity
@@ -196,9 +174,9 @@ buildComponent :: Verbosity
-> IO ()
buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CLib lib) clbi distPref = do
- preprocessComponent pkg_descr comp lbi False verbosity suffixes
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
- info verbosity "Building library..."
+ info verbosity $ "Building library " ++ libName lib ++ "..."
let libbi = libBuildInfo lib
lib' = lib { libBuildInfo = addExtraCSources libbi extras }
buildLib verbosity numJobs pkg_descr lbi lib' clbi
@@ -207,17 +185,15 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
-- on internally defined libraries.
pwd <- getCurrentDirectory
let -- The in place registration uses the "-inplace" suffix, not an ABI hash
- ipkgid = inplacePackageId (packageId installedPkgInfo)
installedPkgInfo = inplaceInstalledPackageInfo pwd distPref pkg_descr
- ipkgid lib' lbi clbi
+ (AbiHash "") lib' lbi clbi
- registerPackage verbosity
- installedPkgInfo pkg_descr lbi True -- True meaning in place
- (withPackageDB lbi)
+ registerPackage verbosity (compiler lbi) (withPrograms lbi) HcPkg.MultiInstance
+ (withPackageDB lbi) installedPkgInfo
buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CExe exe) clbi _ = do
- preprocessComponent pkg_descr comp lbi False verbosity suffixes
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
info verbosity $ "Building executable " ++ exeName exe ++ "..."
let ebi = buildInfo exe
@@ -229,7 +205,7 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CTest test@TestSuite { testInterface = TestSuiteExeV10{} })
clbi _distPref = do
let exe = testSuiteExeV10AsExe test
- preprocessComponent pkg_descr comp lbi False verbosity suffixes
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
info verbosity $ "Building test suite " ++ testName test ++ "..."
let ebi = buildInfo exe
@@ -249,11 +225,15 @@ buildComponent verbosity numJobs pkg_descr lbi0 suffixes
pwd <- getCurrentDirectory
let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) =
testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
- preprocessComponent pkg_descr comp lbi False verbosity suffixes
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
info verbosity $ "Building test suite " ++ testName test ++ "..."
buildLib verbosity numJobs pkg lbi lib libClbi
- registerPackage verbosity ipi pkg lbi True $ withPackageDB lbi
+ -- NB: need to enable multiple instances here, because on 7.10+
+ -- the package name is the same as the library, and we still
+ -- want the registration to go through.
+ registerPackage verbosity (compiler lbi) (withPrograms lbi) HcPkg.MultiInstance
+ (withPackageDB lbi) ipi
let ebi = buildInfo exe
exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' exeClbi
@@ -269,7 +249,7 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CBench bm@Benchmark { benchmarkInterface = BenchmarkExeV10 {} })
clbi _ = do
let (exe, exeClbi) = benchmarkExeV10asExe bm clbi
- preprocessComponent pkg_descr comp lbi False verbosity suffixes
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
info verbosity $ "Building benchmark " ++ benchmarkName bm ++ "..."
let ebi = buildInfo exe
@@ -302,7 +282,7 @@ replComponent :: Verbosity
-> IO ()
replComponent verbosity pkg_descr lbi suffixes
comp@(CLib lib) clbi _ = do
- preprocessComponent pkg_descr comp lbi False verbosity suffixes
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
let libbi = libBuildInfo lib
lib' = lib { libBuildInfo = libbi { cSources = cSources libbi ++ extras } }
@@ -310,7 +290,7 @@ replComponent verbosity pkg_descr lbi suffixes
replComponent verbosity pkg_descr lbi suffixes
comp@(CExe exe) clbi _ = do
- preprocessComponent pkg_descr comp lbi False verbosity suffixes
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
let ebi = buildInfo exe
exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }
@@ -321,7 +301,7 @@ replComponent verbosity pkg_descr lbi suffixes
comp@(CTest test@TestSuite { testInterface = TestSuiteExeV10{} })
clbi _distPref = do
let exe = testSuiteExeV10AsExe test
- preprocessComponent pkg_descr comp lbi False verbosity suffixes
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
let ebi = buildInfo exe
exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }
@@ -335,7 +315,7 @@ replComponent verbosity pkg_descr lbi0 suffixes
pwd <- getCurrentDirectory
let (pkg, lib, libClbi, lbi, _, _, _) =
testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
- preprocessComponent pkg_descr comp lbi False verbosity suffixes
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
let libbi = libBuildInfo lib
lib' = lib { libBuildInfo = libbi { cSources = cSources libbi ++ extras } }
@@ -352,7 +332,7 @@ replComponent verbosity pkg_descr lbi suffixes
comp@(CBench bm@Benchmark { benchmarkInterface = BenchmarkExeV10 {} })
clbi _ = do
let (exe, exeClbi) = benchmarkExeV10asExe bm clbi
- preprocessComponent pkg_descr comp lbi False verbosity suffixes
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
let ebi = buildInfo exe
exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }
@@ -397,6 +377,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
where
bi = testBuildInfo test
lib = Library {
+ libName = testName test,
exposedModules = [ m ],
reexportedModules = [],
requiredSignatures = [],
@@ -404,24 +385,29 @@ testSuiteLibV09AsLibAndExe pkg_descr
libExposed = True,
libBuildInfo = bi
}
+ -- This is, like, the one place where we use a CTestName for a library.
+ -- Should NOT use library name, since that could conflict!
+ PackageIdentifier pkg_name pkg_ver = package pkg_descr
+ compat_name = computeCompatPackageName pkg_name (CTestName (testName test))
+ compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi)
libClbi = LibComponentLocalBuildInfo
{ componentPackageDeps = componentPackageDeps clbi
- , componentPackageRenaming = componentPackageRenaming clbi
- , componentLibraryName = LibraryName (testName test)
- , componentExposedModules = [IPI.ExposedModule m Nothing Nothing]
- , componentPackageKey = OldPackageKey (PackageIdentifier (PackageName (testName test)) (pkgVersion (package pkg_descr)))
+ , componentLocalName = CLibName (testName test)
+ , componentIsPublic = False
+ , componentIncludes = componentIncludes clbi
+ , componentUnitId = componentUnitId clbi
+ , componentCompatPackageName = compat_name
+ , componentCompatPackageKey = compat_key
+ , componentExposedModules = [IPI.ExposedModule m Nothing]
}
pkg = pkg_descr {
- package = (package pkg_descr) {
- pkgName = PackageName (testName test)
- }
+ package = (package pkg_descr) { pkgName = compat_name }
, buildDepends = targetBuildDepends $ testBuildInfo test
, executables = []
, testSuites = []
- , library = Just lib
+ , libraries = [lib]
}
- ipkgid = inplacePackageId (packageId pkg)
- ipi = inplaceInstalledPackageInfo pwd distPref pkg ipkgid lib lbi libClbi
+ ipi = inplaceInstalledPackageInfo pwd distPref pkg (AbiHash "") lib lbi libClbi
testDir = buildDir lbi </> stubName test
</> stubName test ++ "-tmp"
testLibDep = thisPackageVersion $ package pkg
@@ -432,22 +418,22 @@ testSuiteLibV09AsLibAndExe pkg_descr
hsSourceDirs = [ testDir ],
targetBuildDepends = testLibDep
: (targetBuildDepends $ testBuildInfo test),
- targetBuildRenaming =
- Map.insert (packageName pkg) defaultRenaming
- (targetBuildRenaming $ testBuildInfo test)
+ targetBuildRenaming = Map.empty
}
}
-- | The stub executable needs a new 'ComponentLocalBuildInfo'
-- that exposes the relevant test suite library.
+ deps = (IPI.installedUnitId ipi, packageId ipi)
+ : (filter (\(_, x) -> let PackageName name = pkgName x
+ in name == "Cabal" || name == "base")
+ (componentPackageDeps clbi))
exeClbi = ExeComponentLocalBuildInfo {
- componentPackageDeps =
- (IPI.installedPackageId ipi, packageId ipi)
- : (filter (\(_, x) -> let PackageName name = pkgName x
- in name == "Cabal" || name == "base")
- (componentPackageDeps clbi)),
- componentPackageRenaming =
- Map.insert (packageName ipi) defaultRenaming
- (componentPackageRenaming clbi)
+ -- TODO: this is a hack, but as long as this is unique
+ -- (doesn't clobber something) we won't run into trouble
+ componentUnitId = mkUnitId (stubName test),
+ componentLocalName = CExeName (stubName test),
+ componentPackageDeps = deps,
+ componentIncludes = zip (map fst deps) (repeat defaultRenaming)
}
testSuiteLibV09AsLibAndExe _ TestSuite{} _ _ _ _ = error "testSuiteLibV09AsLibAndExe: wrong kind"
@@ -465,8 +451,10 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f }
buildInfo = benchmarkBuildInfo bm
}
exeClbi = ExeComponentLocalBuildInfo {
+ componentUnitId = componentUnitId clbi,
+ componentLocalName = CExeName (benchmarkName bm),
componentPackageDeps = componentPackageDeps clbi,
- componentPackageRenaming = componentPackageRenaming clbi
+ componentIncludes = componentIncludes clbi
}
benchmarkExeV10asExe Benchmark{} _ = error "benchmarkExeV10asExe: wrong kind"
@@ -475,24 +463,14 @@ benchmarkExeV10asExe Benchmark{} _ = error "benchmarkExeV10asExe: wrong kind"
createInternalPackageDB :: Verbosity -> LocalBuildInfo -> FilePath
-> IO PackageDB
createInternalPackageDB verbosity lbi distPref = do
- case compilerFlavor (compiler lbi) of
- GHC -> createWith $ GHC.hcPkgInfo (withPrograms lbi)
- GHCJS -> createWith $ GHCJS.hcPkgInfo (withPrograms lbi)
- LHC -> createWith $ LHC.hcPkgInfo (withPrograms lbi)
- _ -> return packageDB
- where
- dbPath = distPref </> "package.conf.inplace"
- packageDB = SpecificPackageDB dbPath
- createWith hpi = do
- dir_exists <- doesDirectoryExist dbPath
- if dir_exists
- then removeDirectoryRecursive dbPath
- else do file_exists <- doesFileExist dbPath
- when file_exists $ removeFile dbPath
- if HcPkg.useSingleFileDb hpi
- then writeFile dbPath "[]"
- else HcPkg.init hpi verbosity dbPath
- return packageDB
+ existsAlready <- doesPackageDBExist dbPath
+ when existsAlready $ deletePackageDB dbPath
+ createPackageDB verbosity (compiler lbi) (withPrograms lbi) False dbPath
+ return (SpecificPackageDB dbPath)
+ where
+ dbPath = case compilerFlavor (compiler lbi) of
+ UHC -> UHC.inplacePackageDbPath lbi
+ _ -> distPref </> "package.conf.inplace"
addInternalBuildTools :: PackageDescription -> LocalBuildInfo -> BuildInfo
-> ProgramDb -> ProgramDb
@@ -559,76 +537,33 @@ replExe verbosity pkg_descr lbi exe clbi =
initialBuildSteps :: FilePath -- ^"dist" prefix
-> PackageDescription -- ^mostly information from the .cabal file
-> LocalBuildInfo -- ^Configuration information
+ -> ComponentLocalBuildInfo
-> Verbosity -- ^The verbosity to use
-> IO ()
-initialBuildSteps _distPref pkg_descr lbi verbosity = do
+initialBuildSteps _distPref pkg_descr lbi clbi verbosity = do
-- check that there's something to build
unless (not . null $ allBuildInfo pkg_descr) $ do
let name = display (packageId pkg_descr)
die $ "No libraries, executables, tests, or benchmarks "
++ "are enabled for package " ++ name ++ "."
- createDirectoryIfMissingVerbose verbosity True (buildDir lbi)
+ createDirectoryIfMissingVerbose verbosity True (componentBuildDir lbi clbi)
- writeAutogenFiles verbosity pkg_descr lbi
+ writeAutogenFiles verbosity pkg_descr lbi clbi
-- | Generate and write out the Paths_<pkg>.hs and cabal_macros.h files
--
writeAutogenFiles :: Verbosity
-> PackageDescription
-> LocalBuildInfo
+ -> ComponentLocalBuildInfo
-> IO ()
-writeAutogenFiles verbosity pkg lbi = do
- createDirectoryIfMissingVerbose verbosity True (autogenModulesDir lbi)
+writeAutogenFiles verbosity pkg lbi clbi = do
+ createDirectoryIfMissingVerbose verbosity True (autogenModulesDir lbi clbi)
- let pathsModulePath = autogenModulesDir lbi
+ let pathsModulePath = autogenModulesDir lbi clbi
</> ModuleName.toFilePath (autogenModuleName pkg) <.> "hs"
- rewriteFile pathsModulePath (Build.PathsModule.generate pkg lbi)
-
- let cppHeaderPath = autogenModulesDir lbi </> cppHeaderName
- rewriteFile cppHeaderPath (Build.Macros.generate pkg lbi)
+ rewriteFile pathsModulePath (Build.PathsModule.generate pkg lbi clbi)
--- | Check that the given build targets are valid in the current context.
---
--- Also swizzle into a more convenient form.
---
-checkBuildTargets :: Verbosity -> PackageDescription -> [BuildTarget]
- -> IO [(ComponentName, Maybe (Either ModuleName FilePath))]
-checkBuildTargets _ pkg [] =
- return [ (componentName c, Nothing) | c <- pkgEnabledComponents pkg ]
-
-checkBuildTargets verbosity pkg targets = do
-
- let (enabled, disabled) =
- partitionEithers
- [ case componentDisabledReason (getComponent pkg cname) of
- Nothing -> Left target'
- Just reason -> Right (cname, reason)
- | target <- targets
- , let target'@(cname,_) = swizzleTarget target ]
-
- case disabled of
- [] -> return ()
- ((cname,reason):_) -> die $ formatReason (showComponentName cname) reason
-
- forM_ [ (c, t) | (c, Just t) <- enabled ] $ \(c, t) ->
- warn verbosity $ "Ignoring '" ++ either display id t ++ ". The whole "
- ++ showComponentName c ++ " will be built. (Support for "
- ++ "module and file targets has not been implemented yet.)"
-
- return enabled
-
- where
- swizzleTarget (BuildTargetComponent c) = (c, Nothing)
- swizzleTarget (BuildTargetModule c m) = (c, Just (Left m))
- swizzleTarget (BuildTargetFile c f) = (c, Just (Right f))
-
- formatReason cn DisabledComponent =
- "Cannot build the " ++ cn ++ " because the component is marked "
- ++ "as disabled in the .cabal file."
- formatReason cn DisabledAllTests =
- "Cannot build the " ++ cn ++ " because test suites are not "
- ++ "enabled. Run configure with the flag --enable-tests"
- formatReason cn DisabledAllBenchmarks =
- "Cannot build the " ++ cn ++ " because benchmarks are not "
- ++ "enabled. Re-run configure with the flag --enable-benchmarks"
+ let cppHeaderPath = autogenModulesDir lbi clbi </> cppHeaderName
+ rewriteFile cppHeaderPath (Build.Macros.generate pkg lbi clbi)
diff --git a/cabal/Cabal/Distribution/Simple/Build/Macros.hs b/cabal/Cabal/Distribution/Simple/Build/Macros.hs
index f0429cd..cc4c35d 100644
--- a/cabal/Cabal/Distribution/Simple/Build/Macros.hs
+++ b/cabal/Cabal/Distribution/Simple/Build/Macros.hs
@@ -22,24 +22,16 @@ module Distribution.Simple.Build.Macros (
generatePackageVersionMacros,
) where
-import Data.Maybe
- ( isJust )
import Distribution.Package
- ( PackageIdentifier(PackageIdentifier) )
import Distribution.Version
- ( Version(versionBranch) )
import Distribution.PackageDescription
- ( PackageDescription )
-import Distribution.Simple.Compiler
- ( packageKeySupported )
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(compiler, withPrograms), externalPackageDeps, localPackageKey )
import Distribution.Simple.Program.Db
- ( configuredPrograms )
import Distribution.Simple.Program.Types
- ( ConfiguredProgram(programId, programVersion) )
import Distribution.Text
- ( display )
+
+import Data.Maybe
+ ( isJust )
-- ------------------------------------------------------------
-- * Generate cabal_macros.h
@@ -47,12 +39,13 @@ import Distribution.Text
-- | The contents of the @cabal_macros.h@ for the given configured package.
--
-generate :: PackageDescription -> LocalBuildInfo -> String
-generate _pkg_descr lbi =
+generate :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String
+generate pkg_descr lbi clbi =
"/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" ++
- generatePackageVersionMacros (map snd (externalPackageDeps lbi)) ++
+ generatePackageVersionMacros
+ (package pkg_descr : map snd (componentPackageDeps clbi)) ++
generateToolVersionMacros (configuredPrograms . withPrograms $ lbi) ++
- generatePackageKeyMacro lbi
+ generateComponentIdMacro lbi clbi
-- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@
-- macros for a list of package ids (usually used with the specific deps of
@@ -84,10 +77,10 @@ generateToolVersionMacros progs = concat
-- 'generateToolVersionMacros'.
--
generateMacros :: String -> String -> Version -> String
-generateMacros prefix name version =
+generateMacros macro_prefix name version =
concat
- ["#define ", prefix, "VERSION_",name," ",show (display version),"\n"
- ,"#define MIN_", prefix, "VERSION_",name,"(major1,major2,minor) (\\\n"
+ ["#define ", macro_prefix, "VERSION_",name," ",show (display version),"\n"
+ ,"#define MIN_", macro_prefix, "VERSION_",name,"(major1,major2,minor) (\\\n"
," (major1) < ",major1," || \\\n"
," (major1) == ",major1," && (major2) < ",major2," || \\\n"
," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"
@@ -96,14 +89,19 @@ generateMacros prefix name version =
where
(major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
--- | Generate the @CURRENT_PACKAGE_KEY@ definition for the package key
--- of the current package, if supported by the compiler.
--- NB: this only makes sense for definite packages.
-generatePackageKeyMacro :: LocalBuildInfo -> String
-generatePackageKeyMacro lbi
- | packageKeySupported (compiler lbi) =
- "#define CURRENT_PACKAGE_KEY \"" ++ display (localPackageKey lbi) ++ "\"\n\n"
- | otherwise = ""
+-- | Generate the @CURRENT_COMPONENT_ID@ definition for the component ID
+-- of the current package.
+generateComponentIdMacro :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
+generateComponentIdMacro lbi clbi =
+ concat $
+ (case clbi of
+ LibComponentLocalBuildInfo{} ->
+ ["#define CURRENT_PACKAGE_KEY \"" ++ componentCompatPackageKey clbi ++ "\"\n"]
+ _ -> [])
+ ++
+ ["#define CURRENT_COMPONENT_ID \"" ++ display (componentComponentId clbi) ++ "\"\n"
+ ,"#define LOCAL_COMPONENT_ID \"" ++ display (localComponentId lbi) ++ "\"\n"
+ ,"\n"]
fixchar :: Char -> Char
fixchar '-' = '_'
diff --git a/cabal/Cabal/Distribution/Simple/Build/PathsModule.hs b/cabal/Cabal/Distribution/Simple/Build/PathsModule.hs
index 20ed4f1..73d2e42 100644
--- a/cabal/Cabal/Distribution/Simple/Build/PathsModule.hs
+++ b/cabal/Cabal/Distribution/Simple/Build/PathsModule.hs
@@ -19,25 +19,14 @@ module Distribution.Simple.Build.PathsModule (
) where
import Distribution.System
- ( OS(Windows), buildOS, Arch(..), buildArch )
import Distribution.Simple.Compiler
- ( CompilerFlavor(..), compilerFlavor, compilerVersion )
import Distribution.Package
- ( packageId, packageName, packageVersion )
import Distribution.PackageDescription
- ( PackageDescription(..), hasLibs )
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(..), InstallDirs(..)
- , absoluteInstallDirs, prefixRelativeInstallDirs )
-import Distribution.Simple.Setup ( CopyDest(NoCopyDest) )
import Distribution.Simple.BuildPaths
- ( autogenModuleName )
import Distribution.Simple.Utils
- ( shortRelativePath )
import Distribution.Text
- ( display )
import Distribution.Version
- ( Version(..), orLaterVersion, withinRange )
import System.FilePath
( pathSeparator )
@@ -48,11 +37,11 @@ import Data.Maybe
-- * Building Paths_<pkg>.hs
-- ------------------------------------------------------------
-generate :: PackageDescription -> LocalBuildInfo -> String
-generate pkg_descr lbi =
+generate :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String
+generate pkg_descr lbi clbi =
let pragmas = cpp_pragma ++ ffi_pragmas ++ warning_pragmas
- cpp_pragma | supports_cpp = "{-# LANGUAGE CPP #-}"
+ cpp_pragma | supports_cpp = "{-# LANGUAGE CPP #-}\n"
| otherwise = ""
ffi_pragmas
@@ -64,7 +53,8 @@ generate pkg_descr lbi =
"{-# OPTIONS_JHC -fffi #-}\n"
warning_pragmas =
- "{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}\n"
+ "{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}\n"++
+ "{-# OPTIONS_GHC -fno-warn-implicit-prelude #-}\n"
foreign_imports
| absolute = ""
@@ -179,6 +169,8 @@ generate pkg_descr lbi =
in header++body
where
+ cid = componentUnitId clbi
+
InstallDirs {
prefix = flat_prefix,
bindir = flat_bindir,
@@ -186,14 +178,14 @@ generate pkg_descr lbi =
datadir = flat_datadir,
libexecdir = flat_libexecdir,
sysconfdir = flat_sysconfdir
- } = absoluteInstallDirs pkg_descr lbi NoCopyDest
+ } = absoluteComponentInstallDirs pkg_descr lbi cid NoCopyDest
InstallDirs {
bindir = flat_bindirrel,
libdir = flat_libdirrel,
datadir = flat_datadirrel,
libexecdir = flat_libexecdirrel,
sysconfdir = flat_sysconfdirrel
- } = prefixRelativeInstallDirs (packageId pkg_descr) lbi
+ } = prefixRelativeComponentInstallDirs (packageId pkg_descr) lbi cid
flat_bindirreloc = shortRelativePath flat_prefix flat_bindir
flat_libdirreloc = shortRelativePath flat_prefix flat_libdir
diff --git a/cabal/Cabal/Distribution/Simple/BuildPaths.hs b/cabal/Cabal/Distribution/Simple/BuildPaths.hs
index 4ed5790..0025b78 100644
--- a/cabal/Cabal/Distribution/Simple/BuildPaths.hs
+++ b/cabal/Cabal/Distribution/Simple/BuildPaths.hs
@@ -31,21 +31,16 @@ module Distribution.Simple.BuildPaths (
) where
-import System.FilePath ((</>), (<.>))
-
import Distribution.Package
- ( packageName, LibraryName, getHSLibraryName )
-import Distribution.ModuleName (ModuleName)
-import qualified Distribution.ModuleName as ModuleName
+import Distribution.ModuleName as ModuleName
import Distribution.Compiler
- ( CompilerId(..) )
-import Distribution.PackageDescription (PackageDescription)
+import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(buildDir) )
-import Distribution.Simple.Setup (defaultDistPref)
+import Distribution.Simple.Setup
import Distribution.Text
- ( display )
-import Distribution.System (OS(..), buildOS)
+import Distribution.System
+
+import System.FilePath ((</>), (<.>))
-- ---------------------------------------------------------------------------
-- Build directories and files
@@ -61,8 +56,10 @@ haddockPref distPref pkg_descr
= distPref </> "doc" </> "html" </> display (packageName pkg_descr)
-- |The directory in which we put auto-generated modules
-autogenModulesDir :: LocalBuildInfo -> String
-autogenModulesDir lbi = buildDir lbi </> "autogen"
+autogenModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
+autogenModulesDir lbi clbi = componentBuildDir lbi clbi </> "autogen"
+-- NB: Look at 'checkForeignDeps' for where a simplified version of this
+-- has been copy-pasted.
cppHeaderName :: String
cppHeaderName = "cabal_macros.h"
@@ -81,16 +78,16 @@ haddockName pkg_descr = display (packageName pkg_descr) <.> "haddock"
-- ---------------------------------------------------------------------------
-- Library file names
-mkLibName :: LibraryName -> String
+mkLibName :: UnitId -> String
mkLibName lib = "lib" ++ getHSLibraryName lib <.> "a"
-mkProfLibName :: LibraryName -> String
+mkProfLibName :: UnitId -> String
mkProfLibName lib = "lib" ++ getHSLibraryName lib ++ "_p" <.> "a"
-- Implement proper name mangling for dynamical shared objects
-- libHS<packagename>-<compilerFlavour><compilerVersion>
-- e.g. libHSbase-2.1-ghc6.6.1.so
-mkSharedLibName :: CompilerId -> LibraryName -> String
+mkSharedLibName :: CompilerId -> UnitId -> String
mkSharedLibName (CompilerId compilerFlavor compilerVersion) lib
= "lib" ++ getHSLibraryName lib ++ "-" ++ comp <.> dllExtension
where comp = display compilerFlavor ++ display compilerVersion
@@ -99,15 +96,13 @@ mkSharedLibName (CompilerId compilerFlavor compilerVersion) lib
-- * Platform file extensions
-- ------------------------------------------------------------
--- ToDo: This should be determined via autoconf (AC_EXEEXT)
--- | Extension for executable files
+-- | Default extension for executable files on the current platform.
-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
exeExtension :: String
exeExtension = case buildOS of
Windows -> "exe"
_ -> ""
--- TODO: This should be determined via autoconf (AC_OBJEXT)
-- | Extension for object files. For GHC the extension is @\"o\"@.
objExtension :: String
objExtension = "o"
diff --git a/cabal/Cabal/Distribution/Simple/BuildTarget.hs b/cabal/Cabal/Distribution/Simple/BuildTarget.hs
index 821a1d2..aec56e6 100644
--- a/cabal/Cabal/Distribution/Simple/BuildTarget.hs
+++ b/cabal/Cabal/Distribution/Simple/BuildTarget.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.BuildTargets
@@ -14,10 +14,14 @@ module Distribution.Simple.BuildTarget (
-- * Build targets
BuildTarget(..),
readBuildTargets,
+ showBuildTarget,
+ QualLevel(..),
+ buildTargetComponentName,
-- * Parsing user build targets
UserBuildTarget,
readUserBuildTargets,
+ showUserBuildTarget,
UserBuildTargetProblem(..),
reportUserBuildTargetProblems,
@@ -25,44 +29,33 @@ module Distribution.Simple.BuildTarget (
resolveBuildTargets,
BuildTargetProblem(..),
reportBuildTargetProblems,
- ) where
-import Distribution.Package
- ( Package(..), PackageId, packageName )
+ -- * Checking build targets
+ checkBuildTargets
+ ) where
import Distribution.PackageDescription
- ( PackageDescription
- , Executable(..)
- , TestSuite(..), TestSuiteInterface(..), testModules
- , Benchmark(..), BenchmarkInterface(..), benchmarkModules
- , BuildInfo(..), libModules, exeModules )
import Distribution.ModuleName
- ( ModuleName, toFilePath )
import Distribution.Simple.LocalBuildInfo
- ( Component(..), ComponentName(..)
- , pkgComponents, componentName, componentBuildInfo )
-
import Distribution.Text
- ( display )
import Distribution.Simple.Utils
- ( die, lowercase, equating )
+import Distribution.Verbosity
+
+import Distribution.Compat.Binary (Binary)
+import qualified Distribution.Compat.ReadP as Parse
+import Distribution.Compat.ReadP
+ ( (+++), (<++) )
import Data.List
- ( nub, stripPrefix, sortBy, groupBy, partition, intercalate )
-import Data.Ord
+ ( nub, stripPrefix, sortBy, groupBy, partition )
import Data.Maybe
( listToMaybe, catMaybes )
import Data.Either
( partitionEithers )
+import GHC.Generics (Generic)
import qualified Data.Map as Map
import Control.Monad
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative (Applicative(..))
-#endif
-import Control.Applicative (Alternative(..))
-import qualified Distribution.Compat.ReadP as Parse
-import Distribution.Compat.ReadP
- ( (+++), (<++) )
+import Control.Applicative as AP (Alternative(..), Applicative(..))
import Data.Char
( isSpace, isAlphaNum )
import System.FilePath as FilePath
@@ -127,13 +120,19 @@ data BuildTarget =
-- | A specific file within a specific component.
--
| BuildTargetFile ComponentName FilePath
- deriving (Show,Eq)
+ deriving (Eq, Show, Generic)
+instance Binary BuildTarget
--- ------------------------------------------------------------
--- * Do everything
--- ------------------------------------------------------------
+buildTargetComponentName :: BuildTarget -> ComponentName
+buildTargetComponentName (BuildTargetComponent cn) = cn
+buildTargetComponentName (BuildTargetModule cn _) = cn
+buildTargetComponentName (BuildTargetFile cn _) = cn
+-- | Read a list of user-supplied build target strings and resolve them to
+-- 'BuildTarget's according to a 'PackageDescription'. If there are problems
+-- with any of the targets e.g. they don't exist or are misformatted, throw an
+-- 'IOException'.
readBuildTargets :: PackageDescription -> [String] -> IO [BuildTarget]
readBuildTargets pkg targetStrs = do
let (uproblems, utargets) = readUserBuildTargets targetStrs
@@ -226,11 +225,15 @@ reportUserBuildTargetProblems problems = do
++ " - build foo:Data/Foo.hsc -- file qualified by component"
showUserBuildTarget :: UserBuildTarget -> String
-showUserBuildTarget = intercalate ":" . components
+showUserBuildTarget = intercalate ":" . getComponents
where
- components (UserBuildTargetSingle s1) = [s1]
- components (UserBuildTargetDouble s1 s2) = [s1,s2]
- components (UserBuildTargetTriple s1 s2 s3) = [s1,s2,s3]
+ getComponents (UserBuildTargetSingle s1) = [s1]
+ getComponents (UserBuildTargetDouble s1 s2) = [s1,s2]
+ getComponents (UserBuildTargetTriple s1 s2 s3) = [s1,s2,s3]
+
+showBuildTarget :: QualLevel -> BuildTarget -> String
+showBuildTarget ql bt =
+ showUserBuildTarget (renderBuildTarget ql bt)
-- ------------------------------------------------------------
@@ -267,7 +270,7 @@ resolveBuildTarget pkg userTarget fexists =
Unambiguous target -> Right target
Ambiguous targets -> Left (BuildTargetAmbiguous userTarget targets')
where targets' = disambiguateBuildTargets
- (packageId pkg) userTarget
+ userTarget
targets
None errs -> Left (classifyMatchErrors errs)
@@ -291,9 +294,9 @@ data BuildTargetProblem
deriving Show
-disambiguateBuildTargets :: PackageId -> UserBuildTarget -> [BuildTarget]
+disambiguateBuildTargets :: UserBuildTarget -> [BuildTarget]
-> [(UserBuildTarget, BuildTarget)]
-disambiguateBuildTargets pkgid original =
+disambiguateBuildTargets original =
disambiguate (userTargetQualLevel original)
where
disambiguate ql ts
@@ -312,13 +315,13 @@ disambiguateBuildTargets pkgid original =
. partition (\g -> length g > 1)
. groupBy (equating fst)
. sortBy (comparing fst)
- . map (\t -> (renderBuildTarget ql t pkgid, t))
+ . map (\t -> (renderBuildTarget ql t, t))
data QualLevel = QL1 | QL2 | QL3
deriving (Enum, Show)
-renderBuildTarget :: QualLevel -> BuildTarget -> PackageId -> UserBuildTarget
-renderBuildTarget ql target pkgid =
+renderBuildTarget :: QualLevel -> BuildTarget -> UserBuildTarget
+renderBuildTarget ql target =
case ql of
QL1 -> UserBuildTargetSingle s1 where s1 = single target
QL2 -> UserBuildTargetDouble s1 s2 where (s1, s2) = double target
@@ -337,7 +340,7 @@ renderBuildTarget ql target pkgid =
triple (BuildTargetModule cn m) = (dispKind cn, dispCName cn, display m)
triple (BuildTargetFile cn f) = (dispKind cn, dispCName cn, f)
- dispCName = componentStringName pkgid
+ dispCName = componentStringName
dispKind = showComponentKindShort . componentKind
reportBuildTargetProblems :: [BuildTargetProblem] -> IO ()
@@ -440,7 +443,7 @@ pkgComponentInfo :: PackageDescription -> [ComponentInfo]
pkgComponentInfo pkg =
[ ComponentInfo {
cinfoName = componentName c,
- cinfoStrName = componentStringName pkg (componentName c),
+ cinfoStrName = componentStringName (componentName c),
cinfoSrcDirs = hsSourceDirs bi,
cinfoModules = componentModules c,
cinfoHsFiles = componentHsFiles c,
@@ -450,11 +453,11 @@ pkgComponentInfo pkg =
| c <- pkgComponents pkg
, let bi = componentBuildInfo c ]
-componentStringName :: Package pkg => pkg -> ComponentName -> ComponentStringName
-componentStringName pkg CLibName = display (packageName pkg)
-componentStringName _ (CExeName name) = name
-componentStringName _ (CTestName name) = name
-componentStringName _ (CBenchName name) = name
+componentStringName :: ComponentName -> ComponentStringName
+componentStringName (CLibName name) = name
+componentStringName (CExeName name) = name
+componentStringName (CTestName name) = name
+componentStringName (CBenchName name) = name
componentModules :: Component -> [ModuleName]
componentModules (CLib lib) = libModules lib
@@ -494,8 +497,8 @@ data ComponentKind = LibKind | ExeKind | TestKind | BenchKind
deriving (Eq, Ord, Show)
componentKind :: ComponentName -> ComponentKind
-componentKind CLibName = LibKind
-componentKind (CExeName _) = ExeKind
+componentKind (CLibName _) = LibKind
+componentKind (CExeName _) = ExeKind
componentKind (CTestName _) = TestKind
componentKind (CBenchName _) = BenchKind
@@ -798,11 +801,12 @@ instance Functor Match where
fmap f (InexactMatch d xs) = InexactMatch d (fmap f xs)
instance Applicative Match where
- pure = return
+ pure a = ExactMatch 0 [a]
(<*>) = ap
instance Monad Match where
- return a = ExactMatch 0 [a]
+ return = AP.pure
+
NoMatch d ms >>= _ = NoMatch d ms
ExactMatch d xs >>= f = addDepth d
$ foldr matchPlus matchZero (map f xs)
@@ -937,3 +941,49 @@ matchInexactly cannonicalise xs =
caseFold :: String -> String
caseFold = lowercase
+
+
+-- | Check that the given build targets are valid in the current context.
+--
+-- Also swizzle into a more convenient form.
+--
+checkBuildTargets :: Verbosity -> PackageDescription -> [BuildTarget]
+ -> IO [(ComponentName, Maybe (Either ModuleName FilePath))]
+checkBuildTargets _ pkg [] =
+ return [ (componentName c, Nothing) | c <- pkgEnabledComponents pkg ]
+
+checkBuildTargets verbosity pkg targets = do
+
+ let (enabled, disabled) =
+ partitionEithers
+ [ case componentDisabledReason (getComponent pkg cname) of
+ Nothing -> Left target'
+ Just reason -> Right (cname, reason)
+ | target <- targets
+ , let target'@(cname,_) = swizzleTarget target ]
+
+ case disabled of
+ [] -> return ()
+ ((cname,reason):_) -> die $ formatReason (showComponentName cname) reason
+
+ forM_ [ (c, t) | (c, Just t) <- enabled ] $ \(c, t) ->
+ warn verbosity $ "Ignoring '" ++ either display id t ++ ". The whole "
+ ++ showComponentName c ++ " will be processed. (Support for "
+ ++ "module and file targets has not been implemented yet.)"
+
+ return enabled
+
+ where
+ swizzleTarget (BuildTargetComponent c) = (c, Nothing)
+ swizzleTarget (BuildTargetModule c m) = (c, Just (Left m))
+ swizzleTarget (BuildTargetFile c f) = (c, Just (Right f))
+
+ formatReason cn DisabledComponent =
+ "Cannot process the " ++ cn ++ " because the component is marked "
+ ++ "as disabled in the .cabal file."
+ formatReason cn DisabledAllTests =
+ "Cannot process the " ++ cn ++ " because test suites are not "
+ ++ "enabled. Run configure with the flag --enable-tests"
+ formatReason cn DisabledAllBenchmarks =
+ "Cannot process the " ++ cn ++ " because benchmarks are not "
+ ++ "enabled. Re-run configure with the flag --enable-benchmarks"
diff --git a/cabal/Cabal/Distribution/Simple/CCompiler.hs b/cabal/Cabal/Distribution/Simple/CCompiler.hs
index b33417a..a58923b 100644
--- a/cabal/Cabal/Distribution/Simple/CCompiler.hs
+++ b/cabal/Cabal/Distribution/Simple/CCompiler.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.CCompiler
@@ -47,10 +46,8 @@ module Distribution.Simple.CCompiler (
filenameCDialect
) where
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid
- ( Monoid(..) )
-#endif
+import Distribution.Compat.Semigroup as Semi
+
import System.FilePath
( takeExtension )
@@ -66,15 +63,16 @@ data CDialect = C
instance Monoid CDialect where
mempty = C
-
- mappend C anything = anything
- mappend ObjectiveC CPlusPlus = ObjectiveCPlusPlus
- mappend CPlusPlus ObjectiveC = ObjectiveCPlusPlus
- mappend _ ObjectiveCPlusPlus = ObjectiveCPlusPlus
- mappend ObjectiveC _ = ObjectiveC
- mappend CPlusPlus _ = CPlusPlus
- mappend ObjectiveCPlusPlus _ = ObjectiveCPlusPlus
-
+ mappend = (Semi.<>)
+
+instance Semigroup CDialect where
+ C <> anything = anything
+ ObjectiveC <> CPlusPlus = ObjectiveCPlusPlus
+ CPlusPlus <> ObjectiveC = ObjectiveCPlusPlus
+ _ <> ObjectiveCPlusPlus = ObjectiveCPlusPlus
+ ObjectiveC <> _ = ObjectiveC
+ CPlusPlus <> _ = CPlusPlus
+ ObjectiveCPlusPlus <> _ = ObjectiveCPlusPlus
-- | A list of all file extensions which are recognized as possibly containing
-- some dialect of C code. Note that this list is only for source files,
diff --git a/cabal/Cabal/Distribution/Simple/Command.hs b/cabal/Cabal/Distribution/Simple/Command.hs
index 0ae2753..deb7e93 100644
--- a/cabal/Cabal/Distribution/Simple/Command.hs
+++ b/cabal/Cabal/Distribution/Simple/Command.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE ExistentialQuantification #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Command
@@ -6,7 +6,7 @@
-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
--- Portability : portable
+-- Portability : non-portable (ExistentialQuantification)
--
-- This is to do with command line handling. The Cabal command line is
-- organised into a number of named sub-commands (much like darcs). The
@@ -38,6 +38,11 @@ module Distribution.Simple.Command (
commandAddAction,
noExtraFlags,
+ -- ** Building lists of commands
+ CommandType(..),
+ CommandSpec(..),
+ commandFromSpec,
+
-- ** Running commands
commandsRun,
@@ -60,19 +65,17 @@ module Distribution.Simple.Command (
) where
-import Control.Monad
-import Data.Char (isAlpha, toLower)
-import Data.List (sortBy)
-import Data.Maybe
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid
-#endif
import qualified Distribution.GetOpt as GetOpt
import Distribution.Text
- ( Text(disp, parse) )
import Distribution.ParseUtils
import Distribution.ReadE
-import Distribution.Simple.Utils (die, intercalate)
+import Distribution.Simple.Utils
+
+import Control.Monad
+import Data.Char (isAlpha, toLower)
+import Data.List (sortBy)
+import Data.Maybe
+import Data.Monoid as Mon
import Text.PrettyPrint ( punctuate, cat, comma, text )
import Text.PrettyPrint as PP ( empty )
@@ -171,7 +174,7 @@ reqArg' ad mkflag showflag =
reqArg ad (succeedReadE mkflag) showflag
-- | (String -> a) variant of "optArg"
-optArg' :: Monoid b => ArgPlaceHolder -> (Maybe String -> b)
+optArg' :: Mon.Monoid b => ArgPlaceHolder -> (Maybe String -> b)
-> (b -> [Maybe String])
-> MkOptDescr (a -> b) (b -> a -> a) a
optArg' ad mkflag showflag =
@@ -605,3 +608,13 @@ helpCommandUI =
++ " " ++ pname ++ " help help\n"
++ " Oh, appararently you already know this.\n"
}
+
+-- | wraps a @CommandUI@ together with a function that turns it into a @Command@.
+-- By hiding the type of flags for the UI allows construction of a list of all UIs at the
+-- top level of the program. That list can then be used for generation of manual page
+-- as well as for executing the selected command.
+data CommandSpec action
+ = forall flags. CommandSpec (CommandUI flags) (CommandUI flags -> Command action) CommandType
+
+commandFromSpec :: CommandSpec a -> Command a
+commandFromSpec (CommandSpec ui action _) = action ui
diff --git a/cabal/Cabal/Distribution/Simple/Compiler.hs b/cabal/Cabal/Distribution/Simple/Compiler.hs
index f217d73..7274775 100644
--- a/cabal/Cabal/Distribution/Simple/Compiler.hs
+++ b/cabal/Cabal/Distribution/Simple/Compiler.hs
@@ -53,22 +53,25 @@ module Distribution.Simple.Compiler (
parmakeSupported,
reexportedModulesSupported,
renamingPackageFlagsSupported,
+ unifiedIPIDRequired,
packageKeySupported,
+ unitIdSupported,
-- * Support for profiling detail levels
ProfDetailLevel(..),
knownProfDetailLevels,
flagToProfDetailLevel,
+ showProfDetailLevel,
) where
import Distribution.Compiler
-import Distribution.Version (Version(..))
-import Distribution.Text (display)
-import Language.Haskell.Extension (Language(Haskell98), Extension)
-import Distribution.Simple.Utils (lowercase)
+import Distribution.Version
+import Distribution.Text
+import Language.Haskell.Extension
+import Distribution.Simple.Utils
+import Distribution.Compat.Binary
import Control.Monad (liftM)
-import Distribution.Compat.Binary (Binary)
import Data.List (nub)
import qualified Data.Map as M (Map, lookup)
import Data.Maybe (catMaybes, isNothing, listToMaybe)
@@ -89,7 +92,7 @@ data Compiler = Compiler {
compilerProperties :: M.Map String String
-- ^ A key-value map for properties not covered by the above fields.
}
- deriving (Generic, Show, Read)
+ deriving (Eq, Generic, Show, Read)
instance Binary Compiler
@@ -276,10 +279,18 @@ reexportedModulesSupported = ghcSupported "Support reexported-modules"
renamingPackageFlagsSupported :: Compiler -> Bool
renamingPackageFlagsSupported = ghcSupported "Support thinning and renaming package flags"
+-- | Does this compiler have unified IPIDs (so no package keys)
+unifiedIPIDRequired :: Compiler -> Bool
+unifiedIPIDRequired = ghcSupported "Requires unified installed package IDs"
+
-- | Does this compiler support package keys?
packageKeySupported :: Compiler -> Bool
packageKeySupported = ghcSupported "Uses package keys"
+-- | Does this compiler support unit IDs?
+unitIdSupported :: Compiler -> Bool
+unitIdSupported = ghcSupported "Uses unit IDs"
+
-- | Utility function for GHC only features
ghcSupported :: String -> Compiler -> Bool
ghcSupported key comp =
@@ -332,3 +343,12 @@ knownProfDetailLevels =
, ("all-functions", ["all"], ProfDetailAllFunctions)
]
+showProfDetailLevel :: ProfDetailLevel -> String
+showProfDetailLevel dl = case dl of
+ ProfDetailNone -> "none"
+ ProfDetailDefault -> "default"
+ ProfDetailExportedFunctions -> "exported-functions"
+ ProfDetailToplevelFunctions -> "toplevel-functions"
+ ProfDetailAllFunctions -> "all-functions"
+ ProfDetailOther other -> other
+
diff --git a/cabal/Cabal/Distribution/Simple/Configure.hs b/cabal/Cabal/Distribution/Simple/Configure.hs
index 644a019..1c7a58a 100644
--- a/cabal/Cabal/Distribution/Simple/Configure.hs
+++ b/cabal/Cabal/Distribution/Simple/Configure.hs
@@ -1,10 +1,9 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
-#if __GLASGOW_HASKELL__ >= 711
-{-# LANGUAGE PatternSynonyms #-}
-#endif
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE NoMonoLocalBinds #-}
-----------------------------------------------------------------------------
-- |
@@ -37,8 +36,13 @@ module Distribution.Simple.Configure (configure,
tryGetPersistBuildConfig,
maybeGetPersistBuildConfig,
findDistPref, findDistPrefOrDefault,
+ computeComponentId,
+ computeCompatPackageKey,
+ computeCompatPackageName,
localBuildInfoFile,
- getInstalledPackages, getPackageDBContents,
+ getInstalledPackages,
+ getInstalledPackagesMonitorFiles,
+ getPackageDBContents,
configCompiler, configCompilerAux,
configCompilerEx, configCompilerAuxEx,
ccLdOptionsBuildInfo,
@@ -47,73 +51,32 @@ module Distribution.Simple.Configure (configure,
ConfigStateFileError(..),
tryGetConfigStateFile,
platformDefines,
+ relaxPackageDeps,
)
where
import Distribution.Compiler
- ( CompilerId(..) )
import Distribution.Utils.NubList
-import Distribution.Simple.Compiler
- ( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion
- , compilerInfo, ProfDetailLevel(..), knownProfDetailLevels
- , showCompilerId, unsupportedLanguages, unsupportedExtensions
- , PackageDB(..), PackageDBStack, reexportedModulesSupported
- , packageKeySupported, renamingPackageFlagsSupported )
-import Distribution.Simple.PreProcess ( platformDefines )
+import Distribution.Simple.Compiler hiding (Flag)
+import Distribution.Simple.PreProcess
import Distribution.Package
- ( PackageName(PackageName), PackageIdentifier(..), PackageId
- , packageName, packageVersion, Package(..)
- , Dependency(Dependency), simplifyDependency
- , InstalledPackageId(..), thisPackageVersion
- , mkPackageKey, packageKeyLibraryName )
import qualified Distribution.InstalledPackageInfo as Installed
-import Distribution.InstalledPackageInfo (InstalledPackageInfo, emptyInstalledPackageInfo)
+import Distribution.InstalledPackageInfo (InstalledPackageInfo
+ ,emptyInstalledPackageInfo)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
-import Distribution.PackageDescription as PD
- ( PackageDescription(..), specVersion, GenericPackageDescription(..)
- , Library(..), hasLibs, Executable(..), BuildInfo(..), allExtensions
- , HookedBuildInfo, updatePackageDescription, allBuildInfo
- , Flag(flagName), FlagName(..), TestSuite(..), Benchmark(..)
- , ModuleReexport(..) , defaultRenaming )
+import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.ModuleName
- ( ModuleName )
import Distribution.PackageDescription.Configuration
- ( finalizePackageDescription, mapTreeData )
-import Distribution.PackageDescription.Check
- ( PackageCheck(..), checkPackage, checkPackageFiles )
+import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.Simple.Program
- ( Program(..), ProgramLocation(..), ConfiguredProgram(..)
- , ProgramConfiguration, defaultProgramConfiguration
- , ProgramSearchPathEntry(..), getProgramSearchPath, setProgramSearchPath
- , configureAllKnownPrograms, knownPrograms, lookupKnownProgram
- , userSpecifyArgss, userSpecifyPaths
- , lookupProgram, requireProgram, requireProgramVersion
- , pkgConfigProgram, gccProgram, rawSystemProgramStdoutConf )
import Distribution.Simple.Setup as Setup
- ( ConfigFlags(..), CopyDest(..), Flag(..), defaultDistPref
- , fromFlag, fromFlagOrDefault, flagToMaybe, toFlag )
-import Distribution.Simple.InstallDirs
- ( InstallDirs(..), defaultInstallDirs, combineInstallDirs )
+import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(..), Component(..), ComponentLocalBuildInfo(..)
- , absoluteInstallDirs, prefixRelativeInstallDirs, inplacePackageId
- , ComponentName(..), showComponentName, pkgEnabledComponents
- , componentBuildInfo, componentName, checkComponentsCyclic )
-import Distribution.Simple.BuildPaths
- ( autogenModulesDir )
import Distribution.Simple.Utils
- ( die, warn, info, setupMessage
- , createDirectoryIfMissingVerbose, moreRecentFile
- , intercalate, cabalVersion
- , writeFileAtomic
- , withTempFile )
import Distribution.System
- ( OS(..), buildOS, Platform (..), buildPlatform )
import Distribution.Version
- ( Version(..), anyVersion, orLaterVersion, withinRange, isAnyVersion )
import Distribution.Verbosity
- ( Verbosity, lessVerbose )
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
@@ -126,33 +89,29 @@ import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import Prelude hiding ( mapM )
import Control.Exception
( Exception, evaluate, throw, throwIO, try )
-#if __GLASGOW_HASKELL__ >= 711
-import Control.Exception ( pattern ErrorCall )
-#else
-import Control.Exception ( ErrorCall(..) )
-#endif
+import Control.Exception ( ErrorCall )
import Control.Monad
- ( liftM, when, unless, foldM, filterM )
+ ( liftM, when, unless, foldM, filterM, mplus )
import Distribution.Compat.Binary ( decodeOrFailIO, encode )
+import GHC.Fingerprint ( Fingerprint(..), fingerprintString )
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as BLC8
import Data.List
( (\\), nub, partition, isPrefixOf, inits, stripPrefix )
import Data.Maybe
- ( isNothing, catMaybes, fromMaybe, isJust )
+ ( isNothing, catMaybes, fromMaybe, mapMaybe, isJust )
import Data.Either
( partitionEithers )
import qualified Data.Set as Set
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid
- ( Monoid(..) )
-#endif
+import Data.Monoid as Mon ( Monoid(..) )
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Traversable
( mapM )
import Data.Typeable
+import Data.Char ( chr, isAlphaNum )
+import Numeric ( showIntAtBase )
import System.Directory
( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )
import System.FilePath
@@ -162,47 +121,54 @@ import qualified System.Info
import System.IO
( hPutStrLn, hClose )
import Distribution.Text
- ( Text(disp), display, simpleParse )
+ ( Text(disp), defaultStyle, display, simpleParse )
import Text.PrettyPrint
- ( render, (<>), ($+$), char, text, comma
- , quotes, punctuate, nest, sep, hsep )
+ ( Doc, (<>), (<+>), ($+$), char, comma, empty, hsep, nest
+ , punctuate, quotes, render, renderStyle, sep, text )
import Distribution.Compat.Environment ( lookupEnv )
import Distribution.Compat.Exception ( catchExit, catchIO )
+import Data.Graph (graphFromEdges, topSort)
+
-- | The errors that can be thrown when reading the @setup-config@ file.
data ConfigStateFileError
= ConfigStateFileNoHeader -- ^ No header found.
| ConfigStateFileBadHeader -- ^ Incorrect header.
| ConfigStateFileNoParse -- ^ Cannot parse file contents.
| ConfigStateFileMissing -- ^ No file!
- | ConfigStateFileBadVersion PackageIdentifier PackageIdentifier (Either ConfigStateFileError LocalBuildInfo) -- ^ Mismatched version.
+ | ConfigStateFileBadVersion PackageIdentifier PackageIdentifier
+ (Either ConfigStateFileError LocalBuildInfo) -- ^ Mismatched version.
deriving (Typeable)
+-- | Format a 'ConfigStateFileError' as a user-facing error message.
+dispConfigStateFileError :: ConfigStateFileError -> Doc
+dispConfigStateFileError ConfigStateFileNoHeader =
+ text "Saved package config file header is missing."
+ <+> text "Re-run the 'configure' command."
+dispConfigStateFileError ConfigStateFileBadHeader =
+ text "Saved package config file header is corrupt."
+ <+> text "Re-run the 'configure' command."
+dispConfigStateFileError ConfigStateFileNoParse =
+ text "Saved package config file is corrupt."
+ <+> text "Re-run the 'configure' command."
+dispConfigStateFileError ConfigStateFileMissing =
+ text "Run the 'configure' command first."
+dispConfigStateFileError (ConfigStateFileBadVersion oldCabal oldCompiler _) =
+ text "Saved package config file is outdated:"
+ $+$ badCabal $+$ badCompiler
+ $+$ text "Re-run the 'configure' command."
+ where
+ badCabal =
+ text "• the Cabal version changed from"
+ <+> disp oldCabal <+> "to" <+> disp currentCabalId
+ badCompiler
+ | oldCompiler == currentCompilerId = empty
+ | otherwise =
+ text "• the compiler changed from"
+ <+> disp oldCompiler <+> "to" <+> disp currentCompilerId
+
instance Show ConfigStateFileError where
- show ConfigStateFileNoHeader =
- "Saved package config file header is missing. "
- ++ "Try re-running the 'configure' command."
- show ConfigStateFileBadHeader =
- "Saved package config file header is corrupt. "
- ++ "Try re-running the 'configure' command."
- show ConfigStateFileNoParse =
- "Saved package config file body is corrupt. "
- ++ "Try re-running the 'configure' command."
- show ConfigStateFileMissing = "Run the 'configure' command first."
- show (ConfigStateFileBadVersion oldCabal oldCompiler _) =
- "You need to re-run the 'configure' command. "
- ++ "The version of Cabal being used has changed (was "
- ++ display oldCabal ++ ", now "
- ++ display currentCabalId ++ ")."
- ++ badCompiler
- where
- badCompiler
- | oldCompiler == currentCompilerId = ""
- | otherwise =
- " Additionally the compiler is different (was "
- ++ display oldCompiler ++ ", now "
- ++ display currentCompilerId
- ++ ") which is probably the cause of the problem."
+ show = renderStyle defaultStyle . dispConfigStateFileError
instance Exception ConfigStateFileError
@@ -222,7 +188,7 @@ getConfigStateFile filename = do
headerParseResult <- try $ evaluate $ parseHeader header
let (cabalId, compId) =
case headerParseResult of
- Left (ErrorCall _) -> throw ConfigStateFileBadHeader
+ Left (_ :: ErrorCall) -> throw ConfigStateFileBadHeader
Right x -> x
let getStoredValue = do
@@ -237,7 +203,8 @@ getConfigStateFile filename = do
| otherwise = act
deferErrorIfBadVersion getStoredValue
--- | Read the 'localBuildInfoFile', returning either an error or the local build info.
+-- | Read the 'localBuildInfoFile', returning either an error or the local build
+-- info.
tryGetConfigStateFile :: FilePath -- ^ The file path of the @setup-config@ file.
-> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetConfigStateFile = try . getConfigStateFile
@@ -281,12 +248,13 @@ currentCompilerId :: PackageIdentifier
currentCompilerId = PackageIdentifier (PackageName System.Info.compilerName)
System.Info.compilerVersion
--- | Parse the @setup-config@ file header, returning the package identifiers
+-- | Parse the @setup-config@ file header, returning the package identifiers
-- for Cabal and the compiler.
parseHeader :: ByteString -- ^ The file contents.
-> (PackageIdentifier, PackageIdentifier)
parseHeader header = case BLC8.words header of
- ["Saved", "package", "config", "for", pkgId, "written", "by", cabalId, "using", compId] ->
+ ["Saved", "package", "config", "for", pkgId, "written", "by", cabalId,
+ "using", compId] ->
fromMaybe (throw ConfigStateFileBadHeader) $ do
_ <- simpleParse (BLC8.unpack pkgId) :: Maybe PackageIdentifier
cabalId' <- simpleParse (BLC8.unpack cabalId)
@@ -321,9 +289,9 @@ localBuildInfoFile distPref = distPref </> "setup-config"
-- * Configuration
-- -----------------------------------------------------------------------------
--- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken from
--- (in order of highest to lowest preference) the override prefix, the \"CABAL_BUILDDIR\"
--- environment variable, or the default prefix.
+-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken
+-- from (in order of highest to lowest preference) the override prefix, the
+-- \"CABAL_BUILDDIR\" environment variable, or the default prefix.
findDistPref :: FilePath -- ^ default \"dist\" prefix
-> Setup.Flag FilePath -- ^ override \"dist\" prefix
-> IO FilePath
@@ -336,11 +304,12 @@ findDistPref defDistPref overrideDistPref = do
Just distPref | not (null distPref) -> toFlag distPref
_ -> NoFlag
--- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken from
--- (in order of highest to lowest preference) the override prefix, the \"CABAL_BUILDDIR\"
--- environment variable, or 'defaultDistPref' is used. Call this function to resolve a
--- @*DistPref@ flag whenever it is not known to be set. (The @*DistPref@ flags are always
--- set to a definite value before invoking 'UserHooks'.)
+-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken
+-- from (in order of highest to lowest preference) the override prefix, the
+-- \"CABAL_BUILDDIR\" environment variable, or 'defaultDistPref' is used. Call
+-- this function to resolve a @*DistPref@ flag whenever it is not known to be
+-- set. (The @*DistPref@ flags are always set to a definite value before
+-- invoking 'UserHooks'.)
findDistPrefOrDefault :: Setup.Flag FilePath -- ^ override \"dist\" prefix
-> IO FilePath
findDistPrefOrDefault = findDistPref defaultDistPref
@@ -349,448 +318,424 @@ findDistPrefOrDefault = findDistPref defaultDistPref
-- Returns the @.setup-config@ file.
configure :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
-configure (pkg_descr0, pbi) cfg
- = do let distPref = fromFlag (configDistPref cfg)
- buildDir' = distPref </> "build"
-
- setupMessage verbosity "Configuring" (packageId pkg_descr0)
-
- unless (configProfExe cfg == NoFlag) $ do
- let enable | fromFlag (configProfExe cfg) = "enable"
- | otherwise = "disable"
- warn verbosity
- ("The flag --" ++ enable ++ "-executable-profiling is deprecated. "
- ++ "Please use --" ++ enable ++ "-profiling instead.")
-
- unless (configLibCoverage cfg == NoFlag) $ do
- let enable | fromFlag (configLibCoverage cfg) = "enable"
- | otherwise = "disable"
- warn verbosity
- ("The flag --" ++ enable ++ "-library-coverage is deprecated. "
- ++ "Please use --" ++ enable ++ "-coverage instead.")
-
- createDirectoryIfMissingVerbose (lessVerbose verbosity) True distPref
-
- let programsConfig = mkProgramsConfig cfg (configPrograms cfg)
- userInstall = fromFlag (configUserInstall cfg)
- packageDbs = interpretPackageDbFlags userInstall
- (configPackageDBs cfg)
-
- -- detect compiler
- (comp, compPlatform, programsConfig') <- configCompilerEx
- (flagToMaybe $ configHcFlavor cfg)
- (flagToMaybe $ configHcPath cfg) (flagToMaybe $ configHcPkg cfg)
- programsConfig (lessVerbose verbosity)
- let version = compilerVersion comp
- flavor = compilerFlavor comp
-
- -- Create a PackageIndex that makes *any libraries that might be*
- -- defined internally to this package look like installed packages, in
- -- case an executable should refer to any of them as dependencies.
- --
- -- It must be *any libraries that might be* defined rather than the
- -- actual definitions, because these depend on conditionals in the .cabal
- -- file, and we haven't resolved them yet. finalizePackageDescription
- -- does the resolution of conditionals, and it takes internalPackageSet
- -- as part of its input.
- --
- -- Currently a package can define no more than one library (which has
- -- the same name as the package) but we could extend this later.
- -- If we later allowed private internal libraries, then here we would
- -- need to pre-scan the conditional data to make a list of all private
- -- libraries that could possibly be defined by the .cabal file.
- let pid = packageId pkg_descr0
- internalPackage = emptyInstalledPackageInfo {
- --TODO: should use a per-compiler method to map the source
- -- package ID into an installed package id we can use
- -- for the internal package set. The open-codes use of
- -- InstalledPackageId . display here is a hack.
- Installed.installedPackageId =
- InstalledPackageId $ display $ pid,
- Installed.sourcePackageId = pid
- }
- internalPackageSet = PackageIndex.fromList [internalPackage]
- installedPackageSet <- getInstalledPackages (lessVerbose verbosity) comp
- packageDbs programsConfig'
-
- (allConstraints, requiredDepsMap) <- either die return $
- combinedConstraints (configConstraints cfg)
- (configDependencies cfg)
- installedPackageSet
-
- let exactConf = fromFlagOrDefault False (configExactConfiguration cfg)
- -- Constraint test function for the solver
- dependencySatisfiable d@(Dependency depName verRange)
- | exactConf =
- -- When we're given '--exact-configuration', we assume that all
- -- dependencies and flags are exactly specified on the command
- -- line. Thus we only consult the 'requiredDepsMap'. Note that
- -- we're not doing the version range check, so if there's some
- -- dependency that wasn't specified on the command line,
- -- 'finalizePackageDescription' will fail.
- --
- -- TODO: mention '--exact-configuration' in the error message
- -- when this fails?
- (depName `Map.member` requiredDepsMap) || isInternalDep
-
- | otherwise =
- -- Normal operation: just look up dependency in the package
- -- index.
- not . null . PackageIndex.lookupDependency pkgs' $ d
- where
- pkgs' = PackageIndex.insert internalPackage installedPackageSet
- isInternalDep = pkgName pid == depName
- && pkgVersion pid `withinRange` verRange
- enableTest t = t { testEnabled = fromFlag (configTests cfg) }
- flaggedTests = map (\(n, t) -> (n, mapTreeData enableTest t))
- (condTestSuites pkg_descr0)
- enableBenchmark bm = bm { benchmarkEnabled =
- fromFlag (configBenchmarks cfg) }
- flaggedBenchmarks = map (\(n, bm) ->
- (n, mapTreeData enableBenchmark bm))
- (condBenchmarks pkg_descr0)
- pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests
- , condBenchmarks = flaggedBenchmarks }
-
- (pkg_descr0', flags) <-
- case finalizePackageDescription
- (configConfigurationsFlags cfg)
- dependencySatisfiable
- compPlatform
- (compilerInfo comp)
- allConstraints
- pkg_descr0''
- of Right r -> return r
- Left missing ->
- die $ "At least the following dependencies are missing:\n"
- ++ (render . nest 4 . sep . punctuate comma
- . map (disp . simplifyDependency)
- $ missing)
-
- -- Sanity check: if '--exact-configuration' was given, ensure that the
- -- complete flag assignment was specified on the command line.
- when exactConf $ do
- let cmdlineFlags = map fst (configConfigurationsFlags cfg)
- allFlags = map flagName . genPackageFlags $ pkg_descr0
- diffFlags = allFlags \\ cmdlineFlags
- when (not . null $ diffFlags) $
- die $ "'--exact-conf' was given, "
- ++ "but the following flags were not specified: "
- ++ intercalate ", " (map show diffFlags)
-
- -- add extra include/lib dirs as specified in cfg
- -- we do it here so that those get checked too
- let pkg_descr = addExtraIncludeLibDirs pkg_descr0'
-
- unless (renamingPackageFlagsSupported comp ||
- and [ rn == defaultRenaming
- | bi <- allBuildInfo pkg_descr
- , rn <- Map.elems (targetBuildRenaming bi)]) $
- die $ "Your compiler does not support thinning and renaming on "
- ++ "package flags. To use this feature you probably must use "
- ++ "GHC 7.9 or later."
-
- when (not (null flags)) $
- info verbosity $ "Flags chosen: "
- ++ intercalate ", " [ name ++ "=" ++ display value
- | (FlagName name, value) <- flags ]
-
- when (maybe False (not.null.PD.reexportedModules) (PD.library pkg_descr)
- && not (reexportedModulesSupported comp)) $ do
- die $ "Your compiler does not support module re-exports. To use "
- ++ "this feature you probably must use GHC 7.9 or later."
-
- checkPackageProblems verbosity pkg_descr0
- (updatePackageDescription pbi pkg_descr)
-
- -- Handle hole instantiation
- (holeDeps, hole_insts) <- configureInstantiateWith pkg_descr cfg installedPackageSet
-
- let selectDependencies :: [Dependency] ->
- ([FailedDependency], [ResolvedDependency])
- selectDependencies =
- (\xs -> ([ x | Left x <- xs ], [ x | Right x <- xs ]))
- . map (selectDependency internalPackageSet installedPackageSet
- requiredDepsMap)
-
- (failedDeps, allPkgDeps) =
- selectDependencies (buildDepends pkg_descr)
-
- internalPkgDeps = [ pkgid
- | InternalDependency _ pkgid <- allPkgDeps ]
- externalPkgDeps = [ pkg
- | ExternalDependency _ pkg <- allPkgDeps ]
-
- when (not (null internalPkgDeps)
- && not (newPackageDepsBehaviour pkg_descr)) $
- die $ "The field 'build-depends: "
- ++ intercalate ", " (map (display . packageName) internalPkgDeps)
- ++ "' refers to a library which is defined within the same "
- ++ "package. To use this feature the package must specify at "
- ++ "least 'cabal-version: >= 1.8'."
-
- reportFailedDependencies failedDeps
- reportSelectedDependencies verbosity allPkgDeps
-
- let installDeps = Map.elems
- . Map.fromList
- . map (\v -> (Installed.installedPackageId v, v))
- $ externalPkgDeps ++ holeDeps
-
- packageDependsIndex <-
- case PackageIndex.dependencyClosure installedPackageSet
- (map Installed.installedPackageId installDeps) of
- Left packageDependsIndex -> return packageDependsIndex
- Right broken ->
- die $ "The following installed packages are broken because other"
- ++ " packages they depend on are missing. These broken "
- ++ "packages must be rebuilt before they can be used.\n"
- ++ unlines [ "package "
- ++ display (packageId pkg)
- ++ " is broken due to missing package "
- ++ intercalate ", " (map display deps)
- | (pkg, deps) <- broken ]
-
- let pseudoTopPkg = emptyInstalledPackageInfo {
- Installed.installedPackageId =
- InstalledPackageId (display (packageId pkg_descr)),
- Installed.sourcePackageId = packageId pkg_descr,
- Installed.depends =
- map Installed.installedPackageId installDeps
+configure (pkg_descr0', pbi) cfg = do
+ let pkg_descr0 =
+ -- Ignore '--allow-newer' when we're given '--exact-configuration'.
+ if fromFlagOrDefault False (configExactConfiguration cfg)
+ then pkg_descr0'
+ else relaxPackageDeps
+ (fromMaybe AllowNewerNone $ configAllowNewer cfg)
+ pkg_descr0'
+
+ setupMessage verbosity "Configuring" (packageId pkg_descr0)
+
+ checkDeprecatedFlags verbosity cfg
+ checkExactConfiguration pkg_descr0 cfg
+
+ -- Where to build the package
+ let buildDir :: FilePath -- e.g. dist/build
+ -- fromFlag OK due to Distribution.Simple calling
+ -- findDistPrefOrDefault to fill it in
+ buildDir = fromFlag (configDistPref cfg) </> "build"
+ createDirectoryIfMissingVerbose (lessVerbose verbosity) True buildDir
+
+ -- What package database(s) to use
+ let packageDbs :: PackageDBStack
+ packageDbs
+ = interpretPackageDbFlags
+ (fromFlag (configUserInstall cfg))
+ (configPackageDBs cfg)
+
+ -- comp: the compiler we're building with
+ -- compPlatform: the platform we're building for
+ -- programsConfig: location and args of all programs we're
+ -- building with
+ (comp :: Compiler,
+ compPlatform :: Platform,
+ programsConfig :: ProgramConfiguration)
+ <- configCompilerEx
+ (flagToMaybe (configHcFlavor cfg))
+ (flagToMaybe (configHcPath cfg))
+ (flagToMaybe (configHcPkg cfg))
+ (mkProgramsConfig cfg (configPrograms cfg))
+ (lessVerbose verbosity)
+
+ -- The InstalledPackageIndex of all installed packages
+ installedPackageSet :: InstalledPackageIndex
+ <- getInstalledPackages (lessVerbose verbosity) comp
+ packageDbs programsConfig
+
+ -- An approximate InstalledPackageIndex of all (possible) internal libraries.
+ -- This database is used to bootstrap the process before we know precisely
+ -- what these libraries are supposed to be.
+ let internalPackageSet :: InstalledPackageIndex
+ internalPackageSet = getInternalPackages pkg_descr0
+
+ -- allConstraints: The set of all 'Dependency's we have. Used ONLY
+ -- to 'configureFinalizedPackage'.
+ -- requiredDepsMap: A map from 'PackageName' to the specifically
+ -- required 'InstalledPackageInfo', due to --dependency
+ --
+ -- NB: These constraints are to be applied to ALL components of
+ -- a package. Thus, it's not an error if allConstraints contains
+ -- more constraints than is necessary for a component (another
+ -- component might need it.)
+ --
+ -- NB: The fact that we bundle all the constraints together means
+ -- that is not possible to configure a test-suite to use one
+ -- version of a dependency, and the executable to use another.
+ (allConstraints :: [Dependency],
+ requiredDepsMap :: Map PackageName InstalledPackageInfo)
+ <- either die return $
+ combinedConstraints (configConstraints cfg)
+ (configDependencies cfg)
+ installedPackageSet
+
+ -- pkg_descr: The resolved package description, that does not contain any
+ -- conditionals, because we have have an assignment for
+ -- every flag, either picking them ourselves using a
+ -- simple naive algorithm, or having them be passed to
+ -- us by 'configConfigurationsFlags')
+ -- flags: The 'FlagAssignment' that the conditionals were
+ -- resolved with.
+ --
+ -- NB: Why doesn't finalizing a package also tell us what the
+ -- dependencies are (e.g. when we run the naive algorithm,
+ -- we are checking if dependencies are satisfiable)? The
+ -- primary reason is that we may NOT have done any solving:
+ -- if the flags are all chosen for us, this step is a simple
+ -- matter of flattening according to that assignment. It's
+ -- cleaner to then configure the dependencies afterwards.
+ (pkg_descr :: PackageDescription,
+ flags :: FlagAssignment)
+ <- configureFinalizedPackage verbosity cfg
+ allConstraints
+ (dependencySatisfiable
+ (fromFlagOrDefault False (configExactConfiguration cfg))
+ installedPackageSet
+ internalPackageSet
+ requiredDepsMap)
+ comp
+ compPlatform
+ pkg_descr0
+
+ checkCompilerProblems comp pkg_descr
+ checkPackageProblems verbosity pkg_descr0
+ (updatePackageDescription pbi pkg_descr)
+
+ -- The list of 'InstalledPackageInfo' recording the selected
+ -- dependencies...
+ -- internalPkgDeps: ...on internal packages (these are fake!)
+ -- externalPkgDeps: ...on external packages
+ --
+ -- Invariant: For any package name, there is at most one package
+ -- in externalPackageDeps which has that name.
+ --
+ -- NB: The dependency selection is global over ALL components
+ -- in the package (similar to how allConstraints and
+ -- requiredDepsMap are global over all components). In particular,
+ -- if *any* component (post-flag resolution) has an unsatisfiable
+ -- dependency, we will fail. This can sometimes be undesirable
+ -- for users, see #1786 (benchmark conflicts with executable),
+ (internalPkgDeps :: [PackageId],
+ externalPkgDeps :: [InstalledPackageInfo])
+ <- configureDependencies
+ verbosity
+ internalPackageSet
+ installedPackageSet
+ requiredDepsMap
+ pkg_descr
+
+ -- The database of transitively reachable installed packages that the
+ -- external components the package (as a whole) depends on. This will be
+ -- used in several ways:
+ --
+ -- * We'll use it to do a consistency check so we're not depending
+ -- on multiple versions of the same package (TODO: someday relax
+ -- this for private dependencies.) See right below.
+ --
+ -- * We feed it in when configuring the components to resolve
+ -- module reexports. (TODO: axe this.)
+ --
+ -- * We'll pass it on in the LocalBuildInfo, where preprocessors
+ -- and other things will incorrectly use it to determine what
+ -- the include paths and everything should be.
+ --
+ packageDependsIndex :: InstalledPackageIndex <-
+ case PackageIndex.dependencyClosure installedPackageSet
+ (map Installed.installedUnitId externalPkgDeps) of
+ Left packageDependsIndex -> return packageDependsIndex
+ Right broken ->
+ die $ "The following installed packages are broken because other"
+ ++ " packages they depend on are missing. These broken "
+ ++ "packages must be rebuilt before they can be used.\n"
+ ++ unlines [ "package "
+ ++ display (packageId pkg)
+ ++ " is broken due to missing package "
+ ++ intercalate ", " (map display deps)
+ | (pkg, deps) <- broken ]
+
+ -- In this section, we'd like to look at the 'packageDependsIndex'
+ -- and see if we've picked multiple versions of the same
+ -- installed package (this is bad, because it means you might
+ -- get an error could not match foo-0.1:Type with foo-0.2:Type).
+ --
+ -- What is pseudoTopPkg for? I have no idea. It was used
+ -- in the very original commit which introduced checking for
+ -- inconsistencies 5115bb2be4e13841ea07dc9166b9d9afa5f0d012,
+ -- and then moved out of PackageIndex and put here later.
+ -- TODO: Try this code without it...
+ --
+ -- TODO: Move this into a helper function
+ let pseudoTopPkg :: InstalledPackageInfo
+ pseudoTopPkg = emptyInstalledPackageInfo {
+ Installed.installedUnitId =
+ mkLegacyUnitId (packageId pkg_descr),
+ Installed.sourcePackageId = packageId pkg_descr,
+ Installed.depends =
+ map Installed.installedUnitId externalPkgDeps
+ }
+ case PackageIndex.dependencyInconsistencies
+ . PackageIndex.insert pseudoTopPkg
+ $ packageDependsIndex of
+ [] -> return ()
+ inconsistencies ->
+ warn verbosity $
+ "This package indirectly depends on multiple versions of the same "
+ ++ "package. This is highly likely to cause a compile failure.\n"
+ ++ unlines [ "package " ++ display pkg ++ " requires "
+ ++ display (PackageIdentifier name ver)
+ | (name, uses) <- inconsistencies
+ , (pkg, ver) <- uses ]
+
+ -- Compute installation directory templates, based on user
+ -- configuration.
+ --
+ -- TODO: Move this into a helper function.
+ defaultDirs :: InstallDirTemplates
+ <- defaultInstallDirs (compilerFlavor comp)
+ (fromFlag (configUserInstall cfg))
+ (hasLibs pkg_descr)
+ let installDirs :: InstallDirTemplates
+ installDirs = combineInstallDirs fromFlagOrDefault
+ defaultDirs (configInstallDirs cfg)
+
+ -- Check languages and extensions
+ -- TODO: Move this into a helper function.
+ let langlist = nub $ catMaybes $ map defaultLanguage
+ (allBuildInfo pkg_descr)
+ let langs = unsupportedLanguages comp langlist
+ when (not (null langs)) $
+ die $ "The package " ++ display (packageId pkg_descr0)
+ ++ " requires the following languages which are not "
+ ++ "supported by " ++ display (compilerId comp) ++ ": "
+ ++ intercalate ", " (map display langs)
+ let extlist = nub $ concatMap allExtensions (allBuildInfo pkg_descr)
+ let exts = unsupportedExtensions comp extlist
+ when (not (null exts)) $
+ die $ "The package " ++ display (packageId pkg_descr0)
+ ++ " requires the following language extensions which are not "
+ ++ "supported by " ++ display (compilerId comp) ++ ": "
+ ++ intercalate ", " (map display exts)
+
+ -- Configure known/required programs & external build tools.
+ -- Exclude build-tool deps on "internal" exes in the same package
+ --
+ -- TODO: Factor this into a helper package.
+ let requiredBuildTools =
+ [ buildTool
+ | let exeNames = map exeName (executables pkg_descr)
+ , bi <- allBuildInfo pkg_descr
+ , buildTool@(Dependency (PackageName toolName) reqVer)
+ <- buildTools bi
+ , let isInternal =
+ toolName `elem` exeNames
+ -- we assume all internal build-tools are
+ -- versioned with the package:
+ && packageVersion pkg_descr `withinRange` reqVer
+ , not isInternal ]
+
+ programsConfig' <-
+ configureAllKnownPrograms (lessVerbose verbosity) programsConfig
+ >>= configureRequiredPrograms verbosity requiredBuildTools
+
+ (pkg_descr', programsConfig'') <-
+ configurePkgconfigPackages verbosity pkg_descr programsConfig'
+
+ -- Compute internal component graph
+ --
+ -- The general idea is that we take a look at all the source level
+ -- components (which may build-depends on each other) and form a graph.
+ -- From there, we build a ComponentLocalBuildInfo for each of the
+ -- components, which lets us actually build each component.
+ buildComponents <-
+ case mkComponentsGraph pkg_descr internalPkgDeps of
+ Left componentCycle -> reportComponentCycle componentCycle
+ Right comps ->
+ mkComponentsLocalBuildInfo cfg comp packageDependsIndex pkg_descr
+ internalPkgDeps externalPkgDeps
+ comps (configConfigurationsFlags cfg)
+
+ -- Decide if we're going to compile with split objects.
+ split_objs :: Bool <-
+ if not (fromFlag $ configSplitObjs cfg)
+ then return False
+ else case compilerFlavor comp of
+ GHC | compilerVersion comp >= Version [6,5] []
+ -> return True
+ GHCJS
+ -> return True
+ _ -> do warn verbosity
+ ("this compiler does not support " ++
+ "--enable-split-objs; ignoring")
+ return False
+
+ let ghciLibByDefault =
+ case compilerId comp of
+ CompilerId GHC _ ->
+ -- If ghc is non-dynamic, then ghci needs object files,
+ -- so we build one by default.
+ --
+ -- Technically, archive files should be sufficient for ghci,
+ -- but because of GHC bug #8942, it has never been safe to
+ -- rely on them. By the time that bug was fixed, ghci had
+ -- been changed to read shared libraries instead of archive
+ -- files (see next code block).
+ not (GHC.isDynamic comp)
+ CompilerId GHCJS _ ->
+ not (GHCJS.isDynamic comp)
+ _ -> False
+
+ let sharedLibsByDefault
+ | fromFlag (configDynExe cfg) =
+ -- build a shared library if dynamically-linked
+ -- executables are requested
+ True
+ | otherwise = case compilerId comp of
+ CompilerId GHC _ ->
+ -- if ghc is dynamic, then ghci needs a shared
+ -- library, so we build one by default.
+ GHC.isDynamic comp
+ CompilerId GHCJS _ ->
+ GHCJS.isDynamic comp
+ _ -> False
+ withSharedLib_ =
+ -- build shared libraries if required by GHC or by the
+ -- executable linking mode, but allow the user to force
+ -- building only static library archives with
+ -- --disable-shared.
+ fromFlagOrDefault sharedLibsByDefault $ configSharedLib cfg
+ withDynExe_ = fromFlag $ configDynExe cfg
+ when (withDynExe_ && not withSharedLib_) $ warn verbosity $
+ "Executables will use dynamic linking, but a shared library "
+ ++ "is not being built. Linking will fail if any executables "
+ ++ "depend on the library."
+
+ -- The --profiling flag sets the default for both libs and exes,
+ -- but can be overidden by --library-profiling, or the old deprecated
+ -- --executable-profiling flag.
+ let profEnabledLibOnly = configProfLib cfg
+ profEnabledBoth = fromFlagOrDefault False (configProf cfg)
+ profEnabledLib = fromFlagOrDefault profEnabledBoth profEnabledLibOnly
+ profEnabledExe = fromFlagOrDefault profEnabledBoth (configProfExe cfg)
+
+ -- The --profiling-detail and --library-profiling-detail flags behave
+ -- similarly
+ profDetailLibOnly <- checkProfDetail (configProfLibDetail cfg)
+ profDetailBoth <- liftM (fromFlagOrDefault ProfDetailDefault)
+ (checkProfDetail (configProfDetail cfg))
+ let profDetailLib = fromFlagOrDefault profDetailBoth profDetailLibOnly
+ profDetailExe = profDetailBoth
+
+ when (profEnabledExe && not profEnabledLib) $
+ warn verbosity $
+ "Executables will be built with profiling, but library "
+ ++ "profiling is disabled. Linking will fail if any executables "
+ ++ "depend on the library."
+
+ let configCoverage_ =
+ mappend (configCoverage cfg) (configLibCoverage cfg)
+
+ cfg' = cfg { configCoverage = configCoverage_ }
+
+ reloc <-
+ if not (fromFlag $ configRelocatable cfg)
+ then return False
+ else return True
+
+ let lbi = LocalBuildInfo {
+ configFlags = cfg',
+ flagAssignment = flags,
+ extraConfigArgs = [], -- Currently configure does not
+ -- take extra args, but if it
+ -- did they would go here.
+ installDirTemplates = installDirs,
+ compiler = comp,
+ hostPlatform = compPlatform,
+ buildDir = buildDir,
+ componentsConfigs = buildComponents,
+ installedPkgs = packageDependsIndex,
+ pkgDescrFile = Nothing,
+ localPkgDescr = pkg_descr',
+ withPrograms = programsConfig'',
+ withVanillaLib = fromFlag $ configVanillaLib cfg,
+ withProfLib = profEnabledLib,
+ withSharedLib = withSharedLib_,
+ withDynExe = withDynExe_,
+ withProfExe = profEnabledExe,
+ withProfLibDetail = profDetailLib,
+ withProfExeDetail = profDetailExe,
+ withOptimization = fromFlag $ configOptimization cfg,
+ withDebugInfo = fromFlag $ configDebugInfo cfg,
+ withGHCiLib = fromFlagOrDefault ghciLibByDefault $
+ configGHCiLib cfg,
+ splitObjs = split_objs,
+ stripExes = fromFlag $ configStripExes cfg,
+ stripLibs = fromFlag $ configStripLibs cfg,
+ withPackageDB = packageDbs,
+ progPrefix = fromFlag $ configProgPrefix cfg,
+ progSuffix = fromFlag $ configProgSuffix cfg,
+ relocatable = reloc
}
- case PackageIndex.dependencyInconsistencies
- . PackageIndex.insert pseudoTopPkg
- $ packageDependsIndex of
- [] -> return ()
- inconsistencies ->
- warn verbosity $
- "This package indirectly depends on multiple versions of the same "
- ++ "package. This is highly likely to cause a compile failure.\n"
- ++ unlines [ "package " ++ display pkg ++ " requires "
- ++ display (PackageIdentifier name ver)
- | (name, uses) <- inconsistencies
- , (pkg, ver) <- uses ]
-
- -- installation directories
- defaultDirs <- defaultInstallDirs flavor userInstall (hasLibs pkg_descr)
- let installDirs = combineInstallDirs fromFlagOrDefault
- defaultDirs (configInstallDirs cfg)
-
- -- check languages and extensions
- let langlist = nub $ catMaybes $ map defaultLanguage
- (allBuildInfo pkg_descr)
- let langs = unsupportedLanguages comp langlist
- when (not (null langs)) $
- die $ "The package " ++ display (packageId pkg_descr0)
- ++ " requires the following languages which are not "
- ++ "supported by " ++ display (compilerId comp) ++ ": "
- ++ intercalate ", " (map display langs)
- let extlist = nub $ concatMap allExtensions (allBuildInfo pkg_descr)
- let exts = unsupportedExtensions comp extlist
- when (not (null exts)) $
- die $ "The package " ++ display (packageId pkg_descr0)
- ++ " requires the following language extensions which are not "
- ++ "supported by " ++ display (compilerId comp) ++ ": "
- ++ intercalate ", " (map display exts)
-
- -- configured known/required programs & external build tools
- -- exclude build-tool deps on "internal" exes in the same package
- let requiredBuildTools =
- [ buildTool
- | let exeNames = map exeName (executables pkg_descr)
- , bi <- allBuildInfo pkg_descr
- , buildTool@(Dependency (PackageName toolName) reqVer)
- <- buildTools bi
- , let isInternal =
- toolName `elem` exeNames
- -- we assume all internal build-tools are
- -- versioned with the package:
- && packageVersion pkg_descr `withinRange` reqVer
- , not isInternal ]
-
- programsConfig'' <-
- configureAllKnownPrograms (lessVerbose verbosity) programsConfig'
- >>= configureRequiredPrograms verbosity requiredBuildTools
-
- (pkg_descr', programsConfig''') <-
- configurePkgconfigPackages verbosity pkg_descr programsConfig''
-
- -- internal component graph
- buildComponents <-
- case mkComponentsGraph pkg_descr internalPkgDeps of
- Left componentCycle -> reportComponentCycle componentCycle
- Right components ->
- mkComponentsLocalBuildInfo comp packageDependsIndex pkg_descr
- internalPkgDeps externalPkgDeps holeDeps
- (Map.fromList hole_insts)
- components
-
- split_objs <-
- if not (fromFlag $ configSplitObjs cfg)
- then return False
- else case flavor of
- GHC | version >= Version [6,5] [] -> return True
- GHCJS -> return True
- _ -> do warn verbosity
- ("this compiler does not support " ++
- "--enable-split-objs; ignoring")
- return False
-
- let ghciLibByDefault =
- case compilerId comp of
- CompilerId GHC _ ->
- -- If ghc is non-dynamic, then ghci needs object files,
- -- so we build one by default.
- --
- -- Technically, archive files should be sufficient for ghci,
- -- but because of GHC bug #8942, it has never been safe to
- -- rely on them. By the time that bug was fixed, ghci had
- -- been changed to read shared libraries instead of archive
- -- files (see next code block).
- not (GHC.isDynamic comp)
- CompilerId GHCJS _ ->
- not (GHCJS.isDynamic comp)
- _ -> False
-
- let sharedLibsByDefault
- | fromFlag (configDynExe cfg) =
- -- build a shared library if dynamically-linked
- -- executables are requested
- True
- | otherwise = case compilerId comp of
- CompilerId GHC _ ->
- -- if ghc is dynamic, then ghci needs a shared
- -- library, so we build one by default.
- GHC.isDynamic comp
- CompilerId GHCJS _ ->
- GHCJS.isDynamic comp
- _ -> False
- withSharedLib_ =
- -- build shared libraries if required by GHC or by the
- -- executable linking mode, but allow the user to force
- -- building only static library archives with
- -- --disable-shared.
- fromFlagOrDefault sharedLibsByDefault $ configSharedLib cfg
- withDynExe_ = fromFlag $ configDynExe cfg
- when (withDynExe_ && not withSharedLib_) $ warn verbosity $
- "Executables will use dynamic linking, but a shared library "
- ++ "is not being built. Linking will fail if any executables "
- ++ "depend on the library."
-
- -- The --profiling flag sets the default for both libs and exes,
- -- but can be overidden by --library-profiling, or the old deprecated
- -- --executable-profiling flag.
- let profEnabledLibOnly = configProfLib cfg
- profEnabledBoth = fromFlagOrDefault False (configProf cfg)
- profEnabledLib = fromFlagOrDefault profEnabledBoth profEnabledLibOnly
- profEnabledExe = fromFlagOrDefault profEnabledBoth (configProfExe cfg)
-
- -- The --profiling-detail and --library-profiling-detail flags behave
- -- similarly
- profDetailLibOnly <- checkProfDetail (configProfLibDetail cfg)
- profDetailBoth <- liftM (fromFlagOrDefault ProfDetailDefault)
- (checkProfDetail (configProfDetail cfg))
- let profDetailLib = fromFlagOrDefault profDetailBoth profDetailLibOnly
- profDetailExe = profDetailBoth
-
- when (profEnabledExe && not profEnabledLib) $
- warn verbosity $
- "Executables will be built with profiling, but library "
- ++ "profiling is disabled. Linking will fail if any executables "
- ++ "depend on the library."
-
- let configCoverage_ =
- mappend (configCoverage cfg) (configLibCoverage cfg)
-
- cfg' = cfg { configCoverage = configCoverage_ }
-
- reloc <-
- if not (fromFlag $ configRelocatable cfg)
- then return False
- else return True
-
- let lbi = LocalBuildInfo {
- configFlags = cfg',
- extraConfigArgs = [], -- Currently configure does not
- -- take extra args, but if it
- -- did they would go here.
- installDirTemplates = installDirs,
- compiler = comp,
- hostPlatform = compPlatform,
- buildDir = buildDir',
- componentsConfigs = buildComponents,
- installedPkgs = packageDependsIndex,
- pkgDescrFile = Nothing,
- localPkgDescr = pkg_descr',
- instantiatedWith = hole_insts,
- withPrograms = programsConfig''',
- withVanillaLib = fromFlag $ configVanillaLib cfg,
- withProfLib = profEnabledLib,
- withSharedLib = withSharedLib_,
- withDynExe = withDynExe_,
- withProfExe = profEnabledExe,
- withProfLibDetail = profDetailLib,
- withProfExeDetail = profDetailExe,
- withOptimization = fromFlag $ configOptimization cfg,
- withDebugInfo = fromFlag $ configDebugInfo cfg,
- withGHCiLib = fromFlagOrDefault ghciLibByDefault $
- configGHCiLib cfg,
- splitObjs = split_objs,
- stripExes = fromFlag $ configStripExes cfg,
- stripLibs = fromFlag $ configStripLibs cfg,
- withPackageDB = packageDbs,
- progPrefix = fromFlag $ configProgPrefix cfg,
- progSuffix = fromFlag $ configProgSuffix cfg,
- relocatable = reloc
- }
-
- when reloc (checkRelocatable verbosity pkg_descr lbi)
-
- let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
- relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi
-
- unless (isAbsolute (prefix dirs)) $ die $
- "expected an absolute directory name for --prefix: " ++ prefix dirs
-
- info verbosity $ "Using " ++ display currentCabalId
- ++ " compiled by " ++ display currentCompilerId
- info verbosity $ "Using compiler: " ++ showCompilerId comp
- info verbosity $ "Using install prefix: " ++ prefix dirs
-
- let dirinfo name dir isPrefixRelative =
- info verbosity $ name ++ " installed in: " ++ dir ++ relNote
- where relNote = case buildOS of
- Windows | not (hasLibs pkg_descr)
- && isNothing isPrefixRelative
- -> " (fixed location)"
- _ -> ""
-
- dirinfo "Binaries" (bindir dirs) (bindir relative)
- dirinfo "Libraries" (libdir dirs) (libdir relative)
- dirinfo "Private binaries" (libexecdir dirs) (libexecdir relative)
- dirinfo "Data files" (datadir dirs) (datadir relative)
- dirinfo "Documentation" (docdir dirs) (docdir relative)
- dirinfo "Configuration files" (sysconfdir dirs) (sysconfdir relative)
-
- sequence_ [ reportProgram verbosity prog configuredProg
- | (prog, configuredProg) <- knownPrograms programsConfig''' ]
-
- return lbi
+
+ when reloc (checkRelocatable verbosity pkg_descr lbi)
+
+ -- TODO: This is not entirely correct, because the dirs may vary
+ -- across libraries/executables
+ let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
+ relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi
+
+ unless (isAbsolute (prefix dirs)) $ die $
+ "expected an absolute directory name for --prefix: " ++ prefix dirs
+
+ info verbosity $ "Using " ++ display currentCabalId
+ ++ " compiled by " ++ display currentCompilerId
+ info verbosity $ "Using compiler: " ++ showCompilerId comp
+ info verbosity $ "Using install prefix: " ++ prefix dirs
+
+ let dirinfo name dir isPrefixRelative =
+ info verbosity $ name ++ " installed in: " ++ dir ++ relNote
+ where relNote = case buildOS of
+ Windows | not (hasLibs pkg_descr)
+ && isNothing isPrefixRelative
+ -> " (fixed location)"
+ _ -> ""
+
+ dirinfo "Binaries" (bindir dirs) (bindir relative)
+ dirinfo "Libraries" (libdir dirs) (libdir relative)
+ dirinfo "Private binaries" (libexecdir dirs) (libexecdir relative)
+ dirinfo "Data files" (datadir dirs) (datadir relative)
+ dirinfo "Documentation" (docdir dirs) (docdir relative)
+ dirinfo "Configuration files" (sysconfdir dirs) (sysconfdir relative)
+
+ sequence_ [ reportProgram verbosity prog configuredProg
+ | (prog, configuredProg) <- knownPrograms programsConfig'' ]
+
+ return lbi
where
verbosity = fromFlag (configVerbosity cfg)
- addExtraIncludeLibDirs pkg_descr =
- let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
- , PD.includeDirs = configExtraIncludeDirs cfg}
- modifyLib l = l{ libBuildInfo = libBuildInfo l
- `mappend` extraBi }
- modifyExecutable e = e{ buildInfo = buildInfo e
- `mappend` extraBi}
- in pkg_descr{ library = modifyLib `fmap` library pkg_descr
- , executables = modifyExecutable `map`
- executables pkg_descr}
-
checkProfDetail (Flag (ProfDetailOther other)) = do
warn verbosity $
"Unknown profiling detail level '" ++ other
@@ -808,7 +753,251 @@ mkProgramsConfig cfg initialProgramsConfig = programsConfig
. setProgramSearchPath searchpath
$ initialProgramsConfig
searchpath = getProgramSearchPath (initialProgramsConfig)
- ++ map ProgramSearchPathDir (fromNubList $ configProgramPathExtra cfg)
+ ++ map ProgramSearchPathDir
+ (fromNubList $ configProgramPathExtra cfg)
+
+-- -----------------------------------------------------------------------------
+-- Helper functions for configure
+
+-- | Check if the user used any deprecated flags.
+checkDeprecatedFlags :: Verbosity -> ConfigFlags -> IO ()
+checkDeprecatedFlags verbosity cfg = do
+ unless (configProfExe cfg == NoFlag) $ do
+ let enable | fromFlag (configProfExe cfg) = "enable"
+ | otherwise = "disable"
+ warn verbosity
+ ("The flag --" ++ enable ++ "-executable-profiling is deprecated. "
+ ++ "Please use --" ++ enable ++ "-profiling instead.")
+
+ unless (configLibCoverage cfg == NoFlag) $ do
+ let enable | fromFlag (configLibCoverage cfg) = "enable"
+ | otherwise = "disable"
+ warn verbosity
+ ("The flag --" ++ enable ++ "-library-coverage is deprecated. "
+ ++ "Please use --" ++ enable ++ "-coverage instead.")
+
+-- | Sanity check: if '--exact-configuration' was given, ensure that the
+-- complete flag assignment was specified on the command line.
+checkExactConfiguration :: GenericPackageDescription -> ConfigFlags -> IO ()
+checkExactConfiguration pkg_descr0 cfg = do
+ when (fromFlagOrDefault False (configExactConfiguration cfg)) $ do
+ let cmdlineFlags = map fst (configConfigurationsFlags cfg)
+ allFlags = map flagName . genPackageFlags $ pkg_descr0
+ diffFlags = allFlags \\ cmdlineFlags
+ when (not . null $ diffFlags) $
+ die $ "'--exact-configuration' was given, "
+ ++ "but the following flags were not specified: "
+ ++ intercalate ", " (map show diffFlags)
+
+-- | Create a PackageIndex that makes *any libraries that might be*
+-- defined internally to this package look like installed packages, in
+-- case an executable should refer to any of them as dependencies.
+--
+-- It must be *any libraries that might be* defined rather than the
+-- actual definitions, because these depend on conditionals in the .cabal
+-- file, and we haven't resolved them yet. finalizePackageDescription
+-- does the resolution of conditionals, and it takes internalPackageSet
+-- as part of its input.
+getInternalPackages :: GenericPackageDescription
+ -> InstalledPackageIndex
+getInternalPackages pkg_descr0 =
+ let pkg_descr = flattenPackageDescription pkg_descr0
+ mkInternalPackage lib = emptyInstalledPackageInfo {
+ --TODO: should use a per-compiler method to map the source
+ -- package ID into an installed package id we can use
+ -- for the internal package set. What we do here
+ -- is skeevy, but we're highly unlikely to accidentally
+ -- shadow something legitimate.
+ Installed.installedUnitId = mkUnitId (libName lib),
+ -- NB: we TEMPORARILY set the package name to be the
+ -- library name. When we actually register, it won't
+ -- look like this; this is just so that internal
+ -- build-depends get resolved correctly.
+ Installed.sourcePackageId = PackageIdentifier (PackageName (libName lib))
+ (pkgVersion (package pkg_descr))
+ }
+ in PackageIndex.fromList (map mkInternalPackage (libraries pkg_descr))
+
+
+-- | Returns true if a dependency is satisfiable. This is to be passed
+-- to finalizePackageDescription.
+dependencySatisfiable
+ :: Bool
+ -> InstalledPackageIndex -- ^ installed set
+ -> InstalledPackageIndex -- ^ internal set
+ -> Map PackageName InstalledPackageInfo -- ^ required dependencies
+ -> (Dependency -> Bool)
+dependencySatisfiable
+ exact_config installedPackageSet internalPackageSet requiredDepsMap
+ d@(Dependency depName _)
+ | exact_config =
+ -- When we're given '--exact-configuration', we assume that all
+ -- dependencies and flags are exactly specified on the command
+ -- line. Thus we only consult the 'requiredDepsMap'. Note that
+ -- we're not doing the version range check, so if there's some
+ -- dependency that wasn't specified on the command line,
+ -- 'finalizePackageDescription' will fail.
+ --
+ -- TODO: mention '--exact-configuration' in the error message
+ -- when this fails?
+ --
+ -- (However, note that internal deps don't have to be
+ -- specified!)
+ (depName `Map.member` requiredDepsMap) || isInternalDep
+
+ | otherwise =
+ -- Normal operation: just look up dependency in the combined
+ -- package index.
+ not . null . PackageIndex.lookupDependency pkgs $ d
+ where
+ -- NB: Prefer the INTERNAL package set
+ pkgs = PackageIndex.merge installedPackageSet internalPackageSet
+ isInternalDep = not . null
+ $ PackageIndex.lookupDependency internalPackageSet d
+
+-- | Relax the dependencies of this package if needed.
+relaxPackageDeps :: AllowNewer -> GenericPackageDescription
+ -> GenericPackageDescription
+relaxPackageDeps AllowNewerNone gpd = gpd
+relaxPackageDeps AllowNewerAll gpd = transformAllBuildDepends relaxAll gpd
+ where
+ relaxAll = \(Dependency pkgName verRange) ->
+ Dependency pkgName (removeUpperBound verRange)
+relaxPackageDeps (AllowNewerSome allowNewerDeps') gpd =
+ transformAllBuildDepends relaxSome gpd
+ where
+ thisPkgName = packageName gpd
+ allowNewerDeps = mapMaybe f allowNewerDeps'
+
+ f (Setup.AllowNewerDep p) = Just p
+ f (Setup.AllowNewerDepScoped scope p) | scope == thisPkgName = Just p
+ | otherwise = Nothing
+
+ relaxSome = \d@(Dependency depName verRange) ->
+ if depName `elem` allowNewerDeps
+ then Dependency depName (removeUpperBound verRange)
+ else d
+
+-- | Finalize a generic package description. The workhorse is
+-- 'finalizePackageDescription' but there's a bit of other nattering
+-- about necessary.
+--
+-- TODO: what exactly is the business with @flaggedTests@ and
+-- @flaggedBenchmarks@?
+configureFinalizedPackage
+ :: Verbosity
+ -> ConfigFlags
+ -> [Dependency]
+ -> (Dependency -> Bool) -- ^ tests if a dependency is satisfiable.
+ -- Might say it's satisfiable even when not.
+ -> Compiler
+ -> Platform
+ -> GenericPackageDescription
+ -> IO (PackageDescription, FlagAssignment)
+configureFinalizedPackage verbosity cfg
+ allConstraints satisfies comp compPlatform pkg_descr0 = do
+ let enableTest t = t { testEnabled = fromFlag (configTests cfg) }
+ flaggedTests = map (\(n, t) -> (n, mapTreeData enableTest t))
+ (condTestSuites pkg_descr0)
+ enableBenchmark bm = bm { benchmarkEnabled =
+ fromFlag (configBenchmarks cfg) }
+ flaggedBenchmarks = map (\(n, bm) ->
+ (n, mapTreeData enableBenchmark bm))
+ (condBenchmarks pkg_descr0)
+ pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests
+ , condBenchmarks = flaggedBenchmarks }
+
+ (pkg_descr0', flags) <-
+ case finalizePackageDescription
+ (configConfigurationsFlags cfg)
+ satisfies
+ compPlatform
+ (compilerInfo comp)
+ allConstraints
+ pkg_descr0''
+ of Right r -> return r
+ Left missing ->
+ die $ "Encountered missing dependencies:\n"
+ ++ (render . nest 4 . sep . punctuate comma
+ . map (disp . simplifyDependency)
+ $ missing)
+
+ -- add extra include/lib dirs as specified in cfg
+ -- we do it here so that those get checked too
+ let pkg_descr = addExtraIncludeLibDirs pkg_descr0'
+
+ when (not (null flags)) $
+ info verbosity $ "Flags chosen: "
+ ++ intercalate ", " [ name ++ "=" ++ display value
+ | (FlagName name, value) <- flags ]
+
+ return (pkg_descr, flags)
+ where
+ addExtraIncludeLibDirs pkg_descr =
+ let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
+ , extraFrameworkDirs = configExtraFrameworkDirs cfg
+ , PD.includeDirs = configExtraIncludeDirs cfg}
+ modifyLib l = l{ libBuildInfo = libBuildInfo l
+ `mappend` extraBi }
+ modifyExecutable e = e{ buildInfo = buildInfo e
+ `mappend` extraBi}
+ in pkg_descr{ libraries = modifyLib `map` libraries pkg_descr
+ , executables = modifyExecutable `map`
+ executables pkg_descr}
+
+-- | Check for use of Cabal features which require compiler support
+checkCompilerProblems :: Compiler -> PackageDescription -> IO ()
+checkCompilerProblems comp pkg_descr = do
+ unless (renamingPackageFlagsSupported comp ||
+ and [ True
+ | bi <- allBuildInfo pkg_descr
+ , _ <- Map.elems (targetBuildRenaming bi)]) $
+ die $ "Your compiler does not support thinning and renaming on "
+ ++ "package flags. To use this feature you probably must use "
+ ++ "GHC 7.9 or later."
+
+ when (any (not.null.PD.reexportedModules) (PD.libraries pkg_descr)
+ && not (reexportedModulesSupported comp)) $ do
+ die $ "Your compiler does not support module re-exports. To use "
+ ++ "this feature you probably must use GHC 7.9 or later."
+
+-- | Select dependencies for the package.
+configureDependencies
+ :: Verbosity
+ -> InstalledPackageIndex -- ^ internal packages
+ -> InstalledPackageIndex -- ^ installed packages
+ -> Map PackageName InstalledPackageInfo -- ^ required deps
+ -> PackageDescription
+ -> IO ([PackageId], [InstalledPackageInfo])
+configureDependencies verbosity
+ internalPackageSet installedPackageSet requiredDepsMap pkg_descr = do
+ let selectDependencies :: [Dependency] ->
+ ([FailedDependency], [ResolvedDependency])
+ selectDependencies =
+ partitionEithers
+ . map (selectDependency internalPackageSet installedPackageSet
+ requiredDepsMap)
+
+ (failedDeps, allPkgDeps) =
+ selectDependencies (buildDepends pkg_descr)
+
+ internalPkgDeps = [ pkgid
+ | InternalDependency _ pkgid <- allPkgDeps ]
+ externalPkgDeps = [ pkg
+ | ExternalDependency _ pkg <- allPkgDeps ]
+
+ when (not (null internalPkgDeps)
+ && not (newPackageDepsBehaviour pkg_descr)) $
+ die $ "The field 'build-depends: "
+ ++ intercalate ", " (map (display . packageName) internalPkgDeps)
+ ++ "' refers to a library which is defined within the same "
+ ++ "package. To use this feature the package must specify at "
+ ++ "least 'cabal-version: >= 1.8'."
+
+ reportFailedDependencies failedDeps
+ reportSelectedDependencies verbosity allPkgDeps
+
+ return (internalPkgDeps, externalPkgDeps)
-- -----------------------------------------------------------------------------
-- Configuring package dependencies
@@ -839,7 +1028,8 @@ data FailedDependency = DependencyNotExists PackageName
selectDependency :: InstalledPackageIndex -- ^ Internally defined packages
-> InstalledPackageIndex -- ^ Installed packages
-> Map PackageName InstalledPackageInfo
- -- ^ Packages for which we have been given specific deps to use
+ -- ^ Packages for which we have been given specific deps to
+ -- use
-> Dependency
-> Either FailedDependency ResolvedDependency
selectDependency internalIndex installedIndex requiredDepsMap
@@ -921,6 +1111,11 @@ getInstalledPackages verbosity comp packageDBs progconf = do
++ display flv
-- | Like 'getInstalledPackages', but for a single package DB.
+--
+-- NB: Why isn't this always a fall through to 'getInstalledPackages'?
+-- That is because 'getInstalledPackages' performs some sanity checks
+-- on the package database stack in question. However, when sandboxes
+-- are involved these sanity checks are not desirable.
getPackageDBContents :: Verbosity -> Compiler
-> PackageDB -> ProgramConfiguration
-> IO InstalledPackageIndex
@@ -933,6 +1128,22 @@ getPackageDBContents verbosity comp packageDB progconf = do
_ -> getInstalledPackages verbosity comp [packageDB] progconf
+-- | A set of files (or directories) that can be monitored to detect when
+-- there might have been a change in the installed packages.
+--
+getInstalledPackagesMonitorFiles :: Verbosity -> Compiler
+ -> PackageDBStack
+ -> ProgramConfiguration -> Platform
+ -> IO [FilePath]
+getInstalledPackagesMonitorFiles verbosity comp packageDBs progconf platform =
+ case compilerFlavor comp of
+ GHC -> GHC.getInstalledPackagesMonitorFiles
+ verbosity platform progconf packageDBs
+ other -> do
+ warn verbosity $ "don't know how to find change monitoring files for "
+ ++ "the installed package databases for " ++ display other
+ return []
+
-- | The user interface specifies the package dbs to use with a combination of
-- @--global@, @--user@ and @--package-db=global|user|clear|$file@.
-- This function combines the global/user flag and interprets the package-db
@@ -972,21 +1183,22 @@ newPackageDepsBehaviour pkg =
-- deps in the end. So we still need to remember which installed packages to
-- pick.
combinedConstraints :: [Dependency] ->
- [(PackageName, InstalledPackageId)] ->
+ [(PackageName, UnitId)] ->
InstalledPackageIndex ->
Either String ([Dependency],
Map PackageName InstalledPackageInfo)
combinedConstraints constraints dependencies installedPackages = do
- when (not (null badInstalledPackageIds)) $
+ when (not (null badUnitIds)) $
Left $ render $ text "The following package dependencies were requested"
- $+$ nest 4 (dispDependencies badInstalledPackageIds)
+ $+$ nest 4 (dispDependencies badUnitIds)
$+$ text "however the given installed package instance does not exist."
when (not (null badNames)) $
Left $ render $ text "The following package dependencies were requested"
$+$ nest 4 (dispDependencies badNames)
- $+$ text "however the installed package's name does not match the name given."
+ $+$ text ("however the installed package's name does not match "
+ ++ "the name given.")
--TODO: we don't check that all dependencies are used!
@@ -1004,19 +1216,19 @@ combinedConstraints constraints dependencies installedPackages = do
| (_, _, Just pkg) <- dependenciesPkgInfo ]
-- The dependencies along with the installed package info, if it exists
- dependenciesPkgInfo :: [(PackageName, InstalledPackageId,
+ dependenciesPkgInfo :: [(PackageName, UnitId,
Maybe InstalledPackageInfo)]
dependenciesPkgInfo =
[ (pkgname, ipkgid, mpkg)
| (pkgname, ipkgid) <- dependencies
- , let mpkg = PackageIndex.lookupInstalledPackageId
+ , let mpkg = PackageIndex.lookupUnitId
installedPackages ipkgid
]
-- If we looked up a package specified by an installed package id
-- (i.e. someone has written a hash) and didn't find it then it's
-- an error.
- badInstalledPackageIds =
+ badUnitIds =
[ (pkgname, ipkgid)
| (pkgname, ipkgid, Nothing) <- dependenciesPkgInfo ]
@@ -1035,58 +1247,6 @@ combinedConstraints constraints dependencies installedPackages = do
| (pkgname, ipkgid) <- deps ]
-- -----------------------------------------------------------------------------
--- Configuring hole instantiation
-
-configureInstantiateWith :: PackageDescription
- -> ConfigFlags
- -> InstalledPackageIndex -- ^ installed packages
- -> IO ([InstalledPackageInfo],
- [(ModuleName, (InstalledPackageInfo, ModuleName))])
-configureInstantiateWith pkg_descr cfg installedPackageSet = do
- -- Holes: First, check and make sure the provided instantiation covers
- -- all the holes we know about. Indefinite package installation is
- -- not handled at all at this point.
- -- NB: We union together /all/ of the requirements when calculating
- -- the package key.
- -- NB: For now, we assume that dependencies don't contribute signatures.
- -- This will be handled by cabal-install; as far as ./Setup is
- -- concerned, the most important thing is to be provided correctly
- -- built dependencies.
- let signatures =
- maybe [] (\lib -> requiredSignatures lib ++ exposedSignatures lib)
- (PD.library pkg_descr)
- signatureSet = Set.fromList signatures
- instantiateMap = Map.fromList (configInstantiateWith cfg)
- missing_impls = filter (not . flip Map.member instantiateMap) signatures
- hole_insts0 = filter (\(k,_) -> Set.member k signatureSet) (configInstantiateWith cfg)
-
- when (not (null missing_impls)) $
- die $ "Missing signature implementations for these modules: "
- ++ intercalate ", " (map display missing_impls)
-
- -- Holes: Next, we need to make sure we have packages to actually
- -- provide the implementations we're talking about. This is on top
- -- of the normal dependency resolution process.
- -- TODO: internal dependencies (e.g. the test package depending on the
- -- main library) is not currently supported
- let selectHoleDependency (k,(i,m)) =
- case PackageIndex.lookupInstalledPackageId installedPackageSet i of
- Just pkginst -> Right (k,(pkginst, m))
- Nothing -> Left i
- (failed_hmap, hole_insts) = partitionEithers (map selectHoleDependency hole_insts0)
- holeDeps = map (fst.snd) hole_insts -- could have dups
-
- -- Holes: Finally, any dependencies selected this way have to be
- -- included in the allPkgs index, as well as the buildComponents.
- -- But don't report these as potential inconsistencies!
-
- when (not (null failed_hmap)) $
- die $ "Could not resolve these package IDs (from signature implementations): "
- ++ intercalate ", " (map display failed_hmap)
-
- return (holeDeps, hole_insts)
-
--- -----------------------------------------------------------------------------
-- Configuring program dependencies
configureRequiredPrograms :: Verbosity -> [Dependency] -> ProgramConfiguration
@@ -1124,11 +1284,11 @@ configurePkgconfigPackages verbosity pkg_descr conf
(lessVerbose verbosity) pkgConfigProgram
(orLaterVersion $ Version [0,9,0] []) conf
mapM_ requirePkg allpkgs
- lib' <- mapM addPkgConfigBILib (library pkg_descr)
+ libs' <- mapM addPkgConfigBILib (libraries pkg_descr)
exes' <- mapM addPkgConfigBIExe (executables pkg_descr)
tests' <- mapM addPkgConfigBITest (testSuites pkg_descr)
benches' <- mapM addPkgConfigBIBench (benchmarks pkg_descr)
- let pkg_descr' = pkg_descr { library = lib', executables = exes',
+ let pkg_descr' = pkg_descr { libraries = libs', executables = exes',
testSuites = tests', benchmarks = benches' }
return (pkg_descr', conf')
@@ -1182,7 +1342,7 @@ configurePkgconfigPackages verbosity pkg_descr conf
\bench bi -> bench { benchmarkBuildInfo = bi }
pkgconfigBuildInfo :: [Dependency] -> IO BuildInfo
- pkgconfigBuildInfo [] = return mempty
+ pkgconfigBuildInfo [] = return Mon.mempty
pkgconfigBuildInfo pkgdeps = do
let pkgs = nub [ display pkg | Dependency pkg _ <- pkgdeps ]
ccflags <- pkgconfig ("--cflags" : pkgs)
@@ -1263,7 +1423,13 @@ configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx
-- -----------------------------------------------------------------------------
-- Making the internal component graph
-
+-- | Given the package description and the set of package names which
+-- are considered internal (the current package name and any internal
+-- libraries are considered internal), create a graph of dependencies
+-- between the components. This is NOT necessarily the build order
+-- (although it is in the absence of Backpack.)
+--
+-- TODO: tighten up the type of 'internalPkgDeps'
mkComponentsGraph :: PackageDescription
-> [PackageId]
-> Either [ComponentName]
@@ -1273,7 +1439,7 @@ mkComponentsGraph pkg_descr internalPkgDeps =
| c <- pkgEnabledComponents pkg_descr ]
in case checkComponentsCyclic graph of
Just ccycle -> Left [ cname | (_,cname,_) <- ccycle ]
- Nothing -> Right [ (c, cdeps) | (c, _, cdeps) <- graph ]
+ Nothing -> Right [ (c, cdeps) | (c, _, cdeps) <- topSortFromEdges graph ]
where
-- The dependencies for the given component
componentDeps component =
@@ -1282,7 +1448,8 @@ mkComponentsGraph pkg_descr internalPkgDeps =
, toolname `elem` map exeName
(executables pkg_descr) ]
- ++ [ CLibName | Dependency pkgname _ <- targetBuildDepends bi
+ ++ [ CLibName toolname | Dependency pkgname@(PackageName toolname) _
+ <- targetBuildDepends bi
, pkgname `elem` map packageName internalPkgDeps ]
where
bi = componentBuildInfo component
@@ -1294,106 +1461,305 @@ reportComponentCycle cnames =
[ "'" ++ showComponentName cname ++ "'"
| cname <- cnames ++ [head cnames] ]
-mkComponentsLocalBuildInfo :: Compiler
+-- | This method computes a default, "good enough" 'ComponentId'
+-- for a package. The intent is that cabal-install (or the user) will
+-- specify a more detailed IPID via the @--ipid@ flag if necessary.
+computeComponentId
+ :: Flag String
+ -> PackageIdentifier
+ -> ComponentName
+ -- TODO: careful here!
+ -> [ComponentId] -- IPIDs of the component dependencies
+ -> FlagAssignment
+ -> ComponentId
+computeComponentId mb_explicit pid cname dep_ipids flagAssignment = do
+ -- show is found to be faster than intercalate and then replacement of
+ -- special character used in intercalating. We cannot simply hash by
+ -- doubly concating list, as it just flatten out the nested list, so
+ -- different sources can produce same hash
+ let hash = hashToBase62 $
+ -- For safety, include the package + version here
+ -- for GHC 7.10, where just the hash is used as
+ -- the package key
+ display pid
+ ++ show dep_ipids
+ ++ show flagAssignment
+ generated_base = display pid ++ "-" ++ hash
+ explicit_base cid0 = fromPathTemplate (InstallDirs.substPathTemplate env
+ (toPathTemplate cid0))
+ -- Hack to reuse install dirs machinery
+ -- NB: no real IPID available at this point
+ where env = packageTemplateEnv pid (mkUnitId "")
+ actual_base = case mb_explicit of
+ Flag cid0 -> explicit_base cid0
+ NoFlag -> generated_base
+ ComponentId $ actual_base
+ ++ (case componentNameString (pkgName pid) cname of
+ Nothing -> ""
+ Just s -> "-" ++ s)
+
+hashToBase62 :: String -> String
+hashToBase62 s = showFingerprint $ fingerprintString s
+ where
+ showIntAtBase62 x = showIntAtBase 62 representBase62 x ""
+ representBase62 x
+ | x < 10 = chr (48 + x)
+ | x < 36 = chr (65 + x - 10)
+ | x < 62 = chr (97 + x - 36)
+ | otherwise = '@'
+ showFingerprint (Fingerprint a b) = showIntAtBase62 a ++ showIntAtBase62 b
+
+-- | Computes the package name for a library. If this is the public
+-- library, it will just be the original package name; otherwise,
+-- it will be a munged package name recording the original package
+-- name as well as the name of the internal library.
+--
+-- A lot of tooling in the Haskell ecosystem assumes that if something
+-- is installed to the package database with the package name 'foo',
+-- then it actually is an entry for the (only public) library in package
+-- 'foo'. With internal packages, this is not necessarily true:
+-- a public library as well as arbitrarily many internal libraries may
+-- come from the same package. To prevent tools from getting confused
+-- in this case, the package name of these internal libraries is munged
+-- so that they do not conflict the public library proper.
+--
+-- We munge into a reserved namespace, "z-", and encode both the
+-- component name and the package name of an internal library using the
+-- following format:
+--
+-- compat-pkg-name ::= "z-" package-name "-z-" library-name
+--
+-- where package-name and library-name have "-" ( "z" + ) "-"
+-- segments encoded by adding an extra "z".
+--
+-- When we have the public library, the compat-pkg-name is just the
+-- package-name, no surprises there!
+--
+computeCompatPackageName :: PackageName -> ComponentName -> PackageName
+computeCompatPackageName pkg_name cname
+ | Just cname_str <- componentNameString pkg_name cname
+ = let zdashcode s = go s (Nothing :: Maybe Int) []
+ where go [] _ r = reverse r
+ go ('-':z) (Just n) r | n > 0 = go z (Just 0) ('-':'z':r)
+ go ('-':z) _ r = go z (Just 0) ('-':r)
+ go ('z':z) (Just n) r = go z (Just (n+1)) ('z':r)
+ go (c:z) _ r = go z Nothing (c:r)
+ in PackageName $ "z-" ++ zdashcode (display pkg_name)
+ ++ "-z-" ++ zdashcode cname_str
+ | otherwise
+ = pkg_name
+
+-- | In GHC 8.0, the string we pass to GHC to use for symbol
+-- names for a package can be an arbitrary, IPID-compatible string.
+-- However, prior to GHC 8.0 there are some restrictions on what
+-- format this string can be (due to how ghc-pkg parsed the key):
+--
+-- 1. In GHC 7.10, the string had either be of the form
+-- foo_ABCD, where foo is a non-semantic alphanumeric/hyphenated
+-- prefix and ABCD is two base-64 encoded 64-bit integers,
+-- or a GHC 7.8 style identifier.
+--
+-- 2. In GHC 7.8, the string had to be a valid package identifier
+-- like foo-0.1.
+--
+-- So, the problem is that Cabal, in general, has a general IPID,
+-- but needs to figure out a package key / package ID that the
+-- old ghc-pkg will actually accept. But there's an EVERY WORSE
+-- problem: if ghc-pkg decides to parse an identifier foo-0.1-xxx
+-- as if it were a package identifier, which means it will SILENTLY
+-- DROP the "xxx" (because it's a tag, and Cabal does not allow tags.)
+-- So we must CONNIVE to ensure that we don't pick something that
+-- looks like this.
+--
+-- So this function attempts to define a mapping into the old formats.
+--
+-- The mapping for GHC 7.8 and before:
+--
+-- * We use the *compatibility* package name and version. For
+-- public libraries this is just the package identifier; for
+-- internal libraries, it's something like "z-pkgname-z-libname-0.1".
+-- See 'computeCompatPackageName' for more details.
+--
+-- The mapping for GHC 7.10:
+--
+-- * For CLibName:
+-- If the IPID is of the form foo-0.1-ABCDEF where foo_ABCDEF would
+-- validly parse as a package key, we pass "ABCDEF". (NB: not
+-- all hashes parse this way, because GHC 7.10 mandated that
+-- these hashes be two base-62 encoded 64 bit integers),
+-- but hashes that Cabal generated using 'computeComponentId'
+-- are guaranteed to have this form.
+--
+-- If it is not of this form, we rehash the IPID into the
+-- correct form and pass that.
+--
+-- * For sub-components, we rehash the IPID into the correct format
+-- and pass that.
+--
+computeCompatPackageKey
+ :: Compiler
+ -> PackageName
+ -> Version
+ -> UnitId
+ -> String
+computeCompatPackageKey comp pkg_name pkg_version (SimpleUnitId (ComponentId str))
+ | not (packageKeySupported comp) =
+ display pkg_name ++ "-" ++ display pkg_version
+ | not (unifiedIPIDRequired comp) =
+ let mb_verbatim_key
+ = case simpleParse str :: Maybe PackageId of
+ -- Something like 'foo-0.1', use it verbatim.
+ -- (NB: hash tags look like tags, so they are parsed,
+ -- so the extra equality check tests if a tag was dropped.)
+ Just pid0 | display pid0 == str -> Just str
+ _ -> Nothing
+ mb_truncated_key
+ = let cand = reverse (takeWhile isAlphaNum (reverse str))
+ in if length cand == 22 && all isAlphaNum cand
+ then Just cand
+ else Nothing
+ rehashed_key = hashToBase62 str
+ in fromMaybe rehashed_key (mb_verbatim_key `mplus` mb_truncated_key)
+ | otherwise = str
+
+
+topSortFromEdges :: Ord key => [(node, key, [key])]
+ -> [(node, key, [key])]
+topSortFromEdges es =
+ let (graph, vertexToNode, _) = graphFromEdges es
+ in reverse (map vertexToNode (topSort graph))
+
+mkComponentsLocalBuildInfo :: ConfigFlags
+ -> Compiler
-> InstalledPackageIndex
-> PackageDescription
-> [PackageId] -- internal package deps
-> [InstalledPackageInfo] -- external package deps
- -> [InstalledPackageInfo] -- hole package deps
- -> Map ModuleName (InstalledPackageInfo, ModuleName)
-> [(Component, [ComponentName])]
- -> IO [(ComponentName, ComponentLocalBuildInfo,
- [ComponentName])]
-mkComponentsLocalBuildInfo comp installedPackages pkg_descr
- internalPkgDeps externalPkgDeps holePkgDeps hole_insts
- graph =
- sequence
- [ do clbi <- componentLocalBuildInfo c
- return (componentName c, clbi, cdeps)
- | (c, cdeps) <- graph ]
+ -> FlagAssignment
+ -> IO [(ComponentLocalBuildInfo,
+ [UnitId])]
+mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
+ internalPkgDeps externalPkgDeps
+ graph flagAssignment =
+ foldM go [] graph
where
+ go z (component, dep_cnames) = do
+ clbi <- componentLocalBuildInfo z component
+ -- NB: We want to preserve cdeps because it contains extra
+ -- information like build-tools ordering
+ let dep_uids = [ componentUnitId dep_clbi
+ | cname <- dep_cnames
+ -- Being in z relies on topsort!
+ , (dep_clbi, _) <- z
+ , componentLocalName dep_clbi == cname ]
+ return ((clbi, dep_uids):z)
+
-- The allPkgDeps contains all the package deps for the whole package
-- but we need to select the subset for this specific component.
-- we just take the subset for the package names this component
-- needs. Note, this only works because we cannot yet depend on two
-- versions of the same package.
- componentLocalBuildInfo component =
+ componentLocalBuildInfo :: [(ComponentLocalBuildInfo, [UnitId])]
+ -> Component -> IO ComponentLocalBuildInfo
+ componentLocalBuildInfo internalComps component =
case component of
CLib lib -> do
- let exports = map (\n -> Installed.ExposedModule n Nothing Nothing)
+ let exports = map (\n -> Installed.ExposedModule n Nothing)
(PD.exposedModules lib)
- esigs = map (\n -> Installed.ExposedModule n Nothing
- (fmap (\(pkg,m) -> Installed.OriginalModule
- (Installed.installedPackageId pkg) m)
- (Map.lookup n hole_insts)))
- (PD.exposedSignatures lib)
- let mb_reexports = resolveModuleReexports installedPackages
+ mb_reexports = resolveModuleReexports installedPackages
(packageId pkg_descr)
+ uid
externalPkgDeps lib
reexports <- case mb_reexports of
Left problems -> reportModuleReexportProblems problems
Right r -> return r
- -- Calculate the version hash and package key.
- let externalPkgs = selectSubset bi externalPkgDeps
- pkg_key = mkPackageKey (packageKeySupported comp)
- (package pkg_descr)
- (map Installed.libraryName externalPkgs)
- version_hash = packageKeyLibraryName (package pkg_descr) pkg_key
-
return LibComponentLocalBuildInfo {
componentPackageDeps = cpds,
- componentPackageKey = pkg_key,
- componentLibraryName = version_hash,
- componentPackageRenaming = cprns,
- componentExposedModules = exports ++ reexports ++ esigs
+ componentUnitId = uid,
+ componentLocalName = componentName component,
+ componentIsPublic = libName lib == display (packageName (package pkg_descr)),
+ componentCompatPackageKey = compat_key,
+ componentCompatPackageName = compat_name,
+ componentIncludes = includes,
+ componentExposedModules = exports ++ reexports
}
CExe _ ->
return ExeComponentLocalBuildInfo {
+ componentUnitId = uid,
+ componentLocalName = componentName component,
componentPackageDeps = cpds,
- componentPackageRenaming = cprns
+ componentIncludes = includes
}
CTest _ ->
return TestComponentLocalBuildInfo {
+ componentUnitId = uid,
+ componentLocalName = componentName component,
componentPackageDeps = cpds,
- componentPackageRenaming = cprns
+ componentIncludes = includes
}
CBench _ ->
return BenchComponentLocalBuildInfo {
+ componentUnitId = uid,
+ componentLocalName = componentName component,
componentPackageDeps = cpds,
- componentPackageRenaming = cprns
+ componentIncludes = includes
}
where
+
+ -- TODO configIPID should have name changed
+ cid = computeComponentId (configIPID cfg) (package pkg_descr)
+ (componentName component)
+ (getDeps (componentName component))
+ flagAssignment
+ uid = SimpleUnitId cid
+ PackageIdentifier pkg_name pkg_ver = package pkg_descr
+ compat_name = computeCompatPackageName pkg_name (componentName component)
+ compat_key = computeCompatPackageKey comp compat_name pkg_ver uid
+
bi = componentBuildInfo component
- dedup = Map.toList . Map.fromList
+
+ lookupInternalPkg :: PackageId -> UnitId
+ lookupInternalPkg pkgid = do
+ let matcher (clbi, _)
+ | CLibName str <- componentLocalName clbi
+ , str == display (pkgName pkgid)
+ = Just (componentUnitId clbi)
+ matcher _ = Nothing
+ case catMaybes (map matcher internalComps) of
+ [x] -> x
+ _ -> error "lookupInternalPkg"
+
cpds = if newPackageDepsBehaviour pkg_descr
then dedup $
- [ (Installed.installedPackageId pkg, packageId pkg)
+ [ (Installed.installedUnitId pkg, packageId pkg)
| pkg <- selectSubset bi externalPkgDeps ]
- ++ [ (inplacePackageId pkgid, pkgid)
+ ++ [ (lookupInternalPkg pkgid, pkgid)
| pkgid <- selectSubset bi internalPkgDeps ]
- else [ (Installed.installedPackageId pkg, packageId pkg)
+ else [ (Installed.installedUnitId pkg, packageId pkg)
| pkg <- externalPkgDeps ]
+ includes = map (\(i,p) -> (i,lookupRenaming p cprns)) cpds
cprns = if newPackageDepsBehaviour pkg_descr
- then Map.unionWith mappend
- -- We need hole dependencies passed to GHC, so add them here
- -- (but note that they're fully thinned out. If they
- -- appeared legitimately the monoid instance will
- -- fill them out.
- (Map.fromList [(packageName pkg, mempty) | pkg <- holePkgDeps])
- (targetBuildRenaming bi)
- -- Hack: if we have old package-deps behavior, it's impossible
- -- for non-default renamings to be used, because the Cabal
- -- version is too early. This is a good, because while all the
- -- deps were bundled up in buildDepends, we didn't do this for
- -- renamings, so it's not even clear how to get the merged
- -- version. So just assume that all of them are the default..
- else Map.fromList (map (\(_,pid) -> (packageName pid, defaultRenaming)) cpds)
+ then targetBuildRenaming bi
+ else Map.empty
+
+ dedup = Map.toList . Map.fromList
+
+ -- TODO: this should include internal deps too
+ getDeps :: ComponentName -> [ComponentId]
+ getDeps cname =
+ let externalPkgs
+ = maybe [] (\lib -> selectSubset (componentBuildInfo lib)
+ externalPkgDeps)
+ (lookupComponent pkg_descr cname)
+ in map Installed.installedComponentId externalPkgs
selectSubset :: Package pkg => BuildInfo -> [pkg] -> [pkg]
selectSubset bi pkgs =
[ pkg | pkg <- pkgs, packageName pkg `elem` names bi ]
+ names :: BuildInfo -> [PackageName]
names bi = [ name | Dependency name _ <- targetBuildDepends bi ]
-- | Given the author-specified re-export declarations from the .cabal file,
@@ -1405,12 +1771,14 @@ mkComponentsLocalBuildInfo comp installedPackages pkg_descr
--
resolveModuleReexports :: InstalledPackageIndex
-> PackageId
+ -> UnitId
-> [InstalledPackageInfo]
-> Library
-> Either [(ModuleReexport, String)] -- errors
[Installed.ExposedModule] -- ok
-resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
- case partitionEithers (map resolveModuleReexport (PD.reexportedModules lib)) of
+resolveModuleReexports installedPackages srcpkgid key externalPkgDeps lib =
+ case partitionEithers
+ (map resolveModuleReexport (PD.reexportedModules lib)) of
([], ok) -> Right ok
(errs, _) -> Left errs
where
@@ -1425,9 +1793,10 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
exposedModule)])
-- The package index here contains all the indirect deps of the
-- package we're configuring, but we want just the direct deps
- | let directDeps = Set.fromList (map Installed.installedPackageId externalPkgDeps)
+ | let directDeps = Set.fromList
+ (map Installed.installedUnitId externalPkgDeps)
, pkg <- PackageIndex.allPackages installedPackages
- , Installed.installedPackageId pkg `Set.member` directDeps
+ , Installed.installedUnitId pkg `Set.member` directDeps
, let exportingPackageName = packageName pkg
, exposedModule <- visibleModuleDetails pkg
]
@@ -1436,14 +1805,11 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
++ otherModules (libBuildInfo lib)
, let exportingPackageName = packageName srcpkgid
definingModuleName = visibleModuleName
- -- we don't know the InstalledPackageId of this package yet
- -- we will fill it in later, before registration.
- definingPackageId = InstalledPackageId ""
- originalModule = Installed.OriginalModule definingPackageId
- definingModuleName
+ definingPackageId = key
+ originalModule = Module definingPackageId
+ definingModuleName
exposedModule = Installed.ExposedModule visibleModuleName
(Just originalModule)
- Nothing
]
-- All the modules exported from this package and their defining name and
@@ -1456,9 +1822,11 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
case Installed.exposedReexport exposedModule of
-- The first case is the modules actually defined in this package.
-- In this case the reexport will point to this package.
- Nothing -> return exposedModule { Installed.exposedReexport =
- Just (Installed.OriginalModule (Installed.installedPackageId pkg)
- (Installed.exposedName exposedModule)) }
+ Nothing -> return exposedModule {
+ Installed.exposedReexport =
+ Just (Module
+ (Installed.installedUnitId pkg)
+ (Installed.exposedName exposedModule)) }
-- On the other hand, a visible module might actually be itself
-- a re-export! In this case, the re-export info for the package
-- doing the re-export will point us to the original defining
@@ -1483,8 +1851,9 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
case (matches, moriginalPackageName) of
((_, exposedModule):rest, _)
-- TODO: Refine this check for signatures
- | all (\(_, exposedModule') -> Installed.exposedReexport exposedModule
- == Installed.exposedReexport exposedModule') rest
+ | all (\(_, exposedModule') ->
+ Installed.exposedReexport exposedModule
+ == Installed.exposedReexport exposedModule') rest
-> Right exposedModule { Installed.exposedName = newName }
([], Just originalPackageName)
@@ -1569,7 +1938,11 @@ checkForeignDeps pkg lbi verbosity = do
libExists lib = builds (makeProgram []) (makeLdArgs [lib])
commonCppArgs = platformDefines lbi
- ++ [ "-I" ++ autogenModulesDir lbi ]
+ -- TODO: This is a massive hack, to work around the
+ -- fact that the test performed here should be
+ -- PER-component (c.f. the "I'm Feeling Lucky"; we
+ -- should NOT be glomming everything together.)
+ ++ [ "-I" ++ buildDir lbi </> "autogen" ]
++ [ "-I" ++ dir | dir <- collectField PD.includeDirs ]
++ ["-I."]
++ collectField PD.cppOptions
@@ -1729,6 +2102,9 @@ checkRelocatable verbosity pkg lbi
$ die $ "Installation directories are not prefix_relative:\n" ++
show installDirs
where
+ -- NB: should be good enough to check this against the default
+ -- component ID, but if we wanted to be strictly correct we'd
+ -- check for each ComponentId.
installDirs = absoluteInstallDirs pkg lbi NoCopyDest
p = prefix installDirs
relativeInstallDirs (InstallDirs {..}) =
@@ -1750,6 +2126,9 @@ checkRelocatable verbosity pkg lbi
(Installed.libraryDirs ipkg)
| otherwise
= return ()
+ -- NB: should be good enough to check this against the default
+ -- component ID, but if we wanted to be strictly correct we'd
+ -- check for each ComponentId.
installDirs = absoluteInstallDirs pkg lbi NoCopyDest
p = prefix installDirs
ipkgs = PackageIndex.allPackages (installedPkgs lbi)
diff --git a/cabal/Cabal/Distribution/Simple/GHC.hs b/cabal/Cabal/Distribution/Simple/GHC.hs
index ee3df77..d34d0a8 100644
--- a/cabal/Cabal/Distribution/Simple/GHC.hs
+++ b/cabal/Cabal/Distribution/Simple/GHC.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE PatternGuards #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.GHC
@@ -33,7 +34,10 @@
module Distribution.Simple.GHC (
getGhcInfo,
- configure, getInstalledPackages, getPackageDBContents,
+ configure,
+ getInstalledPackages,
+ getInstalledPackagesMonitorFiles,
+ getPackageDBContents,
buildLib, buildExe,
replLib, replExe,
startInterpreter,
@@ -49,74 +53,52 @@ module Distribution.Simple.GHC (
pkgRoot
) where
-import qualified Distribution.Simple.GHC.IPI641 as IPI641
+import Control.Applicative -- 7.10 -Werror workaround
+import Prelude -- https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#GHCsaysTheimportof...isredundant
+
import qualified Distribution.Simple.GHC.IPI642 as IPI642
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.Simple.GHC.ImplInfo
import Distribution.PackageDescription as PD
- ( PackageDescription(..), BuildInfo(..), Executable(..), Library(..)
- , allExtensions, libModules, exeModules
- , hcOptions, hcSharedOptions, hcProfOptions )
-import Distribution.InstalledPackageInfo
- ( InstalledPackageInfo )
+import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
- ( InstalledPackageInfo(..) )
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
- , absoluteInstallDirs, depLibraryPaths )
import qualified Distribution.Simple.Hpc as Hpc
-import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
- ( PackageName(..) )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
- ( Program(..), ConfiguredProgram(..), ProgramConfiguration
- , ProgramSearchPath
- , rawSystemProgramStdout, rawSystemProgramStdoutConf
- , getProgramInvocationOutput, requireProgramVersion, requireProgram
- , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
- , ghcProgram, ghcPkgProgram, haddockProgram, hsc2hsProgram, ldProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar as Ar
import qualified Distribution.Simple.Program.Ld as Ld
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
- ( toFlag, fromFlag, fromFlagOrDefault, configCoverage, configDistPref )
import qualified Distribution.Simple.Setup as Cabal
- ( Flag(..) )
-import Distribution.Simple.Compiler
- ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
- , PackageDB(..), PackageDBStack, AbiTag(..) )
+import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Version
- ( Version(..), anyVersion, orLaterVersion )
import Distribution.System
- ( Platform(..), OS(..) )
import Distribution.Verbosity
import Distribution.Text
- ( display )
import Distribution.Utils.NubList
- ( NubListR, overNubListR, toNubListR )
-import Language.Haskell.Extension (Extension(..), KnownExtension(..))
+import Language.Haskell.Extension
import Control.Monad ( unless, when )
import Data.Char ( isDigit, isSpace )
import Data.List
-import qualified Data.Map as M ( fromList )
+import qualified Data.Map as M ( fromList, lookup )
import Data.Maybe ( catMaybes )
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid ( Monoid(..) )
-#endif
+import Data.Monoid as Mon ( Monoid(..) )
import Data.Version ( showVersion )
import System.Directory
- ( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing )
-import System.FilePath ( (</>), (<.>), takeExtension,
- takeDirectory, replaceExtension,
- splitExtension, isRelative )
+ ( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing
+ , canonicalizePath )
+import System.FilePath ( (</>), (<.>), takeExtension
+ , takeDirectory, replaceExtension
+ , isRelative )
import qualified System.Info
-- -----------------------------------------------------------------------------
@@ -129,7 +111,7 @@ configure verbosity hcPath hcPkgPath conf0 = do
(ghcProg, ghcVersion, conf1) <-
requireProgramVersion verbosity ghcProgram
- (orLaterVersion (Version [6,4] []))
+ (orLaterVersion (Version [6,11] []))
(userMaybeSpecifyPath "ghc" hcPath conf0)
let implInfo = ghcVersionImplInfo ghcVersion
@@ -154,15 +136,29 @@ configure verbosity hcPath hcPkgPath conf0 = do
haddockProgram' = haddockProgram {
programFindLocation = guessHaddockFromGhcPath ghcProg
}
+ hpcProgram' = hpcProgram {
+ programFindLocation = guessHpcFromGhcPath ghcProg
+ }
conf3 = addKnownProgram haddockProgram' $
- addKnownProgram hsc2hsProgram' conf2
+ addKnownProgram hsc2hsProgram' $
+ addKnownProgram hpcProgram' conf2
languages <- Internal.getLanguages verbosity implInfo ghcProg
- extensions <- Internal.getExtensions verbosity implInfo ghcProg
+ extensions0 <- Internal.getExtensions verbosity implInfo ghcProg
ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg
let ghcInfoMap = M.fromList ghcInfo
+ -- starting with GHC 8.0, `TemplateHaskell` will be omitted from
+ -- `--supported-extensions` when it's not available.
+ -- for older GHCs we can use the "Have interpreter" property to
+ -- filter out `TemplateHaskell`
+ extensions | ghcVersion < Version [8] []
+ , Just "NO" <- M.lookup "Have interpreter" ghcInfoMap
+ = filter ((/= EnableExtension TemplateHaskell) . fst)
+ extensions0
+ | otherwise = extensions0
+
let comp = Compiler {
compilerId = CompilerId GHC ghcVersion,
compilerAbiTag = NoAbiTag,
@@ -186,30 +182,42 @@ configure verbosity hcPath hcPkgPath conf0 = do
--
guessToolFromGhcPath :: Program -> ConfiguredProgram
-> Verbosity -> ProgramSearchPath
- -> IO (Maybe FilePath)
+ -> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath tool ghcProg verbosity searchpath
= do let toolname = programName tool
- path = programPath ghcProg
- dir = takeDirectory path
- versionSuffix = takeVersionSuffix (dropExeExtension path)
- guessNormal = dir </> toolname <.> exeExtension
- guessGhcVersioned = dir </> (toolname ++ "-ghc" ++ versionSuffix)
- <.> exeExtension
- guessVersioned = dir </> (toolname ++ versionSuffix)
- <.> exeExtension
- guesses | null versionSuffix = [guessNormal]
- | otherwise = [guessGhcVersioned,
- guessVersioned,
- guessNormal]
+ given_path = programPath ghcProg
+ given_dir = takeDirectory given_path
+ real_path <- canonicalizePath given_path
+ let real_dir = takeDirectory real_path
+ versionSuffix path = takeVersionSuffix (dropExeExtension path)
+ given_suf = versionSuffix given_path
+ real_suf = versionSuffix real_path
+ guessNormal dir = dir </> toolname <.> exeExtension
+ guessGhcVersioned dir suf = dir </> (toolname ++ "-ghc" ++ suf)
+ <.> exeExtension
+ guessVersioned dir suf = dir </> (toolname ++ suf)
+ <.> exeExtension
+ mkGuesses dir suf | null suf = [guessNormal dir]
+ | otherwise = [guessGhcVersioned dir suf,
+ guessVersioned dir suf,
+ guessNormal dir]
+ guesses = mkGuesses given_dir given_suf ++
+ if real_path == given_path
+ then []
+ else mkGuesses real_dir real_suf
info verbosity $ "looking for tool " ++ toolname
- ++ " near compiler in " ++ dir
+ ++ " near compiler in " ++ given_dir
+ debug verbosity $ "candidate locations: " ++ show guesses
exists <- mapM doesFileExist guesses
case [ file | (file, True) <- zip guesses exists ] of
-- If we can't find it near ghc, fall back to the usual
-- method.
[] -> programFindLocation tool verbosity searchpath
(fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
- return (Just fp)
+ let lookedAt = map fst
+ . takeWhile (\(_file, exist) -> not exist)
+ $ zip guesses exists
+ return (Just (fp, lookedAt))
where takeVersionSuffix :: FilePath -> String
takeVersionSuffix = takeWhileEndLE isSuffixChar
@@ -217,12 +225,6 @@ guessToolFromGhcPath tool ghcProg verbosity searchpath
isSuffixChar :: Char -> Bool
isSuffixChar c = isDigit c || c == '.' || c == '-'
- dropExeExtension :: FilePath -> FilePath
- dropExeExtension filepath =
- case splitExtension filepath of
- (filepath', extension) | extension == exeExtension -> filepath'
- | otherwise -> filepath
-
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding ghc-pkg, we try looking for both a versioned and unversioned
-- ghc-pkg in the same dir, that is:
@@ -232,7 +234,8 @@ guessToolFromGhcPath tool ghcProg verbosity searchpath
-- > /usr/local/bin/ghc-pkg(.exe)
--
guessGhcPkgFromGhcPath :: ConfiguredProgram
- -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
+ -> Verbosity -> ProgramSearchPath
+ -> IO (Maybe (FilePath, [FilePath]))
guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
@@ -244,7 +247,8 @@ guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
-- > /usr/local/bin/hsc2hs(.exe)
--
guessHsc2hsFromGhcPath :: ConfiguredProgram
- -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
+ -> Verbosity -> ProgramSearchPath
+ -> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
@@ -256,9 +260,16 @@ guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
-- > /usr/local/bin/haddock(.exe)
--
guessHaddockFromGhcPath :: ConfiguredProgram
- -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
+ -> Verbosity -> ProgramSearchPath
+ -> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcPath = guessToolFromGhcPath haddockProgram
+guessHpcFromGhcPath :: ConfiguredProgram
+ -> Verbosity -> ProgramSearchPath
+ -> IO (Maybe (FilePath, [FilePath]))
+guessHpcFromGhcPath = guessToolFromGhcPath hpcProgram
+
+
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
where
@@ -273,7 +284,8 @@ getPackageDBContents verbosity packagedb conf = do
toPackageIndex verbosity pkgss conf
-- | Given a package DB stack, return all installed packages.
-getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack -> ProgramConfiguration
+getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack
+ -> ProgramConfiguration
-> IO InstalledPackageIndex
getInstalledPackages verbosity comp packagedbs conf = do
checkPackageDbEnvVar
@@ -304,7 +316,7 @@ toPackageIndex verbosity pkgss conf = do
topDir <- getLibDir' verbosity ghcProg
let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
| (_, pkgs) <- pkgss ]
- return $! (mconcat indices)
+ return $! mconcat indices
where
Just ghcProg = lookupProgram ghcProgram conf
@@ -327,6 +339,23 @@ getGlobalPackageDB verbosity ghcProg =
dropWhileEndLE isSpace `fmap`
rawSystemProgramStdout verbosity ghcProg ["--print-global-package-db"]
+-- | Return the 'FilePath' to the per-user GHC package database.
+getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
+getUserPackageDB _verbosity ghcProg (Platform arch os) = do
+ -- It's rather annoying that we have to reconstruct this, because ghc
+ -- hides this information from us otherwise. But for certain use cases
+ -- like change monitoring it really can't remain hidden.
+ appdir <- getAppUserDataDirectory "ghc"
+ return (appdir </> platformAndVersion </> packageConfFileName)
+ where
+ platformAndVersion = intercalate "-" [ Internal.showArchString arch
+ , Internal.showOsString os
+ , display ghcVersion ]
+ packageConfFileName
+ | ghcVersion >= Version [6,12] [] = "package.conf.d"
+ | otherwise = "package.conf"
+ Just ghcVersion = programVersion ghcProg
+
checkPackageDbEnvVar :: IO ()
checkPackageDbEnvVar =
Internal.checkPackageDbEnvVar "GHC" "GHC_PACKAGE_PATH"
@@ -405,14 +434,41 @@ getInstalledPackages' verbosity packagedbs conf = do
= \file content -> case reads content of
[(pkgs, _)] -> return (map IPI642.toCurrent pkgs)
_ -> failToRead file
+ -- We dropped support for 6.4.2 and earlier.
| otherwise
- = \file content -> case reads content of
- [(pkgs, _)] -> return (map IPI641.toCurrent pkgs)
- _ -> failToRead file
+ = \file _ -> failToRead file
Just ghcProg = lookupProgram ghcProgram conf
Just ghcVersion = programVersion ghcProg
failToRead file = die $ "cannot read ghc package database " ++ file
+getInstalledPackagesMonitorFiles :: Verbosity -> Platform
+ -> ProgramConfiguration
+ -> [PackageDB]
+ -> IO [FilePath]
+getInstalledPackagesMonitorFiles verbosity platform progdb =
+ mapM getPackageDBPath
+ where
+ getPackageDBPath :: PackageDB -> IO FilePath
+ getPackageDBPath GlobalPackageDB =
+ selectMonitorFile =<< getGlobalPackageDB verbosity ghcProg
+
+ getPackageDBPath UserPackageDB =
+ selectMonitorFile =<< getUserPackageDB verbosity ghcProg platform
+
+ getPackageDBPath (SpecificPackageDB path) = selectMonitorFile path
+
+ -- GHC has old style file dbs, and new style directory dbs.
+ -- Note that for dir style dbs, we only need to monitor the cache file, not
+ -- the whole directory. The ghc program itself only reads the cache file
+ -- so it's safe to only monitor this one file.
+ selectMonitorFile path = do
+ isFileStyle <- doesFileExist path
+ if isFileStyle then return path
+ else return (path </> "package.cache")
+
+ Just ghcProg = lookupProgram ghcProgram progdb
+
+
-- -----------------------------------------------------------------------------
-- Building
@@ -428,8 +484,8 @@ buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
- let libName = componentLibraryName clbi
- libTargetDir = buildDir lbi
+ let uid = componentUnitId clbi
+ libTargetDir = componentBuildDir lbi clbi
whenVanillaLib forceVanilla =
when (forceVanilla || withVanillaLib lbi)
whenProfLib = when (withProfLib lbi)
@@ -440,10 +496,10 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
comp = compiler lbi
ghcVersion = compilerVersion comp
implInfo = getImplInfo comp
- (Platform _hostArch hostOS) = hostPlatform lbi
+ platform@(Platform _hostArch hostOS) = hostPlatform lbi
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
- let runGhcProg = runGHC verbosity ghcProg comp
+ let runGhcProg = runGHC verbosity ghcProg comp platform
libBi <- hackThreadedFlag verbosity
comp (withProfLib lbi) (libBuildInfo lib)
@@ -458,13 +514,15 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
- -- Component name. Not 'libName' because that has the "HS" prefix
- -- that GHC gives Haskell libraries.
- cname = display $ PD.package $ localPkgDescr lbi
+ -- TODO: Historically HPC files have been put into a directory which
+ -- has the package name. I'm going to avoid changing this for
+ -- now, but it would probably be better for this to be the
+ -- component ID instead...
+ pkg_name = display $ PD.package $ localPkgDescr lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
- | forRepl = mempty -- HPC is not supported in ghci
- | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way cname
+ | forRepl = Mon.mempty -- HPC is not supported in ghci
+ | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
| otherwise = mempty
createDirectoryIfMissingVerbose verbosity True libTargetDir
@@ -498,17 +556,20 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
ghcOptHPCDir = hpcdir Hpc.Dyn
}
linkerOpts = mempty {
- ghcOptLinkOptions = toNubListR $ PD.ldOptions libBi,
- ghcOptLinkLibs = toNubListR $ extraLibs libBi,
- ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
- ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
+ ghcOptLinkOptions = toNubListR $ PD.ldOptions libBi,
+ ghcOptLinkLibs = toNubListR $ extraLibs libBi,
+ ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
+ ghcOptLinkFrameworks = toNubListR $
+ PD.frameworks libBi,
+ ghcOptLinkFrameworkDirs = toNubListR $
+ PD.extraFrameworkDirs libBi,
ghcOptInputFiles = toNubListR
[libTargetDir </> x | x <- cObjs]
}
replOpts = vanillaOpts {
ghcOptExtra = overNubListR
Internal.filterGhciFlags $
- (ghcOptExtra vanillaOpts),
+ ghcOptExtra vanillaOpts,
ghcOptNumJobs = mempty
}
`mappend` linkerOpts
@@ -535,7 +596,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
then do
runGhcProg vanillaSharedOpts
case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of
- (Cabal.Flag dynDir, Cabal.Flag vanillaDir) -> do
+ (Cabal.Flag dynDir, Cabal.Flag vanillaDir) ->
-- When the vanilla and shared library builds are done
-- in one pass, only one set of HPC module interfaces
-- are generated. This set should suffice for both
@@ -571,12 +632,13 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
}
odir = fromFlag (ghcOptObjDir vanillaCcOpts)
createDirectoryIfMissingVerbose verbosity True odir
- needsRecomp <- checkNeedsRecompilation filename vanillaCcOpts
- when needsRecomp $ do
- runGhcProg vanillaCcOpts
- unless forRepl $
- whenSharedLib forceSharedLib (runGhcProg sharedCcOpts)
- unless forRepl $ whenProfLib (runGhcProg profCcOpts)
+ let runGhcProgIfNeeded ccOpts = do
+ needsRecomp <- checkNeedsRecompilation filename ccOpts
+ when needsRecomp $ runGhcProg ccOpts
+ runGhcProgIfNeeded vanillaCcOpts
+ unless forRepl $
+ whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCcOpts)
+ unless forRepl $ whenProfLib (runGhcProgIfNeeded profCcOpts)
| filename <- cSources libBi]
-- TODO: problem here is we need the .c files built first, so we can load them
@@ -594,25 +656,25 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
(cSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
(cSources libBi)
- cid = compilerId (compiler lbi)
- vanillaLibFilePath = libTargetDir </> mkLibName libName
- profileLibFilePath = libTargetDir </> mkProfLibName libName
- sharedLibFilePath = libTargetDir </> mkSharedLibName cid libName
- ghciLibFilePath = libTargetDir </> Internal.mkGHCiLibName libName
- libInstallPath = libdir $ absoluteInstallDirs pkg_descr lbi NoCopyDest
- sharedLibInstallPath = libInstallPath </> mkSharedLibName cid libName
-
- stubObjs <- fmap catMaybes $ sequence
+ compiler_id = compilerId (compiler lbi)
+ vanillaLibFilePath = libTargetDir </> mkLibName uid
+ profileLibFilePath = libTargetDir </> mkProfLibName uid
+ sharedLibFilePath = libTargetDir </> mkSharedLibName compiler_id uid
+ ghciLibFilePath = libTargetDir </> Internal.mkGHCiLibName uid
+ libInstallPath = libdir $ absoluteComponentInstallDirs pkg_descr lbi uid NoCopyDest
+ sharedLibInstallPath = libInstallPath </> mkSharedLibName compiler_id uid
+
+ stubObjs <- catMaybes <$> sequence
[ findFileWithExtension [objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
, x <- libModules lib ]
- stubProfObjs <- fmap catMaybes $ sequence
+ stubProfObjs <- catMaybes <$> sequence
[ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
, x <- libModules lib ]
- stubSharedObjs <- fmap catMaybes $ sequence
+ stubSharedObjs <- catMaybes <$> sequence
[ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
@@ -621,12 +683,12 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
hObjs <- Internal.getHaskellObjects implInfo lib lbi
libTargetDir objExtension True
hProfObjs <-
- if (withProfLib lbi)
+ if withProfLib lbi
then Internal.getHaskellObjects implInfo lib lbi
libTargetDir ("p_" ++ objExtension) True
else return []
hSharedObjs <-
- if (withSharedLib lbi)
+ if withSharedLib lbi
then Internal.getHaskellObjects implInfo lib lbi
libTargetDir ("dyn_" ++ objExtension) False
else return []
@@ -659,11 +721,13 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptInputFiles = toNubListR dynamicObjectFiles,
ghcOptOutputFile = toFlag sharedLibFilePath,
+ ghcOptExtra = toNubListR $
+ hcSharedOptions GHC libBi,
-- For dynamic libs, Mac OS/X needs to know the install location
-- at build time. This only applies to GHC < 7.8 - see the
-- discussion in #1660.
- ghcOptDylibName = if (hostOS == OSX
- && ghcVersion < Version [7,8] [])
+ ghcOptDylibName = if hostOS == OSX
+ && ghcVersion < Version [7,8] []
then toFlag sharedLibInstallPath
else mempty,
ghcOptNoAutoLinkPackages = toFlag True,
@@ -673,15 +737,17 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
ghcOptLinkLibs = toNubListR $ extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
+ ghcOptLinkFrameworkDirs =
+ toNubListR $ PD.extraFrameworkDirs libBi,
ghcOptRPaths = rpaths
}
info verbosity (show (ghcOptPackages ghcSharedLinkArgs))
- whenVanillaLib False $ do
+ whenVanillaLib False $
Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
- whenProfLib $ do
+ whenProfLib $
Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
whenGHCiLib $ do
@@ -693,16 +759,16 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
runGhcProg ghcSharedLinkArgs
-- | Start a REPL without loading any source files.
-startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler
+startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler -> Platform
-> PackageDBStack -> IO ()
-startInterpreter verbosity conf comp packageDBs = do
+startInterpreter verbosity conf comp platform packageDBs = do
let replOpts = mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptPackageDBs = packageDBs
}
checkPackageDbStack comp packageDBs
(ghcProg, _) <- requireProgram verbosity ghcProgram conf
- runGHC verbosity ghcProg comp replOpts
+ runGHC verbosity ghcProg comp platform replOpts
-- | Build an executable with GHC.
--
@@ -720,8 +786,9 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let comp = compiler lbi
+ platform = hostPlatform lbi
implInfo = getImplInfo comp
- runGhcProg = runGHC verbosity ghcProg comp
+ runGhcProg = runGHC verbosity ghcProg comp platform
exeBi <- hackThreadedFlag verbosity
comp (withProfExe lbi) (buildInfo exe)
@@ -732,8 +799,8 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
then exeExtension
else "")
- let targetDir = (buildDir lbi) </> exeName'
- let exeDir = targetDir </> (exeName' ++ "-tmp")
+ let targetDir = componentBuildDir lbi clbi
+ exeDir = targetDir </> (exeName' ++ "-tmp")
createDirectoryIfMissingVerbose verbosity True targetDir
createDirectoryIfMissingVerbose verbosity True exeDir
-- TODO: do we need to put hs-boot files into place for mutually recursive
@@ -773,10 +840,11 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
profOpts = baseOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptProfilingAuto = Internal.profDetailLevelFlag False
- (withProfExeDetail lbi),
+ (withProfExeDetail lbi),
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
- ghcOptExtra = toNubListR (hcProfOptions GHC exeBi),
+ ghcOptExtra = toNubListR
+ (hcProfOptions GHC exeBi),
ghcOptHPCDir = hpcdir Hpc.Prof
}
dynOpts = baseOpts `mappend` mempty {
@@ -794,10 +862,13 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
ghcOptHPCDir = hpcdir Hpc.Dyn
}
linkerOpts = mempty {
- ghcOptLinkOptions = toNubListR $ PD.ldOptions exeBi,
- ghcOptLinkLibs = toNubListR $ extraLibs exeBi,
- ghcOptLinkLibPath = toNubListR $ extraLibDirs exeBi,
- ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi,
+ ghcOptLinkOptions = toNubListR $ PD.ldOptions exeBi,
+ ghcOptLinkLibs = toNubListR $ extraLibs exeBi,
+ ghcOptLinkLibPath = toNubListR $ extraLibDirs exeBi,
+ ghcOptLinkFrameworks = toNubListR $
+ PD.frameworks exeBi,
+ ghcOptLinkFrameworkDirs = toNubListR $
+ PD.extraFrameworkDirs exeBi,
ghcOptInputFiles = toNubListR
[exeDir </> x | x <- cObjs]
}
@@ -846,10 +917,11 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
| isGhcDynamic = doingTH && (withProfExe lbi || withStaticExe)
| otherwise = doingTH && (withProfExe lbi || withDynExe lbi)
- linkOpts = commonOpts `mappend`
- linkerOpts `mappend`
- mempty { ghcOptLinkNoHsMain = toFlag (not isHaskellMain) } `mappend`
- (if withDynExe lbi then dynLinkerOpts else mempty)
+ linkOpts =
+ commonOpts `mappend`
+ linkerOpts `mappend`
+ mempty { ghcOptLinkNoHsMain = toFlag (not isHaskellMain) } `mappend`
+ (if withDynExe lbi then dynLinkerOpts else mempty)
-- Build static/dynamic object files for TH, if needed.
when compileForTH $
@@ -874,7 +946,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
odir = fromFlag (ghcOptObjDir opts)
createDirectoryIfMissingVerbose verbosity True odir
needsRecomp <- checkNeedsRecompilation filename opts
- when needsRecomp $
+ when needsRecomp $
runGhcProg opts
| filename <- cSrcs ]
@@ -974,8 +1046,9 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
(compiler lbi) (withProfLib lbi) (libBuildInfo lib)
let
comp = compiler lbi
+ platform = hostPlatform lbi
vanillaArgs =
- (componentGhcOptions verbosity lbi libBi clbi (buildDir lbi))
+ (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
`mappend` mempty {
ghcOptMode = toFlag GhcModeAbiHash,
ghcOptInputModules = toNubListR $ exposedModules lib
@@ -995,14 +1068,15 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = toNubListR $ hcProfOptions GHC libBi
}
- ghcArgs = if withVanillaLib lbi then vanillaArgs
- else if withSharedLib lbi then sharedArgs
- else if withProfLib lbi then profArgs
- else error "libAbiHash: Can't find an enabled library way"
- --
+ ghcArgs
+ | withVanillaLib lbi = vanillaArgs
+ | withSharedLib lbi = sharedArgs
+ | withProfLib lbi = profArgs
+ | otherwise = error "libAbiHash: Can't find an enabled library way"
+
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
hash <- getProgramInvocationOutput verbosity
- (ghcInvocation ghcProg comp ghcArgs)
+ (ghcInvocation ghcProg comp platform ghcArgs)
return (takeWhile (not . isSpace) hash)
componentGhcOptions :: Verbosity -> LocalBuildInfo
@@ -1057,19 +1131,24 @@ installLib :: Verbosity
-> Library
-> ComponentLocalBuildInfo
-> IO ()
-installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
+installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
-- copy .hi files over:
- whenVanilla $ copyModuleFiles "hi"
- whenProf $ copyModuleFiles "p_hi"
- whenShared $ copyModuleFiles "dyn_hi"
+ whenRegistered $ do
+ whenVanilla $ copyModuleFiles "hi"
+ whenProf $ copyModuleFiles "p_hi"
+ whenShared $ copyModuleFiles "dyn_hi"
-- copy the built library files over:
- whenVanilla $ installOrdinary builtDir targetDir vanillaLibName
- whenProf $ installOrdinary builtDir targetDir profileLibName
- whenGHCi $ installOrdinary builtDir targetDir ghciLibName
- whenShared $ installShared builtDir dynlibTargetDir sharedLibName
+ whenRegistered $ do
+ whenVanilla $ installOrdinary builtDir targetDir vanillaLibName
+ whenProf $ installOrdinary builtDir targetDir profileLibName
+ whenGHCi $ installOrdinary builtDir targetDir ghciLibName
+ whenRegisteredOrDynExecutable $ do
+ whenShared $ installShared builtDir dynlibTargetDir sharedLibName
where
+ builtDir = componentBuildDir lbi clbi
+
install isShared srcDir dstDir name = do
let src = srcDir </> name
dst = dstDir </> name
@@ -1089,12 +1168,12 @@ installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
findModuleFiles [builtDir] [ext] (libModules lib)
>>= installOrdinaryFiles verbosity targetDir
- cid = compilerId (compiler lbi)
- libName = componentLibraryName clbi
- vanillaLibName = mkLibName libName
- profileLibName = mkProfLibName libName
- ghciLibName = Internal.mkGHCiLibName libName
- sharedLibName = (mkSharedLibName cid) libName
+ compiler_id = compilerId (compiler lbi)
+ uid = componentUnitId clbi
+ vanillaLibName = mkLibName uid
+ profileLibName = mkProfLibName uid
+ ghciLibName = Internal.mkGHCiLibName uid
+ sharedLibName = (mkSharedLibName compiler_id) uid
hasLib = not $ null (libModules lib)
&& null (cSources (libBuildInfo lib))
@@ -1103,6 +1182,17 @@ installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
whenGHCi = when (hasLib && withGHCiLib lbi)
whenShared = when (hasLib && withSharedLib lbi)
+ -- Some files (e.g. interface files) are completely unnecessary when
+ -- we are not actually going to register the library. A library is
+ -- not registered if there is no "public library", e.g. in the case
+ -- that we have an internal library and executables, but no public
+ -- library.
+ whenRegistered = when (hasPublicLib pkg)
+
+ -- However, we must always install dynamic libraries when linking
+ -- dynamic executables, because we'll try to load them!
+ whenRegisteredOrDynExecutable = when (hasPublicLib pkg || (hasExes pkg && withDynExe lbi))
+
-- -----------------------------------------------------------------------------
-- Registering
@@ -1111,7 +1201,10 @@ hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcPkgProg
, HcPkg.noPkgDbStack = v < [6,9]
, HcPkg.noVerboseFlag = v < [6,11]
, HcPkg.flagPackageConf = v < [7,5]
- , HcPkg.useSingleFileDb = v < [7,9]
+ , HcPkg.supportsDirDbs = v >= [6,8]
+ , HcPkg.requiresDirDbs = v >= [7,10]
+ , HcPkg.nativeMultiInstance = v >= [7,10]
+ , HcPkg.recacheMultiInstance = v >= [6,12]
}
where
v = versionBranch ver
@@ -1120,15 +1213,19 @@ hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcPkgProg
registerPackage
:: Verbosity
- -> InstalledPackageInfo
- -> PackageDescription
- -> LocalBuildInfo
- -> Bool
+ -> ProgramConfiguration
+ -> HcPkg.MultiInstance
-> PackageDBStack
+ -> InstalledPackageInfo
-> IO ()
-registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs =
- HcPkg.reregister (hcPkgInfo $ withPrograms lbi) verbosity
- packageDbs (Right installedPkgInfo)
+registerPackage verbosity progdb multiInstance packageDbs installedPkgInfo
+ | HcPkg.MultiInstance <- multiInstance
+ = HcPkg.registerMultiInstance (hcPkgInfo progdb) verbosity
+ packageDbs installedPkgInfo
+
+ | otherwise
+ = HcPkg.reregister (hcPkgInfo progdb) verbosity
+ packageDbs (Right installedPkgInfo)
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
pkgRoot verbosity lbi = pkgRoot'
diff --git a/cabal/Cabal/Distribution/Simple/GHC/IPI641.hs b/cabal/Cabal/Distribution/Simple/GHC/IPI641.hs
deleted file mode 100644
index 4bb995d..0000000
--- a/cabal/Cabal/Distribution/Simple/GHC/IPI641.hs
+++ /dev/null
@@ -1,106 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Distribution.Simple.GHC.IPI641
--- Copyright : (c) The University of Glasgow 2004
--- License : BSD3
---
--- Maintainer : cabal-devel@haskell.org
--- Portability : portable
---
-
-module Distribution.Simple.GHC.IPI641 (
- InstalledPackageInfo(..),
- toCurrent,
- ) where
-
-import qualified Distribution.InstalledPackageInfo as Current
-import qualified Distribution.Package as Current hiding (installedPackageId)
-import Distribution.Text (display)
-
-import Distribution.Simple.GHC.IPI642
- ( PackageIdentifier, convertPackageId
- , License, convertLicense, convertModuleName )
-
--- | This is the InstalledPackageInfo type used by ghc-6.4 and 6.4.1.
---
--- It's here purely for the 'Read' instance so that we can read the package
--- database used by those ghc versions. It is a little hacky to read the
--- package db directly, but we do need the info and until ghc-6.9 there was
--- no better method.
---
--- In ghc-6.4.2 the format changed a bit. See "Distribution.Simple.GHC.IPI642"
---
-data InstalledPackageInfo = InstalledPackageInfo {
- package :: PackageIdentifier,
- license :: License,
- copyright :: String,
- maintainer :: String,
- author :: String,
- stability :: String,
- homepage :: String,
- pkgUrl :: String,
- description :: String,
- category :: String,
- exposed :: Bool,
- exposedModules :: [String],
- hiddenModules :: [String],
- importDirs :: [FilePath],
- libraryDirs :: [FilePath],
- hsLibraries :: [String],
- extraLibraries :: [String],
- includeDirs :: [FilePath],
- includes :: [String],
- depends :: [PackageIdentifier],
- hugsOptions :: [String],
- ccOptions :: [String],
- ldOptions :: [String],
- frameworkDirs :: [FilePath],
- frameworks :: [String],
- haddockInterfaces :: [FilePath],
- haddockHTMLs :: [FilePath]
- }
- deriving Read
-
-mkInstalledPackageId :: Current.PackageIdentifier -> Current.InstalledPackageId
-mkInstalledPackageId = Current.InstalledPackageId . display
-
-toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
-toCurrent ipi@InstalledPackageInfo{} =
- let pid = convertPackageId (package ipi)
- mkExposedModule m = Current.ExposedModule m Nothing Nothing
- in Current.InstalledPackageInfo {
- Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
- Current.sourcePackageId = pid,
- Current.packageKey = Current.OldPackageKey pid,
- Current.license = convertLicense (license ipi),
- Current.copyright = copyright ipi,
- Current.maintainer = maintainer ipi,
- Current.author = author ipi,
- Current.stability = stability ipi,
- Current.homepage = homepage ipi,
- Current.pkgUrl = pkgUrl ipi,
- Current.synopsis = "",
- Current.description = description ipi,
- Current.category = category ipi,
- Current.exposed = exposed ipi,
- Current.exposedModules = map (mkExposedModule . convertModuleName) (exposedModules ipi),
- Current.instantiatedWith = [],
- Current.hiddenModules = map convertModuleName (hiddenModules ipi),
- Current.trusted = Current.trusted Current.emptyInstalledPackageInfo,
- Current.importDirs = importDirs ipi,
- Current.libraryDirs = libraryDirs ipi,
- Current.dataDir = "",
- Current.hsLibraries = hsLibraries ipi,
- Current.extraLibraries = extraLibraries ipi,
- Current.extraGHCiLibraries = [],
- Current.includeDirs = includeDirs ipi,
- Current.includes = includes ipi,
- Current.depends = map (mkInstalledPackageId.convertPackageId) (depends ipi),
- Current.ccOptions = ccOptions ipi,
- Current.ldOptions = ldOptions ipi,
- Current.frameworkDirs = frameworkDirs ipi,
- Current.frameworks = frameworks ipi,
- Current.haddockInterfaces = haddockInterfaces ipi,
- Current.haddockHTMLs = haddockHTMLs ipi,
- Current.pkgRoot = Nothing
- }
diff --git a/cabal/Cabal/Distribution/Simple/GHC/IPI642.hs b/cabal/Cabal/Distribution/Simple/GHC/IPI642.hs
index 25145f1..b5d8566 100644
--- a/cabal/Cabal/Distribution/Simple/GHC/IPI642.hs
+++ b/cabal/Cabal/Distribution/Simple/GHC/IPI642.hs
@@ -11,22 +11,11 @@
module Distribution.Simple.GHC.IPI642 (
InstalledPackageInfo(..),
toCurrent,
-
- -- Don't use these, they're only for conversion purposes
- PackageIdentifier, convertPackageId,
- License, convertLicense,
- convertModuleName
) where
import qualified Distribution.InstalledPackageInfo as Current
-import qualified Distribution.Package as Current hiding (installedPackageId)
-import qualified Distribution.License as Current
-
-import Distribution.Version (Version)
-import Distribution.ModuleName (ModuleName)
-import Distribution.Text (simpleParse,display)
-
-import Data.Maybe
+import qualified Distribution.Package as Current hiding (installedUnitId)
+import Distribution.Simple.GHC.IPIConvert
-- | This is the InstalledPackageInfo type used by ghc-6.4.2 and later.
--
@@ -70,43 +59,15 @@ data InstalledPackageInfo = InstalledPackageInfo {
}
deriving Read
-data PackageIdentifier = PackageIdentifier {
- pkgName :: String,
- pkgVersion :: Version
- }
- deriving Read
-
-data License = GPL | LGPL | BSD3 | BSD4
- | PublicDomain | AllRightsReserved | OtherLicense
- deriving Read
-
-convertPackageId :: PackageIdentifier -> Current.PackageIdentifier
-convertPackageId PackageIdentifier { pkgName = n, pkgVersion = v } =
- Current.PackageIdentifier (Current.PackageName n) v
-
-mkInstalledPackageId :: Current.PackageIdentifier -> Current.InstalledPackageId
-mkInstalledPackageId = Current.InstalledPackageId . display
-
-convertModuleName :: String -> ModuleName
-convertModuleName s = fromJust $ simpleParse s
-
-convertLicense :: License -> Current.License
-convertLicense GPL = Current.GPL Nothing
-convertLicense LGPL = Current.LGPL Nothing
-convertLicense BSD3 = Current.BSD3
-convertLicense BSD4 = Current.BSD4
-convertLicense PublicDomain = Current.PublicDomain
-convertLicense AllRightsReserved = Current.AllRightsReserved
-convertLicense OtherLicense = Current.OtherLicense
-
toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
toCurrent ipi@InstalledPackageInfo{} =
let pid = convertPackageId (package ipi)
- mkExposedModule m = Current.ExposedModule m Nothing Nothing
+ mkExposedModule m = Current.ExposedModule m Nothing
in Current.InstalledPackageInfo {
- Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
Current.sourcePackageId = pid,
- Current.packageKey = Current.OldPackageKey pid,
+ Current.installedUnitId = Current.mkLegacyUnitId pid,
+ Current.compatPackageKey = "",
+ Current.abiHash = Current.AbiHash "", -- bogus but old GHCs don't care.
Current.license = convertLicense (license ipi),
Current.copyright = copyright ipi,
Current.maintainer = maintainer ipi,
@@ -120,7 +81,6 @@ toCurrent ipi@InstalledPackageInfo{} =
Current.exposed = exposed ipi,
Current.exposedModules = map (mkExposedModule . convertModuleName) (exposedModules ipi),
Current.hiddenModules = map convertModuleName (hiddenModules ipi),
- Current.instantiatedWith = [],
Current.trusted = Current.trusted Current.emptyInstalledPackageInfo,
Current.importDirs = importDirs ipi,
Current.libraryDirs = libraryDirs ipi,
@@ -130,7 +90,7 @@ toCurrent ipi@InstalledPackageInfo{} =
Current.extraGHCiLibraries = extraGHCiLibraries ipi,
Current.includeDirs = includeDirs ipi,
Current.includes = includes ipi,
- Current.depends = map (mkInstalledPackageId.convertPackageId) (depends ipi),
+ Current.depends = map (Current.mkLegacyUnitId . convertPackageId) (depends ipi),
Current.ccOptions = ccOptions ipi,
Current.ldOptions = ldOptions ipi,
Current.frameworkDirs = frameworkDirs ipi,
diff --git a/cabal/Cabal/Distribution/Simple/GHC/IPIConvert.hs b/cabal/Cabal/Distribution/Simple/GHC/IPIConvert.hs
new file mode 100644
index 0000000..259a927
--- /dev/null
+++ b/cabal/Cabal/Distribution/Simple/GHC/IPIConvert.hs
@@ -0,0 +1,50 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Simple.GHC.IPI642
+-- Copyright : (c) The University of Glasgow 2004
+-- License : BSD3
+--
+-- Maintainer : cabal-devel@haskell.org
+-- Portability : portable
+--
+-- Helper functions for 'Distribution.Simple.GHC.IPI642'.
+module Distribution.Simple.GHC.IPIConvert (
+ PackageIdentifier, convertPackageId,
+ License, convertLicense,
+ convertModuleName
+ ) where
+
+import qualified Distribution.Package as Current hiding (installedUnitId)
+import qualified Distribution.License as Current
+
+import Distribution.Version
+import Distribution.ModuleName
+import Distribution.Text
+
+import Data.Maybe
+
+data PackageIdentifier = PackageIdentifier {
+ pkgName :: String,
+ pkgVersion :: Version
+ }
+ deriving Read
+
+convertPackageId :: PackageIdentifier -> Current.PackageIdentifier
+convertPackageId PackageIdentifier { pkgName = n, pkgVersion = v } =
+ Current.PackageIdentifier (Current.PackageName n) v
+
+data License = GPL | LGPL | BSD3 | BSD4
+ | PublicDomain | AllRightsReserved | OtherLicense
+ deriving Read
+
+convertModuleName :: String -> ModuleName
+convertModuleName s = fromJust $ simpleParse s
+
+convertLicense :: License -> Current.License
+convertLicense GPL = Current.GPL Nothing
+convertLicense LGPL = Current.LGPL Nothing
+convertLicense BSD3 = Current.BSD3
+convertLicense BSD4 = Current.BSD4
+convertLicense PublicDomain = Current.PublicDomain
+convertLicense AllRightsReserved = Current.AllRightsReserved
+convertLicense OtherLicense = Current.OtherLicense
diff --git a/cabal/Cabal/Distribution/Simple/GHC/ImplInfo.hs b/cabal/Cabal/Distribution/Simple/GHC/ImplInfo.hs
index 46e1c43..5656644 100644
--- a/cabal/Cabal/Distribution/Simple/GHC/ImplInfo.hs
+++ b/cabal/Cabal/Distribution/Simple/GHC/ImplInfo.hs
@@ -15,9 +15,7 @@ module Distribution.Simple.GHC.ImplInfo (
) where
import Distribution.Simple.Compiler
- ( Compiler(..), CompilerFlavor(..)
- , compilerFlavor, compilerVersion, compilerCompatVersion )
-import Distribution.Version ( Version(..) )
+import Distribution.Version
{- |
Information about features and quirks of a GHC-based implementation.
@@ -33,17 +31,7 @@ import Distribution.Version ( Version(..) )
-}
data GhcImplInfo = GhcImplInfo
- { hasCcOdirBug :: Bool -- ^ bug in -odir handling for C compilations.
- , flagInfoLanguages :: Bool -- ^ --info and --supported-languages flags
- , fakeRecordPuns :: Bool -- ^ use -XRecordPuns for NamedFieldPuns
- , flagStubdir :: Bool -- ^ -stubdir flag supported
- , flagOutputDir :: Bool -- ^ -outputdir flag supported
- , noExtInSplitSuffix :: Bool -- ^ split-obj suffix does not contain p_o ext
- , flagFfiIncludes :: Bool -- ^ -#include on command line for FFI includes
- , flagBuildingCabalPkg :: Bool -- ^ -fbuilding-cabal-package flag supported
- , flagPackageId :: Bool -- ^ -package-id / -package flags supported
- , separateGccMingw :: Bool -- ^ mingw and gcc are in separate directories
- , supportsHaskell2010 :: Bool -- ^ -XHaskell2010 and -XHaskell98 flags
+ { supportsHaskell2010 :: Bool -- ^ -XHaskell2010 and -XHaskell98 flags
, reportsNoExt :: Bool -- ^ --supported-languages gives Ext and NoExt
, alwaysNondecIndent :: Bool -- ^ NondecreasingIndentation is always on
, flagGhciScript :: Bool -- ^ -ghci-script flag supported
@@ -67,17 +55,7 @@ getImplInfo comp =
ghcVersionImplInfo :: Version -> GhcImplInfo
ghcVersionImplInfo (Version v _) = GhcImplInfo
- { hasCcOdirBug = v < [6,4,1]
- , flagInfoLanguages = v >= [6,7]
- , fakeRecordPuns = v >= [6,8] && v < [6,10]
- , flagStubdir = v >= [6,8]
- , flagOutputDir = v >= [6,10]
- , noExtInSplitSuffix = v < [6,11]
- , flagFfiIncludes = v < [6,11]
- , flagBuildingCabalPkg = v >= [6,11]
- , flagPackageId = v > [6,11]
- , separateGccMingw = v < [6,12]
- , supportsHaskell2010 = v >= [7]
+ { supportsHaskell2010 = v >= [7]
, reportsNoExt = v >= [7]
, alwaysNondecIndent = v < [7,1]
, flagGhciScript = v >= [7,2]
@@ -88,17 +66,7 @@ ghcVersionImplInfo (Version v _) = GhcImplInfo
ghcjsVersionImplInfo :: Version -> Version -> GhcImplInfo
ghcjsVersionImplInfo _ghcjsVer _ghcVer = GhcImplInfo
- { hasCcOdirBug = False
- , flagInfoLanguages = True
- , fakeRecordPuns = False
- , flagStubdir = True
- , flagOutputDir = True
- , noExtInSplitSuffix = False
- , flagFfiIncludes = False
- , flagBuildingCabalPkg = True
- , flagPackageId = True
- , separateGccMingw = False
- , supportsHaskell2010 = True
+ { supportsHaskell2010 = True
, reportsNoExt = True
, alwaysNondecIndent = False
, flagGhciScript = True
diff --git a/cabal/Cabal/Distribution/Simple/GHC/Internal.hs b/cabal/Cabal/Distribution/Simple/GHC/Internal.hs
index 5c412e6..36443e3 100644
--- a/cabal/Cabal/Distribution/Simple/GHC/Internal.hs
+++ b/cabal/Cabal/Distribution/Simple/GHC/Internal.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
@@ -27,56 +26,40 @@ module Distribution.Simple.GHC.Internal (
substTopDir,
checkPackageDbEnvVar,
profDetailLevelFlag,
+ showArchString,
+ showOsString,
) where
-import Distribution.Simple.GHC.ImplInfo ( GhcImplInfo (..) )
+import Distribution.Simple.GHC.ImplInfo
import Distribution.Package
- ( InstalledPackageId, PackageId, LibraryName
- , getHSLibraryName )
import Distribution.InstalledPackageInfo
- ( InstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
- ( InstalledPackageInfo(..) )
-import Distribution.PackageDescription as PD
- ( BuildInfo(..), Library(..), libModules
- , hcOptions, usedExtensions, ModuleRenaming, lookupRenaming )
-import Distribution.Compat.Exception ( catchExit, catchIO )
-import Distribution.Lex (tokenizeQuotedWords)
-import Distribution.Simple.Compiler
- ( CompilerFlavor(..), Compiler(..), DebugInfoLevel(..)
- , OptimisationLevel(..), ProfDetailLevel(..) )
+import Distribution.PackageDescription as PD hiding (Flag)
+import Distribution.Compat.Exception
+import Distribution.Lex
+import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
- ( Flag, toFlag )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
- ( Program(..), ConfiguredProgram(..), ProgramConfiguration
- , ProgramLocation(..), ProgramSearchPath, ProgramSearchPathEntry(..)
- , rawSystemProgram, rawSystemProgramStdout, programPath
- , addKnownProgram, arProgram, ldProgram, gccProgram, stripProgram
- , getProgramOutput )
-import Distribution.Simple.Program.Types ( suppressOverrideArgs )
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
import Distribution.Simple.Utils
import Distribution.Simple.BuildPaths
-import Distribution.System ( buildOS, OS(..), Platform, platformFromTriple )
+import Distribution.System
import Distribution.Text ( display, simpleParse )
import Distribution.Utils.NubList ( toNubListR )
import Distribution.Verbosity
import Language.Haskell.Extension
- ( Language(..), Extension(..), KnownExtension(..) )
import qualified Data.Map as M
import Data.Char ( isSpace )
import Data.Maybe ( fromMaybe, maybeToList, isJust )
import Control.Monad ( unless, when )
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid ( Monoid(..) )
-#endif
+import Data.Monoid as Mon ( Monoid(..) )
import System.Directory ( getDirectoryContents, getTemporaryDirectory )
import System.Environment ( getEnv )
-import System.FilePath ( (</>), (<.>), takeExtension, takeDirectory )
+import System.FilePath ( (</>), (<.>), takeExtension
+ , takeDirectory, takeFileName)
import System.IO ( hClose, hPutStrLn )
targetPlatform :: [(String, String)] -> Maybe Platform
@@ -89,30 +72,36 @@ configureToolchain :: GhcImplInfo
-> M.Map String String
-> ProgramConfiguration
-> ProgramConfiguration
-configureToolchain implInfo ghcProg ghcInfo =
+configureToolchain _implInfo ghcProg ghcInfo =
addKnownProgram gccProgram {
- programFindLocation = findProg gccProgram extraGccPath,
+ programFindLocation = findProg gccProgramName extraGccPath,
programPostConf = configureGcc
}
. addKnownProgram ldProgram {
- programFindLocation = findProg ldProgram extraLdPath,
+ programFindLocation = findProg ldProgramName extraLdPath,
programPostConf = configureLd
}
. addKnownProgram arProgram {
- programFindLocation = findProg arProgram extraArPath
+ programFindLocation = findProg arProgramName extraArPath
}
. addKnownProgram stripProgram {
- programFindLocation = findProg stripProgram extraStripPath
+ programFindLocation = findProg stripProgramName extraStripPath
}
where
compilerDir = takeDirectory (programPath ghcProg)
baseDir = takeDirectory compilerDir
mingwBinDir = baseDir </> "mingw" </> "bin"
- libDir = baseDir </> "gcc-lib"
- includeDir = baseDir </> "include" </> "mingw"
isWindows = case buildOS of Windows -> True; _ -> False
binPrefix = ""
+ maybeName :: Program -> Maybe FilePath -> String
+ maybeName prog = maybe (programName prog) (dropExeExtension . takeFileName)
+
+ gccProgramName = maybeName gccProgram mbGccLocation
+ ldProgramName = maybeName ldProgram mbLdLocation
+ arProgramName = maybeName arProgram mbArLocation
+ stripProgramName = maybeName stripProgram mbStripLocation
+
mkExtraPath :: Maybe FilePath -> FilePath -> [FilePath]
mkExtraPath mbPath mingwPath | isWindows = mbDir ++ [mingwPath]
| otherwise = mbDir
@@ -126,16 +115,15 @@ configureToolchain implInfo ghcProg ghcInfo =
-- on Windows finding and configuring ghc's gcc & binutils is a bit special
(windowsExtraGccDir, windowsExtraLdDir,
- windowsExtraArDir, windowsExtraStripDir)
- | separateGccMingw implInfo = (baseDir, libDir, libDir, libDir)
- | otherwise = -- GHC >= 6.12
+ windowsExtraArDir, windowsExtraStripDir) =
let b = mingwBinDir </> binPrefix
in (b, b, b, b)
- findProg :: Program -> [FilePath]
- -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
- findProg prog extraPath v searchpath =
- programFindLocation prog v searchpath'
+ findProg :: String -> [FilePath]
+ -> Verbosity -> ProgramSearchPath
+ -> IO (Maybe (FilePath, [FilePath]))
+ findProg progName extraPath v searchpath =
+ findProgramOnSearchPath v searchpath' progName
where
searchpath' = (map ProgramSearchPathDir extraPath) ++ searchpath
@@ -165,28 +153,12 @@ configureToolchain implInfo ghcProg ghcInfo =
| otherwise -> tokenizeQuotedWords flags
configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
- configureGcc v gccProg = do
- gccProg' <- configureGcc' v gccProg
- return gccProg' {
- programDefaultArgs = programDefaultArgs gccProg'
+ configureGcc _v gccProg = do
+ return gccProg {
+ programDefaultArgs = programDefaultArgs gccProg
++ ccFlags ++ gccLinkerFlags
}
- configureGcc' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
- configureGcc'
- | isWindows = \_ gccProg -> case programLocation gccProg of
- -- if it's found on system then it means we're using the result
- -- of programFindLocation above rather than a user-supplied path
- -- Pre GHC 6.12, that meant we should add these flags to tell
- -- ghc's gcc where it lives and thus where gcc can find its
- -- various files:
- FoundOnSystem {}
- | separateGccMingw implInfo ->
- return gccProg { programDefaultArgs = ["-B" ++ libDir,
- "-I" ++ includeDir] }
- _ -> return gccProg
- | otherwise = \_ gccProg -> return gccProg
-
configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureLd v ldProg = do
ldProg' <- configureLd' v ldProg
@@ -226,8 +198,7 @@ getLanguages _ implInfo _
getGhcInfo :: Verbosity -> GhcImplInfo -> ConfiguredProgram
-> IO [(String, String)]
-getGhcInfo verbosity implInfo ghcProg
- | flagInfoLanguages implInfo = do
+getGhcInfo verbosity _implInfo ghcProg = do
xs <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
["--info"]
case reads xs of
@@ -236,13 +207,10 @@ getGhcInfo verbosity implInfo ghcProg
return i
_ ->
die "Can't parse --info output of GHC"
- | otherwise =
- return []
getExtensions :: Verbosity -> GhcImplInfo -> ConfiguredProgram
-> IO [(Extension, String)]
-getExtensions verbosity implInfo ghcProg
- | flagInfoLanguages implInfo = do
+getExtensions verbosity implInfo ghcProg = do
str <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
["--supported-languages"]
let extStrs = if reportsNoExt implInfo
@@ -258,94 +226,27 @@ getExtensions verbosity implInfo ghcProg
]
let extensions0 = [ (ext, "-X" ++ display ext)
| Just ext <- map simpleParse extStrs ]
- extensions1 = if fakeRecordPuns implInfo
- then -- ghc-6.8 introduced RecordPuns however it
- -- should have been NamedFieldPuns. We now
- -- encourage packages to use NamedFieldPuns
- -- so for compatibility we fake support for
- -- it in ghc-6.8 by making it an alias for
- -- the old RecordPuns extension.
- (EnableExtension NamedFieldPuns, "-XRecordPuns") :
- (DisableExtension NamedFieldPuns, "-XNoRecordPuns") :
- extensions0
- else extensions0
- extensions2 = if alwaysNondecIndent implInfo
+ extensions1 = if alwaysNondecIndent implInfo
then -- ghc-7.2 split NondecreasingIndentation off
-- into a proper extension. Before that it
-- was always on.
(EnableExtension NondecreasingIndentation, "") :
(DisableExtension NondecreasingIndentation, "") :
- extensions1
- else extensions1
- return extensions2
-
- | otherwise = return oldLanguageExtensions
-
--- | For GHC 6.6.x and earlier, the mapping from supported extensions to flags
-oldLanguageExtensions :: [(Extension, String)]
-oldLanguageExtensions =
- let doFlag (f, (enable, disable)) = [(EnableExtension f, enable),
- (DisableExtension f, disable)]
- fglasgowExts = ("-fglasgow-exts",
- "") -- This is wrong, but we don't want to turn
- -- all the extensions off when asked to just
- -- turn one off
- fFlag flag = ("-f" ++ flag, "-fno-" ++ flag)
- in concatMap doFlag
- [(OverlappingInstances , fFlag "allow-overlapping-instances")
- ,(TypeSynonymInstances , fglasgowExts)
- ,(TemplateHaskell , fFlag "th")
- ,(ForeignFunctionInterface , fFlag "ffi")
- ,(MonomorphismRestriction , fFlag "monomorphism-restriction")
- ,(MonoPatBinds , fFlag "mono-pat-binds")
- ,(UndecidableInstances , fFlag "allow-undecidable-instances")
- ,(IncoherentInstances , fFlag "allow-incoherent-instances")
- ,(Arrows , fFlag "arrows")
- ,(Generics , fFlag "generics")
- ,(ImplicitPrelude , fFlag "implicit-prelude")
- ,(ImplicitParams , fFlag "implicit-params")
- ,(CPP , ("-cpp", ""{- Wrong -}))
- ,(BangPatterns , fFlag "bang-patterns")
- ,(KindSignatures , fglasgowExts)
- ,(RecursiveDo , fglasgowExts)
- ,(ParallelListComp , fglasgowExts)
- ,(MultiParamTypeClasses , fglasgowExts)
- ,(FunctionalDependencies , fglasgowExts)
- ,(Rank2Types , fglasgowExts)
- ,(RankNTypes , fglasgowExts)
- ,(PolymorphicComponents , fglasgowExts)
- ,(ExistentialQuantification , fglasgowExts)
- ,(ScopedTypeVariables , fFlag "scoped-type-variables")
- ,(FlexibleContexts , fglasgowExts)
- ,(FlexibleInstances , fglasgowExts)
- ,(EmptyDataDecls , fglasgowExts)
- ,(PatternGuards , fglasgowExts)
- ,(GeneralizedNewtypeDeriving , fglasgowExts)
- ,(MagicHash , fglasgowExts)
- ,(UnicodeSyntax , fglasgowExts)
- ,(PatternSignatures , fglasgowExts)
- ,(UnliftedFFITypes , fglasgowExts)
- ,(LiberalTypeSynonyms , fglasgowExts)
- ,(TypeOperators , fglasgowExts)
- ,(GADTs , fglasgowExts)
- ,(RelaxedPolyRec , fglasgowExts)
- ,(ExtendedDefaultRules , fFlag "extended-default-rules")
- ,(UnboxedTuples , fglasgowExts)
- ,(DeriveDataTypeable , fglasgowExts)
- ,(ConstrainedClassMethods , fglasgowExts)
- ]
+ extensions0
+ else extensions0
+ return extensions1
componentCcGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath
-> GhcOptions
-componentCcGhcOptions verbosity implInfo lbi bi clbi pref filename =
+componentCcGhcOptions verbosity _implInfo lbi bi clbi odir filename =
mempty {
ghcOptVerbosity = toFlag verbosity,
ghcOptMode = toFlag GhcModeCompile,
ghcOptInputFiles = toNubListR [filename],
- ghcOptCppIncludePath = toNubListR $ [autogenModulesDir lbi, odir]
+ ghcOptCppIncludePath = toNubListR $ [autogenModulesDir lbi clbi, odir]
++ PD.includeDirs bi,
ghcOptPackageDBs = withPackageDB lbi,
ghcOptPackages = toNubListR $ mkGhcOptPackages clbi,
@@ -361,10 +262,6 @@ componentCcGhcOptions verbosity implInfo lbi bi clbi pref filename =
PD.ccOptions bi,
ghcOptObjDir = toFlag odir
}
- where
- odir | hasCcOdirBug implInfo = pref </> takeDirectory filename
- | otherwise = pref
- -- ghc 6.4.0 had a bug in -odir handling for C compilations.
componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
@@ -374,21 +271,21 @@ componentGhcOptions verbosity lbi bi clbi odir =
ghcOptVerbosity = toFlag verbosity,
ghcOptHideAllPackages = toFlag True,
ghcOptCabal = toFlag True,
- ghcOptPackageKey = case clbi of
- LibComponentLocalBuildInfo { componentPackageKey = pk } -> toFlag pk
- _ -> mempty,
- ghcOptSigOf = hole_insts,
+ ghcOptThisUnitId = case clbi of
+ LibComponentLocalBuildInfo { componentCompatPackageKey = pk }
+ -> toFlag pk
+ _ -> Mon.mempty,
ghcOptPackageDBs = withPackageDB lbi,
ghcOptPackages = toNubListR $ mkGhcOptPackages clbi,
ghcOptSplitObjs = toFlag (splitObjs lbi),
ghcOptSourcePathClear = toFlag True,
ghcOptSourcePath = toNubListR $ [odir] ++ (hsSourceDirs bi)
- ++ [autogenModulesDir lbi],
- ghcOptCppIncludePath = toNubListR $ [autogenModulesDir lbi, odir]
+ ++ [autogenModulesDir lbi clbi],
+ ghcOptCppIncludePath = toNubListR $ [autogenModulesDir lbi clbi, odir]
++ PD.includeDirs bi,
ghcOptCppOptions = toNubListR $ cppOptions bi,
ghcOptCppIncludes = toNubListR $
- [autogenModulesDir lbi </> cppHeaderName],
+ [autogenModulesDir lbi clbi </> cppHeaderName],
ghcOptFfiIncludes = toNubListR $ PD.includes bi,
ghcOptObjDir = toFlag odir,
ghcOptHiDir = toFlag odir,
@@ -413,9 +310,6 @@ componentGhcOptions verbosity lbi bi clbi odir =
toGhcDebugInfo NormalDebugInfo = toFlag True
toGhcDebugInfo MaximalDebugInfo = toFlag True
- hole_insts = map (\(k,(p,n)) -> (k, (InstalledPackageInfo.packageKey p,n)))
- (instantiatedWith lbi)
-
-- | Strip out flags that are not supported in ghci
filterGhciFlags :: [String] -> [String]
filterGhciFlags = filter supported
@@ -429,7 +323,7 @@ filterGhciFlags = filter supported
supported "-unreg" = False
supported _ = True
-mkGHCiLibName :: LibraryName -> String
+mkGHCiLibName :: UnitId -> String
mkGHCiLibName lib = getHSLibraryName lib <.> "o"
ghcLookupProperty :: String -> Compiler -> Bool
@@ -442,11 +336,9 @@ ghcLookupProperty prop comp =
-- Module_split directory for each module.
getHaskellObjects :: GhcImplInfo -> Library -> LocalBuildInfo
-> FilePath -> String -> Bool -> IO [FilePath]
-getHaskellObjects implInfo lib lbi pref wanted_obj_ext allow_split_objs
+getHaskellObjects _implInfo lib lbi pref wanted_obj_ext allow_split_objs
| splitObjs lbi && allow_split_objs = do
- let splitSuffix = if noExtInSplitSuffix implInfo
- then "_split"
- else "_" ++ wanted_obj_ext ++ "_split"
+ let splitSuffix = "_" ++ wanted_obj_ext ++ "_split"
dirs = [ pref </> (ModuleName.toFilePath x ++ splitSuffix)
| x <- libModules lib ]
objss <- mapM getDirectoryContents dirs
@@ -460,10 +352,8 @@ getHaskellObjects implInfo lib lbi pref wanted_obj_ext allow_split_objs
| x <- libModules lib ]
mkGhcOptPackages :: ComponentLocalBuildInfo
- -> [(InstalledPackageId, PackageId, ModuleRenaming)]
-mkGhcOptPackages clbi =
- map (\(i,p) -> (i,p,lookupRenaming p (componentPackageRenaming clbi)))
- (componentPackageDeps clbi)
+ -> [(UnitId, ModuleRenaming)]
+mkGhcOptPackages = componentIncludes
substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
substTopDir topDir ipo
@@ -502,7 +392,8 @@ checkPackageDbEnvVar compilerName packagePathEnvVar = do
unless (mPP == mcsPP) abort
where
lookupEnv :: String -> IO (Maybe String)
- lookupEnv name = (Just `fmap` getEnv name) `catchIO` const (return Nothing)
+ lookupEnv name = (Just `fmap` getEnv name)
+ `catchIO` const (return Nothing)
abort =
die $ "Use of " ++ compilerName ++ "'s environment variable "
++ packagePathEnvVar ++ " is incompatible with Cabal. Use the "
@@ -519,3 +410,20 @@ profDetailLevelFlag forLib mpl =
ProfDetailToplevelFunctions -> toFlag GhcProfAutoToplevel
ProfDetailAllFunctions -> toFlag GhcProfAutoAll
ProfDetailOther _ -> mempty
+
+-- | GHC's rendering of it's host or target 'Arch' as used in its platform
+-- strings and certain file locations (such as user package db location).
+--
+showArchString :: Arch -> String
+showArchString PPC = "powerpc"
+showArchString PPC64 = "powerpc64"
+showArchString other = display other
+
+-- | GHC's rendering of it's host or target 'OS' as used in its platform
+-- strings and certain file locations (such as user package db location).
+--
+showOsString :: OS -> String
+showOsString Windows = "mingw32"
+showOsString OSX = "darwin"
+showOsString Solaris = "solaris2"
+showOsString other = display other
diff --git a/cabal/Cabal/Distribution/Simple/GHCJS.hs b/cabal/Cabal/Distribution/Simple/GHCJS.hs
index 6b3157d..e657b92 100644
--- a/cabal/Cabal/Distribution/Simple/GHCJS.hs
+++ b/cabal/Cabal/Distribution/Simple/GHCJS.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE PatternGuards #-}
module Distribution.Simple.GHCJS (
configure, getInstalledPackages, getPackageDBContents,
buildLib, buildExe,
@@ -15,70 +15,40 @@ module Distribution.Simple.GHCJS (
runCmd
) where
-import Distribution.Simple.GHC.ImplInfo ( getImplInfo, ghcjsVersionImplInfo )
+import Distribution.Simple.GHC.ImplInfo
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.PackageDescription as PD
- ( PackageDescription(..), BuildInfo(..), Executable(..)
- , Library(..), libModules, exeModules
- , hcOptions, hcProfOptions, hcSharedOptions
- , allExtensions )
import Distribution.InstalledPackageInfo
- ( InstalledPackageInfo )
-import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
- ( InstalledPackageInfo(..) )
-import Distribution.Package ( LibraryName(..), getHSLibraryName )
+import Distribution.Package
import Distribution.Simple.PackageIndex ( InstalledPackageIndex )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
import qualified Distribution.Simple.Hpc as Hpc
-import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Simple.Program
- ( Program(..), ConfiguredProgram(..), ProgramConfiguration
- , ProgramSearchPath
- , rawSystemProgramConf
- , rawSystemProgramStdout, rawSystemProgramStdoutConf
- , getProgramInvocationOutput
- , requireProgramVersion, requireProgram
- , userMaybeSpecifyPath, programPath
- , lookupProgram, addKnownPrograms
- , ghcjsProgram, ghcjsPkgProgram, c2hsProgram, hsc2hsProgram
- , ldProgram, haddockProgram, stripProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar as Ar
import qualified Distribution.Simple.Program.Ld as Ld
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
-import Distribution.Simple.Setup
- ( toFlag, fromFlag, configCoverage, configDistPref )
+import Distribution.Simple.Setup hiding ( Flag )
import qualified Distribution.Simple.Setup as Cabal
- ( Flag(..) )
-import Distribution.Simple.Compiler
- ( CompilerFlavor(..), CompilerId(..), Compiler(..)
- , PackageDB(..), PackageDBStack, AbiTag(..) )
+import Distribution.Simple.Compiler hiding ( Flag )
import Distribution.Version
- ( Version(..), anyVersion, orLaterVersion )
import Distribution.System
- ( Platform(..) )
import Distribution.Verbosity
import Distribution.Utils.NubList
- ( overNubListR, toNubListR )
-import Distribution.Text ( display )
-import Language.Haskell.Extension ( Extension(..)
- , KnownExtension(..))
+import Distribution.Text
+import Language.Haskell.Extension
import Control.Monad ( unless, when )
import Data.Char ( isSpace )
import qualified Data.Map as M ( fromList )
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid ( Monoid(..) )
-#endif
+import Data.Monoid as Mon ( Monoid(..) )
import System.Directory ( doesFileExist )
-import System.FilePath ( (</>), (<.>), takeExtension,
- takeDirectory, replaceExtension,
- splitExtension )
+import System.FilePath ( (</>), (<.>), takeExtension
+ , takeDirectory, replaceExtension )
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration
@@ -155,24 +125,24 @@ ghcjsNativeToo :: Compiler -> Bool
ghcjsNativeToo = Internal.ghcLookupProperty "Native Too"
guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram -> Verbosity
- -> ProgramSearchPath -> IO (Maybe FilePath)
+ -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessGhcjsPkgFromGhcjsPath = guessToolFromGhcjsPath ghcjsPkgProgram
guessHsc2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
- -> ProgramSearchPath -> IO (Maybe FilePath)
+ -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcjsPath = guessToolFromGhcjsPath hsc2hsProgram
guessC2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
- -> ProgramSearchPath -> IO (Maybe FilePath)
+ -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessC2hsFromGhcjsPath = guessToolFromGhcjsPath c2hsProgram
guessHaddockFromGhcjsPath :: ConfiguredProgram -> Verbosity
- -> ProgramSearchPath -> IO (Maybe FilePath)
+ -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcjsPath = guessToolFromGhcjsPath haddockProgram
guessToolFromGhcjsPath :: Program -> ConfiguredProgram
-> Verbosity -> ProgramSearchPath
- -> IO (Maybe FilePath)
+ -> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath tool ghcjsProg verbosity searchpath
= do let toolname = programName tool
path = programPath ghcjsProg
@@ -197,19 +167,15 @@ guessToolFromGhcjsPath tool ghcjsProg verbosity searchpath
-- method.
[] -> programFindLocation tool verbosity searchpath
(fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
- return (Just fp)
+ let lookedAt = map fst
+ . takeWhile (\(_file, exist) -> not exist)
+ $ zip guesses exists
+ return (Just (fp, lookedAt))
where takeVersionSuffix :: FilePath -> String
takeVersionSuffix = reverse . takeWhile (`elem ` "0123456789.-") .
reverse
- dropExeExtension :: FilePath -> FilePath
- dropExeExtension filepath =
- case splitExtension filepath of
- (filepath', extension) | extension == exeExtension -> filepath'
- | otherwise -> filepath
-
-
-- | Given a single package DB, return all installed packages.
getPackageDBContents :: Verbosity -> PackageDB -> ProgramConfiguration
-> IO InstalledPackageIndex
@@ -301,7 +267,7 @@ buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do
- let libName@(LibraryName cname) = componentLibraryName clbi
+ let uid = componentUnitId clbi
libTargetDir = buildDir lbi
whenVanillaLib forceVanilla =
when (not forRepl && (forceVanilla || withVanillaLib lbi))
@@ -310,14 +276,13 @@ buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do
when (not forRepl && (forceShared || withSharedLib lbi))
whenGHCiLib = when (not forRepl && withGHCiLib lbi && withVanillaLib lbi)
ifReplLib = when forRepl
- comp = compiler lbi
- implInfo = getImplInfo comp
- hole_insts = map (\(k,(p,n)) -> (k,(InstalledPackageInfo.packageKey p,n)))
- (instantiatedWith lbi)
+ comp = compiler lbi
+ platform = hostPlatform lbi
+ implInfo = getImplInfo comp
nativeToo = ghcjsNativeToo comp
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
- let runGhcjsProg = runGHC verbosity ghcjsProg comp
+ let runGhcjsProg = runGHC verbosity ghcjsProg comp platform
libBi = libBuildInfo lib
isGhcjsDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
@@ -329,10 +294,11 @@ buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
+ pkg_name = display $ PD.package $ localPkgDescr lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
- | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way cname
- | otherwise = mempty
+ | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
+ | otherwise = Mon.mempty
createDirectoryIfMissingVerbose verbosity True libTargetDir
-- TODO: do we need to put hs-boot files into place for mutually recursive
@@ -342,14 +308,13 @@ buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
linkJsLibOpts = mempty {
ghcOptExtra = toNubListR $
- [ "-link-js-lib" , getHSLibraryName libName
+ [ "-link-js-lib" , getHSLibraryName uid
, "-js-lib-outputdir", libTargetDir ] ++
concatMap (\x -> ["-js-lib-src",x]) jsSrcs
}
vanillaOptsNoJsLib = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptNumJobs = numJobs,
- ghcOptSigOf = hole_insts,
ghcOptInputModules = toNubListR $ libModules lib,
ghcOptHPCDir = hpcdir Hpc.Vanilla
}
@@ -457,11 +422,11 @@ buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do
(cSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
(cSources libBi)
- cid = compilerId (compiler lbi)
- vanillaLibFilePath = libTargetDir </> mkLibName libName
- profileLibFilePath = libTargetDir </> mkProfLibName libName
- sharedLibFilePath = libTargetDir </> mkSharedLibName cid libName
- ghciLibFilePath = libTargetDir </> Internal.mkGHCiLibName libName
+ compiler_id = compilerId (compiler lbi)
+ vanillaLibFilePath = libTargetDir </> mkLibName uid
+ profileLibFilePath = libTargetDir </> mkProfLibName uid
+ sharedLibFilePath = libTargetDir </> mkSharedLibName compiler_id uid
+ ghciLibFilePath = libTargetDir </> Internal.mkGHCiLibName uid
hObjs <- Internal.getHaskellObjects implInfo lib lbi
libTargetDir objExtension True
@@ -499,6 +464,8 @@ buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptInputFiles = toNubListR dynamicObjectFiles,
ghcOptOutputFile = toFlag sharedLibFilePath,
+ ghcOptExtra = toNubListR $
+ ghcjsSharedOptions libBi,
ghcOptNoAutoLinkPackages = toFlag True,
ghcOptPackageDBs = withPackageDB lbi,
ghcOptPackages = toNubListR $
@@ -522,16 +489,16 @@ buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do
runGhcjsProg ghcSharedLinkArgs
-- | Start a REPL without loading any source files.
-startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler
+startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler -> Platform
-> PackageDBStack -> IO ()
-startInterpreter verbosity conf comp packageDBs = do
+startInterpreter verbosity conf comp platform packageDBs = do
let replOpts = mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptPackageDBs = packageDBs
}
checkPackageDbStack packageDBs
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram conf
- runGHC verbosity ghcjsProg comp replOpts
+ runGHC verbosity ghcjsProg comp platform replOpts
buildExe, replExe :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
@@ -547,8 +514,9 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
let comp = compiler lbi
+ platform = hostPlatform lbi
implInfo = getImplInfo comp
- runGhcjsProg = runGHC verbosity ghcjsProg comp
+ runGhcjsProg = runGHC verbosity ghcjsProg comp platform
exeBi = buildInfo exe
-- exeNameReal, the name that GHC really uses (with .exe on Windows)
@@ -755,12 +723,12 @@ installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
findModuleFiles [builtDir] [ext] (libModules lib)
>>= installOrdinaryFiles verbosity targetDir
- cid = compilerId (compiler lbi)
- libName = componentLibraryName clbi
- vanillaLibName = mkLibName libName
- profileLibName = mkProfLibName libName
- ghciLibName = Internal.mkGHCiLibName libName
- sharedLibName = (mkSharedLibName cid) libName
+ compiler_id = compilerId (compiler lbi)
+ uid = componentUnitId clbi
+ vanillaLibName = mkLibName uid
+ profileLibName = mkProfLibName uid
+ ghciLibName = Internal.mkGHCiLibName uid
+ sharedLibName = (mkSharedLibName compiler_id) uid
hasLib = not $ null (libModules lib)
&& null (cSources (libBuildInfo lib))
@@ -800,11 +768,12 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
let
libBi = libBuildInfo lib
comp = compiler lbi
+ platform = hostPlatform lbi
vanillaArgs =
(componentGhcOptions verbosity lbi libBi clbi (buildDir lbi))
`mappend` mempty {
ghcOptMode = toFlag GhcModeAbiHash,
- ghcOptInputModules = toNubListR $ exposedModules lib
+ ghcOptInputModules = toNubListR $ PD.exposedModules lib
}
profArgs = adjustExts "js_p_hi" "js_p_o" vanillaArgs `mappend` mempty {
ghcOptProfilingMode = toFlag True,
@@ -815,7 +784,8 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
else error "libAbiHash: Can't find an enabled library way"
--
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
- getProgramInvocationOutput verbosity (ghcInvocation ghcjsProg comp ghcArgs)
+ getProgramInvocationOutput verbosity
+ (ghcInvocation ghcjsProg comp platform ghcArgs)
adjustExts :: String -> String -> GhcOptions -> GhcOptions
adjustExts hiSuf objSuf opts =
@@ -825,15 +795,19 @@ adjustExts hiSuf objSuf opts =
}
registerPackage :: Verbosity
- -> InstalledPackageInfo
- -> PackageDescription
- -> LocalBuildInfo
- -> Bool
+ -> ProgramConfiguration
+ -> HcPkg.MultiInstance
-> PackageDBStack
+ -> InstalledPackageInfo
-> IO ()
-registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs =
- HcPkg.reregister (hcPkgInfo $ withPrograms lbi) verbosity packageDbs
- (Right installedPkgInfo)
+registerPackage verbosity progdb multiInstance packageDbs installedPkgInfo
+ | HcPkg.MultiInstance <- multiInstance
+ = HcPkg.registerMultiInstance (hcPkgInfo progdb) verbosity
+ packageDbs installedPkgInfo
+
+ | otherwise
+ = HcPkg.reregister (hcPkgInfo progdb) verbosity
+ packageDbs (Right installedPkgInfo)
componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
@@ -874,7 +848,10 @@ hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcjsPkgProg
, HcPkg.noPkgDbStack = False
, HcPkg.noVerboseFlag = False
, HcPkg.flagPackageConf = False
- , HcPkg.useSingleFileDb = v < [7,9]
+ , HcPkg.supportsDirDbs = True
+ , HcPkg.requiresDirDbs = v >= [7,10]
+ , HcPkg.nativeMultiInstance = v >= [7,10]
+ , HcPkg.recacheMultiInstance = True
}
where
v = versionBranch ver
diff --git a/cabal/Cabal/Distribution/Simple/Haddock.hs b/cabal/Cabal/Distribution/Simple/Haddock.hs
index 3746395..94c2851 100644
--- a/cabal/Cabal/Distribution/Simple/Haddock.hs
+++ b/cabal/Cabal/Distribution/Simple/Haddock.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveGeneric #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Haddock
@@ -24,76 +26,42 @@ import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
-- local
+import Distribution.Compat.Semigroup as Semi
import Distribution.Package
- ( PackageIdentifier(..)
- , Package(..)
- , PackageName(..), packageName, LibraryName(..) )
import qualified Distribution.ModuleName as ModuleName
-import Distribution.PackageDescription as PD
- ( PackageDescription(..), BuildInfo(..), usedExtensions
- , hcSharedOptions
- , Library(..), hasLibs, Executable(..)
- , TestSuite(..), TestSuiteInterface(..)
- , Benchmark(..), BenchmarkInterface(..) )
-import Distribution.Simple.Compiler
- ( Compiler, compilerInfo, CompilerFlavor(..)
- , compilerFlavor, compilerCompatVersion )
+import Distribution.PackageDescription as PD hiding (Flag)
+import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.Program.GHC
- ( GhcOptions(..), GhcDynLinkMode(..), renderGhcOptions )
import Distribution.Simple.Program
- ( ConfiguredProgram(..), lookupProgramVersion, requireProgramVersion
- , rawSystemProgram, rawSystemProgramStdout
- , hscolourProgram, haddockProgram )
import Distribution.Simple.PreProcess
- ( PPSuffixHandler, preprocessComponent)
import Distribution.Simple.Setup
- ( defaultHscolourFlags
- , Flag(..), toFlag, flagToMaybe, flagToList, fromFlag
- , HaddockFlags(..), HscolourFlags(..) )
-import Distribution.Simple.Build (initialBuildSteps)
+import Distribution.Simple.Build
import Distribution.Simple.InstallDirs
- ( InstallDirs(..)
- , PathTemplateEnv, PathTemplate, PathTemplateVariable(..)
- , toPathTemplate, fromPathTemplate
- , substPathTemplate, initialPathTemplateEnv )
-import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(..), Component(..), ComponentLocalBuildInfo(..)
- , withAllComponentsInBuildOrder )
+import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate)
import Distribution.Simple.BuildPaths
- ( haddockName, hscolourPref, autogenModulesDir)
-import Distribution.Simple.PackageIndex (dependencyClosure)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
- ( InstalledPackageInfo(..) )
-import Distribution.InstalledPackageInfo
- ( InstalledPackageInfo )
+import Distribution.InstalledPackageInfo ( InstalledPackageInfo )
import Distribution.Simple.Utils
- ( die, copyFileTo, warn, notice, intercalate, setupMessage
- , createDirectoryIfMissingVerbose
- , TempFileOptions(..), defaultTempFileOptions
- , withTempFileEx, copyFileVerbose
- , withTempDirectoryEx, matchFileGlob
- , findFileWithExtension, findFile )
+import Distribution.System
import Distribution.Text
- ( display, simpleParse )
import Distribution.Utils.NubList
- ( toNubListR )
-
+import Distribution.Version
import Distribution.Verbosity
import Language.Haskell.Extension
import Control.Monad ( when, forM_ )
+import Data.Char ( isSpace )
import Data.Either ( rights )
-import Data.Foldable ( traverse_ )
-import Data.Monoid
+import Data.Foldable ( traverse_, foldl' )
import Data.Maybe ( fromMaybe, listToMaybe )
+import GHC.Generics ( Generic )
import System.Directory (doesFileExist)
import System.FilePath ( (</>), (<.>)
, normalise, splitPath, joinPath, isAbsolute )
-import System.IO (hClose, hPutStrLn, hSetEncoding, utf8)
-import Distribution.Version
+import System.IO (hClose, hPutStr, hPutStrLn, hSetEncoding, utf8)
-- ------------------------------------------------------------------------------
-- Types
@@ -132,7 +100,7 @@ data HaddockArgs = HaddockArgs {
-- ^ To find the correct GHC, required.
argTargets :: [FilePath]
-- ^ Modules to process.
-}
+} deriving Generic
-- | The FilePath of a directory, it's a monoid under '(</>)'.
newtype Directory = Dir { unDir' :: FilePath } deriving (Read,Show,Eq,Ord)
@@ -162,7 +130,28 @@ haddock pkg_descr _ _ haddockFlags
++ "a library. Perhaps you want to use the --executables, --tests or"
++ " --benchmarks flags."
-haddock pkg_descr lbi suffixes flags = do
+haddock pkg_descr lbi suffixes flags' = do
+ let verbosity = flag haddockVerbosity
+ comp = compiler lbi
+ platform = hostPlatform lbi
+
+ flags
+ | fromFlag (haddockForHackage flags') = flags'
+ { haddockHoogle = Flag True
+ , haddockHtml = Flag True
+ , haddockHtmlLocation = Flag (pkg_url ++ "/docs")
+ , haddockContents = Flag (toPathTemplate pkg_url)
+ , haddockHscolour = Flag True
+ }
+ | otherwise = flags'
+ pkg_url = "/package/$pkg-$version"
+ flag f = fromFlag $ f flags
+
+ tmpFileOpts = defaultTempFileOptions
+ { optKeepTempFiles = flag haddockKeepTempFiles }
+ htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation
+ $ flags
+
setupMessage verbosity "Running Haddock for" (packageId pkg_descr)
(confHaddock, version, _) <-
requireProgramVersion verbosity haddockProgram
@@ -188,8 +177,6 @@ haddock pkg_descr lbi suffixes flags = do
-- the tools match the requests, we can proceed
- initialBuildSteps (flag haddockDistPref) pkg_descr lbi verbosity
-
when (flag haddockHscolour) $
hscolour' (warn verbosity) pkg_descr lbi suffixes
(defaultHscolourFlags `mappend` haddockToHscolour flags)
@@ -198,11 +185,12 @@ haddock pkg_descr lbi suffixes flags = do
let commonArgs = mconcat
[ libdirArgs
, fromFlags (haddockTemplateEnv lbi (packageId pkg_descr)) flags
- , fromPackageDescription pkg_descr ]
+ , fromPackageDescription forDist pkg_descr ]
+ forDist = fromFlagOrDefault False (haddockForHackage flags)
- let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do
- pre component
+ initialBuildSteps (flag haddockDistPref) pkg_descr lbi clbi verbosity
+ preprocessComponent pkg_descr component lbi clbi False verbosity suffixes
let
doExe com = case (compToExe com) of
Just exe -> do
@@ -211,7 +199,8 @@ haddock pkg_descr lbi suffixes flags = do
exeArgs <- fromExecutable verbosity tmp lbi exe clbi htmlTemplate
version
let exeArgs' = commonArgs `mappend` exeArgs
- runHaddock verbosity tmpFileOpts comp confHaddock exeArgs'
+ runHaddock verbosity tmpFileOpts comp platform
+ confHaddock exeArgs'
Nothing -> do
warn (fromFlag $ haddockVerbosity flags)
"Unsupported component, skipping..."
@@ -223,7 +212,7 @@ haddock pkg_descr lbi suffixes flags = do
libArgs <- fromLibrary verbosity tmp lbi lib clbi htmlTemplate
version
let libArgs' = commonArgs `mappend` libArgs
- runHaddock verbosity tmpFileOpts comp confHaddock libArgs'
+ runHaddock verbosity tmpFileOpts comp platform confHaddock libArgs'
CExe _ -> when (flag haddockExecutables) $ doExe component
CTest _ -> when (flag haddockTestSuites) $ doExe component
CBench _ -> when (flag haddockBenchmarks) $ doExe component
@@ -231,14 +220,6 @@ haddock pkg_descr lbi suffixes flags = do
forM_ (extraDocFiles pkg_descr) $ \ fpath -> do
files <- matchFileGlob fpath
forM_ files $ copyFileTo verbosity (unDir $ argOutputDir commonArgs)
- where
- verbosity = flag haddockVerbosity
- keepTempFiles = flag haddockKeepTempFiles
- comp = compiler lbi
- tmpFileOpts = defaultTempFileOptions { optKeepTempFiles = keepTempFiles }
- flag f = fromFlag $ f flags
- htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation
- $ flags
-- ------------------------------------------------------------------------------
-- Contributions to HaddockArgs.
@@ -266,12 +247,11 @@ fromFlags env flags =
argOutputDir = maybe mempty Dir . flagToMaybe $ haddockDistPref flags
}
-fromPackageDescription :: PackageDescription -> HaddockArgs
-fromPackageDescription pkg_descr =
+fromPackageDescription :: Bool -> PackageDescription -> HaddockArgs
+fromPackageDescription forDist pkg_descr =
mempty { argInterfaceFile = Flag $ haddockName pkg_descr,
argPackageName = Flag $ packageId $ pkg_descr,
- argOutputDir = Dir $ "doc" </> "html"
- </> display (packageName pkg_descr),
+ argOutputDir = Dir $ "doc" </> "html" </> name,
argPrologue = Flag $ if null desc then synopsis pkg_descr
else desc,
argTitle = Flag $ showPkg ++ subtitle
@@ -279,6 +259,9 @@ fromPackageDescription pkg_descr =
where
desc = PD.description pkg_descr
showPkg = display (packageId pkg_descr)
+ name
+ | forDist = showPkg ++ "-docs"
+ | otherwise = display (packageName pkg_descr)
subtitle | null (synopsis pkg_descr) = ""
| otherwise = ": " ++ synopsis pkg_descr
@@ -301,7 +284,7 @@ fromLibrary :: Verbosity
-> Version
-> IO HaddockArgs
fromLibrary verbosity tmp lbi lib clbi htmlTemplate haddockVersion = do
- inFiles <- map snd `fmap` getLibSourceFiles lbi lib
+ inFiles <- map snd `fmap` getLibSourceFiles lbi lib clbi
ifaceArgs <- getInterfaces verbosity lbi clbi htmlTemplate
let vanillaOpts = (componentGhcOptions normal lbi bi clbi (buildDir lbi)) {
-- Noooooooooo!!!!!111
@@ -346,7 +329,7 @@ fromExecutable :: Verbosity
-> Version
-> IO HaddockArgs
fromExecutable verbosity tmp lbi exe clbi htmlTemplate haddockVersion = do
- inFiles <- map snd `fmap` getExeSourceFiles lbi exe
+ inFiles <- map snd `fmap` getExeSourceFiles lbi exe clbi
ifaceArgs <- getInterfaces verbosity lbi clbi htmlTemplate
let vanillaOpts = (componentGhcOptions normal lbi bi clbi (buildDir lbi)) {
-- Noooooooooo!!!!!111
@@ -444,13 +427,14 @@ getGhcLibDir verbosity lbi = do
runHaddock :: Verbosity
-> TempFileOptions
-> Compiler
+ -> Platform
-> ConfiguredProgram
-> HaddockArgs
-> IO ()
-runHaddock verbosity tmpFileOpts comp confHaddock args = do
+runHaddock verbosity tmpFileOpts comp platform confHaddock args = do
let haddockVersion = fromMaybe (error "unable to determine haddock version")
(programVersion confHaddock)
- renderArgs verbosity tmpFileOpts haddockVersion comp args $
+ renderArgs verbosity tmpFileOpts haddockVersion comp platform args $
\(flags,result)-> do
rawSystemProgram verbosity confHaddock flags
@@ -462,12 +446,13 @@ renderArgs :: Verbosity
-> TempFileOptions
-> Version
-> Compiler
+ -> Platform
-> HaddockArgs
-> (([String], FilePath) -> IO a)
-> IO a
-renderArgs verbosity tmpFileOpts version comp args k = do
+renderArgs verbosity tmpFileOpts version comp platform args k = do
let haddockSupportsUTF8 = version >= Version [2,14,4] []
- haddockSupportsResponseFiles = version > Version [2,16,1] []
+ haddockSupportsResponseFiles = version > Version [2,16,2] []
createDirectoryIfMissingVerbose verbosity True outputDir
withTempFileEx tmpFileOpts outputDir "haddock-prologue.txt" $
\prologueFileName h -> do
@@ -476,13 +461,13 @@ renderArgs verbosity tmpFileOpts version comp args k = do
hPutStrLn h $ fromFlag $ argPrologue args
hClose h
let pflag = "--prologue=" ++ prologueFileName
- renderedArgs = pflag : renderPureArgs version comp args
- if haddockSupportsResponseFiles
+ renderedArgs = pflag : renderPureArgs version comp platform args
+ if haddockSupportsResponseFiles
then
withTempFileEx tmpFileOpts outputDir "haddock-response.txt" $
\responseFileName hf -> do
when haddockSupportsUTF8 (hSetEncoding hf utf8)
- mapM_ (hPutStrLn hf) renderedArgs
+ hPutStr hf $ unlines $ map escapeArg renderedArgs
hClose hf
let respFile = "@" ++ responseFileName
k ([respFile], result)
@@ -500,9 +485,22 @@ renderArgs verbosity tmpFileOpts version comp args k = do
pkgstr = display $ packageName pkgid
pkgid = arg argPackageName
arg f = fromFlag $ f args
-
-renderPureArgs :: Version -> Compiler -> HaddockArgs -> [String]
-renderPureArgs version comp args = concat
+ -- Support a gcc-like response file syntax. Each separate
+ -- argument and its possible parameter(s), will be separated in the
+ -- response file by an actual newline; all other whitespace,
+ -- single quotes, double quotes, and the character used for escaping
+ -- (backslash) are escaped. The called program will need to do a similar
+ -- inverse operation to de-escape and re-constitute the argument list.
+ escape cs c
+ | isSpace c
+ || '\\' == c
+ || '\'' == c
+ || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result
+ | otherwise = c:cs
+ escapeArg = reverse . foldl' escape []
+
+renderPureArgs :: Version -> Compiler -> Platform -> HaddockArgs -> [String]
+renderPureArgs version comp platform args = concat
[ (:[]) . (\f -> "--dump-interface="++ unDir (argOutputDir args) </> f)
. fromFlag . argInterfaceFile $ args
@@ -544,7 +542,7 @@ renderPureArgs version comp args = concat
. fromFlag . argTitle $ args
, [ "--optghc=" ++ opt | (opts, _ghcVer) <- flagToList (argGhcOptions args)
- , opt <- renderGhcOptions comp opts ]
+ , opt <- renderGhcOptions comp platform opts ]
, maybe [] (\l -> ["-B"++l]) $
flagToMaybe (argGhcLibDir args) -- error if Nothing?
@@ -616,7 +614,7 @@ haddockPackageFlags :: LocalBuildInfo
haddockPackageFlags lbi clbi htmlTemplate = do
let allPkgs = installedPkgs lbi
directDeps = map fst (componentPackageDeps clbi)
- transitiveDeps <- case dependencyClosure allPkgs directDeps of
+ transitiveDeps <- case PackageIndex.dependencyClosure allPkgs directDeps of
Left x -> return x
Right inf -> die $ "internal error when calculating transitive "
++ "package dependencies.\nDebug info: " ++ show inf
@@ -631,7 +629,9 @@ haddockPackageFlags lbi clbi htmlTemplate = do
haddockTemplateEnv :: LocalBuildInfo -> PackageIdentifier -> PathTemplateEnv
haddockTemplateEnv lbi pkg_id =
(PrefixVar, prefix (installDirTemplates lbi))
- : initialPathTemplateEnv pkg_id (LibraryName (display pkg_id)) (compilerInfo (compiler lbi))
+ -- We want the legacy unit ID here, because it gives us nice paths
+ -- (Haddock people don't care about the dependencies)
+ : initialPathTemplateEnv pkg_id (mkLegacyUnitId pkg_id) (compilerInfo (compiler lbi))
(hostPlatform lbi)
-- ------------------------------------------------------------------------------
@@ -643,13 +643,7 @@ hscolour :: PackageDescription
-> HscolourFlags
-> IO ()
hscolour pkg_descr lbi suffixes flags = do
- -- we preprocess even if hscolour won't be found on the machine
- -- will this upset someone?
- initialBuildSteps distPref pkg_descr lbi verbosity
hscolour' die pkg_descr lbi suffixes flags
- where
- verbosity = fromFlag (hscolourVerbosity flags)
- distPref = fromFlag $ hscolourDistPref flags
hscolour' :: (String -> IO ()) -- ^ Called when the 'hscolour' exe is not found.
-> PackageDescription
@@ -668,15 +662,15 @@ hscolour' onNoHsColour pkg_descr lbi suffixes flags =
createDirectoryIfMissingVerbose verbosity True $
hscolourPref distPref pkg_descr
- let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
- withAllComponentsInBuildOrder pkg_descr lbi $ \comp _ -> do
- pre comp
+ withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi -> do
+ initialBuildSteps distPref pkg_descr lbi clbi verbosity
+ preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
let
doExe com = case (compToExe com) of
Just exe -> do
let outputDir = hscolourPref distPref pkg_descr
</> exeName exe </> "src"
- runHsColour hscolourProg outputDir =<< getExeSourceFiles lbi exe
+ runHsColour hscolourProg outputDir =<< getExeSourceFiles lbi exe clbi
Nothing -> do
warn (fromFlag $ hscolourVerbosity flags)
"Unsupported component, skipping..."
@@ -684,7 +678,7 @@ hscolour' onNoHsColour pkg_descr lbi suffixes flags =
case comp of
CLib lib -> do
let outputDir = hscolourPref distPref pkg_descr </> "src"
- runHsColour hscolourProg outputDir =<< getLibSourceFiles lbi lib
+ runHsColour hscolourProg outputDir =<< getLibSourceFiles lbi lib clbi
CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp
CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp
CBench _ -> when (fromFlag (hscolourBenchmarks flags)) $ doExe comp
@@ -726,24 +720,26 @@ haddockToHscolour flags =
getLibSourceFiles :: LocalBuildInfo
-> Library
+ -> ComponentLocalBuildInfo
-> IO [(ModuleName.ModuleName, FilePath)]
-getLibSourceFiles lbi lib = getSourceFiles searchpaths modules
+getLibSourceFiles lbi lib clbi = getSourceFiles searchpaths modules
where
bi = libBuildInfo lib
modules = PD.exposedModules lib ++ otherModules bi
- searchpaths = autogenModulesDir lbi : buildDir lbi : hsSourceDirs bi
+ searchpaths = autogenModulesDir lbi clbi : buildDir lbi : hsSourceDirs bi
getExeSourceFiles :: LocalBuildInfo
-> Executable
+ -> ComponentLocalBuildInfo
-> IO [(ModuleName.ModuleName, FilePath)]
-getExeSourceFiles lbi exe = do
+getExeSourceFiles lbi exe clbi = do
moduleFiles <- getSourceFiles searchpaths modules
srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe)
return ((ModuleName.main, srcMainPath) : moduleFiles)
where
bi = buildInfo exe
modules = otherModules bi
- searchpaths = autogenModulesDir lbi : exeBuildDir lbi exe : hsSourceDirs bi
+ searchpaths = autogenModulesDir lbi clbi : exeBuildDir lbi exe : hsSourceDirs bi
getSourceFiles :: [FilePath]
-> [ModuleName.ModuleName]
@@ -761,44 +757,15 @@ exeBuildDir lbi exe = buildDir lbi </> exeName exe </> exeName exe ++ "-tmp"
-- ------------------------------------------------------------------------------
-- Boilerplate Monoid instance.
instance Monoid HaddockArgs where
- mempty = HaddockArgs {
- argInterfaceFile = mempty,
- argPackageName = mempty,
- argHideModules = mempty,
- argIgnoreExports = mempty,
- argLinkSource = mempty,
- argCssFile = mempty,
- argContents = mempty,
- argVerbose = mempty,
- argOutput = mempty,
- argInterfaces = mempty,
- argOutputDir = mempty,
- argTitle = mempty,
- argPrologue = mempty,
- argGhcOptions = mempty,
- argGhcLibDir = mempty,
- argTargets = mempty
- }
- mappend a b = HaddockArgs {
- argInterfaceFile = mult argInterfaceFile,
- argPackageName = mult argPackageName,
- argHideModules = mult argHideModules,
- argIgnoreExports = mult argIgnoreExports,
- argLinkSource = mult argLinkSource,
- argCssFile = mult argCssFile,
- argContents = mult argContents,
- argVerbose = mult argVerbose,
- argOutput = mult argOutput,
- argInterfaces = mult argInterfaces,
- argOutputDir = mult argOutputDir,
- argTitle = mult argTitle,
- argPrologue = mult argPrologue,
- argGhcOptions = mult argGhcOptions,
- argGhcLibDir = mult argGhcLibDir,
- argTargets = mult argTargets
- }
- where mult f = f a `mappend` f b
+ mempty = gmempty
+ mappend = (Semi.<>)
+
+instance Semigroup HaddockArgs where
+ (<>) = gmappend
instance Monoid Directory where
mempty = Dir "."
- mappend (Dir m) (Dir n) = Dir $ m </> n
+ mappend = (Semi.<>)
+
+instance Semigroup Directory where
+ Dir m <> Dir n = Dir $ m </> n
diff --git a/cabal/Cabal/Distribution/Simple/HaskellSuite.hs b/cabal/Cabal/Distribution/Simple/HaskellSuite.hs
index bcfebfa..280b30c 100644
--- a/cabal/Cabal/Distribution/Simple/HaskellSuite.hs
+++ b/cabal/Cabal/Distribution/Simple/HaskellSuite.hs
@@ -1,10 +1,6 @@
-{-# LANGUAGE CPP #-}
module Distribution.Simple.HaskellSuite where
import Control.Monad
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative
-#endif
import Data.Maybe
import Data.Version
import qualified Data.Map as M (empty)
@@ -24,7 +20,6 @@ import Distribution.System (Platform)
import Distribution.Compat.Exception
import Language.Haskell.Extension
import Distribution.Simple.Program.Builtin
- (haskellSuiteProgram, haskellSuitePkgProgram)
configure
:: Verbosity -> Maybe FilePath -> Maybe FilePath
@@ -60,7 +55,7 @@ configure verbosity mbHcPath hcPkgPath conf0 = do
let
haskellSuiteProgram' =
haskellSuiteProgram
- { programFindLocation = \v _p -> findProgramLocation v hcPath }
+ { programFindLocation = \v p -> findProgramOnSearchPath v p hcPath }
-- NB: cannot call requireProgram right away — it'd think that
-- the program is already configured and won't reconfigure it again.
@@ -106,7 +101,7 @@ getCompilerVersion verbosity prog = do
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Compiler.Flag)]
getExtensions verbosity prog = do
extStrs <-
- lines <$>
+ lines `fmap`
rawSystemStdout verbosity (programPath prog) ["--supported-extensions"]
return
[ (ext, "-X" ++ display ext) | Just ext <- map simpleParse extStrs ]
@@ -114,7 +109,7 @@ getExtensions verbosity prog = do
getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Compiler.Flag)]
getLanguages verbosity prog = do
langStrs <-
- lines <$>
+ lines `fmap`
rawSystemStdout verbosity (programPath prog) ["--supported-languages"]
return
[ (ext, "-G" ++ display ext) | Just ext <- map simpleParse langStrs ]
@@ -170,7 +165,7 @@ buildLib verbosity pkg_descr lbi lib clbi = do
runDbProgram verbosity haskellSuiteProgram conf $
[ "compile", "--build-dir", odir ] ++
concat [ ["-i", d] | d <- srcDirs ] ++
- concat [ ["-I", d] | d <- [autogenModulesDir lbi, odir] ++ includeDirs bi ] ++
+ concat [ ["-I", d] | d <- [autogenModulesDir lbi clbi, odir] ++ includeDirs bi ] ++
[ packageDbOpt pkgDb | pkgDb <- dbStack ] ++
[ "--package-name", display pkgid ] ++
concat [ ["--package-id", display ipkgid ]
@@ -190,8 +185,9 @@ installLib
-> FilePath -- ^Build location
-> PackageDescription
-> Library
+ -> ComponentLocalBuildInfo
-> IO ()
-installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib = do
+installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib _clbi = do
let conf = withPrograms lbi
runDbProgram verbosity haskellSuitePkgProgram conf $
[ "install-library"
@@ -203,14 +199,12 @@ installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib = do
registerPackage
:: Verbosity
- -> InstalledPackageInfo
- -> PackageDescription
- -> LocalBuildInfo
- -> Bool
+ -> ProgramConfiguration
-> PackageDBStack
+ -> InstalledPackageInfo
-> IO ()
-registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
- (hspkg, _) <- requireProgram verbosity haskellSuitePkgProgram (withPrograms lbi)
+registerPackage verbosity progdb packageDbs installedPkgInfo = do
+ (hspkg, _) <- requireProgram verbosity haskellSuitePkgProgram progdb
runProgramInvocation verbosity $
(programInvocation hspkg
diff --git a/cabal/Cabal/Distribution/Simple/Install.hs b/cabal/Cabal/Distribution/Simple/Install.hs
index c9c9e68..cc5a9f9 100644
--- a/cabal/Cabal/Distribution/Simple/Install.hs
+++ b/cabal/Cabal/Distribution/Simple/Install.hs
@@ -16,13 +16,9 @@ module Distribution.Simple.Install (
install,
) where
-import Distribution.PackageDescription (
- PackageDescription(..), BuildInfo(..), Library(..),
- hasLibs, withLib, hasExes, withExe )
+import Distribution.PackageDescription
import Distribution.Package (Package(..))
-import Distribution.Simple.LocalBuildInfo (
- LocalBuildInfo(..), InstallDirs(..), absoluteInstallDirs,
- substPathTemplate, withLibLBI)
+import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.BuildPaths (haddockName, haddockPref)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose
@@ -31,6 +27,7 @@ import Distribution.Simple.Utils
import Distribution.Simple.Compiler
( CompilerFlavor(..), compilerFlavor )
import Distribution.Simple.Setup (CopyFlags(..), fromFlag)
+import Distribution.Simple.BuildTarget
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
@@ -51,6 +48,9 @@ import Distribution.Text
-- |Perform the \"@.\/setup install@\" and \"@.\/setup copy@\"
-- actions. Move files into place based on the prefix argument.
+--
+-- This does NOT register libraries, you should call 'register'
+-- to do that.
install :: PackageDescription -- ^information from the .cabal file
-> LocalBuildInfo -- ^information from the configure step
@@ -60,33 +60,41 @@ install pkg_descr lbi flags = do
let distPref = fromFlag (copyDistPref flags)
verbosity = fromFlag (copyVerbosity flags)
copydest = fromFlag (copyDest flags)
- installDirs@(InstallDirs {
- bindir = binPref,
- libdir = libPref,
--- dynlibdir = dynlibPref, --see TODO below
+ -- This is a bit of a hack, to handle files which are not
+ -- per-component (data files and Haddock files.)
+ InstallDirs {
datadir = dataPref,
+ -- NB: The situation with Haddock is a bit delicate. On the
+ -- one hand, the easiest to understand Haddock documentation
+ -- path is pkgname-0.1, which means it's per-package (not
+ -- per-component). But this means that it's impossible to
+ -- install Haddock documentation for internal libraries. We'll
+ -- keep this constraint for now; this means you can't use
+ -- Cabal to Haddock internal libraries. This does not seem
+ -- like a big problem.
docdir = docPref,
htmldir = htmlPref,
- haddockdir = interfacePref,
- includedir = incPref})
+ haddockdir = interfacePref}
+ -- Notice use of 'absoluteInstallDirs' (not the
+ -- per-component variant). This means for non-library
+ -- packages we'll just pick a nondescriptive foo-0.1
= absoluteInstallDirs pkg_descr lbi copydest
- --TODO: decide if we need the user to be able to control the libdir
- -- for shared libs independently of the one for static libs. If so
- -- it should also have a flag in the command line UI
- -- For the moment use dynlibdir = libdir
- dynlibPref = libPref
- progPrefixPref = substPathTemplate (packageId pkg_descr) lbi (progPrefix lbi)
- progSuffixPref = substPathTemplate (packageId pkg_descr) lbi (progSuffix lbi)
-
unless (hasLibs pkg_descr || hasExes pkg_descr) $
die "No executables and no library found. Nothing to do."
+
+ targets <- readBuildTargets pkg_descr (copyArgs flags)
+ targets' <- checkBuildTargets verbosity pkg_descr targets
+
+ -- Install (package-global) data files
+ installDataFiles verbosity pkg_descr dataPref
+
+ -- Install (package-global) Haddock files
+ -- TODO: these should be done per-library
docExists <- doesDirectoryExist $ haddockPref distPref pkg_descr
info verbosity ("directory " ++ haddockPref distPref pkg_descr ++
" does exist: " ++ show docExists)
- installDataFiles verbosity pkg_descr dataPref
-
when docExists $ do
createDirectoryIfMissingVerbose verbosity True htmlPref
installDirectoryContents verbosity
@@ -114,45 +122,74 @@ install pkg_descr lbi flags = do
[ installOrdinaryFile verbosity lfile (docPref </> takeFileName lfile)
| lfile <- lfiles ]
- let buildPref = buildDir lbi
- when (hasLibs pkg_descr) $
- notice verbosity ("Installing library in " ++ libPref)
- when (hasExes pkg_descr) $ do
- notice verbosity ("Installing executable(s) in " ++ binPref)
+ -- It's not necessary to do these in build-order, but it's harmless
+ withComponentsInBuildOrder pkg_descr lbi (map fst targets') $ \comp clbi ->
+ copyComponent verbosity pkg_descr lbi comp clbi copydest
+
+copyComponent :: Verbosity -> PackageDescription
+ -> LocalBuildInfo -> Component -> ComponentLocalBuildInfo
+ -> CopyDest
+ -> IO ()
+copyComponent verbosity pkg_descr lbi (CLib lib) clbi copydest = do
+ let InstallDirs{
+ libdir = libPref,
+ includedir = incPref
+ } = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest
+ buildPref = componentBuildDir lbi clbi
+ -- TODO: decide if we need the user to be able to control the libdir
+ -- for shared libs independently of the one for static libs. If so
+ -- it should also have a flag in the command line UI
+ -- For the moment use dynlibdir = libdir
+ dynlibPref = libPref
+
+ if componentUnitId clbi == localUnitId lbi
+ then notice verbosity ("Installing library in " ++ libPref)
+ else notice verbosity ("Installing internal library " ++ libName lib ++ " in " ++ libPref)
+
+ -- install include files for all compilers - they may be needed to compile
+ -- haskell files (using the CPP extension)
+ installIncludeFiles verbosity lib incPref
+
+ case compilerFlavor (compiler lbi) of
+ GHC -> GHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
+ GHCJS -> GHCJS.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
+ LHC -> LHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
+ JHC -> JHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
+ UHC -> UHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
+ HaskellSuite _ -> HaskellSuite.installLib
+ verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
+ _ -> die $ "installing with "
+ ++ display (compilerFlavor (compiler lbi))
+ ++ " is not implemented"
+
+copyComponent verbosity pkg_descr lbi (CExe exe) clbi copydest = do
+ let installDirs@InstallDirs {
+ bindir = binPref
+ } = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest
+ -- the installers know how to find the actual location of the
+ -- binaries
+ buildPref = buildDir lbi
+ uid = componentUnitId clbi
+ progPrefixPref = substPathTemplate (packageId pkg_descr) lbi uid (progPrefix lbi)
+ progSuffixPref = substPathTemplate (packageId pkg_descr) lbi uid (progSuffix lbi)
+ notice verbosity ("Installing executable " ++ exeName exe ++ " in " ++ binPref)
inPath <- isInSearchPath binPref
when (not inPath) $
warn verbosity ("The directory " ++ binPref
++ " is not in the system search path.")
-
- -- install include files for all compilers - they may be needed to compile
- -- haskell files (using the CPP extension)
- when (hasLibs pkg_descr) $ installIncludeFiles verbosity pkg_descr incPref
-
- case compilerFlavor (compiler lbi) of
- GHC -> do withLibLBI pkg_descr lbi $
- GHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr
- withExe pkg_descr $
- GHC.installExe verbosity lbi installDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr
- GHCJS-> do withLibLBI pkg_descr lbi $
- GHCJS.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr
- withExe pkg_descr $
- GHCJS.installExe verbosity lbi installDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr
- LHC -> do withLibLBI pkg_descr lbi $
- LHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr
- withExe pkg_descr $
- LHC.installExe verbosity lbi installDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr
- JHC -> do withLib pkg_descr $
- JHC.installLib verbosity libPref buildPref pkg_descr
- withExe pkg_descr $
- JHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref) pkg_descr
- UHC -> do withLib pkg_descr $ UHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr
- HaskellSuite {} ->
- withLib pkg_descr $
- HaskellSuite.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr
- _ -> die $ "installing with "
- ++ display (compilerFlavor (compiler lbi))
- ++ " is not implemented"
- -- register step should be performed by caller.
+ case compilerFlavor (compiler lbi) of
+ GHC -> GHC.installExe verbosity lbi installDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr exe
+ GHCJS -> GHCJS.installExe verbosity lbi installDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr exe
+ LHC -> LHC.installExe verbosity lbi installDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr exe
+ JHC -> JHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref) pkg_descr exe
+ UHC -> return ()
+ HaskellSuite {} -> return ()
+ _ -> die $ "installing with "
+ ++ display (compilerFlavor (compiler lbi))
+ ++ " is not implemented"
+
+-- Nothing to do for benchmark/testsuite
+copyComponent _ _ _ _ _ _ = return ()
-- | Install the files listed in data-files
--
@@ -167,26 +204,23 @@ installDataFiles verbosity pkg_descr destDataDir =
(destDataDir </> file')
| file' <- files ]
--- | Install the files listed in install-includes
+-- | Install the files listed in install-includes for a library
--
-installIncludeFiles :: Verbosity -> PackageDescription -> FilePath -> IO ()
-installIncludeFiles verbosity
- PackageDescription { library = Just lib } destIncludeDir = do
-
- incs <- mapM (findInc relincdirs) (installIncludes lbi)
- sequence_
- [ do createDirectoryIfMissingVerbose verbosity True destDir
- installOrdinaryFile verbosity srcFile destFile
- | (relFile, srcFile) <- incs
- , let destFile = destIncludeDir </> relFile
- destDir = takeDirectory destFile ]
+installIncludeFiles :: Verbosity -> Library -> FilePath -> IO ()
+installIncludeFiles verbosity lib destIncludeDir = do
+ let relincdirs = "." : filter (not.isAbsolute) (includeDirs lbi)
+ lbi = libBuildInfo lib
+ incs <- mapM (findInc relincdirs) (installIncludes lbi)
+ sequence_
+ [ do createDirectoryIfMissingVerbose verbosity True destDir
+ installOrdinaryFile verbosity srcFile destFile
+ | (relFile, srcFile) <- incs
+ , let destFile = destIncludeDir </> relFile
+ destDir = takeDirectory destFile ]
where
- relincdirs = "." : filter (not.isAbsolute) (includeDirs lbi)
- lbi = libBuildInfo lib
findInc [] file = die ("can't find include file " ++ file)
findInc (dir:dirs) file = do
let path = dir </> file
exists <- doesFileExist path
if exists then return (file, path) else findInc dirs file
-installIncludeFiles _ _ _ = die "installIncludeFiles: Can't happen?"
diff --git a/cabal/Cabal/Distribution/Simple/InstallDirs.hs b/cabal/Cabal/Distribution/Simple/InstallDirs.hs
index ac91123..49c6f3c 100644
--- a/cabal/Cabal/Distribution/Simple/InstallDirs.hs
+++ b/cabal/Cabal/Distribution/Simple/InstallDirs.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
@@ -46,25 +47,19 @@ module Distribution.Simple.InstallDirs (
import Distribution.Compat.Binary (Binary)
+import Distribution.Compat.Semigroup as Semi
+import Distribution.Package
+import Distribution.System
+import Distribution.Compiler
+import Distribution.Text
+
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid (Monoid(..))
-#endif
import GHC.Generics (Generic)
import System.Directory (getAppUserDataDirectory)
import System.FilePath ((</>), isPathSeparator, pathSeparator)
import System.FilePath (dropDrive)
-import Distribution.Package
- ( PackageIdentifier, packageName, packageVersion, LibraryName )
-import Distribution.System
- ( OS(..), buildOS, Platform(..) )
-import Distribution.Compiler
- ( AbiTag(..), abiTagString, CompilerInfo(..), CompilerFlavor(..) )
-import Distribution.Text
- ( display )
-
#if mingw32_HOST_OS
import Foreign
import Foreign.C
@@ -96,46 +91,16 @@ data InstallDirs dir = InstallDirs {
htmldir :: dir,
haddockdir :: dir,
sysconfdir :: dir
- } deriving (Generic, Read, Show)
+ } deriving (Eq, Read, Show, Functor, Generic)
instance Binary dir => Binary (InstallDirs dir)
-instance Functor InstallDirs where
- fmap f dirs = InstallDirs {
- prefix = f (prefix dirs),
- bindir = f (bindir dirs),
- libdir = f (libdir dirs),
- libsubdir = f (libsubdir dirs),
- dynlibdir = f (dynlibdir dirs),
- libexecdir = f (libexecdir dirs),
- includedir = f (includedir dirs),
- datadir = f (datadir dirs),
- datasubdir = f (datasubdir dirs),
- docdir = f (docdir dirs),
- mandir = f (mandir dirs),
- htmldir = f (htmldir dirs),
- haddockdir = f (haddockdir dirs),
- sysconfdir = f (sysconfdir dirs)
- }
+instance (Semigroup dir, Monoid dir) => Monoid (InstallDirs dir) where
+ mempty = gmempty
+ mappend = (Semi.<>)
-instance Monoid dir => Monoid (InstallDirs dir) where
- mempty = InstallDirs {
- prefix = mempty,
- bindir = mempty,
- libdir = mempty,
- libsubdir = mempty,
- dynlibdir = mempty,
- libexecdir = mempty,
- includedir = mempty,
- datadir = mempty,
- datasubdir = mempty,
- docdir = mempty,
- mandir = mempty,
- htmldir = mempty,
- haddockdir = mempty,
- sysconfdir = mempty
- }
- mappend = combineInstallDirs mappend
+instance Semigroup dir => Semigroup (InstallDirs dir) where
+ (<>) = gmappend
combineInstallDirs :: (a -> b -> c)
-> InstallDirs a
@@ -287,7 +252,7 @@ substituteInstallDirTemplates env dirs = dirs'
-- substituting for all the variables in the abstract paths, to get real
-- absolute path.
absoluteInstallDirs :: PackageIdentifier
- -> LibraryName
+ -> UnitId
-> CompilerInfo
-> CopyDest
-> Platform
@@ -317,7 +282,7 @@ data CopyDest
-- independent\" package).
--
prefixRelativeInstallDirs :: PackageIdentifier
- -> LibraryName
+ -> UnitId
-> CompilerInfo
-> Platform
-> InstallDirTemplates
@@ -349,7 +314,8 @@ prefixRelativeInstallDirs pkgId libname compilerId platform dirs =
-- | An abstract path, possibly containing variables that need to be
-- substituted for to get a real 'FilePath'.
--
-newtype PathTemplate = PathTemplate [PathComponent] deriving (Eq, Generic, Ord)
+newtype PathTemplate = PathTemplate [PathComponent]
+ deriving (Eq, Ord, Generic)
instance Binary PathTemplate
@@ -372,7 +338,7 @@ data PathTemplateVariable =
| PkgNameVar -- ^ The @$pkg@ package name path variable
| PkgVerVar -- ^ The @$version@ package version path variable
| PkgIdVar -- ^ The @$pkgid@ package Id path variable, eg @foo-1.0@
- | LibNameVar -- ^ The @$libname@ expanded package key path variable
+ | LibNameVar -- ^ The @$libname@ path variable
| CompilerVar -- ^ The compiler name and version, eg @ghc-6.6.1@
| OSVar -- ^ The operating system name, eg @windows@ or @linux@
| ArchVar -- ^ The CPU architecture name, eg @i386@ or @x86_64@
@@ -415,7 +381,7 @@ substPathTemplate environment (PathTemplate template) =
-- | The initial environment has all the static stuff but no paths
initialPathTemplateEnv :: PackageIdentifier
- -> LibraryName
+ -> UnitId
-> CompilerInfo
-> Platform
-> PathTemplateEnv
@@ -425,7 +391,7 @@ initialPathTemplateEnv pkgId libname compiler platform =
++ platformTemplateEnv platform
++ abiTemplateEnv compiler platform
-packageTemplateEnv :: PackageIdentifier -> LibraryName -> PathTemplateEnv
+packageTemplateEnv :: PackageIdentifier -> UnitId -> PathTemplateEnv
packageTemplateEnv pkgId libname =
[(PkgNameVar, PathTemplate [Ordinary $ display (packageName pkgId)])
,(PkgVerVar, PathTemplate [Ordinary $ display (packageVersion pkgId)])
@@ -478,7 +444,7 @@ installDirsTemplateEnv dirs =
instance Show PathTemplateVariable where
show PrefixVar = "prefix"
- show LibNameVar = "libname"
+ show LibNameVar = "libname"
show BindirVar = "bindir"
show LibdirVar = "libdir"
show LibsubdirVar = "libsubdir"
@@ -515,8 +481,8 @@ instance Read PathTemplateVariable where
,("docdir", DocdirVar)
,("htmldir", HtmldirVar)
,("pkgid", PkgIdVar)
- ,("pkgkey", LibNameVar) -- backwards compatibility
,("libname", LibNameVar)
+ ,("pkgkey", LibNameVar) -- backwards compatibility
,("pkg", PkgNameVar)
,("version", PkgVerVar)
,("compiler", CompilerVar)
diff --git a/cabal/Cabal/Distribution/Simple/JHC.hs b/cabal/Cabal/Distribution/Simple/JHC.hs
index 0cf8730..dbdb323 100644
--- a/cabal/Cabal/Distribution/Simple/JHC.hs
+++ b/cabal/Cabal/Distribution/Simple/JHC.hs
@@ -16,40 +16,23 @@ module Distribution.Simple.JHC (
installLib, installExe
) where
-import Distribution.PackageDescription as PD
- ( PackageDescription(..), BuildInfo(..), Executable(..)
- , Library(..), libModules, hcOptions, usedExtensions )
+import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.InstalledPackageInfo
- ( emptyInstalledPackageInfo, )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
import Distribution.Simple.BuildPaths
- ( autogenModulesDir, exeExtension )
import Distribution.Simple.Compiler
- ( CompilerFlavor(..), CompilerId(..), Compiler(..), AbiTag(..)
- , PackageDBStack, Flag, languageToFlags, extensionsToFlags )
import Language.Haskell.Extension
- ( Language(Haskell98), Extension(..), KnownExtension(..))
import Distribution.Simple.Program
- ( ConfiguredProgram(..), jhcProgram, ProgramConfiguration
- , userMaybeSpecifyPath, requireProgramVersion, lookupProgram
- , rawSystemProgram, rawSystemProgramStdoutConf )
import Distribution.Version
- ( Version(..), orLaterVersion )
import Distribution.Package
- ( Package(..), InstalledPackageId(InstalledPackageId),
- pkgName, pkgVersion, )
import Distribution.Simple.Utils
- ( createDirectoryIfMissingVerbose, writeFileAtomic
- , installOrdinaryFile, installExecutableFile
- , intercalate )
-import System.FilePath ( (</>) )
import Distribution.Verbosity
import Distribution.Text
- ( Text(parse), display )
+
+import System.FilePath ( (</>) )
import Distribution.Compat.ReadP
( readP_to_S, string, skipSpaces )
import Distribution.System ( Platform )
@@ -57,7 +40,6 @@ import Distribution.System ( Platform )
import Data.List ( nub )
import Data.Char ( isSpace )
import qualified Data.Map as M ( empty )
-import Data.Maybe ( fromMaybe )
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
@@ -116,8 +98,7 @@ getInstalledPackages verbosity _packageDBs conf = do
return $
PackageIndex.fromList $
map (\p -> emptyInstalledPackageInfo {
- InstalledPackageInfo.installedPackageId =
- InstalledPackageId (display p),
+ InstalledPackageInfo.installedUnitId = mkLegacyUnitId p,
InstalledPackageInfo.sourcePackageId = p
}) $
concatMap parseLine $
@@ -162,7 +143,7 @@ constructJHCCmdLine lbi bi clbi _odir verbosity =
++ extensionsToFlags (compiler lbi) (usedExtensions bi)
++ ["--noauto","-i-"]
++ concat [["-i", l] | l <- nub (hsSourceDirs bi)]
- ++ ["-i", autogenModulesDir lbi]
+ ++ ["-i", autogenModulesDir lbi clbi]
++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
-- It would be better if JHC would accept package names with versions,
-- but JHC-0.7.2 doesn't accept this.
@@ -173,7 +154,10 @@ constructJHCCmdLine lbi bi clbi _odir verbosity =
jhcPkgConf :: PackageDescription -> String
jhcPkgConf pd =
let sline name sel = name ++ ": "++sel pd
- lib = fromMaybe (error "no library available") . library
+ lib pd' = case libraries pd' of
+ [lib'] -> lib'
+ [] -> error "no library available"
+ _ -> error "JHC does not support multiple libraries (yet)"
comma = intercalate "," . map display
in unlines [sline "name" (display . pkgName . packageId)
,sline "version" (display . pkgVersion . packageId)
@@ -181,8 +165,16 @@ jhcPkgConf pd =
,sline "hidden-modules" (comma . otherModules . libBuildInfo . lib)
]
-installLib :: Verbosity -> FilePath -> FilePath -> PackageDescription -> Library -> IO ()
-installLib verb dest build_dir pkg_descr _ = do
+installLib :: Verbosity
+ -> LocalBuildInfo
+ -> FilePath
+ -> FilePath
+ -> FilePath
+ -> PackageDescription
+ -> Library
+ -> ComponentLocalBuildInfo
+ -> IO ()
+installLib verb _lbi dest _dyn_dest build_dir pkg_descr _lib _clbi = do
let p = display (packageId pkg_descr)++".hl"
createDirectoryIfMissingVerbose verb True dest
installOrdinaryFile verb (build_dir </> p) (dest </> p)
diff --git a/cabal/Cabal/Distribution/Simple/LHC.hs b/cabal/Cabal/Distribution/Simple/LHC.hs
index 1045c9a..ddcdb6a 100644
--- a/cabal/Cabal/Distribution/Simple/LHC.hs
+++ b/cabal/Cabal/Distribution/Simple/LHC.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.LHC
@@ -41,66 +40,37 @@ module Distribution.Simple.LHC (
ghcVerbosityOptions
) where
-import Distribution.PackageDescription as PD
- ( PackageDescription(..), BuildInfo(..), Executable(..)
- , Library(..), libModules, hcOptions, hcProfOptions, hcSharedOptions
- , usedExtensions, allExtensions )
+import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.InstalledPackageInfo
- ( InstalledPackageInfo
- , parseInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
- ( InstalledPackageInfo(..) )
import Distribution.Simple.PackageIndex
import qualified Distribution.Simple.PackageIndex as PackageIndex
-import Distribution.ParseUtils ( ParseResult(..) )
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
-import Distribution.Simple.InstallDirs
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
- ( Package(..), LibraryName, getHSLibraryName )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
- ( Program(..), ConfiguredProgram(..), ProgramConfiguration
- , ProgramSearchPath, ProgramLocation(..)
- , rawSystemProgram, rawSystemProgramConf
- , rawSystemProgramStdout, rawSystemProgramStdoutConf
- , requireProgramVersion
- , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
- , arProgram, ldProgram
- , gccProgram, stripProgram
- , lhcProgram, lhcPkgProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import Distribution.Simple.Compiler
- ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
- , OptimisationLevel(..), PackageDB(..), PackageDBStack, AbiTag(..)
- , Flag, languageToFlags, extensionsToFlags )
import Distribution.Version
- ( Version(..), orLaterVersion )
-import Distribution.System
- ( OS(..), buildOS )
import Distribution.Verbosity
import Distribution.Text
- ( display, simpleParse )
+import Distribution.Compat.Exception
+import Distribution.System
import Language.Haskell.Extension
- ( Language(Haskell98), Extension(..), KnownExtension(..) )
import Control.Monad ( unless, when )
+import Data.Monoid as Mon
import Data.List
import qualified Data.Map as M ( empty )
import Data.Maybe ( catMaybes )
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid ( Monoid(..) )
-#endif
import System.Directory ( removeFile, renameFile,
getDirectoryContents, doesFileExist,
getTemporaryDirectory )
import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension )
import System.IO (hClose, hPutStrLn)
-import Distribution.Compat.Exception (catchExit, catchIO)
-import Distribution.System ( Platform )
-- -----------------------------------------------------------------------------
-- Configuring
@@ -149,22 +119,23 @@ configureToolchain lhcProg =
programPostConf = configureGcc
}
. addKnownProgram ldProgram {
- programFindLocation = findProg ldProgram (libDir </> "ld.exe"),
+ programFindLocation = findProg ldProgram (gccLibDir </> "ld.exe"),
programPostConf = configureLd
}
where
compilerDir = takeDirectory (programPath lhcProg)
baseDir = takeDirectory compilerDir
- libDir = baseDir </> "gcc-lib"
+ gccLibDir = baseDir </> "gcc-lib"
includeDir = baseDir </> "include" </> "mingw"
isWindows = case buildOS of Windows -> True; _ -> False
-- on Windows finding and configuring ghc's gcc and ld is a bit special
findProg :: Program -> FilePath
- -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
+ -> Verbosity -> ProgramSearchPath
+ -> IO (Maybe (FilePath, [FilePath]))
findProg prog location | isWindows = \verbosity searchpath -> do
exists <- doesFileExist location
- if exists then return (Just location)
+ if exists then return (Just (location, []))
else do warn verbosity ("Couldn't find " ++ programName prog ++ " where I expected it. Trying the search path.")
programFindLocation prog verbosity searchpath
| otherwise = programFindLocation prog
@@ -177,7 +148,7 @@ configureToolchain lhcProg =
-- that means we should add this extra flag to tell ghc's gcc
-- where it lives and thus where gcc can find its various files:
FoundOnSystem {} -> return gccProg {
- programDefaultArgs = ["-B" ++ libDir,
+ programDefaultArgs = ["-B" ++ gccLibDir,
"-I" ++ includeDir]
}
UserSpecified {} -> return gccProg
@@ -230,7 +201,7 @@ getInstalledPackages verbosity packagedbs conf = do
pkgss <- getInstalledPackages' lhcPkg verbosity packagedbs conf
let indexes = [ PackageIndex.fromList (map (substTopDir topDir) pkgs)
| (_, pkgs) <- pkgss ]
- return $! (mconcat indexes)
+ return $! (Mon.mconcat indexes)
where
-- On Windows, various fields have $topdir/foo rather than full
@@ -318,8 +289,8 @@ substTopDir topDir ipo
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
- let libName = componentLibraryName clbi
- pref = buildDir lbi
+ let lib_name = componentUnitId clbi
+ pref = componentBuildDir lbi clbi
pkgid = packageId pkg_descr
runGhcProg = rawSystemProgramConf verbosity lhcProgram (withPrograms lbi)
ifVanillaLib forceVanilla = when (forceVanilla || withVanillaLib lbi)
@@ -373,10 +344,10 @@ buildLib verbosity pkg_descr lbi lib clbi = do
let cObjs = map (`replaceExtension` objExtension) (cSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) (cSources libBi)
cid = compilerId (compiler lbi)
- vanillaLibFilePath = libTargetDir </> mkLibName libName
- profileLibFilePath = libTargetDir </> mkProfLibName libName
- sharedLibFilePath = libTargetDir </> mkSharedLibName cid libName
- ghciLibFilePath = libTargetDir </> mkGHCiLibName libName
+ vanillaLibFilePath = libTargetDir </> mkLibName lib_name
+ profileLibFilePath = libTargetDir </> mkProfLibName lib_name
+ sharedLibFilePath = libTargetDir </> mkSharedLibName cid lib_name
+ ghciLibFilePath = libTargetDir </> mkGHCiLibName lib_name
stubObjs <- fmap catMaybes $ sequence
[ findFileWithExtension [objExtension] [libTargetDir]
@@ -455,7 +426,7 @@ buildLib verbosity pkg_descr lbi lib clbi = do
-- This method is called iteratively by xargs. The
-- output goes to <ldLibName>.tmp, and any existing file
-- named <ldLibName> is included when linking. The
- -- output is renamed to <libName>.
+ -- output is renamed to <lib_name>.
rawSystemProgramConf verbosity ldProgram (withPrograms lbi)
(args ++ if exists then [ldLibName] else [])
renameFile (ldLibName <.> "tmp") ldLibName
@@ -525,7 +496,7 @@ buildExe verbosity _pkg_descr lbi
++ [srcMainFile]
++ ["-optl" ++ opt | opt <- PD.ldOptions exeBi]
++ ["-l"++lib | lib <- extraLibs exeBi]
- ++ ["-L"++libDir | libDir <- extraLibDirs exeBi]
+ ++ ["-L"++extraLibDir | extraLibDir <- extraLibDirs exeBi]
++ concat [["-framework", f] | f <- PD.frameworks exeBi]
++ if profExe
then ["-prof",
@@ -607,12 +578,12 @@ ghcOptions lbi bi clbi odir
++ ["-i"]
++ ["-i" ++ odir]
++ ["-i" ++ l | l <- nub (hsSourceDirs bi)]
- ++ ["-i" ++ autogenModulesDir lbi]
- ++ ["-I" ++ autogenModulesDir lbi]
+ ++ ["-i" ++ autogenModulesDir lbi clbi]
+ ++ ["-I" ++ autogenModulesDir lbi clbi]
++ ["-I" ++ odir]
++ ["-I" ++ dir | dir <- PD.includeDirs bi]
++ ["-optP" ++ opt | opt <- cppOptions bi]
- ++ [ "-optP-include", "-optP"++ (autogenModulesDir lbi </> cppHeaderName) ]
+ ++ [ "-optP-include", "-optP"++ (autogenModulesDir lbi clbi </> cppHeaderName) ]
++ [ "-#include \"" ++ inc ++ "\"" | inc <- PD.includes bi ]
++ [ "-odir", odir, "-hidir", odir ]
++ (if compilerVersion c >= Version [6,8] []
@@ -682,7 +653,7 @@ ghcCcOptions lbi bi clbi odir
_ -> ["-optc-O2"])
++ ["-odir", odir]
-mkGHCiLibName :: LibraryName -> String
+mkGHCiLibName :: UnitId -> String
mkGHCiLibName lib = getHSLibraryName lib <.> "o"
-- -----------------------------------------------------------------------------
@@ -757,11 +728,11 @@ installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
where
cid = compilerId (compiler lbi)
- libName = componentLibraryName clbi
- vanillaLibName = mkLibName libName
- profileLibName = mkProfLibName libName
- ghciLibName = mkGHCiLibName libName
- sharedLibName = mkSharedLibName cid libName
+ lib_name = componentUnitId clbi
+ vanillaLibName = mkLibName lib_name
+ profileLibName = mkProfLibName lib_name
+ ghciLibName = mkGHCiLibName lib_name
+ sharedLibName = mkSharedLibName cid lib_name
hasLib = not $ null (libModules lib)
&& null (cSources (libBuildInfo lib))
@@ -777,14 +748,12 @@ installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
registerPackage
:: Verbosity
- -> InstalledPackageInfo
- -> PackageDescription
- -> LocalBuildInfo
- -> Bool
+ -> ProgramConfiguration
-> PackageDBStack
+ -> InstalledPackageInfo
-> IO ()
-registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs =
- HcPkg.reregister (hcPkgInfo $ withPrograms lbi) verbosity packageDbs
+registerPackage verbosity progdb packageDbs installedPkgInfo =
+ HcPkg.reregister (hcPkgInfo progdb) verbosity packageDbs
(Right installedPkgInfo)
hcPkgInfo :: ProgramConfiguration -> HcPkg.HcPkgInfo
@@ -792,7 +761,10 @@ hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = lhcPkgProg
, HcPkg.noPkgDbStack = False
, HcPkg.noVerboseFlag = False
, HcPkg.flagPackageConf = False
- , HcPkg.useSingleFileDb = True
+ , HcPkg.supportsDirDbs = True
+ , HcPkg.requiresDirDbs = True
+ , HcPkg.nativeMultiInstance = False -- ?
+ , HcPkg.recacheMultiInstance = False -- ?
}
where
Just lhcPkgProg = lookupProgram lhcPkgProgram conf
diff --git a/cabal/Cabal/Distribution/Simple/LocalBuildInfo.hs b/cabal/Cabal/Distribution/Simple/LocalBuildInfo.hs
index 96043ba..b241ac7 100644
--- a/cabal/Cabal/Distribution/Simple/LocalBuildInfo.hs
+++ b/cabal/Cabal/Distribution/Simple/LocalBuildInfo.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
@@ -20,15 +21,20 @@
module Distribution.Simple.LocalBuildInfo (
LocalBuildInfo(..),
externalPackageDeps,
- inplacePackageId,
- localPackageKey,
- localLibraryName,
+ localComponentId,
+ localUnitId,
+ localCompatPackageKey,
-- * Buildable package components
Component(..),
ComponentName(..),
+ defaultLibName,
showComponentName,
+ componentNameString,
ComponentLocalBuildInfo(..),
+ getLocalComponent,
+ componentComponentId,
+ componentBuildDir,
foldComponent,
componentName,
componentBuildInfo,
@@ -39,6 +45,8 @@ module Distribution.Simple.LocalBuildInfo (
pkgEnabledComponents,
lookupComponent,
getComponent,
+ maybeGetDefaultLibraryLocalBuildInfo,
+ maybeGetComponentLocalBuildInfo,
getComponentLocalBuildInfo,
allComponentsInBuildOrder,
componentsInBuildOrder,
@@ -55,6 +63,7 @@ module Distribution.Simple.LocalBuildInfo (
-- * Installation directories
module Distribution.Simple.InstallDirs,
absoluteInstallDirs, prefixRelativeInstallDirs,
+ absoluteComponentInstallDirs, prefixRelativeComponentInstallDirs,
substPathTemplate
) where
@@ -63,30 +72,16 @@ import Distribution.Simple.InstallDirs hiding (absoluteInstallDirs,
prefixRelativeInstallDirs,
substPathTemplate, )
import qualified Distribution.Simple.InstallDirs as InstallDirs
-import Distribution.Simple.Program (ProgramConfiguration)
-import Distribution.InstalledPackageInfo (InstalledPackageInfo)
+import Distribution.Simple.Program
import Distribution.PackageDescription
- ( PackageDescription(..), withLib, Library(libBuildInfo), withExe
- , Executable(exeName, buildInfo), withTest, TestSuite(..)
- , BuildInfo(buildable), Benchmark(..), ModuleRenaming(..) )
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Package
- ( PackageId, Package(..), InstalledPackageId(..)
- , PackageName, LibraryName(..), PackageKey(..) )
import Distribution.Simple.Compiler
- ( Compiler, compilerInfo, PackageDBStack, DebugInfoLevel
- , OptimisationLevel, ProfDetailLevel )
import Distribution.Simple.PackageIndex
- ( InstalledPackageIndex, allPackages )
-import Distribution.ModuleName ( ModuleName )
import Distribution.Simple.Setup
- ( ConfigFlags )
import Distribution.Simple.Utils
- ( shortRelativePath )
import Distribution.Text
- ( display )
import Distribution.System
- ( Platform (..) )
import Data.Array ((!))
import Distribution.Compat.Binary (Binary)
@@ -95,7 +90,7 @@ import Data.List (nub, find, stripPrefix)
import Data.Maybe
import Data.Tree (flatten)
import GHC.Generics (Generic)
-import Data.Map (Map)
+import System.FilePath
import System.Directory (doesDirectoryExist, canonicalizePath)
@@ -105,6 +100,8 @@ data LocalBuildInfo = LocalBuildInfo {
configFlags :: ConfigFlags,
-- ^ Options passed to the configuration step.
-- Needed to re-run configuration when .cabal is out of date
+ flagAssignment :: FlagAssignment,
+ -- ^ The final set of flags which were picked for this package
extraConfigArgs :: [String],
-- ^ Extra args on the command line for the configuration step.
-- Needed to re-run configuration when .cabal is out of date
@@ -118,18 +115,21 @@ data LocalBuildInfo = LocalBuildInfo {
-- ^ The platform we're building for
buildDir :: FilePath,
-- ^ Where to build the package.
- componentsConfigs :: [(ComponentName, ComponentLocalBuildInfo, [ComponentName])],
- -- ^ All the components to build, ordered by topological sort, and with their dependencies
- -- over the intrapackage dependency graph
+ componentsConfigs :: [(ComponentLocalBuildInfo, [UnitId])],
+ -- ^ All the components to build, ordered by topological
+ -- sort, and with their INTERNAL dependencies over the
+ -- intrapackage dependency graph.
+ -- TODO: this is assumed to be short; otherwise we want
+ -- some sort of ordered map.
installedPkgs :: InstalledPackageIndex,
-- ^ All the info about the installed packages that the
-- current package depends on (directly or indirectly).
+ -- Does NOT include internal dependencies.
pkgDescrFile :: Maybe FilePath,
-- ^ the filename containing the .cabal file, if available
localPkgDescr :: PackageDescription,
-- ^ The resolved package description, that does not contain
-- any conditionals.
- instantiatedWith :: [(ModuleName, (InstalledPackageInfo, ModuleName))],
withPrograms :: ProgramConfiguration, -- ^Location and args for all programs
withPackageDB :: PackageDBStack, -- ^What package database to use, global\/user
withVanillaLib:: Bool, -- ^Whether to build normal libs.
@@ -152,48 +152,53 @@ data LocalBuildInfo = LocalBuildInfo {
instance Binary LocalBuildInfo
--- | Extract the 'PackageKey' from the library component of a
--- 'LocalBuildInfo' if it exists, or make a fake package key based
+-- TODO: Get rid of these functions, as much as possible. They are
+-- a bit useful in some cases, but you should be very careful!
+
+-- | Extract the 'ComponentId' from the public library component of a
+-- 'LocalBuildInfo' if it exists, or make a fake component ID based
-- on the package ID.
-localPackageKey :: LocalBuildInfo -> PackageKey
-localPackageKey lbi =
- foldr go (OldPackageKey (package (localPkgDescr lbi))) (componentsConfigs lbi)
- where go (_, clbi, _) old_pk = case clbi of
- LibComponentLocalBuildInfo { componentPackageKey = pk } -> pk
- _ -> old_pk
-
--- | Extract the 'LibraryName' from the library component of a
--- 'LocalBuildInfo' if it exists, or make a library name based
+localComponentId :: LocalBuildInfo -> ComponentId
+localComponentId lbi
+ = case localUnitId lbi of
+ SimpleUnitId cid -> cid
+
+-- | Extract the 'UnitId' from the library component of a
+-- 'LocalBuildInfo' if it exists, or make a fake unit ID based on
+-- the package ID.
+localUnitId :: LocalBuildInfo -> UnitId
+localUnitId lbi
+ = case maybeGetDefaultLibraryLocalBuildInfo lbi of
+ Just LibComponentLocalBuildInfo { componentUnitId = uid } -> uid
+ -- Something fake:
+ _ -> mkLegacyUnitId (package (localPkgDescr lbi))
+
+-- | Extract the compatibility package key from the public library component of a
+-- 'LocalBuildInfo' if it exists, or make a fake package key based
-- on the package ID.
-localLibraryName :: LocalBuildInfo -> LibraryName
-localLibraryName lbi =
- foldr go (LibraryName (display (package (localPkgDescr lbi)))) (componentsConfigs lbi)
- where go (_, clbi, _) old_n = case clbi of
- LibComponentLocalBuildInfo { componentLibraryName = n } -> n
- _ -> old_n
+localCompatPackageKey :: LocalBuildInfo -> String
+localCompatPackageKey lbi =
+ case maybeGetDefaultLibraryLocalBuildInfo lbi of
+ Just LibComponentLocalBuildInfo { componentCompatPackageKey = pk } -> pk
+ -- Something fake:
+ _ -> display (package (localPkgDescr lbi))
-- | External package dependencies for the package as a whole. This is the
-- union of the individual 'componentPackageDeps', less any internal deps.
-externalPackageDeps :: LocalBuildInfo -> [(InstalledPackageId, PackageId)]
+externalPackageDeps :: LocalBuildInfo -> [(UnitId, PackageId)]
externalPackageDeps lbi =
-- TODO: what about non-buildable components?
nub [ (ipkgid, pkgid)
- | (_,clbi,_) <- componentsConfigs lbi
+ | (clbi,_) <- componentsConfigs lbi
, (ipkgid, pkgid) <- componentPackageDeps clbi
- , not (internal pkgid) ]
+ , not (internal ipkgid) ]
where
-- True if this dependency is an internal one (depends on the library
-- defined in the same package).
- internal pkgid = pkgid == packageId (localPkgDescr lbi)
-
--- | The installed package Id we use for local packages registered in the local
--- package db. This is what is used for intra-package deps between components.
---
-inplacePackageId :: PackageId -> InstalledPackageId
-inplacePackageId pkgid = InstalledPackageId (display pkgid ++ "-inplace")
+ internal ipkgid = any ((==ipkgid) . componentUnitId . fst) (componentsConfigs lbi)
-- -----------------------------------------------------------------------------
--- Buildable components
+-- Source-representation of buildable components
data Component = CLib Library
| CExe Executable
@@ -201,48 +206,23 @@ data Component = CLib Library
| CBench Benchmark
deriving (Show, Eq, Read)
-data ComponentName = CLibName -- currently only a single lib
- | CExeName String
- | CTestName String
- | CBenchName String
- deriving (Eq, Generic, Ord, Read, Show)
-
-instance Binary ComponentName
+-- | This gets the 'String' component name. In fact, it is
+-- guaranteed to uniquely identify a component, returning
+-- @Nothing@ if the 'ComponentName' was for the public
+-- library (which CAN conflict with an executable name.)
+componentNameString :: PackageName -> ComponentName -> Maybe String
+componentNameString (PackageName pkg_name) (CLibName n) | pkg_name == n = Nothing
+componentNameString _ (CLibName n) = Just n
+componentNameString _ (CExeName n) = Just n
+componentNameString _ (CTestName n) = Just n
+componentNameString _ (CBenchName n) = Just n
showComponentName :: ComponentName -> String
-showComponentName CLibName = "library"
+showComponentName (CLibName name) = "library '" ++ name ++ "'"
showComponentName (CExeName name) = "executable '" ++ name ++ "'"
showComponentName (CTestName name) = "test suite '" ++ name ++ "'"
showComponentName (CBenchName name) = "benchmark '" ++ name ++ "'"
-data ComponentLocalBuildInfo
- = LibComponentLocalBuildInfo {
- -- | Resolved internal and external package dependencies for this component.
- -- The 'BuildInfo' specifies a set of build dependencies that must be
- -- satisfied in terms of version ranges. This field fixes those dependencies
- -- to the specific versions available on this machine for this compiler.
- componentPackageDeps :: [(InstalledPackageId, PackageId)],
- componentPackageKey :: PackageKey,
- componentLibraryName :: LibraryName,
- componentExposedModules :: [Installed.ExposedModule],
- componentPackageRenaming :: Map PackageName ModuleRenaming
- }
- | ExeComponentLocalBuildInfo {
- componentPackageDeps :: [(InstalledPackageId, PackageId)],
- componentPackageRenaming :: Map PackageName ModuleRenaming
- }
- | TestComponentLocalBuildInfo {
- componentPackageDeps :: [(InstalledPackageId, PackageId)],
- componentPackageRenaming :: Map PackageName ModuleRenaming
- }
- | BenchComponentLocalBuildInfo {
- componentPackageDeps :: [(InstalledPackageId, PackageId)],
- componentPackageRenaming :: Map PackageName ModuleRenaming
- }
- deriving (Generic, Read, Show)
-
-instance Binary ComponentLocalBuildInfo
-
foldComponent :: (Library -> a)
-> (Executable -> a)
-> (TestSuite -> a)
@@ -260,7 +240,7 @@ componentBuildInfo =
componentName :: Component -> ComponentName
componentName =
- foldComponent (const CLibName)
+ foldComponent (CLibName . libName)
(CExeName . exeName)
(CTestName . testName)
(CBenchName . benchmarkName)
@@ -269,7 +249,7 @@ componentName =
--
pkgComponents :: PackageDescription -> [Component]
pkgComponents pkg =
- [ CLib lib | Just lib <- [library pkg] ]
+ [ CLib lib | lib <- libraries pkg ]
++ [ CExe exe | exe <- executables pkg ]
++ [ CTest tst | tst <- testSuites pkg ]
++ [ CBench bm | bm <- benchmarks pkg ]
@@ -302,8 +282,9 @@ componentDisabledReason (CBench bm)
componentDisabledReason _ = Nothing
lookupComponent :: PackageDescription -> ComponentName -> Maybe Component
-lookupComponent pkg CLibName =
- fmap CLib $ library pkg
+lookupComponent pkg (CLibName "") = lookupComponent pkg (defaultLibName (package pkg))
+lookupComponent pkg (CLibName name) =
+ fmap CLib $ find ((name ==) . libName) (libraries pkg)
lookupComponent pkg (CExeName name) =
fmap CExe $ find ((name ==) . exeName) (executables pkg)
lookupComponent pkg (CTestName name) =
@@ -321,43 +302,149 @@ getComponent pkg cname =
error $ "internal error: the package description contains no "
++ "component corresponding to " ++ show cname
+-- -----------------------------------------------------------------------------
+-- Configuration information of buildable components
+
+data ComponentLocalBuildInfo
+ = LibComponentLocalBuildInfo {
+ -- | It would be very convenient to store the literal Library here,
+ -- but if we do that, it will get serialized (via the Binary)
+ -- instance twice. So instead we just provide the ComponentName,
+ -- which can be used to find the Component in the
+ -- PackageDescription. NB: eventually, this will NOT uniquely
+ -- identify the ComponentLocalBuildInfo.
+ componentLocalName :: ComponentName,
+ -- | Resolved internal and external package dependencies for this component.
+ -