Cabal 1.24.2.0 → 2.0.0.2

raw patch · 561 files changed

+36087/−16019 lines, 561 filesdep +generics-sopdep +keysdep +parsecdep −exceptionsdep −regex-posixdep ~QuickCheckdep ~arraydep ~basebinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: generics-sop, keys, parsec, singleton-bool, tar, these

Dependencies removed: exceptions, regex-posix

Dependency ranges changed: QuickCheck, array, base, bytestring, containers, directory, filepath, old-time, process, unix

API changes (from Hackage documentation)

Files

• Cabal.cabal +237/−181
• Distribution/Backpack.hs +246/−0
• Distribution/Backpack/ComponentsGraph.hs +97/−0
• Distribution/Backpack/Configure.hs +357/−0
• Distribution/Backpack/ConfiguredComponent.hs +292/−0
• Distribution/Backpack/DescribeUnitId.hs +61/−0
• Distribution/Backpack/FullUnitId.hs +26/−0
• Distribution/Backpack/Id.hs +146/−0
• Distribution/Backpack/LinkedComponent.hs +393/−0
• Distribution/Backpack/MixLink.hs +192/−0
• Distribution/Backpack/ModSubst.hs +54/−0
• Distribution/Backpack/ModuleScope.hs +88/−0
• Distribution/Backpack/ModuleShape.hs +83/−0
• Distribution/Backpack/PreExistingComponent.hs +67/−0
• Distribution/Backpack/ReadyComponent.hs +368/−0
• Distribution/Backpack/UnifyM.hs +640/−0
• Distribution/Compat/Binary.hs +21/−6
• Distribution/Compat/Binary/Class.hs +11/−10
• Distribution/Compat/CopyFile.hs +9/−8
• Distribution/Compat/CreatePipe.hs +23/−8
• Distribution/Compat/DList.hs +40/−0
• Distribution/Compat/Environment.hs +58/−11
• Distribution/Compat/Exception.hs +10/−0
• Distribution/Compat/GetShortPathName.hs +8/−5
• Distribution/Compat/Graph.hs +417/−0
• Distribution/Compat/Map/Strict.hs +26/−0
• Distribution/Compat/MonadFail.hs +2/−2
• Distribution/Compat/Parsec.hs +73/−0
• Distribution/Compat/Prelude.hs +205/−0
• Distribution/Compat/Prelude/Internal.hs +14/−0
• Distribution/Compat/ReadP.hs +19/−5
• Distribution/Compat/SnocList.hs +33/−0
• Distribution/Compat/Stack.hs +113/−0
• Distribution/Compat/Time.hs +205/−0
• Distribution/Compiler.hs +29/−29
• Distribution/GetOpt.hs +23/−149
• Distribution/InstalledPackageInfo.hs +181/−36
• Distribution/Lex.hs +3/−18
• Distribution/License.hs +12/−16
• Distribution/Make.hs +8/−2
• Distribution/ModuleName.hs +72/−30
• Distribution/Package.hs +44/−184
• Distribution/PackageDescription.hs +122/−1277
• Distribution/PackageDescription/Check.hs +361/−88
• Distribution/PackageDescription/Configuration.hs +143/−257
• Distribution/PackageDescription/Parse.hs +253/−226
• Distribution/PackageDescription/Parsec.hs +569/−0
• Distribution/PackageDescription/Parsec/FieldDescr.hs +619/−0
• Distribution/PackageDescription/PrettyPrint.hs +194/−58
• Distribution/ParseUtils.hs +47/−93
• Distribution/Parsec/Class.hs +482/−0
• Distribution/Parsec/ConfVar.hs +142/−0
• Distribution/Parsec/Lexer.x +269/−0
• Distribution/Parsec/LexerMonad.hs +145/−0
• Distribution/Parsec/Parser.hs +403/−0
• Distribution/Parsec/Types/Common.hs +89/−0
• Distribution/Parsec/Types/Field.hs +82/−0
• Distribution/Parsec/Types/FieldDescr.hs +238/−0
• Distribution/Parsec/Types/ParseResult.hs +87/−0
• Distribution/PrettyUtils.hs +64/−0
• Distribution/ReadE.hs +3/−1
• Distribution/Simple.hs +148/−71
• Distribution/Simple/Bench.hs +21/−18
• Distribution/Simple/Build.hs +268/−189
• Distribution/Simple/Build/Macros.hs +81/−33
• Distribution/Simple/Build/PathsModule.hs +20/−15
• Distribution/Simple/BuildPaths.hs +120/−16
• Distribution/Simple/BuildTarget.hs +148/−56
• Distribution/Simple/BuildToolDepends.hs +96/−0
• Distribution/Simple/CCompiler.hs +3/−2
• Distribution/Simple/Command.hs +8/−7
• Distribution/Simple/Compiler.hs +73/−16
• Distribution/Simple/Configure.hs +1960/−2036
• Distribution/Simple/Doctest.hs +188/−0
• Distribution/Simple/GHC.hs +1742/−1237
• Distribution/Simple/GHC/IPI642.hs +16/−4
• Distribution/Simple/GHC/IPIConvert.hs +10/−6
• Distribution/Simple/GHC/ImplInfo.hs +21/−36
• Distribution/Simple/GHC/Internal.hs +194/−165
• Distribution/Simple/GHCJS.hs +124/−123
• Distribution/Simple/Haddock.hs +155/−165
• Distribution/Simple/HaskellSuite.hs +42/−36
• Distribution/Simple/Hpc.hs +16/−8
• Distribution/Simple/Install.hs +160/−80
• Distribution/Simple/InstallDirs.hs +40/−17
• Distribution/Simple/JHC.hs +31/−22
• Distribution/Simple/LHC.hs +125/−117
• Distribution/Simple/LocalBuildInfo.hs +201/−330
• Distribution/Simple/PackageIndex.hs +211/−111
• Distribution/Simple/PreProcess.hs +141/−84
• Distribution/Simple/PreProcess/Unlit.hs +5/−3
• Distribution/Simple/Program.hs +30/−12
• Distribution/Simple/Program/Ar.hs +13/−9
• Distribution/Simple/Program/Builtin.hs +30/−4
• Distribution/Simple/Program/Db.hs +57/−47
• Distribution/Simple/Program/Find.hs +13/−11
• Distribution/Simple/Program/GHC.hs +69/−30
• Distribution/Simple/Program/HcPkg.hs +94/−76
• Distribution/Simple/Program/Hpc.hs +7/−1
• Distribution/Simple/Program/Internal.hs +2/−2
• Distribution/Simple/Program/Ld.hs +6/−0
• Distribution/Simple/Program/Run.hs +37/−10
• Distribution/Simple/Program/Script.hs +3/−3
• Distribution/Simple/Program/Strip.hs +19/−14
• Distribution/Simple/Program/Types.hs +10/−4
• Distribution/Simple/Register.hs +210/−93
• Distribution/Simple/Setup.hs +432/−168
• Distribution/Simple/SrcDist.hs +97/−73
• Distribution/Simple/Test.hs +29/−22
• Distribution/Simple/Test/ExeV10.hs +25/−17
• Distribution/Simple/Test/LibV09.hs +50/−35
• Distribution/Simple/Test/Log.hs +10/−5
• Distribution/Simple/UHC.hs +34/−28
• Distribution/Simple/UserHooks.hs +19/−3
• Distribution/Simple/Utils.hs +416/−387
• Distribution/System.hs +41/−18
• Distribution/TestSuite.hs +6/−0
• Distribution/Text.hs +40/−5
• Distribution/Types/AbiHash.hs +55/−0
• Distribution/Types/AnnotatedId.hs +25/−0
• Distribution/Types/Benchmark.hs +70/−0
• Distribution/Types/BenchmarkInterface.hs +44/−0
• Distribution/Types/BenchmarkType.hs +38/−0
• Distribution/Types/BuildInfo.hs +197/−0
• Distribution/Types/BuildType.hs +48/−0
• Distribution/Types/Component.hs +82/−0
• Distribution/Types/ComponentId.hs +66/−0
• Distribution/Types/ComponentInclude.hs +32/−0
• Distribution/Types/ComponentLocalBuildInfo.hs +127/−0
• Distribution/Types/ComponentName.hs +89/−0
• Distribution/Types/ComponentRequestedSpec.hs +123/−0
• Distribution/Types/CondTree.hs +145/−0
• Distribution/Types/Condition.hs +133/−0
• Distribution/Types/Dependency.hs +64/−0
• Distribution/Types/DependencyMap.hs +74/−0
• Distribution/Types/ExeDependency.hs +46/−0
• Distribution/Types/Executable.hs +58/−0
• Distribution/Types/ExecutableScope.hs +41/−0
• Distribution/Types/ForeignLib.hs +188/−0
• Distribution/Types/ForeignLibOption.hs +32/−0
• Distribution/Types/ForeignLibType.hs +61/−0
• Distribution/Types/GenericPackageDescription.hs +162/−0
• Distribution/Types/HookedBuildInfo.hs +66/−0
• Distribution/Types/IncludeRenaming.hs +59/−0
• Distribution/Types/LegacyExeDependency.hs +51/−0
• Distribution/Types/Library.hs +80/−0
• Distribution/Types/LocalBuildInfo.hs +332/−0
• Distribution/Types/Mixin.hs +32/−0
• Distribution/Types/Module.hs +42/−0
• Distribution/Types/ModuleReexport.hs +49/−0
• Distribution/Types/ModuleRenaming.hs +91/−0
• Distribution/Types/MungedPackageId.hs +55/−0
• Distribution/Types/MungedPackageName.hs +134/−0
• Distribution/Types/PackageDescription.hs +415/−0
• Distribution/Types/PackageId.hs +45/−0
• Distribution/Types/PackageName.hs +55/−0
• Distribution/Types/PkgconfigDependency.hs +38/−0
• Distribution/Types/PkgconfigName.hs +58/−0
• Distribution/Types/SetupBuildInfo.hs +38/−0
• Distribution/Types/SourceRepo.hs +166/−0
• Distribution/Types/TargetInfo.hs +33/−0
• Distribution/Types/TestSuite.hs +75/−0
• Distribution/Types/TestSuiteInterface.hs +50/−0
• Distribution/Types/TestType.hs +38/−0
• Distribution/Types/UnitId.hs +117/−0
• Distribution/Types/UnqualComponentName.hs +84/−0
• Distribution/Utils/Base62.hs +22/−0
• Distribution/Utils/Generic.hs +420/−0
• Distribution/Utils/LogProgress.hs +89/−0
• Distribution/Utils/MapAccum.hs +34/−0
• Distribution/Utils/NubList.hs +7/−5
• Distribution/Utils/Progress.hs +67/−0
• Distribution/Utils/ShortText.hs +111/−0
• Distribution/Utils/String.hs +85/−0
• Distribution/Utils/UnionFind.hs +102/−0
• Distribution/Verbosity.hs +195/−29
• Distribution/Version.hs +287/−83
• LICENSE +2/−5
• Language/Haskell/Extension.hs +14/−10
• changelog +128/−15
• dist/build/Distribution/Parsec/Lexer.hs +491/−0
• doc/API/Cabal/Cabal.haddock binary
• doc/API/Cabal/Distribution-Backpack-ComponentsGraph.html +11/−0
• doc/API/Cabal/Distribution-Backpack-Configure.html +5/−0
• doc/API/Cabal/Distribution-Backpack-ConfiguredComponent.html +16/−0
• doc/API/Cabal/Distribution-Backpack-DescribeUnitId.html +8/−0
• doc/API/Cabal/Distribution-Backpack-FullUnitId.html +4/−0
• doc/API/Cabal/Distribution-Backpack-LinkedComponent.html +20/−0
• doc/API/Cabal/Distribution-Backpack-ModSubst.html +5/−0
• doc/API/Cabal/Distribution-Backpack-ModuleShape.html +6/−0
• doc/API/Cabal/Distribution-Backpack.html +39/−0
• doc/API/Cabal/Distribution-Compat-Binary.html +4/−0
• doc/API/Cabal/Distribution-Compat-CreatePipe.html +4/−0
• doc/API/Cabal/Distribution-Compat-DList.html +4/−0
• doc/API/Cabal/Distribution-Compat-Exception.html +4/−0
• doc/API/Cabal/Distribution-Compat-Graph.html +46/−0
• doc/API/Cabal/Distribution-Compat-Map-Strict.html +4/−0
• doc/API/Cabal/Distribution-Compat-Prelude-Internal.html too large to diff
• doc/API/Cabal/Distribution-Compat-ReadP.html +41/−0
• doc/API/Cabal/Distribution-Compat-Semigroup.html +33/−0
• doc/API/Cabal/Distribution-Compat-Stack.html +41/−0
• doc/API/Cabal/Distribution-Compat-Time.html +12/−0
• doc/API/Cabal/Distribution-Compiler.html +26/−0
• doc/API/Cabal/Distribution-InstalledPackageInfo.html +30/−0
• doc/API/Cabal/Distribution-License.html +34/−0
• doc/API/Cabal/Distribution-Make.html +46/−0
• doc/API/Cabal/Distribution-ModuleName.html +8/−0
• doc/API/Cabal/Distribution-Package.html +14/−0
• doc/API/Cabal/Distribution-PackageDescription-Check.html +39/−0
• doc/API/Cabal/Distribution-PackageDescription-Configuration.html +44/−0
• doc/API/Cabal/Distribution-PackageDescription-Parse.html +13/−0
• doc/API/Cabal/Distribution-PackageDescription-PrettyPrint.html +4/−0
• doc/API/Cabal/Distribution-PackageDescription-Utils.html +4/−0
• doc/API/Cabal/Distribution-PackageDescription.html +186/−0
• doc/API/Cabal/Distribution-ReadE.html +4/−0
• doc/API/Cabal/Distribution-Simple-Bench.html +6/−0
• doc/API/Cabal/Distribution-Simple-Build-Macros.html +10/−0
• doc/API/Cabal/Distribution-Simple-Build-PathsModule.html +9/−0
• doc/API/Cabal/Distribution-Simple-Build.html +7/−0
• doc/API/Cabal/Distribution-Simple-BuildPaths.html +11/−0
• doc/API/Cabal/Distribution-Simple-BuildTarget.html +10/−0
• doc/API/Cabal/Distribution-Simple-BuildToolDepends.html +25/−0
• doc/API/Cabal/Distribution-Simple-CCompiler.html +13/−0
• doc/API/Cabal/Distribution-Simple-Command.html +30/−0
• doc/API/Cabal/Distribution-Simple-Compiler.html +42/−0
• doc/API/Cabal/Distribution-Simple-Configure.html +97/−0
• doc/API/Cabal/Distribution-Simple-Doctest.html +4/−0
• doc/API/Cabal/Distribution-Simple-GHC.html +29/−0
• doc/API/Cabal/Distribution-Simple-GHCJS.html +6/−0
• doc/API/Cabal/Distribution-Simple-Haddock.html +8/−0
• doc/API/Cabal/Distribution-Simple-HaskellSuite.html +4/−0
• doc/API/Cabal/Distribution-Simple-Hpc.html +7/−0
• doc/API/Cabal/Distribution-Simple-Install.html +9/−0
• doc/API/Cabal/Distribution-Simple-InstallDirs.html +40/−0
• doc/API/Cabal/Distribution-Simple-JHC.html +7/−0
• doc/API/Cabal/Distribution-Simple-LHC.html +19/−0
• doc/API/Cabal/Distribution-Simple-LocalBuildInfo.html +154/−0
• doc/API/Cabal/Distribution-Simple-PackageIndex.html +63/−0
• doc/API/Cabal/Distribution-Simple-PreProcess-Unlit.html +6/−0
• doc/API/Cabal/Distribution-Simple-PreProcess.html +41/−0
• doc/API/Cabal/Distribution-Simple-Program-Ar.html +14/−0
• doc/API/Cabal/Distribution-Simple-Program-Builtin.html +5/−0
• doc/API/Cabal/Distribution-Simple-Program-Db.html +54/−0
• doc/API/Cabal/Distribution-Simple-Program-Find.html +20/−0
• doc/API/Cabal/Distribution-Simple-Program-GHC.html +27/−0
• doc/API/Cabal/Distribution-Simple-Program-HcPkg.html +17/−0
• doc/API/Cabal/Distribution-Simple-Program-Hpc.html +8/−0
• doc/API/Cabal/Distribution-Simple-Program-Internal.html +7/−0
• doc/API/Cabal/Distribution-Simple-Program-Ld.html +4/−0
• doc/API/Cabal/Distribution-Simple-Program-Run.html +20/−0
• doc/API/Cabal/Distribution-Simple-Program-Script.html +6/−0
• doc/API/Cabal/Distribution-Simple-Program-Strip.html +4/−0
• doc/API/Cabal/Distribution-Simple-Program-Types.html +42/−0
• doc/API/Cabal/Distribution-Simple-Program.html +97/−0
• doc/API/Cabal/Distribution-Simple-Register.html +27/−0
• doc/API/Cabal/Distribution-Simple-Setup.html +56/−0
• doc/API/Cabal/Distribution-Simple-SrcDist.html +19/−0
• doc/API/Cabal/Distribution-Simple-Test-ExeV10.html +4/−0
• doc/API/Cabal/Distribution-Simple-Test-LibV09.html +10/−0
• doc/API/Cabal/Distribution-Simple-Test-Log.html +11/−0
• doc/API/Cabal/Distribution-Simple-Test.html +6/−0
• doc/API/Cabal/Distribution-Simple-UHC.html +7/−0
• doc/API/Cabal/Distribution-Simple-UserHooks.html +21/−0
• doc/API/Cabal/Distribution-Simple-Utils.html +116/−0
• doc/API/Cabal/Distribution-Simple.html +29/−0
• doc/API/Cabal/Distribution-System.html +33/−0
• doc/API/Cabal/Distribution-TestSuite.html +19/−0
• doc/API/Cabal/Distribution-Text.html +10/−0
• doc/API/Cabal/Distribution-Types-AbiHash.html +6/−0
• doc/API/Cabal/Distribution-Types-AnnotatedId.html +6/−0
• doc/API/Cabal/Distribution-Types-Benchmark.html +5/−0
• doc/API/Cabal/Distribution-Types-BenchmarkInterface.html +11/−0
• doc/API/Cabal/Distribution-Types-BenchmarkType.html +4/−0
• doc/API/Cabal/Distribution-Types-BuildInfo.html +12/−0
• doc/API/Cabal/Distribution-Types-BuildType.html +9/−0
• doc/API/Cabal/Distribution-Types-Component.html +6/−0
• doc/API/Cabal/Distribution-Types-ComponentId.html +9/−0
• doc/API/Cabal/Distribution-Types-ComponentInclude.html +5/−0
• doc/API/Cabal/Distribution-Types-ComponentLocalBuildInfo.html +91/−0
• doc/API/Cabal/Distribution-Types-ComponentName.html +8/−0
• doc/API/Cabal/Distribution-Types-ComponentRequestedSpec.html +30/−0
• doc/API/Cabal/Distribution-Types-CondTree.html +26/−0
• doc/API/Cabal/Distribution-Types-Condition.html +4/−0
• doc/API/Cabal/Distribution-Types-Dependency.html +5/−0
• doc/API/Cabal/Distribution-Types-DependencyMap.html +5/−0
• doc/API/Cabal/Distribution-Types-ExeDependency.html +4/−0
• doc/API/Cabal/Distribution-Types-Executable.html +5/−0
• doc/API/Cabal/Distribution-Types-ExecutableScope.html +4/−0
• doc/API/Cabal/Distribution-Types-ForeignLib.html +17/−0
• doc/API/Cabal/Distribution-Types-ForeignLibOption.html +8/−0
• doc/API/Cabal/Distribution-Types-ForeignLibType.html +5/−0
• doc/API/Cabal/Distribution-Types-GenericPackageDescription.html +9/−0
• doc/API/Cabal/Distribution-Types-HookedBuildInfo.html +41/−0
• doc/API/Cabal/Distribution-Types-IncludeRenaming.html +5/−0
• doc/API/Cabal/Distribution-Types-LegacyExeDependency.html +6/−0
• doc/API/Cabal/Distribution-Types-Library.html +14/−0
• doc/API/Cabal/Distribution-Types-LocalBuildInfo.html +56/−0
• doc/API/Cabal/Distribution-Types-Mixin.html +4/−0
• doc/API/Cabal/Distribution-Types-Module.html +11/−0
• doc/API/Cabal/Distribution-Types-ModuleReexport.html +4/−0
• doc/API/Cabal/Distribution-Types-ModuleRenaming.html +14/−0
• doc/API/Cabal/Distribution-Types-MungedPackageId.html +8/−0
• doc/API/Cabal/Distribution-Types-MungedPackageName.html +26/−0
• doc/API/Cabal/Distribution-Types-PackageDescription.html +62/−0
• doc/API/Cabal/Distribution-Types-PackageId.html +4/−0
• doc/API/Cabal/Distribution-Types-PackageName.html +6/−0
• doc/API/Cabal/Distribution-Types-PkgconfigDependency.html +4/−0
• doc/API/Cabal/Distribution-Types-PkgconfigName.html +5/−0
• doc/API/Cabal/Distribution-Types-SetupBuildInfo.html +7/−0
• doc/API/Cabal/Distribution-Types-SourceRepo.html +34/−0
• doc/API/Cabal/Distribution-Types-TargetInfo.html +8/−0
• doc/API/Cabal/Distribution-Types-TestSuite.html +5/−0
• doc/API/Cabal/Distribution-Types-TestSuiteInterface.html +11/−0
• doc/API/Cabal/Distribution-Types-TestType.html +4/−0
• doc/API/Cabal/Distribution-Types-UnitId.html +34/−0
• doc/API/Cabal/Distribution-Types-UnqualComponentName.html +10/−0
• doc/API/Cabal/Distribution-Utils-Generic.html +59/−0
• doc/API/Cabal/Distribution-Utils-LogProgress.html +6/−0
• doc/API/Cabal/Distribution-Utils-MapAccum.html +4/−0
• doc/API/Cabal/Distribution-Utils-NubList.html +15/−0
• doc/API/Cabal/Distribution-Utils-Progress.html +11/−0
• doc/API/Cabal/Distribution-Utils-ShortText.html +8/−0
• doc/API/Cabal/Distribution-Verbosity.html +11/−0
• doc/API/Cabal/Distribution-Version.html +78/−0
• doc/API/Cabal/Language-Haskell-Extension.html +113/−0
• doc/API/Cabal/doc-index-124.html +4/−0
• doc/API/Cabal/doc-index-33.html +4/−0
• doc/API/Cabal/doc-index-36.html +4/−0
• doc/API/Cabal/doc-index-38.html +4/−0
• doc/API/Cabal/doc-index-42.html +4/−0
• doc/API/Cabal/doc-index-43.html +4/−0
• doc/API/Cabal/doc-index-45.html +4/−0
• doc/API/Cabal/doc-index-46.html +4/−0
• doc/API/Cabal/doc-index-47.html +4/−0
• doc/API/Cabal/doc-index-60.html +4/−0
• doc/API/Cabal/doc-index-61.html +4/−0
• doc/API/Cabal/doc-index-62.html +4/−0
• doc/API/Cabal/doc-index-92.html +4/−0
• doc/API/Cabal/doc-index-94.html +4/−0
• doc/API/Cabal/doc-index-A.html +4/−0
• doc/API/Cabal/doc-index-All.html +4/−0
• doc/API/Cabal/doc-index-B.html +4/−0
• doc/API/Cabal/doc-index-C.html +4/−0
• doc/API/Cabal/doc-index-D.html +4/−0
• doc/API/Cabal/doc-index-E.html +4/−0
• doc/API/Cabal/doc-index-F.html +4/−0
• doc/API/Cabal/doc-index-G.html +4/−0
• doc/API/Cabal/doc-index-H.html +4/−0
• doc/API/Cabal/doc-index-I.html +4/−0
• doc/API/Cabal/doc-index-J.html +4/−0
• doc/API/Cabal/doc-index-K.html +4/−0
• doc/API/Cabal/doc-index-L.html +4/−0
• doc/API/Cabal/doc-index-M.html +4/−0
• doc/API/Cabal/doc-index-N.html +4/−0
• doc/API/Cabal/doc-index-O.html +4/−0
• doc/API/Cabal/doc-index-P.html +4/−0
• doc/API/Cabal/doc-index-Q.html +4/−0
• doc/API/Cabal/doc-index-R.html +4/−0
• doc/API/Cabal/doc-index-S.html +4/−0
• doc/API/Cabal/doc-index-T.html +4/−0
• doc/API/Cabal/doc-index-U.html +4/−0
• doc/API/Cabal/doc-index-V.html +4/−0
• doc/API/Cabal/doc-index-W.html +4/−0
• doc/API/Cabal/doc-index-X.html +4/−0
• doc/API/Cabal/doc-index-Y.html +4/−0
• doc/API/Cabal/doc-index-Z.html +4/−0
• doc/API/Cabal/doc-index.html +4/−0
• doc/API/Cabal/haddock-util.js +186/−0
• doc/API/Cabal/hslogo-16.png binary
• doc/API/Cabal/index.html +7/−0
• doc/API/Cabal/minus.gif binary
• doc/API/Cabal/ocean.css +618/−0
• doc/API/Cabal/plus.gif binary
• doc/API/Cabal/synopsis.png binary
• doc/Cabal.css +0/−49
• doc/README.md +122/−0
• doc/bugs-and-stability.rst +6/−0
• doc/concepts-and-development.rst +7/−0
• doc/conf.py +207/−0
• doc/config-and-install.rst +5/−0
• doc/developing-packages.markdown +0/−2238
• doc/developing-packages.rst +2861/−0
• doc/images/Cabal-dark.png binary
• doc/index.markdown +0/−201
• doc/index.rst +14/−0
• doc/installing-packages.markdown +0/−1303
• doc/installing-packages.rst +1702/−0
• doc/intro.rst +200/−0
• doc/misc.markdown +0/−109
• doc/misc.rst +103/−0
• doc/nix-local-build-overview.rst +34/−0
• doc/nix-local-build.rst +1709/−0
• doc/references.inc +22/−0
• tests/DiffInstances.hs +107/−0
• tests/PackageTests.hs +0/−283
• tests/PackageTests/AllowNewer/AllowNewer.cabal +0/−25
• tests/PackageTests/AllowNewer/benchmarks/Bench.hs +0/−4
• tests/PackageTests/AllowNewer/src/Foo.hs +0/−4
• tests/PackageTests/AllowNewer/tests/Test.hs +0/−4
• tests/PackageTests/BenchmarkExeV10/Foo.hs +0/−4
• tests/PackageTests/BenchmarkExeV10/benchmarks/bench-Foo.hs +0/−8
• tests/PackageTests/BenchmarkExeV10/my.cabal +0/−15
• tests/PackageTests/BenchmarkOptions/BenchmarkOptions.cabal +0/−20
• tests/PackageTests/BenchmarkOptions/test-BenchmarkOptions.hs +0/−11
• tests/PackageTests/BenchmarkStanza/Check.hs +0/−30
• tests/PackageTests/BenchmarkStanza/my.cabal +0/−19
• tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive1/GlobalBuildDepsNotAdditive1.cabal +0/−20
• tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive1/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive2/GlobalBuildDepsNotAdditive2.cabal +0/−20
• tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive2/lemon.hs +0/−7
• tests/PackageTests/BuildDeps/InternalLibrary0/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/InternalLibrary0/my.cabal +0/−24
• tests/PackageTests/BuildDeps/InternalLibrary0/programs/lemon.hs +0/−6
• tests/PackageTests/BuildDeps/InternalLibrary1/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/InternalLibrary1/my.cabal +0/−23
• tests/PackageTests/BuildDeps/InternalLibrary1/programs/lemon.hs +0/−6
• tests/PackageTests/BuildDeps/InternalLibrary2/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/InternalLibrary2/my.cabal +0/−23
• tests/PackageTests/BuildDeps/InternalLibrary2/programs/lemon.hs +0/−6
• tests/PackageTests/BuildDeps/InternalLibrary2/to-install/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/InternalLibrary2/to-install/my.cabal +0/−18
• tests/PackageTests/BuildDeps/InternalLibrary3/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/InternalLibrary3/my.cabal +0/−23
• tests/PackageTests/BuildDeps/InternalLibrary3/programs/lemon.hs +0/−6
• tests/PackageTests/BuildDeps/InternalLibrary3/to-install/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/InternalLibrary3/to-install/my.cabal +0/−18
• tests/PackageTests/BuildDeps/InternalLibrary4/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/InternalLibrary4/my.cabal +0/−23
• tests/PackageTests/BuildDeps/InternalLibrary4/programs/lemon.hs +0/−6
• tests/PackageTests/BuildDeps/InternalLibrary4/to-install/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/InternalLibrary4/to-install/my.cabal +0/−18
• tests/PackageTests/BuildDeps/SameDepsAllRound/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/SameDepsAllRound/SameDepsAllRound.cabal +0/−31
• tests/PackageTests/BuildDeps/SameDepsAllRound/lemon.hs +0/−7
• tests/PackageTests/BuildDeps/SameDepsAllRound/pineapple.hs +0/−7
• tests/PackageTests/BuildDeps/TargetSpecificDeps1/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/TargetSpecificDeps1/lemon.hs +0/−7
• tests/PackageTests/BuildDeps/TargetSpecificDeps1/my.cabal +0/−22
• tests/PackageTests/BuildDeps/TargetSpecificDeps2/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/TargetSpecificDeps2/lemon.hs +0/−5
• tests/PackageTests/BuildDeps/TargetSpecificDeps2/my.cabal +0/−24
• tests/PackageTests/BuildDeps/TargetSpecificDeps3/MyLibrary.hs +0/−10
• tests/PackageTests/BuildDeps/TargetSpecificDeps3/lemon.hs +0/−7
• tests/PackageTests/BuildDeps/TargetSpecificDeps3/my.cabal +0/−22
• tests/PackageTests/BuildTargetErrors/BuildTargetErrors.cabal +0/−10
• tests/PackageTests/BuildTargetErrors/Main.hs +0/−1
• tests/PackageTests/BuildTestSuiteDetailedV09/Dummy2.hs +0/−6
• tests/PackageTests/BuildableField/BuildableField.cabal +0/−16
• tests/PackageTests/BuildableField/Main.hs +0/−4
• tests/PackageTests/CMain/Bar.hs +0/−7
• tests/PackageTests/CMain/foo.c +0/−13
• tests/PackageTests/CMain/my.cabal +0/−10
• tests/PackageTests/DeterministicAr/Check.hs +0/−85
• tests/PackageTests/DeterministicAr/Lib.hs +0/−5
• tests/PackageTests/DeterministicAr/my.cabal +0/−17
• tests/PackageTests/DuplicateModuleName/DuplicateModuleName.cabal +0/−25
• tests/PackageTests/DuplicateModuleName/src/Foo.hs +0/−12
• tests/PackageTests/DuplicateModuleName/tests/Foo.hs +0/−18
• tests/PackageTests/DuplicateModuleName/tests2/Foo.hs +0/−18
• tests/PackageTests/EmptyLib/empty/empty.cabal +0/−6
• tests/PackageTests/GhcPkgGuess/SameDirectory/SameDirectory.cabal +0/−11
• tests/PackageTests/GhcPkgGuess/SameDirectory/ghc +0/−6
• tests/PackageTests/GhcPkgGuess/SameDirectory/ghc-pkg +0/−3
• tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/SameDirectory.cabal +0/−11
• tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/ghc-7.10 +0/−6
• tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/ghc-pkg-ghc-7.10 +0/−3
• tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/SameDirectory.cabal +0/−11
• tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/ghc-7.10 +0/−6
• tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/ghc-pkg-7.10 +0/−3
• tests/PackageTests/GhcPkgGuess/Symlink/SameDirectory.cabal +0/−11
• tests/PackageTests/GhcPkgGuess/Symlink/bin/ghc +0/−6
• tests/PackageTests/GhcPkgGuess/Symlink/bin/ghc-pkg +0/−3
• tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/SameDirectory.cabal +0/−11
• tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/bin/ghc-7.10 +0/−6
• tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/bin/ghc-pkg-7.10 +0/−3
• tests/PackageTests/GhcPkgGuess/SymlinkVersion/SameDirectory.cabal +0/−11
• tests/PackageTests/GhcPkgGuess/SymlinkVersion/bin/ghc-7.10 +0/−6
• tests/PackageTests/GhcPkgGuess/SymlinkVersion/bin/ghc-pkg-ghc-7.10 +0/−3
• tests/PackageTests/Haddock/CPP.hs +0/−9
• tests/PackageTests/Haddock/Literate.lhs +0/−4
• tests/PackageTests/Haddock/NoCPP.hs +0/−8
• tests/PackageTests/Haddock/Simple.hs +0/−4
• tests/PackageTests/Haddock/my.cabal +0/−16
• tests/PackageTests/HaddockNewline/A.hs +0/−1
• tests/PackageTests/HaddockNewline/HaddockNewline.cabal +0/−20
• tests/PackageTests/HaddockNewline/Setup.hs +0/−2
• tests/PackageTests/Options.hs +0/−19
• tests/PackageTests/OrderFlags/Foo.hs +0/−8
• tests/PackageTests/OrderFlags/my.cabal +0/−20
• tests/PackageTests/PackageTester.hs +0/−693
• tests/PackageTests/PathsModule/Executable/Main.hs +0/−8
• tests/PackageTests/PathsModule/Executable/my.cabal +0/−16
• tests/PackageTests/PathsModule/Library/my.cabal +0/−15
• tests/PackageTests/PreProcess/Foo.hsc +0/−1
• tests/PackageTests/PreProcess/Main.hs +0/−6
• tests/PackageTests/PreProcess/my.cabal +0/−32
• tests/PackageTests/PreProcessExtraSources/Foo.hsc +0/−9
• tests/PackageTests/PreProcessExtraSources/Main.hs +0/−8
• tests/PackageTests/PreProcessExtraSources/my.cabal +0/−32
• tests/PackageTests/ReexportedModules/ReexportedModules.cabal +0/−11
• tests/PackageTests/TemplateHaskell/dynamic/Exe.hs +0/−6
• tests/PackageTests/TemplateHaskell/dynamic/Lib.hs +0/−6
• tests/PackageTests/TemplateHaskell/dynamic/TH.hs +0/−4
• tests/PackageTests/TemplateHaskell/dynamic/my.cabal +0/−15
• tests/PackageTests/TemplateHaskell/profiling/Exe.hs +0/−6
• tests/PackageTests/TemplateHaskell/profiling/Lib.hs +0/−6
• tests/PackageTests/TemplateHaskell/profiling/TH.hs +0/−4
• tests/PackageTests/TemplateHaskell/profiling/my.cabal +0/−15
• tests/PackageTests/TemplateHaskell/vanilla/Exe.hs +0/−6
• tests/PackageTests/TemplateHaskell/vanilla/Lib.hs +0/−6
• tests/PackageTests/TemplateHaskell/vanilla/TH.hs +0/−4
• tests/PackageTests/TemplateHaskell/vanilla/my.cabal +0/−15
• tests/PackageTests/TestNameCollision/child/Child.hs +0/−2
• tests/PackageTests/TestNameCollision/child/child.cabal +0/−19
• tests/PackageTests/TestNameCollision/child/tests/Test.hs +0/−13
• tests/PackageTests/TestNameCollision/parent/Parent.hs +0/−1
• tests/PackageTests/TestNameCollision/parent/parent.cabal +0/−13
• tests/PackageTests/TestOptions/TestOptions.cabal +0/−20
• tests/PackageTests/TestOptions/test-TestOptions.hs +0/−11
• tests/PackageTests/TestStanza/Check.hs +0/−29
• tests/PackageTests/TestStanza/my.cabal +0/−19
• tests/PackageTests/TestSuiteTests/ExeV10/Check.hs +0/−129
• tests/PackageTests/TestSuiteTests/ExeV10/Foo.hs +0/−4
• tests/PackageTests/TestSuiteTests/ExeV10/my.cabal +0/−21
• tests/PackageTests/TestSuiteTests/ExeV10/tests/test-Foo.hs +0/−12
• tests/PackageTests/TestSuiteTests/ExeV10/tests/test-Short.hs +0/−11
• tests/PackageTests/TestSuiteTests/LibV09/Lib.hs +0/−11
• tests/PackageTests/TestSuiteTests/LibV09/LibV09.cabal +0/−21
• tests/PackageTests/TestSuiteTests/LibV09/tests/Deadlock.hs +0/−8
• tests/PackageTests/Tests.hs +0/−314
• tests/PackageTests/UniqueIPID/P1/M.hs +0/−3
• tests/PackageTests/UniqueIPID/P1/my.cabal +0/−15
• tests/PackageTests/UniqueIPID/P2/M.hs +0/−3
• tests/PackageTests/UniqueIPID/P2/my.cabal +0/−15
• tests/PackageTests/multInst/my.cabal +0/−16
• tests/ParserHackageTests.hs +365/−0
• tests/ParserTests.hs +56/−0
• tests/ParserTests/warnings/bom.cabal +7/−0
• tests/ParserTests/warnings/bool.cabal +12/−0
• tests/ParserTests/warnings/deprecatedfield.cabal +7/−0
• tests/ParserTests/warnings/extratestmodule.cabal +11/−0
• tests/ParserTests/warnings/gluedop.cabal +9/−0
• tests/ParserTests/warnings/nbsp.cabal +7/−0
• tests/ParserTests/warnings/newsyntax.cabal +6/−0
• tests/ParserTests/warnings/oldsyntax.cabal +6/−0
• tests/ParserTests/warnings/subsection.cabal +9/−0
• tests/ParserTests/warnings/trailingfield.cabal +9/−0
• tests/ParserTests/warnings/unknownfield.cabal +8/−0
• tests/ParserTests/warnings/unknownsection.cabal +10/−0
• tests/ParserTests/warnings/utf8.cabal +8/−0
• tests/ParserTests/warnings/versiontag.cabal +7/−0
• tests/README.md +4/−37
• tests/Setup.hs +0/−3
• tests/StructDiff.hs +162/−0
• tests/UnitTests.hs +53/−3
• tests/UnitTests/Distribution/Compat/Graph.hs +91/−0
• tests/UnitTests/Distribution/Compat/Time.hs +49/−0
• tests/UnitTests/Distribution/Simple/Utils.hs +42/−1
• tests/UnitTests/Distribution/Utils/NubList.hs +38/−8
• tests/UnitTests/Distribution/Utils/ShortText.hs +33/−0
• tests/UnitTests/Distribution/Version.hs +167/−86

@@ -1,15 +1,13 @@-name: Cabal-version: 1.24.2.0-copyright: 2003-2006, Isaac Jones-           2005-2011, Duncan Coutts-license: BSD3-license-file: LICENSE-author: Isaac Jones <ijones@syntaxpolice.org>-        Duncan Coutts <duncan@community.haskell.org>-maintainer: cabal-devel@haskell.org-homepage: http://www.haskell.org/cabal/-bug-reports: https://github.com/haskell/cabal/issues-synopsis: A framework for packaging Haskell software+name:          Cabal+version:       2.0.0.2+copyright:     2003-2017, Cabal Development Team (see AUTHORS file)+license:       BSD3+license-file:  LICENSE+author:        Cabal Development Team <cabal-devel@haskell.org>+maintainer:    cabal-devel@haskell.org+homepage:      http://www.haskell.org/cabal/+bug-reports:   https://github.com/haskell/cabal/issues+synopsis:      A framework for packaging Haskell software description:   The Haskell Common Architecture for Building Applications and   Libraries: a framework defining a common interface for authors to more@@ -17,157 +15,37 @@   .   The Haskell Cabal is part of a larger infrastructure for distributing,   organizing, and cataloging Haskell libraries and tools.-category: Distribution-cabal-version: >=1.10-build-type: Simple+category:       Distribution+cabal-version:  >=1.10+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-  doc/Cabal.css doc/developing-packages.markdown doc/index.markdown-  doc/installing-packages.markdown-  doc/misc.markdown+  doc/bugs-and-stability.rst doc/concepts-and-development.rst+  doc/conf.py doc/config-and-install.rst doc/developing-packages.rst+  doc/images/Cabal-dark.png doc/index.rst doc/installing-packages.rst+  doc/intro.rst doc/misc.rst doc/nix-local-build-overview.rst+  doc/nix-local-build.rst doc/README.md doc/references.inc    -- 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-  tests/PackageTests/BenchmarkOptions/BenchmarkOptions.cabal-  tests/PackageTests/BenchmarkOptions/test-BenchmarkOptions.hs-  tests/PackageTests/BenchmarkStanza/my.cabal-  tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive1/GlobalBuildDepsNotAdditive1.cabal-  tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive1/MyLibrary.hs-  tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive2/GlobalBuildDepsNotAdditive2.cabal-  tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive2/lemon.hs-  tests/PackageTests/BuildDeps/InternalLibrary0/MyLibrary.hs-  tests/PackageTests/BuildDeps/InternalLibrary0/my.cabal-  tests/PackageTests/BuildDeps/InternalLibrary0/programs/lemon.hs-  tests/PackageTests/BuildDeps/InternalLibrary1/MyLibrary.hs-  tests/PackageTests/BuildDeps/InternalLibrary1/my.cabal-  tests/PackageTests/BuildDeps/InternalLibrary1/programs/lemon.hs-  tests/PackageTests/BuildDeps/InternalLibrary2/MyLibrary.hs-  tests/PackageTests/BuildDeps/InternalLibrary2/my.cabal-  tests/PackageTests/BuildDeps/InternalLibrary2/programs/lemon.hs-  tests/PackageTests/BuildDeps/InternalLibrary2/to-install/MyLibrary.hs-  tests/PackageTests/BuildDeps/InternalLibrary2/to-install/my.cabal-  tests/PackageTests/BuildDeps/InternalLibrary3/MyLibrary.hs-  tests/PackageTests/BuildDeps/InternalLibrary3/my.cabal-  tests/PackageTests/BuildDeps/InternalLibrary3/programs/lemon.hs-  tests/PackageTests/BuildDeps/InternalLibrary3/to-install/MyLibrary.hs-  tests/PackageTests/BuildDeps/InternalLibrary3/to-install/my.cabal-  tests/PackageTests/BuildDeps/InternalLibrary4/MyLibrary.hs-  tests/PackageTests/BuildDeps/InternalLibrary4/my.cabal-  tests/PackageTests/BuildDeps/InternalLibrary4/programs/lemon.hs-  tests/PackageTests/BuildDeps/InternalLibrary4/to-install/MyLibrary.hs-  tests/PackageTests/BuildDeps/InternalLibrary4/to-install/my.cabal-  tests/PackageTests/BuildDeps/SameDepsAllRound/MyLibrary.hs-  tests/PackageTests/BuildDeps/SameDepsAllRound/SameDepsAllRound.cabal-  tests/PackageTests/BuildDeps/SameDepsAllRound/lemon.hs-  tests/PackageTests/BuildDeps/SameDepsAllRound/pineapple.hs-  tests/PackageTests/BuildDeps/TargetSpecificDeps1/MyLibrary.hs-  tests/PackageTests/BuildDeps/TargetSpecificDeps1/lemon.hs-  tests/PackageTests/BuildDeps/TargetSpecificDeps1/my.cabal-  tests/PackageTests/BuildDeps/TargetSpecificDeps2/MyLibrary.hs-  tests/PackageTests/BuildDeps/TargetSpecificDeps2/lemon.hs-  tests/PackageTests/BuildDeps/TargetSpecificDeps2/my.cabal-  tests/PackageTests/BuildDeps/TargetSpecificDeps3/MyLibrary.hs-  tests/PackageTests/BuildDeps/TargetSpecificDeps3/lemon.hs-  tests/PackageTests/BuildDeps/TargetSpecificDeps3/my.cabal-  tests/PackageTests/BuildTargetErrors/BuildTargetErrors.cabal-  tests/PackageTests/BuildTargetErrors/Main.hs-  tests/PackageTests/BuildTestSuiteDetailedV09/Dummy2.hs-  tests/PackageTests/BuildableField/BuildableField.cabal-  tests/PackageTests/BuildableField/Main.hs-  tests/PackageTests/CMain/Bar.hs-  tests/PackageTests/CMain/foo.c-  tests/PackageTests/CMain/my.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/Options.hs-  tests/PackageTests/OrderFlags/Foo.hs-  tests/PackageTests/OrderFlags/my.cabal-  tests/PackageTests/PathsModule/Executable/Main.hs-  tests/PackageTests/PathsModule/Executable/my.cabal-  tests/PackageTests/PathsModule/Library/my.cabal-  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-  tests/PackageTests/TemplateHaskell/dynamic/TH.hs-  tests/PackageTests/TemplateHaskell/dynamic/my.cabal-  tests/PackageTests/TemplateHaskell/profiling/Exe.hs-  tests/PackageTests/TemplateHaskell/profiling/Lib.hs-  tests/PackageTests/TemplateHaskell/profiling/TH.hs-  tests/PackageTests/TemplateHaskell/profiling/my.cabal-  tests/PackageTests/TemplateHaskell/vanilla/Exe.hs-  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/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/ParserTests/warnings/bom.cabal+  tests/ParserTests/warnings/bool.cabal+  tests/ParserTests/warnings/deprecatedfield.cabal+  tests/ParserTests/warnings/extratestmodule.cabal+  tests/ParserTests/warnings/gluedop.cabal+  tests/ParserTests/warnings/nbsp.cabal+  tests/ParserTests/warnings/newsyntax.cabal+  tests/ParserTests/warnings/oldsyntax.cabal+  tests/ParserTests/warnings/subsection.cabal+  tests/ParserTests/warnings/trailingfield.cabal+  tests/ParserTests/warnings/unknownfield.cabal+  tests/ParserTests/warnings/unknownsection.cabal+  tests/ParserTests/warnings/utf8.cabal+  tests/ParserTests/warnings/versiontag.cabal   tests/hackage/check.sh   tests/hackage/download.sh   tests/hackage/unpack.sh@@ -182,6 +60,20 @@ flag bundled-binary-generic   default: False +flag old-directory+  description:  Use directory < 1.2 and old-time+  default:      False++flag parsec+  description:  Use parsec parser+  default:      False+  manual:       True++flag parsec-struct-diff+  description:  Use StructDiff in parsec tests. Affects only parsec tests.+  default:      False+  manual:       True+ library   build-depends:     array      >= 0.1 && < 0.6,@@ -189,12 +81,18 @@     bytestring >= 0.9 && < 1,     containers >= 0.4 && < 0.6,     deepseq    >= 1.3 && < 1.5,-    directory  >= 1.1 && < 1.4,     filepath   >= 1.3 && < 1.5,     pretty     >= 1.1 && < 1.2,-    process    >= 1.1.0.1 && < 1.5,-    time       >= 1.4 && < 1.8+    process    >= 1.1.0.1 && < 1.7,+    time       >= 1.4 && < 1.9 +  if flag(old-directory)+    build-depends: directory >= 1.1 && < 1.2, old-time >= 1 && < 1.2,+                   process   >= 1.0.1.1  && < 1.1.0.2+  else+    build-depends: directory >= 1.2 && < 1.4,+                   process   >= 1.1.0.2  && < 1.7+   if flag(bundled-binary-generic)     build-depends: binary >= 0.5 && < 0.7   else@@ -210,7 +108,7 @@    if os(windows)     build-depends:-      Win32 >= 2.2 && < 2.4+      Win32 >= 2.2 && < 2.6    ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs   if impl(ghc >= 8.0)@@ -218,12 +116,29 @@                  -Wnoncanonical-monadfail-instances    exposed-modules:+    Distribution.Backpack+    Distribution.Backpack.Configure+    Distribution.Backpack.ComponentsGraph+    Distribution.Backpack.ConfiguredComponent+    Distribution.Backpack.DescribeUnitId+    Distribution.Backpack.FullUnitId+    Distribution.Backpack.LinkedComponent+    Distribution.Backpack.ModSubst+    Distribution.Backpack.ModuleShape+    Distribution.Utils.LogProgress+    Distribution.Utils.MapAccum     Distribution.Compat.CreatePipe     Distribution.Compat.Environment     Distribution.Compat.Exception+    Distribution.Compat.Graph     Distribution.Compat.Internal.TempFile+    Distribution.Compat.Map.Strict+    Distribution.Compat.Prelude.Internal     Distribution.Compat.ReadP     Distribution.Compat.Semigroup+    Distribution.Compat.Stack+    Distribution.Compat.Time+    Distribution.Compat.DList     Distribution.Compiler     Distribution.InstalledPackageInfo     Distribution.License@@ -237,6 +152,7 @@     Distribution.PackageDescription.PrettyPrint     Distribution.PackageDescription.Utils     Distribution.ParseUtils+    Distribution.PrettyUtils     Distribution.ReadE     Distribution.Simple     Distribution.Simple.Bench@@ -245,6 +161,7 @@     Distribution.Simple.Build.PathsModule     Distribution.Simple.BuildPaths     Distribution.Simple.BuildTarget+    Distribution.Simple.BuildToolDepends     Distribution.Simple.CCompiler     Distribution.Simple.Command     Distribution.Simple.Compiler@@ -252,6 +169,7 @@     Distribution.Simple.GHC     Distribution.Simple.GHCJS     Distribution.Simple.Haddock+    Distribution.Simple.Doctest     Distribution.Simple.HaskellSuite     Distribution.Simple.Hpc     Distribution.Simple.Install@@ -289,18 +207,101 @@     Distribution.System     Distribution.TestSuite     Distribution.Text+    Distribution.Types.AbiHash+    Distribution.Types.AnnotatedId+    Distribution.Types.Benchmark+    Distribution.Types.BenchmarkInterface+    Distribution.Types.BenchmarkType+    Distribution.Types.BuildInfo+    Distribution.Types.BuildType+    Distribution.Types.ComponentInclude+    Distribution.Types.Dependency+    Distribution.Types.ExeDependency+    Distribution.Types.LegacyExeDependency+    Distribution.Types.PkgconfigDependency+    Distribution.Types.DependencyMap+    Distribution.Types.ComponentId+    Distribution.Types.MungedPackageId+    Distribution.Types.PackageId+    Distribution.Types.UnitId+    Distribution.Types.Executable+    Distribution.Types.ExecutableScope+    Distribution.Types.Library+    Distribution.Types.ForeignLib+    Distribution.Types.ForeignLibType+    Distribution.Types.ForeignLibOption+    Distribution.Types.Module+    Distribution.Types.ModuleReexport+    Distribution.Types.ModuleRenaming+    Distribution.Types.ComponentName+    Distribution.Types.MungedPackageName+    Distribution.Types.PackageName+    Distribution.Types.PkgconfigName+    Distribution.Types.UnqualComponentName+    Distribution.Types.IncludeRenaming+    Distribution.Types.Mixin+    Distribution.Types.SetupBuildInfo+    Distribution.Types.TestSuite+    Distribution.Types.TestSuiteInterface+    Distribution.Types.TestType+    Distribution.Types.GenericPackageDescription+    Distribution.Types.Condition+    Distribution.Types.CondTree+    Distribution.Types.HookedBuildInfo+    Distribution.Types.PackageDescription+    Distribution.Types.SourceRepo+    Distribution.Types.Component+    Distribution.Types.ComponentLocalBuildInfo+    Distribution.Types.LocalBuildInfo+    Distribution.Types.ComponentRequestedSpec+    Distribution.Types.TargetInfo+    Distribution.Utils.Generic     Distribution.Utils.NubList+    Distribution.Utils.ShortText+    Distribution.Utils.Progress     Distribution.Verbosity     Distribution.Version     Language.Haskell.Extension     Distribution.Compat.Binary +  if flag(parsec)+    cpp-options: -DCABAL_PARSEC+    build-depends:+      transformers,+      parsec >= 3.1.9 && <3.2+    build-tools:+      alex >=3.1.4 && <3.3+    exposed-modules:+      Distribution.Compat.Parsec+      Distribution.PackageDescription.Parsec+      Distribution.PackageDescription.Parsec.FieldDescr+      Distribution.Parsec.Class+      Distribution.Parsec.ConfVar+      Distribution.Parsec.Lexer+      Distribution.Parsec.LexerMonad+      Distribution.Parsec.Parser+      Distribution.Parsec.Types.Common+      Distribution.Parsec.Types.Field+      Distribution.Parsec.Types.FieldDescr+      Distribution.Parsec.Types.ParseResult+   other-modules:+    Distribution.Backpack.PreExistingComponent+    Distribution.Backpack.ReadyComponent+    Distribution.Backpack.MixLink+    Distribution.Backpack.ModuleScope+    Distribution.Backpack.UnifyM+    Distribution.Backpack.Id+    Distribution.Utils.UnionFind+    Distribution.Utils.Base62     Distribution.Compat.CopyFile     Distribution.Compat.GetShortPathName     Distribution.Compat.MonadFail+    Distribution.Compat.Prelude+    Distribution.Compat.SnocList     Distribution.GetOpt     Distribution.Lex+    Distribution.Utils.String     Distribution.Simple.GHC.Internal     Distribution.Simple.GHC.IPI642     Distribution.Simple.GHC.IPIConvert@@ -312,8 +313,37 @@       Distribution.Compat.Binary.Class       Distribution.Compat.Binary.Generic -  default-language: Haskell98+  default-language: Haskell2010+  other-extensions:+    BangPatterns+    CPP+    DefaultSignatures+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    ExistentialQuantification+    FlexibleContexts+    FlexibleInstances+    GeneralizedNewtypeDeriving+    ImplicitParams+    KindSignatures+    NondecreasingIndentation+    OverloadedStrings+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    Trustworthy+    TypeFamilies+    TypeOperators+    TypeSynonymInstances+    UndecidableInstances +  if impl(ghc >= 7.11)+    other-extensions: PatternSynonyms+ -- Small, fast running tests. test-suite unit-tests   type: exitcode-stdio-1.0@@ -323,51 +353,77 @@     Test.QuickCheck.Utils     UnitTests.Distribution.Compat.CreatePipe     UnitTests.Distribution.Compat.ReadP+    UnitTests.Distribution.Compat.Time+    UnitTests.Distribution.Compat.Graph     UnitTests.Distribution.Simple.Program.Internal     UnitTests.Distribution.Simple.Utils     UnitTests.Distribution.System     UnitTests.Distribution.Utils.NubList+    UnitTests.Distribution.Utils.ShortText     UnitTests.Distribution.Version   main-is: UnitTests.hs   build-depends:+    array,     base,+    containers,     directory,+    filepath,     tasty,     tasty-hunit,     tasty-quickcheck,+    tagged,     pretty,-    QuickCheck >= 2.7 && < 2.10,+    QuickCheck >= 2.7 && < 2.11,     Cabal   ghc-options: -Wall-  default-language: Haskell98+  default-language: Haskell2010 --- Large, system tests that build packages.-test-suite package-tests+test-suite parser-tests+  if !flag(parsec)+    buildable: False+   type: exitcode-stdio-1.0-  main-is: PackageTests.hs-  other-modules:-    PackageTests.BenchmarkStanza.Check-    PackageTests.TestStanza.Check-    PackageTests.DeterministicAr.Check-    PackageTests.TestSuiteTests.ExeV10.Check-    PackageTests.PackageTester   hs-source-dirs: tests+  main-is: ParserTests.hs   build-depends:     base,-    containers,-    tagged,+    bytestring,+    filepath,     tasty,     tasty-hunit,-    transformers,-    Cabal,-    process,+    tasty-quickcheck,+    Cabal+  ghc-options: -Wall+  default-language: Haskell2010++test-suite parser-hackage-tests+  if !flag(parsec)+    buildable: False++  type: exitcode-stdio-1.0+  main-is: ParserHackageTests.hs++  hs-source-dirs: tests+  build-depends:+    base,+    containers,+    tar >=0.5 && <0.6,+    bytestring,     directory,     filepath,-    bytestring,-    regex-posix,-    old-time-  if !os(windows)-    build-depends: unix, exceptions+    Cabal++  if flag(parsec-struct-diff)+    build-depends:+      generics-sop ==0.2.*,+      these >=0.7.1 && <0.8,+      singleton-bool >=0.1.1.0 && <0.2,+      keys+    other-modules:+      DiffInstances+      StructDiff+    cpp-options: -DHAS_STRUCT_DIFF+   ghc-options: -Wall -rtsopts   default-extensions: CPP-  default-language: Haskell98+  default-language: Haskell2010

@@ -0,0 +1,246 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | This module defines the core data types for Backpack.  For more+-- details, see:+--+--  <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>++module Distribution.Backpack (+    -- * OpenUnitId+    OpenUnitId(..),+    openUnitIdFreeHoles,+    mkOpenUnitId,++    -- * DefUnitId+    DefUnitId,+    unDefUnitId,+    mkDefUnitId,++    -- * OpenModule+    OpenModule(..),+    openModuleFreeHoles,++    -- * OpenModuleSubst+    OpenModuleSubst,+    dispOpenModuleSubst,+    dispOpenModuleSubstEntry,+    parseOpenModuleSubst,+    parseOpenModuleSubstEntry,+    openModuleSubstFreeHoles,++    -- * Conversions to 'UnitId'+    abstractUnitId,+    hashModuleSubst,+) where++import Prelude ()+import Distribution.Compat.Prelude hiding (mod)+import Distribution.Compat.ReadP+import qualified Distribution.Compat.ReadP as Parse+import qualified Text.PrettyPrint as Disp+import Text.PrettyPrint (hcat)++import Distribution.ModuleName+import Distribution.Text+import Distribution.Types.ComponentId+import Distribution.Types.UnitId+import Distribution.Types.Module+import Distribution.Utils.Base62++import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set++-----------------------------------------------------------------------+-- OpenUnitId++-- | An 'OpenUnitId' describes a (possibly partially) instantiated+-- Backpack component, with a description of how the holes are filled+-- in.  Unlike 'OpenUnitId', the 'ModuleSubst' is kept in a structured+-- form that allows for substitution (which fills in holes.) This form+-- of unit cannot be installed. It must first be converted to a+-- 'UnitId'.+--+-- In the absence of Backpack, there are no holes to fill, so any such+-- component always has an empty module substitution; thus we can lossly+-- represent it as an 'OpenUnitId uid'.+--+-- For a source component using Backpack, however, there is more+-- structure as components may be parametrized over some signatures, and+-- these \"holes\" may be partially or wholly filled.+--+-- OpenUnitId plays an important role when we are mix-in linking,+-- and is recorded to the installed packaged database for indefinite+-- packages; however, for compiled packages that are fully instantiated,+-- we instantiate 'OpenUnitId' into 'UnitId'.+--+-- For more details see the Backpack spec+-- <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+--++data OpenUnitId+    -- | Identifies a component which may have some unfilled holes;+    -- specifying its 'ComponentId' and its 'OpenModuleSubst'.+    -- TODO: Invariant that 'OpenModuleSubst' is non-empty?+    -- See also the Text instance.+    = IndefFullUnitId ComponentId OpenModuleSubst+    -- | Identifies a fully instantiated component, which has+    -- been compiled and abbreviated as a hash.  The embedded 'UnitId'+    -- MUST NOT be for an indefinite component; an 'OpenUnitId'+    -- is guaranteed not to have any holes.+    | DefiniteUnitId DefUnitId+  deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)+-- TODO: cache holes?++instance Binary OpenUnitId++instance NFData OpenUnitId where+    rnf (IndefFullUnitId cid subst) = rnf cid `seq` rnf subst+    rnf (DefiniteUnitId uid) = rnf uid++instance Text OpenUnitId where+    disp (IndefFullUnitId cid insts)+        -- TODO: arguably a smart constructor to enforce invariant would be+        -- better+        | Map.null insts = disp cid+        | otherwise      = disp cid <<>> Disp.brackets (dispOpenModuleSubst insts)+    disp (DefiniteUnitId uid) = disp uid+    parse = parseOpenUnitId <++ fmap DefiniteUnitId parse+      where+        parseOpenUnitId = do+            cid <- parse+            insts <- Parse.between (Parse.char '[') (Parse.char ']')+                       parseOpenModuleSubst+            return (IndefFullUnitId cid insts)++-- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'.+openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName+openUnitIdFreeHoles (IndefFullUnitId _ insts) = openModuleSubstFreeHoles insts+openUnitIdFreeHoles _ = Set.empty++-- | Safe constructor from a UnitId.  The only way to do this safely+-- is if the instantiation is provided.+mkOpenUnitId :: UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId+mkOpenUnitId uid cid insts =+    if Set.null (openModuleSubstFreeHoles insts)+        then DefiniteUnitId (unsafeMkDefUnitId uid) -- invariant holds!+        else IndefFullUnitId cid insts++-----------------------------------------------------------------------+-- DefUnitId++-- | Create a 'DefUnitId' from a 'ComponentId' and an instantiation+-- with no holes.+mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId+mkDefUnitId cid insts =+    unsafeMkDefUnitId (mkUnitId+        (unComponentId cid ++ maybe "" ("+"++) (hashModuleSubst insts)))+        -- impose invariant!++-----------------------------------------------------------------------+-- OpenModule++-- | Unlike a 'Module', an 'OpenModule' is either an ordinary+-- module from some unit, OR an 'OpenModuleVar', representing a+-- hole that needs to be filled in.  Substitutions are over+-- module variables.+data OpenModule+    = OpenModule OpenUnitId ModuleName+    | OpenModuleVar ModuleName+  deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)++instance Binary OpenModule++instance NFData OpenModule where+    rnf (OpenModule uid mod_name) = rnf uid `seq` rnf mod_name+    rnf (OpenModuleVar mod_name) = rnf mod_name++instance Text OpenModule where+    disp (OpenModule uid mod_name) =+        hcat [disp uid, Disp.text ":", disp mod_name]+    disp (OpenModuleVar mod_name) =+        hcat [Disp.char '<', disp mod_name, Disp.char '>']+    parse = parseModuleVar <++ parseOpenModule+      where+        parseOpenModule = do+            uid <- parse+            _ <- Parse.char ':'+            mod_name <- parse+            return (OpenModule uid mod_name)+        parseModuleVar = do+            _ <- Parse.char '<'+            mod_name <- parse+            _ <- Parse.char '>'+            return (OpenModuleVar mod_name)++-- | Get the set of holes ('ModuleVar') embedded in a 'Module'.+openModuleFreeHoles :: OpenModule -> Set ModuleName+openModuleFreeHoles (OpenModuleVar mod_name) = Set.singleton mod_name+openModuleFreeHoles (OpenModule uid _n) = openUnitIdFreeHoles uid++-----------------------------------------------------------------------+-- OpenModuleSubst++-- | An explicit substitution on modules.+--+-- NB: These substitutions are NOT idempotent, for example, a+-- valid substitution is (A -> B, B -> A).+type OpenModuleSubst = Map ModuleName OpenModule++-- | Pretty-print the entries of a module substitution, suitable+-- for embedding into a 'OpenUnitId' or passing to GHC via @--instantiate-with@.+dispOpenModuleSubst :: OpenModuleSubst -> Disp.Doc+dispOpenModuleSubst subst+    = Disp.hcat+    . Disp.punctuate Disp.comma+    $ map dispOpenModuleSubstEntry (Map.toAscList subst)++-- | Pretty-print a single entry of a module substitution.+dispOpenModuleSubstEntry :: (ModuleName, OpenModule) -> Disp.Doc+dispOpenModuleSubstEntry (k, v) = disp k <<>> Disp.char '=' <<>> disp v++-- | Inverse to 'dispModSubst'.+parseOpenModuleSubst :: ReadP r OpenModuleSubst+parseOpenModuleSubst = fmap Map.fromList+      . flip Parse.sepBy (Parse.char ',')+      $ parseOpenModuleSubstEntry++-- | Inverse to 'dispModSubstEntry'.+parseOpenModuleSubstEntry :: ReadP r (ModuleName, OpenModule)+parseOpenModuleSubstEntry =+    do k <- parse+       _ <- Parse.char '='+       v <- parse+       return (k, v)++-- | Get the set of holes ('ModuleVar') embedded in a 'OpenModuleSubst'.+-- This is NOT the domain of the substitution.+openModuleSubstFreeHoles :: OpenModuleSubst -> Set ModuleName+openModuleSubstFreeHoles insts = Set.unions (map openModuleFreeHoles (Map.elems insts))++-----------------------------------------------------------------------+-- Conversions to UnitId++-- | When typechecking, we don't demand that a freshly instantiated+-- 'IndefFullUnitId' be compiled; instead, we just depend on the+-- installed indefinite unit installed at the 'ComponentId'.+abstractUnitId :: OpenUnitId -> UnitId+abstractUnitId (DefiniteUnitId def_uid) = unDefUnitId def_uid+abstractUnitId (IndefFullUnitId cid _) = newSimpleUnitId cid++-- | Take a module substitution and hash it into a string suitable for+-- 'UnitId'.  Note that since this takes 'Module', not 'OpenModule',+-- you are responsible for recursively converting 'OpenModule'+-- into 'Module'.  See also "Distribution.Backpack.ReadyComponent".+hashModuleSubst :: Map ModuleName Module -> Maybe String+hashModuleSubst subst+  | Map.null subst = Nothing+  | otherwise =+      Just . hashToBase62 $+        concat [ display mod_name ++ "=" ++ display m ++ "\n"+               | (mod_name, m) <- Map.toList subst]

@@ -0,0 +1,97 @@+-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+module Distribution.Backpack.ComponentsGraph (+    ComponentsGraph,+    ComponentsWithDeps,+    mkComponentsGraph,+    componentsGraphToList,+    dispComponentsWithDeps,+    componentCycleMsg+) where++import Prelude ()+import Distribution.Compat.Prelude++import Distribution.Package+import Distribution.PackageDescription as PD hiding (Flag)+import Distribution.Simple.BuildToolDepends+import Distribution.Simple.LocalBuildInfo+import Distribution.Types.ComponentRequestedSpec+import Distribution.Types.UnqualComponentName+import Distribution.Compat.Graph (Graph, Node(..))+import qualified Distribution.Compat.Graph as Graph++import Distribution.Text+    ( Text(disp) )+import Text.PrettyPrint++------------------------------------------------------------------------------+-- Components graph+------------------------------------------------------------------------------++-- | A graph of source-level components by their source-level+-- dependencies+--+type ComponentsGraph = Graph (Node ComponentName Component)++-- | A list of components associated with the source level+-- dependencies between them.+--+type ComponentsWithDeps = [(Component, [ComponentName])]++-- | Pretty-print 'ComponentsWithDeps'.+--+dispComponentsWithDeps :: ComponentsWithDeps -> Doc+dispComponentsWithDeps graph =+    vcat [ hang (text "component" <+> disp (componentName c)) 4+                (vcat [ text "dependency" <+> disp cdep | cdep <- cdeps ])+         | (c, cdeps) <- graph ]++-- | Create a 'Graph' of 'Component', or report a cycle if there is a+-- problem.+--+mkComponentsGraph :: ComponentRequestedSpec+                  -> PackageDescription+                  -> Either [ComponentName] ComponentsGraph+mkComponentsGraph enabled pkg_descr =+    let g = Graph.fromDistinctList+                           [ N c (componentName c) (componentDeps c)+                           | c <- pkgBuildableComponents pkg_descr+                           , componentEnabled enabled c ]+    in case Graph.cycles g of+          []     -> Right g+          ccycles -> Left  [ componentName c | N c _ _ <- concat ccycles ]+  where+    -- The dependencies for the given component+    componentDeps component =+      (CExeName <$> getAllInternalToolDependencies pkg_descr bi)++      ++ [ if pkgname == packageName pkg_descr+           then CLibName+           else CSubLibName toolname+         | Dependency pkgname _ <- targetBuildDepends bi+         , let toolname = packageNameToUnqualComponentName pkgname+         , toolname `elem` internalPkgDeps ]+      where+        bi = componentBuildInfo component+        internalPkgDeps = map (conv . libName) (allLibraries pkg_descr)+        conv Nothing = packageNameToUnqualComponentName $ packageName pkg_descr+        conv (Just s) = s++-- | Given the package description and a 'PackageDescription' (used+-- to determine if a package name is internal or not), sort the+-- components in dependency order (fewest dependencies first).  This is+-- NOT necessarily the build order (although it is in the absence of+-- Backpack.)+--+componentsGraphToList :: ComponentsGraph+                      -> ComponentsWithDeps+componentsGraphToList =+    map (\(N c _ cs) -> (c, cs)) . Graph.revTopSort++-- | Error message when there is a cycle; takes the SCC of components.+componentCycleMsg :: [ComponentName] -> Doc+componentCycleMsg cnames =+    text $ "Components in the package depend on each other in a cyclic way:\n  "+       ++ intercalate " depends on "+            [ "'" ++ showComponentName cname ++ "'"+            | cname <- cnames ++ [head cnames] ]

@@ -0,0 +1,357 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoMonoLocalBinds #-}+{-# LANGUAGE NondecreasingIndentation #-}++-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+--+-- WARNING: The contents of this module are HIGHLY experimental.+-- We may refactor it under you.+module Distribution.Backpack.Configure (+    configureComponentLocalBuildInfos,+) where++import Prelude ()+import Distribution.Compat.Prelude hiding ((<>))++import Distribution.Backpack+import Distribution.Backpack.FullUnitId+import Distribution.Backpack.PreExistingComponent+import Distribution.Backpack.ConfiguredComponent+import Distribution.Backpack.LinkedComponent+import Distribution.Backpack.ReadyComponent+import Distribution.Backpack.ComponentsGraph+import Distribution.Backpack.Id++import Distribution.Simple.Compiler hiding (Flag)+import Distribution.Package+import qualified Distribution.InstalledPackageInfo as Installed+import Distribution.InstalledPackageInfo (InstalledPackageInfo+                                         ,emptyInstalledPackageInfo)+import qualified Distribution.Simple.PackageIndex as PackageIndex+import Distribution.Simple.PackageIndex (InstalledPackageIndex)+import Distribution.PackageDescription as PD hiding (Flag)+import Distribution.ModuleName+import Distribution.Simple.Setup as Setup+import Distribution.Simple.LocalBuildInfo+import Distribution.Types.AnnotatedId+import Distribution.Types.ComponentRequestedSpec+import Distribution.Types.ComponentInclude+import Distribution.Verbosity+import qualified Distribution.Compat.Graph as Graph+import Distribution.Compat.Graph (Graph, IsNode(..))+import Distribution.Utils.LogProgress++import Data.Either+    ( lefts )+import qualified Data.Set as Set+import qualified Data.Map as Map+import Distribution.Text+import Text.PrettyPrint++------------------------------------------------------------------------------+-- Pipeline+------------------------------------------------------------------------------++configureComponentLocalBuildInfos+    :: Verbosity+    -> Bool                   -- use_external_internal_deps+    -> ComponentRequestedSpec+    -> Bool                   -- deterministic+    -> Flag String            -- configIPID+    -> Flag ComponentId       -- configCID+    -> PackageDescription+    -> [PreExistingComponent]+    -> FlagAssignment         -- configConfigurationsFlags+    -> [(ModuleName, Module)] -- configInstantiateWith+    -> InstalledPackageIndex+    -> Compiler+    -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)+configureComponentLocalBuildInfos+    verbosity use_external_internal_deps enabled deterministic ipid_flag cid_flag pkg_descr+    prePkgDeps flagAssignment instantiate_with installedPackageSet comp = do+    -- NB: In single component mode, this returns a *single* component.+    -- In this graph, the graph is NOT closed.+    graph0 <- case mkComponentsGraph enabled pkg_descr of+                Left ccycle -> dieProgress (componentCycleMsg ccycle)+                Right g -> return (componentsGraphToList g)+    infoProgress $ hang (text "Source component graph:") 4+                        (dispComponentsWithDeps graph0)++    let conf_pkg_map = Map.fromListWith Map.union+            [(pc_pkgname pkg,+                Map.singleton (pc_compname pkg)+                              (AnnotatedId {+                                ann_id = pc_cid pkg,+                                ann_pid = packageId pkg,+                                ann_cname = pc_compname pkg+                              }))+            | pkg <- prePkgDeps]+    graph1 <- toConfiguredComponents use_external_internal_deps+                    flagAssignment+                    deterministic ipid_flag cid_flag pkg_descr+                    conf_pkg_map (map fst graph0)+    infoProgress $ hang (text "Configured component graph:") 4+                        (vcat (map dispConfiguredComponent graph1))++    let shape_pkg_map = Map.fromList+            [ (pc_cid pkg, (pc_open_uid pkg, pc_shape pkg))+            | pkg <- prePkgDeps]+        uid_lookup def_uid+            | Just pkg <- PackageIndex.lookupUnitId installedPackageSet uid+            = FullUnitId (Installed.installedComponentId pkg)+                 (Map.fromList (Installed.instantiatedWith pkg))+            | otherwise = error ("uid_lookup: " ++ display uid)+          where uid = unDefUnitId def_uid+    graph2 <- toLinkedComponents verbosity uid_lookup+                    (package pkg_descr) shape_pkg_map graph1++    infoProgress $+        hang (text "Linked component graph:") 4+             (vcat (map dispLinkedComponent graph2))++    let pid_map = Map.fromList $+            [ (pc_uid pkg, pc_munged_id pkg)+            | pkg <- prePkgDeps] +++            [ (Installed.installedUnitId pkg, mungedId pkg)+            | (_, Module uid _) <- instantiate_with+            , Just pkg <- [PackageIndex.lookupUnitId+                                installedPackageSet (unDefUnitId uid)] ]+        subst = Map.fromList instantiate_with+        graph3 = toReadyComponents pid_map subst graph2+        graph4 = Graph.revTopSort (Graph.fromDistinctList graph3)++    infoProgress $ hang (text "Ready component graph:") 4+                        (vcat (map dispReadyComponent graph4))++    toComponentLocalBuildInfos comp installedPackageSet pkg_descr prePkgDeps graph4++------------------------------------------------------------------------------+-- ComponentLocalBuildInfo+------------------------------------------------------------------------------++toComponentLocalBuildInfos+    :: Compiler+    -> InstalledPackageIndex -- FULL set+    -> PackageDescription+    -> [PreExistingComponent] -- external package deps+    -> [ReadyComponent]+    -> LogProgress ([ComponentLocalBuildInfo],+                    InstalledPackageIndex) -- only relevant packages+toComponentLocalBuildInfos+    comp installedPackageSet pkg_descr externalPkgDeps graph = do+    -- Check and make sure that every instantiated component exists.+    -- We have to do this now, because prior to linking/instantiating+    -- we don't actually know what the full set of 'UnitId's we need+    -- are.+    let -- TODO: This is actually a bit questionable performance-wise,+        -- since we will pay for the ALL installed packages even if+        -- they are not related to what we are building.  This was true+        -- in the old configure code.+        external_graph :: Graph (Either InstalledPackageInfo ReadyComponent)+        external_graph = Graph.fromDistinctList+                       . map Left+                       $ PackageIndex.allPackages installedPackageSet+        internal_graph :: Graph (Either InstalledPackageInfo ReadyComponent)+        internal_graph = Graph.fromDistinctList+                       . map Right+                       $ graph+        combined_graph = Graph.unionRight external_graph internal_graph+        Just local_graph = Graph.closure combined_graph (map nodeKey graph)+        -- 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'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 = PackageIndex.fromList (lefts local_graph)+        fullIndex = Graph.fromDistinctList local_graph+    case Graph.broken fullIndex of+        [] -> return ()+        broken ->+          -- TODO: ppr this+          dieProgress . text $+                "The following packages are broken because other"+             ++ " packages they depend on are missing. These broken "+             ++ "packages must be rebuilt before they can be used.\n"+             -- TODO: Undupe.+             ++ unlines [ "installed package "+                       ++ display (packageId pkg)+                       ++ " is broken due to missing package "+                       ++ intercalate ", " (map display deps)+                        | (Left pkg, deps) <- broken ]+             ++ unlines [ "planned package "+                       ++ display (packageId pkg)+                       ++ " is broken due to missing package "+                       ++ intercalate ", " (map display deps)+                        | (Right 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+    --+    -- TODO: This is probably wrong for Backpack+    let pseudoTopPkg :: InstalledPackageInfo+        pseudoTopPkg = emptyInstalledPackageInfo {+            Installed.installedUnitId = mkLegacyUnitId (packageId pkg_descr),+            Installed.sourcePackageId = packageId pkg_descr,+            Installed.depends = map pc_uid externalPkgDeps+          }+    case PackageIndex.dependencyInconsistencies+       . PackageIndex.insert pseudoTopPkg+       $ packageDependsIndex of+      [] -> return ()+      inconsistencies ->+        warnProgress $+          hang (text "This package indirectly depends on multiple versions of the same" <+>+                text "package. This is very likely to cause a compile failure.") 2+               (vcat [ text "package" <+> disp (packageName user) <+>+                       parens (disp (installedUnitId user)) <+> text "requires" <+>+                       disp inst+                     | (_dep_key, insts) <- inconsistencies+                     , (inst, users) <- insts+                     , user <- users ])+    let clbis = mkLinkedComponentsLocalBuildInfo comp graph+    -- forM clbis $ \(clbi,deps) -> info verbosity $ "UNIT" ++ hashUnitId (componentUnitId clbi) ++ "\n" ++ intercalate "\n" (map hashUnitId deps)+    return (clbis, packageDependsIndex)++-- Build ComponentLocalBuildInfo for each component we are going+-- to build.+--+-- This conversion is lossy; we lose some invariants from ReadyComponent+mkLinkedComponentsLocalBuildInfo+    :: Compiler+    -> [ReadyComponent]+    -> [ComponentLocalBuildInfo]+mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs+  where+    internalUnits = Set.fromList (map rc_uid rcs)+    isInternal x = Set.member x internalUnits+    go rc =+      case rc_component rc of+      CLib lib ->+        let convModuleExport (modname', (Module uid modname))+              | this_uid == unDefUnitId uid+              , modname' == modname+              = Installed.ExposedModule modname' Nothing+              | otherwise+              = Installed.ExposedModule modname'+                  (Just (OpenModule (DefiniteUnitId uid) modname))+            convOpenModuleExport (modname', modu@(OpenModule uid modname))+              | uid == this_open_uid+              , modname' == modname+              = Installed.ExposedModule modname' Nothing+              | otherwise+              = Installed.ExposedModule modname' (Just modu)+            convOpenModuleExport (_, OpenModuleVar _)+                = error "convOpenModuleExport: top-level modvar"+            exports =+                -- Loses invariants+                case rc_i rc of+                    Left indefc -> map convOpenModuleExport+                                 $ Map.toList (indefc_provides indefc)+                    Right instc -> map convModuleExport+                                 $ Map.toList (instc_provides instc)+            insts =+                case rc_i rc of+                    Left indefc -> [ (m, OpenModuleVar m) | m <- indefc_requires indefc ]+                    Right instc -> [ (m, OpenModule (DefiniteUnitId uid') m')+                                   | (m, Module uid' m') <- instc_insts instc ]++            compat_name = computeCompatPackageName (packageName rc) (libName lib)+            compat_key = computeCompatPackageKey comp compat_name (packageVersion rc) this_uid++        in LibComponentLocalBuildInfo {+          componentPackageDeps = cpds,+          componentUnitId = this_uid,+          componentComponentId = this_cid,+          componentInstantiatedWith = insts,+          componentIsIndefinite_ = is_indefinite,+          componentLocalName = cname,+          componentInternalDeps = internal_deps,+          componentExeDeps = exe_deps,+          componentIncludes = includes,+          componentExposedModules = exports,+          componentIsPublic = rc_public rc,+          componentCompatPackageKey = compat_key,+          componentCompatPackageName = compat_name+        }+      CFLib _ ->+        FLibComponentLocalBuildInfo {+          componentUnitId = this_uid,+          componentComponentId = this_cid,+          componentLocalName = cname,+          componentPackageDeps = cpds,+          componentExeDeps = exe_deps,+          componentInternalDeps = internal_deps,+          componentIncludes = includes+        }+      CExe _ ->+        ExeComponentLocalBuildInfo {+          componentUnitId = this_uid,+          componentComponentId = this_cid,+          componentLocalName = cname,+          componentPackageDeps = cpds,+          componentExeDeps = exe_deps,+          componentInternalDeps = internal_deps,+          componentIncludes = includes+        }+      CTest _ ->+        TestComponentLocalBuildInfo {+          componentUnitId = this_uid,+          componentComponentId = this_cid,+          componentLocalName = cname,+          componentPackageDeps = cpds,+          componentExeDeps = exe_deps,+          componentInternalDeps = internal_deps,+          componentIncludes = includes+        }+      CBench _ ->+        BenchComponentLocalBuildInfo {+          componentUnitId = this_uid,+          componentComponentId = this_cid,+          componentLocalName = cname,+          componentPackageDeps = cpds,+          componentExeDeps = exe_deps,+          componentInternalDeps = internal_deps,+          componentIncludes = includes+        }+     where+      this_uid      = rc_uid rc+      this_open_uid = rc_open_uid rc+      this_cid      = rc_cid rc+      cname = componentName (rc_component rc)+      cpds = rc_depends rc+      exe_deps = map ann_id $ rc_exe_deps rc+      is_indefinite =+        case rc_i rc of+            Left _ -> True+            Right _ -> False+      includes =+        map (\ci -> (ci_id ci, ci_renaming ci)) $+            case rc_i rc of+                Left indefc ->+                    indefc_includes indefc+                Right instc ->+                    map (\ci -> ci { ci_ann_id = fmap DefiniteUnitId (ci_ann_id ci) })+                        (instc_includes instc)+      internal_deps = filter isInternal (nodeNeighbors rc)

@@ -0,0 +1,292 @@+{-# LANGUAGE PatternGuards #-}+-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+module Distribution.Backpack.ConfiguredComponent (+    ConfiguredComponent(..),+    cc_name,+    cc_cid,+    cc_pkgid,+    toConfiguredComponent,+    toConfiguredComponents,+    dispConfiguredComponent,++    ConfiguredComponentMap,+    extendConfiguredComponentMap,++    -- TODO: Should go somewhere else+    newPackageDepsBehaviour+) where++import Prelude ()+import Distribution.Compat.Prelude hiding ((<>))++import Distribution.Backpack.Id++import Distribution.Types.AnnotatedId+import Distribution.Types.Dependency+import Distribution.Types.ExeDependency+import Distribution.Types.IncludeRenaming+import Distribution.Types.ComponentId+import Distribution.Types.PackageId+import Distribution.Types.PackageName+import Distribution.Types.Mixin+import Distribution.Types.ComponentName+import Distribution.Types.UnqualComponentName+import Distribution.Types.ComponentInclude+import Distribution.Package+import Distribution.PackageDescription as PD hiding (Flag)+import Distribution.Simple.BuildToolDepends+import Distribution.Simple.Setup as Setup+import Distribution.Simple.LocalBuildInfo+import Distribution.Version+import Distribution.Utils.LogProgress+import Distribution.Utils.MapAccum++import Control.Monad+import qualified Data.Set as Set+import qualified Data.Map as Map+import Distribution.Text+import Text.PrettyPrint++-- | A configured component, we know exactly what its 'ComponentId' is,+-- and the 'ComponentId's of the things it depends on.+data ConfiguredComponent+    = ConfiguredComponent {+        -- | Unique identifier of component, plus extra useful info.+        cc_ann_id :: AnnotatedId ComponentId,+        -- | The fragment of syntax from the Cabal file describing this+        -- component.+        cc_component :: Component,+        -- | Is this the public library component of the package?+        -- (If we invoke Setup with an instantiation, this is the+        -- component the instantiation applies to.)+        -- Note that in one-component configure mode, this is+        -- always True, because any component is the "public" one.)+        cc_public :: Bool,+        -- | Dependencies on executables from @build-tools@ and+        -- @build-tool-depends@.+        cc_exe_deps :: [AnnotatedId ComponentId],+        -- | The mixins of this package, including both explicit (from+        -- the @mixins@ field) and implicit (from @build-depends@).  Not+        -- mix-in linked yet; component configuration only looks at+        -- 'ComponentId's.+        cc_includes :: [ComponentInclude ComponentId IncludeRenaming]+      }+++-- | Uniquely identifies a configured component.+cc_cid :: ConfiguredComponent -> ComponentId+cc_cid = ann_id . cc_ann_id++-- | The package this component came from.+cc_pkgid :: ConfiguredComponent -> PackageId+cc_pkgid = ann_pid . cc_ann_id++-- | The 'ComponentName' of a component; this uniquely identifies+-- a fragment of syntax within a specified Cabal file describing the+-- component.+cc_name :: ConfiguredComponent -> ComponentName+cc_name = ann_cname . cc_ann_id++-- | Pretty-print a 'ConfiguredComponent'.+dispConfiguredComponent :: ConfiguredComponent -> Doc+dispConfiguredComponent cc =+    hang (text "component" <+> disp (cc_cid cc)) 4+         (vcat [ hsep $ [ text "include", disp (ci_id incl), disp (ci_renaming incl) ]+               | incl <- cc_includes cc+               ])++-- | Construct a 'ConfiguredComponent', given that the 'ComponentId'+-- and library/executable dependencies are known.  The primary+-- work this does is handling implicit @backpack-include@ fields.+mkConfiguredComponent+    :: PackageDescription+    -> ComponentId+    -> [AnnotatedId ComponentId] -- lib deps+    -> [AnnotatedId ComponentId] -- exe deps+    -> Component+    -> LogProgress ConfiguredComponent+mkConfiguredComponent pkg_descr this_cid lib_deps exe_deps component = do+    -- Resolve each @mixins@ into the actual dependency+    -- from @lib_deps@.+    explicit_includes <- forM (mixins bi) $ \(Mixin name rns) -> do+        let keys = fixFakePkgName pkg_descr name+        aid <- case Map.lookup keys deps_map of+                Nothing ->+                    dieProgress $+                        text "Mix-in refers to non-existent package" <+>+                        quotes (disp name) $$+                        text "(did you forget to add the package to build-depends?)"+                Just r  -> return r+        return ComponentInclude {+                ci_ann_id   = aid,+                ci_renaming = rns,+                ci_implicit = False+            }++        -- Any @build-depends@ which is not explicitly mentioned in+        -- @backpack-include@ is converted into an "implicit" include.+    let used_explicitly = Set.fromList (map ci_id explicit_includes)+        implicit_includes+            = map (\aid -> ComponentInclude {+                                ci_ann_id = aid,+                                ci_renaming = defaultIncludeRenaming,+                                ci_implicit = True+                            })+            $ filter (flip Set.notMember used_explicitly . ann_id) lib_deps++    return ConfiguredComponent {+            cc_ann_id = AnnotatedId {+                    ann_id = this_cid,+                    ann_pid = package pkg_descr,+                    ann_cname = componentName component+                },+            cc_component = component,+            cc_public = is_public,+            cc_exe_deps = exe_deps,+            cc_includes = explicit_includes ++ implicit_includes+        }+  where+    bi = componentBuildInfo component+    deps_map = Map.fromList [ ((packageName dep, ann_cname dep), dep)+                            | dep <- lib_deps ]+    is_public = componentName component == CLibName++type ConfiguredComponentMap =+        Map PackageName (Map ComponentName (AnnotatedId ComponentId))++toConfiguredComponent+    :: PackageDescription+    -> ComponentId+    -> ConfiguredComponentMap+    -> Component+    -> LogProgress ConfiguredComponent+toConfiguredComponent pkg_descr this_cid dep_map component = do+    lib_deps <-+        if newPackageDepsBehaviour pkg_descr+            then forM (targetBuildDepends bi) $ \(Dependency name _) -> do+                    let (pn, cn) = fixFakePkgName pkg_descr name+                    value <- case Map.lookup cn =<< Map.lookup pn dep_map of+                        Nothing ->+                            dieProgress $+                                text "Dependency on unbuildable" <+>+                                text (showComponentName cn) <+>+                                text "from" <+> disp pn+                        Just v -> return v+                    return value+            else return old_style_lib_deps+    mkConfiguredComponent+       pkg_descr this_cid+       lib_deps exe_deps component+  where+    bi = componentBuildInfo component+    -- dep_map contains a mix of internal and external deps.+    -- We want all the public libraries (dep_cn == CLibName)+    -- of all external deps (dep /= pn).  Note that this+    -- excludes the public library of the current package:+    -- this is not supported by old-style deps behavior+    -- because it would imply a cyclic dependency for the+    -- library itself.+    old_style_lib_deps = [ e+                         | (pn, comp_map) <- Map.toList dep_map+                         , pn /= packageName pkg_descr+                         , (cn, e) <- Map.toList comp_map+                         , cn == CLibName ]+    exe_deps =+        [ exe+        | ExeDependency pn cn _ <- getAllToolDependencies pkg_descr bi+        -- The error suppression here is important, because in general+        -- we won't know about external dependencies (e.g., 'happy')+        -- which the package is attempting to use (those deps are only+        -- fed in when cabal-install uses this codepath.)+        -- TODO: Let cabal-install request errors here+        , Just exe <- [Map.lookup (CExeName cn) =<< Map.lookup pn dep_map]+        ]++-- | Also computes the 'ComponentId', and sets cc_public if necessary.+-- This is Cabal-only; cabal-install won't use this.+toConfiguredComponent'+    :: Bool -- use_external_internal_deps+    -> FlagAssignment+    -> PackageDescription+    -> Bool -- deterministic+    -> Flag String      -- configIPID (todo: remove me)+    -> Flag ComponentId -- configCID+    -> ConfiguredComponentMap+    -> Component+    -> LogProgress ConfiguredComponent+toConfiguredComponent' use_external_internal_deps flags+                pkg_descr deterministic ipid_flag cid_flag+                dep_map component = do+    cc <- toConfiguredComponent+                pkg_descr this_cid+                dep_map component+    return $ if use_external_internal_deps+                then cc { cc_public = True }+                else cc+  where+    -- TODO: pass component names to it too!+    this_cid = computeComponentId deterministic ipid_flag cid_flag (package pkg_descr)+                (componentName component) (Just (deps, flags))+    deps = [ ann_id aid | m <- Map.elems dep_map+                        , aid <- Map.elems m ]++extendConfiguredComponentMap+    :: ConfiguredComponent+    -> ConfiguredComponentMap+    -> ConfiguredComponentMap+extendConfiguredComponentMap cc =+    Map.insertWith Map.union+        (pkgName (cc_pkgid cc))+        (Map.singleton (cc_name cc) (cc_ann_id cc))++-- Compute the 'ComponentId's for a graph of 'Component's.  The+-- list of internal components must be topologically sorted+-- based on internal package dependencies, so that any internal+-- dependency points to an entry earlier in the list.+toConfiguredComponents+    :: Bool -- use_external_internal_deps+    -> FlagAssignment+    -> Bool -- deterministic+    -> Flag String -- configIPID+    -> Flag ComponentId -- configCID+    -> PackageDescription+    -> ConfiguredComponentMap+    -> [Component]+    -> LogProgress [ConfiguredComponent]+toConfiguredComponents+    use_external_internal_deps flags deterministic ipid_flag cid_flag pkg_descr+    dep_map comps+    = fmap snd (mapAccumM go dep_map comps)+  where+    go m component = do+        cc <- toConfiguredComponent'+                        use_external_internal_deps flags pkg_descr+                        deterministic ipid_flag cid_flag+                        m component+        return (extendConfiguredComponentMap cc m, cc)++newPackageDepsBehaviourMinVersion :: Version+newPackageDepsBehaviourMinVersion = mkVersion [1,7,1]+++-- In older cabal versions, there was only one set of package dependencies for+-- the whole package. In this version, we can have separate dependencies per+-- target, but we only enable this behaviour if the minimum cabal version+-- specified is >= a certain minimum. Otherwise, for compatibility we use the+-- old behaviour.+newPackageDepsBehaviour :: PackageDescription -> Bool+newPackageDepsBehaviour pkg =+   specVersion pkg >= newPackageDepsBehaviourMinVersion++-- | 'build-depends:' stanzas are currently ambiguous as the external packages+-- and internal libraries are specified the same. For now, we assume internal+-- libraries shadow, and this function disambiguates accordingly, but soon the+-- underlying ambiguity will be addressed.+fixFakePkgName :: PackageDescription -> PackageName -> (PackageName, ComponentName)+fixFakePkgName pkg_descr pn =+  if subLibName `elem` internalLibraries+  then (packageName pkg_descr, CSubLibName subLibName)+  else (pn,                    CLibName)+  where+    subLibName = packageNameToUnqualComponentName pn+    internalLibraries = mapMaybe libName (allLibraries pkg_descr)

@@ -0,0 +1,61 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-}+module Distribution.Backpack.DescribeUnitId where++import Prelude ()+import Distribution.Compat.Prelude++import Distribution.Types.PackageId+import Distribution.Types.ComponentName+import Distribution.Compat.Stack+import Distribution.Verbosity+import Distribution.ModuleName+import Distribution.Text+import Distribution.Simple.Utils++import Text.PrettyPrint++-- Unit identifiers have a well defined, machine-readable format,+-- but this format isn't very user-friendly for users.  This+-- module defines some functions for solving common rendering+-- problems one has for displaying these.+--+-- There are three basic problems we tackle:+--+--  - Users don't want to see pkg-0.5-inplace-libname,+--    they want to see "library 'libname' from 'pkg-0.5'"+--+--  - Users don't want to see the raw component identifier, which+--    usually contains a wordy hash that doesn't matter.+--+--  - Users don't want to see a hash of the instantiation: they+--    want to see the actual instantiation, and they want it in+--    interpretable form.+--++-- | Print a Setup message stating (1) what operation we are doing,+-- for (2) which component (with enough details to uniquely identify+-- the build in question.)+--+setupMessage' :: Text a => Verbosity+             -> String            -- ^ Operation being done (capitalized), on:+             -> PackageIdentifier -- ^ Package+             -> ComponentName     -- ^ Component name+             -> Maybe [(ModuleName, a)] -- ^ Instantiation, if available.+                                        -- Polymorphic to take+                                        -- 'OpenModule' or 'Module'+             -> IO ()+setupMessage' verbosity msg pkgid cname mb_insts = withFrozenCallStack $ do+    noticeDoc verbosity $+      case mb_insts of+        Just insts | not (null insts) ->+          hang (msg_doc <+> text "instantiated with") 2+               (vcat [ disp k <+> text "=" <+> disp v+                     | (k,v) <- insts ]) $$+          for_doc+        _ ->+          msg_doc <+> for_doc++  where+    msg_doc = text msg <+> text (showComponentName cname)+    for_doc = text "for" <+> disp pkgid <<>> text ".."

@@ -0,0 +1,26 @@+{-# LANGUAGE DeriveGeneric #-}+module Distribution.Backpack.FullUnitId (+    FullUnitId(..),+    FullDb,+    expandOpenUnitId,+    expandUnitId+) where++import Distribution.Backpack+import Distribution.Types.ComponentId+import Distribution.Compat.Prelude++-- Unlike OpenUnitId, which could direct to a UnitId.+data FullUnitId = FullUnitId ComponentId OpenModuleSubst+    deriving (Show, Generic)++type FullDb = DefUnitId -> FullUnitId++expandOpenUnitId :: FullDb -> OpenUnitId -> FullUnitId+expandOpenUnitId _db (IndefFullUnitId cid subst)+    = FullUnitId cid subst+expandOpenUnitId db (DefiniteUnitId uid)+    = expandUnitId db uid++expandUnitId :: FullDb -> DefUnitId -> FullUnitId+expandUnitId db uid = db uid

@@ -0,0 +1,146 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE PatternGuards #-}+-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+module Distribution.Backpack.Id(+    computeComponentId,+    computeCompatPackageKey,+    computeCompatPackageName,+) where++import Prelude ()+import Distribution.Compat.Prelude++import Distribution.Types.UnqualComponentName+import Distribution.Simple.Compiler hiding (Flag)+import Distribution.PackageDescription as PD hiding (Flag)+import Distribution.Simple.Setup as Setup+import qualified Distribution.Simple.InstallDirs as InstallDirs+import Distribution.Simple.LocalBuildInfo+import Distribution.Types.ComponentId+import Distribution.Types.PackageId+import Distribution.Types.UnitId+import Distribution.Types.MungedPackageName+import Distribution.Utils.Base62+import Distribution.Version++import Distribution.Text+    ( display, simpleParse )++-- | 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+    :: Bool -- deterministic mode+    -> Flag String+    -> Flag ComponentId+    -> PackageIdentifier+    -> ComponentName+    -- This is used by cabal-install's legacy codepath+    -> Maybe ([ComponentId], FlagAssignment)+    -> ComponentId+computeComponentId deterministic mb_ipid mb_cid pid cname mb_details =+    -- 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_suffix+            | Just (dep_ipids, flags) <- mb_details+            = "-" ++ 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 flags     )+            | otherwise = ""+        generated_base = display pid ++ hash_suffix+        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_ipid of+                        Flag ipid0 -> explicit_base ipid0+                        NoFlag | deterministic -> display pid+                               | otherwise     -> generated_base+    in case mb_cid of+          Flag cid -> cid+          NoFlag -> mkComponentId $ actual_base+                        ++ (case componentNameString cname of+                                Nothing -> ""+                                Just s -> "-" ++ unUnqualComponentName s)++-- | 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+    -> MungedPackageName+    -> Version+    -> UnitId+    -> String+computeCompatPackageKey comp pkg_name pkg_version uid+    | not (packageKeySupported comp) =+        display pkg_name ++ "-" ++ display pkg_version+    | not (unifiedIPIDRequired comp) =+        let str = unUnitId uid -- assume no Backpack support+            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 = display uid

@@ -0,0 +1,393 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+module Distribution.Backpack.LinkedComponent (+    LinkedComponent(..),+    lc_insts,+    lc_uid,+    lc_cid,+    lc_pkgid,+    toLinkedComponent,+    toLinkedComponents,+    dispLinkedComponent,+    LinkedComponentMap,+    extendLinkedComponentMap,+) where++import Prelude ()+import Distribution.Compat.Prelude hiding ((<>))++import Distribution.Backpack+import Distribution.Backpack.FullUnitId+import Distribution.Backpack.ConfiguredComponent+import Distribution.Backpack.ModuleShape+import Distribution.Backpack.ModuleScope+import Distribution.Backpack.UnifyM+import Distribution.Backpack.MixLink+import Distribution.Utils.MapAccum++import Distribution.Types.AnnotatedId+import Distribution.Types.ComponentName+import Distribution.Types.ModuleRenaming+import Distribution.Types.IncludeRenaming+import Distribution.Types.ComponentInclude+import Distribution.Types.ComponentId+import Distribution.Types.PackageId+import Distribution.Package+import Distribution.PackageDescription as PD hiding (Flag)+import Distribution.ModuleName+import Distribution.Simple.LocalBuildInfo+import Distribution.Verbosity+import Distribution.Utils.LogProgress++import qualified Data.Set as Set+import qualified Data.Map as Map+import Data.Traversable+    ( mapM )+import Distribution.Text+    ( Text(disp) )+import Text.PrettyPrint+import Data.Either++-- | A linked component is a component that has been mix-in linked, at+-- which point we have determined how all the dependencies of the+-- component are explicitly instantiated (in the form of an OpenUnitId).+-- 'ConfiguredComponent' is mix-in linked into 'LinkedComponent', which+-- is then instantiated into 'ReadyComponent'.+data LinkedComponent+    = LinkedComponent {+        -- | Uniquely identifies linked component+        lc_ann_id :: AnnotatedId ComponentId,+        -- | Corresponds to 'cc_component'.+        lc_component :: Component,+        -- | @build-tools@ and @build-tool-depends@ dependencies.+        -- Corresponds to 'cc_exe_deps'.+        lc_exe_deps :: [AnnotatedId OpenUnitId],+        -- | Is this the public library of a package?  Corresponds to+        -- 'cc_public'.+        lc_public :: Bool,+        -- | Corresponds to 'cc_includes', but (1) this does not contain+        -- includes of signature packages (packages with no exports),+        -- and (2) the 'ModuleRenaming' for requirements (stored in+        -- 'IncludeRenaming') has been removed, as it is reflected in+        -- 'OpenUnitId'.)+        lc_includes :: [ComponentInclude OpenUnitId ModuleRenaming],+        -- | Like 'lc_includes', but this specifies includes on+        -- signature packages which have no exports.+        lc_sig_includes :: [ComponentInclude OpenUnitId ModuleRenaming],+        -- | The module shape computed by mix-in linking.  This is+        -- newly computed from 'ConfiguredComponent'+        lc_shape :: ModuleShape+      }++-- | Uniquely identifies a 'LinkedComponent'.  Corresponds to+-- 'cc_cid'.+lc_cid :: LinkedComponent -> ComponentId+lc_cid = ann_id . lc_ann_id++-- | Corresponds to 'cc_pkgid'.+lc_pkgid :: LinkedComponent -> PackageId+lc_pkgid = ann_pid . lc_ann_id++-- | The 'OpenUnitId' of this component in the "default" instantiation.+-- See also 'lc_insts'.  'LinkedComponent's cannot be instantiated+-- (e.g., there is no 'ModSubst' instance for them).+lc_uid :: LinkedComponent -> OpenUnitId+lc_uid lc = IndefFullUnitId (lc_cid lc) . Map.fromList $ lc_insts lc++-- | The instantiation of 'lc_uid'; this always has the invariant+-- that it is a mapping from a module name @A@ to @<A>@ (the hole A).+lc_insts :: LinkedComponent -> [(ModuleName, OpenModule)]+lc_insts lc = [ (req, OpenModuleVar req)+              | req <- Set.toList (modShapeRequires (lc_shape lc)) ]++dispLinkedComponent :: LinkedComponent -> Doc+dispLinkedComponent lc =+    hang (text "unit" <+> disp (lc_uid lc)) 4 $+         vcat [ text "include" <+> disp (ci_id incl) <+> disp (ci_renaming incl)+              | incl <- lc_includes lc ]+            $+$+         vcat [ text "signature include" <+> disp (ci_id incl)+              | incl <- lc_sig_includes lc ]+            $+$ dispOpenModuleSubst (modShapeProvides (lc_shape lc))++instance Package LinkedComponent where+    packageId = lc_pkgid++toLinkedComponent+    :: Verbosity+    -> FullDb+    -> PackageId+    -> LinkedComponentMap+    -> ConfiguredComponent+    -> LogProgress LinkedComponent+toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {+    cc_ann_id = aid@AnnotatedId { ann_id = this_cid, ann_cname = compname },+    cc_component = component,+    cc_exe_deps = exe_deps,+    cc_public = is_public,+    cc_includes = cid_includes+   } = do+    let+        -- The explicitly specified requirements, provisions and+        -- reexports from the Cabal file.  These are only non-empty for+        -- libraries; everything else is trivial.+        (src_reqs      :: [ModuleName],+         src_provs     :: [ModuleName],+         src_reexports :: [ModuleReexport]) =+            case component of+                CLib lib -> (signatures lib,+                             exposedModules lib,+                             reexportedModules lib)+                _ -> ([], [], [])++        -- Take each included ComponentId and resolve it into an+        -- *unlinked* unit identity.  We will use unification (relying+        -- on the ModuleShape) to resolve these into linked identities.+        unlinked_includes :: [ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming]+        unlinked_includes = [ ComponentInclude (fmap lookupUid dep_aid) rns i+                            | ComponentInclude dep_aid rns i <- cid_includes ]++        lookupUid :: ComponentId -> (OpenUnitId, ModuleShape)+        lookupUid cid = fromMaybe (error "linkComponent: lookupUid")+                                    (Map.lookup cid pkg_map)++    let orErr (Right x) = return x+        orErr (Left [err]) = dieProgress err+        orErr (Left errs) = do+            dieProgress (vcat (intersperse (text "") -- double newline!+                                [ hang (text "-") 2 err | err <- errs]))++    -- OK, actually do unification+    -- TODO: the unification monad might return errors, in which+    -- case we have to deal.  Use monadic bind for now.+    (linked_shape0   :: ModuleScope,+     linked_includes0 :: [ComponentInclude OpenUnitId ModuleRenaming],+     linked_sig_includes0 :: [ComponentInclude OpenUnitId ModuleRenaming])+      <- orErr $ runUnifyM verbosity db $ do+        -- The unification monad is implemented using mutable+        -- references.  Thus, we must convert our *pure* data+        -- structures into mutable ones to perform unification.+        --+        {-+        let convertReq :: ModuleName -> UnifyM s (ModuleScopeU s)+            convertReq req = do+                req_u <- convertModule (OpenModuleVar req)+                return (Map.empty, Map.singleton req req_u)+            -- NB: We DON'T convert locally defined modules, as in the+            -- absence of mutual recursion across packages they+            -- cannot participate in mix-in linking.+        -}+        (shapes_u, all_includes_u) <- fmap unzip (mapM convertInclude unlinked_includes)+        failIfErrs -- Prevent error cascade+        -- Mix-in link everything!  mixLink is the real workhorse.+        shape_u <- mixLink shapes_u+        -- shape_u <- foldM mixLink emptyModuleScopeU (shapes_u ++ src_reqs_u)+        -- src_reqs_u <- mapM convertReq src_reqs+        -- Read out all the final results by converting back+        -- into a pure representation.+        let convertIncludeU (ComponentInclude dep_aid rns i) = do+                uid <- convertUnitIdU (ann_id dep_aid)+                return (ComponentInclude {+                            ci_ann_id = dep_aid { ann_id = uid },+                            ci_renaming = rns,+                            ci_implicit = i+                        })+        shape <- convertModuleScopeU shape_u+        let (includes_u, sig_includes_u) = partitionEithers all_includes_u+        incls <- mapM convertIncludeU includes_u+        sig_incls <- mapM convertIncludeU sig_includes_u+        return (shape, incls, sig_incls)++    -- linked_shape0 is almost complete, but it doesn't contain+    -- the actual modules we export ourselves.  Add them!+    let reqs = Map.keysSet (modScopeRequires linked_shape0)+                `Set.union` Set.fromList src_reqs+        -- TODO: check that there aren't pre-filled requirements...+        insts = [ (req, OpenModuleVar req)+                | req <- Set.toList reqs ]+        this_uid = IndefFullUnitId this_cid . Map.fromList $ insts++        -- add the local exports to the scope+        local_source m = [ModuleSource (packageName this_pid)+                                       compname+                                       defaultIncludeRenaming m True]+        local_exports = Map.fromListWith (++) $+          [ (mod_name, local_source (OpenModule this_uid mod_name)) | mod_name <- src_provs ]+        local_reqs = Map.fromListWith (++) $+          [ (mod_name, local_source (OpenModuleVar mod_name)) | mod_name <- src_reqs ]+          -- NB: do NOT include hidden modules here: GHC 7.10's ghc-pkg+          -- won't allow it (since someone could directly synthesize+          -- an 'InstalledPackageInfo' that violates abstraction.)+          -- Though, maybe it should be relaxed?+        linked_shape = linked_shape0 {+                          modScopeProvides =+                            Map.unionWith (++)+                              local_exports+                              (modScopeProvides linked_shape0),+                          -- TODO: test that requirements aren't already+                          -- in scope+                          modScopeRequires =+                            Map.unionWith (++)+                              local_reqs+                              (modScopeRequires linked_shape0)+                        }++    let isNotLib (CLib _) = False+        isNotLib _        = True+    when (not (Set.null reqs) && isNotLib component) $+        dieProgress $+            hang (text "Non-library component has unfilled requirements:")+                4 (vcat [disp req | req <- Set.toList reqs])++    -- OK, compute the reexports+    -- TODO: This code reports the errors for reexports one reexport at+    -- a time.  Better to collect them all up and report them all at+    -- once.+    let hdl :: [Either Doc a] -> LogProgress [a]+        hdl es =+            case partitionEithers es of+                ([], rs) -> return rs+                (ls, _) ->+                    dieProgress $+                     hang (text "Problem with module re-exports:") 2+                        (vcat [hang (text "-") 2 l | l <- ls])+    reexports_list <- hdl . (flip map) src_reexports $ \reex@(ModuleReexport mb_pn from to) -> do+      case Map.lookup from (modScopeProvides linked_shape) of+        Just cands@(x0:xs0) -> do+          -- Make sure there is at least one candidate+          (x, xs) <-+            case mb_pn of+              Just pn ->+                case filter ((pn==) . msrc_pkgname) cands of+                  (x1:xs1) -> return (x1, xs1)+                  _ -> Left (brokenReexportMsg reex)+              Nothing -> return (x0, xs0)+          -- Test that all the candidates are consistent+          case filter (\x' -> msrc_module x /= msrc_module x') xs of+            [] -> return ()+            _ -> Left $ ambiguousReexportMsg reex x xs+          return (to, msrc_module x)+        _ ->+          Left (brokenReexportMsg reex)++    -- TODO: maybe check this earlier; it's syntactically obvious.+    let build_reexports m (k, v)+            | Map.member k m =+                dieProgress $ hsep+                    [ text "Module name ", disp k, text " is exported multiple times." ]+            | otherwise = return (Map.insert k v m)+    provs <- foldM build_reexports Map.empty $+                -- TODO: doublecheck we have checked for+                -- src_provs duplicates already!+                [ (mod_name, OpenModule this_uid mod_name) | mod_name <- src_provs ] +++                reexports_list++    let final_linked_shape = ModuleShape provs (Map.keysSet (modScopeRequires linked_shape))++    -- See Note Note [Signature package special case]+    let (linked_includes, linked_sig_includes)+            | Set.null reqs = (linked_includes0 ++ linked_sig_includes0, [])+            | otherwise     = (linked_includes0, linked_sig_includes0)++    return $ LinkedComponent {+                lc_ann_id = aid,+                lc_component = component,+                lc_public = is_public,+                -- These must be executables+                lc_exe_deps = map (fmap (\cid -> IndefFullUnitId cid Map.empty)) exe_deps,+                lc_shape = final_linked_shape,+                lc_includes = linked_includes,+                lc_sig_includes = linked_sig_includes+           }++-- Note [Signature package special case]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Suppose we have p-indef, which depends on str-sig and inherits+-- the hole from that signature package.  When we instantiate p-indef,+-- it's a bit pointless to also go ahead and build str-sig, because+-- str-sig cannot possibly have contributed any code to the package+-- in question.  Furthermore, because the signature was inherited to+-- p-indef, if we test matching against p-indef, we also have tested+-- matching against p-sig.  In fact, skipping p-sig is *mandatory*,+-- because p-indef may have thinned it (so that an implementation may+-- match p-indef but not p-sig.)+--+-- However, suppose that we have a package which mixes together str-sig+-- and str-bytestring, with the intent of *checking* that str-sig is+-- implemented by str-bytestring.  Here, it's quite important to+-- build an instantiated str-sig, since that is the only way we will+-- actually end up testing if the matching works.  Note that this+-- admonition only applies if the package has NO requirements; if it+-- has any requirements, we will typecheck it as an indefinite+-- package, at which point the signature includes will be passed to+-- GHC who will in turn actually do the checking to make sure they+-- are instantiated correctly.++-- Handle mix-in linking for components.  In the absence of Backpack,+-- every ComponentId gets converted into a UnitId by way of SimpleUnitId.+toLinkedComponents+    :: Verbosity+    -> FullDb+    -> PackageId+    -> LinkedComponentMap+    -> [ConfiguredComponent]+    -> LogProgress [LinkedComponent]+toLinkedComponents verbosity db this_pid lc_map0 comps+   = fmap snd (mapAccumM go lc_map0 comps)+ where+  go :: Map ComponentId (OpenUnitId, ModuleShape)+     -> ConfiguredComponent+     -> LogProgress (Map ComponentId (OpenUnitId, ModuleShape), LinkedComponent)+  go lc_map cc = do+    lc <- addProgressCtx (text "In the stanza" <+> text (componentNameStanza (cc_name cc))) $+            toLinkedComponent verbosity db this_pid lc_map cc+    return (extendLinkedComponentMap lc lc_map, lc)++type LinkedComponentMap = Map ComponentId (OpenUnitId, ModuleShape)++extendLinkedComponentMap :: LinkedComponent+                         -> LinkedComponentMap+                         -> LinkedComponentMap+extendLinkedComponentMap lc m =+    Map.insert (lc_cid lc) (lc_uid lc, lc_shape lc) m++brokenReexportMsg :: ModuleReexport -> Doc+brokenReexportMsg (ModuleReexport (Just pn) from _to) =+  vcat [ text "The package" <+> quotes (disp pn)+       , text "does not export a module" <+> quotes (disp from) ]+brokenReexportMsg (ModuleReexport Nothing from _to) =+  vcat [ text "The module" <+> quotes (disp from)+       , text "is not exported by any suitable package."+       , text "It occurs in neither the 'exposed-modules' of this package,"+       , text "nor any of its 'build-depends' dependencies." ]++ambiguousReexportMsg :: ModuleReexport -> ModuleSource -> [ModuleSource] -> Doc+ambiguousReexportMsg (ModuleReexport mb_pn from _to) y1 ys =+  vcat [ text "Ambiguous reexport" <+> quotes (disp from)+       , hang (text "It could refer to either:") 2+            (vcat (msg : msgs))+       , help_msg mb_pn ]+  where+    msg  = text "  " <+> displaySource y1+    msgs = [text "or" <+> displaySource y | y <- ys]+    help_msg Nothing =+      -- TODO: This advice doesn't help if the ambiguous exports+      -- come from a package named the same thing+      vcat [ text "The ambiguity can be resolved by qualifying the"+           , text "re-export with a package name."+           , text "The syntax is 'packagename:ModuleName [as NewName]'." ]+    -- Qualifying won't help that much.+    help_msg (Just _) =+      vcat [ text "The ambiguity can be resolved by using the"+           , text "mixins field to rename one of the module"+           , text "names differently." ]+    displaySource y+      = vcat [ quotes (disp (msrc_module y))+             , text "brought into scope by" <+>+                if not (isDefaultIncludeRenaming (msrc_renaming y))+                  then text "the mixin" <+>+                       disp (msrc_pkgname y) <+>+                       parens (disp (includeProvidesRn (msrc_renaming y)))+                  else text "the build dependency on" <+> disp (msrc_pkgname y)+             ]

@@ -0,0 +1,192 @@+{-# LANGUAGE NondecreasingIndentation #-}+-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+module Distribution.Backpack.MixLink (+    mixLink,+) where++import Prelude ()+import Distribution.Compat.Prelude hiding (mod)++import Distribution.Backpack+import Distribution.Backpack.UnifyM+import Distribution.Backpack.FullUnitId++import qualified Distribution.Utils.UnionFind as UnionFind+import Distribution.ModuleName+import Distribution.Text+import Distribution.Types.ComponentId+import Distribution.Types.ComponentName++import Text.PrettyPrint+import Control.Monad+import qualified Data.Map as Map+import qualified Data.Foldable as F++-----------------------------------------------------------------------+-- Linking++-- | Given to scopes of provisions and requirements, link them together.+mixLink :: [ModuleScopeU s] -> UnifyM s (ModuleScopeU s)+mixLink scopes = do+    let provs = Map.unionsWith (++) (map fst scopes)+        -- Invariant: any identically named holes refer to same mutable cell+        reqs  = Map.unionsWith (++) (map snd scopes)+        filled = Map.intersectionWithKey linkProvision provs reqs+    F.sequenceA_ filled+    let remaining = Map.difference reqs filled+    return (provs, remaining)++-- TODO: Deduplicate this with Distribution.Backpack.UnifyM.ci_msg+dispSource :: ModuleSourceU s -> Doc+dispSource src+ | usrc_implicit src+ = text "build-depends:" <+> pp_pn+ | otherwise+ = text "mixins:" <+> pp_pn <+> disp (usrc_renaming src)+ where+  pp_pn =+    -- NB: This syntax isn't quite the source syntax, but it+    -- should be clear enough.  To do source syntax, we'd+    -- need to know what the package we're linking is.+    case usrc_compname src of+        CLibName -> disp (usrc_pkgname src)+        CSubLibName cn -> disp (usrc_pkgname src) <<>> colon <<>> disp cn+        -- Shouldn't happen+        cn -> disp (usrc_pkgname src) <+> parens (disp cn)++-- | Link a list of possibly provided modules to a single+-- requirement.  This applies a side-condition that all+-- of the provided modules at the same name are *actually*+-- the same module.+linkProvision :: ModuleName+              -> [ModuleSourceU s] -- provs+              -> [ModuleSourceU s] -- reqs+              -> UnifyM s [ModuleSourceU s]+linkProvision mod_name ret@(prov:provs) (req:reqs) = do+    -- TODO: coalesce all the non-unifying modules together+    forM_ provs $ \prov' -> do+        -- Careful: read it out BEFORE unifying, because the+        -- unification algorithm preemptively unifies modules+        mod  <- convertModuleU (usrc_module prov)+        mod' <- convertModuleU (usrc_module prov')+        r <- unify prov prov'+        case r of+            Just () -> return ()+            Nothing -> do+                addErr $+                  text "Ambiguous module" <+> quotes (disp mod_name) $$+                  text "It could refer to" <+>+                    ( text "  " <+> (quotes (disp mod)  $$ in_scope_by prov) $$+                      text "or" <+> (quotes (disp mod') $$ in_scope_by prov') ) $$+                  link_doc+    mod <- convertModuleU (usrc_module prov)+    req_mod <- convertModuleU (usrc_module req)+    r <- unify prov req+    case r of+        Just () -> return ()+        Nothing -> do+            -- TODO: Record and report WHERE the bad constraint came from+            addErr $ text "Could not instantiate requirement" <+> quotes (disp mod_name) $$+                     nest 4 (text "Expected:" <+> disp mod $$+                             text "Actual:  " <+> disp req_mod) $$+                     parens (text "This can occur if an exposed module of" <+>+                             text "a libraries shares a name with another module.") $$+                     link_doc+    return ret+  where+    unify s1 s2 = tryM $ addErrContext short_link_doc+                       $ unifyModule (usrc_module s1) (usrc_module s2)+    in_scope_by s = text "brought into scope by" <+> dispSource s+    short_link_doc = text "While filling requirement" <+> quotes (disp mod_name)+    link_doc = text "While filling requirements of" <+> reqs_doc+    reqs_doc+      | null reqs = dispSource req+      | otherwise =  (       text "   " <+> dispSource req  $$+                      vcat [ text "and" <+> dispSource r | r <- reqs])+linkProvision _ _ _ = error "linkProvision"++++-----------------------------------------------------------------------+-- The unification algorithm++-- This is based off of https://gist.github.com/amnn/559551517d020dbb6588+-- which is a translation from Huet's thesis.++unifyUnitId :: UnitIdU s -> UnitIdU s -> UnifyM s ()+unifyUnitId uid1_u uid2_u+    | uid1_u == uid2_u = return ()+    | otherwise = do+        xuid1 <- liftST $ UnionFind.find uid1_u+        xuid2 <- liftST $ UnionFind.find uid2_u+        case (xuid1, xuid2) of+            (UnitIdThunkU u1, UnitIdThunkU u2)+                | u1 == u2  -> return ()+                | otherwise ->+                    failWith $ hang (text "Couldn't match unit IDs:") 4+                               (text "   " <+> disp u1 $$+                                text "and" <+> disp u2)+            (UnitIdThunkU uid1, UnitIdU _ cid2 insts2)+                -> unifyThunkWith cid2 insts2 uid2_u uid1 uid1_u+            (UnitIdU _ cid1 insts1, UnitIdThunkU uid2)+                -> unifyThunkWith cid1 insts1 uid1_u uid2 uid2_u+            (UnitIdU _ cid1 insts1, UnitIdU _ cid2 insts2)+                -> unifyInner cid1 insts1 uid1_u cid2 insts2 uid2_u++unifyThunkWith :: ComponentId+               -> Map ModuleName (ModuleU s)+               -> UnitIdU s+               -> DefUnitId+               -> UnitIdU s+               -> UnifyM s ()+unifyThunkWith cid1 insts1 uid1_u uid2 uid2_u = do+    db <- fmap unify_db getUnifEnv+    let FullUnitId cid2 insts2' = expandUnitId db uid2+    insts2 <- convertModuleSubst insts2'+    unifyInner cid1 insts1 uid1_u cid2 insts2 uid2_u++unifyInner :: ComponentId+           -> Map ModuleName (ModuleU s)+           -> UnitIdU s+           -> ComponentId+           -> Map ModuleName (ModuleU s)+           -> UnitIdU s+           -> UnifyM s ()+unifyInner cid1 insts1 uid1_u cid2 insts2 uid2_u = do+    when (cid1 /= cid2) $+        -- TODO: if we had a package identifier, could be an+        -- easier to understand error message.+        failWith $+            hang (text "Couldn't match component IDs:") 4+                 (text "   " <+> disp cid1 $$+                  text "and" <+> disp cid2)+    -- The KEY STEP which makes this a Huet-style unification+    -- algorithm.  (Also a payoff of using union-find.)+    -- We can build infinite unit IDs this way, which is necessary+    -- for support mutual recursion. NB: union keeps the SECOND+    -- descriptor, so we always arrange for a UnitIdThunkU to live+    -- there.+    liftST $ UnionFind.union uid1_u uid2_u+    F.sequenceA_ $ Map.intersectionWith unifyModule insts1 insts2++-- | Imperatively unify two modules.+unifyModule :: ModuleU s -> ModuleU s -> UnifyM s ()+unifyModule mod1_u mod2_u+    | mod1_u == mod2_u = return ()+    | otherwise = do+        mod1 <- liftST $ UnionFind.find mod1_u+        mod2 <- liftST $ UnionFind.find mod2_u+        case (mod1, mod2) of+            (ModuleVarU _, _) -> liftST $ UnionFind.union mod1_u mod2_u+            (_, ModuleVarU _) -> liftST $ UnionFind.union mod2_u mod1_u+            (ModuleU uid1 mod_name1, ModuleU uid2 mod_name2) -> do+                when (mod_name1 /= mod_name2) $+                    failWith $+                        hang (text "Cannot match module names") 4 $+                            text "   " <+> disp mod_name1 $$+                            text "and" <+> disp mod_name2+                -- NB: this is not actually necessary (because we'll+                -- detect loops eventually in 'unifyUnitId'), but it+                -- seems harmless enough+                liftST $ UnionFind.union mod1_u mod2_u+                unifyUnitId uid1 uid2

@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PatternGuards #-}++-- | A type class 'ModSubst' for objects which can have 'ModuleSubst'+-- applied to them.+--+-- See also <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>++module Distribution.Backpack.ModSubst (+    ModSubst(..),+) where++import Prelude ()+import Distribution.Compat.Prelude hiding (mod)++import Distribution.ModuleName++import Distribution.Backpack++import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set++-- | Applying module substitutions to semantic objects.+class ModSubst a where+    -- In notation, substitution is postfix, which implies+    -- putting it on the right hand side, but for partial+    -- application it's more convenient to have it on the left+    -- hand side.+    modSubst :: OpenModuleSubst -> a -> a++instance ModSubst OpenModule where+    modSubst subst (OpenModule cid mod_name) = OpenModule (modSubst subst cid) mod_name+    modSubst subst mod@(OpenModuleVar mod_name)+        | Just mod' <- Map.lookup mod_name subst = mod'+        | otherwise = mod++instance ModSubst OpenUnitId where+    modSubst subst (IndefFullUnitId cid insts) = IndefFullUnitId cid (modSubst subst insts)+    modSubst _subst uid = uid++instance ModSubst (Set ModuleName) where+    modSubst subst reqs+        = Set.union (Set.difference reqs (Map.keysSet subst))+                    (openModuleSubstFreeHoles subst)++-- Substitutions are functorial.  NB: this means that+-- there is an @instance 'ModSubst' 'ModuleSubst'@!+instance ModSubst a => ModSubst (Map k a) where+    modSubst subst = fmap (modSubst subst)+instance ModSubst a => ModSubst [a] where+    modSubst subst = fmap (modSubst subst)+instance ModSubst a => ModSubst (k, a) where+    modSubst subst (x,y) = (x, modSubst subst y)

@@ -0,0 +1,88 @@+-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+module Distribution.Backpack.ModuleScope (+    -- * Module scopes+    ModuleScope(..),+    ModuleProvides,+    ModuleRequires,+    ModuleSource(..),+    emptyModuleScope,+) where++import Prelude ()+import Distribution.Compat.Prelude++import Distribution.ModuleName+import Distribution.Types.IncludeRenaming+import Distribution.Types.PackageName+import Distribution.Types.ComponentName++import Distribution.Backpack+import Distribution.Backpack.ModSubst++import qualified Data.Map as Map+++-----------------------------------------------------------------------+-- Module scopes++-- Why is ModuleProvides so complicated?  The basic problem is that+-- we want to support this:+--+--  package p where+--      include q (A)+--      include r (A)+--      module B where+--          import "q" A+--          import "r" A+--+-- Specifically, in Cabal today it is NOT an error have two modules in+-- scope with the same identifier.  So we need to preserve this for+-- Backpack.  The modification is that an ambiguous module name is+-- OK... as long as it is NOT used to fill a requirement!+--+-- So as a first try, we might try deferring unifying provisions that+-- are being glommed together, and check for equality after the fact.+-- But this doesn't work, because what if a multi-module provision+-- is used to fill a requirement?!  So you do the equality test+-- IMMEDIATELY before a requirement fill happens... or never at all.+--+-- Alternate strategy: go ahead and unify, and then if it is revealed+-- that some requirements got filled "out-of-thin-air", error.+++-- | A 'ModuleScope' describes the modules and requirements that+-- are in-scope as we are processing a Cabal package.  Unlike+-- a 'ModuleShape', there may be multiple modules in scope at+-- the same 'ModuleName'; this is only an error if we attempt+-- to use those modules to fill a requirement.  A 'ModuleScope'+-- can influence the 'ModuleShape' via a reexport.+data ModuleScope = ModuleScope {+    modScopeProvides :: ModuleProvides,+    modScopeRequires :: ModuleRequires+    }++-- | Every 'Module' in scope at a 'ModuleName' is annotated with+-- the 'PackageName' it comes from.+type ModuleProvides = Map ModuleName [ModuleSource]+-- | INVARIANT: entries for ModuleName m, have msrc_module is OpenModuleVar m+type ModuleRequires = Map ModuleName [ModuleSource]+-- TODO: consider newtping the two types above.++data ModuleSource =+    ModuleSource {+        -- We don't have line numbers, but if we did the+        -- package name and renaming could be associated+        -- with that as well+        msrc_pkgname :: PackageName,+        msrc_compname :: ComponentName,+        msrc_renaming :: IncludeRenaming,+        msrc_module :: OpenModule,+        msrc_implicit :: Bool+    }++-- | An empty 'ModuleScope'.+emptyModuleScope :: ModuleScope+emptyModuleScope = ModuleScope Map.empty Map.empty++instance ModSubst ModuleSource where+    modSubst subst src = src { msrc_module = modSubst subst (msrc_module src) }

@@ -0,0 +1,83 @@+{-# LANGUAGE DeriveGeneric #-}+-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+module Distribution.Backpack.ModuleShape (+    -- * Module shapes+    ModuleShape(..),+    emptyModuleShape,+    shapeInstalledPackage,+) where++import Prelude ()+import Distribution.Compat.Prelude hiding (mod)++import Distribution.ModuleName+import Distribution.InstalledPackageInfo as IPI++import Distribution.Backpack.ModSubst+import Distribution.Backpack++import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set++-----------------------------------------------------------------------+-- Module shapes++-- | A 'ModuleShape' describes the provisions and requirements of+-- a library.  We can extract a 'ModuleShape' from an+-- 'InstalledPackageInfo'.+data ModuleShape = ModuleShape {+    modShapeProvides :: OpenModuleSubst,+    modShapeRequires :: Set ModuleName+    }+    deriving (Eq, Show, Generic)++instance Binary ModuleShape++instance ModSubst ModuleShape where+    modSubst subst (ModuleShape provs reqs)+        = ModuleShape (modSubst subst provs) (modSubst subst reqs)++-- | The default module shape, with no provisions and no requirements.+emptyModuleShape :: ModuleShape+emptyModuleShape = ModuleShape Map.empty Set.empty++-- Food for thought: suppose we apply the Merkel tree optimization.+-- Imagine this situation:+--+--      component p+--          signature H+--          module P+--      component h+--          module H+--      component a+--          signature P+--          module A+--      component q(P)+--          include p+--          include h+--      component r+--          include q (P)+--          include p (P) requires (H)+--          include h (H)+--          include a (A) requires (P)+--+-- Component r should not have any conflicts, since after mix-in linking+-- the two P imports will end up being the same, so we can properly+-- instantiate it.  But to know that q's P is p:P instantiated with h:H,+-- we have to be able to expand its unit id.  Maybe we can expand it+-- lazily but in some cases it will need to be expanded.+--+-- FWIW, the way that GHC handles this is by improving unit IDs as+-- soon as it sees an improved one in the package database.  This+-- is a bit disgusting.+shapeInstalledPackage :: IPI.InstalledPackageInfo -> ModuleShape+shapeInstalledPackage ipi = ModuleShape (Map.fromList provs) reqs+  where+    uid = installedOpenUnitId ipi+    provs = map shapeExposedModule (IPI.exposedModules ipi)+    reqs = requiredSignatures ipi+    shapeExposedModule (IPI.ExposedModule mod_name Nothing)+        = (mod_name, OpenModule uid mod_name)+    shapeExposedModule (IPI.ExposedModule mod_name (Just mod))+        = (mod_name, mod)

@@ -0,0 +1,67 @@+-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+module Distribution.Backpack.PreExistingComponent (+    PreExistingComponent(..),+    ipiToPreExistingComponent,+) where++import Prelude ()+import Distribution.Compat.Prelude++import Distribution.Backpack.ModuleShape+import Distribution.Backpack+import Distribution.Types.ComponentId+import Distribution.Types.MungedPackageId+import Distribution.Types.PackageId+import Distribution.Types.UnitId+import Distribution.Types.ComponentName+import Distribution.Types.PackageName+import Distribution.Package++import qualified Data.Map as Map+import qualified Distribution.InstalledPackageInfo as Installed+import Distribution.InstalledPackageInfo (InstalledPackageInfo)++-- | Stripped down version of 'LinkedComponent' for things+-- we don't need to know how to build.+data PreExistingComponent+    = PreExistingComponent {+        -- | The actual name of the package. This may DISAGREE with 'pc_pkgid'+        -- for internal dependencies: e.g., an internal component @lib@ may be+        -- munged to @z-pkg-z-lib@, but we still want to use it when we see+        -- @lib@ in @build-depends@+        pc_pkgname :: PackageName,+        -- | The actual name of the component.+        pc_compname :: ComponentName,+        pc_munged_id :: MungedPackageId,+        pc_uid   :: UnitId,+        pc_cid   :: ComponentId,+        pc_open_uid :: OpenUnitId,+        pc_shape :: ModuleShape+    }++-- | Convert an 'InstalledPackageInfo' into a 'PreExistingComponent',+-- which was brought into scope under the 'PackageName' (important for+-- a package qualified reference.)+ipiToPreExistingComponent :: InstalledPackageInfo -> PreExistingComponent+ipiToPreExistingComponent ipi =+    PreExistingComponent {+        pc_pkgname = packageName ipi,+        pc_compname = libraryComponentName $ Installed.sourceLibName ipi,+        pc_munged_id = mungedId ipi,+        pc_uid   = Installed.installedUnitId ipi,+        pc_cid   = Installed.installedComponentId ipi,+        pc_open_uid =+            IndefFullUnitId (Installed.installedComponentId ipi)+                            (Map.fromList (Installed.instantiatedWith ipi)),+        pc_shape = shapeInstalledPackage ipi+    }++instance HasMungedPackageId PreExistingComponent where+  mungedId = pc_munged_id++instance Package PreExistingComponent where+  packageId pec = PackageIdentifier (pc_pkgname pec) v+    where MungedPackageId _ v = pc_munged_id pec++instance HasUnitId PreExistingComponent where+  installedUnitId = pc_uid

@@ -0,0 +1,368 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE PatternGuards #-}+-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+module Distribution.Backpack.ReadyComponent (+    ReadyComponent(..),+    InstantiatedComponent(..),+    IndefiniteComponent(..),+    rc_depends,+    rc_uid,+    rc_pkgid,+    dispReadyComponent,+    toReadyComponents,+) where++import Prelude ()+import Distribution.Compat.Prelude hiding ((<>))++import Distribution.Backpack+import Distribution.Backpack.LinkedComponent+import Distribution.Backpack.ModuleShape++import Distribution.Types.AnnotatedId+import Distribution.Types.ModuleRenaming+import Distribution.Types.Component+import Distribution.Types.ComponentInclude+import Distribution.Types.ComponentId+import Distribution.Types.ComponentName+import Distribution.Types.PackageId+import Distribution.Types.UnitId+import Distribution.Compat.Graph (IsNode(..))+import Distribution.Types.Module+import Distribution.Types.MungedPackageId+import Distribution.Types.MungedPackageName+import Distribution.Types.Library++import Distribution.ModuleName+import Distribution.Package+import Distribution.Simple.Utils++import qualified Control.Applicative as A+import qualified Data.Traversable as T++import Control.Monad+import Text.PrettyPrint+import qualified Data.Map as Map++import Distribution.Version+import Distribution.Text++-- | A 'ReadyComponent' is one that we can actually generate build+-- products for.  We have a ready component for the typecheck-only+-- products of every indefinite package, as well as a ready component+-- for every way these packages can be fully instantiated.+--+data ReadyComponent+    = ReadyComponent {+        rc_ann_id       :: AnnotatedId UnitId,+        -- | The 'OpenUnitId' for this package.  At the moment, this+        -- is used in only one case, which is to determine if an+        -- export is of a module from this library (indefinite+        -- libraries record these exports as 'OpenModule');+        -- 'rc_open_uid' can be conveniently used to test for+        -- equality, whereas 'UnitId' cannot always be used in this+        -- case.+        rc_open_uid     :: OpenUnitId,+        -- | Corresponds to 'lc_cid'.  Invariant: if 'rc_open_uid'+        -- records a 'ComponentId', it coincides with this one.+        rc_cid          :: ComponentId,+        -- | Corresponds to 'lc_component'.+        rc_component    :: Component,+        -- | Corresponds to 'lc_exe_deps'.+        -- Build-tools don't participate in mix-in linking.+        -- (but what if they could?)+        rc_exe_deps     :: [AnnotatedId UnitId],+        -- | Corresponds to 'lc_public'.+        rc_public       :: Bool,+        -- | Extra metadata depending on whether or not this is an+        -- indefinite library (typechecked only) or an instantiated+        -- component (can be compiled).+        rc_i            :: Either IndefiniteComponent InstantiatedComponent+    }++-- | The final, string 'UnitId' that will uniquely identify+-- the compilation products of this component.+rc_uid          :: ReadyComponent -> UnitId+rc_uid = ann_id . rc_ann_id++-- | Corresponds to 'lc_pkgid'.+rc_pkgid        :: ReadyComponent -> PackageId+rc_pkgid = ann_pid . rc_ann_id++-- | An 'InstantiatedComponent' is a library which is fully instantiated+-- (or, possibly, has no requirements at all.)+data InstantiatedComponent+    = InstantiatedComponent {+        -- | How this library was instantiated.+        instc_insts    :: [(ModuleName, Module)],+        -- | Dependencies induced by 'instc_insts'.  These are recorded+        -- here because there isn't a convenient way otherwise to get+        -- the 'PackageId' we need to fill 'componentPackageDeps' as needed.+        instc_insts_deps :: [(UnitId, MungedPackageId)],+        -- | The modules exported/reexported by this library.+        instc_provides :: Map ModuleName Module,+        -- | The dependencies which need to be passed to the compiler+        -- to bring modules into scope.  These always refer to installed+        -- fully instantiated libraries.+        instc_includes :: [ComponentInclude DefUnitId ModuleRenaming]+    }++-- | An 'IndefiniteComponent' is a library with requirements+-- which we will typecheck only.+data IndefiniteComponent+    = IndefiniteComponent {+        -- | The requirements of the library.+        indefc_requires :: [ModuleName],+        -- | The modules exported/reexported by this library.+        indefc_provides :: Map ModuleName OpenModule,+        -- | The dependencies which need to be passed to the compiler+        -- to bring modules into scope.  These are 'OpenUnitId' because+        -- these may refer to partially instantiated libraries.+        indefc_includes :: [ComponentInclude OpenUnitId ModuleRenaming]+    }++-- | Compute the dependencies of a 'ReadyComponent' that should+-- be recorded in the @depends@ field of 'InstalledPackageInfo'.+rc_depends :: ReadyComponent -> [(UnitId, MungedPackageId)]+rc_depends rc = ordNub $+    case rc_i rc of+        Left indefc ->+            map (\ci -> (abstractUnitId $ ci_id ci, toMungedPackageId ci))+                (indefc_includes indefc)+        Right instc ->+            map (\ci -> (unDefUnitId $ ci_id ci, toMungedPackageId ci))+                (instc_includes instc)+              ++ instc_insts_deps instc+  where+    toMungedPackageId :: Text id => ComponentInclude id rn -> MungedPackageId+    toMungedPackageId ci =+        computeCompatPackageId+            (ci_pkgid ci)+            (case ci_cname ci of+                CLibName -> Nothing+                CSubLibName uqn -> Just uqn+                _ -> error $ display (rc_cid rc) +++                        " depends on non-library " ++ display (ci_id ci))++-- | Get the 'MungedPackageId' of a 'ReadyComponent' IF it is+-- a library.+rc_munged_id :: ReadyComponent -> MungedPackageId+rc_munged_id rc =+    computeCompatPackageId+        (rc_pkgid rc)+        (case rc_component rc of+            CLib lib -> libName lib+            _ -> error "rc_munged_id: not library")++instance Package ReadyComponent where+    packageId = rc_pkgid++instance HasUnitId ReadyComponent where+    installedUnitId = rc_uid++instance IsNode ReadyComponent where+    type Key ReadyComponent = UnitId+    nodeKey = rc_uid+    nodeNeighbors rc =+      (case rc_i rc of+        Right inst | [] <- instc_insts inst+                   -> []+                   | otherwise+                   -> [newSimpleUnitId (rc_cid rc)]+        _ -> []) +++      ordNub (map fst (rc_depends rc)) +++      map ann_id (rc_exe_deps rc)++dispReadyComponent :: ReadyComponent -> Doc+dispReadyComponent rc =+    hang (text (case rc_i rc of+                    Left  _ -> "indefinite"+                    Right _ -> "definite")+            <+> disp (nodeKey rc)+            {- <+> dispModSubst (Map.fromList (lc_insts lc)) -} ) 4 $+        vcat [ text "depends" <+> disp uid+             | uid <- nodeNeighbors rc ]++-- | The state of 'InstM'; a mapping from 'UnitId's to their+-- ready component, or @Nothing@ if its an external+-- component which we don't know how to build.+type InstS = Map UnitId (Maybe ReadyComponent)++-- | A state monad for doing instantiations (can't use actual+-- State because that would be an extra dependency.)+newtype InstM a = InstM { runInstM :: InstS -> (a, InstS) }++instance Functor InstM where+    fmap f (InstM m) = InstM $ \s -> let (x, s') = m s+                                     in (f x, s')++instance A.Applicative InstM where+    pure a = InstM $ \s -> (a, s)+    InstM f <*> InstM x = InstM $ \s -> let (f', s') = f s+                                            (x', s'') = x s'+                                        in (f' x', s'')++instance Monad InstM where+    return = A.pure+    InstM m >>= f = InstM $ \s -> let (x, s') = m s+                                  in runInstM (f x) s'++-- | Given a list of 'LinkedComponent's, expand the module graph+-- so that we have an instantiated graph containing all of the+-- instantiated components we need to build.+--+-- Instantiation intuitively follows the following algorithm:+--+--      instantiate a definite unit id p[S]:+--          recursively instantiate each module M in S+--          recursively instantiate modules exported by this unit+--          recursively instantiate dependencies substituted by S+--+-- The implementation is a bit more involved to memoize instantiation+-- if we have done it already.+--+-- We also call 'improveUnitId' during this process, so that fully+-- instantiated components are given 'HashedUnitId'.+--+toReadyComponents+    :: Map UnitId MungedPackageId+    -> Map ModuleName Module -- subst for the public component+    -> [LinkedComponent]+    -> [ReadyComponent]+toReadyComponents pid_map subst0 comps+    = catMaybes (Map.elems ready_map)+  where+    cmap = Map.fromList [ (lc_cid lc, lc) | lc <- comps ]++    instantiateUnitId :: ComponentId -> Map ModuleName Module+                      -> InstM DefUnitId+    instantiateUnitId cid insts = InstM $ \s ->+        case Map.lookup uid s of+            Nothing ->+                -- Knot tied+                let (r, s') = runInstM (instantiateComponent uid cid insts)+                                       (Map.insert uid r s)+                in (def_uid, Map.insert uid r s')+            Just _ -> (def_uid, s)+      where+        -- The mkDefUnitId here indicates that we assume+        -- that Cabal handles unit id hash allocation.+        -- Good thing about hashing here: map is only on string.+        -- Bad thing: have to repeatedly hash.+        def_uid = mkDefUnitId cid insts+        uid = unDefUnitId def_uid++    instantiateComponent+        :: UnitId -> ComponentId -> Map ModuleName Module+        -> InstM (Maybe ReadyComponent)+    instantiateComponent uid cid insts+      | Just lc <- Map.lookup cid cmap = do+            provides <- T.mapM (substModule insts) (modShapeProvides (lc_shape lc))+            -- NB: lc_sig_includes is omitted here, because we don't+            -- need them to build+            includes <- forM (lc_includes lc) $ \ci -> do+                uid' <- substUnitId insts (ci_id ci)+                return ci { ci_ann_id = fmap (const uid') (ci_ann_id ci) }+            exe_deps <- mapM (substExeDep insts) (lc_exe_deps lc)+            s <- InstM $ \s -> (s, s)+            let getDep (Module dep_def_uid _)+                    | let dep_uid = unDefUnitId dep_def_uid+                    -- Lose DefUnitId invariant for rc_depends+                    = [(dep_uid,+                          fromMaybe err_pid $+                            Map.lookup dep_uid pid_map A.<|>+                            fmap rc_munged_id (join (Map.lookup dep_uid s)))]+                  where+                    err_pid = MungedPackageId+                        (mkMungedPackageName "nonexistent-package-this-is-a-cabal-bug")+                        (mkVersion [0])+                instc = InstantiatedComponent {+                            instc_insts = Map.toList insts,+                            instc_insts_deps = concatMap getDep (Map.elems insts),+                            instc_provides = provides,+                            instc_includes = includes+                            -- NB: there is no dependency on the+                            -- indefinite version of this instantiated package here,+                            -- as (1) it doesn't go in depends in the+                            -- IPI: it's not a run time dep, and (2)+                            -- we don't have to tell GHC about it, it+                            -- will match up the ComponentId+                            -- automatically+                        }+            return $ Just ReadyComponent {+                    rc_ann_id       = (lc_ann_id lc) { ann_id = uid },+                    rc_open_uid     = DefiniteUnitId (unsafeMkDefUnitId uid),+                    rc_cid          = lc_cid lc,+                    rc_component    = lc_component lc,+                    rc_exe_deps     = exe_deps,+                    rc_public       = lc_public lc,+                    rc_i            = Right instc+                   }+      | otherwise = return Nothing++    substUnitId :: Map ModuleName Module -> OpenUnitId -> InstM DefUnitId+    substUnitId _ (DefiniteUnitId uid) =+        return uid+    substUnitId subst (IndefFullUnitId cid insts) = do+        insts' <- substSubst subst insts+        instantiateUnitId cid insts'++    -- NB: NOT composition+    substSubst :: Map ModuleName Module+               -> Map ModuleName OpenModule+               -> InstM (Map ModuleName Module)+    substSubst subst insts = T.mapM (substModule subst) insts++    substModule :: Map ModuleName Module -> OpenModule -> InstM Module+    substModule subst (OpenModuleVar mod_name)+        | Just m <- Map.lookup mod_name subst = return m+        | otherwise = error "substModule: non-closing substitution"+    substModule subst (OpenModule uid mod_name) = do+        uid' <- substUnitId subst uid+        return (Module uid' mod_name)++    substExeDep :: Map ModuleName Module+                -> AnnotatedId OpenUnitId -> InstM (AnnotatedId UnitId)+    substExeDep insts exe_aid = do+        exe_uid' <- substUnitId insts (ann_id exe_aid)+        return exe_aid { ann_id = unDefUnitId exe_uid' }++    indefiniteUnitId :: ComponentId -> InstM UnitId+    indefiniteUnitId cid = do+        let uid = newSimpleUnitId cid+        r <- indefiniteComponent uid cid+        InstM $ \s -> (uid, Map.insert uid r s)++    indefiniteComponent :: UnitId -> ComponentId -> InstM (Maybe ReadyComponent)+    indefiniteComponent uid cid+      | Just lc <- Map.lookup cid cmap = do+            exe_deps <- mapM (substExeDep Map.empty) (lc_exe_deps lc)+            let indefc = IndefiniteComponent {+                        indefc_requires = map fst (lc_insts lc),+                        indefc_provides = modShapeProvides (lc_shape lc),+                        indefc_includes = lc_includes lc ++ lc_sig_includes lc+                    }+            return $ Just ReadyComponent {+                    rc_ann_id       = (lc_ann_id lc) { ann_id = uid },+                    rc_cid          = lc_cid lc,+                    rc_open_uid     = lc_uid lc,+                    rc_component    = lc_component lc,+                    -- It's always fully built+                    rc_exe_deps     = exe_deps,+                    rc_public       = lc_public lc,+                    rc_i            = Left indefc+                }+      | otherwise = return Nothing++    ready_map = snd $ runInstM work Map.empty++    work+        | not (Map.null subst0)+        , [lc] <- filter lc_public (Map.elems cmap)+        = do _ <- instantiateUnitId (lc_cid lc) subst0+             return ()+        | otherwise+        = forM_ (Map.elems cmap) $ \lc ->+            if null (lc_insts lc)+                then instantiateUnitId (lc_cid lc) Map.empty >> return ()+                else indefiniteUnitId (lc_cid lc) >> return ()

@@ -0,0 +1,640 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>+module Distribution.Backpack.UnifyM (+    -- * Unification monad+    UnifyM,+    runUnifyM,+    failWith,+    addErr,+    failIfErrs,+    tryM,+    addErrContext,+    addErrContextM,+    liftST,++    UnifEnv(..),+    getUnifEnv,++    -- * Modules and unit IDs+    ModuleU,+    ModuleU'(..),+    convertModule,+    convertModuleU,++    UnitIdU,+    UnitIdU'(..),+    convertUnitId,+    convertUnitIdU,++    ModuleSubstU,+    convertModuleSubstU,+    convertModuleSubst,++    ModuleScopeU,+    emptyModuleScopeU,+    convertModuleScopeU,++    ModuleSourceU(..),++    convertInclude,+    convertModuleProvides,+    convertModuleProvidesU,++) where++import Prelude ()+import Distribution.Compat.Prelude hiding (mod)++import Distribution.Backpack.ModuleShape+import Distribution.Backpack.ModuleScope+import Distribution.Backpack.ModSubst+import Distribution.Backpack.FullUnitId+import Distribution.Backpack++import qualified Distribution.Utils.UnionFind as UnionFind+import Distribution.ModuleName+import Distribution.Package+import Distribution.PackageDescription+import Distribution.Text+import Distribution.Types.IncludeRenaming+import Distribution.Types.ComponentInclude+import Distribution.Types.AnnotatedId+import Distribution.Types.ComponentName+import Distribution.Verbosity++import Data.STRef+import Data.Traversable+import Control.Monad.ST+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import qualified Data.Traversable as T+import Text.PrettyPrint++-- TODO: more detailed trace output on high verbosity would probably+-- be appreciated by users debugging unification errors.  Collect+-- some good examples!++data ErrMsg = ErrMsg {+        err_msg :: Doc,+        err_ctx :: [Doc]+    }+type MsgDoc = Doc++renderErrMsg :: ErrMsg -> MsgDoc+renderErrMsg ErrMsg { err_msg = msg, err_ctx = ctx } =+    msg $$ vcat ctx++-- | The unification monad, this monad encapsulates imperative+-- unification.+newtype UnifyM s a = UnifyM { unUnifyM :: UnifEnv s -> ST s (Maybe a) }++-- | Run a computation in the unification monad.+runUnifyM :: Verbosity -> FullDb -> (forall s. UnifyM s a) -> Either [MsgDoc] a+runUnifyM verbosity db m+    = runST $ do i    <- newSTRef 0+                 hmap <- newSTRef Map.empty+                 errs <- newSTRef []+                 mb_r <- unUnifyM m UnifEnv {+                            unify_uniq = i,+                            unify_reqs = hmap,+                            unify_verbosity = verbosity,+                            unify_ctx = [],+                            unify_db = db,+                            unify_errs = errs }+                 final_errs <- readSTRef errs+                 case mb_r of+                    Just x | null final_errs -> return (Right x)+                    _ -> return (Left (map renderErrMsg (reverse final_errs)))+-- NB: GHC 7.6 throws a hissy fit if you pattern match on 'm'.++type ErrCtx s = MsgDoc++-- | The unification environment.+data UnifEnv s = UnifEnv {+        -- | A supply of unique integers to label 'UnitIdU'+        -- cells.  This is used to determine loops in unit+        -- identifiers (which can happen with mutual recursion.)+        unify_uniq :: UnifRef s UnitIdUnique,+        -- | The set of requirements in scope.  When+        -- a provision is brought into scope, we unify with+        -- the requirement at the same module name to fill it.+        -- This mapping grows monotonically.+        unify_reqs :: UnifRef s (Map ModuleName (ModuleU s)),+        -- | How verbose the error message should be+        unify_verbosity :: Verbosity,+        -- | The error reporting context+        unify_ctx :: [ErrCtx s],+        -- | The package index for expanding unit identifiers+        unify_db :: FullDb,+        -- | Accumulated errors+        unify_errs :: UnifRef s [ErrMsg]+    }++instance Functor (UnifyM s) where+    fmap f (UnifyM m) = UnifyM (fmap (fmap (fmap f)) m)++instance Applicative (UnifyM s) where+    pure = UnifyM . pure . pure . pure+    UnifyM f <*> UnifyM x = UnifyM $ \r -> do+        f' <- f r+        case f' of+          Nothing -> return Nothing+          Just f'' -> do+              x' <- x r+              case x' of+                  Nothing -> return Nothing+                  Just x'' -> return (Just (f'' x''))++instance Monad (UnifyM s) where+    return = pure+    UnifyM m >>= f = UnifyM $ \r -> do+        x <- m r+        case x of+            Nothing -> return Nothing+            Just x' -> unUnifyM (f x') r++-- | Lift a computation from 'ST' monad to 'UnifyM' monad.+-- Internal use only.+liftST :: ST s a -> UnifyM s a+liftST m = UnifyM $ \_ -> fmap Just m++addErr :: MsgDoc -> UnifyM s ()+addErr msg = do+    env <- getUnifEnv+    let err = ErrMsg {+                err_msg = msg,+                err_ctx = unify_ctx env+              }+    liftST $ modifySTRef (unify_errs env) (\errs -> err:errs)++failWith :: MsgDoc -> UnifyM s a+failWith msg = do+    addErr msg+    failM++failM :: UnifyM s a+failM = UnifyM $ \_ -> return Nothing++failIfErrs :: UnifyM s ()+failIfErrs = do+    env <- getUnifEnv+    errs <- liftST $ readSTRef (unify_errs env)+    when (not (null errs)) failM++tryM :: UnifyM s a -> UnifyM s (Maybe a)+tryM m =+    UnifyM (\env -> do+        mb_r <- unUnifyM m env+        return (Just mb_r))++{-+otherFail :: ErrMsg -> UnifyM s a+otherFail s = UnifyM $ \_ -> return (Left s)++unifyFail :: ErrMsg -> UnifyM s a+unifyFail err = do+    env <- getUnifEnv+    msg <- case unify_ctx env of+        Nothing -> return (text "Unspecified unification error:" <+> err)+        Just (ctx, mod1, mod2)+            | unify_verbosity env > normal+            -> do mod1' <- convertModuleU mod1+                  mod2' <- convertModuleU mod2+                  let extra = " (was unifying " ++ display mod1'+                                     ++ " and " ++ display mod2' ++ ")"+                  return (ctx ++ err ++ extra)+            | otherwise+            -> return (ctx ++ err ++ " (for more information, pass -v flag)")+    UnifyM $ \_ -> return (Left msg)+-}++-- | A convenient alias for mutable references in the unification monad.+type UnifRef s a = STRef s a++-- | Imperatively read a 'UnifRef'.+readUnifRef :: UnifRef s a -> UnifyM s a+readUnifRef = liftST . readSTRef++-- | Imperatively write a 'UnifRef'.+writeUnifRef :: UnifRef s a -> a -> UnifyM s ()+writeUnifRef x = liftST . writeSTRef x++-- | Get the current unification environment.+getUnifEnv :: UnifyM s (UnifEnv s)+getUnifEnv = UnifyM $ \r -> return (return r)++-- | Add a fixed message to the error context.+addErrContext :: Doc -> UnifyM s a -> UnifyM s a+addErrContext ctx m = addErrContextM ctx m++-- | Add a message to the error context.  It may make monadic queries.+addErrContextM :: ErrCtx s -> UnifyM s a -> UnifyM s a+addErrContextM ctx m =+    UnifyM $ \r -> unUnifyM m r { unify_ctx = ctx : unify_ctx r }+++-----------------------------------------------------------------------+-- The "unifiable" variants of the data types+--+-- In order to properly do unification over infinite trees, we+-- need to union find over 'Module's and 'UnitId's.  The pure+-- representation is ill-equipped to do this, so we convert+-- from the pure representation into one which is indirected+-- through union-find.  'ModuleU' handles hole variables;+-- 'UnitIdU' handles mu-binders.++-- | Contents of a mutable 'ModuleU' reference.+data ModuleU' s+    = ModuleU (UnitIdU s) ModuleName+    | ModuleVarU ModuleName++-- | Contents of a mutable 'UnitIdU' reference.+data UnitIdU' s+    = UnitIdU UnitIdUnique ComponentId (Map ModuleName (ModuleU s))+    | UnitIdThunkU DefUnitId++-- | A mutable version of 'Module' which can be imperatively unified.+type ModuleU s = UnionFind.Point s (ModuleU' s)++-- | A mutable version of 'UnitId' which can be imperatively unified.+type UnitIdU s = UnionFind.Point s (UnitIdU' s)++-- | An integer for uniquely labeling 'UnitIdU' nodes.  We need+-- these labels in order to efficiently serialize 'UnitIdU's into+-- 'UnitId's (we use the label to check if any parent is the+-- node in question, and if so insert a deBruijn index instead.)+-- These labels must be unique across all 'UnitId's/'Module's which+-- participate in unification!+type UnitIdUnique = Int+++-----------------------------------------------------------------------+-- Conversion to the unifiable data types++-- An environment for tracking the mu-bindings in scope.+-- The invariant for a state @(m, i)@ is that [0..i] are+-- keys of @m@; in fact, the @i-k@th entry is the @k@th+-- de Bruijn index (this saves us from having to shift as+-- we enter mu-binders.)+type MuEnv s = (IntMap (UnitIdU s), Int)++extendMuEnv :: MuEnv s -> UnitIdU s -> MuEnv s+extendMuEnv (m, i) x =+    (IntMap.insert (i + 1) x m, i + 1)++{-+lookupMuEnv :: MuEnv s -> Int {- de Bruijn index -} -> UnitIdU s+lookupMuEnv (m, i) k =+    case IntMap.lookup (i - k) m of+        -- Technically a user can trigger this by giving us a+        -- bad 'UnitId', so handle this better.+        Nothing -> error "lookupMuEnv: out of bounds (malformed de Bruijn index)"+        Just v -> v+-}++emptyMuEnv :: MuEnv s+emptyMuEnv = (IntMap.empty, -1)++-- The workhorse functions.  These share an environment:+--   * @UnifRef s UnitIdUnique@ - the unique label supply for 'UnitIdU' nodes+--   * @UnifRef s (Map ModuleName moduleU)@ - the (lazily initialized)+--     environment containing the implicitly universally quantified+--     @hole:A@ binders.+--   * @MuEnv@ - the environment for mu-binders.++convertUnitId' :: MuEnv s+               -> OpenUnitId+               -> UnifyM s (UnitIdU s)+-- TODO: this could be more lazy if we know there are no internal+-- references+convertUnitId' _ (DefiniteUnitId uid) =+    liftST $ UnionFind.fresh (UnitIdThunkU uid)+convertUnitId' stk (IndefFullUnitId cid insts) = do+    fs <- fmap unify_uniq getUnifEnv+    x <- liftST $ UnionFind.fresh (error "convertUnitId") -- tie the knot later+    insts_u <- T.forM insts $ convertModule' (extendMuEnv stk x)+    u <- readUnifRef fs+    writeUnifRef fs (u+1)+    y <- liftST $ UnionFind.fresh (UnitIdU u cid insts_u)+    liftST $ UnionFind.union x y+    return y+-- convertUnitId' stk (UnitIdVar i) = return (lookupMuEnv stk i)++convertModule' :: MuEnv s+               -> OpenModule -> UnifyM s (ModuleU s)+convertModule' _stk (OpenModuleVar mod_name) = do+    hmap <- fmap unify_reqs getUnifEnv+    hm <- readUnifRef hmap+    case Map.lookup mod_name hm of+        Nothing -> do mod <- liftST $ UnionFind.fresh (ModuleVarU mod_name)+                      writeUnifRef hmap (Map.insert mod_name mod hm)+                      return mod+        Just mod -> return mod+convertModule' stk (OpenModule uid mod_name) = do+    uid_u <- convertUnitId' stk uid+    liftST $ UnionFind.fresh (ModuleU uid_u mod_name)++convertUnitId :: OpenUnitId -> UnifyM s (UnitIdU s)+convertUnitId = convertUnitId' emptyMuEnv++convertModule :: OpenModule -> UnifyM s (ModuleU s)+convertModule = convertModule' emptyMuEnv++++-----------------------------------------------------------------------+-- Substitutions++-- | The mutable counterpart of a 'ModuleSubst' (not defined here).+type ModuleSubstU s = Map ModuleName (ModuleU s)++-- | Conversion of 'ModuleSubst' to 'ModuleSubstU'+convertModuleSubst :: Map ModuleName OpenModule -> UnifyM s (Map ModuleName (ModuleU s))+convertModuleSubst = T.mapM convertModule++-- | Conversion of 'ModuleSubstU' to 'ModuleSubst'+convertModuleSubstU :: ModuleSubstU s -> UnifyM s OpenModuleSubst+convertModuleSubstU = T.mapM convertModuleU++-----------------------------------------------------------------------+-- Conversion from the unifiable data types++-- An environment for tracking candidates for adding a mu-binding.+-- The invariant for a state @(m, i)@, is that if we encounter a node+-- labeled @k@ such that @m[k -> v]@, then we can replace this+-- node with the de Bruijn index @i-v@ referring to an enclosing+-- mu-binder; furthermore, @range(m) = [0..i]@.+type MooEnv = (IntMap Int, Int)++emptyMooEnv :: MooEnv+emptyMooEnv = (IntMap.empty, -1)++extendMooEnv :: MooEnv -> UnitIdUnique -> MooEnv+extendMooEnv (m, i) k = (IntMap.insert k (i + 1) m, i + 1)++lookupMooEnv :: MooEnv -> UnitIdUnique -> Maybe Int+lookupMooEnv (m, i) k =+    case IntMap.lookup k m of+        Nothing -> Nothing+        Just v -> Just (i-v) -- de Bruijn indexize++-- The workhorse functions++convertUnitIdU' :: MooEnv -> UnitIdU s -> UnifyM s OpenUnitId+convertUnitIdU' stk uid_u = do+    x <- liftST $ UnionFind.find uid_u+    case x of+        UnitIdThunkU uid -> return (DefiniteUnitId uid)+        UnitIdU u cid insts_u ->+            case lookupMooEnv stk u of+                Just _i ->+                    failWith (text "Unsupported mutually recursive unit identifier")+                    -- return (UnitIdVar i)+                Nothing -> do+                    insts <- T.forM insts_u $ convertModuleU' (extendMooEnv stk u)+                    return (IndefFullUnitId cid insts)++convertModuleU' :: MooEnv -> ModuleU s -> UnifyM s OpenModule+convertModuleU' stk mod_u = do+    mod <- liftST $ UnionFind.find mod_u+    case mod of+        ModuleVarU mod_name -> return (OpenModuleVar mod_name)+        ModuleU uid_u mod_name -> do+            uid <- convertUnitIdU' stk uid_u+            return (OpenModule uid mod_name)++-- Helper functions++convertUnitIdU :: UnitIdU s -> UnifyM s OpenUnitId+convertUnitIdU = convertUnitIdU' emptyMooEnv++convertModuleU :: ModuleU s -> UnifyM s OpenModule+convertModuleU = convertModuleU' emptyMooEnv++-- | An empty 'ModuleScopeU'.+emptyModuleScopeU :: ModuleScopeU s+emptyModuleScopeU = (Map.empty, Map.empty)+++-- | The mutable counterpart of 'ModuleScope'.+type ModuleScopeU s = (ModuleProvidesU s, ModuleRequiresU s)+-- | The mutable counterpart of 'ModuleProvides'+type ModuleProvidesU s = Map ModuleName [ModuleSourceU s]+type ModuleRequiresU s = ModuleProvidesU s+data ModuleSourceU s =+    ModuleSourceU {+        -- We don't have line numbers, but if we did the+        -- package name and renaming could be associated+        -- with that as well+        usrc_pkgname :: PackageName,+        usrc_compname :: ComponentName,+        usrc_renaming :: IncludeRenaming,+        usrc_module :: ModuleU s,+        usrc_implicit :: Bool+    }++-- TODO: Deduplicate this with Distribution.Backpack.MixLink.dispSource+ci_msg :: ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming -> Doc+ci_msg ci+  | ci_implicit ci = text "build-depends:" <+> pp_pn+  | otherwise = text "mixins:" <+> pp_pn <+> disp (ci_renaming ci)+  where+    pn = pkgName (ci_pkgid ci)+    pp_pn =+        case ci_cname ci of+            CLibName -> disp pn+            CSubLibName cn -> disp pn <<>> colon <<>> disp cn+            -- Shouldn't happen+            cn -> disp pn <+> parens (disp cn)++-- | Convert a 'ModuleShape' into a 'ModuleScopeU', so we can do+-- unification on it.+convertInclude+    :: ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming+    -> UnifyM s (ModuleScopeU s,+                 Either (ComponentInclude (UnitIdU s) ModuleRenaming) {- normal -}+                        (ComponentInclude (UnitIdU s) ModuleRenaming) {- sig -})+convertInclude ci@(ComponentInclude {+                    ci_ann_id = AnnotatedId {+                            ann_id = (uid, ModuleShape provs reqs),+                            ann_pid = pid,+                            ann_cname = compname+                        },+                    ci_renaming = incl@(IncludeRenaming prov_rns req_rns),+                    ci_implicit = implicit+               }) = addErrContext (text "In" <+> ci_msg ci) $ do+    let pn = packageName pid+        source m = ModuleSource {+                        msrc_pkgname = pn,+                        msrc_compname = compname,+                        msrc_renaming = incl,+                        msrc_module = m,+                        msrc_implicit = implicit+                    }++    -- Suppose our package has two requirements A and B, and+    -- we include it with @requires (A as X)@+    -- There are three closely related things we compute based+    -- off of @reqs@ and @reqs_rns@:+    --+    --      1. The requirement renaming (A -> X)+    --      2. The requirement substitution (A -> <X>, B -> <B>)++    -- Requirement renaming.  This is read straight off the syntax:+    --+    --      [nothing]          ==>  [empty]+    --      requires (B as Y)  ==>  B -> Y+    --+    -- Requirement renamings are NOT injective: if two requirements+    -- are mapped to the same name, the intent is to merge them+    -- together.  But they are *functions*, so @B as X, B as Y@ is+    -- illegal.++    req_rename_list <-+      case req_rns of+        DefaultRenaming -> return []+        HidingRenaming _ -> do+            -- Not valid here for requires!+            addErr $ text "Unsupported syntax" <+>+                     quotes (text "requires hiding (...)")+            return []+        ModuleRenaming rns -> return rns++    let req_rename_listmap :: Map ModuleName [ModuleName]+        req_rename_listmap =+            Map.fromListWith (++) [ (k,[v]) | (k,v) <- req_rename_list ]+    req_rename <- sequenceA . flip Map.mapWithKey req_rename_listmap $ \k vs0 ->+      case vs0 of+        []  -> error "req_rename"+        [v] -> return v+        v:vs -> do addErr $+                    text "Conflicting renamings of requirement" <+> quotes (disp k) $$+                    text "Renamed to: " <+> vcat (map disp (v:vs))+                   return v++    let req_rename_fn k = case Map.lookup k req_rename of+                            Nothing -> k+                            Just v  -> v++    -- Requirement substitution.+    --+    --      A -> X      ==>     A -> <X>+    let req_subst = fmap OpenModuleVar req_rename++    uid_u <- convertUnitId (modSubst req_subst uid)++    -- Requirement mapping.  This is just taking the range of the+    -- requirement substitution, and making a mapping so that it is+    -- convenient to merge things together.  It INCLUDES the implicit+    -- mappings.+    --+    --      A -> X      ==>     X -> <X>, B -> <B>+    reqs_u <- convertModuleRequires . Map.fromList $+                [ (k, [source (OpenModuleVar k)])+                | k <- map req_rename_fn (Set.toList reqs)+                ]++    -- Report errors if there were unused renamings+    let leftover = Map.keysSet req_rename `Set.difference` reqs+    unless (Set.null leftover) $+        addErr $+            hang (text "The" <+> text (showComponentName compname) <+>+                  text "from package" <+> quotes (disp pid)+                  <+> text "does not require:") 4+                 (vcat (map disp (Set.toList leftover)))++    -- Provision computation is more complex.+    -- For example, if we have:+    --+    --      include p (A as X) requires (B as Y)+    --          where A -> q[B=<B>]:A+    --+    -- Then we need:+    --+    --      X -> [("p", q[B=<B>]:A)]+    --+    -- There are a bunch of clever ways to present the algorithm+    -- but here is the simple one:+    --+    --      1. If we have a default renaming, apply req_subst+    --      to provs and use that.+    --+    --      2. Otherwise, build a map by successively looking+    --      up the referenced modules in the renaming in provs.+    --+    -- Importantly, overlapping rename targets get accumulated+    -- together.  It's not an (immediate) error.+    (pre_prov_scope, prov_rns') <-+        case prov_rns of+            DefaultRenaming -> return (Map.toList provs, prov_rns)+            HidingRenaming hides ->+                let hides_set = Set.fromList hides+                in let r = [ (k,v)+                           | (k,v) <- Map.toList provs+                           , not (k `Set.member` hides_set) ]+                   -- GHC doesn't understand hiding, so expand it out!+                   in return (r, ModuleRenaming (map ((\x -> (x,x)).fst) r))+            ModuleRenaming rns -> do+              r <- sequence+                [ case Map.lookup from provs of+                    Just m -> return (to, m)+                    Nothing -> failWith $+                        text "Package" <+> quotes (disp pid) <+>+                        text "does not expose the module" <+> quotes (disp from)+                | (from, to) <- rns ]+              return (r, prov_rns)+    let prov_scope = modSubst req_subst+                   $ Map.fromListWith (++)+                   [ (k, [source v])+                   | (k, v) <- pre_prov_scope ]++    provs_u <- convertModuleProvides prov_scope++    -- TODO: Assert that provs_u is empty if provs was empty+    return ((provs_u, reqs_u),+                -- NB: We test that requirements is not null so that+                -- users can create packages with zero module exports+                -- that cause some C library to linked in, etc.+                (if Map.null provs && not (Set.null reqs)+                    then Right -- is sig+                    else Left) (ComponentInclude {+                                    ci_ann_id = AnnotatedId {+                                            ann_id = uid_u,+                                            ann_pid = pid,+                                            ann_cname = compname+                                        },+                                    ci_renaming = prov_rns',+                                    ci_implicit = ci_implicit ci+                                    }))++-- | Convert a 'ModuleScopeU' to a 'ModuleScope'.+convertModuleScopeU :: ModuleScopeU s -> UnifyM s ModuleScope+convertModuleScopeU (provs_u, reqs_u) = do+    provs <- convertModuleProvidesU provs_u+    reqs  <- convertModuleRequiresU reqs_u+    -- TODO: Test that the requirements are still free. If they+    -- are not, they got unified, and that's dodgy at best.+    return (ModuleScope provs reqs)++-- | Convert a 'ModuleProvides' to a 'ModuleProvidesU'+convertModuleProvides :: ModuleProvides -> UnifyM s (ModuleProvidesU s)+convertModuleProvides = T.mapM $ \ms ->+    mapM (\(ModuleSource pn cn incl m i)+            -> do m' <- convertModule m+                  return (ModuleSourceU pn cn incl m' i)) ms++-- | Convert a 'ModuleProvidesU' to a 'ModuleProvides'+convertModuleProvidesU :: ModuleProvidesU s -> UnifyM s ModuleProvides+convertModuleProvidesU = T.mapM $ \ms ->+    mapM (\(ModuleSourceU pn cn incl m i)+            -> do m' <- convertModuleU m+                  return (ModuleSource pn cn incl m' i)) ms++convertModuleRequires :: ModuleRequires -> UnifyM s (ModuleRequiresU s)+convertModuleRequires = convertModuleProvides++convertModuleRequiresU :: ModuleRequiresU s -> UnifyM s ModuleRequires+convertModuleRequiresU = convertModuleProvidesU

@@ -9,14 +9,19 @@  module Distribution.Compat.Binary        ( decodeOrFailIO+       , decodeFileOrFail' #if __GLASGOW_HASKELL__ >= 708 || MIN_VERSION_binary(0,7,0)        , module Data.Binary #else        , Binary(..)-       , decode, encode+       , decode, encode, encodeFile #endif        ) where +#if __GLASGOW_HASKELL__ < 706+import Prelude hiding (catch)+#endif+ import Control.Exception (catch, evaluate) #if __GLASGOW_HASKELL__ >= 711 import Control.Exception (pattern ErrorCall)@@ -25,23 +30,25 @@ #endif import Data.ByteString.Lazy (ByteString) -#if __GLASGOW_HASKELL__ < 706-import Prelude hiding (catch)-#endif- #if __GLASGOW_HASKELL__ >= 708 || MIN_VERSION_binary(0,7,0)  import Data.Binary +-- | Lazily reconstruct a value previously written to a file.+decodeFileOrFail' :: Binary a => FilePath -> IO (Either String a)+decodeFileOrFail' f = either (Left . snd) Right `fmap` decodeFileOrFail f+ #else  import Data.Binary.Get import Data.Binary.Put+import qualified Data.ByteString.Lazy as BSL  import Distribution.Compat.Binary.Class import Distribution.Compat.Binary.Generic () --- | Decode a value from a lazy ByteString, reconstructing the original structure.+-- | Decode a value from a lazy ByteString, reconstructing the+-- original structure. -- decode :: Binary a => ByteString -> a decode = runGet get@@ -51,6 +58,14 @@ encode :: Binary a => a -> ByteString encode = runPut . put {-# INLINE encode #-}++-- | Lazily reconstruct a value previously written to a file.+decodeFileOrFail' :: Binary a => FilePath -> IO (Either String a)+decodeFileOrFail' f = decodeOrFailIO =<< BSL.readFile f++-- | Lazily serialise a value to a file+encodeFile :: Binary a => FilePath -> a -> IO ()+encodeFile f = BSL.writeFile f . encode  #endif