Cabal 1.22.8.0 → 1.24.0.0

raw patch · 225 files changed

+9660/−6555 lines, 225 filesdep +Win32dep +exceptionsdep +taggeddep −HUnitdep −extensible-exceptionsdep −test-frameworkdep ~QuickCheckdep ~basedep ~bytestringsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: Win32, exceptions, tagged, tasty, tasty-hunit, tasty-quickcheck, transformers

Dependencies removed: HUnit, extensible-exceptions, test-framework, test-framework-hunit, test-framework-quickcheck2

Dependency ranges changed: QuickCheck, base, bytestring, containers, directory, filepath, pretty, process, time, unix

API changes (from Hackage documentation)

Files

• Cabal.cabal +107/−64
• Distribution/Compat/Binary.hs +9/−1
• Distribution/Compat/Binary/Class.hs +1/−13
• Distribution/Compat/CopyFile.hs +6/−9
• Distribution/Compat/Environment.hs +67/−2
• Distribution/Compat/GetShortPathName.hs +49/−0
• Distribution/Compat/Internal/TempFile.hs +124/−0
• Distribution/Compat/MonadFail.hs +36/−0
• Distribution/Compat/ReadP.hs +23/−19
• Distribution/Compat/Semigroup.hs +171/−0
• Distribution/Compat/TempFile.hs +0/−128
• Distribution/Compiler.hs +4/−4
• Distribution/InstalledPackageInfo.hs +50/−74
• Distribution/Lex.hs +55/−0
• Distribution/License.hs +4/−4
• Distribution/Make.hs +4/−7
• Distribution/ModuleName.hs +2/−3
• Distribution/Package.hs +66/−203
• Distribution/PackageDescription.hs +241/−109
• Distribution/PackageDescription/Check.hs +286/−139
• Distribution/PackageDescription/Configuration.hs +232/−82
• Distribution/PackageDescription/Parse.hs +96/−93
• Distribution/PackageDescription/PrettyPrint.hs +40/−31
• Distribution/ParseUtils.hs +11/−16
• Distribution/Simple.hs +166/−171
• Distribution/Simple/Bench.hs +11/−16
• Distribution/Simple/Build.hs +103/−102
• Distribution/Simple/Build/Macros.hs +15/−14
• Distribution/Simple/Build/PathsModule.hs +27/−13
• Distribution/Simple/BuildPaths.hs +14/−21
• Distribution/Simple/BuildTarget.hs +46/−45
• Distribution/Simple/CCompiler.hs +11/−13
• Distribution/Simple/Command.hs +39/−19
• Distribution/Simple/Compiler.hs +73/−6
• Distribution/Simple/Configure.hs +1775/−1429
• Distribution/Simple/GHC.hs +267/−149
• Distribution/Simple/GHC/IPI641.hs +0/−106
• Distribution/Simple/GHC/IPI642.hs +7/−47
• Distribution/Simple/GHC/IPIConvert.hs +50/−0
• Distribution/Simple/GHC/ImplInfo.hs +4/−3
• Distribution/Simple/GHC/Internal.hs +81/−45
• Distribution/Simple/GHCJS.hs +75/−101
• Distribution/Simple/Haddock.hs +71/−113
• Distribution/Simple/HaskellSuite.hs +9/−15
• Distribution/Simple/Install.hs +31/−30
• Distribution/Simple/InstallDirs.hs +32/−68
• Distribution/Simple/JHC.hs +14/−24
• Distribution/Simple/LHC.hs +29/−62
• Distribution/Simple/LocalBuildInfo.hs +52/−46
• Distribution/Simple/PackageIndex.hs +109/−181
• Distribution/Simple/PreProcess.hs +64/−32
• Distribution/Simple/Program.hs +8/−6
• Distribution/Simple/Program/Ar.hs +4/−7
• Distribution/Simple/Program/Builtin.hs +7/−32
• Distribution/Simple/Program/Db.hs +38/−34
• Distribution/Simple/Program/Find.hs +103/−44
• Distribution/Simple/Program/GHC.hs +104/−160
• Distribution/Simple/Program/HcPkg.hs +162/−77
• Distribution/Simple/Program/Hpc.hs +6/−7
• Distribution/Simple/Program/Internal.hs +46/−0
• Distribution/Simple/Program/Run.hs +1/−6
• Distribution/Simple/Program/Script.hs +0/−2
• Distribution/Simple/Program/Strip.hs +7/−9
• Distribution/Simple/Program/Types.hs +20/−9
• Distribution/Simple/Register.hs +97/−103
• Distribution/Simple/Setup.hs +267/−386
• Distribution/Simple/SrcDist.hs +25/−38
• Distribution/Simple/Test.hs +7/−13
• Distribution/Simple/Test/ExeV10.hs +25/−26
• Distribution/Simple/Test/LibV09.hs +30/−28
• Distribution/Simple/Test/Log.hs +10/−12
• Distribution/Simple/UHC.hs +40/−29
• Distribution/Simple/UserHooks.hs +4/−9
• Distribution/Simple/Utils.hs +188/−72
• Distribution/System.hs +38/−18
• Distribution/Text.hs +21/−16
• Distribution/Utils/NubList.hs +11/−9
• Distribution/Verbosity.hs +3/−2
• Distribution/Version.hs +116/−22
• Language/Haskell/Extension.hs +54/−2
• Setup.hs +3/−0
• changelog +28/−38
• doc/Cabal.css +49/−0
• doc/developing-packages.markdown +121/−51
• doc/index.markdown +1/−0
• doc/installing-packages.markdown +234/−13
• tests/PackageTests.hs +251/−140
• tests/PackageTests/AllowNewer/AllowNewer.cabal +25/−0
• tests/PackageTests/AllowNewer/benchmarks/Bench.hs +4/−0
• tests/PackageTests/AllowNewer/src/Foo.hs +4/−0
• tests/PackageTests/AllowNewer/tests/Test.hs +4/−0
• tests/PackageTests/BenchmarkExeV10/Check.hs +0/−16
• tests/PackageTests/BenchmarkOptions/Check.hs +0/−26
• tests/PackageTests/BenchmarkStanza/Check.hs +15/−37
• tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive1/Check.hs +0/−22
• tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive1/GlobalBuildDepsNotAdditive1.cabal +1/−1
• tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive1/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive2/Check.hs +0/−22
• tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive2/GlobalBuildDepsNotAdditive2.cabal +1/−1
• tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive2/lemon.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary0/Check.hs +0/−22
• tests/PackageTests/BuildDeps/InternalLibrary0/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary0/my.cabal +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary0/programs/lemon.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary1/Check.hs +0/−16
• tests/PackageTests/BuildDeps/InternalLibrary1/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary1/my.cabal +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary1/programs/lemon.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs +0/−32
• tests/PackageTests/BuildDeps/InternalLibrary2/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary2/my.cabal +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary2/programs/lemon.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary2/to-install/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary2/to-install/my.cabal +1/−1
• tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs +0/−32
• tests/PackageTests/BuildDeps/InternalLibrary3/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary3/my.cabal +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary3/programs/lemon.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary3/to-install/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary3/to-install/my.cabal +1/−1
• tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs +0/−32
• tests/PackageTests/BuildDeps/InternalLibrary4/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary4/my.cabal +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary4/programs/lemon.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary4/to-install/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/InternalLibrary4/to-install/my.cabal +1/−1
• tests/PackageTests/BuildDeps/SameDepsAllRound/Check.hs +0/−21
• tests/PackageTests/BuildDeps/SameDepsAllRound/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/SameDepsAllRound/SameDepsAllRound.cabal +1/−1
• tests/PackageTests/BuildDeps/SameDepsAllRound/lemon.hs +2/−2
• tests/PackageTests/BuildDeps/SameDepsAllRound/pineapple.hs +2/−2
• tests/PackageTests/BuildDeps/TargetSpecificDeps1/Check.hs +0/−29
• tests/PackageTests/BuildDeps/TargetSpecificDeps1/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/TargetSpecificDeps1/lemon.hs +2/−2
• tests/PackageTests/BuildDeps/TargetSpecificDeps1/my.cabal +1/−1
• tests/PackageTests/BuildDeps/TargetSpecificDeps2/Check.hs +0/−21
• tests/PackageTests/BuildDeps/TargetSpecificDeps2/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/TargetSpecificDeps2/my.cabal +1/−1
• tests/PackageTests/BuildDeps/TargetSpecificDeps3/Check.hs +0/−28
• tests/PackageTests/BuildDeps/TargetSpecificDeps3/MyLibrary.hs +2/−2
• tests/PackageTests/BuildDeps/TargetSpecificDeps3/lemon.hs +2/−2
• tests/PackageTests/BuildDeps/TargetSpecificDeps3/my.cabal +1/−1
• tests/PackageTests/BuildTestSuiteDetailedV09/Check.hs +0/−18
• tests/PackageTests/BuildTestSuiteDetailedV09/Dummy.hs +0/−6
• tests/PackageTests/BuildTestSuiteDetailedV09/Dummy2.hs +6/−0
• tests/PackageTests/BuildTestSuiteDetailedV09/my.cabal +0/−19
• tests/PackageTests/BuildableField/BuildableField.cabal +16/−0
• tests/PackageTests/BuildableField/Main.hs +4/−0
• tests/PackageTests/CMain/Check.hs +0/−20
• tests/PackageTests/CMain/Setup.hs +0/−3
• tests/PackageTests/DeterministicAr/Check.hs +14/−70
• tests/PackageTests/DuplicateModuleName/DuplicateModuleName.cabal +25/−0
• tests/PackageTests/DuplicateModuleName/src/Foo.hs +12/−0
• tests/PackageTests/DuplicateModuleName/tests/Foo.hs +18/−0
• tests/PackageTests/DuplicateModuleName/tests2/Foo.hs +18/−0
• tests/PackageTests/EmptyLib/Check.hs +0/−16
• tests/PackageTests/GhcPkgGuess/SameDirectory/SameDirectory.cabal +11/−0
• tests/PackageTests/GhcPkgGuess/SameDirectory/ghc +6/−0
• tests/PackageTests/GhcPkgGuess/SameDirectory/ghc-pkg +3/−0
• tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/SameDirectory.cabal +11/−0
• tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/ghc-7.10 +6/−0
• tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/ghc-pkg-ghc-7.10 +3/−0
• tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/SameDirectory.cabal +11/−0
• tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/ghc-7.10 +6/−0
• tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/ghc-pkg-7.10 +3/−0
• tests/PackageTests/GhcPkgGuess/Symlink/SameDirectory.cabal +11/−0
• tests/PackageTests/GhcPkgGuess/Symlink/bin/ghc +6/−0
• tests/PackageTests/GhcPkgGuess/Symlink/bin/ghc-pkg +3/−0
• tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/SameDirectory.cabal +11/−0
• tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/bin/ghc-7.10 +6/−0
• tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/bin/ghc-pkg-7.10 +3/−0
• tests/PackageTests/GhcPkgGuess/SymlinkVersion/SameDirectory.cabal +11/−0
• tests/PackageTests/GhcPkgGuess/SymlinkVersion/bin/ghc-7.10 +6/−0
• tests/PackageTests/GhcPkgGuess/SymlinkVersion/bin/ghc-pkg-ghc-7.10 +3/−0
• tests/PackageTests/Haddock/Check.hs +0/−42
• tests/PackageTests/HaddockNewline/A.hs +1/−0
• tests/PackageTests/HaddockNewline/HaddockNewline.cabal +20/−0
• tests/PackageTests/HaddockNewline/Setup.hs +2/−0
• tests/PackageTests/Options.hs +19/−0
• tests/PackageTests/OrderFlags/Check.hs +0/−24
• tests/PackageTests/PackageTester.hs +602/−217
• tests/PackageTests/PathsModule/Executable/Check.hs +0/−16
• tests/PackageTests/PathsModule/Library/Check.hs +0/−16
• tests/PackageTests/PreProcess/Check.hs +0/−16
• tests/PackageTests/PreProcessExtraSources/Foo.hsc +9/−0
• tests/PackageTests/PreProcessExtraSources/Main.hs +8/−0
• tests/PackageTests/PreProcessExtraSources/my.cabal +32/−0
• tests/PackageTests/ReexportedModules/Check.hs +0/−41
• tests/PackageTests/TemplateHaskell/Check.hs +0/−41
• tests/PackageTests/TestNameCollision/child/Child.hs +2/−0
• tests/PackageTests/TestNameCollision/child/child.cabal +19/−0
• tests/PackageTests/TestNameCollision/child/tests/Test.hs +13/−0
• tests/PackageTests/TestNameCollision/parent/Parent.hs +1/−0
• tests/PackageTests/TestNameCollision/parent/parent.cabal +13/−0
• tests/PackageTests/TestOptions/Check.hs +0/−26
• tests/PackageTests/TestStanza/Check.hs +14/−38
• tests/PackageTests/TestSuiteExeV10/Check.hs +0/−147
• tests/PackageTests/TestSuiteExeV10/Foo.hs +0/−4
• tests/PackageTests/TestSuiteExeV10/my.cabal +0/−15
• tests/PackageTests/TestSuiteExeV10/tests/test-Foo.hs +0/−8
• tests/PackageTests/TestSuiteTests/ExeV10/Check.hs +129/−0
• tests/PackageTests/TestSuiteTests/ExeV10/Foo.hs +4/−0
• tests/PackageTests/TestSuiteTests/ExeV10/my.cabal +21/−0
• tests/PackageTests/TestSuiteTests/ExeV10/tests/test-Foo.hs +12/−0
• tests/PackageTests/TestSuiteTests/ExeV10/tests/test-Short.hs +11/−0
• tests/PackageTests/TestSuiteTests/LibV09/Lib.hs +11/−0
• tests/PackageTests/TestSuiteTests/LibV09/LibV09.cabal +21/−0
• tests/PackageTests/TestSuiteTests/LibV09/tests/Deadlock.hs +8/−0
• tests/PackageTests/Tests.hs +307/−0
• tests/PackageTests/UniqueIPID/P1/M.hs +3/−0
• tests/PackageTests/UniqueIPID/P1/my.cabal +15/−0
• tests/PackageTests/UniqueIPID/P2/M.hs +3/−0
• tests/PackageTests/UniqueIPID/P2/my.cabal +15/−0
• tests/PackageTests/multInst/my.cabal +16/−0
• tests/README.md +19/−15
• tests/Test/Laws.hs +79/−0
• tests/Test/QuickCheck/Utils.hs +29/−0
• tests/UnitTests.hs +19/−12
• tests/UnitTests/Distribution/Compat/CreatePipe.hs +3/−4
• tests/UnitTests/Distribution/Compat/ReadP.hs +3/−3
• tests/UnitTests/Distribution/Simple/Program/Internal.hs +36/−0
• tests/UnitTests/Distribution/Simple/Utils.hs +59/−0
• tests/UnitTests/Distribution/System.hs +29/−0
• tests/UnitTests/Distribution/Utils/NubList.hs +4/−5
• tests/UnitTests/Distribution/Version.hs +711/−0

@@ -1,5 +1,5 @@ name: Cabal-version: 1.22.8.0+version: 1.24.0.0 copyright: 2003-2006, Isaac Jones            2005-2011, Duncan Coutts license: BSD3@@ -20,16 +20,22 @@ category: Distribution cabal-version: >=1.10 build-type: Simple--- Even though we do use the default Setup.lhs it's vital to bootstrapping--- that we build Setup.lhs using our own local Cabal source code.+-- 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/developing-packages.markdown doc/index.markdown+  doc/Cabal.css doc/developing-packages.markdown doc/index.markdown   doc/installing-packages.markdown   doc/misc.markdown -  -- Generated with 'misc/gen-extra-source-files.sh' & 'M-x sort-lines':+  -- Generated with 'misc/gen-extra-source-files.sh'+  -- Do NOT edit this section manually; instead, run the script.+  -- BEGIN gen-extra-source-files+  tests/PackageTests/AllowNewer/AllowNewer.cabal+  tests/PackageTests/AllowNewer/benchmarks/Bench.hs+  tests/PackageTests/AllowNewer/src/Foo.hs+  tests/PackageTests/AllowNewer/tests/Test.hs   tests/PackageTests/BenchmarkExeV10/Foo.hs   tests/PackageTests/BenchmarkExeV10/benchmarks/bench-Foo.hs   tests/PackageTests/BenchmarkExeV10/my.cabal@@ -74,20 +80,46 @@   tests/PackageTests/BuildDeps/TargetSpecificDeps3/MyLibrary.hs   tests/PackageTests/BuildDeps/TargetSpecificDeps3/lemon.hs   tests/PackageTests/BuildDeps/TargetSpecificDeps3/my.cabal-  tests/PackageTests/BuildTestSuiteDetailedV09/Dummy.hs-  tests/PackageTests/BuildTestSuiteDetailedV09/my.cabal+  tests/PackageTests/BuildTestSuiteDetailedV09/Dummy2.hs+  tests/PackageTests/BuildableField/BuildableField.cabal+  tests/PackageTests/BuildableField/Main.hs   tests/PackageTests/CMain/Bar.hs-  tests/PackageTests/CMain/Setup.hs   tests/PackageTests/CMain/foo.c   tests/PackageTests/CMain/my.cabal   tests/PackageTests/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@@ -96,6 +128,9 @@   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@@ -109,17 +144,33 @@   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/TestSuiteExeV10/Foo.hs-  tests/PackageTests/TestSuiteExeV10/my.cabal-  tests/PackageTests/TestSuiteExeV10/tests/test-Foo.hs+  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/hackage/check.sh   tests/hackage/download.sh   tests/hackage/unpack.sh   tests/misc/ghc-supported-languages.hs+  -- END gen-extra-source-files  source-repository head   type:     git@@ -131,16 +182,16 @@  library   build-depends:-    base       >= 4.4 && < 5,-    deepseq    >= 1.3 && < 1.5,-    filepath   >= 1   && < 1.5,-    directory  >= 1   && < 1.3,-    process    >= 1.1.0.1 && < 1.3,-    time       >= 1.1 && < 1.6,-    containers >= 0.1 && < 0.6,     array      >= 0.1 && < 0.6,-    pretty     >= 1   && < 1.2,-    bytestring >= 0.9+    base       >= 4.5 && < 5,+    bytestring >= 0.9 && < 1,+    containers >= 0.4 && < 0.6,+    deepseq    >= 1.3 && < 1.5,+    directory  >= 1.1 && < 1.3,+    filepath   >= 1.3 && < 1.5,+    pretty     >= 1.1 && < 1.2,+    process    >= 1.1.0.1 && < 1.5,+    time       >= 1.4 && < 1.7    if flag(bundled-binary-generic)     build-depends: binary >= 0.5 && < 0.7@@ -153,15 +204,24 @@    if !os(windows)     build-depends:-      unix >= 2.0 && < 2.8+      unix >= 2.5 && < 2.8 +  if os(windows)+    build-depends:+      Win32 >= 2.2 && < 2.4+   ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs+  if impl(ghc >= 8.0)+    ghc-options: -Wcompat -Wnoncanonical-monad-instances+                 -Wnoncanonical-monadfail-instances    exposed-modules:     Distribution.Compat.CreatePipe     Distribution.Compat.Environment     Distribution.Compat.Exception+    Distribution.Compat.Internal.TempFile     Distribution.Compat.ReadP+    Distribution.Compat.Semigroup     Distribution.Compiler     Distribution.InstalledPackageInfo     Distribution.License@@ -208,6 +268,7 @@     Distribution.Simple.Program.GHC     Distribution.Simple.Program.HcPkg     Distribution.Simple.Program.Hpc+    Distribution.Simple.Program.Internal     Distribution.Simple.Program.Ld     Distribution.Simple.Program.Run     Distribution.Simple.Program.Script@@ -230,15 +291,17 @@     Distribution.Verbosity     Distribution.Version     Language.Haskell.Extension+    Distribution.Compat.Binary    other-modules:-    Distribution.Compat.Binary     Distribution.Compat.CopyFile-    Distribution.Compat.TempFile+    Distribution.Compat.GetShortPathName+    Distribution.Compat.MonadFail     Distribution.GetOpt+    Distribution.Lex     Distribution.Simple.GHC.Internal-    Distribution.Simple.GHC.IPI641     Distribution.Simple.GHC.IPI642+    Distribution.Simple.GHC.IPIConvert     Distribution.Simple.GHC.ImplInfo     Paths_Cabal @@ -248,24 +311,30 @@       Distribution.Compat.Binary.Generic    default-language: Haskell98-  default-extensions: CPP  -- Small, fast running tests. test-suite unit-tests   type: exitcode-stdio-1.0   hs-source-dirs: tests   other-modules:+    Test.Laws+    Test.QuickCheck.Utils     UnitTests.Distribution.Compat.CreatePipe     UnitTests.Distribution.Compat.ReadP+    UnitTests.Distribution.Simple.Program.Internal+    UnitTests.Distribution.Simple.Utils+    UnitTests.Distribution.System     UnitTests.Distribution.Utils.NubList+    UnitTests.Distribution.Version   main-is: UnitTests.hs   build-depends:     base,-    test-framework,-    test-framework-hunit,-    test-framework-quickcheck2,-    HUnit,-    QuickCheck < 2.9,+    directory,+    tasty,+    tasty-hunit,+    tasty-quickcheck,+    pretty,+    QuickCheck >= 2.7 && < 2.9,     Cabal   ghc-options: -Wall   default-language: Haskell98@@ -275,54 +344,28 @@   type: exitcode-stdio-1.0   main-is: PackageTests.hs   other-modules:-    PackageTests.BenchmarkExeV10.Check-    PackageTests.BenchmarkOptions.Check     PackageTests.BenchmarkStanza.Check-    PackageTests.BuildDeps.GlobalBuildDepsNotAdditive1.Check-    PackageTests.BuildDeps.GlobalBuildDepsNotAdditive2.Check-    PackageTests.BuildDeps.InternalLibrary0.Check-    PackageTests.BuildDeps.InternalLibrary1.Check-    PackageTests.BuildDeps.InternalLibrary2.Check-    PackageTests.BuildDeps.InternalLibrary3.Check-    PackageTests.BuildDeps.InternalLibrary4.Check-    PackageTests.BuildDeps.SameDepsAllRound.Check-    PackageTests.BuildDeps.TargetSpecificDeps1.Check-    PackageTests.BuildDeps.TargetSpecificDeps2.Check-    PackageTests.BuildDeps.TargetSpecificDeps3.Check-    PackageTests.BuildTestSuiteDetailedV09.Check-    PackageTests.CMain.Check+    PackageTests.TestStanza.Check     PackageTests.DeterministicAr.Check-    PackageTests.EmptyLib.Check-    PackageTests.Haddock.Check-    PackageTests.OrderFlags.Check+    PackageTests.TestSuiteTests.ExeV10.Check     PackageTests.PackageTester-    PackageTests.PathsModule.Executable.Check-    PackageTests.PathsModule.Library.Check-    PackageTests.PreProcess.Check-    PackageTests.ReexportedModules.Check-    PackageTests.TemplateHaskell.Check-    PackageTests.TestOptions.Check-    PackageTests.TestStanza.Check-    PackageTests.TestSuiteExeV10.Check   hs-source-dirs: tests   build-depends:     base,     containers,-    test-framework,-    test-framework-quickcheck2 >= 0.2.12,-    test-framework-hunit,-    HUnit,-    QuickCheck >= 2.1.0.1 && < 2.9,+    tagged,+    tasty,+    tasty-hunit,+    transformers,     Cabal,     process,     directory,     filepath,-    extensible-exceptions,     bytestring,     regex-posix,     old-time   if !os(windows)-    build-depends: unix-  ghc-options: -Wall+    build-depends: unix, exceptions+  ghc-options: -Wall -rtsopts   default-extensions: CPP   default-language: Haskell98

@@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 711+{-# LANGUAGE PatternSynonyms #-}+#endif  #ifndef MIN_VERSION_binary #define MIN_VERSION_binary(x, y, z) 0@@ -14,7 +17,12 @@ #endif        ) where -import Control.Exception (ErrorCall(..), catch, evaluate)+import Control.Exception (catch, evaluate)+#if __GLASGOW_HASKELL__ >= 711+import Control.Exception (pattern ErrorCall)+#else+import Control.Exception (ErrorCall(..))+#endif import Data.ByteString.Lazy (ByteString)  #if __GLASGOW_HASKELL__ < 706

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DefaultSignatures #-} -----------------------------------------------------------------------------@@ -53,13 +53,8 @@  import GHC.Generics ------ This isn't available in older Hugs or older GHC----#if __GLASGOW_HASKELL__ >= 606 import qualified Data.Sequence as Seq import qualified Data.Foldable as Fold-#endif  ------------------------------------------------------------------------ @@ -467,11 +462,6 @@ ------------------------------------------------------------------------ -- Queues and Sequences -#if __GLASGOW_HASKELL__ >= 606------ This is valid Hugs, but you need the most recent Hugs---- instance (Binary e) => Binary (Seq.Seq e) where     put s = put (Seq.length s) >> Fold.mapM_ put s     get = do n <- get :: Get Int@@ -480,8 +470,6 @@             rep xs n g = xs `seq` n `seq` do                            x <- g                            rep (xs Seq.|> x) (n-1) g--#endif  ------------------------------------------------------------------------ -- Floating point

@@ -11,24 +11,22 @@   setDirOrdinary,   ) where +import Distribution.Compat.Exception+import Distribution.Compat.Internal.TempFile  import Control.Monad          ( when, unless ) import Control.Exception-         ( bracket, bracketOnError, throwIO )+         ( bracketOnError, throwIO ) import qualified Data.ByteString.Lazy as BSL-import Distribution.Compat.Exception-         ( catchIO ) import System.IO.Error          ( ioeSetLocation ) import System.Directory          ( doesFileExist, renameFile, removeFile )-import Distribution.Compat.TempFile-         ( openBinaryTempFile ) import System.FilePath          ( takeDirectory ) import System.IO-         ( openBinaryFile, IOMode(ReadMode), hClose, hGetBuf, hPutBuf+         ( IOMode(ReadMode), hClose, hGetBuf, hPutBuf          , withBinaryFile ) import Foreign          ( allocaBytes )@@ -69,7 +67,7 @@ copyFile fromFPath toFPath =   copy     `catchIO` (\ioe -> throwIO (ioeSetLocation ioe "copyFile"))-    where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->+    where copy = withBinaryFile fromFPath ReadMode $ \hFrom ->                  bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->                  do allocaBytes bufferSize $ copyContents hFrom hTmp                     hClose hTmp@@ -100,8 +98,7 @@ filesEqual f1 f2 = do   ex1 <- doesFileExist f1   ex2 <- doesFileExist f2-  if not (ex1 && ex2) then return False else do-+  if not (ex1 && ex2) then return False else     withBinaryFile f1 ReadMode $ \h1 ->       withBinaryFile f2 ReadMode $ \h2 -> do         c1 <- BSL.hGetContents h1

@@ -1,14 +1,29 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-} {-# OPTIONS_HADDOCK hide #-} -module Distribution.Compat.Environment (getEnvironment)+module Distribution.Compat.Environment+       ( getEnvironment, lookupEnv, setEnv )        where  import qualified System.Environment as System+#if __GLASGOW_HASKELL__ >= 706+import System.Environment (lookupEnv)+#else+import Distribution.Compat.Exception (catchIO)+#endif  #ifdef mingw32_HOST_OS+import Control.Monad import qualified Data.Char as Char (toUpper)-#endif+import Foreign.C+import GHC.Windows+#else+import Foreign.C.Types+import Foreign.C.String+import Foreign.C.Error (throwErrnoIfMinus1_)+import System.Posix.Internals ( withFilePath )+#endif /* mingw32_HOST_OS */  getEnvironment :: IO [(String, String)] #ifdef mingw32_HOST_OS@@ -22,3 +37,53 @@ #else getEnvironment = System.getEnvironment #endif++#if __GLASGOW_HASKELL__ < 706+-- | @lookupEnv var@ returns the value of the environment variable @var@, or+-- @Nothing@ if there is no such value.+lookupEnv :: String -> IO (Maybe String)+lookupEnv name = (Just `fmap` System.getEnv name) `catchIO` const (return Nothing)+#endif /* __GLASGOW_HASKELL__ < 706 */++-- | @setEnv name value@ sets the specified environment variable to @value@.+--+-- Throws `Control.Exception.IOException` if either @name@ or @value@ is the+-- empty string or contains an equals sign.+setEnv :: String -> String -> IO ()+setEnv key value_+  | null value = error "Distribuiton.Compat.setEnv: empty string"+  | otherwise  = setEnv_ key value+  where+    -- NOTE: Anything that follows NUL is ignored on both POSIX and Windows. We+    -- still strip it manually so that the null check above succeeds if a value+    -- starts with NUL.+    value = takeWhile (/= '\NUL') value_++setEnv_ :: String -> String -> IO ()++#ifdef mingw32_HOST_OS++setEnv_ key value = withCWString key $ \k -> withCWString value $ \v -> do+  success <- c_SetEnvironmentVariable k v+  unless success (throwGetLastError "setEnv")++# if defined(i386_HOST_ARCH)+#  define WINDOWS_CCONV stdcall+# elif defined(x86_64_HOST_ARCH)+#  define WINDOWS_CCONV ccall+# else+#  error Unknown mingw32 arch+# endif /* i386_HOST_ARCH */++foreign import WINDOWS_CCONV unsafe "windows.h SetEnvironmentVariableW"+  c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> IO Bool+#else+setEnv_ key value = do+  withFilePath key $ \ keyP ->+    withFilePath value $ \ valueP ->+      throwErrnoIfMinus1_ "setenv" $+        c_setenv keyP valueP (fromIntegral (fromEnum True))++foreign import ccall unsafe "setenv"+   c_setenv :: CString -> CString -> CInt -> IO CInt+#endif /* mingw32_HOST_OS */

@@ -0,0 +1,49 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Compat.GetShortPathName+--+-- Maintainer  :  cabal-devel@haskell.org+-- Portability :  Windows-only+--+-- Win32 API 'GetShortPathName' function.++module Distribution.Compat.GetShortPathName ( getShortPathName )+    where++#ifdef mingw32_HOST_OS+import Control.Monad         (void)++import qualified System.Win32 as Win32+import System.Win32          (LPCTSTR, LPTSTR, DWORD)+import Foreign.Marshal.Array (allocaArray)++#ifdef x86_64_HOST_ARCH+#define WINAPI ccall+#else+#define WINAPI stdcall+#endif++foreign import WINAPI unsafe "windows.h GetShortPathNameW"+  c_GetShortPathName :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD++-- | On Windows, retrieves the short path form of the specified path. On+-- non-Windows, does nothing. See https://github.com/haskell/cabal/issues/3185.+getShortPathName :: FilePath -> IO FilePath+getShortPathName path =+  Win32.withTString path $ \c_path ->+    allocaArray arr_len $ \c_out -> do+      void $ Win32.failIfZero "GetShortPathName failed!" $+        c_GetShortPathName c_path c_out c_len+      Win32.peekTString c_out+  where+    arr_len = length path + 1+    c_len   = fromIntegral arr_len++#else++getShortPathName :: FilePath -> IO FilePath+getShortPathName path = return path++#endif

@@ -0,0 +1,124 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}+module Distribution.Compat.Internal.TempFile (+  openTempFile,+  openBinaryTempFile,+  openNewBinaryFile,+  createTempDirectory,+  ) where++import Distribution.Compat.Exception++import System.FilePath        ((</>))+import Foreign.C              (CInt, eEXIST, getErrno, errnoToIOError)++import System.IO              (Handle, openTempFile, openBinaryTempFile)+import Data.Bits              ((.|.))+import System.Posix.Internals (c_open, c_close, o_CREAT, o_EXCL, o_RDWR,+                               o_BINARY, o_NONBLOCK, o_NOCTTY,+                               withFilePath, c_getpid)+import System.IO.Error        (isAlreadyExistsError)+import GHC.IO.Handle.FD       (fdToHandle)+import Control.Exception      (onException)++#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS)+import System.Directory       ( createDirectory )+#else+import qualified System.Posix+#endif++-- ------------------------------------------------------------+-- * temporary files+-- ------------------------------------------------------------++-- This is here for Haskell implementations that do not come with+-- System.IO.openTempFile. This includes nhc-1.20, hugs-2006.9.+-- TODO: Not sure about JHC+-- TODO: This file should probably be removed.++-- This is a copy/paste of the openBinaryTempFile definition, but+-- if uses 666 rather than 600 for the permissions. The base library+-- needs to be changed to make this better.+openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)+openNewBinaryFile dir template = do+  pid <- c_getpid+  findTempName pid+  where+    -- We split off the last extension, so we can use .foo.ext files+    -- for temporary files (hidden on Unix OSes). Unfortunately we're+    -- below file path in the hierarchy here.+    (prefix,suffix) =+       case break (== '.') $ reverse template of+         -- First case: template contains no '.'s. Just re-reverse it.+         (rev_suffix, "")       -> (reverse rev_suffix, "")+         -- Second case: template contains at least one '.'. Strip the+         -- dot from the prefix and prepend it to the suffix (if we don't+         -- do this, the unique number will get added after the '.' and+         -- thus be part of the extension, which is wrong.)+         (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)+         -- Otherwise, something is wrong, because (break (== '.')) should+         -- always return a pair with either the empty string or a string+         -- beginning with '.' as the second component.+         _                      -> error "bug in System.IO.openTempFile"++    oflags = rw_flags .|. o_EXCL .|. o_BINARY++    findTempName x = do+      fd <- withFilePath filepath $ \ f ->+              c_open f oflags 0o666+      if fd < 0+       then do+         errno <- getErrno+         if errno == eEXIST+           then findTempName (x+1)+           else ioError (errnoToIOError "openNewBinaryFile" errno Nothing (Just dir))+       else do+         -- TODO: We want to tell fdToHandle what the file path is,+         -- as any exceptions etc will only be able to report the+         -- FD currently+         h <- fdToHandle fd `onException` c_close fd+         return (filepath, h)+      where+        filename        = prefix ++ show x ++ suffix+        filepath        = dir `combine` filename++        -- FIXME: bits copied from System.FilePath+        combine a b+                  | null b = a+                  | null a = b+                  | last a == pathSeparator = a ++ b+                  | otherwise = a ++ [pathSeparator] ++ b++-- FIXME: Should use System.FilePath library+pathSeparator :: Char+#ifdef mingw32_HOST_OS+pathSeparator = '\\'+#else+pathSeparator = '/'+#endif++-- FIXME: Copied from GHC.Handle+std_flags, output_flags, rw_flags :: CInt+std_flags    = o_NONBLOCK   .|. o_NOCTTY+output_flags = std_flags    .|. o_CREAT+rw_flags     = output_flags .|. o_RDWR++createTempDirectory :: FilePath -> String -> IO FilePath+createTempDirectory dir template = do+  pid <- c_getpid+  findTempName pid+  where+    findTempName x = do+      let dirpath = dir </> template ++ "-" ++ show x+      r <- tryIO $ mkPrivateDir dirpath+      case r of+        Right _ -> return dirpath+        Left  e | isAlreadyExistsError e -> findTempName (x+1)+                | otherwise              -> ioError e++mkPrivateDir :: String -> IO ()+#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS)+mkPrivateDir s = createDirectory s+#else+mkPrivateDir s = System.Posix.createDirectory s 0o700+#endif

@@ -0,0 +1,36 @@+{-# LANGUAGE CPP #-}++-- | Compatibility layer for "Control.Monad.Fail"+module Distribution.Compat.MonadFail ( MonadFail(fail) ) where+#if __GLASGOW_HASKELL__ >= 800+-- provided by base-4.9.0.0 and later+import Control.Monad.Fail (MonadFail(fail))+#else+-- the following code corresponds to+-- http://hackage.haskell.org/package/fail-4.9.0.0+import qualified Prelude as P+import Prelude hiding (fail)++import Text.ParserCombinators.ReadP+import Text.ParserCombinators.ReadPrec++class Monad m => MonadFail m where+    fail :: String -> m a++-- instances provided by base-4.9++instance MonadFail Maybe where+    fail _ = Nothing++instance MonadFail [] where+    fail _ = []++instance MonadFail IO where+    fail = P.fail++instance MonadFail ReadPrec where+    fail = P.fail -- = P (\_ -> fail s)++instance MonadFail ReadP where+    fail = P.fail+#endif

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  Distribution.Compat.ReadP@@ -70,12 +69,11 @@   )  where -import Control.Monad( MonadPlus(..), liftM, liftM2, ap )+import qualified Distribution.Compat.MonadFail as Fail++import Control.Monad( MonadPlus(..), liftM, liftM2, replicateM, ap, (>=>) ) import Data.Char (isSpace)-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative (Applicative(..))-#endif-import Control.Applicative (Alternative(empty, (<|>)))+import Control.Applicative as AP (Applicative(..), Alternative(empty, (<|>)))  infixr 5 +++, <++ @@ -96,18 +94,21 @@   fmap = liftM  instance Applicative (P s) where-  pure = return+  pure x = Result x Fail   (<*>) = ap  instance Monad (P s) where-  return x = Result x Fail+  return = AP.pure -  (Get f)      >>= k = Get (\c -> f c >>= k)-  (Look f)     >>= k = Look (\s -> f s >>= k)+  (Get f)      >>= k = Get (f >=> k)+  (Look f)     >>= k = Look (f >=> k)   Fail         >>= _ = Fail   (Result x p) >>= k = k x `mplus` (p >>= k)   (Final r)    >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s] +  fail = Fail.fail++instance Fail.MonadFail (P s) where   fail _ = Fail  instance Alternative (P s) where@@ -155,14 +156,17 @@   fmap h (R f) = R (\k -> f (k . h))  instance Applicative (Parser r s) where-  pure = return+  pure x  = R (\k -> k x)   (<*>) = ap  instance Monad (Parser r s) where-  return x  = R (\k -> k x)-  fail _    = R (\_ -> Fail)+  return = AP.pure+  fail = Fail.fail   R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k)) +instance Fail.MonadFail (Parser r s) where+  fail _    = R (const Fail)+ --instance MonadPlus (Parser r s) where --  mzero = pfail --  mplus = (+++)@@ -197,7 +201,7 @@  pfail :: ReadP r a -- ^ Always fails.-pfail = R (\_ -> Fail)+pfail = R (const Fail)  (+++) :: ReadP r a -> ReadP r a -> ReadP r a -- ^ Symmetric choice.@@ -230,7 +234,7 @@  where   gath l (Get f)      = Get (\c -> gath (l.(c:)) (f c))   gath _ Fail         = Fail-  gath l (Look f)     = Look (\s -> gath l (f s))+  gath l (Look f)     = Look (gath l . f)   gath l (Result k p) = k (l []) `mplus` gath l p   gath _ (Final _)    = error "do not use readS_to_P in gather!" @@ -250,9 +254,9 @@ -- ^ Parses and returns the specified string. string this = do s <- look; scan this s  where-  scan []     _               = do return this-  scan (x:xs) (y:ys) | x == y = do get >> scan xs ys-  scan _      _               = do pfail+  scan []     _               = return this+  scan (x:xs) (y:ys) | x == y = get >> scan xs ys+  scan _      _               = pfail  munch :: (Char -> Bool) -> ReadP r String -- ^ Parses the first zero or more characters satisfying the predicate.@@ -288,7 +292,7 @@ count :: Int -> ReadP r a -> ReadP r [a] -- ^ @ count n p @ parses @n@ occurrences of @p@ in sequence. A list of --   results is returned.-count n p = sequence (replicate n p)+count n p = replicateM n p  between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r a -- ^ @ between open close p @ parses @open@, followed by @p@ and finally

@@ -0,0 +1,171 @@+{-# LANGUAGE CPP                         #-}+{-# LANGUAGE DeriveGeneric               #-}+{-# LANGUAGE FlexibleContexts            #-}+{-# LANGUAGE GeneralizedNewtypeDeriving  #-}+{-# LANGUAGE TypeOperators               #-}++-- | Compatibility layer for "Data.Semigroup"+module Distribution.Compat.Semigroup+    ( Semigroup((<>))+    , Mon.Monoid(..)+    , All(..)+    , Any(..)++    , Last'(..)++    , gmappend+    , gmempty+    ) where++import Distribution.Compat.Binary (Binary)++import Control.Applicative as App+import GHC.Generics+#if __GLASGOW_HASKELL__ >= 711+-- Data.Semigroup is available since GHC 8.0/base-4.9+import Data.Semigroup+import qualified Data.Monoid as Mon+#else+-- provide internal simplified non-exposed class for older GHCs+import Data.Monoid as Mon (Monoid(..), All(..), Any(..), Dual(..))+-- containers+import Data.Set (Set)+import Data.IntSet (IntSet)+import Data.Map (Map)+import Data.IntMap (IntMap)+++class Semigroup a where+    (<>) :: a -> a -> a++-- several primitive instances+instance Semigroup () where+    _ <> _ = ()++instance Semigroup [a] where+    (<>) = (++)++instance Semigroup a => Semigroup (Dual a) where+    Dual a <> Dual b = Dual (b <> a)++instance Semigroup a => Semigroup (Maybe a) where+    Nothing <> b       = b+    a       <> Nothing = a+    Just a  <> Just b  = Just (a <> b)++instance Semigroup (Either a b) where+    Left _ <> b = b+    a      <> _ = a++instance Semigroup Ordering where+    LT <> _ = LT+    EQ <> y = y+    GT <> _ = GT++instance Semigroup b => Semigroup (a -> b) where+    f <> g = \a -> f a <> g a++instance Semigroup All where+    All a <> All b = All (a && b)++instance Semigroup Any where+    Any a <> Any b = Any (a || b)++instance (Semigroup a, Semigroup b) => Semigroup (a, b) where+    (a,b) <> (a',b') = (a<>a',b<>b')++instance (Semigroup a, Semigroup b, Semigroup c)+         => Semigroup (a, b, c) where+    (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')++instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)+         => Semigroup (a, b, c, d) where+    (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')++instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)+         => Semigroup (a, b, c, d, e) where+    (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')++-- containers instances+instance Semigroup IntSet where+  (<>) = mappend++instance Ord a => Semigroup (Set a) where+  (<>) = mappend++instance Semigroup (IntMap v) where+  (<>) = mappend++instance Ord k => Semigroup (Map k v) where+  (<>) = mappend+#endif++-- | Cabal's own 'Data.Monoid.Last' copy to avoid requiring an orphan+-- 'Binary' instance.+--+-- Once the oldest `binary` version we support provides a 'Binary'+-- instance for 'Data.Monoid.Last' we can remove this one here.+--+-- NB: 'Data.Semigroup.Last' is defined differently and not a 'Monoid'+newtype Last' a = Last' { getLast' :: Maybe a }+                deriving (Eq, Ord, Read, Show, Binary,+                          Functor, App.Applicative, Generic)++instance Semigroup (Last' a) where+    x <> Last' Nothing = x+    _ <> x             = x++instance Monoid (Last' a) where+    mempty = Last' Nothing+    mappend = (<>)++-------------------------------------------------------------------------------+-------------------------------------------------------------------------------+-- Stolen from Edward Kmett's BSD3-licensed `semigroups` package++-- | Generically generate a 'Semigroup' ('<>') operation for any type+-- implementing 'Generic'. This operation will append two values+-- by point-wise appending their component fields. It is only defined+-- for product types.+--+-- @+-- 'gmappend' a ('gmappend' b c) = 'gmappend' ('gmappend' a b) c+-- @+gmappend :: (Generic a, GSemigroup (Rep a)) => a -> a -> a+gmappend x y = to (gmappend' (from x) (from y))++class GSemigroup f where+    gmappend' :: f p -> f p -> f p++instance Semigroup a => GSemigroup (K1 i a) where+    gmappend' (K1 x) (K1 y) = K1 (x <> y)++instance GSemigroup f => GSemigroup (M1 i c f) where+    gmappend' (M1 x) (M1 y) = M1 (gmappend' x y)++instance (GSemigroup f, GSemigroup g) => GSemigroup (f :*: g) where+    gmappend' (x1 :*: x2) (y1 :*: y2) = gmappend' x1 y1 :*: gmappend' x2 y2++-- | Generically generate a 'Monoid' 'mempty' for any product-like type+-- implementing 'Generic'.+--+-- It is only defined for product types.+--+-- @+-- 'gmappend' 'gmempty' a = a = 'gmappend' a 'gmempty'+-- @++gmempty :: (Generic a, GMonoid (Rep a)) => a+gmempty = to gmempty'++class GSemigroup f => GMonoid f where+    gmempty' :: f p++instance (Semigroup a, Monoid a) => GMonoid (K1 i a) where+    gmempty' = K1 mempty++instance GMonoid f => GMonoid (M1 i c f) where+    gmempty' = M1 gmempty'++instance (GMonoid f, GMonoid g) => GMonoid (f :*: g) where+    gmempty' = gmempty' :*: gmempty'

@@ -1,128 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_HADDOCK hide #-}-module Distribution.Compat.TempFile (-  openTempFile,-  openBinaryTempFile,-  openNewBinaryFile,-  createTempDirectory,-  ) where---import System.FilePath        ((</>))-import Foreign.C              (eEXIST)--import System.IO              (Handle, openTempFile, openBinaryTempFile)-import Data.Bits              ((.|.))-import System.Posix.Internals (c_open, c_close, o_CREAT, o_EXCL, o_RDWR,-                               o_BINARY, o_NONBLOCK, o_NOCTTY)-import System.IO.Error        (isAlreadyExistsError)-import System.Posix.Internals (withFilePath)-import Foreign.C              (CInt)-import GHC.IO.Handle.FD       (fdToHandle)-import Distribution.Compat.Exception (tryIO)-import Control.Exception      (onException)-import Foreign.C              (getErrno, errnoToIOError)--import System.Posix.Internals (c_getpid)--#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS)-import System.Directory       ( createDirectory )-#else-import qualified System.Posix-#endif---- --------------------------------------------------------------- * temporary files--- ---------------------------------------------------------------- This is here for Haskell implementations that do not come with--- System.IO.openTempFile. This includes nhc-1.20, hugs-2006.9.--- TODO: Not sure about JHC--- TODO: This file should probably be removed.---- This is a copy/paste of the openBinaryTempFile definition, but--- if uses 666 rather than 600 for the permissions. The base library--- needs to be changed to make this better.-openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)-openNewBinaryFile dir template = do-  pid <- c_getpid-  findTempName pid-  where-    -- We split off the last extension, so we can use .foo.ext files-    -- for temporary files (hidden on Unix OSes). Unfortunately we're-    -- below file path in the hierarchy here.-    (prefix,suffix) =-       case break (== '.') $ reverse template of-         -- First case: template contains no '.'s. Just re-reverse it.-         (rev_suffix, "")       -> (reverse rev_suffix, "")-         -- Second case: template contains at least one '.'. Strip the-         -- dot from the prefix and prepend it to the suffix (if we don't-         -- do this, the unique number will get added after the '.' and-         -- thus be part of the extension, which is wrong.)-         (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)-         -- Otherwise, something is wrong, because (break (== '.')) should-         -- always return a pair with either the empty string or a string-         -- beginning with '.' as the second component.-         _                      -> error "bug in System.IO.openTempFile"--    oflags = rw_flags .|. o_EXCL .|. o_BINARY--    findTempName x = do-      fd <- withFilePath filepath $ \ f ->-              c_open f oflags 0o666-      if fd < 0-       then do-         errno <- getErrno-         if errno == eEXIST-           then findTempName (x+1)-           else ioError (errnoToIOError "openNewBinaryFile" errno Nothing (Just dir))-       else do-         -- TODO: We want to tell fdToHandle what the file path is,-         -- as any exceptions etc will only be able to report the-         -- FD currently-         h <- fdToHandle fd `onException` c_close fd-         return (filepath, h)-      where-        filename        = prefix ++ show x ++ suffix-        filepath        = dir `combine` filename--        -- FIXME: bits copied from System.FilePath-        combine a b-                  | null b = a-                  | null a = b-                  | last a == pathSeparator = a ++ b-                  | otherwise = a ++ [pathSeparator] ++ b---- FIXME: Should use System.FilePath library-pathSeparator :: Char-#ifdef mingw32_HOST_OS-pathSeparator = '\\'-#else-pathSeparator = '/'-#endif---- FIXME: Copied from GHC.Handle-std_flags, output_flags, rw_flags :: CInt-std_flags    = o_NONBLOCK   .|. o_NOCTTY-output_flags = std_flags    .|. o_CREAT-rw_flags     = output_flags .|. o_RDWR--createTempDirectory :: FilePath -> String -> IO FilePath-createTempDirectory dir template = do-  pid <- c_getpid-  findTempName pid-  where-    findTempName x = do-      let dirpath = dir </> template ++ "-" ++ show x-      r <- tryIO $ mkPrivateDir dirpath-      case r of-        Right _ -> return dirpath-        Left  e | isAlreadyExistsError e -> findTempName (x+1)-                | otherwise              -> ioError e--mkPrivateDir :: String -> IO ()-#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS)-mkPrivateDir s = createDirectory s-#else-mkPrivateDir s = System.Posix.createDirectory s 0o700-#endif

@@ -42,15 +42,15 @@   AbiTag(..), abiTagString   ) where -import Distribution.Compat.Binary (Binary)+import Distribution.Compat.Binary+import Language.Haskell.Extension+ import Data.Data (Data) import Data.Typeable (Typeable) import Data.Maybe (fromMaybe) import Distribution.Version (Version(..)) import GHC.Generics (Generic) -import Language.Haskell.Extension (Language, Extension)- import qualified System.Info (compilerName, compilerVersion) import Distribution.Text (Text(..), display) import qualified Distribution.Compat.ReadP as Parse@@ -180,7 +180,7 @@ data AbiTag   = NoAbiTag   | AbiTag String-  deriving (Generic, Show, Read)+  deriving (Eq, Generic, Show, Read)  instance Binary AbiTag 

@@ -27,7 +27,9 @@ -- This module is meant to be local-only to Distribution...  module Distribution.InstalledPackageInfo (-        InstalledPackageInfo_(..), InstalledPackageInfo,+        InstalledPackageInfo(..),+        installedComponentId,+        installedPackageId,         OriginalModule(..), ExposedModule(..),         ParseResult(..), PError(..), PWarning,         emptyInstalledPackageInfo,@@ -39,42 +41,30 @@   ) where  import Distribution.ParseUtils-         ( FieldDescr(..), ParseResult(..), PError(..), PWarning-         , simpleField, listField, parseLicenseQ-         , showFields, showSingleNamedField, showSimpleSingleNamedField-         , parseFieldsFlat-         , parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ-         , showFilePath, showToken, boolField, parseOptVersion-         , parseFreeText, showFreeText, parseOptCommaList )-import Distribution.License     ( License(..) )-import Distribution.Package-         ( PackageName(..), PackageIdentifier(..)-         , PackageId, InstalledPackageId(..)-         , packageName, packageVersion, PackageKey(..) )+import Distribution.License+import Distribution.Package hiding (installedUnitId, installedPackageId) import qualified Distribution.Package as Package import Distribution.ModuleName-         ( ModuleName ) import Distribution.Version-         ( Version(..) ) import Distribution.Text-         ( Text(disp, parse) )-import Text.PrettyPrint as Disp import qualified Distribution.Compat.ReadP as Parse+import Distribution.Compat.Binary -import Distribution.Compat.Binary  (Binary)+import Text.PrettyPrint as Disp import Data.Maybe   (fromMaybe) import GHC.Generics (Generic)  -- ----------------------------------------------------------------------------- -- The InstalledPackageInfo type --data InstalledPackageInfo_ m+-- For BC reasons, we continue to name this record an InstalledPackageInfo;+-- but it would more accurately be called an InstalledUnitInfo with Backpack+data InstalledPackageInfo    = InstalledPackageInfo {         -- these parts are exactly the same as PackageDescription-        installedPackageId :: InstalledPackageId,-        sourcePackageId    :: PackageId,-        packageKey         :: PackageKey,+        sourcePackageId   :: PackageId,+        installedUnitId   :: UnitId,+        compatPackageKey  :: String,         license           :: License,         copyright         :: String,         maintainer        :: String,@@ -86,10 +76,10 @@         description       :: String,         category          :: String,         -- these parts are required by an installed package only:+        abiHash           :: AbiHash,         exposed           :: Bool,         exposedModules    :: [ExposedModule],-        instantiatedWith  :: [(m, OriginalModule)],-        hiddenModules     :: [m],+        hiddenModules     :: [ModuleName],         trusted           :: Bool,         importDirs        :: [FilePath],         libraryDirs       :: [FilePath],@@ -99,7 +89,7 @@         extraGHCiLibraries:: [String],    -- overrides extraLibraries for GHCi         includeDirs       :: [FilePath],         includes          :: [String],-        depends           :: [InstalledPackageId],+        depends           :: [UnitId],         ccOptions         :: [String],         ldOptions         :: [String],         frameworkDirs     :: [FilePath],@@ -108,26 +98,34 @@         haddockHTMLs      :: [FilePath],         pkgRoot           :: Maybe FilePath     }-    deriving (Generic, Read, Show)+    deriving (Eq, Generic, Read, Show) -instance Binary m => Binary (InstalledPackageInfo_ m)+installedComponentId :: InstalledPackageInfo -> ComponentId+installedComponentId ipi = case installedUnitId ipi of+                            SimpleUnitId cid -> cid -instance Package.Package          (InstalledPackageInfo_ str) where+{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}+-- | Backwards compatibility with Cabal pre-1.24.+installedPackageId :: InstalledPackageInfo -> UnitId+installedPackageId = installedUnitId++instance Binary InstalledPackageInfo++instance Package.Package InstalledPackageInfo where    packageId = sourcePackageId -instance Package.PackageInstalled (InstalledPackageInfo_ str) where-   installedPackageId = installedPackageId-   installedDepends = depends+instance Package.HasUnitId InstalledPackageInfo where+   installedUnitId = installedUnitId -type InstalledPackageInfo = InstalledPackageInfo_ ModuleName+instance Package.PackageInstalled InstalledPackageInfo where+   installedDepends = depends -emptyInstalledPackageInfo :: InstalledPackageInfo_ m+emptyInstalledPackageInfo :: InstalledPackageInfo emptyInstalledPackageInfo    = InstalledPackageInfo {-        installedPackageId = InstalledPackageId "",-        sourcePackageId    = PackageIdentifier (PackageName "") noVersion,-        packageKey         = OldPackageKey (PackageIdentifier-                                               (PackageName "") noVersion),+        sourcePackageId   = PackageIdentifier (PackageName "") (Version [] []),+        installedUnitId   = mkUnitId "",+        compatPackageKey  = "",         license           = UnspecifiedLicense,         copyright         = "",         maintainer        = "",@@ -138,10 +136,10 @@         synopsis          = "",         description       = "",         category          = "",+        abiHash           = AbiHash "",         exposed           = False,         exposedModules    = [],         hiddenModules     = [],-        instantiatedWith  = [],         trusted           = False,         importDirs        = [],         libraryDirs       = [],@@ -161,15 +159,12 @@         pkgRoot           = Nothing     } -noVersion :: Version-noVersion = Version [] []- -- ----------------------------------------------------------------------------- -- Exposed modules  data OriginalModule    = OriginalModule {-       originalPackageId :: InstalledPackageId,+       originalPackageId  :: UnitId,        originalModuleName :: ModuleName      }   deriving (Generic, Eq, Read, Show)@@ -177,10 +172,9 @@ data ExposedModule    = ExposedModule {        exposedName      :: ModuleName,-       exposedReexport  :: Maybe OriginalModule,-       exposedSignature :: Maybe OriginalModule -- This field is unused for now.+       exposedReexport  :: Maybe OriginalModule      }-  deriving (Generic, Read, Show)+  deriving (Eq, Generic, Read, Show)  instance Text OriginalModule where     disp (OriginalModule ipi m) =@@ -192,14 +186,11 @@         return (OriginalModule ipi m)  instance Text ExposedModule where-    disp (ExposedModule m reexport signature) =+    disp (ExposedModule m reexport) =         Disp.sep [ disp m                  , case reexport of                     Just m' -> Disp.sep [Disp.text "from", disp m']                     Nothing -> Disp.empty-                 , case signature of-                    Just m' -> Disp.sep [Disp.text "is", disp m']-                    Nothing -> Disp.empty                  ]     parse = do         m <- parseModuleNameQ@@ -208,12 +199,7 @@             _ <- Parse.string "from"             Parse.skipSpaces             fmap Just parse-        Parse.skipSpaces-        signature <- Parse.option Nothing $ do-            _ <- Parse.string "is"-            Parse.skipSpaces-            fmap Just parse-        return (ExposedModule m reexport signature)+        return (ExposedModule m reexport)   instance Binary OriginalModule@@ -229,7 +215,7 @@ showExposedModules xs     | all isExposedModule xs = fsep (map disp xs)     | otherwise = fsep (Disp.punctuate comma (map disp xs))-    where isExposedModule (ExposedModule _ Nothing Nothing) = True+    where isExposedModule (ExposedModule _ Nothing) = True           isExposedModule _ = False  parseExposedModules :: Parse.ReadP r [ExposedModule]@@ -243,14 +229,6 @@     parseFieldsFlat (fieldsInstalledPackageInfo ++ deprecatedFieldDescrs)     emptyInstalledPackageInfo -parseInstantiatedWith :: Parse.ReadP r (ModuleName, OriginalModule)-parseInstantiatedWith = do k <- parse-                           _ <- Parse.char '='-                           n <- parse-                           _ <- Parse.char '@'-                           p <- parse-                           return (k, OriginalModule p n)- -- ----------------------------------------------------------------------------- -- Pretty-printing @@ -263,9 +241,6 @@ showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) showSimpleInstalledPackageInfoField = showSimpleSingleNamedField fieldsInstalledPackageInfo -showInstantiatedWith :: (ModuleName, OriginalModule) -> Doc-showInstantiatedWith (k, OriginalModule p m) = disp k <> text "=" <> disp m <> text "@" <> disp p- -- ----------------------------------------------------------------------------- -- Description of the fields, for parsing/printing @@ -282,10 +257,11 @@                            packageVersion         (\ver pkg -> pkg{sourcePackageId=(sourcePackageId pkg){pkgVersion=ver}})  , simpleField "id"                            disp                   parse-                           installedPackageId     (\ipid pkg -> pkg{installedPackageId=ipid})+                           installedUnitId             (\pk pkg -> pkg{installedUnitId=pk})+ -- NB: parse these as component IDs  , simpleField "key"-                           disp                   parse-                           packageKey             (\ipid pkg -> pkg{packageKey=ipid})+                           (disp . ComponentId)   (fmap (\(ComponentId s) -> s) parse)+                           compatPackageKey       (\pk pkg -> pkg{compatPackageKey=pk})  , simpleField "license"                            disp                   parseLicenseQ                            license                (\l pkg -> pkg{license=l})@@ -328,9 +304,9 @@  , listField   "hidden-modules"         disp               parseModuleNameQ         hiddenModules      (\xs    pkg -> pkg{hiddenModules=xs})- , listField   "instantiated-with"-        showInstantiatedWith parseInstantiatedWith-        instantiatedWith   (\xs    pkg -> pkg{instantiatedWith=xs})+ , simpleField "abi"+        disp               parse+        abiHash            (\abi    pkg -> pkg{abiHash=abi})  , boolField   "trusted"         trusted            (\val pkg -> pkg{trusted=val})  , listField   "import-dirs"

@@ -0,0 +1,55 @@+{-# LANGUAGE PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Lex+-- Copyright   :  Ben Gamari 2015-2019+--+-- Maintainer  :  cabal-devel@haskell.org+-- Portability :  portable+--+-- This module contains a simple lexer supporting quoted strings++module Distribution.Lex (+        tokenizeQuotedWords+ ) where++import Data.Char (isSpace)+import Distribution.Compat.Semigroup as Semi++newtype DList a = DList ([a] -> [a])++runDList :: DList a -> [a]+runDList (DList run) = run []++singleton :: a -> DList a+singleton a = DList (a:)++instance Monoid (DList a) where+  mempty = DList id+  mappend = (Semi.<>)++instance Semigroup (DList a) where+  DList a <> DList b = DList (a . b)++tokenizeQuotedWords :: String -> [String]+tokenizeQuotedWords = filter (not . null) . go False mempty+  where+    go :: Bool        -- ^ in quoted region+       -> DList Char  -- ^ accumulator+       -> String      -- ^ string to be parsed+       -> [String]    -- ^ parse result+    go _ accum []+      | [] <- accum' = []+      | otherwise    = [accum']+      where accum' = runDList accum++    go False  accum (c:cs)+      | isSpace c = runDList accum : go False mempty cs+      | c == '"'  = go True accum cs++    go True   accum (c:cs)+      | c == '"'  = go False accum cs++    go quoted accum (c:cs)+                  = go quoted (accum `mappend` singleton c) cs+

@@ -47,13 +47,13 @@     knownLicenses,   ) where -import Distribution.Version (Version(Version))--import Distribution.Text (Text(..), display)+import Distribution.Version+import Distribution.Text import qualified Distribution.Compat.ReadP as Parse+import Distribution.Compat.Binary+ import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ((<>))-import Distribution.Compat.Binary (Binary) import qualified Data.Char as Char (isAlphaNum) import Data.Data (Data) import Data.Typeable (Typeable)

@@ -62,22 +62,19 @@  -- local import Distribution.Compat.Exception-import Distribution.Package --must not specify imports, since we're exporting moule.-import Distribution.Simple.Program(defaultProgramConfiguration)+import Distribution.Package+import Distribution.Simple.Program import Distribution.PackageDescription import Distribution.Simple.Setup import Distribution.Simple.Command -import Distribution.Simple.Utils (rawSystemExit, cabalVersion)+import Distribution.Simple.Utils -import Distribution.License (License(..))+import Distribution.License import Distribution.Version-         ( Version(..) ) import Distribution.Text-         ( display )  import System.Environment (getArgs, getProgName)-import Data.List  (intercalate) import System.Exit  defaultMain :: IO ()

@@ -22,14 +22,13 @@   ) where  import Distribution.Text-         ( Text(..) )+import Distribution.Compat.Binary+import qualified Distribution.Compat.ReadP as Parse -import Distribution.Compat.Binary (Binary) import qualified Data.Char as Char          ( isAlphaNum, isUpper ) import Data.Data (Data) import Data.Typeable (Typeable)-import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp import Data.List          ( intercalate, intersperse )

@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}  ----------------------------------------------------------------------------- -- |@@ -21,14 +22,16 @@         PackageIdentifier(..),         PackageId, -        -- * Installed package identifiers-        InstalledPackageId(..),+        -- * Package keys/installed package IDs (used for linker symbols)+        ComponentId(..),+        UnitId(..),+        mkUnitId,+        mkLegacyUnitId,+        getHSLibraryName,+        InstalledPackageId, -- backwards compat -        -- * Package keys (used for linker symbols and library name)-        PackageKey(..),-        mkPackageKey,-        packageKeyHash,-        packageKeyLibraryName,+        -- * ABI hash+        AbiHash(..),          -- * Package source dependencies         Dependency(..),@@ -38,32 +41,28 @@          -- * Package classes         Package(..), packageName, packageVersion,-        PackageFixedDeps(..),+        HasUnitId(..),+        installedPackageId,         PackageInstalled(..),   ) where -import Distribution.ModuleName ( ModuleName ) import Distribution.Version          ( Version(..), VersionRange, anyVersion, thisVersion          , notThisVersion, simplifyVersionRange ) -import Distribution.Text (Text(..), display) import qualified Distribution.Compat.ReadP as Parse-import Distribution.Compat.ReadP ((<++)) import qualified Text.PrettyPrint as Disp+import Distribution.Compat.ReadP+import Distribution.Compat.Binary+import Distribution.Text  import Control.DeepSeq (NFData(..))-import Data.Ord ( comparing )-import Distribution.Compat.Binary (Binary) import qualified Data.Char as Char-    ( isDigit, isAlphaNum, isUpper, isLower, ord, chr )+    ( isDigit, isAlphaNum, ) import Data.Data ( Data )-import Data.List ( intercalate, foldl', sortBy )+import Data.List ( intercalate ) import Data.Typeable ( Typeable )-import Data.Word ( Word64 )-import GHC.Fingerprint ( Fingerprint(..), fingerprintString ) import GHC.Generics (Generic)-import Numeric ( showIntAtBase ) import Text.PrettyPrint ((<>), (<+>), text)  newtype PackageName = PackageName { unPackageName :: String }@@ -113,192 +112,47 @@     rnf (PackageIdentifier name version) = rnf name `seq` rnf version  -- --------------------------------------------------------------- * Installed Package Ids--- ---------------------------------------------------------------- | An InstalledPackageId uniquely identifies an instance of an installed--- package.  There can be at most one package with a given 'InstalledPackageId'--- in a package database, or overlay of databases.----newtype InstalledPackageId = InstalledPackageId String- deriving (Generic, Read,Show,Eq,Ord,Typeable,Data)--instance Binary InstalledPackageId--instance Text InstalledPackageId where-  disp (InstalledPackageId str) = text str--  parse = InstalledPackageId `fmap` Parse.munch1 abi_char-   where abi_char c = Char.isAlphaNum c || c `elem` "-_."---- --------------------------------------------------------------- * Package Keys+-- * Component Source Hash -- ------------------------------------------------------------ --- | A 'PackageKey' is the notion of "package ID" which is visible to the--- compiler. Why is this not a 'PackageId'? The 'PackageId' is a user-visible--- concept written explicity in Cabal files; on the other hand, a 'PackageKey'--- may contain, for example, information about the transitive dependency--- tree of a package.  Why is this not an 'InstalledPackageId'?  A 'PackageKey'--- affects the ABI because it is used for linker symbols; however, an--- 'InstalledPackageId' can be used to distinguish two ABI-compatible versions--- of a library.------ The key is defined to be a 128-bit MD5 hash, separated into two 64-bit--- components (the most significant component coming first) which are--- individually base-62 encoded (A-Z, a-z, 0-9).------ @---      key         ::= hash64 hash64---      hash64      ::= [A-Za-z0-9]{11}--- @------ The string that is hashed is specified as raw_key:------ @---      raw_key     ::= package_id "\n"---                      holes_nl---                      depends_nl---      package_id  ::= package_name "-" package_version---      holes_nl    ::= ""---                    | hole_inst "\n" holes_nl---      hole_inst   ::= modulename " " key ":" modulename---      depends_nl  ::= ""---                    | depend "\n" depends_nl---      depend      ::= key--- @------ The holes list MUST be sorted by the first modulename; the depends list--- MUST be sorted by the key.  holes describes the backing implementations of--- all holes in the package; depends describes all of the build-depends of--- a package.  A package key MAY be used in holes even if it is not--- mentioned in depends: depends contains STRICTLY packages which are--- textually mentioned in the package description.------ The trailing newline is MANDATORY.------ There is also a variant of package key which is prefixed by a informational--- string.  This key MUST NOT be used in the computation of the hash proper,--- but it is useful for human-readable consumption.------ @---      infokey     ::= infostring "_" key---      infostring  ::= [A-Za-z0-9-]+--- @------ For example, Cabal provides a key with the first five characters of the--- package name for linker symbols.+-- | A 'ComponentId' uniquely identifies the transitive source+-- code closure of a component.  For non-Backpack components, it also+-- serves as the basis for install paths, symbols, etc. ---data PackageKey-    -- | Modern package key which is a hash of the PackageId and the transitive-    -- dependency key.  Manually inline it here so we can get the instances-    -- we need.  Also contains a short informative string-    = PackageKey !String {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64-    -- | Old-style package key which is just a 'PackageId'.  Required because-    -- old versions of GHC assume that the 'sourcePackageId' recorded for an-    -- installed package coincides with the package key it was compiled with.-    | OldPackageKey !PackageId+data ComponentId+    = ComponentId String     deriving (Generic, Read, Show, Eq, Ord, Typeable, Data) -instance Binary PackageKey---- | Convenience function which converts a fingerprint into a new-style package--- key.-fingerprintPackageKey :: String -> Fingerprint -> PackageKey-fingerprintPackageKey s (Fingerprint a b) = PackageKey s a b---- | Generates a 'PackageKey' from a 'PackageId', sorted package keys of the--- immediate dependencies.-mkPackageKey :: Bool -- are modern style package keys supported?-             -> PackageId-             -> [PackageKey]     -- dependencies-             -> [(ModuleName, (PackageKey, ModuleName))] -- hole instantiations-             -> PackageKey-mkPackageKey True pid deps holes =-    fingerprintPackageKey stubName . fingerprintString $-        display pid ++ "\n" ++-        -- NB: packageKeyHash, NOT display-        concat [ display m ++ " " ++ packageKeyHash p' ++ ":" ++ display m' ++ "\n"-               | (m, (p', m')) <- sortBy (comparing fst) holes] ++-        concat [ packageKeyHash d ++ "\n"-               | d <- sortBy (comparing packageKeyHash) deps]-  where stubName = take 5 (filter (/= '-') (unPackageName (pkgName pid)))-mkPackageKey False pid _ _ = OldPackageKey pid---- The base-62 code is based off of 'locators'--- ((c) Operational Dynamics Consulting, BSD3 licensed)---- Note: Instead of base-62 encoding a single 128-bit integer--- (ceil(21.49) characters), we'll base-62 a pair of 64-bit integers--- (2 * ceil(10.75) characters).  Luckily for us, it's the same number of--- characters!  In the long term, this should go in GHC.Fingerprint,--- but not now...---- | Size of a 64-bit word when written as a base-62 string-word64Base62Len :: Int-word64Base62Len = 11---- | Converts a 64-bit word into a base-62 string-toBase62 :: Word64 -> String-toBase62 w = pad ++ str-  where-    pad = replicate len '0'-    len = word64Base62Len - length str -- 11 == ceil(64 / lg 62)-    str = showIntAtBase 62 represent w ""-    represent :: Int -> Char-    represent x-        | x < 10 = Char.chr (48 + x)-        | x < 36 = Char.chr (65 + x - 10)-        | x < 62 = Char.chr (97 + x - 36)-        | otherwise = error ("represent (base 62): impossible!")+{-# DEPRECATED InstalledPackageId "Use UnitId instead" #-}+type InstalledPackageId = UnitId --- | Parses a base-62 string into a 64-bit word-fromBase62 :: String -> Word64-fromBase62 ss = foldl' multiply 0 ss-  where-    value :: Char -> Int-    value c-        | Char.isDigit c = Char.ord c - 48-        | Char.isUpper c = Char.ord c - 65 + 10-        | Char.isLower c = Char.ord c - 97 + 36-        | otherwise = error ("value (base 62): impossible!")+instance Binary ComponentId -    multiply :: Word64 -> Char -> Word64-    multiply acc c = acc * 62 + (fromIntegral $ value c)+instance Text ComponentId where+  disp (ComponentId str) = text str --- | Parses a base-62 string into a fingerprint.-readBase62Fingerprint :: String -> Fingerprint-readBase62Fingerprint s = Fingerprint w1 w2- where (s1,s2) = splitAt word64Base62Len s-       w1 = fromBase62 s1-       w2 = fromBase62 (take word64Base62Len s2)+  parse = ComponentId `fmap` Parse.munch1 abi_char+   where abi_char c = Char.isAlphaNum c || c `elem` "-_." -packageKeyHash :: PackageKey -> String-packageKeyHash (PackageKey _ w1 w2) = toBase62 w1 ++ toBase62 w2-packageKeyHash (OldPackageKey pid) = display pid+instance NFData ComponentId where+    rnf (ComponentId pk) = rnf pk -packageKeyLibraryName :: PackageId -> PackageKey -> String-packageKeyLibraryName pid (PackageKey _ w1 w2) = display pid ++ "-" ++ toBase62 w1 ++ toBase62 w2-packageKeyLibraryName _ (OldPackageKey pid) = display pid+-- | Returns library name prefixed with HS, suitable for filenames+getHSLibraryName :: UnitId -> String+getHSLibraryName (SimpleUnitId (ComponentId s)) = "HS" ++ s -instance Text PackageKey where-  disp (PackageKey prefix w1 w2) = Disp.text prefix <> Disp.char '_'-                        <> Disp.text (toBase62 w1) <> Disp.text (toBase62 w2)-  disp (OldPackageKey pid) = disp pid+-- | For now, there is no distinction between component IDs+-- and unit IDs in Cabal.+newtype UnitId = SimpleUnitId ComponentId+    deriving (Generic, Read, Show, Eq, Ord, Typeable, Data, Binary, Text, NFData) -  parse = parseNew <++ parseOld-    where parseNew = do-            prefix <- Parse.munch1 (\c -> Char.isAlphaNum c || c `elem` "-")-            _ <- Parse.char '_' -- if we use '-' it's ambiguous-            fmap (fingerprintPackageKey prefix . readBase62Fingerprint)-                . Parse.count (word64Base62Len * 2)-                $ Parse.satisfy Char.isAlphaNum-          parseOld = do pid <- parse-                        return (OldPackageKey pid)+-- | Makes a simple-style UnitId from a string.+mkUnitId :: String -> UnitId+mkUnitId = SimpleUnitId . ComponentId -instance NFData PackageKey where-    rnf (PackageKey prefix _ _) = rnf prefix-    rnf (OldPackageKey pid) = rnf pid+-- | Make an old-style UnitId from a package identifier+mkLegacyUnitId :: PackageId -> UnitId+mkLegacyUnitId = SimpleUnitId . ComponentId . display  -- ------------------------------------------------------------ -- * Package source dependencies@@ -358,22 +212,31 @@ instance Package PackageIdentifier where   packageId = id --- | Subclass of packages that have specific versioned dependencies.------ So for example a not-yet-configured package has dependencies on version--- ranges, not specific versions. A configured or an already installed package--- depends on exact versions. Some operations or data structures (like---  dependency graphs) only make sense on this subclass of package types.----class Package pkg => PackageFixedDeps pkg where-  depends :: pkg -> [PackageIdentifier]+-- | Packages that have an installed package ID+class Package pkg => HasUnitId pkg where+  installedUnitId :: pkg -> UnitId +{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}+-- | Compatibility wrapper for Cabal pre-1.24.+installedPackageId :: HasUnitId pkg => pkg -> UnitId+installedPackageId = installedUnitId+ -- | Class of installed packages. -- -- The primary data type which is an instance of this package is -- 'InstalledPackageInfo', but when we are doing install plans in Cabal install -- we may have other, installed package-like things which contain more metadata. -- Installed packages have exact dependencies 'installedDepends'.-class Package pkg => PackageInstalled pkg where-  installedPackageId :: pkg -> InstalledPackageId-  installedDepends :: pkg -> [InstalledPackageId]+class (HasUnitId pkg) => PackageInstalled pkg where+  installedDepends :: pkg -> [UnitId]++-- -----------------------------------------------------------------------------+-- ABI hash++newtype AbiHash = AbiHash String+    deriving (Eq, Show, Read, Generic)+instance Binary AbiHash++instance Text AbiHash where+    disp (AbiHash abi) = Disp.text abi+    parse = fmap AbiHash (Parse.munch Char.isAlphaNum)

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} @@ -98,46 +97,47 @@         GenericPackageDescription(..),         Flag(..), FlagName(..), FlagAssignment,         CondTree(..), ConfVar(..), Condition(..),+        cNot, cAnd, cOr,          -- * Source repositories         SourceRepo(..),         RepoKind(..),         RepoType(..),         knownRepoTypes,++        -- * Custom setup build information+        SetupBuildInfo(..),   ) where -import Distribution.Compat.Binary (Binary)-import Data.Data   (Data)-import Data.List   (nub, intercalate)-import Data.Maybe  (fromMaybe, maybeToList)-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid (Monoid(mempty, mappend))-#endif-import Data.Typeable ( Typeable )-import Control.Monad (MonadPlus(mplus))-import GHC.Generics (Generic)-import Text.PrettyPrint as Disp+import Distribution.Compat.Binary+import qualified Distribution.Compat.Semigroup as Semi ((<>))+import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup, gmempty) import qualified Distribution.Compat.ReadP as Parse-import Distribution.Compat.ReadP ((<++))-import qualified Data.Char as Char (isAlphaNum, isDigit, toLower)-import qualified Data.Map as Map-import Data.Map (Map)-+import Distribution.Compat.ReadP   ((<++)) import Distribution.Package-         ( PackageName(PackageName), PackageIdentifier(PackageIdentifier)-         , Dependency, Package(..), PackageName, packageName )-import Distribution.ModuleName ( ModuleName )+import Distribution.ModuleName import Distribution.Version-         ( Version(Version), VersionRange, anyVersion, orLaterVersion-         , asVersionIntervals, LowerBound(..) )-import Distribution.License  (License(UnspecifiedLicense))-import Distribution.Compiler (CompilerFlavor)-import Distribution.System   (OS, Arch)+import Distribution.License+import Distribution.Compiler+import Distribution.System import Distribution.Text-         ( Text(..), display ) import Language.Haskell.Extension-         ( Language, Extension ) +import Data.Data                  (Data)+import Data.Foldable              (traverse_)+import Data.List                  (nub, intercalate)+import Data.Maybe                 (fromMaybe, maybeToList)+import Data.Foldable as Fold      (Foldable(foldMap))+import Data.Traversable as Trav   (Traversable(traverse))+import Data.Typeable               ( Typeable )+import Control.Applicative as AP   (Alternative(..), Applicative(..))+import Control.Monad               (MonadPlus(mplus,mzero), ap)+import GHC.Generics                (Generic)+import Text.PrettyPrint as Disp+import qualified Data.Char as Char (isAlphaNum, isDigit, toLower)+import qualified Data.Map as Map+import Data.Map                    (Map)+ -- ----------------------------------------------------------------------------- -- The PackageDescription type @@ -168,6 +168,7 @@         customFieldsPD :: [(String,String)], -- ^Custom fields starting                                              -- with x-, stored in a                                              -- simple assoc-list.+         -- | YOU PROBABLY DON'T WANT TO USE THIS FIELD. This field is         -- special! Depending on how far along processing the         -- PackageDescription we are, the contents of this field are@@ -186,6 +187,7 @@         -- transitioning to specifying just a single version, not a range.         specVersionRaw :: Either Version VersionRange,         buildType      :: Maybe BuildType,+        setupBuildInfo :: Maybe SetupBuildInfo,         -- components         library        :: Maybe Library,         executables    :: [Executable],@@ -253,6 +255,7 @@                       description  = "",                       category     = "",                       customFieldsPD = [],+                      setupBuildInfo = Nothing,                       library      = Nothing,                       executables  = [],                       testSuites   = [],@@ -298,6 +301,33 @@       _           -> UnknownBuildType name  -- ---------------------------------------------------------------------------+-- The SetupBuildInfo type++-- One can see this as a very cut-down version of BuildInfo below.+-- To keep things simple for tools that compile Setup.hs we limit the+-- options authors can specify to just Haskell package dependencies.++data SetupBuildInfo = SetupBuildInfo {+        setupDepends        :: [Dependency],+        defaultSetupDepends :: Bool+        -- ^ Is this a default 'custom-setup' section added by the cabal-install+        -- code (as opposed to user-provided)? This field is only used+        -- internally, and doesn't correspond to anything in the .cabal+        -- file. See #3199.+    }+    deriving (Generic, Show, Eq, Read, Typeable, Data)++instance Binary SetupBuildInfo++instance Semi.Monoid SetupBuildInfo where+  mempty  = SetupBuildInfo [] False+  mappend = (Semi.<>)++instance Semigroup SetupBuildInfo where+  a <> b = SetupBuildInfo (setupDepends a Semi.<> setupDepends b)+           (defaultSetupDepends a || defaultSetupDepends b)++-- --------------------------------------------------------------------------- -- Module renaming  -- | Renaming applied to the modules provided by a package.@@ -313,18 +343,18 @@ defaultRenaming = ModuleRenaming True []  lookupRenaming :: Package pkg => pkg -> Map PackageName ModuleRenaming -> ModuleRenaming-lookupRenaming pkg rns =-    Map.findWithDefault-        (error ("lookupRenaming: missing renaming for " ++ display (packageName pkg)))-        (packageName pkg) rns+lookupRenaming = Map.findWithDefault defaultRenaming . packageName  instance Binary ModuleRenaming where  instance Monoid ModuleRenaming where-    ModuleRenaming b rns `mappend` ModuleRenaming b' rns'-        = ModuleRenaming (b || b') (rns ++ rns') -- ToDo: dedupe?     mempty = ModuleRenaming False []+    mappend = (Semi.<>) +instance Semigroup ModuleRenaming where+    ModuleRenaming b rns <> ModuleRenaming b' rns'+        = ModuleRenaming (b || b') (rns ++ rns') -- ToDo: dedupe?+ -- NB: parentheses are mandatory, because later we may extend this syntax -- to allow "hiding (A, B)" or other modifier words. instance Text ModuleRenaming where@@ -383,7 +413,10 @@     libExposed     = True,     libBuildInfo   = mempty   }-  mappend a b = Library {+  mappend = (Semi.<>)++instance Semigroup Library where+  a <> b = Library {     exposedModules = combine exposedModules,     reexportedModules = combine reexportedModules,     requiredSignatures = combine requiredSignatures,@@ -411,7 +444,7 @@ --  function with the library build info as argument. withLib :: PackageDescription -> (Library -> IO ()) -> IO () withLib pkg_descr f =-   maybe (return ()) f (maybeHasLibs pkg_descr)+   traverse_ f (maybeHasLibs pkg_descr)  -- | Get all the module names from the library (exposed and internal modules) -- which need to be compiled.  (This does not include reexports, which@@ -444,7 +477,7 @@      parse = do       mpkgname <- Parse.option Nothing $ do-                    pkgname <- parse +                    pkgname <- parse                     _       <- Parse.char ':'                     return (Just pkgname)       origname <- parse@@ -468,12 +501,11 @@ instance Binary Executable  instance Monoid Executable where-  mempty = Executable {-    exeName    = mempty,-    modulePath = mempty,-    buildInfo  = mempty-  }-  mappend a b = Executable{+  mempty = gmempty+  mappend = (Semi.<>)++instance Semigroup Executable where+  a <> b = Executable{     exeName    = combine' exeName,     modulePath = combine modulePath,     buildInfo  = combine buildInfo@@ -558,8 +590,10 @@         testBuildInfo = mempty,         testEnabled   = False     }+    mappend = (Semi.<>) -    mappend a b = TestSuite {+instance Semigroup TestSuite where+    a <> b = TestSuite {         testName      = combine' testName,         testInterface = combine  testInterface,         testBuildInfo = combine  testBuildInfo,@@ -574,9 +608,12 @@  instance Monoid TestSuiteInterface where     mempty  =  TestSuiteUnsupported (TestTypeUnknown mempty (Version [] []))-    mappend a (TestSuiteUnsupported _) = a-    mappend _ b                        = b+    mappend = (Semi.<>) +instance Semigroup TestSuiteInterface where+    a <> (TestSuiteUnsupported _) = a+    _ <> b                        = b+ emptyTestSuite :: TestSuite emptyTestSuite = mempty @@ -691,8 +728,10 @@         benchmarkBuildInfo = mempty,         benchmarkEnabled   = False     }+    mappend = (Semi.<>) -    mappend a b = Benchmark {+instance Semigroup Benchmark where+    a <> b = Benchmark {         benchmarkName      = combine' benchmarkName,         benchmarkInterface = combine  benchmarkInterface,         benchmarkBuildInfo = combine  benchmarkBuildInfo,@@ -707,9 +746,12 @@  instance Monoid BenchmarkInterface where     mempty  =  BenchmarkUnsupported (BenchmarkTypeUnknown mempty (Version [] []))-    mappend a (BenchmarkUnsupported _) = a-    mappend _ b                        = b+    mappend = (Semi.<>) +instance Semigroup BenchmarkInterface where+    a <> (BenchmarkUnsupported _) = a+    _ <> b                        = b+ emptyBenchmark :: Benchmark emptyBenchmark = mempty @@ -769,6 +811,7 @@         ldOptions         :: [String],  -- ^ options for linker         pkgconfigDepends  :: [Dependency], -- ^ pkg-config packages that are used         frameworks        :: [String], -- ^support frameworks for Mac OS X+        extraFrameworkDirs:: [String], -- ^ extra locations to find frameworks.         cSources          :: [FilePath],         jsSources         :: [FilePath],         hsSourceDirs      :: [FilePath], -- ^ where to look for the Haskell module hierarchy@@ -801,63 +844,68 @@  instance Monoid BuildInfo where   mempty = BuildInfo {-    buildable         = True,-    buildTools        = [],-    cppOptions        = [],-    ccOptions         = [],-    ldOptions         = [],-    pkgconfigDepends  = [],-    frameworks        = [],-    cSources          = [],-    jsSources         = [],-    hsSourceDirs      = [],-    otherModules      = [],-    defaultLanguage   = Nothing,-    otherLanguages    = [],-    defaultExtensions = [],-    otherExtensions   = [],-    oldExtensions     = [],-    extraLibs         = [],-    extraGHCiLibs     = [],-    extraLibDirs      = [],-    includeDirs       = [],-    includes          = [],-    installIncludes   = [],-    options           = [],-    profOptions       = [],-    sharedOptions     = [],-    customFieldsBI    = [],-    targetBuildDepends = [],+    buildable           = True,+    buildTools          = [],+    cppOptions          = [],+    ccOptions           = [],+    ldOptions           = [],+    pkgconfigDepends    = [],+    frameworks          = [],+    extraFrameworkDirs  = [],+    cSources            = [],+    jsSources           = [],+    hsSourceDirs        = [],+    otherModules        = [],+    defaultLanguage     = Nothing,+    otherLanguages      = [],+    defaultExtensions   = [],+    otherExtensions     = [],+    oldExtensions       = [],+    extraLibs           = [],+    extraGHCiLibs       = [],+    extraLibDirs        = [],+    includeDirs         = [],+    includes            = [],+    installIncludes     = [],+    options             = [],+    profOptions         = [],+    sharedOptions       = [],+    customFieldsBI      = [],+    targetBuildDepends  = [],     targetBuildRenaming = Map.empty   }-  mappend a b = BuildInfo {-    buildable         = buildable a && buildable b,-    buildTools        = combine    buildTools,-    cppOptions        = combine    cppOptions,-    ccOptions         = combine    ccOptions,-    ldOptions         = combine    ldOptions,-    pkgconfigDepends  = combine    pkgconfigDepends,-    frameworks        = combineNub frameworks,-    cSources          = combineNub cSources,-    jsSources         = combineNub jsSources,-    hsSourceDirs      = combineNub hsSourceDirs,-    otherModules      = combineNub otherModules,-    defaultLanguage   = combineMby defaultLanguage,-    otherLanguages    = combineNub otherLanguages,-    defaultExtensions = combineNub defaultExtensions,-    otherExtensions   = combineNub otherExtensions,-    oldExtensions     = combineNub oldExtensions,-    extraLibs         = combine    extraLibs,-    extraGHCiLibs     = combine    extraGHCiLibs,-    extraLibDirs      = combineNub extraLibDirs,-    includeDirs       = combineNub includeDirs,-    includes          = combineNub includes,-    installIncludes   = combineNub installIncludes,-    options           = combine    options,-    profOptions       = combine    profOptions,-    sharedOptions     = combine    sharedOptions,-    customFieldsBI    = combine    customFieldsBI,-    targetBuildDepends = combineNub targetBuildDepends,+  mappend = (Semi.<>)++instance Semigroup BuildInfo where+  a <> b = BuildInfo {+    buildable           = buildable a && buildable b,+    buildTools          = combine    buildTools,+    cppOptions          = combine    cppOptions,+    ccOptions           = combine    ccOptions,+    ldOptions           = combine    ldOptions,+    pkgconfigDepends    = combine    pkgconfigDepends,+    frameworks          = combineNub frameworks,+    extraFrameworkDirs  = combineNub extraFrameworkDirs,+    cSources            = combineNub cSources,+    jsSources           = combineNub jsSources,+    hsSourceDirs        = combineNub hsSourceDirs,+    otherModules        = combineNub otherModules,+    defaultLanguage     = combineMby defaultLanguage,+    otherLanguages      = combineNub otherLanguages,+    defaultExtensions   = combineNub defaultExtensions,+    otherExtensions     = combineNub otherExtensions,+    oldExtensions       = combineNub oldExtensions,+    extraLibs           = combine    extraLibs,+    extraGHCiLibs       = combine    extraGHCiLibs,+    extraLibDirs        = combineNub extraLibDirs,+    includeDirs         = combineNub includeDirs,+    includes            = combineNub includes,+    installIncludes     = combineNub installIncludes,+    options             = combine    options,+    profOptions         = combine    profOptions,+    sharedOptions       = combine    sharedOptions,+    customFieldsBI      = combine    customFieldsBI,+    targetBuildDepends  = combineNub targetBuildDepends,     targetBuildRenaming = combineMap targetBuildRenaming   }     where@@ -1102,12 +1150,12 @@         condTestSuites     :: [(String, CondTree ConfVar [Dependency] TestSuite)],         condBenchmarks     :: [(String, CondTree ConfVar [Dependency] Benchmark)]       }-    deriving (Show, Eq, Typeable, Data)+    deriving (Show, Eq, Typeable, Data, Generic)  instance Package GenericPackageDescription where   packageId = packageId . packageDescription ---TODO: make PackageDescription an instance of Text.+instance Binary GenericPackageDescription  -- | A flag can represent a feature to be included, or a way of linking --   a target against its dependencies, or in fact whatever you can think of.@@ -1117,8 +1165,10 @@     , flagDefault     :: Bool     , flagManual      :: Bool     }-    deriving (Show, Eq, Typeable, Data)+    deriving (Show, Eq, Typeable, Data, Generic) +instance Binary Flag+ -- | A 'FlagName' is the name of a user-defined configuration flag newtype FlagName = FlagName String     deriving (Eq, Generic, Ord, Show, Read, Typeable, Data)@@ -1137,16 +1187,96 @@              | Arch Arch              | Flag FlagName              | Impl CompilerFlavor VersionRange-    deriving (Eq, Show, Typeable, Data)+    deriving (Eq, Show, Typeable, Data, Generic) +instance Binary ConfVar+ -- | A boolean expression parameterized over the variable type used. data Condition c = Var c                  | Lit Bool                  | CNot (Condition c)                  | COr (Condition c) (Condition c)                  | CAnd (Condition c) (Condition c)-    deriving (Show, Eq, Typeable, Data)+    deriving (Show, Eq, Typeable, Data, Generic) +-- | Boolean negation of a 'Condition' value.+cNot :: Condition a -> Condition a+cNot (Lit b)  = Lit (not b)+cNot (CNot c) = c+cNot c        = CNot c++-- | Boolean AND of two 'Condtion' values.+cAnd :: Condition a -> Condition a -> Condition a+cAnd (Lit False) _           = Lit False+cAnd _           (Lit False) = Lit False+cAnd (Lit True)  x           = x+cAnd x           (Lit True)  = x+cAnd x           y           = CAnd x y++-- | Boolean OR of two 'Condition' values.+cOr :: Eq v => Condition v -> Condition v -> Condition v+cOr  (Lit True)  _           = Lit True+cOr  _           (Lit True)  = Lit True+cOr  (Lit False) x           = x+cOr  x           (Lit False) = x+cOr  c           (CNot d)+  | c == d                   = Lit True+cOr  (CNot c)    d+  | c == d                   = Lit True+cOr  x           y           = COr x y++instance Functor Condition where+  f `fmap` Var c    = Var (f c)+  _ `fmap` Lit c    = Lit c+  f `fmap` CNot c   = CNot (fmap f c)+  f `fmap` COr c d  = COr  (fmap f c) (fmap f d)+  f `fmap` CAnd c d = CAnd (fmap f c) (fmap f d)++instance Foldable Condition where+  f `foldMap` Var c    = f c+  _ `foldMap` Lit _    = mempty+  f `foldMap` CNot c   = Fold.foldMap f c+  f `foldMap` COr c d  = foldMap f c `mappend` foldMap f d+  f `foldMap` CAnd c d = foldMap f c `mappend` foldMap f d++instance Traversable Condition where+  f `traverse` Var c    = Var `fmap` f c+  _ `traverse` Lit c    = pure $ Lit c+  f `traverse` CNot c   = CNot `fmap` Trav.traverse f c+  f `traverse` COr c d  = COr  `fmap` traverse f c <*> traverse f d+  f `traverse` CAnd c d = CAnd `fmap` traverse f c <*> traverse f d++instance Applicative Condition where+  pure  = Var+  (<*>) = ap++instance Monad Condition where+  return = AP.pure+  -- Terminating cases+  (>>=) (Lit x) _ = Lit x+  (>>=) (Var x) f = f x+  -- Recursing cases+  (>>=) (CNot  x  ) f = CNot (x >>= f)+  (>>=) (COr   x y) f = COr  (x >>= f) (y >>= f)+  (>>=) (CAnd  x y) f = CAnd (x >>= f) (y >>= f)++instance Monoid (Condition a) where+  mempty = Lit False+  mappend = (Semi.<>)++instance Semigroup (Condition a) where+  (<>) = COr++instance Alternative Condition where+  empty = mempty+  (<|>) = mappend++instance MonadPlus Condition where+  mzero = mempty+  mplus = mappend++instance Binary c => Binary (Condition c)+ data CondTree v c a = CondNode     { condTreeData        :: a     , condTreeConstraints :: c@@ -1154,4 +1284,6 @@                               , CondTree v c a                               , Maybe (CondTree v c a))]     }-    deriving (Show, Eq, Typeable, Data)+    deriving (Show, Eq, Typeable, Data, Generic)++instance (Binary v, Binary c, Binary a) => Binary (CondTree v c a)

@@ -33,53 +33,35 @@         checkPackageFileNames,   ) where -import Data.Maybe-         ( isNothing, isJust, catMaybes, maybeToList, fromMaybe )-import Data.List  (sort, group, isPrefixOf, nub, find)-import Control.Monad-         ( filterM, liftM )-import qualified System.Directory as System-         ( doesFileExist, doesDirectoryExist )-import qualified Data.Map as Map- import Distribution.PackageDescription import Distribution.PackageDescription.Configuration-         ( flattenPackageDescription, finalizePackageDescription ) import Distribution.Compiler-         ( CompilerFlavor(..), buildCompilerFlavor, CompilerId(..)-         , unknownCompilerInfo, AbiTag(..) ) import Distribution.System-         ( OS(..), Arch(..), buildPlatform ) import Distribution.License-         ( License(..), knownLicenses ) import Distribution.Simple.CCompiler-         ( filenameCDialect )-import Distribution.Simple.Utils-         ( cabalVersion, intercalate, parseFileGlob, FileGlob(..), lowercase )-+import Distribution.Simple.Utils hiding (findPackageDesc, notice) import Distribution.Version-         ( Version(..)-         , VersionRange(..), foldVersionRange'-         , anyVersion, noVersion, thisVersion, laterVersion, earlierVersion-         , orLaterVersion, orEarlierVersion-         , unionVersionRanges, intersectVersionRanges-         , asVersionIntervals, UpperBound(..), isNoVersion ) import Distribution.Package-         ( PackageName(PackageName), packageName, packageVersion-         , Dependency(..), pkgName )- import Distribution.Text-         ( display, disp )+import Language.Haskell.Extension++import Data.Maybe+         ( isNothing, isJust, catMaybes, mapMaybe, maybeToList, fromMaybe )+import Data.List  (sort, group, isPrefixOf, nub, find)+import Control.Monad+         ( filterM, liftM )+import qualified System.Directory as System+         ( doesFileExist, doesDirectoryExist )+import qualified Data.Map as Map+ import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ((<>), (<+>)) -import qualified Language.Haskell.Extension as Extension (deprecatedExtensions)-import Language.Haskell.Extension-         ( Language(UnknownLanguage), knownLanguages-         , Extension(..), KnownExtension(..) )+import qualified System.Directory (getDirectoryContents)+import System.IO (openBinaryFile, IOMode(ReadMode), hGetContents) import System.FilePath          ( (</>), takeExtension, isRelative, isAbsolute-         , splitDirectories,  splitPath )+         , splitDirectories,  splitPath, splitExtension ) import System.FilePath.Windows as FilePath.Windows          ( isValid ) @@ -108,6 +90,10 @@        -- ban them entirely.      | PackageDistSuspicious { explanation :: String } +       -- | Like PackageDistSuspicious but will only display warnings+       -- rather than causing abnormal exit when you run 'cabal check'.+     | PackageDistSuspiciousWarn { explanation :: String }+        -- | An issue that is OK in the author's environment but is almost        -- certain to be a portability problem for other environments. We can        -- quite legitimately refuse to publicly distribute packages with these@@ -128,7 +114,6 @@   | specVersion pkg >= Version specver [] = Nothing   | otherwise                             = check cond pc - -- ------------------------------------------------------------ -- * Standard checks -- ------------------------------------------------------------@@ -150,6 +135,7 @@      checkConfiguredPackage pkg   ++ checkConditionals gpkg   ++ checkPackageVersions gpkg+  ++ checkDevelopmentOnlyFlags gpkg   where     pkg = fromMaybe (flattenPackageDescription gpkg) mpkg @@ -184,9 +170,12 @@   , check (null . versionBranch . packageVersion $ pkg) $       PackageBuildImpossible "No 'version' field." -  , check (null (executables pkg) && isNothing (library pkg)) $+  , check (all ($ pkg) [ null . executables+                       , null . testSuites+                       , null . benchmarks+                       , isNothing . library ]) $       PackageBuildImpossible-        "No executables and no library found. Nothing to do."+        "No executables, libraries, tests, or benchmarks found. Nothing to do."    , check (not (null duplicateNames)) $       PackageBuildImpossible $ "Duplicate sections: " ++ commaSep duplicateNames@@ -308,14 +297,6 @@       PackageDistInexcusable $            "The package uses a C/C++/obj-C source file for the 'main-is' field. "         ++ "To use this feature you must specify 'cabal-version: >= 1.18'."--    -- Test suites might be built as (internal) libraries named after-    -- the test suite and thus their names must not clash with the-    -- name of the package.-  , check libNameClash $-      PackageBuildImpossible $-           "The test suite " ++ testName test-        ++ " has the same name as the package."   ]   where     moduleDuplicates = dups $ testModules test@@ -328,13 +309,8 @@       TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]       _                   -> False -    libNameClash = testName test `elem` [ libName-                                        | _lib <- maybeToList (library pkg)-                                        , let PackageName libName =-                                                pkgName (package pkg) ]- checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck]-checkBenchmark pkg bm =+checkBenchmark _pkg bm =   catMaybes [      case benchmarkInterface bm of@@ -360,12 +336,6 @@       PackageBuildImpossible $            "The 'main-is' field must specify a '.hs' or '.lhs' file "         ++ "(even if it is generated by a preprocessor)."--    -- See comment for similar check on test suites.-  , check libNameClash $-      PackageBuildImpossible $-           "The benchmark " ++ benchmarkName bm-        ++ " has the same name as the package."   ]   where     moduleDuplicates = dups $ benchmarkModules bm@@ -374,11 +344,6 @@       BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]       _                   -> False -    libNameClash = benchmarkName bm `elem` [ libName-                                           | _lib <- maybeToList (library pkg)-                                           , let PackageName libName =-                                                   pkgName (package pkg) ]- -- ------------------------------------------------------------ -- * Additional pure checks -- ------------------------------------------------------------@@ -407,6 +372,12 @@           ++ commaSep (map display knownBuildTypes)       _ -> Nothing +  , check (isJust (setupBuildInfo pkg) && buildType pkg /= Just Custom) $+      PackageBuildWarning $+           "Ignoring the 'custom-setup' section because the 'build-type' is "+        ++ "not 'Custom'. Use 'build-type: Custom' if you need to use a "+        ++ "custom Setup.hs script."+   , check (not (null unknownCompilers)) $       PackageBuildWarning $         "Unknown compiler " ++ commaSep (map quote unknownCompilers)@@ -427,14 +398,14 @@         ++ ". Languages must be specified in either the 'default-language' "         ++ " or the 'other-languages' field." -  , check (not (null deprecatedExtensions)) $+  , check (not (null ourDeprecatedExtensions)) $       PackageDistSuspicious $            "Deprecated extensions: "-        ++ commaSep (map (quote . display . fst) deprecatedExtensions)+        ++ commaSep (map (quote . display . fst) ourDeprecatedExtensions)         ++ ". " ++ unwords              [ "Instead of '" ++ display ext             ++ "' use '" ++ display replacement ++ "'."-             | (ext, Just replacement) <- deprecatedExtensions ]+             | (ext, Just replacement) <- ourDeprecatedExtensions ]    , check (null (category pkg)) $       PackageDistSuspicious "No 'category' field."@@ -476,8 +447,8 @@     unknownExtensions = [ name | bi <- allBuildInfo pkg                                , UnknownExtension name <- allExtensions bi                                , name `notElem` map display knownLanguages ]-    deprecatedExtensions = nub $ catMaybes-      [ find ((==ext) . fst) Extension.deprecatedExtensions+    ourDeprecatedExtensions = nub $ catMaybes+      [ find ((==ext) . fst) deprecatedExtensions       | bi <- allBuildInfo pkg       , ext <- allExtensions bi ]     languagesUsedAsExtensions =@@ -588,19 +559,7 @@ checkGhcOptions pkg =   catMaybes [ -    check has_WerrorWall $-      PackageDistSuspicious $-           "'ghc-options: -Wall -Werror' makes the package very easy to "-        ++ "break with future GHC versions because new GHC versions often "-        ++ "add new warnings. Use just 'ghc-options: -Wall' instead."--  , check (not has_WerrorWall && has_Werror) $-      PackageDistSuspicious $-           "'ghc-options: -Werror' makes the package easy to "-        ++ "break with future GHC versions because new GHC versions often "-        ++ "add new warnings."--  , checkFlags ["-fasm"] $+    checkFlags ["-fasm"] $       PackageDistInexcusable $            "'ghc-options: -fasm' is unnecessary and will not work on CPU "         ++ "architectures other than x86, x86-64, ppc or sparc."@@ -612,27 +571,16 @@         ++ "is using the FFI incorrectly and will probably not work with GHC "         ++ "6.10 or later." -  , checkFlags ["-fdefer-type-errors"] $-      PackageDistInexcusable $-          "'ghc-options: -fdefer-type-errors' is fine during development but "-       ++ "is not appropriate for a distributed package."-   , checkFlags ["-fhpc"] $       PackageDistInexcusable $-        "'ghc-options: -fhpc' is not appropriate for a distributed package."--    -- -dynamic is not a debug flag-  , check (any (\opt -> "-d" `isPrefixOf` opt && opt /= "-dynamic")-           all_ghc_options) $-      PackageDistInexcusable $-        "'ghc-options: -d*' debug flags are not appropriate "-        ++ "for a distributed package."+           "'ghc-options: -fhpc' is not not necessary. Use the configure flag "+        ++ " --enable-coverage instead."    , checkFlags ["-prof"] $       PackageBuildWarning $            "'ghc-options: -prof' is not necessary and will lead to problems "         ++ "when used on a library. Use the configure flag "-        ++ "--enable-library-profiling and/or --enable-executable-profiling."+        ++ "--enable-library-profiling and/or --enable-profiling."    , checkFlags ["-o"] $       PackageBuildWarning $@@ -664,7 +612,7 @@       ++ "Setting it yourself interferes with the --disable-optimization flag."    , checkFlags ["-O2"] $-      PackageDistSuspicious $+      PackageDistSuspiciousWarn $       "'ghc-options: -O2' is rarely needed. "       ++ "Check that it is giving a real benefit "       ++ "and not just imposing longer compile times on your users."@@ -687,21 +635,21 @@         "Instead of 'ghc-options: -fglasgow-exts' it is preferable to use "         ++ "the 'extensions' field." -  , checkProfFlags ["-auto-all"] $-      PackageDistSuspicious $-        "'ghc-prof-options: -auto-all' is fine during development, but "-        ++ "not recommended in a distributed package. "--  , checkProfFlags ["-fprof-auto"] $-      PackageDistSuspicious $-        "'ghc-prof-options: -fprof-auto' is fine during development, but "-        ++ "not recommended in a distributed package. "-   , check ("-threaded" `elem` lib_ghc_options) $-      PackageDistSuspicious $+      PackageBuildWarning $            "'ghc-options: -threaded' has no effect for libraries. It should "         ++ "only be used for executables." +  , check ("-rtsopts" `elem` lib_ghc_options) $+      PackageBuildWarning $+           "'ghc-options: -rtsopts' has no effect for libraries. It should "+        ++ "only be used for executables."++  , check (any (\opt -> "-with-rtsopts" `isPrefixOf` opt) lib_ghc_options) $+      PackageBuildWarning $+           "'ghc-options: -with-rtsopts' has no effect for libraries. It "+        ++ "should only be used for executables."+   , checkAlternatives "ghc-options" "extensions"       [ (flag, display extension) | flag <- all_ghc_options                                   , Just extension <- [ghcExtension flag] ]@@ -721,26 +669,24 @@    , checkAlternatives "ghc-options" "extra-lib-dirs"       [ (flag, dir) | flag@('-':'L':dir) <- all_ghc_options ]-  ] -  where-    has_WerrorWall = flip any ghc_options $ \opts ->-                               "-Werror" `elem` opts-                           && ("-Wall"   `elem` opts || "-W" `elem` opts)-    has_Werror     = any (\opts -> "-Werror" `elem` opts) ghc_options+  , checkAlternatives "ghc-options" "frameworks"+      [ (flag, fmwk) | (flag@"-framework", fmwk) <-+           zip all_ghc_options (safeTail all_ghc_options) ] -    (ghc_options, ghc_prof_options) =-      unzip . map (\bi -> (hcOptions GHC bi, hcProfOptions GHC bi))-      $ (allBuildInfo pkg)-    all_ghc_options      = concat ghc_options-    all_ghc_prof_options = concat ghc_prof_options-    lib_ghc_options = maybe [] (hcOptions GHC . libBuildInfo) (library pkg)+  , checkAlternatives "ghc-options" "extra-framework-dirs"+      [ (flag, dir) | (flag@"-framework-path", dir) <-+           zip all_ghc_options (safeTail all_ghc_options) ]+  ] -    checkFlags,checkProfFlags :: [String] -> PackageCheck -> Maybe PackageCheck-    checkFlags     flags = doCheckFlags flags all_ghc_options-    checkProfFlags flags = doCheckFlags flags all_ghc_prof_options+  where+    all_ghc_options    = concatMap get_ghc_options (allBuildInfo pkg)+    lib_ghc_options    = maybe [] (get_ghc_options . libBuildInfo) (library pkg)+    get_ghc_options bi = hcOptions GHC bi ++ hcProfOptions GHC bi+                         ++ hcSharedOptions GHC bi -    doCheckFlags   flags opts = check (any (`elem` flags) opts)+    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck+    checkFlags flags = check (any (`elem` flags) all_ghc_options)      ghcExtension ('-':'f':name) = case name of       "allow-overlapping-instances"    -> enable  OverlappingInstances@@ -843,7 +789,7 @@   , isOutsideTree path ]   ++   [ PackageDistInexcusable $-      quote (kind ++ ": " ++ path) ++ " is an absolute directory."+      quote (kind ++ ": " ++ path) ++ " is an absolute path."   | (path, kind) <- relPaths   , isAbsolute path ]   ++@@ -882,6 +828,7 @@       ++ [ (path, "extra-doc-files") | path <- extraDocFiles pkg ]       ++ [ (path, "data-files")      | path <- dataFiles     pkg ]       ++ [ (path, "data-dir")        | path <- [dataDir      pkg]]+      ++ [ (path, "license-file")    | path <- licenseFiles  pkg ]       ++ concat          [    [ (path, "c-sources")        | path <- cSources        bi ]            ++ [ (path, "js-sources")       | path <- jsSources       bi ]@@ -973,6 +920,13 @@         ++ ". To use this new syntax, the package needs to specify at least"         ++ "'cabal-version: >= 1.21'." +    -- check use of 'extra-framework-dirs' field+  , checkVersion [1,23] (any (not . null) (buildInfoField extraFrameworkDirs)) $+      -- Just a warning, because this won't break on old Cabal versions.+      PackageDistSuspiciousWarn $+           "To use the 'extra-framework-dirs' field the package needs to specify"+        ++ " at least 'cabal-version: >= 1.23'."+     -- check use of default-extensions field     -- don't need to do the equivalent check for other-extensions   , checkVersion [1,10] (any (not . null) (buildInfoField defaultExtensions)) $@@ -1084,6 +1038,27 @@         ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "         ++ "compatibility with earlier Cabal versions then you may be able to "         ++ "use an equivalent compiler-specific flag."++  , check (specVersion pkg >= Version [1,23] []+           && isNothing (setupBuildInfo pkg)+           && buildType pkg == Just Custom) $+      PackageBuildWarning $+           "Packages using 'cabal-version: >= 1.23' with 'build-type: Custom' "+        ++ "must use a 'custom-setup' section with a 'setup-depends' field "+        ++ "that specifies the dependencies of the Setup.hs script itself. "+        ++ "The 'setup-depends' field uses the same syntax as 'build-depends', "+        ++ "so a simple example would be 'setup-depends: base, Cabal'."++  , check (specVersion pkg < Version [1,23] []+           && isNothing (setupBuildInfo pkg)+           && buildType pkg == Just Custom) $+      PackageDistSuspiciousWarn $+           "From version 1.23 cabal supports specifiying explicit dependencies "+        ++ "for Custom setup scripts. Consider using cabal-version >= 1.23 and "+        ++ "adding a 'custom-setup' section with a 'setup-depends' field "+        ++ "that specifies the dependencies of the Setup.hs script itself. "+        ++ "The 'setup-depends' field uses the same syntax as 'build-depends', "+        ++ "so a simple example would be 'setup-depends: base, Cabal'."   ]   where     -- Perform a check on packages that use a version of the spec less than@@ -1143,14 +1118,13 @@     depsUsingWildcardSyntax = [ dep | dep@(Dependency _ vr) <- buildDepends pkg                                     , usesWildcardSyntax vr ] -    -- XXX: If the user writes build-depends: foo with (), this is+    -- TODO: If the user writes build-depends: foo with (), this is     -- indistinguishable from build-depends: foo, so there won't be an     -- error even though there should be     depsUsingThinningRenamingSyntax =       [ name       | bi <- allBuildInfo pkg-      , (name, rns) <- Map.toList (targetBuildRenaming bi)-      , rns /= ModuleRenaming True [] ]+      , (name, _) <- Map.toList (targetBuildRenaming bi) ]      testedWithUsingWildcardSyntax =       [ Dependency (PackageName (display compiler)) vr@@ -1279,7 +1253,7 @@         ++ "new major version of the 'base' package is released. If you are "         ++ "not sure what upper bound to use then use the next  major "         ++ "version. For example if you have tested your package with 'base' "-        ++ "version 2 and 3 then use 'build-depends: base >= 2 && < 4'."+        ++ "version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'."    ]   where@@ -1338,10 +1312,10 @@     unknownOSs    = [ os   | OS   (OtherOS os)           <- conditions ]     unknownArches = [ arch | Arch (OtherArch arch)       <- conditions ]     unknownImpls  = [ impl | Impl (OtherCompiler impl) _ <- conditions ]-    conditions = maybe [] freeVars (condLibrary pkg)-              ++ concatMap (freeVars . snd) (condExecutables pkg)-    freeVars (CondNode _ _ ifs) = concatMap compfv ifs-    compfv (c, ct, mct) = condfv c ++ freeVars ct ++ maybe [] freeVars mct+    conditions = maybe [] fvs (condLibrary pkg)+              ++ concatMap (fvs . snd) (condExecutables pkg)+    fvs (CondNode _ _ ifs) = concatMap compfv ifs -- free variables+    compfv (c, ct, mct) = condfv c ++ fvs ct ++ maybe [] fvs mct     condfv c = case c of       Var v      -> [v]       Lit _      -> []@@ -1349,6 +1323,131 @@       COr  c1 c2 -> condfv c1 ++ condfv c2       CAnd c1 c2 -> condfv c1 ++ condfv c2 +checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck]+checkDevelopmentOnlyFlagsBuildInfo bi =+  catMaybes [++    check has_WerrorWall $+      PackageDistInexcusable $+           "'ghc-options: -Wall -Werror' makes the package very easy to "+        ++ "break with future GHC versions because new GHC versions often "+        ++ "add new warnings. Use just 'ghc-options: -Wall' instead."+        ++ extraExplanation++  , check (not has_WerrorWall && has_Werror) $+      PackageDistInexcusable $+           "'ghc-options: -Werror' makes the package easy to "+        ++ "break with future GHC versions because new GHC versions often "+        ++ "add new warnings. "+        ++ extraExplanation++  , checkFlags ["-fdefer-type-errors"] $+      PackageDistInexcusable $+           "'ghc-options: -fdefer-type-errors' is fine during development but "+        ++ "is not appropriate for a distributed package. "+        ++ extraExplanation++    -- -dynamic is not a debug flag+  , check (any (\opt -> "-d" `isPrefixOf` opt && opt /= "-dynamic")+           ghc_options) $+      PackageDistInexcusable $+           "'ghc-options: -d*' debug flags are not appropriate "+        ++ "for a distributed package. "+        ++ extraExplanation++  , checkFlags ["-fprof-auto", "-fprof-auto-top", "-fprof-auto-calls",+               "-fprof-cafs", "-fno-prof-count-entries",+               "-auto-all", "-auto", "-caf-all"] $+      PackageDistSuspicious $+           "'ghc-options: -fprof*' profiling flags are typically not "+        ++ "appropriate for a distributed library package. These flags are "+        ++ "useful to profile this package, but when profiling other packages "+        ++ "that use this one these flags clutter the profile output with "+        ++ "excessive detail. If you think other packages really want to see "+        ++ "cost centres from this package then use '-fprof-auto-exported' "+        ++ "which puts cost centres only on exported functions. "+        ++ extraExplanation+  ]+  where+    extraExplanation =+         " Alternatively, if you want to use this, make it conditional based "+      ++ "on a Cabal configuration flag (with 'manual: True' and 'default: "+      ++ "False') and enable that flag during development."++    has_WerrorWall   = has_Werror && ( has_Wall || has_W )+    has_Werror       = "-Werror" `elem` ghc_options+    has_Wall         = "-Wall"   `elem` ghc_options+    has_W            = "-W"      `elem` ghc_options+    ghc_options      = hcOptions GHC bi ++ hcProfOptions GHC bi+                       ++ hcSharedOptions GHC bi++    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck+    checkFlags flags = check (any (`elem` flags) ghc_options)++checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck]+checkDevelopmentOnlyFlags pkg =+    concatMap checkDevelopmentOnlyFlagsBuildInfo+              [ bi+              | (conditions, bi) <- allConditionalBuildInfo+              , not (any guardedByManualFlag conditions) ]+  where+    guardedByManualFlag = definitelyFalse++    -- We've basically got three-values logic here: True, False or unknown+    -- hence this pattern to propagate the unknown cases properly.+    definitelyFalse (Var (Flag n)) = maybe False not (Map.lookup n manualFlags)+    definitelyFalse (Var _)        = False+    definitelyFalse (Lit  b)       = not b+    definitelyFalse (CNot c)       = definitelyTrue c+    definitelyFalse (COr  c1 c2)   = definitelyFalse c1 && definitelyFalse c2+    definitelyFalse (CAnd c1 c2)   = definitelyFalse c1 || definitelyFalse c2++    definitelyTrue (Var (Flag n)) = fromMaybe False (Map.lookup n manualFlags)+    definitelyTrue (Var _)        = False+    definitelyTrue (Lit  b)       = b+    definitelyTrue (CNot c)       = definitelyFalse c+    definitelyTrue (COr  c1 c2)   = definitelyTrue c1 || definitelyTrue c2+    definitelyTrue (CAnd c1 c2)   = definitelyTrue c1 && definitelyTrue c2++    manualFlags = Map.fromList+                    [ (flagName flag, flagDefault flag)+                    | flag <- genPackageFlags pkg+                    , flagManual flag ]++    allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]+    allConditionalBuildInfo =+        concatMap (collectCondTreePaths libBuildInfo)+                  (maybeToList (condLibrary pkg))++     ++ concatMap (collectCondTreePaths buildInfo . snd)+                  (condExecutables pkg)++     ++ concatMap (collectCondTreePaths testBuildInfo . snd)+                  (condTestSuites pkg)++     ++ concatMap (collectCondTreePaths benchmarkBuildInfo . snd)+                  (condBenchmarks pkg)++    -- get all the leaf BuildInfo, paired up with the path (in the tree sense)+    -- of if-conditions that guard it+    collectCondTreePaths :: (a -> b)+                         -> CondTree v c a+                         -> [([Condition v], b)]+    collectCondTreePaths mapData = go []+      where+        go conditions condNode =+            -- the data at this level in the tree:+            (reverse conditions, mapData (condTreeData condNode))++          : concat+            [ go (condition:conditions) ifThen+            | (condition, ifThen, _) <- condTreeComponents condNode ]++         ++ concat+            [ go (condition:conditions) elseThen+            | (condition, _, Just elseThen) <- condTreeComponents condNode ]++ -- ------------------------------------------------------------ -- * Checks involving files in the package -- ------------------------------------------------------------@@ -1360,8 +1459,10 @@ checkPackageFiles pkg root = checkPackageContent checkFilesIO pkg   where     checkFilesIO = CheckPackageContentOps {-      doesFileExist      = System.doesFileExist      . relative,-      doesDirectoryExist = System.doesDirectoryExist . relative+      doesFileExist        = System.doesFileExist                  . relative,+      doesDirectoryExist   = System.doesDirectoryExist             . relative,+      getDirectoryContents = System.Directory.getDirectoryContents . relative,+      getFileContents      = \f -> openBinaryFile (relative f) ReadMode >>= hGetContents     }     relative path = root </> path @@ -1369,8 +1470,10 @@ -- Used by 'checkPackageContent'. -- data CheckPackageContentOps m = CheckPackageContentOps {-    doesFileExist      :: FilePath -> m Bool,-    doesDirectoryExist :: FilePath -> m Bool+    doesFileExist        :: FilePath -> m Bool,+    doesDirectoryExist   :: FilePath -> m Bool,+    getDirectoryContents :: FilePath -> m [FilePath],+    getFileContents      :: FilePath -> m String   }  -- | Sanity check things that requires looking at files in the package.@@ -1384,6 +1487,7 @@                     -> PackageDescription                     -> m [PackageCheck] checkPackageContent ops pkg = do+  cabalBomError   <- checkCabalFileBOM    ops   licenseErrors   <- checkLicensesExist   ops pkg   setupError      <- checkSetupExists     ops pkg   configureError  <- checkConfigureExists ops pkg@@ -1391,10 +1495,50 @@   vcsLocation     <- checkMissingVcsInfo  ops pkg    return $ licenseErrors-        ++ catMaybes [setupError, configureError]+        ++ catMaybes [cabalBomError, setupError, configureError]         ++ localPathErrors         ++ vcsLocation +checkCabalFileBOM :: Monad m => CheckPackageContentOps m+                  -> m (Maybe PackageCheck)+checkCabalFileBOM ops = do+  epdfile <- findPackageDesc ops+  case epdfile of+    Left pc      -> return $ Just pc+    Right pdfile -> (flip check pc . startsWithBOM . fromUTF8) `liftM` (getFileContents ops pdfile)+                       where pc = PackageDistInexcusable $+                                    pdfile ++ " starts with an Unicode byte order mark (BOM). This may cause problems with older cabal versions."++-- |Find a package description file in the given directory.  Looks for+-- @.cabal@ files.  Like 'Distribution.Simple.Utils.findPackageDesc',+-- but generalized over monads.+findPackageDesc :: Monad m => CheckPackageContentOps m+                 -> m (Either PackageCheck FilePath) -- ^<pkgname>.cabal+findPackageDesc ops+ = do let dir = "."+      files <- getDirectoryContents ops dir+      -- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.cabal+      -- file we filter to exclude dirs and null base file names:+      cabalFiles <- filterM (doesFileExist ops)+                       [ dir </> file+                       | file <- files+                       , let (name, ext) = splitExtension file+                       , not (null name) && ext == ".cabal" ]+      case cabalFiles of+        []          -> return (Left $ PackageBuildImpossible noDesc)+        [cabalFile] -> return (Right cabalFile)+        multiple    -> return (Left $ PackageBuildImpossible $ multiDesc multiple)++  where+    noDesc :: String+    noDesc = "No cabal file found.\n"+             ++ "Please create a package description file <pkgname>.cabal"++    multiDesc :: [String] -> String+    multiDesc l = "Multiple cabal files found.\n"+                  ++ "Please use only one of: "+                  ++ intercalate ", " l+ checkLicensesExist :: Monad m => CheckPackageContentOps m                    -> PackageDescription                    -> m [PackageCheck]@@ -1412,10 +1556,11 @@ checkSetupExists :: Monad m => CheckPackageContentOps m                  -> PackageDescription                  -> m (Maybe PackageCheck)-checkSetupExists ops _ = do+checkSetupExists ops pkg = do+  let simpleBuild = buildType pkg == Just Simple   hsexists  <- doesFileExist ops "Setup.hs"   lhsexists <- doesFileExist ops "Setup.lhs"-  return $ check (not hsexists && not lhsexists) $+  return $ check (not simpleBuild && not hsexists && not lhsexists) $     PackageDistInexcusable $       "The package is missing a Setup.hs or Setup.lhs script." @@ -1438,6 +1583,8 @@              | bi <- allBuildInfo pkg              , (dir, kind) <-                   [ (dir, "extra-lib-dirs") | dir <- extraLibDirs bi ]+               ++ [ (dir, "extra-framework-dirs")+                  | dir <- extraFrameworkDirs  bi ]                ++ [ (dir, "include-dirs")   | dir <- includeDirs  bi ]                ++ [ (dir, "hs-source-dirs") | dir <- hsSourceDirs bi ]              , isRelative dir ]@@ -1486,8 +1633,8 @@ -- checkPackageFileNames :: [FilePath] -> [PackageCheck] checkPackageFileNames files =-     (take 1 . catMaybes . map checkWindowsPath $ files)-  ++ (take 1 . catMaybes . map checkTarPath     $ files)+     (take 1 . mapMaybe checkWindowsPath $ files)+  ++ (take 1 . mapMaybe checkTarPath     $ files)       -- If we get any of these checks triggering then we're likely to get       -- many, and that's probably not helpful, so return at most one. 

@@ -23,46 +23,38 @@     -- Utils     parseCondition,     freeVars,+    extractCondition,+    extractConditions,+    addBuildableCondition,     mapCondTree,     mapTreeData,     mapTreeConds,     mapTreeConstrs,+    transformAllBuildInfos,+    transformAllBuildDepends,   ) where +import Control.Applicative -- 7.10 -Werror workaround.+import Prelude+ import Distribution.Package-         ( PackageName, Dependency(..) ) import Distribution.PackageDescription-         ( GenericPackageDescription(..), PackageDescription(..)-         , Library(..), Executable(..), BuildInfo(..)-         , Flag(..), FlagName(..), FlagAssignment-         , Benchmark(..), CondTree(..), ConfVar(..), Condition(..)-         , TestSuite(..) ) import Distribution.PackageDescription.Utils-         ( cabalBug, userBug ) import Distribution.Version-         ( VersionRange, anyVersion, intersectVersionRanges, withinRange ) import Distribution.Compiler-         ( CompilerId(CompilerId) ) import Distribution.System-         ( Platform(..), OS, Arch ) import Distribution.Simple.Utils-         ( currentDir, lowercase )-import Distribution.Simple.Compiler-         ( CompilerInfo(..) )- import Distribution.Text-         ( Text(parse) ) import Distribution.Compat.ReadP as ReadP hiding ( char )-import Control.Arrow (first) import qualified Distribution.Compat.ReadP as ReadP ( char )+import Distribution.Compat.Semigroup as Semi +import Control.Arrow (first) import Data.Char ( isAlphaNum )-import Data.Maybe ( catMaybes, maybeToList )+import Data.Maybe ( mapMaybe, maybeToList ) import Data.Map ( Map, fromListWith, toList ) import qualified Data.Map as Map-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid-#endif+import Data.Tree ( Tree(Node) )  ------------------------------------------------------------------------------ @@ -185,14 +177,14 @@ --   clarity. data DepTestRslt d = DepOk | MissingDeps d -instance Monoid d => Monoid (DepTestRslt d) where+instance Semigroup d => Monoid (DepTestRslt d) where     mempty = DepOk-    mappend DepOk x = x-    mappend x DepOk = x-    mappend (MissingDeps d) (MissingDeps d') = MissingDeps (d `mappend` d')-+    mappend = (Semi.<>) -data BT a = BTN a | BTB (BT a) (BT a)  -- very simple binary tree+instance Semigroup d => Semigroup (DepTestRslt d) where+    DepOk <> x     = x+    x     <> DepOk = x+    (MissingDeps d) <> (MissingDeps d') = MissingDeps (d <> d')   -- | Try to find a flag assignment that satisfies the constraints of all trees.@@ -201,8 +193,9 @@ -- resulting data, the associated dependencies, and the chosen flag -- assignments. ----- In case of failure, the _smallest_ number of of missing dependencies is--- returned. [TODO: Could also be specified with a function argument.]+-- In case of failure, the union of the dependencies that led to backtracking+-- on all branches is returned.+-- [TODO: Could also be specified with a function argument.] -- -- TODO: The current algorithm is rather naive.  A better approach would be to: --@@ -228,65 +221,138 @@        -- ^ Either the missing dependencies (error case), or a pair of        -- (set of build targets with dependencies, chosen flag assignments) resolveWithFlags dom os arch impl constrs trees checkDeps =-    case try dom [] of-      Right r -> Right r-      Left dbt -> Left $ findShortest dbt+    either (Left . fromDepMapUnion) Right $ explore (build [] dom)   where     extraConstrs = toDepMap constrs      -- simplify trees by (partially) evaluating all conditions and converting     -- dependencies to dependency maps.+    simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged]     simplifiedTrees = map ( mapTreeConstrs toDepMap  -- convert to maps+                          . addBuildableCondition pdTaggedBuildInfo                           . mapTreeConds (fst . simplifyWithSysParams os arch impl))                           trees -    -- @try@ recursively tries all possible flag assignments in the domain and-    -- either succeeds or returns a binary tree with the missing dependencies-    -- encountered in each run.  Since the tree is constructed lazily, we-    -- avoid some computation overhead in the successful case.-    try [] flags =+    -- @explore@ searches a tree of assignments, backtracking whenever a flag+    -- introduces a dependency that cannot be satisfied.  If there is no+    -- solution, @explore@ returns the union of all dependencies that caused+    -- it to backtrack.  Since the tree is constructed lazily, we avoid some+    -- computation overhead in the successful case.+    explore :: Tree FlagAssignment+            -> Either DepMapUnion (TargetSet PDTagged, FlagAssignment)+    explore (Node flags ts) =         let targetSet = TargetSet $ flip map simplifiedTrees $                 -- apply additional constraints to all dependencies                 first (`constrainBy` extraConstrs) .                 simplifyCondTree (env flags)             deps = overallDependencies targetSet         in case checkDeps (fromDepMap deps) of-             DepOk           -> Right (targetSet, flags)-             MissingDeps mds -> Left (BTN mds)+             DepOk | null ts   -> Right (targetSet, flags)+                   | otherwise -> tryAll $ map explore ts+             MissingDeps mds   -> Left (toDepMapUnion mds) -    try ((n, vals):rest) flags =-        tryAll $ map (\v -> try rest ((n, v):flags)) vals+    -- Builds a tree of all possible flag assignments.  Internal nodes+    -- have only partial assignments.+    build :: FlagAssignment -> [(FlagName, [Bool])] -> Tree FlagAssignment+    build assigned [] = Node assigned []+    build assigned ((fn, vals) : unassigned) =+        Node assigned $ map (\v -> build ((fn, v) : assigned) unassigned) vals +    tryAll :: [Either DepMapUnion a] -> Either DepMapUnion a     tryAll = foldr mp mz      -- special version of `mplus' for our local purposes-    mp (Left xs)   (Left ys)   = (Left (BTB xs ys))-    mp (Left _)    m@(Right _) = m+    mp :: Either DepMapUnion a -> Either DepMapUnion a -> Either DepMapUnion a     mp m@(Right _) _           = m+    mp _           m@(Right _) = m+    mp (Left xs)   (Left ys)   =+        let union = Map.foldrWithKey (Map.insertWith' combine)+                    (unDepMapUnion xs) (unDepMapUnion ys)+            combine x y = simplifyVersionRange $ unionVersionRanges x y+        in union `seq` Left (DepMapUnion union)      -- `mzero'-    mz = Left (BTN [])+    mz :: Either DepMapUnion a+    mz = Left (DepMapUnion Map.empty) +    env :: FlagAssignment -> FlagName -> Either FlagName Bool     env flags flag = (maybe (Left flag) Right . lookup flag) flags -    -- for the error case we inspect our lazy tree of missing dependencies and-    -- pick the shortest list of missing dependencies-    findShortest (BTN x) = x-    findShortest (BTB lt rt) =-        let l = findShortest lt-            r = findShortest rt-        in case (l,r) of-             ([], xs) -> xs  -- [] is too short-             (xs, []) -> xs-             ([x], _) -> [x] -- single elem is optimum-             (_, [x]) -> [x]-             (xs, ys) -> if lazyLengthCmp xs ys-                         then xs else ys-    -- lazy variant of @\xs ys -> length xs <= length ys@-    lazyLengthCmp [] _ = True-    lazyLengthCmp _ [] = False-    lazyLengthCmp (_:xs) (_:ys) = lazyLengthCmp xs ys+    pdTaggedBuildInfo :: PDTagged -> BuildInfo+    pdTaggedBuildInfo (Lib l) = libBuildInfo l+    pdTaggedBuildInfo (Exe _ e) = buildInfo e+    pdTaggedBuildInfo (Test _ t) = testBuildInfo t+    pdTaggedBuildInfo (Bench _ b) = benchmarkBuildInfo b+    pdTaggedBuildInfo PDNull = mempty +-- | Transforms a 'CondTree' by putting the input under the "then" branch of a+-- conditional that is True when Buildable is True. If 'addBuildableCondition'+-- can determine that Buildable is always True, it returns the input unchanged.+-- If Buildable is always False, it returns the empty 'CondTree'.+addBuildableCondition :: (Eq v, Monoid a, Monoid c) => (a -> BuildInfo)+                      -> CondTree v c a+                      -> CondTree v c a+addBuildableCondition getInfo t =+  case extractCondition (buildable . getInfo) t of+    Lit True  -> t+    Lit False -> CondNode mempty mempty []+    c         -> CondNode mempty mempty [(c, t, Nothing)]++-- Note: extracting buildable conditions.+-- --------------------------------------+--+-- If the conditions in a cond tree lead to Buildable being set to False, then+-- none of the dependencies for this cond tree should actually be taken into+-- account. On the other hand, some of the flags may only be decided in the+-- solver, so we cannot necessarily make the decision whether a component is+-- Buildable or not prior to solving.+--+-- What we are doing here is to partially evaluate a condition tree in order to+-- extract the condition under which Buildable is True. The predicate determines+-- whether data under a 'CondTree' is buildable.+++-- | Extract the condition matched by the given predicate from a cond tree.+--+-- We use this mainly for extracting buildable conditions (see the Note above),+-- but the function is in fact more general.+extractCondition :: Eq v => (a -> Bool) -> CondTree v c a -> Condition v+extractCondition p = go+  where+    go (CondNode x _ cs) | not (p x) = Lit False+                         | otherwise = goList cs++    goList []               = Lit True+    goList ((c, t, e) : cs) =+      let+        ct = go t+        ce = maybe (Lit True) go e+      in+        ((c `cAnd` ct) `cOr` (CNot c `cAnd` ce)) `cAnd` goList cs++-- | Extract conditions matched by the given predicate from all cond trees in a+-- 'GenericPackageDescription'.+extractConditions :: (BuildInfo -> Bool) -> GenericPackageDescription+                     -> [Condition ConfVar]+extractConditions f gpkg =+  concat [+      maybeToList $ extractCondition (f . libBuildInfo) <$> condLibrary     gpkg+    , extractCondition (f . buildInfo)          . snd   <$> condExecutables gpkg+    , extractCondition (f . testBuildInfo)      . snd   <$> condTestSuites  gpkg+    , extractCondition (f . benchmarkBuildInfo) . snd   <$> condBenchmarks  gpkg+    ]+++-- | A map of dependencies that combines version ranges using 'unionVersionRanges'.+newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName VersionRange }++toDepMapUnion :: [Dependency] -> DepMapUnion+toDepMapUnion ds =+  DepMapUnion $ fromListWith unionVersionRanges [ (p,vr) | Dependency p vr <- ds ]++fromDepMapUnion :: DepMapUnion -> [Dependency]+fromDepMapUnion m = [ Dependency p vr | (p,vr) <- toList (unDepMapUnion m) ]+ -- | A map of dependencies.  Newtyped since the default monoid instance is not --   appropriate.  The monoid instance uses 'intersectVersionRanges'. newtype DependencyMap = DependencyMap { unDependencyMap :: Map PackageName VersionRange }@@ -294,7 +360,10 @@  instance Monoid DependencyMap where     mempty = DependencyMap Map.empty-    (DependencyMap a) `mappend` (DependencyMap b) =+    mappend = (Semi.<>)++instance Semigroup DependencyMap where+    (DependencyMap a) <> (DependencyMap b) =         DependencyMap (Map.unionWith intersectVersionRanges a b)  toDepMap :: [Dependency] -> DependencyMap@@ -304,18 +373,20 @@ fromDepMap :: DependencyMap -> [Dependency] fromDepMap m = [ Dependency p vr | (p,vr) <- toList (unDependencyMap m) ] +-- | Flattens a CondTree using a partial flag assignment.  When a condition+-- cannot be evaluated, both branches are ignored. simplifyCondTree :: (Monoid a, Monoid d) =>                     (v -> Either v Bool)                  -> CondTree v d a                  -> (d, a) simplifyCondTree env (CondNode a d ifs) =-    mconcat $ (d, a) : catMaybes (map simplifyIf ifs)+    mconcat $ (d, a) : mapMaybe simplifyIf ifs   where     simplifyIf (cnd, t, me) =         case simplifyCondition cnd env of           (Lit True, _) -> Just $ simplifyCondTree env t           (Lit False, _) -> fmap (simplifyCondTree env) me-          _ -> error $ "Environment not defined for all free vars"+          _ -> Nothing  -- | Flatten a CondTree.  This will resolve the CondTree by taking all --  possible paths into account.  Note that since branches represent exclusive@@ -350,11 +421,11 @@   where     (depss, _) = unzip $ filter (removeDisabledSections . snd) targets     removeDisabledSections :: PDTagged -> Bool-    removeDisabledSections (Lib _) = True-    removeDisabledSections (Exe _ _) = True-    removeDisabledSections (Test _ t) = testEnabled t-    removeDisabledSections (Bench _ b) = benchmarkEnabled b-    removeDisabledSections PDNull = True+    removeDisabledSections (Lib l)     = buildable (libBuildInfo l)+    removeDisabledSections (Exe _ e)   = buildable (buildInfo e)+    removeDisabledSections (Test _ t)  = testEnabled t && buildable (testBuildInfo t)+    removeDisabledSections (Bench _ b) = benchmarkEnabled b && buildable (benchmarkBuildInfo b)+    removeDisabledSections PDNull      = True  -- Apply extra constraints to a dependency map. -- Combines dependencies where the result will only contain keys from the left@@ -440,14 +511,17 @@  instance Monoid PDTagged where     mempty = PDNull-    PDNull `mappend` x = x-    x `mappend` PDNull = x-    Lib l `mappend` Lib l' = Lib (l `mappend` l')-    Exe n e `mappend` Exe n' e' | n == n' = Exe n (e `mappend` e')-    Test n t `mappend` Test n' t' | n == n' = Test n (t `mappend` t')-    Bench n b `mappend` Bench n' b' | n == n' = Bench n (b `mappend` b')-    _ `mappend` _ = cabalBug "Cannot combine incompatible tags"+    mappend = (Semi.<>) +instance Semigroup PDTagged where+    PDNull    <> x      = x+    x         <> PDNull = x+    Lib l     <> Lib l' = Lib (l <> l')+    Exe n e   <> Exe   n' e' | n == n' = Exe n (e <> e')+    Test n t  <> Test  n' t' | n == n' = Test n (t <> t')+    Bench n b <> Bench n' b' | n == n' = Bench n (b <> b')+    _         <> _  = cabalBug "Cannot combine incompatible tags"+ -- | Create a package description with all configurations resolved. -- -- This function takes a `GenericPackageDescription` and several environment@@ -465,9 +539,10 @@ -- -- This function will fail if it cannot find a flag assignment that leads to -- satisfiable dependencies.  (It will not try alternative assignments for--- explicitly specified flags.)  In case of failure it will return a /minimum/--- number of dependencies that could not be satisfied.  On success, it will--- return the package description and the full flag assignment chosen.+-- explicitly specified flags.)  In case of failure it will return the missing+-- dependencies that it encountered when trying different flag assignments.+-- On success, it will return the package description and the full flag+-- assignment chosen. -- finalizePackageDescription ::      FlagAssignment  -- ^ Explicitly specified flag assignments@@ -492,10 +567,6 @@                     , testSuites = tests'                     , benchmarks = bms'                     , buildDepends = fromDepMap (overallDependencies targetSet)-                      --TODO: we need to find a way to avoid pulling in deps-                      -- for non-buildable components. However cannot simply-                      -- filter at this stage, since if the package were not-                      -- available we would have failed already.                     }               , flagVals ) @@ -607,3 +678,82 @@     if null (hsSourceDirs bi)     then bi { hsSourceDirs = [currentDir] }     else bi++-- Walk a 'GenericPackageDescription' and apply @onBuildInfo@/@onSetupBuildInfo@+-- to all nested 'BuildInfo'/'SetupBuildInfo' values.+transformAllBuildInfos :: (BuildInfo -> BuildInfo)+                       -> (SetupBuildInfo -> SetupBuildInfo)+                       -> GenericPackageDescription+                       -> GenericPackageDescription+transformAllBuildInfos onBuildInfo onSetupBuildInfo gpd = gpd'+  where+    onLibrary    lib  = lib { libBuildInfo  = onBuildInfo $ libBuildInfo  lib }+    onExecutable exe  = exe { buildInfo     = onBuildInfo $ buildInfo     exe }+    onTestSuite  tst  = tst { testBuildInfo = onBuildInfo $ testBuildInfo tst }+    onBenchmark  bmk  = bmk { benchmarkBuildInfo =+                                 onBuildInfo $ benchmarkBuildInfo bmk }++    pd = packageDescription gpd+    pd'  = pd {+      library        = fmap onLibrary        (library pd),+      executables    = map  onExecutable     (executables pd),+      testSuites     = map  onTestSuite      (testSuites pd),+      benchmarks     = map  onBenchmark      (benchmarks pd),+      setupBuildInfo = fmap onSetupBuildInfo (setupBuildInfo pd)+      }++    gpd' = transformAllCondTrees onLibrary onExecutable+           onTestSuite onBenchmark id+           $ gpd { packageDescription = pd' }++-- | Walk a 'GenericPackageDescription' and apply @f@ to all nested+-- @build-depends@ fields.+transformAllBuildDepends :: (Dependency -> Dependency)+                         -> GenericPackageDescription+                         -> GenericPackageDescription+transformAllBuildDepends f gpd = gpd'+  where+    onBI  bi  = bi  { targetBuildDepends = map f $ targetBuildDepends bi }+    onSBI stp = stp { setupDepends       = map f $ setupDepends stp      }+    onPD  pd  = pd  { buildDepends       = map f $ buildDepends pd       }++    pd'   = onPD $ packageDescription gpd+    gpd'  = transformAllCondTrees id id id id (map f)+            . transformAllBuildInfos onBI onSBI+            $ gpd { packageDescription = pd' }++-- | Walk all 'CondTree's inside a 'GenericPackageDescription' and apply+-- appropriate transformations to all nodes. Helper function used by+-- 'transformAllBuildDepends' and 'transformAllBuildInfos'.+transformAllCondTrees :: (Library -> Library)+                      -> (Executable -> Executable)+                      -> (TestSuite -> TestSuite)+                      -> (Benchmark -> Benchmark)+                      -> ([Dependency] -> [Dependency])+                      -> GenericPackageDescription -> GenericPackageDescription+transformAllCondTrees onLibrary onExecutable+  onTestSuite onBenchmark onDepends gpd = gpd'+  where+    gpd'    = gpd {+      condLibrary        = condLib',+      condExecutables    = condExes',+      condTestSuites     = condTests',+      condBenchmarks     = condBenchs'+      }++    condLib    = condLibrary        gpd+    condExes   = condExecutables    gpd+    condTests  = condTestSuites     gpd+    condBenchs = condBenchmarks     gpd++    condLib'    = fmap (onCondTree onLibrary)             condLib+    condExes'   = map  (mapSnd $ onCondTree onExecutable) condExes+    condTests'  = map  (mapSnd $ onCondTree onTestSuite)  condTests+    condBenchs' = map  (mapSnd $ onCondTree onBenchmark)  condBenchs++    mapSnd :: (a -> b) -> (c,a) -> (c,b)+    mapSnd = fmap++    onCondTree :: (a -> b) -> CondTree v [Dependency] a+               -> CondTree v [Dependency] b+    onCondTree g = mapCondTree g onDepends id

@@ -41,49 +41,35 @@         flagFieldDescrs   ) where -import Data.Char  (isSpace)-import Data.Maybe (listToMaybe, isJust)-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid ( Monoid(..) )-#endif-import Data.List  (nub, unfoldr, partition, (\\))+import Distribution.ParseUtils hiding (parseFields)+import Distribution.PackageDescription+import Distribution.PackageDescription.Utils+import Distribution.Package+import Distribution.ModuleName+import Distribution.Version+import Distribution.Verbosity+import Distribution.Compiler+import Distribution.PackageDescription.Configuration+import Distribution.Simple.Utils+import Distribution.Text+import Distribution.Compat.ReadP hiding (get)++import Data.Char     (isSpace)+import Data.Foldable (traverse_)+import Data.Maybe    (listToMaybe, isJust)+import Data.List     (nub, unfoldr, partition, (\\)) import Control.Monad (liftM, foldM, when, unless, ap) #if __GLASGOW_HASKELL__ < 710+import Data.Monoid         (Monoid(..)) import Control.Applicative (Applicative(..)) #endif-import Control.Arrow (first)+import Control.Arrow    (first) import System.Directory (doesFileExist) import qualified Data.ByteString.Lazy.Char8 as BS.Char8-import Data.Typeable-import Data.Data-import qualified Data.Map as Map -import Distribution.Text-         ( Text(disp, parse), display, simpleParse )-import Distribution.Compat.ReadP-         ((+++), option)-import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint -import Distribution.ParseUtils hiding (parseFields)-import Distribution.PackageDescription-import Distribution.PackageDescription.Utils-         ( cabalBug, userBug )-import Distribution.Package-         ( PackageIdentifier(..), Dependency(..), packageName, packageVersion )-import Distribution.ModuleName ( ModuleName )-import Distribution.Version-        ( Version(Version), orLaterVersion-        , LowerBound(..), asVersionIntervals )-import Distribution.Verbosity (Verbosity)-import Distribution.Compiler  (CompilerFlavor(..))-import Distribution.PackageDescription.Configuration (parseCondition, freeVars)-import Distribution.Simple.Utils-         ( die, dieWithLocation, warn, intercalate, lowercase, cabalVersion-         , withFileContents, withUTF8FileContents-         , writeFileAtomic, writeUTF8File ) - -- ----------------------------------------------------------------------------- -- The PackageDescription type @@ -403,8 +389,7 @@            buildTools         (\xs  binfo -> binfo{buildTools=xs})  , commaListFieldWithSep vcat "build-depends"            disp                   parse-           buildDependsWithRenaming-           setBuildDependsWithRenaming+           targetBuildDepends (\xs binfo -> binfo{targetBuildDepends=xs})  , spaceListField "cpp-options"            showToken          parseTokenQ'            cppOptions          (\val binfo -> binfo{cppOptions=val})@@ -420,6 +405,9 @@  , listField "frameworks"            showToken          parseTokenQ            frameworks         (\val binfo -> binfo{frameworks=val})+ , listField "extra-framework-dirs"+           showToken          parseFilePathQ+           extraFrameworkDirs (\val binfo -> binfo{extraFrameworkDirs=val})  , listFieldWithSep vcat "c-sources"            showFilePath       parseFilePathQ            cSources           (\paths binfo -> binfo{cSources=paths})@@ -530,6 +518,15 @@         repoSubdir                 (\val repo -> repo { repoSubdir = val })     ] +------------------------------------------------------------------------------++setupBInfoFieldDescrs :: [FieldDescr SetupBuildInfo]+setupBInfoFieldDescrs =+    [ commaListFieldWithSep vcat "setup-depends"+        disp         parse+        setupDepends (\xs binfo -> binfo{setupDepends=xs})+    ]+ -- --------------------------------------------------------------- -- Parsing @@ -589,7 +586,8 @@ -- prop_isMapM fs = mapSimpleFields return fs == return fs  --- names of fields that represents dependencies, thus consrca+-- names of fields that represents dependencies+-- TODO: maybe build-tools should go here too? constraintFieldNames :: [String] constraintFieldNames = ["build-depends"] @@ -597,9 +595,9 @@ -- they add and define an accessor that specifies what the dependencies -- are.  This way we would completely reuse the parsing knowledge from the -- field descriptor.-parseConstraint :: Field -> ParseResult [DependencyWithRenaming]+parseConstraint :: Field -> ParseResult [Dependency] parseConstraint (F l n v)-    | n == "build-depends" = runP l n (parseCommaList parse) v+    | n `elem` constraintFieldNames = runP l n (parseCommaList parse) v parseConstraint f = userBug $ "Constraint was expected (got: " ++ show f ++ ")"  {-@@ -627,12 +625,19 @@ instance Functor f => Functor (StT s f) where     fmap g (StT f) = StT $ fmap (first g)  . f +#if __GLASGOW_HASKELL__ >= 710+instance (Monad m) => Applicative (StT s m) where+#else instance (Monad m, Functor m) => Applicative (StT s m) where-    pure = return+#endif+    pure a = StT (\s -> return (a,s))     (<*>) = ap + instance Monad m => Monad (StT s m) where+#if __GLASGOW_HASKELL__ < 710     return a = StT (\s -> return (a,s))+#endif     StT f >>= g = StT $ \s -> do                         (a,s') <- f s                         runStT (g a) s'@@ -736,13 +741,13 @@            -- 'getBody' assumes that the remaining fields only consist of           -- flags, lib and exe sections.-        (repos, flags, mlib, exes, tests, bms) <- getBody+        (repos, flags, mcsetup, mlib, exes, tests, bms) <- getBody         warnIfRest  -- warn if getBody did not parse up to the last field.           -- warn about using old/new syntax with wrong cabal-version:         maybeWarnCabalVersion (not $ oldSyntax fields0) pkg         checkForUndefinedFlags flags mlib exes tests         return $ GenericPackageDescription-                   pkg { sourceRepos = repos }+                   pkg { sourceRepos = repos, setupBuildInfo = mcsetup }                    flags mlib exes tests bms    where@@ -848,6 +853,7 @@     -- The body consists of an optional sequence of declarations of flags and     -- an arbitrary number of executables and at most one library.     getBody :: PM ([SourceRepo], [Flag]+                  ,Maybe SetupBuildInfo                   ,Maybe (CondTree ConfVar [Dependency] Library)                   ,[(String, CondTree ConfVar [Dependency] Executable)]                   ,[(String, CondTree ConfVar [Dependency] TestSuite)]@@ -860,8 +866,8 @@             exename <- lift $ runP line_no "executable" parseTokenQ sec_label             flds <- collectFields parseExeFields sec_fields             skipField-            (repos, flags, lib, exes, tests, bms) <- getBody-            return (repos, flags, lib, (exename, flds): exes, tests, bms)+            (repos, flags, csetup, lib, exes, tests, bms) <- getBody+            return (repos, flags, csetup, lib, (exename, flds): exes, tests, bms)          | sec_type == "test-suite" -> do             when (null sec_label) $ lift $ syntaxError line_no@@ -890,7 +896,6 @@                         -- Does the current node specify a test type?                         hasTestType = testInterface ts'                             /= testInterface emptyTestSuite-                        components = condTreeComponents ct                     -- If the current level of the tree specifies a type,                     -- then we are done. If not, then one of the conditional                     -- branches below the current node must specify a type.@@ -898,12 +903,13 @@                     -- only one need one to specify a type because the                     -- configure step uses 'mappend' to join together the                     -- results of flag resolution.-                    in hasTestType || any checkComponent components+                    in hasTestType || any checkComponent (condTreeComponents ct)             if checkTestType emptyTestSuite flds                 then do                     skipField-                    (repos, flags, lib, exes, tests, bms) <- getBody-                    return (repos, flags, lib, exes, (testname, flds) : tests, bms)+                    (repos, flags, csetup, lib, exes, tests, bms) <- getBody+                    return (repos, flags, csetup, lib, exes,+                            (testname, flds) : tests, bms)                 else lift $ syntaxError line_no $                          "Test suite \"" ++ testname                       ++ "\" is missing required field \"type\" or the field "@@ -938,7 +944,6 @@                         -- Does the current node specify a benchmark type?                         hasBenchmarkType = benchmarkInterface ts'                             /= benchmarkInterface emptyBenchmark-                        components = condTreeComponents ct                     -- If the current level of the tree specifies a type,                     -- then we are done. If not, then one of the conditional                     -- branches below the current node must specify a type.@@ -946,12 +951,13 @@                     -- only one need one to specify a type because the                     -- configure step uses 'mappend' to join together the                     -- results of flag resolution.-                    in hasBenchmarkType || any checkComponent components+                    in hasBenchmarkType || any checkComponent (condTreeComponents ct)             if checkBenchmarkType emptyBenchmark flds                 then do                     skipField-                    (repos, flags, lib, exes, tests, bms) <- getBody-                    return (repos, flags, lib, exes, tests, (benchname, flds) : bms)+                    (repos, flags, csetup, lib, exes, tests, bms) <- getBody+                    return (repos, flags, csetup, lib, exes,+                            tests, (benchname, flds) : bms)                 else lift $ syntaxError line_no $                          "Benchmark \"" ++ benchname                       ++ "\" is missing required field \"type\" or the field "@@ -964,10 +970,10 @@               syntaxError line_no "'library' expects no argument"             flds <- collectFields parseLibFields sec_fields             skipField-            (repos, flags, lib, exes, tests, bms) <- getBody+            (repos, flags, csetup, lib, exes, tests, bms) <- getBody             when (isJust lib) $ lift $ syntaxError line_no               "There can only be one library section in a package description."-            return (repos, flags, Just flds, exes, tests, bms)+            return (repos, flags, csetup, Just flds, exes, tests, bms)          | sec_type == "flag" -> do             when (null sec_label) $ lift $@@ -978,8 +984,8 @@                     (MkFlag (FlagName (lowercase sec_label)) "" True False)                     sec_fields             skipField-            (repos, flags, lib, exes, tests, bms) <- getBody-            return (repos, flag:flags, lib, exes, tests, bms)+            (repos, flags, csetup, lib, exes, tests, bms) <- getBody+            return (repos, flag:flags, csetup, lib, exes, tests, bms)          | sec_type == "source-repository" -> do             when (null sec_label) $ lift $ syntaxError line_no $@@ -1003,9 +1009,23 @@                     }                     sec_fields             skipField-            (repos, flags, lib, exes, tests, bms) <- getBody-            return (repo:repos, flags, lib, exes, tests, bms)+            (repos, flags, csetup, lib, exes, tests, bms) <- getBody+            return (repo:repos, flags, csetup, lib, exes, tests, bms) +        | sec_type == "custom-setup" -> do+            unless (null sec_label) $ lift $+              syntaxError line_no "'setup' expects no argument"+            flds <- lift $ parseFields+                             setupBInfoFieldDescrs+                             warnUnrec+                             mempty+                             sec_fields+            skipField+            (repos, flags, csetup0, lib, exes, tests, bms) <- getBody+            when (isJust csetup0) $ lift $ syntaxError line_no+              "There can only be one 'custom-setup' section in a package description."+            return (repos, flags, Just flds, lib, exes, tests, bms)+         | otherwise -> do             lift $ warning $ "Ignoring unknown section type: " ++ sec_type             skipField@@ -1020,7 +1040,7 @@               "If-blocks are not allowed in between stanzas: " ++ show f             skipField             getBody-      Nothing -> return ([], [], Nothing, [], [], [])+      Nothing -> return ([], [], Nothing, Nothing, [], [], [])      -- Extracts all fields in a block and returns a 'CondTree'.     --@@ -1034,18 +1054,30 @@             condFlds = [ f | f@IfBlock{} <- allflds ]             sections = [ s | s@Section{} <- allflds ] -        -- Put these through the normal parsing pass too, so that we-        -- collect the ModRenamings-        let depFlds = filter isConstraint simplFlds-                 mapM_             (\(Section l n _ _) -> lift . warning $                 "Unexpected section '" ++ n ++ "' on line " ++ show l)             sections          a <- parser simplFlds-        deps <- liftM concat . mapM (lift . fmap (map dependency) .  parseConstraint) $ depFlds +        -- Dependencies must be treated specially: when we+        -- parse into a CondTree, not only do we parse them into+        -- the targetBuildDepends/etc field inside the+        -- PackageDescription, but we also have to put the+        -- combined dependencies into CondTree.+        --+        -- This information is, in principle, redundant, but+        -- putting it here makes it easier for the constraint+        -- solver to pick a flag assignment which supports+        -- all of the dependencies (because it only has+        -- to check the CondTree, rather than grovel everywhere+        -- inside the conditional bits).+        deps <- liftM concat+              . mapM (lift . parseConstraint)+              . filter isConstraint+              $ simplFlds+         ifs <- mapM processIfs condFlds          return (CondNode a deps ifs)@@ -1091,7 +1123,7 @@         PM ()     checkForUndefinedFlags flags mlib exes tests = do         let definedFlags = map flagName flags-        maybe (return ()) (checkCondTreeFlags definedFlags) mlib+        traverse_ (checkCondTreeFlags definedFlags) mlib         mapM_ (checkCondTreeFlags definedFlags . snd) exes         mapM_ (checkCondTreeFlags definedFlags . snd) tests @@ -1248,32 +1280,3 @@  --test_findIndentTabs = findIndentTabs $ unlines $ --    [ "foo", "  bar", " \t baz", "\t  biz\t", "\t\t \t mib" ]---- | Dependencies plus module renamings.  This is what users specify; however,--- renaming information is not used for dependency resolution.-data DependencyWithRenaming = DependencyWithRenaming Dependency ModuleRenaming-  deriving (Read, Show, Eq, Typeable, Data)--dependency :: DependencyWithRenaming -> Dependency-dependency (DependencyWithRenaming dep _) = dep--instance Text DependencyWithRenaming where-  disp (DependencyWithRenaming d rns) = disp d <+> disp rns-  parse = do d <- parse-             Parse.skipSpaces-             rns <- parse-             Parse.skipSpaces-             return (DependencyWithRenaming d rns)--buildDependsWithRenaming :: BuildInfo -> [DependencyWithRenaming]-buildDependsWithRenaming pkg =-    map (\dep@(Dependency n _) ->-            DependencyWithRenaming dep-                (Map.findWithDefault defaultRenaming n (targetBuildRenaming pkg)))-        (targetBuildDepends pkg)--setBuildDependsWithRenaming :: [DependencyWithRenaming] -> BuildInfo -> BuildInfo-setBuildDependsWithRenaming deps pkg = pkg {-    targetBuildDepends = map dependency deps,-    targetBuildRenaming = Map.fromList (map (\(DependencyWithRenaming (Dependency n _) rns) -> (n, rns)) deps)-  }

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  Distribution.PackageDescription.PrettyPrint@@ -18,27 +17,18 @@     showGenericPackageDescription, ) where -#if __GLASGOW_HASKELL__ < 710-import Data.Monoid (Monoid(mempty))-#endif import Distribution.PackageDescription-       ( Benchmark(..), BenchmarkInterface(..), benchmarkType-       , TestSuite(..), TestSuiteInterface(..), testType-       , SourceRepo(..),-        customFieldsBI, CondTree(..), Condition(..),-        FlagName(..), ConfVar(..), Executable(..), Library(..),-        Flag(..), PackageDescription(..),-        GenericPackageDescription(..))+import Distribution.Simple.Utils+import Distribution.ParseUtils+import Distribution.PackageDescription.Parse+import Distribution.Package+import Distribution.Text++import Data.Monoid as Mon (Monoid(mempty))+import Data.Maybe (isJust) import Text.PrettyPrint-       (hsep, parens, char, nest, empty,-        isEmpty, ($$), (<+>), colon, (<>), text, vcat, ($+$), Doc, render)-import Distribution.Simple.Utils (writeUTF8File)-import Distribution.ParseUtils (showFreeText, FieldDescr(..), indentWith, ppField, ppFields)-import Distribution.PackageDescription.Parse (pkgDescrFieldDescrs,binfoFieldDescrs,libFieldDescrs,-       sourceRepoFieldDescrs,flagFieldDescrs)-import Distribution.Package (Dependency(..))-import Distribution.Text (Text(..))-import Data.Maybe (isJust, fromJust, isNothing)+       (hsep, parens, char, nest, empty, isEmpty, ($$), (<+>),+        colon, (<>), text, vcat, ($+$), Doc, render)  -- | Recompile with false for regression testing simplifiedPrinting :: Bool@@ -226,18 +216,37 @@         else res   where     -- TODO: this ends up printing trailing spaces when combined with nest.-    ppIf (c,thenTree,mElseTree)          =-        ((emptyLine $ text "if" <+> ppCondition c) $$-          nest indentWith (ppCondTree thenTree-                    (if simplifiedPrinting then (Just it) else Nothing) ppIt))-        $+$ (if isNothing mElseTree-                then empty-                else text "else"-                    $$ nest indentWith (ppCondTree (fromJust mElseTree)-                        (if simplifiedPrinting then (Just it) else Nothing) ppIt))+    ppIf (c, thenTree, Just elseTree) = ppIfElse it ppIt c thenTree elseTree+    ppIf (c, thenTree, Nothing)       = ppIf' it ppIt c thenTree -emptyLine :: Doc -> Doc-emptyLine d                              = text "" $+$ d+ppIfCondition :: (Condition ConfVar) -> Doc+ppIfCondition c = (emptyLine $ text "if" <+> ppCondition c) +ppIf' :: a -> (a -> Maybe a -> Doc)+           -> Condition ConfVar+           -> CondTree ConfVar [Dependency] a+           -> Doc+ppIf' it ppIt c thenTree =+  if isEmpty thenDoc+     then Mon.mempty+     else ppIfCondition c $$ nest indentWith thenDoc+  where thenDoc = ppCondTree thenTree (if simplifiedPrinting then (Just it) else Nothing) ppIt +ppIfElse :: a -> (a -> Maybe a -> Doc)+              -> Condition ConfVar+              -> CondTree ConfVar [Dependency] a+              -> CondTree ConfVar [Dependency] a+              -> Doc+ppIfElse it ppIt c thenTree elseTree =+  case (isEmpty thenDoc, isEmpty elseDoc) of+    (True,  True)  -> Mon.mempty+    (False, True)  -> ppIfCondition c $$ nest indentWith thenDoc+    (True,  False) -> ppIfCondition (cNot c) $$ nest indentWith elseDoc+    (False, False) -> (ppIfCondition c $$ nest indentWith thenDoc)+                      $+$ (text "else" $$ nest indentWith elseDoc)+  where thenDoc = ppCondTree thenTree (if simplifiedPrinting then (Just it) else Nothing) ppIt+        elseDoc = ppCondTree elseTree (if simplifiedPrinting then (Just it) else Nothing) ppIt++emptyLine :: Doc -> Doc+emptyLine d                              = text "" $+$ d 

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  Distribution.ParseUtils@@ -40,21 +39,17 @@         UnrecFieldParser, warnUnrec, ignoreUnrec,   ) where -import Distribution.Compiler (CompilerFlavor, parseCompilerFlavorCompat)+import Distribution.Compiler import Distribution.License import Distribution.Version-         ( Version(..), VersionRange, anyVersion )-import Distribution.Package     ( PackageName(..), Dependency(..) )-import Distribution.ModuleName (ModuleName)+import Distribution.Package+import Distribution.ModuleName+import qualified Distribution.Compat.MonadFail as Fail import Distribution.Compat.ReadP as ReadP hiding (get) import Distribution.ReadE import Distribution.Text-         ( Text(..) ) import Distribution.Simple.Utils-         ( comparing, dropWhileEndLE, intercalate, lowercase-         , normaliseLineEndings ) import Language.Haskell.Extension-         ( Language, Extension )  import Text.PrettyPrint hiding (braces) import Data.Char (isSpace, toLower, isAlphaNum, isDigit)@@ -62,9 +57,7 @@ import Data.Tree as Tree (Tree(..), flatten) import qualified Data.Map as Map import Control.Monad (foldM, ap)-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative (Applicative(..))-#endif+import Control.Applicative as AP (Applicative(..)) import System.FilePath (normalise) import Data.List (sortBy) @@ -98,16 +91,19 @@         fmap f (ParseOk ws x) = ParseOk ws $ f x  instance Applicative ParseResult where-        pure = return+        pure = ParseOk []         (<*>) = ap   instance Monad ParseResult where-        return = ParseOk []+        return = AP.pure         ParseFailed err >>= _ = ParseFailed err         ParseOk ws x >>= f = case f x of                                ParseFailed err -> ParseFailed err                                ParseOk ws' x' -> ParseOk (ws'++ws) x'+        fail = Fail.fail++instance Fail.MonadFail ParseResult where         fail s = ParseFailed (FromString s Nothing)  catchParseError :: ParseResult a -> (PError -> ParseResult a)@@ -660,8 +656,7 @@ parseOptVersion :: ReadP r Version parseOptVersion = parseQuoted ver <++ ver   where ver :: ReadP r Version-        ver = parse <++ return noVersion-        noVersion = Version [] []+        ver = parse <++ return (Version [] [])  parseTestedWithQ :: ReadP r (CompilerFlavor,VersionRange) parseTestedWithQ = parseQuoted tw <++ tw

@@ -56,63 +56,48 @@ -- local import Distribution.Simple.Compiler hiding (Flag) import Distribution.Simple.UserHooks-import Distribution.Package --must not specify imports, since we're exporting module.-import Distribution.PackageDescription-         ( PackageDescription(..), GenericPackageDescription, Executable(..)-         , updatePackageDescription, hasLibs-         , HookedBuildInfo, emptyHookedBuildInfo )+import Distribution.Package+import Distribution.PackageDescription hiding (Flag) import Distribution.PackageDescription.Parse-         ( readPackageDescription, readHookedBuildInfo ) import Distribution.PackageDescription.Configuration-         ( flattenPackageDescription ) import Distribution.Simple.Program-         ( defaultProgramConfiguration, addKnownPrograms, builtinPrograms-         , restoreProgramConfiguration, reconfigurePrograms )-import Distribution.Simple.PreProcess (knownSuffixHandlers, PPSuffixHandler)+import Distribution.Simple.Program.Db+import Distribution.Simple.PreProcess import Distribution.Simple.Setup import Distribution.Simple.Command -import Distribution.Simple.Build        ( build, repl )-import Distribution.Simple.SrcDist      ( sdist )+import Distribution.Simple.Build+import Distribution.Simple.SrcDist import Distribution.Simple.Register-         ( register, unregister )  import Distribution.Simple.Configure-         ( getPersistBuildConfig, maybeGetPersistBuildConfig-         , writePersistBuildConfig, checkPersistBuildConfigOutdated-         , configure, checkForeignDeps ) -import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )-import Distribution.Simple.Bench (bench)-import Distribution.Simple.BuildPaths ( srcPref)-import Distribution.Simple.Test (test)-import Distribution.Simple.Install (install)-import Distribution.Simple.Haddock (haddock, hscolour)+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.Bench+import Distribution.Simple.BuildPaths+import Distribution.Simple.Test+import Distribution.Simple.Install+import Distribution.Simple.Haddock import Distribution.Simple.Utils-         (die, notice, info, warn, setupMessage, chattyTry,-          defaultPackageDesc, defaultHookedPackageDesc,-          rawSystemExitWithEnv, cabalVersion, topHandler )-import Distribution.System-         ( OS(..), buildOS )+import Distribution.Utils.NubList import Distribution.Verbosity import Language.Haskell.Extension import Distribution.Version import Distribution.License import Distribution.Text-         ( display )  -- Base-import System.Environment(getArgs, getProgName)-import System.Directory(removeFile, doesFileExist,-                        doesDirectoryExist, removeDirectoryRecursive)-import System.Exit       (exitWith,ExitCode(..))-import System.IO.Error   (isDoesNotExistError)-import Control.Exception (throwIO)-import Distribution.Compat.Environment (getEnvironment)-import Distribution.Compat.Exception (catchIO)+import System.Environment (getArgs, getProgName)+import System.Directory   (removeFile, doesFileExist+                          ,doesDirectoryExist, removeDirectoryRecursive)+import System.Exit                          (exitWith,ExitCode(..))+import System.FilePath                      (searchPathSeparator)+import Distribution.Compat.Environment      (getEnvironment)+import Distribution.Compat.GetShortPathName (getShortPathName)  import Control.Monad   (when)-import Data.List       (intercalate, unionBy, nub, (\\))+import Data.Foldable   (traverse_)+import Data.List       (unionBy, nub, (\\))  -- | A simple implementation of @main@ for a Cabal setup script. -- It reads the package description file using IO, and performs the@@ -196,151 +181,166 @@  configureAction :: UserHooks -> ConfigFlags -> Args -> IO LocalBuildInfo configureAction hooks flags args = do-                let distPref = fromFlag $ configDistPref flags-                pbi <- preConf hooks args flags+    distPref <- findDistPrefOrDefault (configDistPref flags)+    let flags' = flags { configDistPref = toFlag distPref }+    pbi <- preConf hooks args flags' -                (mb_pd_file, pkg_descr0) <- confPkgDescr+    (mb_pd_file, pkg_descr0) <- confPkgDescr -                --    get_pkg_descr (configVerbosity flags')-                --let pkg_descr = updatePackageDescription pbi pkg_descr0-                let epkg_descr = (pkg_descr0, pbi)+    --get_pkg_descr (configVerbosity flags')+    --let pkg_descr = updatePackageDescription pbi pkg_descr0+    let epkg_descr = (pkg_descr0, pbi) -                --(warns, ers) <- sanityCheckPackage pkg_descr-                --errorOut (configVerbosity flags') warns ers+    --(warns, ers) <- sanityCheckPackage pkg_descr+    --errorOut (configVerbosity flags') warns ers -                localbuildinfo0 <- confHook hooks epkg_descr flags+    localbuildinfo0 <- confHook hooks epkg_descr flags' -                -- remember the .cabal filename if we know it-                -- and all the extra command line args-                let localbuildinfo = localbuildinfo0 {-                                       pkgDescrFile = mb_pd_file,-                                       extraConfigArgs = args-                                     }-                writePersistBuildConfig distPref localbuildinfo+    -- remember the .cabal filename if we know it+    -- and all the extra command line args+    let localbuildinfo = localbuildinfo0 {+                           pkgDescrFile = mb_pd_file,+                           extraConfigArgs = args+                         }+    writePersistBuildConfig distPref localbuildinfo -                let pkg_descr = localPkgDescr localbuildinfo-                postConf hooks args flags pkg_descr localbuildinfo-                return localbuildinfo-              where-                verbosity = fromFlag (configVerbosity flags)-                confPkgDescr :: IO (Maybe FilePath, GenericPackageDescription)-                confPkgDescr = do-                  mdescr <- readDesc hooks-                  case mdescr of-                    Just descr -> return (Nothing, descr)-                    Nothing -> do-                      pdfile <- defaultPackageDesc verbosity-                      descr  <- readPackageDescription verbosity pdfile-                      return (Just pdfile, descr)+    let pkg_descr = localPkgDescr localbuildinfo+    postConf hooks args flags' pkg_descr localbuildinfo+    return localbuildinfo+  where+    verbosity = fromFlag (configVerbosity flags)+    confPkgDescr :: IO (Maybe FilePath, GenericPackageDescription)+    confPkgDescr = do+        mdescr <- readDesc hooks+        case mdescr of+          Just descr -> return (Nothing, descr)+          Nothing -> do+              pdfile <- defaultPackageDesc verbosity+              descr  <- readPackageDescription verbosity pdfile+              return (Just pdfile, descr)  buildAction :: UserHooks -> BuildFlags -> Args -> IO () buildAction hooks flags args = do-  let distPref  = fromFlag $ buildDistPref flags-      verbosity = fromFlag $ buildVerbosity flags+  distPref <- findDistPrefOrDefault (buildDistPref flags)+  let verbosity = fromFlag $ buildVerbosity flags+      flags' = flags { buildDistPref = toFlag distPref }    lbi <- getBuildConfig hooks verbosity distPref   progs <- reconfigurePrograms verbosity-             (buildProgramPaths flags)-             (buildProgramArgs flags)+             (buildProgramPaths flags')+             (buildProgramArgs flags')              (withPrograms lbi)    hookedAction preBuild buildHook postBuild                (return lbi { withPrograms = progs })-               hooks flags { buildArgs = args } args+               hooks flags' { buildArgs = args } args  replAction :: UserHooks -> ReplFlags -> Args -> IO () replAction hooks flags args = do-  let distPref  = fromFlag $ replDistPref flags-      verbosity = fromFlag $ replVerbosity flags+  distPref <- findDistPrefOrDefault (replDistPref flags)+  let verbosity = fromFlag $ replVerbosity flags+      flags' = flags { replDistPref = toFlag distPref }    lbi <- getBuildConfig hooks verbosity distPref   progs <- reconfigurePrograms verbosity-             (replProgramPaths flags)-             (replProgramArgs flags)+             (replProgramPaths flags')+             (replProgramArgs flags')              (withPrograms lbi) -  pbi <- preRepl hooks args flags+  pbi <- preRepl hooks args flags'   let lbi' = lbi { withPrograms = progs }       pkg_descr0 = localPkgDescr lbi'       pkg_descr = updatePackageDescription pbi pkg_descr0-  replHook hooks pkg_descr lbi' hooks flags args-  postRepl hooks args flags pkg_descr lbi'+  replHook hooks pkg_descr lbi' hooks flags' args+  postRepl hooks args flags' pkg_descr lbi'  hscolourAction :: UserHooks -> HscolourFlags -> Args -> IO ()-hscolourAction hooks flags args-    = do let distPref  = fromFlag $ hscolourDistPref flags-             verbosity = fromFlag $ hscolourVerbosity flags-         hookedAction preHscolour hscolourHook postHscolour-                      (getBuildConfig hooks verbosity distPref)-                      hooks flags args+hscolourAction hooks flags args = do+    distPref <- findDistPrefOrDefault (hscolourDistPref flags)+    let verbosity = fromFlag $ hscolourVerbosity flags+        flags' = flags { hscolourDistPref = toFlag distPref }+    hookedAction preHscolour hscolourHook postHscolour+                 (getBuildConfig hooks verbosity distPref)+                 hooks flags' args  haddockAction :: UserHooks -> HaddockFlags -> Args -> IO () haddockAction hooks flags args = do-  let distPref  = fromFlag $ haddockDistPref flags-      verbosity = fromFlag $ haddockVerbosity flags+  distPref <- findDistPrefOrDefault (haddockDistPref flags)+  let verbosity = fromFlag $ haddockVerbosity flags+      flags' = flags { haddockDistPref = toFlag distPref }    lbi <- getBuildConfig hooks verbosity distPref   progs <- reconfigurePrograms verbosity-             (haddockProgramPaths flags)-             (haddockProgramArgs flags)+             (haddockProgramPaths flags')+             (haddockProgramArgs flags')              (withPrograms lbi)    hookedAction preHaddock haddockHook postHaddock                (return lbi { withPrograms = progs })-               hooks flags args+               hooks flags' args  cleanAction :: UserHooks -> CleanFlags -> Args -> IO () cleanAction hooks flags args = do-                pbi <- preClean hooks args flags+    distPref <- findDistPrefOrDefault (cleanDistPref flags)+    let flags' = flags { cleanDistPref = toFlag distPref } -                pdfile <- defaultPackageDesc verbosity-                ppd <- readPackageDescription verbosity pdfile-                let pkg_descr0 = flattenPackageDescription ppd-                -- We don't sanity check for clean as an error-                -- here would prevent cleaning:-                --sanityCheckHookedBuildInfo pkg_descr0 pbi-                let pkg_descr = updatePackageDescription pbi pkg_descr0+    pbi <- preClean hooks args flags' -                cleanHook hooks pkg_descr () hooks flags-                postClean hooks args flags pkg_descr ()-  where verbosity = fromFlag (cleanVerbosity flags)+    pdfile <- defaultPackageDesc verbosity+    ppd <- readPackageDescription verbosity pdfile+    let pkg_descr0 = flattenPackageDescription ppd+    -- We don't sanity check for clean as an error+    -- here would prevent cleaning:+    --sanityCheckHookedBuildInfo pkg_descr0 pbi+    let pkg_descr = updatePackageDescription pbi pkg_descr0 +    cleanHook hooks pkg_descr () hooks flags'+    postClean hooks args flags' pkg_descr ()+  where+    verbosity = fromFlag (cleanVerbosity flags)+ copyAction :: UserHooks -> CopyFlags -> Args -> IO ()-copyAction hooks flags args-    = do let distPref  = fromFlag $ copyDistPref flags-             verbosity = fromFlag $ copyVerbosity flags-         hookedAction preCopy copyHook postCopy-                      (getBuildConfig hooks verbosity distPref)-                      hooks flags args+copyAction hooks flags args = do+    distPref <- findDistPrefOrDefault (copyDistPref flags)+    let verbosity = fromFlag $ copyVerbosity flags+        flags' = flags { copyDistPref = toFlag distPref }+    hookedAction preCopy copyHook postCopy+                 (getBuildConfig hooks verbosity distPref)+                 hooks flags' args  installAction :: UserHooks -> InstallFlags -> Args -> IO ()-installAction hooks flags args-    = do let distPref  = fromFlag $ installDistPref flags-             verbosity = fromFlag $ installVerbosity flags-         hookedAction preInst instHook postInst-                      (getBuildConfig hooks verbosity distPref)-                      hooks flags args+installAction hooks flags args = do+    distPref <- findDistPrefOrDefault (installDistPref flags)+    let verbosity = fromFlag $ installVerbosity flags+        flags' = flags { installDistPref = toFlag distPref }+    hookedAction preInst instHook postInst+                 (getBuildConfig hooks verbosity distPref)+                 hooks flags' args  sdistAction :: UserHooks -> SDistFlags -> Args -> IO () sdistAction hooks flags args = do-                let distPref = fromFlag $ sDistDistPref flags-                pbi <- preSDist hooks args flags+    distPref <- findDistPrefOrDefault (sDistDistPref flags)+    let flags' = flags { sDistDistPref = toFlag distPref }+    pbi <- preSDist hooks args flags' -                mlbi <- maybeGetPersistBuildConfig distPref-                pdfile <- defaultPackageDesc verbosity-                ppd <- readPackageDescription verbosity pdfile-                let pkg_descr0 = flattenPackageDescription ppd-                sanityCheckHookedBuildInfo pkg_descr0 pbi-                let pkg_descr = updatePackageDescription pbi pkg_descr0+    mlbi <- maybeGetPersistBuildConfig distPref+    pdfile <- defaultPackageDesc verbosity+    ppd <- readPackageDescription verbosity pdfile+    let pkg_descr0 = flattenPackageDescription ppd+    sanityCheckHookedBuildInfo pkg_descr0 pbi+    let pkg_descr = updatePackageDescription pbi pkg_descr0 -                sDistHook hooks pkg_descr mlbi hooks flags-                postSDist hooks args flags pkg_descr mlbi-  where verbosity = fromFlag (sDistVerbosity flags)+    sDistHook hooks pkg_descr mlbi hooks flags'+    postSDist hooks args flags' pkg_descr mlbi+  where+    verbosity = fromFlag (sDistVerbosity flags)  testAction :: UserHooks -> TestFlags -> Args -> IO () testAction hooks flags args = do-    let distPref  = fromFlag $ testDistPref flags-        verbosity = fromFlag $ testVerbosity flags+    distPref <- findDistPrefOrDefault (testDistPref flags)+    let verbosity = fromFlag $ testVerbosity flags+        flags' = flags { testDistPref = toFlag distPref }+     localBuildInfo <- getBuildConfig hooks verbosity distPref     let pkg_descr = localPkgDescr localBuildInfo     -- It is safe to do 'runTests' before the new test handler because the@@ -349,31 +349,34 @@     runTests hooks args False pkg_descr localBuildInfo     hookedActionWithArgs preTest testHook postTest             (getBuildConfig hooks verbosity distPref)-            hooks flags args+            hooks flags' args  benchAction :: UserHooks -> BenchmarkFlags -> Args -> IO () benchAction hooks flags args = do-    let distPref  = fromFlag $ benchmarkDistPref flags-        verbosity = fromFlag $ benchmarkVerbosity flags+    distPref <- findDistPrefOrDefault (benchmarkDistPref flags)+    let verbosity = fromFlag $ benchmarkVerbosity flags+        flags' = flags { benchmarkDistPref = toFlag distPref }     hookedActionWithArgs preBench benchHook postBench             (getBuildConfig hooks verbosity distPref)-            hooks flags args+            hooks flags' args  registerAction :: UserHooks -> RegisterFlags -> Args -> IO ()-registerAction hooks flags args-    = do let distPref  = fromFlag $ regDistPref flags-             verbosity = fromFlag $ regVerbosity flags-         hookedAction preReg regHook postReg-                      (getBuildConfig hooks verbosity distPref)-                      hooks flags args+registerAction hooks flags args = do+    distPref <- findDistPrefOrDefault (regDistPref flags)+    let verbosity = fromFlag $ regVerbosity flags+        flags' = flags { regDistPref = toFlag distPref }+    hookedAction preReg regHook postReg+                 (getBuildConfig hooks verbosity distPref)+                 hooks flags' args  unregisterAction :: UserHooks -> RegisterFlags -> Args -> IO ()-unregisterAction hooks flags args-    = do let distPref  = fromFlag $ regDistPref flags-             verbosity = fromFlag $ regVerbosity flags-         hookedAction preUnreg unregHook postUnreg-                      (getBuildConfig hooks verbosity distPref)-                      hooks flags args+unregisterAction hooks flags args = do+    distPref <- findDistPrefOrDefault (regDistPref flags)+    let verbosity = fromFlag $ regVerbosity flags+        flags' = flags { regDistPref = toFlag distPref }+    hookedAction preUnreg unregHook postUnreg+                 (getBuildConfig hooks verbosity distPref)+                 hooks flags' args  hookedAction :: (UserHooks -> Args -> flags -> IO HookedBuildInfo)         -> (UserHooks -> PackageDescription -> LocalBuildInfo@@ -451,9 +454,9 @@             -- Since the list of unconfigured programs is not serialized,             -- restore it to the same value as normally used at the beginning             -- of a configure run:-            configPrograms = restoreProgramConfiguration+            configPrograms_ = restoreProgramConfiguration                                (builtinPrograms ++ hookedPrograms hooks)-                               (configPrograms cFlags),+                               `fmap` configPrograms_ cFlags,              -- Use the current, not saved verbosity level:             configVerbosity = Flag verbosity@@ -466,7 +469,7 @@  clean :: PackageDescription -> CleanFlags -> IO () clean pkg_descr flags = do-    let distPref = fromFlag $ cleanDistPref flags+    let distPref = fromFlagOrDefault defaultDistPref $ cleanDistPref flags     notice verbosity "cleaning..."      maybeConfig <- if fromFlag (cleanSaveConf flags)@@ -483,7 +486,7 @@     mapM_ removeFileOrDirectory (extraTmpFiles pkg_descr)      -- If the user wanted to save the config, write it back-    maybe (return ()) (writePersistBuildConfig distPref) maybeConfig+    traverse_ (writePersistBuildConfig distPref) maybeConfig    where         removeFileOrDirectory :: FilePath -> IO ()@@ -607,42 +610,35 @@ runConfigureScript :: Verbosity -> Bool -> ConfigFlags -> LocalBuildInfo                    -> IO () runConfigureScript verbosity backwardsCompatHack flags lbi = do-   env <- getEnvironment   let programConfig = withPrograms lbi   (ccProg, ccFlags) <- configureCCompiler verbosity programConfig+  ccProgShort <- getShortPathName ccProg   -- The C compiler's compilation and linker flags (e.g.   -- "C compiler flags" and "Gcc Linker flags" from GHC) have already   -- been merged into ccFlags, so we set both CFLAGS and LDFLAGS   -- to ccFlags   -- We don't try and tell configure which ld to use, as we don't have   -- a way to pass its flags too-  let env' = appendToEnvironment ("CFLAGS",  unwords ccFlags)-             env-      args' = args ++ ["--with-gcc=" ++ ccProg]-  handleNoWindowsSH $-    rawSystemExitWithEnv verbosity "sh" args' env'+  let extraPath = fromNubList $ configProgramPathExtra flags+  let cflagsEnv = maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags)) $ lookup "CFLAGS" env+      spSep = [searchPathSeparator]+      pathEnv = maybe (intercalate spSep extraPath) ((intercalate spSep extraPath ++ spSep)++) $ lookup "PATH" env+      overEnv = ("CFLAGS", Just cflagsEnv) : [("PATH", Just pathEnv) | not (null extraPath)]+      args' = args ++ ["CC=" ++ ccProgShort]+      shProg = simpleProgram "sh"+      progDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb+  shConfiguredProg <- lookupProgram shProg `fmap` configureProgram  verbosity shProg progDb+  case shConfiguredProg of+      Just sh -> runProgramInvocation verbosity (programInvocation (sh {programOverrideEnv = overEnv}) args')+      Nothing -> die notFoundMsg    where     args = "./configure" : configureArgs backwardsCompatHack flags -    appendToEnvironment (key, val) [] = [(key, val)]-    appendToEnvironment (key, val) (kv@(k, v) : rest)-     | key == k  = (key, v ++ " " ++ val) : rest-     | otherwise = kv : appendToEnvironment (key, val) rest--    handleNoWindowsSH action-      | buildOS /= Windows-      = action--      | otherwise-      = action-          `catchIO` \ioe -> if isDoesNotExistError ioe-                              then die notFoundMsg-                              else throwIO ioe--    notFoundMsg = "The package has a './configure' script. This requires a "-               ++ "Unix compatibility toolchain such as MinGW+MSYS or Cygwin."+    notFoundMsg = "The package has a './configure' script. If you are on Windows, This requires a "+               ++ "Unix compatibility toolchain such as MinGW+MSYS or Cygwin. "+               ++ "If you are not on Windows, ensure that an 'sh' command is discoverable in your path."  getHookedBuildInfo :: Verbosity -> IO HookedBuildInfo getHookedBuildInfo verbosity = do@@ -695,6 +691,5 @@ defaultRegHook pkg_descr localbuildinfo _ flags =     if hasLibs pkg_descr     then register pkg_descr localbuildinfo flags-    else setupMessage verbosity+    else setupMessage (fromFlag (regVerbosity flags))            "Package contains no library to register:" (packageId pkg_descr)-  where verbosity = fromFlag (regVerbosity flags)

@@ -16,22 +16,17 @@     ) where  import qualified Distribution.PackageDescription as PD-    ( PackageDescription(..), BuildInfo(buildable)-    , Benchmark(..), BenchmarkInterface(..), benchmarkType, hasBenchmarks )-import Distribution.Simple.BuildPaths ( exeExtension )-import Distribution.Simple.Compiler ( compilerInfo )+import Distribution.Simple.BuildPaths+import Distribution.Simple.Compiler import Distribution.Simple.InstallDirs-    ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)-    , substPathTemplate , toPathTemplate, PathTemplate ) import qualified Distribution.Simple.LocalBuildInfo as LBI-    ( LocalBuildInfo(..) )-import Distribution.Simple.Setup ( BenchmarkFlags(..), fromFlag )-import Distribution.Simple.UserHooks ( Args )-import Distribution.Simple.Utils ( die, notice, rawSystemExitCode )+import Distribution.Simple.Setup+import Distribution.Simple.UserHooks+import Distribution.Simple.Utils import Distribution.Text -import Control.Monad ( when, unless )-import System.Exit ( ExitCode(..), exitFailure, exitWith )+import Control.Monad ( when, unless, forM )+import System.Exit ( ExitCode(..), exitFailure, exitSuccess ) import System.Directory ( doesFileExist ) import System.FilePath ( (</>), (<.>) ) @@ -78,9 +73,9 @@                       ++ show (disp $ PD.benchmarkType bm)                   exitFailure -    when (not $ PD.hasBenchmarks pkg_descr) $ do+    unless (PD.hasBenchmarks pkg_descr) $ do         notice verbosity "Package has no benchmarks."-        exitWith ExitSuccess+        exitSuccess      when (PD.hasBenchmarks pkg_descr && null enabledBenchmarks) $         die $ "No benchmarks enabled. Did you remember to configure with "@@ -88,7 +83,7 @@      bmsToRun <- case benchmarkNames of             [] -> return enabledBenchmarks-            names -> flip mapM names $ \bmName ->+            names -> forM names $ \bmName ->                 let benchmarkMap = zip enabledNames enabledBenchmarks                     enabledNames = map PD.benchmarkName enabledBenchmarks                     allNames = map PD.benchmarkName pkgBenchmarks@@ -123,6 +118,6 @@     fromPathTemplate $ substPathTemplate env template   where     env = initialPathTemplateEnv-          (PD.package pkg_descr) (LBI.pkgKey lbi)+          (PD.package pkg_descr) (LBI.localUnitId lbi)           (compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi) ++           [(BenchmarkNameVar, toPathTemplate $ PD.benchmarkName bm)]

@@ -23,6 +23,7 @@     writeAutogenFiles,   ) where +import Distribution.Package import qualified Distribution.Simple.GHC   as GHC import qualified Distribution.Simple.GHCJS as GHCJS import qualified Distribution.Simple.JHC   as JHC@@ -33,65 +34,40 @@ import qualified Distribution.Simple.Build.Macros      as Build.Macros import qualified Distribution.Simple.Build.PathsModule as Build.PathsModule -import Distribution.Package-         ( Package(..), PackageName(..), PackageIdentifier(..)-         , Dependency(..), thisPackageVersion, mkPackageKey, packageName )-import Distribution.Simple.Compiler-         ( Compiler, CompilerFlavor(..), compilerFlavor-         , PackageDB(..), PackageDBStack, packageKeySupported )-import Distribution.PackageDescription-         ( PackageDescription(..), BuildInfo(..), Library(..), Executable(..)-         , TestSuite(..), TestSuiteInterface(..), Benchmark(..)-         , BenchmarkInterface(..), defaultRenaming )+import Distribution.Simple.Compiler hiding (Flag)+import Distribution.PackageDescription hiding (Flag) import qualified Distribution.InstalledPackageInfo as IPI import qualified Distribution.ModuleName as ModuleName import Distribution.ModuleName (ModuleName)  import Distribution.Simple.Setup-         ( Flag(..), BuildFlags(..), ReplFlags(..), fromFlag ) import Distribution.Simple.BuildTarget-         ( BuildTarget(..), readBuildTargets ) import Distribution.Simple.PreProcess-         ( preprocessComponent, PPSuffixHandler ) import Distribution.Simple.LocalBuildInfo-         ( LocalBuildInfo(compiler, buildDir, withPackageDB, withPrograms, pkgKey)-         , Component(..), componentName, getComponent, componentBuildInfo-         , ComponentLocalBuildInfo(..), pkgEnabledComponents-         , withComponentsInBuildOrder, componentsInBuildOrder-         , ComponentName(..), showComponentName-         , ComponentDisabledReason(..), componentDisabledReason-         , inplacePackageId, LibraryName(..) ) import Distribution.Simple.Program.Types import Distribution.Simple.Program.Db-import qualified Distribution.Simple.Program.HcPkg as HcPkg import Distribution.Simple.BuildPaths-         ( autogenModulesDir, autogenModuleName, cppHeaderName, exeExtension )+import Distribution.Simple.Configure import Distribution.Simple.Register-         ( registerPackage, inplaceInstalledPackageInfo )-import Distribution.Simple.Test.LibV09 ( stubFilePath, stubName )+import Distribution.Simple.Test.LibV09 import Distribution.Simple.Utils-         ( createDirectoryIfMissingVerbose, rewriteFile-         , die, info, debug, warn, setupMessage ) -import Distribution.Verbosity-         ( Verbosity )+import Distribution.System import Distribution.Text-         ( display )+import Distribution.Verbosity  import qualified Data.Map as Map-import Data.Maybe-         ( maybeToList )+import qualified Data.Set as Set import Data.Either          ( partitionEithers ) import Data.List-         ( intersect, intercalate )+         ( intersect ) import Control.Monad          ( when, unless, forM_ ) import System.FilePath          ( (</>), (<.>) ) import System.Directory-         ( getCurrentDirectory, removeDirectoryRecursive, removeFile-         , doesDirectoryExist, doesFileExist )+         ( getCurrentDirectory )  -- ----------------------------------------------------------------------------- -- |Build the libraries and executables in this package.@@ -178,11 +154,12 @@   -- | Start an interpreter without loading any package files.-startInterpreter :: Verbosity -> ProgramDb -> Compiler -> PackageDBStack -> IO ()-startInterpreter verbosity programDb comp packageDBs =+startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform+                 -> PackageDBStack -> IO ()+startInterpreter verbosity programDb comp platform packageDBs =   case compilerFlavor comp of-    GHC   -> GHC.startInterpreter   verbosity programDb comp packageDBs-    GHCJS -> GHCJS.startInterpreter verbosity programDb comp packageDBs+    GHC   -> GHC.startInterpreter   verbosity programDb comp platform packageDBs+    GHCJS -> GHCJS.startInterpreter verbosity programDb comp platform packageDBs     _     -> die "A REPL is not supported with this compiler."  buildComponent :: Verbosity@@ -197,27 +174,30 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes                comp@(CLib lib) clbi distPref = do     preprocessComponent pkg_descr comp lbi False verbosity suffixes+    extras <- preprocessExtras comp lbi     info verbosity "Building library..."-    buildLib verbosity numJobs pkg_descr lbi lib clbi+    let libbi = libBuildInfo lib+        lib' = lib { libBuildInfo = addExtraCSources libbi extras }+    buildLib verbosity numJobs pkg_descr lbi lib' clbi      -- Register the library in-place, so exes can depend     -- on internally defined libraries.     pwd <- getCurrentDirectory     let -- The in place registration uses the "-inplace" suffix, not an ABI hash-        ipkgid           = inplacePackageId (packageId installedPkgInfo)         installedPkgInfo = inplaceInstalledPackageInfo pwd distPref pkg_descr-                                                       ipkgid lib lbi clbi--    registerPackage verbosity-      installedPkgInfo pkg_descr lbi True -- True meaning in place-      (withPackageDB lbi)+                                                       (AbiHash "") lib' lbi clbi +    registerPackage verbosity (compiler lbi) (withPrograms lbi) False+                    (withPackageDB lbi) installedPkgInfo  buildComponent verbosity numJobs pkg_descr lbi suffixes                comp@(CExe exe) clbi _ = do     preprocessComponent pkg_descr comp lbi False verbosity suffixes+    extras <- preprocessExtras comp lbi     info verbosity $ "Building executable " ++ exeName exe ++ "..."-    buildExe verbosity numJobs pkg_descr lbi exe clbi+    let ebi = buildInfo exe+        exe' = exe { buildInfo = addExtraCSources ebi extras }+    buildExe verbosity numJobs pkg_descr lbi exe' clbi   buildComponent verbosity numJobs pkg_descr lbi suffixes@@ -225,8 +205,11 @@                clbi _distPref = do     let exe = testSuiteExeV10AsExe test     preprocessComponent pkg_descr comp lbi False verbosity suffixes+    extras <- preprocessExtras comp lbi     info verbosity $ "Building test suite " ++ testName test ++ "..."-    buildExe verbosity numJobs pkg_descr lbi exe clbi+    let ebi = buildInfo exe+        exe' = exe { buildInfo = addExtraCSources ebi extras }+    buildExe verbosity numJobs pkg_descr lbi exe' clbi   buildComponent verbosity numJobs pkg_descr lbi0 suffixes@@ -242,10 +225,17 @@     let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) =           testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd     preprocessComponent pkg_descr comp lbi False verbosity suffixes+    extras <- preprocessExtras comp lbi     info verbosity $ "Building test suite " ++ testName test ++ "..."     buildLib verbosity numJobs pkg lbi lib libClbi-    registerPackage verbosity ipi pkg lbi True $ withPackageDB lbi-    buildExe verbosity numJobs pkg_descr lbi exe exeClbi+    -- NB: need to enable multiple instances here, because on 7.10++    -- the package name is the same as the library, and we still+    -- want the registration to go through.+    registerPackage verbosity (compiler lbi) (withPrograms lbi) True+                    (withPackageDB lbi) ipi+    let ebi = buildInfo exe+        exe' = exe { buildInfo = addExtraCSources ebi extras }+    buildExe verbosity numJobs pkg_descr lbi exe' exeClbi   buildComponent _ _ _ _ _@@ -259,8 +249,11 @@                clbi _ = do     let (exe, exeClbi) = benchmarkExeV10asExe bm clbi     preprocessComponent pkg_descr comp lbi False verbosity suffixes+    extras <- preprocessExtras comp lbi     info verbosity $ "Building benchmark " ++ benchmarkName bm ++ "..."-    buildExe verbosity numJobs pkg_descr lbi exe exeClbi+    let ebi = buildInfo exe+        exe' = exe { buildInfo = addExtraCSources ebi extras }+    buildExe verbosity numJobs pkg_descr lbi exe' exeClbi   buildComponent _ _ _ _ _@@ -269,6 +262,15 @@     die $ "No support for building benchmark type " ++ display tt  +-- | Add extra C sources generated by preprocessing to build+-- information.+addExtraCSources :: BuildInfo -> [FilePath] -> BuildInfo+addExtraCSources bi extras = bi { cSources = new }+  where new = Set.toList $ old `Set.union` exs+        old = Set.fromList $ cSources bi+        exs = Set.fromList extras++ replComponent :: Verbosity               -> PackageDescription               -> LocalBuildInfo@@ -280,12 +282,18 @@ replComponent verbosity pkg_descr lbi suffixes                comp@(CLib lib) clbi _ = do     preprocessComponent pkg_descr comp lbi False verbosity suffixes-    replLib verbosity pkg_descr lbi lib clbi+    extras <- preprocessExtras comp lbi+    let libbi = libBuildInfo lib+        lib' = lib { libBuildInfo = libbi { cSources = cSources libbi ++ extras } }+    replLib verbosity pkg_descr lbi lib' clbi  replComponent verbosity pkg_descr lbi suffixes                comp@(CExe exe) clbi _ = do     preprocessComponent pkg_descr comp lbi False verbosity suffixes-    replExe verbosity pkg_descr lbi exe clbi+    extras <- preprocessExtras comp lbi+    let ebi = buildInfo exe+        exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }+    replExe verbosity pkg_descr lbi exe' clbi   replComponent verbosity pkg_descr lbi suffixes@@ -293,7 +301,10 @@                clbi _distPref = do     let exe = testSuiteExeV10AsExe test     preprocessComponent pkg_descr comp lbi False verbosity suffixes-    replExe verbosity pkg_descr lbi exe clbi+    extras <- preprocessExtras comp lbi+    let ebi = buildInfo exe+        exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }+    replExe verbosity pkg_descr lbi exe' clbi   replComponent verbosity pkg_descr lbi0 suffixes@@ -304,7 +315,10 @@     let (pkg, lib, libClbi, lbi, _, _, _) =           testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd     preprocessComponent pkg_descr comp lbi False verbosity suffixes-    replLib verbosity pkg lbi lib libClbi+    extras <- preprocessExtras comp lbi+    let libbi = libBuildInfo lib+        lib' = lib { libBuildInfo = libbi { cSources = cSources libbi ++ extras } }+    replLib verbosity pkg lbi lib' libClbi   replComponent _ _ _ _@@ -318,7 +332,10 @@                clbi _ = do     let (exe, exeClbi) = benchmarkExeV10asExe bm clbi     preprocessComponent pkg_descr comp lbi False verbosity suffixes-    replExe verbosity pkg_descr lbi exe exeClbi+    extras <- preprocessExtras comp lbi+    let ebi = buildInfo exe+        exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }+    replExe verbosity pkg_descr lbi exe' exeClbi   replComponent _ _ _ _@@ -350,12 +367,12 @@                            -> (PackageDescription,                                Library, ComponentLocalBuildInfo,                                LocalBuildInfo,-                               IPI.InstalledPackageInfo_ ModuleName,+                               IPI.InstalledPackageInfo,                                Executable, ComponentLocalBuildInfo) testSuiteLibV09AsLibAndExe pkg_descr                      test@TestSuite { testInterface = TestSuiteLibV09 _ m }                      clbi lbi distPref pwd =-    (pkg, lib, libClbi, lbi', ipi, exe, exeClbi)+    (pkg, lib, libClbi, lbi, ipi, exe, exeClbi)   where     bi  = testBuildInfo test     lib = Library {@@ -366,31 +383,31 @@             libExposed     = True,             libBuildInfo   = bi           }+    -- NB: temporary hack; I have a refactor which solves this+    cid = computeComponentId (package pkg_descr)+                             (CTestName (testName test))+                             (map ((\(SimpleUnitId cid0) -> cid0) . fst)+                                  (componentPackageDeps clbi))+                             (flagAssignment lbi)+    uid = SimpleUnitId cid+    (pkg_name, compat_key) = computeCompatPackageKey+                                (compiler lbi) (package pkg_descr)+                                (CTestName (testName test)) uid     libClbi = LibComponentLocalBuildInfo                 { componentPackageDeps = componentPackageDeps clbi                 , componentPackageRenaming = componentPackageRenaming clbi-                , componentLibraries = [LibraryName (testName test)]-                , componentExposedModules = [IPI.ExposedModule m Nothing Nothing]+                , componentUnitId = uid+                , componentCompatPackageKey = compat_key+                , componentExposedModules = [IPI.ExposedModule m Nothing]                 }     pkg = pkg_descr {-            package      = (package pkg_descr) {-                             pkgName = PackageName (testName test)-                           }+            package      = (package pkg_descr) { pkgName = pkg_name }           , buildDepends = targetBuildDepends $ testBuildInfo test           , executables  = []           , testSuites   = []           , library      = Just lib           }-    -- Hack to make the library compile with the right package key.-    -- Probably the "right" way to do this is move this information to-    -- the ComponentLocalBuildInfo, but it seems odd that a single package-    -- can define multiple actual packages.-    lbi' = lbi {-        pkgKey = mkPackageKey (packageKeySupported (compiler lbi))-                              (package pkg) [] []-    }-    ipkgid = inplacePackageId (packageId pkg)-    ipi    = inplaceInstalledPackageInfo pwd distPref pkg ipkgid lib lbi' libClbi+    ipi    = inplaceInstalledPackageInfo pwd distPref pkg (AbiHash "") lib lbi libClbi     testDir = buildDir lbi </> stubName test           </> stubName test ++ "-tmp"     testLibDep = thisPackageVersion $ package pkg@@ -401,22 +418,18 @@                            hsSourceDirs       = [ testDir ],                            targetBuildDepends = testLibDep                              : (targetBuildDepends $ testBuildInfo test),-                           targetBuildRenaming =-                            Map.insert (packageName pkg) defaultRenaming-                                (targetBuildRenaming $ testBuildInfo test)+                           targetBuildRenaming = Map.empty                          }           }     -- | The stub executable needs a new 'ComponentLocalBuildInfo'     -- that exposes the relevant test suite library.     exeClbi = ExeComponentLocalBuildInfo {                 componentPackageDeps =-                    (IPI.installedPackageId ipi, packageId ipi)+                    (IPI.installedUnitId ipi, packageId ipi)                   : (filter (\(_, x) -> let PackageName name = pkgName x                                         in name == "Cabal" || name == "base")                             (componentPackageDeps clbi)),-                componentPackageRenaming =-                    Map.insert (packageName ipi) defaultRenaming-                               (componentPackageRenaming clbi)+                componentPackageRenaming = Map.empty               } testSuiteLibV09AsLibAndExe _ TestSuite{} _ _ _ _ = error "testSuiteLibV09AsLibAndExe: wrong kind" @@ -444,24 +457,14 @@ createInternalPackageDB :: Verbosity -> LocalBuildInfo -> FilePath                         -> IO PackageDB createInternalPackageDB verbosity lbi distPref = do-    case compilerFlavor (compiler lbi) of-      GHC   -> createWith $ GHC.hcPkgInfo   (withPrograms lbi)-      GHCJS -> createWith $ GHCJS.hcPkgInfo (withPrograms lbi)-      LHC   -> createWith $ LHC.hcPkgInfo   (withPrograms lbi)-      _     -> return packageDB-    where-      dbPath = distPref </> "package.conf.inplace"-      packageDB = SpecificPackageDB dbPath-      createWith hpi = do-        dir_exists <- doesDirectoryExist dbPath-        if dir_exists-            then removeDirectoryRecursive dbPath-            else do file_exists <- doesFileExist dbPath-                    when file_exists $ removeFile dbPath-        if HcPkg.useSingleFileDb hpi-            then writeFile dbPath "[]"-            else HcPkg.init hpi verbosity dbPath-        return packageDB+    existsAlready <- doesPackageDBExist dbPath+    when existsAlready $ deletePackageDB dbPath+    createPackageDB verbosity (compiler lbi) (withPrograms lbi) False dbPath +    return (SpecificPackageDB dbPath)+  where+      dbPath = case compilerFlavor (compiler lbi) of+        UHC -> UHC.inplacePackageDbPath lbi+        _   -> distPref </> "package.conf.inplace"  addInternalBuildTools :: PackageDescription -> LocalBuildInfo -> BuildInfo                       -> ProgramDb -> ProgramDb@@ -532,12 +535,10 @@                   -> IO () initialBuildSteps _distPref pkg_descr lbi verbosity = do   -- check that there's something to build-  let buildInfos =-          map libBuildInfo (maybeToList (library pkg_descr)) ++-          map buildInfo (executables pkg_descr)-  unless (any buildable buildInfos) $ do+  unless (not . null $ allBuildInfo pkg_descr) $ do     let name = display (packageId pkg_descr)-    die ("Package " ++ name ++ " can't be built on this system.")+    die $ "No libraries, executables, tests, or benchmarks "+       ++ "are enabled for package " ++ name ++ "."    createDirectoryIfMissingVerbose verbosity True (buildDir lbi) 

@@ -29,11 +29,10 @@ import Distribution.Version          ( Version(versionBranch) ) import Distribution.PackageDescription-         ( PackageDescription )-import Distribution.Simple.Compiler-         ( packageKeySupported )+         ( PackageDescription ( package ) ) import Distribution.Simple.LocalBuildInfo-         ( LocalBuildInfo(compiler, pkgKey, withPrograms), externalPackageDeps )+         ( LocalBuildInfo(withPrograms), externalPackageDeps+         , localComponentId, localCompatPackageKey ) import Distribution.Simple.Program.Db          ( configuredPrograms ) import Distribution.Simple.Program.Types@@ -48,11 +47,12 @@ -- | The contents of the @cabal_macros.h@ for the given configured package. -- generate :: PackageDescription -> LocalBuildInfo -> String-generate _pkg_descr lbi =+generate pkg_descr lbi =   "/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" ++-  generatePackageVersionMacros (map snd (externalPackageDeps lbi)) +++  generatePackageVersionMacros+    (package pkg_descr : map snd (externalPackageDeps lbi)) ++   generateToolVersionMacros (configuredPrograms . withPrograms $ lbi) ++-  generatePackageKeyMacro lbi+  generateComponentIdMacro lbi  -- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@ -- macros for a list of package ids (usually used with the specific deps of@@ -96,13 +96,14 @@   where     (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0) --- | Generate the @CURRENT_PACKAGE_KEY@ definition for the package key---   of the current package, if supported by the compiler-generatePackageKeyMacro :: LocalBuildInfo -> String-generatePackageKeyMacro lbi-  | packageKeySupported (compiler lbi) =-      "#define CURRENT_PACKAGE_KEY \"" ++ display (pkgKey lbi) ++ "\"\n\n"-  | otherwise = ""+-- | Generate the @CURRENT_COMPONENT_ID@ definition for the component ID+--   of the current package.+generateComponentIdMacro :: LocalBuildInfo -> String+generateComponentIdMacro lbi =+    concat+    [ "#define CURRENT_COMPONENT_ID \"" ++ display (localComponentId lbi) ++ "\"\n\n"+    , "#define CURRENT_PACKAGE_KEY \"" ++ localCompatPackageKey lbi ++ "\"\n\n"+    ]  fixchar :: Char -> Char fixchar '-' = '_'

@@ -19,25 +19,14 @@   ) where  import Distribution.System-         ( OS(Windows), buildOS, Arch(..), buildArch ) import Distribution.Simple.Compiler-         ( CompilerFlavor(..), compilerFlavor, compilerVersion ) import Distribution.Package-         ( packageId, packageName, packageVersion ) import Distribution.PackageDescription-         ( PackageDescription(..), hasLibs ) import Distribution.Simple.LocalBuildInfo-         ( LocalBuildInfo(..), InstallDirs(..)-         , absoluteInstallDirs, prefixRelativeInstallDirs )-import Distribution.Simple.Setup ( CopyDest(NoCopyDest) ) import Distribution.Simple.BuildPaths-         ( autogenModuleName ) import Distribution.Simple.Utils-         ( shortRelativePath ) import Distribution.Text-         ( display ) import Distribution.Version-         ( Version(..), orLaterVersion, withinRange )  import System.FilePath          ( pathSeparator )@@ -50,7 +39,12 @@  generate :: PackageDescription -> LocalBuildInfo -> String generate pkg_descr lbi =-   let pragmas+   let pragmas = cpp_pragma ++ ffi_pragmas ++ warning_pragmas++       cpp_pragma | supports_cpp = "{-# LANGUAGE CPP #-}\n"+                  | otherwise    = ""++       ffi_pragmas         | absolute = ""         | supports_language_pragma =           "{-# LANGUAGE ForeignFunctionInterface #-}\n"@@ -58,6 +52,10 @@           "{-# OPTIONS_GHC -fffi #-}\n"++           "{-# OPTIONS_JHC -fffi #-}\n" +       warning_pragmas =+        "{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}\n"+++        "{-# OPTIONS_GHC -fno-warn-implicit-prelude #-}\n"+        foreign_imports         | absolute = ""         | otherwise =@@ -84,7 +82,21 @@         reloc_imports ++         "import Prelude\n"++         "\n"++-        "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"+++        (if supports_cpp+         then+           ("#if defined(VERSION_base)\n"+++            "\n"+++            "#if MIN_VERSION_base(4,0,0)\n"+++            "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"+++            "#else\n"+++            "catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a\n"+++            "#endif\n"+++            "\n"+++            "#else\n"+++            "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"+++            "#endif\n")+         else+           "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n")++         "catchIO = Exception.catch\n" ++         "\n"++         "version :: Version"++@@ -212,6 +224,8 @@         get_prefix_stuff = get_prefix_win32 buildArch          path_sep = show [pathSeparator]++        supports_cpp = compilerFlavor (compiler lbi) == GHC          supports_language_pragma =           (compilerFlavor (compiler lbi) == GHC &&

@@ -31,22 +31,17 @@   ) where  -import System.FilePath ((</>), (<.>))- import Distribution.Package-         ( packageName )-import Distribution.ModuleName (ModuleName)-import qualified Distribution.ModuleName as ModuleName+import Distribution.ModuleName as ModuleName import Distribution.Compiler-         ( CompilerId(..) )-import Distribution.PackageDescription (PackageDescription)+import Distribution.PackageDescription import Distribution.Simple.LocalBuildInfo-         ( LocalBuildInfo(buildDir), LibraryName(..) )-import Distribution.Simple.Setup (defaultDistPref)+import Distribution.Simple.Setup import Distribution.Text-         ( display )-import Distribution.System (OS(..), buildOS)+import Distribution.System +import System.FilePath ((</>), (<.>))+ -- --------------------------------------------------------------------------- -- Build directories and files @@ -81,33 +76,31 @@ -- --------------------------------------------------------------------------- -- Library file names -mkLibName :: LibraryName -> String-mkLibName (LibraryName lib) = "lib" ++ lib <.> "a"+mkLibName :: UnitId -> String+mkLibName lib = "lib" ++ getHSLibraryName lib <.> "a" -mkProfLibName :: LibraryName -> String-mkProfLibName (LibraryName lib) =  "lib" ++ lib ++ "_p" <.> "a"+mkProfLibName :: UnitId -> String+mkProfLibName lib =  "lib" ++ getHSLibraryName lib ++ "_p" <.> "a"  -- Implement proper name mangling for dynamical shared objects -- libHS<packagename>-<compilerFlavour><compilerVersion> -- e.g. libHSbase-2.1-ghc6.6.1.so-mkSharedLibName :: CompilerId -> LibraryName -> String-mkSharedLibName (CompilerId compilerFlavor compilerVersion) (LibraryName lib)-  = "lib" ++ lib ++ "-" ++ comp <.> dllExtension+mkSharedLibName :: CompilerId -> UnitId -> String+mkSharedLibName (CompilerId compilerFlavor compilerVersion) lib+  = "lib" ++ getHSLibraryName lib ++ "-" ++ comp <.> dllExtension   where comp = display compilerFlavor ++ display compilerVersion  -- ------------------------------------------------------------ -- * Platform file extensions -- ------------------------------------------------------------ --- ToDo: This should be determined via autoconf (AC_EXEEXT)--- | Extension for executable files+-- | Default extension for executable files on the current platform. -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2) exeExtension :: String exeExtension = case buildOS of                    Windows -> "exe"                    _       -> "" --- TODO: This should be determined via autoconf (AC_OBJEXT) -- | Extension for object files. For GHC the extension is @\"o\"@. objExtension :: String objExtension = "o"

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module      :  Distribution.Client.BuildTargets@@ -14,10 +14,14 @@     -- * Build targets     BuildTarget(..),     readBuildTargets,+    showBuildTarget,+    QualLevel(..),+    buildTargetComponentName,      -- * Parsing user build targets     UserBuildTarget,     readUserBuildTargets,+    showUserBuildTarget,     UserBuildTargetProblem(..),     reportUserBuildTargetProblems, @@ -28,41 +32,27 @@   ) where  import Distribution.Package-         ( Package(..), PackageId, packageName )- import Distribution.PackageDescription-         ( PackageDescription-         , Executable(..)-         , TestSuite(..), TestSuiteInterface(..), testModules-         , Benchmark(..), BenchmarkInterface(..), benchmarkModules-         , BuildInfo(..), libModules, exeModules ) import Distribution.ModuleName-         ( ModuleName, toFilePath ) import Distribution.Simple.LocalBuildInfo-         ( Component(..), ComponentName(..)-         , pkgComponents, componentName, componentBuildInfo )- import Distribution.Text-         ( display ) import Distribution.Simple.Utils-         ( die, lowercase, equating ) +import Distribution.Compat.Binary (Binary)+import qualified Distribution.Compat.ReadP as Parse+import Distribution.Compat.ReadP+         ( (+++), (<++) )+ import Data.List-         ( nub, stripPrefix, sortBy, groupBy, partition, intercalate )-import Data.Ord+         ( nub, stripPrefix, sortBy, groupBy, partition ) import Data.Maybe          ( listToMaybe, catMaybes ) import Data.Either          ( partitionEithers )+import GHC.Generics (Generic) import qualified Data.Map as Map import Control.Monad-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative (Applicative(..))-#endif-import Control.Applicative (Alternative(..))-import qualified Distribution.Compat.ReadP as Parse-import Distribution.Compat.ReadP-         ( (+++), (<++) )+import Control.Applicative as AP (Alternative(..), Applicative(..)) import Data.Char          ( isSpace, isAlphaNum ) import System.FilePath as FilePath@@ -127,13 +117,19 @@      -- | A specific file within a specific component.      --    | BuildTargetFile ComponentName FilePath-  deriving (Show,Eq)+  deriving (Eq, Show, Generic) +instance Binary BuildTarget --- --------------------------------------------------------------- * Do everything--- ------------------------------------------------------------+buildTargetComponentName :: BuildTarget -> ComponentName+buildTargetComponentName (BuildTargetComponent cn)   = cn+buildTargetComponentName (BuildTargetModule    cn _) = cn+buildTargetComponentName (BuildTargetFile      cn _) = cn +-- | Read a list of user-supplied build target strings and resolve them to+-- 'BuildTarget's according to a 'PackageDescription'. If there are problems+-- with any of the targets e.g. they don't exist or are misformatted, throw an+-- 'IOException'. readBuildTargets :: PackageDescription -> [String] -> IO [BuildTarget] readBuildTargets pkg targetStrs = do     let (uproblems, utargets) = readUserBuildTargets targetStrs@@ -226,13 +222,17 @@            ++ " - build foo:Data/Foo.hsc  -- file qualified by component"  showUserBuildTarget :: UserBuildTarget -> String-showUserBuildTarget = intercalate ":" . components+showUserBuildTarget = intercalate ":" . getComponents   where-    components (UserBuildTargetSingle s1)       = [s1]-    components (UserBuildTargetDouble s1 s2)    = [s1,s2]-    components (UserBuildTargetTriple s1 s2 s3) = [s1,s2,s3]+    getComponents (UserBuildTargetSingle s1)       = [s1]+    getComponents (UserBuildTargetDouble s1 s2)    = [s1,s2]+    getComponents (UserBuildTargetTriple s1 s2 s3) = [s1,s2,s3] +showBuildTarget :: QualLevel -> PackageId -> BuildTarget -> String+showBuildTarget ql pkgid bt =+    showUserBuildTarget (renderBuildTarget ql bt pkgid) + -- ------------------------------------------------------------ -- * Resolving user targets to build targets -- ------------------------------------------------------------@@ -265,7 +265,7 @@ resolveBuildTarget pkg userTarget fexists =     case findMatch (matchBuildTarget pkg userTarget fexists) of       Unambiguous target  -> Right target-      Ambiguous   targets -> Left (BuildTargetAmbigious userTarget targets')+      Ambiguous   targets -> Left (BuildTargetAmbiguous userTarget targets')                                where targets' = disambiguateBuildTargets                                                     (packageId pkg) userTarget                                                     targets@@ -287,7 +287,7 @@      -- ^  [expected thing] (actually got)    | BuildTargetNoSuch    UserBuildTarget [(String, String)]      -- ^ [(no such thing,  actually got)]-   | BuildTargetAmbigious UserBuildTarget [(UserBuildTarget, BuildTarget)]+   | BuildTargetAmbiguous UserBuildTarget [(UserBuildTarget, BuildTarget)]   deriving Show  @@ -366,7 +366,7 @@           mungeThing "file" = "file target"           mungeThing thing  = thing -    case [ (t, ts) | BuildTargetAmbigious t ts <- problems ] of+    case [ (t, ts) | BuildTargetAmbiguous t ts <- problems ] of       []      -> return ()       targets ->         die $ unlines@@ -734,10 +734,10 @@ --  -- | A matcher embodies a way to match some input as being some recognised--- value. In particular it deals with multiple and ambigious matches.+-- value. In particular it deals with multiple and ambiguous matches. -- -- There are various matcher primitives ('matchExactly', 'matchInexactly'),--- ways to combine matchers ('ambigiousWith', 'shadows') and finally we can+-- ways to combine matchers ('ambiguousWith', 'shadows') and finally we can -- run a matcher against an input using 'findMatch'. -- @@ -766,7 +766,7 @@  -- | Combine two matchers. Exact matches are used over inexact matches -- but if we have multiple exact, or inexact then the we collect all the--- ambigious matches.+-- ambiguous matches. -- matchPlus :: Match a -> Match a -> Match a matchPlus   (ExactMatch   d1 xs)   (ExactMatch   d2 xs') =@@ -784,7 +784,7 @@                                              | d1 <  d2  = b                                              | otherwise = NoMatch d1 (ms ++ ms') --- | Combine two matchers. This is similar to 'ambigiousWith' with the+-- | Combine two matchers. This is similar to 'ambiguousWith' with the -- difference that an exact match from the left matcher shadows any exact -- match on the right. Inexact matches are still collected however. --@@ -798,11 +798,12 @@   fmap f (InexactMatch d xs) = InexactMatch d (fmap f xs)  instance Applicative Match where-  pure = return+  pure a = ExactMatch 0 [a]   (<*>) = ap  instance Monad Match where-  return a                = ExactMatch 0 [a]+  return = AP.pure+   NoMatch      d ms >>= _ = NoMatch d ms   ExactMatch   d xs >>= f = addDepth d                           $ foldr matchPlus matchZero (map f xs)@@ -872,18 +873,18 @@ -- possible matches. There may be 'None', a single 'Unambiguous' match or -- you may have an 'Ambiguous' match with several possibilities. ---findMatch :: Eq b => Match b -> MaybeAmbigious b+findMatch :: Eq b => Match b -> MaybeAmbiguous b findMatch match =     case match of       NoMatch    _ msgs -> None (nub msgs)-      ExactMatch   _ xs -> checkAmbigious xs-      InexactMatch _ xs -> checkAmbigious xs+      ExactMatch   _ xs -> checkAmbiguous xs+      InexactMatch _ xs -> checkAmbiguous xs   where-    checkAmbigious xs = case nub xs of+    checkAmbiguous xs = case nub xs of                           [x] -> Unambiguous x                           xs' -> Ambiguous   xs' -data MaybeAmbigious a = None [MatchError] | Unambiguous a | Ambiguous [a]+data MaybeAmbiguous a = None [MatchError] | Unambiguous a | Ambiguous [a]   deriving Show  

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  Distribution.Simple.CCompiler@@ -47,10 +46,8 @@    filenameCDialect   ) where -#if __GLASGOW_HASKELL__ < 710-import Data.Monoid-     ( Monoid(..) )-#endif+import Distribution.Compat.Semigroup as Semi+ import System.FilePath      ( takeExtension ) @@ -66,15 +63,16 @@  instance Monoid CDialect where   mempty = C--  mappend C                  anything           = anything-  mappend ObjectiveC         CPlusPlus          = ObjectiveCPlusPlus-  mappend CPlusPlus          ObjectiveC         = ObjectiveCPlusPlus-  mappend _                  ObjectiveCPlusPlus = ObjectiveCPlusPlus-  mappend ObjectiveC         _                  = ObjectiveC-  mappend CPlusPlus          _                  = CPlusPlus-  mappend ObjectiveCPlusPlus _                  = ObjectiveCPlusPlus+  mappend = (Semi.<>) +instance Semigroup CDialect where+  C                  <> anything           = anything+  ObjectiveC         <> CPlusPlus          = ObjectiveCPlusPlus+  CPlusPlus          <> ObjectiveC         = ObjectiveCPlusPlus+  _                  <> ObjectiveCPlusPlus = ObjectiveCPlusPlus+  ObjectiveC         <> _                  = ObjectiveC+  CPlusPlus          <> _                  = CPlusPlus+  ObjectiveCPlusPlus <> _                  = ObjectiveCPlusPlus  -- | A list of all file extensions which are recognized as possibly containing --   some dialect of C code.  Note that this list is only for source files,

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-} ----------------------------------------------------------------------------- -- | -- Module      :  Distribution.Simple.Command@@ -6,7 +6,7 @@ -- License     :  BSD3 -- -- Maintainer  :  cabal-devel@haskell.org--- Portability :  portable+-- Portability :  non-portable (ExistentialQuantification) -- -- This is to do with command line handling. The Cabal command line is -- organised into a number of named sub-commands (much like darcs). The@@ -38,6 +38,11 @@   commandAddAction,   noExtraFlags, +  -- ** Building lists of commands+  CommandType(..),+  CommandSpec(..),+  commandFromSpec,+   -- ** Running commands   commandsRun, @@ -60,19 +65,17 @@    ) where -import Control.Monad-import Data.Char (isAlpha, toLower)-import Data.List (sortBy)-import Data.Maybe-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid-#endif import qualified Distribution.GetOpt as GetOpt import Distribution.Text-         ( Text(disp, parse) ) import Distribution.ParseUtils import Distribution.ReadE-import Distribution.Simple.Utils (die, intercalate)+import Distribution.Simple.Utils++import Control.Monad+import Data.Char (isAlpha, toLower)+import Data.List (sortBy)+import Data.Maybe+import Data.Monoid as Mon import Text.PrettyPrint ( punctuate, cat, comma, text ) import Text.PrettyPrint as PP ( empty ) @@ -171,14 +174,14 @@     reqArg ad (succeedReadE mkflag) showflag  -- | (String -> a) variant of "optArg"-optArg' :: Monoid b => ArgPlaceHolder -> (Maybe String -> b)+optArg' :: Mon.Monoid b => ArgPlaceHolder -> (Maybe String -> b)            -> (b -> [Maybe String])            -> MkOptDescr (a -> b) (b -> a -> a) a optArg' ad mkflag showflag =     optArg ad (succeedReadE (mkflag . Just)) def showflag       where def = mkflag Nothing -noArg :: (Eq b, Monoid b) => b -> MkOptDescr (a -> b) (b -> a -> a) a+noArg :: (Eq b) => b -> MkOptDescr (a -> b) (b -> a -> a) a noArg flag sf lf d = choiceOpt [(flag, (sf,lf), d)] sf lf d  boolOpt :: (b -> Maybe Bool) -> (Bool -> b) -> SFlags -> SFlags@@ -592,9 +595,26 @@   | Command name description _ NormalCommand <- cmds ]  helpCommandUI :: CommandUI ()-helpCommandUI = mkCommandUI-  "help"-  "Help about commands."-  ["[FLAGS]", "COMMAND [FLAGS]"]-  ()-  (const [])+helpCommandUI =+  (mkCommandUI+    "help"+    "Help about commands."+    ["[FLAGS]", "COMMAND [FLAGS]"]+    ()+    (const []))+  {+    commandNotes = Just $ \pname ->+       "Examples:\n"+    ++ "  " ++ pname ++ " help help\n"+    ++ "    Oh, appararently you already know this.\n"+  }++-- | wraps a @CommandUI@ together with a function that turns it into a @Command@.+-- By hiding the type of flags for the UI allows construction of a list of all UIs at the+-- top level of the program. That list can then be used for generation of manual page+-- as well as for executing the selected command.+data CommandSpec action+  = forall flags. CommandSpec (CommandUI flags) (CommandUI flags -> Command action) CommandType++commandFromSpec :: CommandSpec a -> Command a+commandFromSpec (CommandSpec ui action _) = action ui

@@ -53,16 +53,25 @@         parmakeSupported,         reexportedModulesSupported,         renamingPackageFlagsSupported,-        packageKeySupported+        unifiedIPIDRequired,+        packageKeySupported,+        unitIdSupported,++        -- * Support for profiling detail levels+        ProfDetailLevel(..),+        knownProfDetailLevels,+        flagToProfDetailLevel,+        showProfDetailLevel,   ) where  import Distribution.Compiler-import Distribution.Version (Version(..))-import Distribution.Text (display)-import Language.Haskell.Extension (Language(Haskell98), Extension)+import Distribution.Version+import Distribution.Text+import Language.Haskell.Extension+import Distribution.Simple.Utils+import Distribution.Compat.Binary  import Control.Monad (liftM)-import Distribution.Compat.Binary (Binary) import Data.List (nub) import qualified Data.Map as M (Map, lookup) import Data.Maybe (catMaybes, isNothing, listToMaybe)@@ -83,7 +92,7 @@         compilerProperties      :: M.Map String String         -- ^ A key-value map for properties not covered by the above fields.     }-    deriving (Generic, Show, Read)+    deriving (Eq, Generic, Show, Read)  instance Binary Compiler @@ -270,10 +279,18 @@ renamingPackageFlagsSupported :: Compiler -> Bool renamingPackageFlagsSupported = ghcSupported "Support thinning and renaming package flags" +-- | Does this compiler have unified IPIDs (so no package keys)+unifiedIPIDRequired :: Compiler -> Bool+unifiedIPIDRequired = ghcSupported "Requires unified installed package IDs"+ -- | Does this compiler support package keys? packageKeySupported :: Compiler -> Bool packageKeySupported = ghcSupported "Uses package keys" +-- | Does this compiler support unit IDs?+unitIdSupported :: Compiler -> Bool+unitIdSupported = ghcSupported "Uses unit IDs"+ -- | Utility function for GHC only features ghcSupported :: String -> Compiler -> Bool ghcSupported key comp =@@ -285,3 +302,53 @@           case M.lookup key (compilerProperties comp) of             Just "YES" -> True             _          -> False++-- ------------------------------------------------------------+-- * Profiling detail level+-- ------------------------------------------------------------++-- | Some compilers (notably GHC) support profiling and can instrument+-- programs so the system can account costs to different functions. There are+-- different levels of detail that can be used for this accounting.+-- For compilers that do not support this notion or the particular detail+-- levels, this is either ignored or just capped to some similar level+-- they do support.+--+data ProfDetailLevel = ProfDetailNone+                     | ProfDetailDefault+                     | ProfDetailExportedFunctions+                     | ProfDetailToplevelFunctions+                     | ProfDetailAllFunctions+                     | ProfDetailOther String+    deriving (Eq, Generic, Read, Show)++instance Binary ProfDetailLevel++flagToProfDetailLevel :: String -> ProfDetailLevel+flagToProfDetailLevel "" = ProfDetailDefault+flagToProfDetailLevel s  =+    case lookup (lowercase s)+                [ (name, value)+                | (primary, aliases, value) <- knownProfDetailLevels+                , name <- primary : aliases ]+      of Just value -> value+         Nothing    -> ProfDetailOther s++knownProfDetailLevels :: [(String, [String], ProfDetailLevel)]+knownProfDetailLevels =+  [ ("default",            [],                  ProfDetailDefault)+  , ("none",               [],                  ProfDetailNone)+  , ("exported-functions", ["exported"],        ProfDetailExportedFunctions)+  , ("toplevel-functions", ["toplevel", "top"], ProfDetailToplevelFunctions)+  , ("all-functions",      ["all"],             ProfDetailAllFunctions)+  ]++showProfDetailLevel :: ProfDetailLevel -> String+showProfDetailLevel dl = case dl of+    ProfDetailNone              -> "none"+    ProfDetailDefault           -> "default"+    ProfDetailExportedFunctions -> "exported-functions"+    ProfDetailToplevelFunctions -> "toplevel-functions"+    ProfDetailAllFunctions      -> "all-functions"+    ProfDetailOther other       -> other+

@@ -1,1432 +1,1778 @@-{-# LANGUAGE CPP                #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE RecordWildCards    #-}---------------------------------------------------------------------------------- |--- Module      :  Distribution.Simple.Configure--- Copyright   :  Isaac Jones 2003-2005--- License     :  BSD3------ Maintainer  :  cabal-devel@haskell.org--- Portability :  portable------ This deals with the /configure/ phase. It provides the 'configure' action--- which is given the package description and configure flags. It then tries--- to: configure the compiler; resolves any conditionals in the package--- description; resolve the package dependencies; check if all the extensions--- used by this package are supported by the compiler; check that all the build--- tools are available (including version checks if appropriate); checks for--- any required @pkg-config@ packages (updating the 'BuildInfo' with the--- results)------ Then based on all this it saves the info in the 'LocalBuildInfo' and writes--- it out to the @dist\/setup-config@ file. It also displays various details to--- the user, the amount of information displayed depending on the verbosity--- level.--module Distribution.Simple.Configure (configure,-                                      writePersistBuildConfig,-                                      getConfigStateFile,-                                      getPersistBuildConfig,-                                      checkPersistBuildConfigOutdated,-                                      tryGetPersistBuildConfig,-                                      maybeGetPersistBuildConfig,-                                      localBuildInfoFile,-                                      getInstalledPackages, getPackageDBContents,-                                      configCompiler, configCompilerAux,-                                      configCompilerEx, configCompilerAuxEx,-                                      ccLdOptionsBuildInfo,-                                      checkForeignDeps,-                                      interpretPackageDbFlags,-                                      ConfigStateFileError(..),-                                      tryGetConfigStateFile,-                                      platformDefines,-                                     )-    where--import Distribution.Compiler-    ( CompilerId(..) )-import Distribution.Utils.NubList-import Distribution.Simple.Compiler-    ( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion-    , compilerInfo-    , showCompilerId, unsupportedLanguages, unsupportedExtensions-    , PackageDB(..), PackageDBStack, reexportedModulesSupported-    , packageKeySupported, renamingPackageFlagsSupported )-import Distribution.Simple.PreProcess ( platformDefines )-import Distribution.Package-    ( PackageName(PackageName), PackageIdentifier(..), PackageId-    , packageName, packageVersion, Package(..)-    , Dependency(Dependency), simplifyDependency-    , InstalledPackageId(..), thisPackageVersion-    , mkPackageKey, PackageKey(..), packageKeyLibraryName )-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-    ( PackageDescription(..), specVersion, GenericPackageDescription(..)-    , Library(..), hasLibs, Executable(..), BuildInfo(..), allExtensions-    , HookedBuildInfo, updatePackageDescription, allBuildInfo-    , Flag(flagName), FlagName(..), TestSuite(..), Benchmark(..)-    , ModuleReexport(..) , defaultRenaming )-import Distribution.ModuleName-    ( ModuleName )-import Distribution.PackageDescription.Configuration-    ( finalizePackageDescription, mapTreeData )-import Distribution.PackageDescription.Check-    ( PackageCheck(..), checkPackage, checkPackageFiles )-import Distribution.Simple.Program-    ( Program(..), ProgramLocation(..), ConfiguredProgram(..)-    , ProgramConfiguration, defaultProgramConfiguration-    , ProgramSearchPathEntry(..), getProgramSearchPath, setProgramSearchPath-    , configureAllKnownPrograms, knownPrograms, lookupKnownProgram-    , userSpecifyArgss, userSpecifyPaths-    , lookupProgram, requireProgram, requireProgramVersion-    , pkgConfigProgram, gccProgram, rawSystemProgramStdoutConf )-import Distribution.Simple.Setup-    ( ConfigFlags(..), CopyDest(..), Flag(..), fromFlag, fromFlagOrDefault-    , flagToMaybe )-import Distribution.Simple.InstallDirs-    ( InstallDirs(..), defaultInstallDirs, combineInstallDirs )-import Distribution.Simple.LocalBuildInfo-    ( LocalBuildInfo(..), Component(..), ComponentLocalBuildInfo(..)-    , LibraryName(..)-    , absoluteInstallDirs, prefixRelativeInstallDirs, inplacePackageId-    , ComponentName(..), showComponentName, pkgEnabledComponents-    , componentBuildInfo, componentName, checkComponentsCyclic )-import Distribution.Simple.BuildPaths-    ( autogenModulesDir )-import Distribution.Simple.Utils-    ( die, warn, info, setupMessage-    , createDirectoryIfMissingVerbose, moreRecentFile-    , intercalate, cabalVersion-    , writeFileAtomic-    , withTempFile )-import Distribution.System-    ( OS(..), buildOS, Platform (..), buildPlatform )-import Distribution.Version-         ( Version(..), anyVersion, orLaterVersion, withinRange, isAnyVersion )-import Distribution.Verbosity-    ( Verbosity, lessVerbose )--import qualified Distribution.Simple.GHC   as GHC-import qualified Distribution.Simple.GHCJS as GHCJS-import qualified Distribution.Simple.JHC   as JHC-import qualified Distribution.Simple.LHC   as LHC-import qualified Distribution.Simple.UHC   as UHC-import qualified Distribution.Simple.HaskellSuite as HaskellSuite---- Prefer the more generic Data.Traversable.mapM to Prelude.mapM-import Prelude hiding ( mapM )-import Control.Exception-    ( ErrorCall(..), Exception, evaluate, throw, throwIO, try )-import Control.Monad-    ( liftM, when, unless, foldM, filterM )-import Distribution.Compat.Binary ( decodeOrFailIO, encode )-import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString            as BS-import qualified Data.ByteString.Lazy.Char8 as BLC8-import Data.List-    ( (\\), nub, partition, isPrefixOf, inits, stripPrefix )-import Data.Maybe-    ( isNothing, catMaybes, fromMaybe, isJust )-import Data.Either-    ( partitionEithers )-import qualified Data.Set as Set-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid-    ( Monoid(..) )-#endif-import qualified Data.Map as Map-import Data.Map (Map)-import Data.Traversable-    ( mapM )-import Data.Typeable-import System.Directory-    ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )-import System.FilePath-    ( (</>), isAbsolute )-import qualified System.Info-    ( compilerName, compilerVersion )-import System.IO-    ( hPutStrLn, hClose )-import Distribution.Text-    ( Text(disp), display, simpleParse )-import Text.PrettyPrint-    ( render, (<>), ($+$), char, text, comma-    , quotes, punctuate, nest, sep, hsep )-import Distribution.Compat.Exception ( catchExit, catchIO )--data ConfigStateFileError-    = ConfigStateFileNoHeader-    | ConfigStateFileBadHeader-    | ConfigStateFileNoParse-    | ConfigStateFileMissing-    | ConfigStateFileBadVersion PackageIdentifier PackageIdentifier (Either ConfigStateFileError LocalBuildInfo)-  deriving (Typeable)--instance Show ConfigStateFileError where-    show ConfigStateFileNoHeader =-        "Saved package config file header is missing. "-        ++ "Try re-running the 'configure' command."-    show ConfigStateFileBadHeader =-        "Saved package config file header is corrupt. "-        ++ "Try re-running the 'configure' command."-    show ConfigStateFileNoParse =-        "Saved package config file body is corrupt. "-        ++ "Try re-running the 'configure' command."-    show ConfigStateFileMissing = "Run the 'configure' command first."-    show (ConfigStateFileBadVersion oldCabal oldCompiler _) =-        "You need to re-run the 'configure' command. "-        ++ "The version of Cabal being used has changed (was "-        ++ display oldCabal ++ ", now "-        ++ display currentCabalId ++ ")."-        ++ badCompiler-      where-        badCompiler-          | oldCompiler == currentCompilerId = ""-          | otherwise =-              " Additionally the compiler is different (was "-              ++ display oldCompiler ++ ", now "-              ++ display currentCompilerId-              ++ ") which is probably the cause of the problem."--instance Exception ConfigStateFileError--getConfigStateFile :: FilePath -> IO LocalBuildInfo-getConfigStateFile filename = do-    exists <- doesFileExist filename-    unless exists $ throwIO ConfigStateFileMissing-    -- Read the config file into a strict ByteString to avoid problems with-    -- lazy I/O, then convert to lazy because the binary package needs that.-    contents <- BS.readFile filename-    let (header, body) = BLC8.span (/='\n') (BLC8.fromChunks [contents])--    headerParseResult <- try $ evaluate $ parseHeader header-    let (cabalId, compId) =-            case headerParseResult of-              Left (ErrorCall _) -> throw ConfigStateFileBadHeader-              Right x -> x--    let getStoredValue = do-          result <- decodeOrFailIO (BLC8.tail body)-          case result of-            Left _ -> throw ConfigStateFileNoParse-            Right x -> return x-        deferErrorIfBadVersion act-          | cabalId /= currentCabalId = do-              eResult <- try act-              throw $ ConfigStateFileBadVersion cabalId compId eResult-          | otherwise = act-    deferErrorIfBadVersion getStoredValue--tryGetConfigStateFile :: FilePath-                      -> IO (Either ConfigStateFileError LocalBuildInfo)-tryGetConfigStateFile = try . getConfigStateFile---- |Try to read the 'localBuildInfoFile'.-tryGetPersistBuildConfig :: FilePath-                         -> IO (Either ConfigStateFileError LocalBuildInfo)-tryGetPersistBuildConfig = try . getPersistBuildConfig---- | Read the 'localBuildInfoFile'. Throw an exception if the file is--- missing, if the file cannot be read, or if the file was created by an older--- version of Cabal.-getPersistBuildConfig :: FilePath -> IO LocalBuildInfo-getPersistBuildConfig = getConfigStateFile . localBuildInfoFile---- |Try to read the 'localBuildInfoFile'.-maybeGetPersistBuildConfig :: FilePath -> IO (Maybe LocalBuildInfo)-maybeGetPersistBuildConfig =-    liftM (either (const Nothing) Just) . tryGetPersistBuildConfig---- |After running configure, output the 'LocalBuildInfo' to the--- 'localBuildInfoFile'.-writePersistBuildConfig :: FilePath -> LocalBuildInfo -> IO ()-writePersistBuildConfig distPref lbi = do-    createDirectoryIfMissing False distPref-    writeFileAtomic (localBuildInfoFile distPref) $-      BLC8.unlines [showHeader pkgId, encode lbi]-  where-    pkgId = packageId $ localPkgDescr lbi--currentCabalId :: PackageIdentifier-currentCabalId = PackageIdentifier (PackageName "Cabal") cabalVersion--currentCompilerId :: PackageIdentifier-currentCompilerId = PackageIdentifier (PackageName System.Info.compilerName)-                                      System.Info.compilerVersion--parseHeader :: ByteString -> (PackageIdentifier, PackageIdentifier)-parseHeader header = case BLC8.words header of-  ["Saved", "package", "config", "for", pkgId, "written", "by", cabalId, "using", compId] ->-      fromMaybe (throw ConfigStateFileBadHeader) $ do-          _ <- simpleParse (BLC8.unpack pkgId) :: Maybe PackageIdentifier-          cabalId' <- simpleParse (BLC8.unpack cabalId)-          compId' <- simpleParse (BLC8.unpack compId)-          return (cabalId', compId')-  _ -> throw ConfigStateFileNoHeader--showHeader :: PackageIdentifier -> ByteString-showHeader pkgId = BLC8.unwords-    [ "Saved", "package", "config", "for"-    , BLC8.pack $ display pkgId-    , "written", "by"-    , BLC8.pack $ display currentCabalId-    , "using"-    , BLC8.pack $ display currentCompilerId-    ]---- |Check that localBuildInfoFile is up-to-date with respect to the--- .cabal file.-checkPersistBuildConfigOutdated :: FilePath -> FilePath -> IO Bool-checkPersistBuildConfigOutdated distPref pkg_descr_file = do-  pkg_descr_file `moreRecentFile` (localBuildInfoFile distPref)---- |@dist\/setup-config@-localBuildInfoFile :: FilePath -> FilePath-localBuildInfoFile distPref = distPref </> "setup-config"---- -------------------------------------------------------------------------------- * Configuration--- --------------------------------------------------------------------------------- |Perform the \"@.\/setup configure@\" action.--- Returns the @.setup-config@ file.-configure :: (GenericPackageDescription, HookedBuildInfo)-          -> ConfigFlags -> IO LocalBuildInfo-configure (pkg_descr0, pbi) cfg-  = do  let distPref = fromFlag (configDistPref cfg)-            buildDir' = distPref </> "build"-            verbosity = fromFlag (configVerbosity cfg)--        setupMessage verbosity "Configuring" (packageId pkg_descr0)--        unless (configLibCoverage cfg == NoFlag) $ do-          let enable | fromFlag (configLibCoverage cfg) = "enable"-                     | otherwise = "disable"-          warn verbosity-            ("The flag --" ++ enable ++ "-library-coverage is deprecated. "-             ++ "Please use --" ++ enable ++ "-coverage instead.")--        createDirectoryIfMissingVerbose (lessVerbose verbosity) True distPref--        let programsConfig = mkProgramsConfig cfg (configPrograms cfg)-            userInstall    = fromFlag (configUserInstall cfg)-            packageDbs     = interpretPackageDbFlags userInstall-                             (configPackageDBs cfg)--        -- detect compiler-        (comp, compPlatform, programsConfig') <- configCompilerEx-          (flagToMaybe $ configHcFlavor cfg)-          (flagToMaybe $ configHcPath cfg) (flagToMaybe $ configHcPkg cfg)-          programsConfig (lessVerbose verbosity)-        let version = compilerVersion comp-            flavor  = compilerFlavor comp--        -- Create a PackageIndex that makes *any libraries that might be*-        -- defined internally to this package look like installed packages, in-        -- case an executable should refer to any of them as dependencies.-        ---        -- It must be *any libraries that might be* defined rather than the-        -- actual definitions, because these depend on conditionals in the .cabal-        -- file, and we haven't resolved them yet.  finalizePackageDescription-        -- does the resolution of conditionals, and it takes internalPackageSet-        -- as part of its input.-        ---        -- Currently a package can define no more than one library (which has-        -- the same name as the package) but we could extend this later.-        -- If we later allowed private internal libraries, then here we would-        -- need to pre-scan the conditional data to make a list of all private-        -- libraries that could possibly be defined by the .cabal file.-        let pid = packageId pkg_descr0-            internalPackage = emptyInstalledPackageInfo {-                --TODO: should use a per-compiler method to map the source-                --      package ID into an installed package id we can use-                --      for the internal package set. The open-codes use of-                --      InstalledPackageId . display here is a hack.-                Installed.installedPackageId =-                   InstalledPackageId $ display $ pid,-                Installed.sourcePackageId = pid-              }-            internalPackageSet = PackageIndex.fromList [internalPackage]-        installedPackageSet <- getInstalledPackages (lessVerbose verbosity) comp-                                      packageDbs programsConfig'--        (allConstraints, requiredDepsMap) <- either die return $-          combinedConstraints (configConstraints cfg)-                              (configDependencies cfg)-                              installedPackageSet--        let exactConf = fromFlagOrDefault False (configExactConfiguration cfg)-            -- Constraint test function for the solver-            dependencySatisfiable d@(Dependency depName verRange)-              | exactConf =-                -- When we're given '--exact-configuration', we assume that all-                -- dependencies and flags are exactly specified on the command-                -- line. Thus we only consult the 'requiredDepsMap'. Note that-                -- we're not doing the version range check, so if there's some-                -- dependency that wasn't specified on the command line,-                -- 'finalizePackageDescription' will fail.-                ---                -- TODO: mention '--exact-configuration' in the error message-                -- when this fails?-                (depName `Map.member` requiredDepsMap) || isInternalDep--              | otherwise =-                -- Normal operation: just look up dependency in the package-                -- index.-                not . null . PackageIndex.lookupDependency pkgs' $ d-              where-                pkgs' = PackageIndex.insert internalPackage installedPackageSet-                isInternalDep = pkgName pid == depName-                                && pkgVersion pid `withinRange` verRange-            enableTest t = t { testEnabled = fromFlag (configTests cfg) }-            flaggedTests = map (\(n, t) -> (n, mapTreeData enableTest t))-                               (condTestSuites pkg_descr0)-            enableBenchmark bm = bm { benchmarkEnabled =-                                         fromFlag (configBenchmarks cfg) }-            flaggedBenchmarks = map (\(n, bm) ->-                                      (n, mapTreeData enableBenchmark bm))-                               (condBenchmarks pkg_descr0)-            pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests-                                      , condBenchmarks = flaggedBenchmarks }--        (pkg_descr0', flags) <--                case finalizePackageDescription-                       (configConfigurationsFlags cfg)-                       dependencySatisfiable-                       compPlatform-                       (compilerInfo comp)-                       allConstraints-                       pkg_descr0''-                of Right r -> return r-                   Left missing ->-                       die $ "At least the following dependencies are missing:\n"-                         ++ (render . nest 4 . sep . punctuate comma-                                    . map (disp . simplifyDependency)-                                    $ missing)--        -- Sanity check: if '--exact-configuration' was given, ensure that the-        -- complete flag assignment was specified on the command line.-        when exactConf $ do-          let cmdlineFlags = map fst (configConfigurationsFlags cfg)-              allFlags     = map flagName . genPackageFlags $ pkg_descr0-              diffFlags    = allFlags \\ cmdlineFlags-          when (not . null $ diffFlags) $-            die $ "'--exact-conf' was given, "-            ++ "but the following flags were not specified: "-            ++ intercalate ", " (map show diffFlags)--        -- add extra include/lib dirs as specified in cfg-        -- we do it here so that those get checked too-        let pkg_descr = addExtraIncludeLibDirs pkg_descr0'--        unless (renamingPackageFlagsSupported comp ||-                    and [ rn == defaultRenaming-                        | bi <- allBuildInfo pkg_descr-                        , rn <- Map.elems (targetBuildRenaming bi)]) $-            die $ "Your compiler does not support thinning and renaming on "-               ++ "package flags.  To use this feature you probably must use "-               ++ "GHC 7.9 or later."--        when (not (null flags)) $-          info verbosity $ "Flags chosen: "-                        ++ intercalate ", " [ name ++ "=" ++ display value-                                            | (FlagName name, value) <- flags ]--        when (maybe False (not.null.PD.reexportedModules) (PD.library pkg_descr)-              && not (reexportedModulesSupported comp)) $ do-            die $ "Your compiler does not support module re-exports. To use "-               ++ "this feature you probably must use GHC 7.9 or later."--        checkPackageProblems verbosity pkg_descr0-          (updatePackageDescription pbi pkg_descr)--        -- Handle hole instantiation-        (holeDeps, hole_insts) <- configureInstantiateWith pkg_descr cfg installedPackageSet--        let selectDependencies :: [Dependency] ->-                                  ([FailedDependency], [ResolvedDependency])-            selectDependencies =-                (\xs -> ([ x | Left x <- xs ], [ x | Right x <- xs ]))-              . map (selectDependency internalPackageSet installedPackageSet-                                      requiredDepsMap)--            (failedDeps, allPkgDeps) =-              selectDependencies (buildDepends pkg_descr)--            internalPkgDeps = [ pkgid-                              | InternalDependency _ pkgid <- allPkgDeps ]-            externalPkgDeps = [ pkg-                              | ExternalDependency _ pkg   <- allPkgDeps ]--        when (not (null internalPkgDeps)-              && not (newPackageDepsBehaviour pkg_descr)) $-            die $ "The field 'build-depends: "-               ++ intercalate ", " (map (display . packageName) internalPkgDeps)-               ++ "' refers to a library which is defined within the same "-               ++ "package. To use this feature the package must specify at "-               ++ "least 'cabal-version: >= 1.8'."--        reportFailedDependencies failedDeps-        reportSelectedDependencies verbosity allPkgDeps--        let installDeps = Map.elems-                        . Map.fromList-                        . map (\v -> (Installed.installedPackageId v, v))-                        $ externalPkgDeps ++ holeDeps--        packageDependsIndex <--          case PackageIndex.dependencyClosure installedPackageSet-                  (map Installed.installedPackageId installDeps) of-            Left packageDependsIndex -> return packageDependsIndex-            Right broken ->-              die $ "The following installed packages are broken because other"-                 ++ " packages they depend on are missing. These broken "-                 ++ "packages must be rebuilt before they can be used.\n"-                 ++ unlines [ "package "-                           ++ display (packageId pkg)-                           ++ " is broken due to missing package "-                           ++ intercalate ", " (map display deps)-                            | (pkg, deps) <- broken ]--        let pseudoTopPkg = emptyInstalledPackageInfo {-                Installed.installedPackageId =-                   InstalledPackageId (display (packageId pkg_descr)),-                Installed.sourcePackageId = packageId pkg_descr,-                Installed.depends =-                  map Installed.installedPackageId installDeps-              }-        case PackageIndex.dependencyInconsistencies-           . PackageIndex.insert pseudoTopPkg-           $ packageDependsIndex of-          [] -> return ()-          inconsistencies ->-            warn verbosity $-                 "This package indirectly depends on multiple versions of the same "-              ++ "package. This is highly likely to cause a compile failure.\n"-              ++ unlines [ "package " ++ display pkg ++ " requires "-                        ++ display (PackageIdentifier name ver)-                         | (name, uses) <- inconsistencies-                         , (pkg, ver) <- uses ]--        -- Calculate the package key.  We're going to store it in LocalBuildInfo-        -- canonically, but ComponentsLocalBuildInfo also needs to know about it-        -- XXX Do we need the internal deps?-        -- NB: does *not* include holeDeps!-        let pkg_key = mkPackageKey (packageKeySupported comp)-                                   (package pkg_descr)-                                   (map Installed.packageKey externalPkgDeps)-                                   (map (\(k,(p,m)) -> (k,(Installed.packageKey p,m))) hole_insts)--        -- internal component graph-        buildComponents <--          case mkComponentsGraph pkg_descr internalPkgDeps of-            Left  componentCycle -> reportComponentCycle componentCycle-            Right components     ->-              case mkComponentsLocalBuildInfo packageDependsIndex pkg_descr-                                              internalPkgDeps externalPkgDeps holeDeps-                                              (Map.fromList hole_insts)-                                              pkg_key components of-                Left  problems    -> reportModuleReexportProblems problems-                Right components' -> return components'--        -- installation directories-        defaultDirs <- defaultInstallDirs flavor userInstall (hasLibs pkg_descr)-        let installDirs = combineInstallDirs fromFlagOrDefault-                            defaultDirs (configInstallDirs cfg)--        -- check languages and extensions-        let langlist = nub $ catMaybes $ map defaultLanguage-                       (allBuildInfo pkg_descr)-        let langs = unsupportedLanguages comp langlist-        when (not (null langs)) $-          die $ "The package " ++ display (packageId pkg_descr0)-             ++ " requires the following languages which are not "-             ++ "supported by " ++ display (compilerId comp) ++ ": "-             ++ intercalate ", " (map display langs)-        let extlist = nub $ concatMap allExtensions (allBuildInfo pkg_descr)-        let exts = unsupportedExtensions comp extlist-        when (not (null exts)) $-          die $ "The package " ++ display (packageId pkg_descr0)-             ++ " requires the following language extensions which are not "-             ++ "supported by " ++ display (compilerId comp) ++ ": "-             ++ intercalate ", " (map display exts)--        -- configured known/required programs & external build tools-        -- exclude build-tool deps on "internal" exes in the same package-        let requiredBuildTools =-              [ buildTool-              | let exeNames = map exeName (executables pkg_descr)-              , bi <- allBuildInfo pkg_descr-              , buildTool@(Dependency (PackageName toolName) reqVer)-                <- buildTools bi-              , let isInternal =-                        toolName `elem` exeNames-                        -- we assume all internal build-tools are-                        -- versioned with the package:-                     && packageVersion pkg_descr `withinRange` reqVer-              , not isInternal ]--        programsConfig'' <--              configureAllKnownPrograms (lessVerbose verbosity) programsConfig'-          >>= configureRequiredPrograms verbosity requiredBuildTools--        (pkg_descr', programsConfig''') <--          configurePkgconfigPackages verbosity pkg_descr programsConfig''--        split_objs <--           if not (fromFlag $ configSplitObjs cfg)-                then return False-                else case flavor of-                            GHC | version >= Version [6,5] [] -> return True-                            GHCJS                             -> return True-                            _ -> do warn verbosity-                                         ("this compiler does not support " ++-                                          "--enable-split-objs; ignoring")-                                    return False--        let ghciLibByDefault =-              case compilerId comp of-                CompilerId GHC _ ->-                  -- If ghc is non-dynamic, then ghci needs object files,-                  -- so we build one by default.-                  ---                  -- Technically, archive files should be sufficient for ghci,-                  -- but because of GHC bug #8942, it has never been safe to-                  -- rely on them. By the time that bug was fixed, ghci had-                  -- been changed to read shared libraries instead of archive-                  -- files (see next code block).-                  not (GHC.isDynamic comp)-                CompilerId GHCJS _ ->-                  not (GHCJS.isDynamic comp)-                _ -> False--        let sharedLibsByDefault-              | fromFlag (configDynExe cfg) =-                  -- build a shared library if dynamically-linked-                  -- executables are requested-                  True-              | otherwise = case compilerId comp of-                CompilerId GHC _ ->-                  -- if ghc is dynamic, then ghci needs a shared-                  -- library, so we build one by default.-                  GHC.isDynamic comp-                CompilerId GHCJS _ ->-                  GHCJS.isDynamic comp-                _ -> False-            withSharedLib_ =-                -- build shared libraries if required by GHC or by the-                -- executable linking mode, but allow the user to force-                -- building only static library archives with-                -- --disable-shared.-                fromFlagOrDefault sharedLibsByDefault $ configSharedLib cfg-            withDynExe_ = fromFlag $ configDynExe cfg-        when (withDynExe_ && not withSharedLib_) $ warn verbosity $-               "Executables will use dynamic linking, but a shared library "-            ++ "is not being built. Linking will fail if any executables "-            ++ "depend on the library."--        let withProfExe_ = fromFlagOrDefault False $ configProfExe cfg-            withProfLib_ = fromFlagOrDefault withProfExe_ $ configProfLib cfg-        when (withProfExe_ && not withProfLib_) $ warn verbosity $-               "Executables will be built with profiling, but library "-            ++ "profiling is disabled. Linking will fail if any executables "-            ++ "depend on the library."--        let configCoverage_ =-              mappend (configCoverage cfg) (configLibCoverage cfg)--            cfg' = cfg { configCoverage = configCoverage_ }--        reloc <--           if not (fromFlag $ configRelocatable cfg)-                then return False-                else return True--        let lbi = LocalBuildInfo {-                    configFlags         = cfg',-                    extraConfigArgs     = [],  -- Currently configure does not-                                               -- take extra args, but if it-                                               -- did they would go here.-                    installDirTemplates = installDirs,-                    compiler            = comp,-                    hostPlatform        = compPlatform,-                    buildDir            = buildDir',-                    componentsConfigs   = buildComponents,-                    installedPkgs       = packageDependsIndex,-                    pkgDescrFile        = Nothing,-                    localPkgDescr       = pkg_descr',-                    pkgKey              = pkg_key,-                    instantiatedWith    = hole_insts,-                    withPrograms        = programsConfig''',-                    withVanillaLib      = fromFlag $ configVanillaLib cfg,-                    withProfLib         = withProfLib_,-                    withSharedLib       = withSharedLib_,-                    withDynExe          = withDynExe_,-                    withProfExe         = withProfExe_,-                    withOptimization    = fromFlag $ configOptimization cfg,-                    withDebugInfo       = fromFlag $ configDebugInfo cfg,-                    withGHCiLib         = fromFlagOrDefault ghciLibByDefault $-                                          configGHCiLib cfg,-                    splitObjs           = split_objs,-                    stripExes           = fromFlag $ configStripExes cfg,-                    stripLibs           = fromFlag $ configStripLibs cfg,-                    withPackageDB       = packageDbs,-                    progPrefix          = fromFlag $ configProgPrefix cfg,-                    progSuffix          = fromFlag $ configProgSuffix cfg,-                    relocatable         = reloc-                  }--        when reloc (checkRelocatable verbosity pkg_descr lbi)--        let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest-            relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi--        unless (isAbsolute (prefix dirs)) $ die $-            "expected an absolute directory name for --prefix: " ++ prefix dirs--        info verbosity $ "Using " ++ display currentCabalId-                      ++ " compiled by " ++ display currentCompilerId-        info verbosity $ "Using compiler: " ++ showCompilerId comp-        info verbosity $ "Using install prefix: " ++ prefix dirs--        let dirinfo name dir isPrefixRelative =-              info verbosity $ name ++ " installed in: " ++ dir ++ relNote-              where relNote = case buildOS of-                      Windows | not (hasLibs pkg_descr)-                             && isNothing isPrefixRelative-                             -> "  (fixed location)"-                      _      -> ""--        dirinfo "Binaries"         (bindir dirs)     (bindir relative)-        dirinfo "Libraries"        (libdir dirs)     (libdir relative)-        dirinfo "Private binaries" (libexecdir dirs) (libexecdir relative)-        dirinfo "Data files"       (datadir dirs)    (datadir relative)-        dirinfo "Documentation"    (docdir dirs)     (docdir relative)-        dirinfo "Configuration files" (sysconfdir dirs) (sysconfdir relative)--        sequence_ [ reportProgram verbosity prog configuredProg-                  | (prog, configuredProg) <- knownPrograms programsConfig''' ]--        return lbi--    where-      addExtraIncludeLibDirs pkg_descr =-          let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg-                               , PD.includeDirs = configExtraIncludeDirs cfg}-              modifyLib l        = l{ libBuildInfo = libBuildInfo l-                                                     `mappend` extraBi }-              modifyExecutable e = e{ buildInfo    = buildInfo e-                                                     `mappend` extraBi}-          in pkg_descr{ library     = modifyLib        `fmap` library pkg_descr-                      , executables = modifyExecutable  `map`-                                      executables pkg_descr}--mkProgramsConfig :: ConfigFlags -> ProgramConfiguration -> ProgramConfiguration-mkProgramsConfig cfg initialProgramsConfig = programsConfig-  where-    programsConfig = userSpecifyArgss (configProgramArgs cfg)-                   . userSpecifyPaths (configProgramPaths cfg)-                   . setProgramSearchPath searchpath-                   $ initialProgramsConfig-    searchpath     = getProgramSearchPath (initialProgramsConfig)-                  ++ map ProgramSearchPathDir (fromNubList $ configProgramPathExtra cfg)---- -------------------------------------------------------------------------------- Configuring package dependencies--reportProgram :: Verbosity -> Program -> Maybe ConfiguredProgram -> IO ()-reportProgram verbosity prog Nothing-    = info verbosity $ "No " ++ programName prog ++ " found"-reportProgram verbosity prog (Just configuredProg)-    = info verbosity $ "Using " ++ programName prog ++ version ++ location-    where location = case programLocation configuredProg of-            FoundOnSystem p -> " found on system at: " ++ p-            UserSpecified p -> " given by user at: " ++ p-          version = case programVersion configuredProg of-            Nothing -> ""-            Just v  -> " version " ++ display v--hackageUrl :: String-hackageUrl = "http://hackage.haskell.org/package/"--data ResolvedDependency = ExternalDependency Dependency InstalledPackageInfo-                        | InternalDependency Dependency PackageId -- should be a-                                                                      -- lib name--data FailedDependency = DependencyNotExists PackageName-                      | DependencyNoVersion Dependency---- | Test for a package dependency and record the version we have installed.-selectDependency :: InstalledPackageIndex  -- ^ Internally defined packages-                 -> InstalledPackageIndex  -- ^ Installed packages-                 -> Map PackageName InstalledPackageInfo-                    -- ^ Packages for which we have been given specific deps to use-                 -> Dependency-                 -> Either FailedDependency ResolvedDependency-selectDependency internalIndex installedIndex requiredDepsMap-  dep@(Dependency pkgname vr) =-  -- If the dependency specification matches anything in the internal package-  -- index, then we prefer that match to anything in the second.-  -- For example:-  ---  -- Name: MyLibrary-  -- Version: 0.1-  -- Library-  --     ..-  -- Executable my-exec-  --     build-depends: MyLibrary-  ---  -- We want "build-depends: MyLibrary" always to match the internal library-  -- even if there is a newer installed library "MyLibrary-0.2".-  -- However, "build-depends: MyLibrary >= 0.2" should match the installed one.-  case PackageIndex.lookupPackageName internalIndex pkgname of-    [(_,[pkg])] | packageVersion pkg `withinRange` vr-           -> Right $ InternalDependency dep (packageId pkg)--    _      -> case Map.lookup pkgname requiredDepsMap of-      -- If we know the exact pkg to use, then use it.-      Just pkginstance -> Right (ExternalDependency dep pkginstance)-      -- Otherwise we just pick an arbitrary instance of the latest version.-      Nothing -> case PackageIndex.lookupDependency installedIndex dep of-        []   -> Left  $ DependencyNotExists pkgname-        pkgs -> Right $ ExternalDependency dep $-                case last pkgs of-                  (_ver, pkginstances) -> head pkginstances--reportSelectedDependencies :: Verbosity-                           -> [ResolvedDependency] -> IO ()-reportSelectedDependencies verbosity deps =-  info verbosity $ unlines-    [ "Dependency " ++ display (simplifyDependency dep)-                    ++ ": using " ++ display pkgid-    | resolved <- deps-    , let (dep, pkgid) = case resolved of-            ExternalDependency dep' pkg'   -> (dep', packageId pkg')-            InternalDependency dep' pkgid' -> (dep', pkgid') ]--reportFailedDependencies :: [FailedDependency] -> IO ()-reportFailedDependencies []     = return ()-reportFailedDependencies failed =-    die (intercalate "\n\n" (map reportFailedDependency failed))--  where-    reportFailedDependency (DependencyNotExists pkgname) =-         "there is no version of " ++ display pkgname ++ " installed.\n"-      ++ "Perhaps you need to download and install it from\n"-      ++ hackageUrl ++ display pkgname ++ "?"--    reportFailedDependency (DependencyNoVersion dep) =-        "cannot satisfy dependency " ++ display (simplifyDependency dep) ++ "\n"--getInstalledPackages :: Verbosity -> Compiler-                     -> PackageDBStack -> ProgramConfiguration-                     -> IO InstalledPackageIndex-getInstalledPackages verbosity comp packageDBs progconf = do-  when (null packageDBs) $-    die $ "No package databases have been specified. If you use "-       ++ "--package-db=clear, you must follow it with --package-db= "-       ++ "with 'global', 'user' or a specific file."--  info verbosity "Reading installed packages..."-  case compilerFlavor comp of-    GHC   -> GHC.getInstalledPackages verbosity packageDBs progconf-    GHCJS -> GHCJS.getInstalledPackages verbosity packageDBs progconf-    JHC   -> JHC.getInstalledPackages verbosity packageDBs progconf-    LHC   -> LHC.getInstalledPackages verbosity packageDBs progconf-    UHC   -> UHC.getInstalledPackages verbosity comp packageDBs progconf-    HaskellSuite {} ->-      HaskellSuite.getInstalledPackages verbosity packageDBs progconf-    flv -> die $ "don't know how to find the installed packages for "-              ++ display flv---- | Like 'getInstalledPackages', but for a single package DB.-getPackageDBContents :: Verbosity -> Compiler-                     -> PackageDB -> ProgramConfiguration-                     -> IO InstalledPackageIndex-getPackageDBContents verbosity comp packageDB progconf = do-  info verbosity "Reading installed packages..."-  case compilerFlavor comp of-    GHC -> GHC.getPackageDBContents verbosity packageDB progconf-    GHCJS -> GHCJS.getPackageDBContents verbosity packageDB progconf-    -- For other compilers, try to fall back on 'getInstalledPackages'.-    _   -> getInstalledPackages verbosity comp [packageDB] progconf----- | The user interface specifies the package dbs to use with a combination of--- @--global@, @--user@ and @--package-db=global|user|clear|$file@.--- This function combines the global/user flag and interprets the package-db--- flag into a single package db stack.----interpretPackageDbFlags :: Bool -> [Maybe PackageDB] -> PackageDBStack-interpretPackageDbFlags userInstall specificDBs =-    extra initialStack specificDBs-  where-    initialStack | userInstall = [GlobalPackageDB, UserPackageDB]-                 | otherwise   = [GlobalPackageDB]--    extra dbs' []            = dbs'-    extra _    (Nothing:dbs) = extra []             dbs-    extra dbs' (Just db:dbs) = extra (dbs' ++ [db]) dbs--newPackageDepsBehaviourMinVersion :: Version-newPackageDepsBehaviourMinVersion = Version [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---- We are given both --constraint="foo < 2.0" style constraints and also--- specific packages to pick via --dependency="foo=foo-2.0-177d5cdf20962d0581".------ When finalising the package we have to take into account the specific--- installed deps we've been given, and the finalise function expects--- constraints, so we have to translate these deps into version constraints.------ But after finalising we then have to make sure we pick the right specific--- deps in the end. So we still need to remember which installed packages to--- pick.-combinedConstraints :: [Dependency] ->-                       [(PackageName, InstalledPackageId)] ->-                       InstalledPackageIndex ->-                       Either String ([Dependency],-                                      Map PackageName InstalledPackageInfo)-combinedConstraints constraints dependencies installedPackages = do--    when (not (null badInstalledPackageIds)) $-      Left $ render $ text "The following package dependencies were requested"-         $+$ nest 4 (dispDependencies badInstalledPackageIds)-         $+$ text "however the given installed package instance does not exist."--    when (not (null badNames)) $-      Left $ render $ text "The following package dependencies were requested"-         $+$ nest 4 (dispDependencies badNames)-         $+$ text "however the installed package's name does not match the name given."--    --TODO: we don't check that all dependencies are used!--    return (allConstraints, idConstraintMap)--  where-    allConstraints :: [Dependency]-    allConstraints = constraints-                  ++ [ thisPackageVersion (packageId pkg)-                     | (_, _, Just pkg) <- dependenciesPkgInfo ]--    idConstraintMap :: Map PackageName InstalledPackageInfo-    idConstraintMap = Map.fromList-                        [ (packageName pkg, pkg)-                        | (_, _, Just pkg) <- dependenciesPkgInfo ]--    -- The dependencies along with the installed package info, if it exists-    dependenciesPkgInfo :: [(PackageName, InstalledPackageId,-                             Maybe InstalledPackageInfo)]-    dependenciesPkgInfo =-      [ (pkgname, ipkgid, mpkg)-      | (pkgname, ipkgid) <- dependencies-      , let mpkg = PackageIndex.lookupInstalledPackageId-                     installedPackages ipkgid-      ]--    -- If we looked up a package specified by an installed package id-    -- (i.e. someone has written a hash) and didn't find it then it's-    -- an error.-    badInstalledPackageIds =-      [ (pkgname, ipkgid)-      | (pkgname, ipkgid, Nothing) <- dependenciesPkgInfo ]--    -- If someone has written e.g.-    -- --dependency="foo=MyOtherLib-1.0-07...5bf30" then they have-    -- probably made a mistake.-    badNames =-      [ (requestedPkgName, ipkgid)-      | (requestedPkgName, ipkgid, Just pkg) <- dependenciesPkgInfo-      , let foundPkgName = packageName pkg-      , requestedPkgName /= foundPkgName ]--    dispDependencies deps =-      hsep [    text "--dependency="-             <> quotes (disp pkgname <> char '=' <> disp ipkgid)-           | (pkgname, ipkgid) <- deps ]---- -------------------------------------------------------------------------------- Configuring hole instantiation--configureInstantiateWith :: PackageDescription-                         -> ConfigFlags-                         -> InstalledPackageIndex -- ^ installed packages-                         -> IO ([InstalledPackageInfo],-                                [(ModuleName, (InstalledPackageInfo, ModuleName))])-configureInstantiateWith pkg_descr cfg installedPackageSet = do-        -- Holes: First, check and make sure the provided instantiation covers-        -- all the holes we know about.  Indefinite package installation is-        -- not handled at all at this point.-        -- NB: We union together /all/ of the requirements when calculating-        -- the package key.-        -- NB: For now, we assume that dependencies don't contribute signatures.-        -- This will be handled by cabal-install; as far as ./Setup is-        -- concerned, the most important thing is to be provided correctly-        -- built dependencies.-        let signatures =-              maybe [] (\lib -> requiredSignatures lib ++ exposedSignatures lib)-                (PD.library pkg_descr)-            signatureSet = Set.fromList signatures-            instantiateMap = Map.fromList (configInstantiateWith cfg)-            missing_impls = filter (not . flip Map.member instantiateMap) signatures-            hole_insts0 = filter (\(k,_) -> Set.member k signatureSet) (configInstantiateWith cfg)--        when (not (null missing_impls)) $-          die $ "Missing signature implementations for these modules: "-            ++ intercalate ", " (map display missing_impls)--        -- Holes: Next, we need to make sure we have packages to actually-        -- provide the implementations we're talking about.  This is on top-        -- of the normal dependency resolution process.-        -- TODO: internal dependencies (e.g. the test package depending on the-        -- main library) is not currently supported-        let selectHoleDependency (k,(i,m)) =-              case PackageIndex.lookupInstalledPackageId installedPackageSet i of-                Just pkginst -> Right (k,(pkginst, m))-                Nothing -> Left i-            (failed_hmap, hole_insts) = partitionEithers (map selectHoleDependency hole_insts0)-            holeDeps = map (fst.snd) hole_insts -- could have dups--        -- Holes: Finally, any dependencies selected this way have to be-        -- included in the allPkgs index, as well as the buildComponents.-        -- But don't report these as potential inconsistencies!--        when (not (null failed_hmap)) $-          die $ "Could not resolve these package IDs (from signature implementations): "-            ++ intercalate ", " (map display failed_hmap)--        return (holeDeps, hole_insts)---- -------------------------------------------------------------------------------- Configuring program dependencies--configureRequiredPrograms :: Verbosity -> [Dependency] -> ProgramConfiguration-                             -> IO ProgramConfiguration-configureRequiredPrograms verbosity deps conf =-  foldM (configureRequiredProgram verbosity) conf deps--configureRequiredProgram :: Verbosity -> ProgramConfiguration -> Dependency-                            -> IO ProgramConfiguration-configureRequiredProgram verbosity conf-  (Dependency (PackageName progName) verRange) =-  case lookupKnownProgram progName conf of-    Nothing -> die ("Unknown build tool " ++ progName)-    Just prog-      -- requireProgramVersion always requires the program have a version-      -- but if the user says "build-depends: foo" ie no version constraint-      -- then we should not fail if we cannot discover the program version.-      | verRange == anyVersion -> do-          (_, conf') <- requireProgram verbosity prog conf-          return conf'-      | otherwise -> do-          (_, _, conf') <- requireProgramVersion verbosity prog verRange conf-          return conf'---- -------------------------------------------------------------------------------- Configuring pkg-config package dependencies--configurePkgconfigPackages :: Verbosity -> PackageDescription-                           -> ProgramConfiguration-                           -> IO (PackageDescription, ProgramConfiguration)-configurePkgconfigPackages verbosity pkg_descr conf-  | null allpkgs = return (pkg_descr, conf)-  | otherwise    = do-    (_, _, conf') <- requireProgramVersion-                       (lessVerbose verbosity) pkgConfigProgram-                       (orLaterVersion $ Version [0,9,0] []) conf-    mapM_ requirePkg allpkgs-    lib' <- mapM addPkgConfigBILib (library pkg_descr)-    exes' <- mapM addPkgConfigBIExe (executables pkg_descr)-    tests' <- mapM addPkgConfigBITest (testSuites pkg_descr)-    benches' <- mapM addPkgConfigBIBench (benchmarks pkg_descr)-    let pkg_descr' = pkg_descr { library = lib', executables = exes',-                                 testSuites = tests', benchmarks = benches' }-    return (pkg_descr', conf')--  where-    allpkgs = concatMap pkgconfigDepends (allBuildInfo pkg_descr)-    pkgconfig = rawSystemProgramStdoutConf (lessVerbose verbosity)-                  pkgConfigProgram conf--    requirePkg dep@(Dependency (PackageName pkg) range) = do-      version <- pkgconfig ["--modversion", pkg]-                 `catchIO`   (\_ -> die notFound)-                 `catchExit` (\_ -> die notFound)-      case simpleParse version of-        Nothing -> die "parsing output of pkg-config --modversion failed"-        Just v | not (withinRange v range) -> die (badVersion v)-               | otherwise                 -> info verbosity (depSatisfied v)-      where-        notFound     = "The pkg-config package '" ++ pkg ++ "'"-                    ++ versionRequirement-                    ++ " is required but it could not be found."-        badVersion v = "The pkg-config package '" ++ pkg ++ "'"-                    ++ versionRequirement-                    ++ " is required but the version installed on the"-                    ++ " system is version " ++ display v-        depSatisfied v = "Dependency " ++ display dep-                      ++ ": using version " ++ display v--        versionRequirement-          | isAnyVersion range = ""-          | otherwise          = " version " ++ display range--    -- Adds pkgconfig dependencies to the build info for a component-    addPkgConfigBI compBI setCompBI comp = do-      bi <- pkgconfigBuildInfo (pkgconfigDepends (compBI comp))-      return $ setCompBI comp (compBI comp `mappend` bi)--    -- Adds pkgconfig dependencies to the build info for a library-    addPkgConfigBILib = addPkgConfigBI libBuildInfo $-                          \lib bi -> lib { libBuildInfo = bi }--    -- Adds pkgconfig dependencies to the build info for an executable-    addPkgConfigBIExe = addPkgConfigBI buildInfo $-                          \exe bi -> exe { buildInfo = bi }--    -- Adds pkgconfig dependencies to the build info for a test suite-    addPkgConfigBITest = addPkgConfigBI testBuildInfo $-                          \test bi -> test { testBuildInfo = bi }--    -- Adds pkgconfig dependencies to the build info for a benchmark-    addPkgConfigBIBench = addPkgConfigBI benchmarkBuildInfo $-                          \bench bi -> bench { benchmarkBuildInfo = bi }--    pkgconfigBuildInfo :: [Dependency] -> IO BuildInfo-    pkgconfigBuildInfo []      = return mempty-    pkgconfigBuildInfo pkgdeps = do-      let pkgs = nub [ display pkg | Dependency pkg _ <- pkgdeps ]-      ccflags <- pkgconfig ("--cflags" : pkgs)-      ldflags <- pkgconfig ("--libs"   : pkgs)-      return (ccLdOptionsBuildInfo (words ccflags) (words ldflags))---- | Makes a 'BuildInfo' from C compiler and linker flags.------ This can be used with the output from configuration programs like pkg-config--- and similar package-specific programs like mysql-config, freealut-config etc.--- For example:------ > ccflags <- rawSystemProgramStdoutConf verbosity prog conf ["--cflags"]--- > ldflags <- rawSystemProgramStdoutConf verbosity prog conf ["--libs"]--- > return (ccldOptionsBuildInfo (words ccflags) (words ldflags))----ccLdOptionsBuildInfo :: [String] -> [String] -> BuildInfo-ccLdOptionsBuildInfo cflags ldflags =-  let (includeDirs',  cflags')   = partition ("-I" `isPrefixOf`) cflags-      (extraLibs',    ldflags')  = partition ("-l" `isPrefixOf`) ldflags-      (extraLibDirs', ldflags'') = partition ("-L" `isPrefixOf`) ldflags'-  in mempty {-       PD.includeDirs  = map (drop 2) includeDirs',-       PD.extraLibs    = map (drop 2) extraLibs',-       PD.extraLibDirs = map (drop 2) extraLibDirs',-       PD.ccOptions    = cflags',-       PD.ldOptions    = ldflags''-     }---- -------------------------------------------------------------------------------- Determining the compiler details--configCompilerAuxEx :: ConfigFlags-                    -> IO (Compiler, Platform, ProgramConfiguration)-configCompilerAuxEx cfg = configCompilerEx (flagToMaybe $ configHcFlavor cfg)-                                           (flagToMaybe $ configHcPath cfg)-                                           (flagToMaybe $ configHcPkg cfg)-                                           programsConfig-                                           (fromFlag (configVerbosity cfg))-  where-    programsConfig = mkProgramsConfig cfg defaultProgramConfiguration--configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath-                 -> ProgramConfiguration -> Verbosity-                 -> IO (Compiler, Platform, ProgramConfiguration)-configCompilerEx Nothing _ _ _ _ = die "Unknown compiler"-configCompilerEx (Just hcFlavor) hcPath hcPkg conf verbosity = do-  (comp, maybePlatform, programsConfig) <- case hcFlavor of-    GHC   -> GHC.configure  verbosity hcPath hcPkg conf-    GHCJS -> GHCJS.configure verbosity hcPath hcPkg conf-    JHC   -> JHC.configure  verbosity hcPath hcPkg conf-    LHC   -> do (_, _, ghcConf) <- GHC.configure  verbosity Nothing hcPkg conf-                LHC.configure  verbosity hcPath Nothing ghcConf-    UHC   -> UHC.configure  verbosity hcPath hcPkg conf-    HaskellSuite {} -> HaskellSuite.configure verbosity hcPath hcPkg conf-    _    -> die "Unknown compiler"-  return (comp, fromMaybe buildPlatform maybePlatform, programsConfig)---- Ideally we would like to not have separate configCompiler* and--- configCompiler*Ex sets of functions, but there are many custom setup scripts--- in the wild that are using them, so the versions with old types are kept for--- backwards compatibility. Platform was added to the return triple in 1.18.--{-# DEPRECATED configCompiler-    "'configCompiler' is deprecated. Use 'configCompilerEx' instead." #-}-configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath-               -> ProgramConfiguration -> Verbosity-               -> IO (Compiler, ProgramConfiguration)-configCompiler mFlavor hcPath hcPkg conf verbosity =-  fmap (\(a,_,b) -> (a,b)) $ configCompilerEx mFlavor hcPath hcPkg conf verbosity--{-# DEPRECATED configCompilerAux-    "configCompilerAux is deprecated. Use 'configCompilerAuxEx' instead." #-}-configCompilerAux :: ConfigFlags-                  -> IO (Compiler, ProgramConfiguration)-configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx---- -------------------------------------------------------------------------------- Making the internal component graph---mkComponentsGraph :: PackageDescription-                  -> [PackageId]-                  -> Either [ComponentName]-                            [(Component, [ComponentName])]-mkComponentsGraph pkg_descr internalPkgDeps =-    let graph = [ (c, componentName c, componentDeps c)-                | c <- pkgEnabledComponents pkg_descr ]-     in case checkComponentsCyclic graph of-          Just ccycle -> Left  [ cname | (_,cname,_) <- ccycle ]-          Nothing     -> Right [ (c, cdeps) | (c, _, cdeps) <- graph ]-  where-    -- The dependencies for the given component-    componentDeps component =-         [ CExeName toolname | Dependency (PackageName toolname) _-                               <- buildTools bi-                             , toolname `elem` map exeName-                               (executables pkg_descr) ]--      ++ [ CLibName          | Dependency pkgname _ <- targetBuildDepends bi-                             , pkgname `elem` map packageName internalPkgDeps ]-      where-        bi = componentBuildInfo component--reportComponentCycle :: [ComponentName] -> IO a-reportComponentCycle cnames =-    die $ "Components in the package depend on each other in a cyclic way:\n  "-       ++ intercalate " depends on "-            [ "'" ++ showComponentName cname ++ "'"-            | cname <- cnames ++ [head cnames] ]--mkComponentsLocalBuildInfo :: InstalledPackageIndex-                           -> PackageDescription-                           -> [PackageId] -- internal package deps-                           -> [InstalledPackageInfo] -- external package deps-                           -> [InstalledPackageInfo] -- hole package deps-                           -> Map ModuleName (InstalledPackageInfo, ModuleName)-                           -> PackageKey-                           -> [(Component, [ComponentName])]-                           -> Either [(ModuleReexport, String)] -- errors-                                     [(ComponentName, ComponentLocalBuildInfo,-                                                      [ComponentName])] -- ok-mkComponentsLocalBuildInfo installedPackages pkg_descr-                           internalPkgDeps externalPkgDeps holePkgDeps hole_insts-                           pkg_key graph =-    sequence-      [ do clbi <- componentLocalBuildInfo c-           return (componentName c, clbi, cdeps)-      | (c, cdeps) <- graph ]-  where-    -- The allPkgDeps contains all the package deps for the whole package-    -- but we need to select the subset for this specific component.-    -- we just take the subset for the package names this component-    -- needs. Note, this only works because we cannot yet depend on two-    -- versions of the same package.-    componentLocalBuildInfo component =-      case component of-      CLib lib -> do-        let exports = map (\n -> Installed.ExposedModule n Nothing Nothing)-                          (PD.exposedModules lib)-            esigs = map (\n -> Installed.ExposedModule n Nothing-                                (fmap (\(pkg,m) -> Installed.OriginalModule-                                                      (Installed.installedPackageId pkg) m)-                                      (Map.lookup n hole_insts)))-                        (PD.exposedSignatures lib)-        reexports <- resolveModuleReexports installedPackages-                                            (packageId pkg_descr)-                                            externalPkgDeps lib-        return LibComponentLocalBuildInfo {-          componentPackageDeps = cpds,-          componentLibraries   = [ LibraryName ("HS" ++ packageKeyLibraryName (package pkg_descr) pkg_key) ],-          componentPackageRenaming = cprns,-          componentExposedModules = exports ++ reexports ++ esigs-        }-      CExe _ ->-        return ExeComponentLocalBuildInfo {-          componentPackageDeps = cpds,-          componentPackageRenaming = cprns-        }-      CTest _ ->-        return TestComponentLocalBuildInfo {-          componentPackageDeps = cpds,-          componentPackageRenaming = cprns-        }-      CBench _ ->-        return BenchComponentLocalBuildInfo {-          componentPackageDeps = cpds,-          componentPackageRenaming = cprns-        }-      where-        bi = componentBuildInfo component-        dedup = Map.toList . Map.fromList-        cpds = if newPackageDepsBehaviour pkg_descr-               then dedup $-                    [ (Installed.installedPackageId pkg, packageId pkg)-                    | pkg <- selectSubset bi externalPkgDeps ]-                 ++ [ (inplacePackageId pkgid, pkgid)-                    | pkgid <- selectSubset bi internalPkgDeps ]-                 ++ [ (Installed.installedPackageId pkg, packageId pkg)-                    | pkg <- holePkgDeps ]-               else [ (Installed.installedPackageId pkg, packageId pkg)-                    | pkg <- externalPkgDeps ]-        cprns = if newPackageDepsBehaviour pkg_descr-                then Map.unionWith mappend-                        -- We need hole dependencies passed to GHC, so add them here-                        -- (but note that they're fully thinned out.  If they-                        -- appeared legitimately the monoid instance will-                        -- fill them out.-                        (Map.fromList [(packageName pkg, mempty) | pkg <- holePkgDeps])-                        (targetBuildRenaming bi)-                -- Hack: if we have old package-deps behavior, it's impossible-                -- for non-default renamings to be used, because the Cabal-                -- version is too early.  This is a good, because while all the-                -- deps were bundled up in buildDepends, we didn't do this for-                -- renamings, so it's not even clear how to get the merged-                -- version.  So just assume that all of them are the default..-                else Map.fromList (map (\(_,pid) -> (packageName pid, defaultRenaming)) cpds)--    selectSubset :: Package pkg => BuildInfo -> [pkg] -> [pkg]-    selectSubset bi pkgs =-        [ pkg | pkg <- pkgs, packageName pkg `elem` names bi ]--    names bi = [ name | Dependency name _ <- targetBuildDepends bi ]---- | Given the author-specified re-export declarations from the .cabal file,--- resolve them to the form that we need for the package database.------ An invariant of the package database is that we always link the re-export--- directly to its original defining location (rather than indirectly via a--- chain of re-exporting packages).----resolveModuleReexports :: InstalledPackageIndex-                       -> PackageId-                       -> [InstalledPackageInfo]-                       -> Library-                       -> Either [(ModuleReexport, String)] -- errors-                                 [Installed.ExposedModule] -- ok-resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =-    case partitionEithers (map resolveModuleReexport (PD.reexportedModules lib)) of-      ([],  ok) -> Right ok-      (errs, _) -> Left  errs-  where-    -- A mapping from visible module names to their original defining-    -- module name.  We also record the package name of the package which-    -- *immediately* provided the module (not the original) to handle if the-    -- user explicitly says which build-depends they want to reexport from.-    visibleModules :: Map ModuleName [(PackageName, Installed.ExposedModule)]-    visibleModules =-      Map.fromListWith (++) $-        [ (Installed.exposedName exposedModule, [(exportingPackageName,-                                                  exposedModule)])-          -- The package index here contains all the indirect deps of the-          -- package we're configuring, but we want just the direct deps-        | let directDeps = Set.fromList (map Installed.installedPackageId externalPkgDeps)-        , pkg <- PackageIndex.allPackages installedPackages-        , Installed.installedPackageId pkg `Set.member` directDeps-        , let exportingPackageName = packageName pkg-        , exposedModule <- visibleModuleDetails pkg-        ]-     ++ [ (visibleModuleName, [(exportingPackageName, exposedModule)])-        | visibleModuleName <- PD.exposedModules lib-                            ++ otherModules (libBuildInfo lib)-        , let exportingPackageName = packageName srcpkgid-              definingModuleName   = visibleModuleName-              -- we don't know the InstalledPackageId of this package yet-              -- we will fill it in later, before registration.-              definingPackageId    = InstalledPackageId ""-              originalModule = Installed.OriginalModule definingPackageId-                                                        definingModuleName-              exposedModule  = Installed.ExposedModule visibleModuleName-                                                       (Just originalModule)-                                                             Nothing-        ]--    -- All the modules exported from this package and their defining name and-    -- package (either defined here in this package or re-exported from some-    -- other package).  Return an ExposedModule because we want to hold onto-    -- signature information.-    visibleModuleDetails :: InstalledPackageInfo -> [Installed.ExposedModule]-    visibleModuleDetails pkg = do-        exposedModule <- Installed.exposedModules pkg-        case Installed.exposedReexport exposedModule of-        -- The first case is the modules actually defined in this package.-        -- In this case the reexport will point to this package.-            Nothing -> return exposedModule { Installed.exposedReexport =-                            Just (Installed.OriginalModule (Installed.installedPackageId pkg)-                                                 (Installed.exposedName exposedModule)) }-        -- On the other hand, a visible module might actually be itself-        -- a re-export! In this case, the re-export info for the package-        -- doing the re-export will point us to the original defining-        -- module name and package, so we can reuse the entry.-            Just _ -> return exposedModule--    resolveModuleReexport reexport@ModuleReexport {-         moduleReexportOriginalPackage = moriginalPackageName,-         moduleReexportOriginalName    = originalName,-         moduleReexportName            = newName-      } =--      let filterForSpecificPackage =-            case moriginalPackageName of-              Nothing                  -> id-              Just originalPackageName ->-                filter (\(pkgname, _) -> pkgname == originalPackageName)--          matches = filterForSpecificPackage-                      (Map.findWithDefault [] originalName visibleModules)-      in-      case (matches, moriginalPackageName) of-        ((_, exposedModule):rest, _)-          -- TODO: Refine this check for signatures-          | all (\(_, exposedModule') -> Installed.exposedReexport exposedModule-                                      == Installed.exposedReexport exposedModule') rest-           -> Right exposedModule { Installed.exposedName = newName }--        ([], Just originalPackageName)-           -> Left $ (,) reexport-                   $ "The package " ++ display originalPackageName-                  ++ " does not export a module " ++ display originalName--        ([], Nothing)-           -> Left $ (,) reexport-                   $ "The module " ++ display originalName-                  ++ " is not exported by any suitable package (this package "-                  ++ "itself nor any of its 'build-depends' dependencies)."--        (ms, _)-           -> Left $ (,) reexport-                   $ "The module " ++ display originalName ++ " is exported "-                  ++ "by more than one package ("-                  ++ intercalate ", " [ display pkgname | (pkgname,_) <- ms ]-                  ++ ") and so the re-export is ambiguous. The ambiguity can "-                  ++ "be resolved by qualifying by the package name. The "-                  ++ "syntax is 'packagename:moduleName [as newname]'."--        -- Note: if in future Cabal allows directly depending on multiple-        -- instances of the same package (e.g. backpack) then an additional-        -- ambiguity case is possible here: (_, Just originalPackageName)-        -- with the module being ambigious despite being qualified by a+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Simple.Configure+-- Copyright   :  Isaac Jones 2003-2005+-- License     :  BSD3+--+-- Maintainer  :  cabal-devel@haskell.org+-- Portability :  portable+--+-- This deals with the /configure/ phase. It provides the 'configure' action+-- which is given the package description and configure flags. It then tries+-- to: configure the compiler; resolves any conditionals in the package+-- description; resolve the package dependencies; check if all the extensions+-- used by this package are supported by the compiler; check that all the build+-- tools are available (including version checks if appropriate); checks for+-- any required @pkg-config@ packages (updating the 'BuildInfo' with the+-- results)+--+-- Then based on all this it saves the info in the 'LocalBuildInfo' and writes+-- it out to the @dist\/setup-config@ file. It also displays various details to+-- the user, the amount of information displayed depending on the verbosity+-- level.++module Distribution.Simple.Configure (configure,+                                      writePersistBuildConfig,+                                      getConfigStateFile,+                                      getPersistBuildConfig,+                                      checkPersistBuildConfigOutdated,+                                      tryGetPersistBuildConfig,+                                      maybeGetPersistBuildConfig,+                                      findDistPref, findDistPrefOrDefault,+                                      computeComponentId,+                                      computeCompatPackageKey,+                                      localBuildInfoFile,+                                      getInstalledPackages,+                                      getInstalledPackagesMonitorFiles,+                                      getPackageDBContents,+                                      configCompiler, configCompilerAux,+                                      configCompilerEx, configCompilerAuxEx,+                                      ccLdOptionsBuildInfo,+                                      checkForeignDeps,+                                      interpretPackageDbFlags,+                                      ConfigStateFileError(..),+                                      tryGetConfigStateFile,+                                      platformDefines,+                                      relaxPackageDeps,+                                     )+    where++import Distribution.Compiler+import Distribution.Utils.NubList+import Distribution.Simple.Compiler hiding (Flag)+import Distribution.Simple.PreProcess+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.PackageDescription.Configuration+import Distribution.PackageDescription.Check hiding (doesFileExist)+import Distribution.Simple.Program+import Distribution.Simple.Setup as Setup+import qualified Distribution.Simple.InstallDirs as InstallDirs+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.BuildPaths+import Distribution.Simple.Utils+import Distribution.System+import Distribution.Version+import Distribution.Verbosity++import qualified Distribution.Simple.GHC   as GHC+import qualified Distribution.Simple.GHCJS as GHCJS+import qualified Distribution.Simple.JHC   as JHC+import qualified Distribution.Simple.LHC   as LHC+import qualified Distribution.Simple.UHC   as UHC+import qualified Distribution.Simple.HaskellSuite as HaskellSuite++-- Prefer the more generic Data.Traversable.mapM to Prelude.mapM+import Prelude hiding ( mapM )+import Control.Exception+    ( Exception, evaluate, throw, throwIO, try )+import Control.Exception ( ErrorCall )+import Control.Monad+    ( liftM, when, unless, foldM, filterM, mplus )+import Distribution.Compat.Binary ( decodeOrFailIO, encode )+import GHC.Fingerprint ( Fingerprint(..), fingerprintString )+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString            as BS+import qualified Data.ByteString.Lazy.Char8 as BLC8+import Data.List+    ( (\\), nub, partition, isPrefixOf, inits, stripPrefix )+import Data.Maybe+    ( isNothing, catMaybes, fromMaybe, mapMaybe, isJust )+import Data.Either+    ( partitionEithers )+import qualified Data.Set as Set+import Data.Monoid as Mon ( Monoid(..) )+import qualified Data.Map as Map+import Data.Map (Map)+import Data.Traversable+    ( mapM )+import Data.Typeable+import Data.Char ( chr, isAlphaNum )+import Numeric ( showIntAtBase )+import System.Directory+    ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )+import System.FilePath+    ( (</>), isAbsolute )+import qualified System.Info+    ( compilerName, compilerVersion )+import System.IO+    ( hPutStrLn, hClose )+import Distribution.Text+    ( Text(disp), defaultStyle, display, simpleParse )+import Text.PrettyPrint+    ( Doc, (<>), (<+>), ($+$), char, comma, empty, hsep, nest+    , punctuate, quotes, render, renderStyle, sep, text )+import Distribution.Compat.Environment ( lookupEnv )+import Distribution.Compat.Exception ( catchExit, catchIO )++-- | The errors that can be thrown when reading the @setup-config@ file.+data ConfigStateFileError+    = ConfigStateFileNoHeader -- ^ No header found.+    | ConfigStateFileBadHeader -- ^ Incorrect header.+    | ConfigStateFileNoParse -- ^ Cannot parse file contents.+    | ConfigStateFileMissing -- ^ No file!+    | ConfigStateFileBadVersion PackageIdentifier PackageIdentifier+      (Either ConfigStateFileError LocalBuildInfo) -- ^ Mismatched version.+  deriving (Typeable)++-- | Format a 'ConfigStateFileError' as a user-facing error message.+dispConfigStateFileError :: ConfigStateFileError -> Doc+dispConfigStateFileError ConfigStateFileNoHeader =+    text "Saved package config file header is missing."+    <+> text "Re-run the 'configure' command."+dispConfigStateFileError ConfigStateFileBadHeader =+    text "Saved package config file header is corrupt."+    <+> text "Re-run the 'configure' command."+dispConfigStateFileError ConfigStateFileNoParse =+    text "Saved package config file is corrupt."+    <+> text "Re-run the 'configure' command."+dispConfigStateFileError ConfigStateFileMissing =+    text "Run the 'configure' command first."+dispConfigStateFileError (ConfigStateFileBadVersion oldCabal oldCompiler _) =+    text "Saved package config file is outdated:"+    $+$ badCabal $+$ badCompiler+    $+$ text "Re-run the 'configure' command."+    where+      badCabal =+          text "• the Cabal version changed from"+          <+> disp oldCabal <+> "to" <+> disp currentCabalId+      badCompiler+        | oldCompiler == currentCompilerId = empty+        | otherwise =+            text "• the compiler changed from"+            <+> disp oldCompiler <+> "to" <+> disp currentCompilerId++instance Show ConfigStateFileError where+    show = renderStyle defaultStyle . dispConfigStateFileError++instance Exception ConfigStateFileError++-- | Read the 'localBuildInfoFile'.  Throw an exception if the file is+-- missing, if the file cannot be read, or if the file was created by an older+-- version of Cabal.+getConfigStateFile :: FilePath -- ^ The file path of the @setup-config@ file.+                   -> IO LocalBuildInfo+getConfigStateFile filename = do+    exists <- doesFileExist filename+    unless exists $ throwIO ConfigStateFileMissing+    -- Read the config file into a strict ByteString to avoid problems with+    -- lazy I/O, then convert to lazy because the binary package needs that.+    contents <- BS.readFile filename+    let (header, body) = BLC8.span (/='\n') (BLC8.fromChunks [contents])++    headerParseResult <- try $ evaluate $ parseHeader header+    let (cabalId, compId) =+            case headerParseResult of+              Left (_ :: ErrorCall) -> throw ConfigStateFileBadHeader+              Right x -> x++    let getStoredValue = do+          result <- decodeOrFailIO (BLC8.tail body)+          case result of+            Left _ -> throw ConfigStateFileNoParse+            Right x -> return x+        deferErrorIfBadVersion act+          | cabalId /= currentCabalId = do+              eResult <- try act+              throw $ ConfigStateFileBadVersion cabalId compId eResult+          | otherwise = act+    deferErrorIfBadVersion getStoredValue++-- | Read the 'localBuildInfoFile', returning either an error or the local build+-- info.+tryGetConfigStateFile :: FilePath -- ^ The file path of the @setup-config@ file.+                      -> IO (Either ConfigStateFileError LocalBuildInfo)+tryGetConfigStateFile = try . getConfigStateFile++-- | Try to read the 'localBuildInfoFile'.+tryGetPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.+                         -> IO (Either ConfigStateFileError LocalBuildInfo)+tryGetPersistBuildConfig = try . getPersistBuildConfig++-- | Read the 'localBuildInfoFile'. Throw an exception if the file is+-- missing, if the file cannot be read, or if the file was created by an older+-- version of Cabal.+getPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.+                      -> IO LocalBuildInfo+getPersistBuildConfig = getConfigStateFile . localBuildInfoFile++-- | Try to read the 'localBuildInfoFile'.+maybeGetPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.+                           -> IO (Maybe LocalBuildInfo)+maybeGetPersistBuildConfig =+    liftM (either (const Nothing) Just) . tryGetPersistBuildConfig++-- | After running configure, output the 'LocalBuildInfo' to the+-- 'localBuildInfoFile'.+writePersistBuildConfig :: FilePath -- ^ The @dist@ directory path.+                        -> LocalBuildInfo -- ^ The 'LocalBuildInfo' to write.+                        -> IO ()+writePersistBuildConfig distPref lbi = do+    createDirectoryIfMissing False distPref+    writeFileAtomic (localBuildInfoFile distPref) $+      BLC8.unlines [showHeader pkgId, encode lbi]+  where+    pkgId = packageId $ localPkgDescr lbi++-- | Identifier of the current Cabal package.+currentCabalId :: PackageIdentifier+currentCabalId = PackageIdentifier (PackageName "Cabal") cabalVersion++-- | Identifier of the current compiler package.+currentCompilerId :: PackageIdentifier+currentCompilerId = PackageIdentifier (PackageName System.Info.compilerName)+                                      System.Info.compilerVersion++-- | Parse the @setup-config@ file header, returning the package identifiers+-- for Cabal and the compiler.+parseHeader :: ByteString -- ^ The file contents.+            -> (PackageIdentifier, PackageIdentifier)+parseHeader header = case BLC8.words header of+  ["Saved", "package", "config", "for", pkgId, "written", "by", cabalId,+   "using", compId] ->+      fromMaybe (throw ConfigStateFileBadHeader) $ do+          _ <- simpleParse (BLC8.unpack pkgId) :: Maybe PackageIdentifier+          cabalId' <- simpleParse (BLC8.unpack cabalId)+          compId' <- simpleParse (BLC8.unpack compId)+          return (cabalId', compId')+  _ -> throw ConfigStateFileNoHeader++-- | Generate the @setup-config@ file header.+showHeader :: PackageIdentifier -- ^ The processed package.+            -> ByteString+showHeader pkgId = BLC8.unwords+    [ "Saved", "package", "config", "for"+    , BLC8.pack $ display pkgId+    , "written", "by"+    , BLC8.pack $ display currentCabalId+    , "using"+    , BLC8.pack $ display currentCompilerId+    ]++-- | Check that localBuildInfoFile is up-to-date with respect to the+-- .cabal file.+checkPersistBuildConfigOutdated :: FilePath -> FilePath -> IO Bool+checkPersistBuildConfigOutdated distPref pkg_descr_file = do+  pkg_descr_file `moreRecentFile` (localBuildInfoFile distPref)++-- | Get the path of @dist\/setup-config@.+localBuildInfoFile :: FilePath -- ^ The @dist@ directory path.+                    -> FilePath+localBuildInfoFile distPref = distPref </> "setup-config"++-- -----------------------------------------------------------------------------+-- * Configuration+-- -----------------------------------------------------------------------------++-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken+-- from (in order of highest to lowest preference) the override prefix, the+-- \"CABAL_BUILDDIR\" environment variable, or the default prefix.+findDistPref :: FilePath  -- ^ default \"dist\" prefix+             -> Setup.Flag FilePath  -- ^ override \"dist\" prefix+             -> IO FilePath+findDistPref defDistPref overrideDistPref = do+    envDistPref <- liftM parseEnvDistPref (lookupEnv "CABAL_BUILDDIR")+    return $ fromFlagOrDefault defDistPref (mappend envDistPref overrideDistPref)+  where+    parseEnvDistPref env =+      case env of+        Just distPref | not (null distPref) -> toFlag distPref+        _ -> NoFlag++-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken+-- from (in order of highest to lowest preference) the override prefix, the+-- \"CABAL_BUILDDIR\" environment variable, or 'defaultDistPref' is used. Call+-- this function to resolve a @*DistPref@ flag whenever it is not known to be+-- set. (The @*DistPref@ flags are always set to a definite value before+-- invoking 'UserHooks'.)+findDistPrefOrDefault :: Setup.Flag FilePath  -- ^ override \"dist\" prefix+                      -> IO FilePath+findDistPrefOrDefault = findDistPref defaultDistPref++-- |Perform the \"@.\/setup configure@\" action.+-- Returns the @.setup-config@ file.+configure :: (GenericPackageDescription, HookedBuildInfo)+          -> ConfigFlags -> IO LocalBuildInfo+configure (pkg_descr0', pbi) cfg = do+    let pkg_descr0 =+          -- Ignore '--allow-newer' when we're given '--exact-configuration'.+          if fromFlagOrDefault False (configExactConfiguration cfg)+          then pkg_descr0'+          else relaxPackageDeps+               (fromMaybe AllowNewerNone $ configAllowNewer cfg)+               pkg_descr0'++    setupMessage verbosity "Configuring" (packageId pkg_descr0)++    checkDeprecatedFlags verbosity cfg+    checkExactConfiguration pkg_descr0 cfg++    -- Where to build the package+    let buildDir :: FilePath -- e.g. dist/build+        -- fromFlag OK due to Distribution.Simple calling+        -- findDistPrefOrDefault to fill it in+        buildDir = fromFlag (configDistPref cfg) </> "build"+    createDirectoryIfMissingVerbose (lessVerbose verbosity) True buildDir++    -- What package database(s) to use+    let packageDbs+         = interpretPackageDbFlags+            (fromFlag (configUserInstall cfg))+            (configPackageDBs cfg)++    -- comp:            the compiler we're building with+    -- compPlatform:    the platform we're building for+    -- programsConfig:  location and args of all programs we're+    --                  building with+    (comp, compPlatform, programsConfig)+        <- configCompilerEx+            (flagToMaybe (configHcFlavor cfg))+            (flagToMaybe (configHcPath cfg))+            (flagToMaybe (configHcPkg cfg))+            (mkProgramsConfig cfg (configPrograms cfg))+            (lessVerbose verbosity)++    -- The InstalledPackageIndex of all installed packages+    installedPackageSet <- getInstalledPackages (lessVerbose verbosity) comp+                                  packageDbs programsConfig++    -- The InstalledPackageIndex of all (possible) internal packages+    let internalPackageSet = getInternalPackages pkg_descr0++    -- allConstraints:  The set of all 'Dependency's we have.  Used ONLY+    --                  to 'configureFinalizedPackage'.+    -- requiredDepsMap: A map from 'PackageName' to the specifically+    --                  required 'InstalledPackageInfo', due to --dependency+    --+    -- NB: These constraints are to be applied to ALL components of+    -- a package.  Thus, it's not an error if allConstraints contains+    -- more constraints than is necessary for a component (another+    -- component might need it.)+    --+    -- NB: The fact that we bundle all the constraints together means+    -- that is not possible to configure a test-suite to use one+    -- version of a dependency, and the executable to use another.+    (allConstraints, requiredDepsMap) <- either die return $+      combinedConstraints (configConstraints cfg)+                          (configDependencies cfg)+                          installedPackageSet++    -- pkg_descr:   The resolved package description, that does not contain any+    --              conditionals, because we have have an assignment for+    --              every flag, either picking them ourselves using a+    --              simple naive algorithm, or having them be passed to+    --              us by 'configConfigurationsFlags')+    -- flags:       The 'FlagAssignment' that the conditionals were+    --              resolved with.+    --+    -- NB: Why doesn't finalizing a package also tell us what the+    -- dependencies are (e.g. when we run the naive algorithm,+    -- we are checking if dependencies are satisfiable)?  The+    -- primary reason is that we may NOT have done any solving:+    -- if the flags are all chosen for us, this step is a simple+    -- matter of flattening according to that assignment.  It's+    -- cleaner to then configure the dependencies afterwards.+    (pkg_descr, flags)+        <- configureFinalizedPackage verbosity cfg+                allConstraints+                (dependencySatisfiable+                    (fromFlagOrDefault False (configExactConfiguration cfg))+                    installedPackageSet+                    internalPackageSet+                    requiredDepsMap)+                comp+                compPlatform+                pkg_descr0++    checkCompilerProblems comp pkg_descr+    checkPackageProblems verbosity pkg_descr0+        (updatePackageDescription pbi pkg_descr)++    -- The list of 'InstalledPackageInfo' recording the selected+    -- dependencies...+    -- internalPkgDeps: ...on internal packages (these are fake!)+    -- externalPkgDeps: ...on external packages+    --+    -- Invariant: For any package name, there is at most one package+    -- in externalPackageDeps which has that name.+    --+    -- NB: The dependency selection is global over ALL components+    -- in the package (similar to how allConstraints and+    -- requiredDepsMap are global over all components).  In particular,+    -- if *any* component (post-flag resolution) has an unsatisfiable+    -- dependency, we will fail.  This can sometimes be undesirable+    -- for users, see #1786 (benchmark conflicts with executable),+    (internalPkgDeps, externalPkgDeps)+        <- configureDependencies+                verbosity+                internalPackageSet+                installedPackageSet+                requiredDepsMap+                pkg_descr++    let installDeps = Map.elems -- deduplicate+                    . Map.fromList+                    . map (\v -> (Installed.installedUnitId v, v))+                    $ externalPkgDeps++    packageDependsIndex <-+      case PackageIndex.dependencyClosure installedPackageSet+              (map Installed.installedUnitId installDeps) of+        Left packageDependsIndex -> return packageDependsIndex+        Right broken ->+          die $ "The following installed packages are broken because other"+             ++ " packages they depend on are missing. These broken "+             ++ "packages must be rebuilt before they can be used.\n"+             ++ unlines [ "package "+                       ++ display (packageId pkg)+                       ++ " is broken due to missing package "+                       ++ intercalate ", " (map display deps)+                        | (pkg, deps) <- broken ]++    let pseudoTopPkg = emptyInstalledPackageInfo {+            Installed.installedUnitId =+               mkLegacyUnitId (packageId pkg_descr),+            Installed.sourcePackageId = packageId pkg_descr,+            Installed.depends =+              map Installed.installedUnitId installDeps+          }+    case PackageIndex.dependencyInconsistencies+       . PackageIndex.insert pseudoTopPkg+       $ packageDependsIndex of+      [] -> return ()+      inconsistencies ->+        warn verbosity $+             "This package indirectly depends on multiple versions of the same "+          ++ "package. This is highly likely to cause a compile failure.\n"+          ++ unlines [ "package " ++ display pkg ++ " requires "+                    ++ display (PackageIdentifier name ver)+                     | (name, uses) <- inconsistencies+                     , (pkg, ver) <- uses ]++    -- installation directories+    defaultDirs <- defaultInstallDirs (compilerFlavor comp)+                   (fromFlag (configUserInstall cfg)) (hasLibs pkg_descr)+    let installDirs = combineInstallDirs fromFlagOrDefault+                        defaultDirs (configInstallDirs cfg)++    -- check languages and extensions+    let langlist = nub $ catMaybes $ map defaultLanguage+                   (allBuildInfo pkg_descr)+    let langs = unsupportedLanguages comp langlist+    when (not (null langs)) $+      die $ "The package " ++ display (packageId pkg_descr0)+         ++ " requires the following languages which are not "+         ++ "supported by " ++ display (compilerId comp) ++ ": "+         ++ intercalate ", " (map display langs)+    let extlist = nub $ concatMap allExtensions (allBuildInfo pkg_descr)+    let exts = unsupportedExtensions comp extlist+    when (not (null exts)) $+      die $ "The package " ++ display (packageId pkg_descr0)+         ++ " requires the following language extensions which are not "+         ++ "supported by " ++ display (compilerId comp) ++ ": "+         ++ intercalate ", " (map display exts)++    -- configured known/required programs & external build tools+    -- exclude build-tool deps on "internal" exes in the same package+    let requiredBuildTools =+          [ buildTool+          | let exeNames = map exeName (executables pkg_descr)+          , bi <- allBuildInfo pkg_descr+          , buildTool@(Dependency (PackageName toolName) reqVer)+            <- buildTools bi+          , let isInternal =+                    toolName `elem` exeNames+                    -- we assume all internal build-tools are+                    -- versioned with the package:+                 && packageVersion pkg_descr `withinRange` reqVer+          , not isInternal ]++    programsConfig' <-+          configureAllKnownPrograms (lessVerbose verbosity) programsConfig+      >>= configureRequiredPrograms verbosity requiredBuildTools++    (pkg_descr', programsConfig'') <-+      configurePkgconfigPackages verbosity pkg_descr programsConfig'++    -- internal component graph+    buildComponents <-+      case mkComponentsGraph pkg_descr internalPkgDeps of+        Left  componentCycle -> reportComponentCycle componentCycle+        Right comps          ->+          mkComponentsLocalBuildInfo cfg comp packageDependsIndex pkg_descr+                                     internalPkgDeps externalPkgDeps+                                     comps (configConfigurationsFlags cfg)++    split_objs <-+       if not (fromFlag $ configSplitObjs cfg)+            then return False+            else case compilerFlavor comp of+                        GHC | compilerVersion comp >= Version [6,5] []+                          -> return True+                        GHCJS+                          -> return True+                        _ -> do warn verbosity+                                     ("this compiler does not support " +++                                      "--enable-split-objs; ignoring")+                                return False++    let ghciLibByDefault =+          case compilerId comp of+            CompilerId GHC _ ->+              -- If ghc is non-dynamic, then ghci needs object files,+              -- so we build one by default.+              --+              -- Technically, archive files should be sufficient for ghci,+              -- but because of GHC bug #8942, it has never been safe to+              -- rely on them. By the time that bug was fixed, ghci had+              -- been changed to read shared libraries instead of archive+              -- files (see next code block).+              not (GHC.isDynamic comp)+            CompilerId GHCJS _ ->+              not (GHCJS.isDynamic comp)+            _ -> False++    let sharedLibsByDefault+          | fromFlag (configDynExe cfg) =+              -- build a shared library if dynamically-linked+              -- executables are requested+              True+          | otherwise = case compilerId comp of+            CompilerId GHC _ ->+              -- if ghc is dynamic, then ghci needs a shared+              -- library, so we build one by default.+              GHC.isDynamic comp+            CompilerId GHCJS _ ->+              GHCJS.isDynamic comp+            _ -> False+        withSharedLib_ =+            -- build shared libraries if required by GHC or by the+            -- executable linking mode, but allow the user to force+            -- building only static library archives with+            -- --disable-shared.+            fromFlagOrDefault sharedLibsByDefault $ configSharedLib cfg+        withDynExe_ = fromFlag $ configDynExe cfg+    when (withDynExe_ && not withSharedLib_) $ warn verbosity $+           "Executables will use dynamic linking, but a shared library "+        ++ "is not being built. Linking will fail if any executables "+        ++ "depend on the library."++    -- The --profiling flag sets the default for both libs and exes,+    -- but can be overidden by --library-profiling, or the old deprecated+    -- --executable-profiling flag.+    let profEnabledLibOnly = configProfLib cfg+        profEnabledBoth    = fromFlagOrDefault False (configProf cfg)+        profEnabledLib = fromFlagOrDefault profEnabledBoth profEnabledLibOnly+        profEnabledExe = fromFlagOrDefault profEnabledBoth (configProfExe cfg)++    -- The --profiling-detail and --library-profiling-detail flags behave+    -- similarly+    profDetailLibOnly <- checkProfDetail (configProfLibDetail cfg)+    profDetailBoth    <- liftM (fromFlagOrDefault ProfDetailDefault)+                               (checkProfDetail (configProfDetail cfg))+    let profDetailLib = fromFlagOrDefault profDetailBoth profDetailLibOnly+        profDetailExe = profDetailBoth++    when (profEnabledExe && not profEnabledLib) $+      warn verbosity $+           "Executables will be built with profiling, but library "+        ++ "profiling is disabled. Linking will fail if any executables "+        ++ "depend on the library."++    let configCoverage_ =+          mappend (configCoverage cfg) (configLibCoverage cfg)++        cfg' = cfg { configCoverage = configCoverage_ }++    reloc <-+       if not (fromFlag $ configRelocatable cfg)+            then return False+            else return True++    let lbi = LocalBuildInfo {+                configFlags         = cfg',+                flagAssignment      = flags,+                extraConfigArgs     = [],  -- Currently configure does not+                                           -- take extra args, but if it+                                           -- did they would go here.+                installDirTemplates = installDirs,+                compiler            = comp,+                hostPlatform        = compPlatform,+                buildDir            = buildDir,+                componentsConfigs   = buildComponents,+                installedPkgs       = packageDependsIndex,+                pkgDescrFile        = Nothing,+                localPkgDescr       = pkg_descr',+                withPrograms        = programsConfig'',+                withVanillaLib      = fromFlag $ configVanillaLib cfg,+                withProfLib         = profEnabledLib,+                withSharedLib       = withSharedLib_,+                withDynExe          = withDynExe_,+                withProfExe         = profEnabledExe,+                withProfLibDetail   = profDetailLib,+                withProfExeDetail   = profDetailExe,+                withOptimization    = fromFlag $ configOptimization cfg,+                withDebugInfo       = fromFlag $ configDebugInfo cfg,+                withGHCiLib         = fromFlagOrDefault ghciLibByDefault $+                                      configGHCiLib cfg,+                splitObjs           = split_objs,+                stripExes           = fromFlag $ configStripExes cfg,+                stripLibs           = fromFlag $ configStripLibs cfg,+                withPackageDB       = packageDbs,+                progPrefix          = fromFlag $ configProgPrefix cfg,+                progSuffix          = fromFlag $ configProgSuffix cfg,+                relocatable         = reloc+              }++    when reloc (checkRelocatable verbosity pkg_descr lbi)++    let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest+        relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi++    unless (isAbsolute (prefix dirs)) $ die $+        "expected an absolute directory name for --prefix: " ++ prefix dirs++    info verbosity $ "Using " ++ display currentCabalId+                  ++ " compiled by " ++ display currentCompilerId+    info verbosity $ "Using compiler: " ++ showCompilerId comp+    info verbosity $ "Using install prefix: " ++ prefix dirs++    let dirinfo name dir isPrefixRelative =+          info verbosity $ name ++ " installed in: " ++ dir ++ relNote+          where relNote = case buildOS of+                  Windows | not (hasLibs pkg_descr)+                         && isNothing isPrefixRelative+                         -> "  (fixed location)"+                  _      -> ""++    dirinfo "Binaries"         (bindir dirs)     (bindir relative)+    dirinfo "Libraries"        (libdir dirs)     (libdir relative)+    dirinfo "Private binaries" (libexecdir dirs) (libexecdir relative)+    dirinfo "Data files"       (datadir dirs)    (datadir relative)+    dirinfo "Documentation"    (docdir dirs)     (docdir relative)+    dirinfo "Configuration files" (sysconfdir dirs) (sysconfdir relative)++    sequence_ [ reportProgram verbosity prog configuredProg+              | (prog, configuredProg) <- knownPrograms programsConfig'' ]++    return lbi++    where+      verbosity = fromFlag (configVerbosity cfg)++      checkProfDetail (Flag (ProfDetailOther other)) = do+        warn verbosity $+             "Unknown profiling detail level '" ++ other+          ++ "', using default.\n"+          ++ "The profiling detail levels are: " ++ intercalate ", "+             [ name | (name, _, _) <- knownProfDetailLevels ]+        return (Flag ProfDetailDefault)+      checkProfDetail other = return other++mkProgramsConfig :: ConfigFlags -> ProgramConfiguration -> ProgramConfiguration+mkProgramsConfig cfg initialProgramsConfig = programsConfig+  where+    programsConfig = userSpecifyArgss (configProgramArgs cfg)+                   . userSpecifyPaths (configProgramPaths cfg)+                   . setProgramSearchPath searchpath+                   $ initialProgramsConfig+    searchpath     = getProgramSearchPath (initialProgramsConfig)+                  ++ map ProgramSearchPathDir+                     (fromNubList $ configProgramPathExtra cfg)++-- -----------------------------------------------------------------------------+-- Helper functions for configure++-- | Check if the user used any deprecated flags.+checkDeprecatedFlags :: Verbosity -> ConfigFlags -> IO ()+checkDeprecatedFlags verbosity cfg = do+    unless (configProfExe cfg == NoFlag) $ do+      let enable | fromFlag (configProfExe cfg) = "enable"+                 | otherwise = "disable"+      warn verbosity+        ("The flag --" ++ enable ++ "-executable-profiling is deprecated. "+         ++ "Please use --" ++ enable ++ "-profiling instead.")++    unless (configLibCoverage cfg == NoFlag) $ do+      let enable | fromFlag (configLibCoverage cfg) = "enable"+                 | otherwise = "disable"+      warn verbosity+        ("The flag --" ++ enable ++ "-library-coverage is deprecated. "+         ++ "Please use --" ++ enable ++ "-coverage instead.")++-- | Sanity check: if '--exact-configuration' was given, ensure that the+-- complete flag assignment was specified on the command line.+checkExactConfiguration :: GenericPackageDescription -> ConfigFlags -> IO ()+checkExactConfiguration pkg_descr0 cfg = do+    when (fromFlagOrDefault False (configExactConfiguration cfg)) $ do+      let cmdlineFlags = map fst (configConfigurationsFlags cfg)+          allFlags     = map flagName . genPackageFlags $ pkg_descr0+          diffFlags    = allFlags \\ cmdlineFlags+      when (not . null $ diffFlags) $+        die $ "'--exact-configuration' was given, "+        ++ "but the following flags were not specified: "+        ++ intercalate ", " (map show diffFlags)++-- | Create a PackageIndex that makes *any libraries that might be*+-- defined internally to this package look like installed packages, in+-- case an executable should refer to any of them as dependencies.+--+-- It must be *any libraries that might be* defined rather than the+-- actual definitions, because these depend on conditionals in the .cabal+-- file, and we haven't resolved them yet.  finalizePackageDescription+-- does the resolution of conditionals, and it takes internalPackageSet+-- as part of its input.+--+-- Currently a package can define no more than one library (which has+-- the same name as the package) but we could extend this later.+-- If we later allowed private internal libraries, then here we would+-- need to pre-scan the conditional data to make a list of all private+-- libraries that could possibly be defined by the .cabal file.+getInternalPackages :: GenericPackageDescription+                    -> InstalledPackageIndex+getInternalPackages pkg_descr0 =+    let pid :: PackageIdentifier -- e.g. foo-0.1+        pid = packageId pkg_descr0+        internalPackage = emptyInstalledPackageInfo {+            --TODO: should use a per-compiler method to map the source+            --      package ID into an installed package id we can use+            --      for the internal package set. The use of+            --      mkLegacyUnitId here is a hack.+            Installed.installedUnitId = mkLegacyUnitId pid,+            Installed.sourcePackageId = pid+          }+    in PackageIndex.fromList [internalPackage]+++-- | Returns true if a dependency is satisfiable.  This is to be passed+-- to finalizePackageDescription.+dependencySatisfiable+    :: Bool+    -> InstalledPackageIndex -- ^ installed set+    -> InstalledPackageIndex -- ^ internal set+    -> Map PackageName InstalledPackageInfo -- ^ required dependencies+    -> (Dependency -> Bool)+dependencySatisfiable+    exact_config installedPackageSet internalPackageSet requiredDepsMap+    d@(Dependency depName _)+      | exact_config =+        -- When we're given '--exact-configuration', we assume that all+        -- dependencies and flags are exactly specified on the command+        -- line. Thus we only consult the 'requiredDepsMap'. Note that+        -- we're not doing the version range check, so if there's some+        -- dependency that wasn't specified on the command line,+        -- 'finalizePackageDescription' will fail.+        --+        -- TODO: mention '--exact-configuration' in the error message+        -- when this fails?+        --+        -- (However, note that internal deps don't have to be+        -- specified!)+        (depName `Map.member` requiredDepsMap) || isInternalDep++      | otherwise =+        -- Normal operation: just look up dependency in the combined+        -- package index.+        not . null . PackageIndex.lookupDependency pkgs $ d+      where+        pkgs = PackageIndex.merge internalPackageSet installedPackageSet+        isInternalDep = not . null+                      $ PackageIndex.lookupDependency internalPackageSet d++-- | Relax the dependencies of this package if needed.+relaxPackageDeps :: AllowNewer -> GenericPackageDescription+                 -> GenericPackageDescription+relaxPackageDeps AllowNewerNone gpd = gpd+relaxPackageDeps AllowNewerAll  gpd = transformAllBuildDepends relaxAll gpd+  where+    relaxAll = \(Dependency pkgName verRange) ->+      Dependency pkgName (removeUpperBound verRange)+relaxPackageDeps (AllowNewerSome allowNewerDeps') gpd =+  transformAllBuildDepends relaxSome gpd+  where+    thisPkgName    = packageName gpd+    allowNewerDeps = mapMaybe f allowNewerDeps'++    f (Setup.AllowNewerDep p) = Just p+    f (Setup.AllowNewerDepScoped scope p) | scope == thisPkgName = Just p+                                          | otherwise            = Nothing++    relaxSome = \d@(Dependency depName verRange) ->+      if depName `elem` allowNewerDeps+      then Dependency depName (removeUpperBound verRange)+      else d++-- | Finalize a generic package description.  The workhorse is+-- 'finalizePackageDescription' but there's a bit of other nattering+-- about necessary.+--+-- TODO: what exactly is the business with @flaggedTests@ and+-- @flaggedBenchmarks@?+configureFinalizedPackage+    :: Verbosity+    -> ConfigFlags+    -> [Dependency]+    -> (Dependency -> Bool) -- ^ tests if a dependency is satisfiable.+                            -- Might say it's satisfiable even when not.+    -> Compiler+    -> Platform+    -> GenericPackageDescription+    -> IO (PackageDescription, FlagAssignment)+configureFinalizedPackage verbosity cfg+  allConstraints satisfies comp compPlatform pkg_descr0 = do+    let enableTest t = t { testEnabled = fromFlag (configTests cfg) }+        flaggedTests = map (\(n, t) -> (n, mapTreeData enableTest t))+                           (condTestSuites pkg_descr0)+        enableBenchmark bm = bm { benchmarkEnabled =+                                     fromFlag (configBenchmarks cfg) }+        flaggedBenchmarks = map (\(n, bm) ->+                                  (n, mapTreeData enableBenchmark bm))+                           (condBenchmarks pkg_descr0)+        pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests+                                  , condBenchmarks = flaggedBenchmarks }++    (pkg_descr0', flags) <-+            case finalizePackageDescription+                   (configConfigurationsFlags cfg)+                   satisfies+                   compPlatform+                   (compilerInfo comp)+                   allConstraints+                   pkg_descr0''+            of Right r -> return r+               Left missing ->+                   die $ "Encountered missing dependencies:\n"+                     ++ (render . nest 4 . sep . punctuate comma+                                . map (disp . simplifyDependency)+                                $ missing)++    -- add extra include/lib dirs as specified in cfg+    -- we do it here so that those get checked too+    let pkg_descr = addExtraIncludeLibDirs pkg_descr0'++    when (not (null flags)) $+      info verbosity $ "Flags chosen: "+                    ++ intercalate ", " [ name ++ "=" ++ display value+                                        | (FlagName name, value) <- flags ]++    return (pkg_descr, flags)+  where+    addExtraIncludeLibDirs pkg_descr =+        let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg+                             , extraFrameworkDirs = configExtraFrameworkDirs cfg+                             , PD.includeDirs = configExtraIncludeDirs cfg}+            modifyLib l        = l{ libBuildInfo = libBuildInfo l+                                                   `mappend` extraBi }+            modifyExecutable e = e{ buildInfo    = buildInfo e+                                                   `mappend` extraBi}+        in pkg_descr{ library     = modifyLib        `fmap` library pkg_descr+                    , executables = modifyExecutable  `map`+                                      executables pkg_descr}++-- | Check for use of Cabal features which require compiler support+checkCompilerProblems :: Compiler -> PackageDescription -> IO ()+checkCompilerProblems comp pkg_descr = do+    unless (renamingPackageFlagsSupported comp ||+                and [ True+                    | bi <- allBuildInfo pkg_descr+                    , _ <- Map.elems (targetBuildRenaming bi)]) $+        die $ "Your compiler does not support thinning and renaming on "+           ++ "package flags.  To use this feature you probably must use "+           ++ "GHC 7.9 or later."++    when (maybe False (not.null.PD.reexportedModules) (PD.library pkg_descr)+          && not (reexportedModulesSupported comp)) $ do+        die $ "Your compiler does not support module re-exports. To use "+           ++ "this feature you probably must use GHC 7.9 or later."++-- | Select dependencies for the package.+configureDependencies+    :: Verbosity+    -> InstalledPackageIndex -- ^ internal packages+    -> InstalledPackageIndex -- ^ installed packages+    -> Map PackageName InstalledPackageInfo -- ^ required deps+    -> PackageDescription+    -> IO ([PackageId], [InstalledPackageInfo])+configureDependencies verbosity+  internalPackageSet installedPackageSet requiredDepsMap pkg_descr = do+    let selectDependencies :: [Dependency] ->+                              ([FailedDependency], [ResolvedDependency])+        selectDependencies =+            partitionEithers+          . map (selectDependency internalPackageSet installedPackageSet+                                  requiredDepsMap)++        (failedDeps, allPkgDeps) =+          selectDependencies (buildDepends pkg_descr)++        internalPkgDeps = [ pkgid+                          | InternalDependency _ pkgid <- allPkgDeps ]+        externalPkgDeps = [ pkg+                          | ExternalDependency _ pkg   <- allPkgDeps ]++    when (not (null internalPkgDeps)+          && not (newPackageDepsBehaviour pkg_descr)) $+        die $ "The field 'build-depends: "+           ++ intercalate ", " (map (display . packageName) internalPkgDeps)+           ++ "' refers to a library which is defined within the same "+           ++ "package. To use this feature the package must specify at "+           ++ "least 'cabal-version: >= 1.8'."++    reportFailedDependencies failedDeps+    reportSelectedDependencies verbosity allPkgDeps++    return (internalPkgDeps, externalPkgDeps)++-- -----------------------------------------------------------------------------+-- Configuring package dependencies++reportProgram :: Verbosity -> Program -> Maybe ConfiguredProgram -> IO ()+reportProgram verbosity prog Nothing+    = info verbosity $ "No " ++ programName prog ++ " found"+reportProgram verbosity prog (Just configuredProg)+    = info verbosity $ "Using " ++ programName prog ++ version ++ location+    where location = case programLocation configuredProg of+            FoundOnSystem p -> " found on system at: " ++ p+            UserSpecified p -> " given by user at: " ++ p+          version = case programVersion configuredProg of+            Nothing -> ""+            Just v  -> " version " ++ display v++hackageUrl :: String+hackageUrl = "http://hackage.haskell.org/package/"++data ResolvedDependency = ExternalDependency Dependency InstalledPackageInfo+                        | InternalDependency Dependency PackageId -- should be a+                                                                      -- lib name++data FailedDependency = DependencyNotExists PackageName+                      | DependencyNoVersion Dependency++-- | Test for a package dependency and record the version we have installed.+selectDependency :: InstalledPackageIndex  -- ^ Internally defined packages+                 -> InstalledPackageIndex  -- ^ Installed packages+                 -> Map PackageName InstalledPackageInfo+                    -- ^ Packages for which we have been given specific deps to+                    -- use+                 -> Dependency+                 -> Either FailedDependency ResolvedDependency+selectDependency internalIndex installedIndex requiredDepsMap+  dep@(Dependency pkgname vr) =+  -- If the dependency specification matches anything in the internal package+  -- index, then we prefer that match to anything in the second.+  -- For example:+  --+  -- Name: MyLibrary+  -- Version: 0.1+  -- Library+  --     ..+  -- Executable my-exec+  --     build-depends: MyLibrary+  --+  -- We want "build-depends: MyLibrary" always to match the internal library+  -- even if there is a newer installed library "MyLibrary-0.2".+  -- However, "build-depends: MyLibrary >= 0.2" should match the installed one.+  case PackageIndex.lookupPackageName internalIndex pkgname of+    [(_,[pkg])] | packageVersion pkg `withinRange` vr+           -> Right $ InternalDependency dep (packageId pkg)++    _      -> case Map.lookup pkgname requiredDepsMap of+      -- If we know the exact pkg to use, then use it.+      Just pkginstance -> Right (ExternalDependency dep pkginstance)+      -- Otherwise we just pick an arbitrary instance of the latest version.+      Nothing -> case PackageIndex.lookupDependency installedIndex dep of+        []   -> Left  $ DependencyNotExists pkgname+        pkgs -> Right $ ExternalDependency dep $+                case last pkgs of+                  (_ver, pkginstances) -> head pkginstances++reportSelectedDependencies :: Verbosity+                           -> [ResolvedDependency] -> IO ()+reportSelectedDependencies verbosity deps =+  info verbosity $ unlines+    [ "Dependency " ++ display (simplifyDependency dep)+                    ++ ": using " ++ display pkgid+    | resolved <- deps+    , let (dep, pkgid) = case resolved of+            ExternalDependency dep' pkg'   -> (dep', packageId pkg')+            InternalDependency dep' pkgid' -> (dep', pkgid') ]++reportFailedDependencies :: [FailedDependency] -> IO ()+reportFailedDependencies []     = return ()+reportFailedDependencies failed =+    die (intercalate "\n\n" (map reportFailedDependency failed))++  where+    reportFailedDependency (DependencyNotExists pkgname) =+         "there is no version of " ++ display pkgname ++ " installed.\n"+      ++ "Perhaps you need to download and install it from\n"+      ++ hackageUrl ++ display pkgname ++ "?"++    reportFailedDependency (DependencyNoVersion dep) =+        "cannot satisfy dependency " ++ display (simplifyDependency dep) ++ "\n"++-- | List all installed packages in the given package databases.+getInstalledPackages :: Verbosity -> Compiler+                     -> PackageDBStack -- ^ The stack of package databases.+                     -> ProgramConfiguration+                     -> IO InstalledPackageIndex+getInstalledPackages verbosity comp packageDBs progconf = do+  when (null packageDBs) $+    die $ "No package databases have been specified. If you use "+       ++ "--package-db=clear, you must follow it with --package-db= "+       ++ "with 'global', 'user' or a specific file."++  info verbosity "Reading installed packages..."+  case compilerFlavor comp of+    GHC   -> GHC.getInstalledPackages verbosity comp packageDBs progconf+    GHCJS -> GHCJS.getInstalledPackages verbosity packageDBs progconf+    JHC   -> JHC.getInstalledPackages verbosity packageDBs progconf+    LHC   -> LHC.getInstalledPackages verbosity packageDBs progconf+    UHC   -> UHC.getInstalledPackages verbosity comp packageDBs progconf+    HaskellSuite {} ->+      HaskellSuite.getInstalledPackages verbosity packageDBs progconf+    flv -> die $ "don't know how to find the installed packages for "+              ++ display flv++-- | Like 'getInstalledPackages', but for a single package DB.+--+-- NB: Why isn't this always a fall through to 'getInstalledPackages'?+-- That is because 'getInstalledPackages' performs some sanity checks+-- on the package database stack in question.  However, when sandboxes+-- are involved these sanity checks are not desirable.+getPackageDBContents :: Verbosity -> Compiler+                     -> PackageDB -> ProgramConfiguration+                     -> IO InstalledPackageIndex+getPackageDBContents verbosity comp packageDB progconf = do+  info verbosity "Reading installed packages..."+  case compilerFlavor comp of+    GHC -> GHC.getPackageDBContents verbosity packageDB progconf+    GHCJS -> GHCJS.getPackageDBContents verbosity packageDB progconf+    -- For other compilers, try to fall back on 'getInstalledPackages'.+    _   -> getInstalledPackages verbosity comp [packageDB] progconf+++-- | A set of files (or directories) that can be monitored to detect when+-- there might have been a change in the installed packages.+--+getInstalledPackagesMonitorFiles :: Verbosity -> Compiler+                                 -> PackageDBStack+                                 -> ProgramConfiguration -> Platform+                                 -> IO [FilePath]+getInstalledPackagesMonitorFiles verbosity comp packageDBs progconf platform =+  case compilerFlavor comp of+    GHC   -> GHC.getInstalledPackagesMonitorFiles+               verbosity platform progconf packageDBs+    other -> do+      warn verbosity $ "don't know how to find change monitoring files for "+                    ++ "the installed package databases for " ++ display other+      return []++-- | The user interface specifies the package dbs to use with a combination of+-- @--global@, @--user@ and @--package-db=global|user|clear|$file@.+-- This function combines the global/user flag and interprets the package-db+-- flag into a single package db stack.+--+interpretPackageDbFlags :: Bool -> [Maybe PackageDB] -> PackageDBStack+interpretPackageDbFlags userInstall specificDBs =+    extra initialStack specificDBs+  where+    initialStack | userInstall = [GlobalPackageDB, UserPackageDB]+                 | otherwise   = [GlobalPackageDB]++    extra dbs' []            = dbs'+    extra _    (Nothing:dbs) = extra []             dbs+    extra dbs' (Just db:dbs) = extra (dbs' ++ [db]) dbs++newPackageDepsBehaviourMinVersion :: Version+newPackageDepsBehaviourMinVersion = Version [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++-- We are given both --constraint="foo < 2.0" style constraints and also+-- specific packages to pick via --dependency="foo=foo-2.0-177d5cdf20962d0581".+--+-- When finalising the package we have to take into account the specific+-- installed deps we've been given, and the finalise function expects+-- constraints, so we have to translate these deps into version constraints.+--+-- But after finalising we then have to make sure we pick the right specific+-- deps in the end. So we still need to remember which installed packages to+-- pick.+combinedConstraints :: [Dependency] ->+                       [(PackageName, UnitId)] ->+                       InstalledPackageIndex ->+                       Either String ([Dependency],+                                      Map PackageName InstalledPackageInfo)+combinedConstraints constraints dependencies installedPackages = do++    when (not (null badUnitIds)) $+      Left $ render $ text "The following package dependencies were requested"+         $+$ nest 4 (dispDependencies badUnitIds)+         $+$ text "however the given installed package instance does not exist."++    when (not (null badNames)) $+      Left $ render $ text "The following package dependencies were requested"+         $+$ nest 4 (dispDependencies badNames)+         $+$ text ("however the installed package's name does not match "+                   ++ "the name given.")++    --TODO: we don't check that all dependencies are used!++    return (allConstraints, idConstraintMap)++  where+    allConstraints :: [Dependency]+    allConstraints = constraints+                  ++ [ thisPackageVersion (packageId pkg)+                     | (_, _, Just pkg) <- dependenciesPkgInfo ]++    idConstraintMap :: Map PackageName InstalledPackageInfo+    idConstraintMap = Map.fromList+                        [ (packageName pkg, pkg)+                        | (_, _, Just pkg) <- dependenciesPkgInfo ]++    -- The dependencies along with the installed package info, if it exists+    dependenciesPkgInfo :: [(PackageName, UnitId,+                             Maybe InstalledPackageInfo)]+    dependenciesPkgInfo =+      [ (pkgname, ipkgid, mpkg)+      | (pkgname, ipkgid) <- dependencies+      , let mpkg = PackageIndex.lookupUnitId+                     installedPackages ipkgid+      ]++    -- If we looked up a package specified by an installed package id+    -- (i.e. someone has written a hash) and didn't find it then it's+    -- an error.+    badUnitIds =+      [ (pkgname, ipkgid)+      | (pkgname, ipkgid, Nothing) <- dependenciesPkgInfo ]++    -- If someone has written e.g.+    -- --dependency="foo=MyOtherLib-1.0-07...5bf30" then they have+    -- probably made a mistake.+    badNames =+      [ (requestedPkgName, ipkgid)+      | (requestedPkgName, ipkgid, Just pkg) <- dependenciesPkgInfo+      , let foundPkgName = packageName pkg+      , requestedPkgName /= foundPkgName ]++    dispDependencies deps =+      hsep [    text "--dependency="+             <> quotes (disp pkgname <> char '=' <> disp ipkgid)+           | (pkgname, ipkgid) <- deps ]++-- -----------------------------------------------------------------------------+-- Configuring program dependencies++configureRequiredPrograms :: Verbosity -> [Dependency] -> ProgramConfiguration+                             -> IO ProgramConfiguration+configureRequiredPrograms verbosity deps conf =+  foldM (configureRequiredProgram verbosity) conf deps++configureRequiredProgram :: Verbosity -> ProgramConfiguration -> Dependency+                            -> IO ProgramConfiguration+configureRequiredProgram verbosity conf+  (Dependency (PackageName progName) verRange) =+  case lookupKnownProgram progName conf of+    Nothing -> die ("Unknown build tool " ++ progName)+    Just prog+      -- requireProgramVersion always requires the program have a version+      -- but if the user says "build-depends: foo" ie no version constraint+      -- then we should not fail if we cannot discover the program version.+      | verRange == anyVersion -> do+          (_, conf') <- requireProgram verbosity prog conf+          return conf'+      | otherwise -> do+          (_, _, conf') <- requireProgramVersion verbosity prog verRange conf+          return conf'++-- -----------------------------------------------------------------------------+-- Configuring pkg-config package dependencies++configurePkgconfigPackages :: Verbosity -> PackageDescription+                           -> ProgramConfiguration+                           -> IO (PackageDescription, ProgramConfiguration)+configurePkgconfigPackages verbosity pkg_descr conf+  | null allpkgs = return (pkg_descr, conf)+  | otherwise    = do+    (_, _, conf') <- requireProgramVersion+                       (lessVerbose verbosity) pkgConfigProgram+                       (orLaterVersion $ Version [0,9,0] []) conf+    mapM_ requirePkg allpkgs+    lib' <- mapM addPkgConfigBILib (library pkg_descr)+    exes' <- mapM addPkgConfigBIExe (executables pkg_descr)+    tests' <- mapM addPkgConfigBITest (testSuites pkg_descr)+    benches' <- mapM addPkgConfigBIBench (benchmarks pkg_descr)+    let pkg_descr' = pkg_descr { library = lib', executables = exes',+                                 testSuites = tests', benchmarks = benches' }+    return (pkg_descr', conf')++  where+    allpkgs = concatMap pkgconfigDepends (allBuildInfo pkg_descr)+    pkgconfig = rawSystemProgramStdoutConf (lessVerbose verbosity)+                  pkgConfigProgram conf++    requirePkg dep@(Dependency (PackageName pkg) range) = do+      version <- pkgconfig ["--modversion", pkg]+                 `catchIO`   (\_ -> die notFound)+                 `catchExit` (\_ -> die notFound)+      case simpleParse version of+        Nothing -> die "parsing output of pkg-config --modversion failed"+        Just v | not (withinRange v range) -> die (badVersion v)+               | otherwise                 -> info verbosity (depSatisfied v)+      where+        notFound     = "The pkg-config package '" ++ pkg ++ "'"+                    ++ versionRequirement+                    ++ " is required but it could not be found."+        badVersion v = "The pkg-config package '" ++ pkg ++ "'"+                    ++ versionRequirement+                    ++ " is required but the version installed on the"+                    ++ " system is version " ++ display v+        depSatisfied v = "Dependency " ++ display dep+                      ++ ": using version " ++ display v++        versionRequirement+          | isAnyVersion range = ""+          | otherwise          = " version " ++ display range++    -- Adds pkgconfig dependencies to the build info for a component+    addPkgConfigBI compBI setCompBI comp = do+      bi <- pkgconfigBuildInfo (pkgconfigDepends (compBI comp))+      return $ setCompBI comp (compBI comp `mappend` bi)++    -- Adds pkgconfig dependencies to the build info for a library+    addPkgConfigBILib = addPkgConfigBI libBuildInfo $+                          \lib bi -> lib { libBuildInfo = bi }++    -- Adds pkgconfig dependencies to the build info for an executable+    addPkgConfigBIExe = addPkgConfigBI buildInfo $+                          \exe bi -> exe { buildInfo = bi }++    -- Adds pkgconfig dependencies to the build info for a test suite+    addPkgConfigBITest = addPkgConfigBI testBuildInfo $+                          \test bi -> test { testBuildInfo = bi }++    -- Adds pkgconfig dependencies to the build info for a benchmark+    addPkgConfigBIBench = addPkgConfigBI benchmarkBuildInfo $+                          \bench bi -> bench { benchmarkBuildInfo = bi }++    pkgconfigBuildInfo :: [Dependency] -> IO BuildInfo+    pkgconfigBuildInfo []      = return Mon.mempty+    pkgconfigBuildInfo pkgdeps = do+      let pkgs = nub [ display pkg | Dependency pkg _ <- pkgdeps ]+      ccflags <- pkgconfig ("--cflags" : pkgs)+      ldflags <- pkgconfig ("--libs"   : pkgs)+      return (ccLdOptionsBuildInfo (words ccflags) (words ldflags))++-- | Makes a 'BuildInfo' from C compiler and linker flags.+--+-- This can be used with the output from configuration programs like pkg-config+-- and similar package-specific programs like mysql-config, freealut-config etc.+-- For example:+--+-- > ccflags <- rawSystemProgramStdoutConf verbosity prog conf ["--cflags"]+-- > ldflags <- rawSystemProgramStdoutConf verbosity prog conf ["--libs"]+-- > return (ccldOptionsBuildInfo (words ccflags) (words ldflags))+--+ccLdOptionsBuildInfo :: [String] -> [String] -> BuildInfo+ccLdOptionsBuildInfo cflags ldflags =+  let (includeDirs',  cflags')   = partition ("-I" `isPrefixOf`) cflags+      (extraLibs',    ldflags')  = partition ("-l" `isPrefixOf`) ldflags+      (extraLibDirs', ldflags'') = partition ("-L" `isPrefixOf`) ldflags'+  in mempty {+       PD.includeDirs  = map (drop 2) includeDirs',+       PD.extraLibs    = map (drop 2) extraLibs',+       PD.extraLibDirs = map (drop 2) extraLibDirs',+       PD.ccOptions    = cflags',+       PD.ldOptions    = ldflags''+     }++-- -----------------------------------------------------------------------------+-- Determining the compiler details++configCompilerAuxEx :: ConfigFlags+                    -> IO (Compiler, Platform, ProgramConfiguration)+configCompilerAuxEx cfg = configCompilerEx (flagToMaybe $ configHcFlavor cfg)+                                           (flagToMaybe $ configHcPath cfg)+                                           (flagToMaybe $ configHcPkg cfg)+                                           programsConfig+                                           (fromFlag (configVerbosity cfg))+  where+    programsConfig = mkProgramsConfig cfg defaultProgramConfiguration++configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath+                 -> ProgramConfiguration -> Verbosity+                 -> IO (Compiler, Platform, ProgramConfiguration)+configCompilerEx Nothing _ _ _ _ = die "Unknown compiler"+configCompilerEx (Just hcFlavor) hcPath hcPkg conf verbosity = do+  (comp, maybePlatform, programsConfig) <- case hcFlavor of+    GHC   -> GHC.configure  verbosity hcPath hcPkg conf+    GHCJS -> GHCJS.configure verbosity hcPath hcPkg conf+    JHC   -> JHC.configure  verbosity hcPath hcPkg conf+    LHC   -> do (_, _, ghcConf) <- GHC.configure  verbosity Nothing hcPkg conf+                LHC.configure  verbosity hcPath Nothing ghcConf+    UHC   -> UHC.configure  verbosity hcPath hcPkg conf+    HaskellSuite {} -> HaskellSuite.configure verbosity hcPath hcPkg conf+    _    -> die "Unknown compiler"+  return (comp, fromMaybe buildPlatform maybePlatform, programsConfig)++-- Ideally we would like to not have separate configCompiler* and+-- configCompiler*Ex sets of functions, but there are many custom setup scripts+-- in the wild that are using them, so the versions with old types are kept for+-- backwards compatibility. Platform was added to the return triple in 1.18.++{-# DEPRECATED configCompiler+    "'configCompiler' is deprecated. Use 'configCompilerEx' instead." #-}+configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath+               -> ProgramConfiguration -> Verbosity+               -> IO (Compiler, ProgramConfiguration)+configCompiler mFlavor hcPath hcPkg conf verbosity =+  fmap (\(a,_,b) -> (a,b)) $ configCompilerEx mFlavor hcPath hcPkg conf verbosity++{-# DEPRECATED configCompilerAux+    "configCompilerAux is deprecated. Use 'configCompilerAuxEx' instead." #-}+configCompilerAux :: ConfigFlags+                  -> IO (Compiler, ProgramConfiguration)+configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx++-- -----------------------------------------------------------------------------+-- Making the internal component graph+++mkComponentsGraph :: PackageDescription+                  -> [PackageId]+                  -> Either [ComponentName]+                            [(Component, [ComponentName])]+mkComponentsGraph pkg_descr internalPkgDeps =+    let graph = [ (c, componentName c, componentDeps c)+                | c <- pkgEnabledComponents pkg_descr ]+     in case checkComponentsCyclic graph of+          Just ccycle -> Left  [ cname | (_,cname,_) <- ccycle ]+          Nothing     -> Right [ (c, cdeps) | (c, _, cdeps) <- graph ]+  where+    -- The dependencies for the given component+    componentDeps component =+         [ CExeName toolname | Dependency (PackageName toolname) _+                               <- buildTools bi+                             , toolname `elem` map exeName+                               (executables pkg_descr) ]++      ++ [ CLibName          | Dependency pkgname _ <- targetBuildDepends bi+                             , pkgname `elem` map packageName internalPkgDeps ]+      where+        bi = componentBuildInfo component++reportComponentCycle :: [ComponentName] -> IO a+reportComponentCycle cnames =+    die $ "Components in the package depend on each other in a cyclic way:\n  "+       ++ intercalate " depends on "+            [ "'" ++ showComponentName cname ++ "'"+            | cname <- cnames ++ [head cnames] ]++-- | 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 :: PackageIdentifier+            -> ComponentName+            -- TODO: careful here!+            -> [ComponentId] -- IPIDs of the component dependencies+            -> FlagAssignment+            -> ComponentId+computeComponentId pid cname dep_ipids flagAssignment = do+    -- show is found to be faster than intercalate and then replacement of+    -- special character used in intercalating. We cannot simply hash by+    -- doubly concating list, as it just flatten out the nested list, so+    -- different sources can produce same hash+    let hash = hashToBase62 $+                -- For safety, include the package + version here+                -- for GHC 7.10, where just the hash is used as+                -- the package key+                (display pid)+                      ++ (show $ dep_ipids)+                      ++ show flagAssignment+    ComponentId $+                display pid+                    ++ "-" ++ hash+                    ++ (case cname of+                         CLibName -> ""+                         -- TODO: these could result in non-parseable IPIDs+                         -- since the component name format is very flexible+                         CExeName   s -> "-" ++ s ++ ".exe"+                         CTestName  s -> "-" ++ s ++ ".test"+                         CBenchName s -> "-" ++ s ++ ".bench")++hashToBase62 :: String -> String+hashToBase62 s = showFingerprint $ fingerprintString s+  where+    showIntAtBase62 x = showIntAtBase 62 representBase62 x ""+    representBase62 x+        | x < 10 = chr (48 + x)+        | x < 36 = chr (65 + x - 10)+        | x < 62 = chr (97 + x - 36)+        | otherwise = '@'+    showFingerprint (Fingerprint a b) = showIntAtBase62 a ++ showIntAtBase62 b++-- | 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:+--+--      * For CLibName, we unconditionally use the 'PackageIdentifier'.+--+--      * For sub-components, we create a new 'PackageIdentifier' which+--        is encoded in the following way.  The test suite "qux" in package+--        "foobar-0.2" gets this package identifier "z-foobar-z-test-qux-0.2".+--        These package IDs have the form:+--+--          cpid ::= "z-" package-id "-z-" component-type "-" component-name+--          component-type ::= "test" | "bench" | "exe" | "lib"+--          package-id and component-name have "-" ( "z" + ) "-"+--          segments encoded by adding an extra "z".+--+-- 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+    -> PackageIdentifier+    -> ComponentName+    -> UnitId+    -> (PackageName, String)+computeCompatPackageKey comp pid cname uid@(SimpleUnitId (ComponentId str))+    | not (packageKeySupported comp || unitIdSupported comp) =+        -- NB: the package ID in the database entry has to follow this+        let zdashcode s = go s (Nothing :: Maybe Int) []+                where go [] _ r = reverse r+                      go ('-':z) (Just n) r | n > 0 = go z (Just 0) ('-':'z':r)+                      go ('-':z) _        r = go z (Just 0) ('-':r)+                      go ('z':z) (Just n) r = go z (Just (n+1)) ('z':r)+                      go (c:z)   _        r = go z Nothing (c:r)+            cname_str = case cname of+                            CLibName     -> error "computeCompatPackageKey"+                            CTestName n  -> "-z-test-"  ++ zdashcode n+                            CBenchName n -> "-z-bench-" ++ zdashcode n+                            CExeName n   -> "-z-exe-"   ++ zdashcode n+            package_name+                | cname == CLibName = pkgName pid+                | otherwise = PackageName $ "z-"+                              ++ zdashcode (display (pkgName pid))+                              ++ zdashcode cname_str+            old_style_key+                | cname == CLibName = display pid+                | otherwise         = display package_name ++ "-"+                                   ++ display (pkgVersion pid)+        in (package_name, old_style_key)+    | not (unifiedIPIDRequired comp) =+        let mb_verbatim_key+                = case simpleParse str :: Maybe PackageId of+                    -- Something like 'foo-0.1', use it verbatim.+                    -- (NB: hash tags look like tags, so they are parsed,+                    -- so the extra equality check tests if a tag was dropped.)+                    Just pid0 | display pid0 == str -> Just str+                    _ -> Nothing+            mb_truncated_key+                = let cand = reverse (takeWhile isAlphaNum (reverse str))+                  in if length cand == 22 && all isAlphaNum cand+                        then Just cand+                        else Nothing+            rehashed_key = hashToBase62 str+        in (pkgName pid, fromMaybe rehashed_key+                            (mb_verbatim_key `mplus` mb_truncated_key))+    | otherwise = (pkgName pid, display uid)++mkComponentsLocalBuildInfo :: ConfigFlags+                           -> Compiler+                           -> InstalledPackageIndex+                           -> PackageDescription+                           -> [PackageId] -- internal package deps+                           -> [InstalledPackageInfo] -- external package deps+                           -> [(Component, [ComponentName])]+                           -> FlagAssignment+                           -> IO [(ComponentName, ComponentLocalBuildInfo,+                                                  [ComponentName])]+mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr+                           internalPkgDeps externalPkgDeps+                           graph flagAssignment = do+    -- Pre-compute library hash so we can setup internal deps+    -- TODO configIPID should have name changed+    let cid = case configIPID cfg of+                Flag cid0 ->+                    -- Hack to reuse install dirs machinery+                    -- NB: no real IPID available at this point+                    let env = packageTemplateEnv (package pkg_descr)+                                                 (mkUnitId "")+                        str = fromPathTemplate+                                (InstallDirs.substPathTemplate env+                                 (toPathTemplate cid0))+                    in ComponentId str+                _ ->+                  computeComponentId (package pkg_descr) CLibName+                  (getDeps CLibName) flagAssignment+        uid = SimpleUnitId cid+        (_, compat_key) = computeCompatPackageKey comp+                          (package pkg_descr) CLibName uid+    sequence+      [ do clbi <- componentLocalBuildInfo uid compat_key c+           return (componentName c, clbi, cdeps)+      | (c, cdeps) <- graph ]+  where+    getDeps cname =+          let externalPkgs = maybe [] (\lib -> selectSubset+                                               (componentBuildInfo lib)+                                               externalPkgDeps)+                                      (lookupComponent pkg_descr cname)+          in map Installed.installedComponentId externalPkgs++    -- The allPkgDeps contains all the package deps for the whole package+    -- but we need to select the subset for this specific component.+    -- we just take the subset for the package names this component+    -- needs. Note, this only works because we cannot yet depend on two+    -- versions of the same package.+    componentLocalBuildInfo uid compat_key component =+      case component of+      CLib lib -> do+        let exports = map (\n -> Installed.ExposedModule n Nothing)+                          (PD.exposedModules lib)+        let mb_reexports = resolveModuleReexports installedPackages+                                                  (packageId pkg_descr)+                                                  uid+                                                  externalPkgDeps lib+        reexports <- case mb_reexports of+            Left problems -> reportModuleReexportProblems problems+            Right r -> return r++        return LibComponentLocalBuildInfo {+          componentPackageDeps = cpds,+          componentUnitId = uid,+          componentCompatPackageKey = compat_key,+          componentPackageRenaming = cprns,+          componentExposedModules = exports ++ reexports+        }+      CExe _ ->+        return ExeComponentLocalBuildInfo {+          componentPackageDeps = cpds,+          componentPackageRenaming = cprns+        }+      CTest _ ->+        return TestComponentLocalBuildInfo {+          componentPackageDeps = cpds,+          componentPackageRenaming = cprns+        }+      CBench _ ->+        return BenchComponentLocalBuildInfo {+          componentPackageDeps = cpds,+          componentPackageRenaming = cprns+        }+      where+        bi = componentBuildInfo component+        dedup = Map.toList . Map.fromList+        cpds = if newPackageDepsBehaviour pkg_descr+               then dedup $+                    [ (Installed.installedUnitId pkg, packageId pkg)+                    | pkg <- selectSubset bi externalPkgDeps ]+                 ++ [ (uid, pkgid)+                    | pkgid <- selectSubset bi internalPkgDeps ]+               else [ (Installed.installedUnitId pkg, packageId pkg)+                    | pkg <- externalPkgDeps ]+        cprns = if newPackageDepsBehaviour pkg_descr+                then targetBuildRenaming bi+                -- Hack: if we have old package-deps behavior, it's impossible+                -- for non-default renamings to be used, because the Cabal+                -- version is too early.  This is a good, because while all the+                -- deps were bundled up in buildDepends, we didn't do this for+                -- renamings, so it's not even clear how to get the merged+                -- version.  So just assume that all of them are the default..+                else Map.fromList (map (\(_,pid) ->+                                   (packageName pid, defaultRenaming)) cpds)++    selectSubset :: Package pkg => BuildInfo -> [pkg] -> [pkg]+    selectSubset bi pkgs =+        [ pkg | pkg <- pkgs, packageName pkg `elem` names bi ]++    names bi = [ name | Dependency name _ <- targetBuildDepends bi ]++-- | Given the author-specified re-export declarations from the .cabal file,+-- resolve them to the form that we need for the package database.+--+-- An invariant of the package database is that we always link the re-export+-- directly to its original defining location (rather than indirectly via a+-- chain of re-exporting packages).+--+resolveModuleReexports :: InstalledPackageIndex+                       -> PackageId+                       -> UnitId+                       -> [InstalledPackageInfo]+                       -> Library+                       -> Either [(ModuleReexport, String)] -- errors+                                 [Installed.ExposedModule] -- ok+resolveModuleReexports installedPackages srcpkgid key externalPkgDeps lib =+    case partitionEithers+         (map resolveModuleReexport (PD.reexportedModules lib)) of+      ([],  ok) -> Right ok+      (errs, _) -> Left  errs+  where+    -- A mapping from visible module names to their original defining+    -- module name.  We also record the package name of the package which+    -- *immediately* provided the module (not the original) to handle if the+    -- user explicitly says which build-depends they want to reexport from.+    visibleModules :: Map ModuleName [(PackageName, Installed.ExposedModule)]+    visibleModules =+      Map.fromListWith (++) $+        [ (Installed.exposedName exposedModule, [(exportingPackageName,+                                                  exposedModule)])+          -- The package index here contains all the indirect deps of the+          -- package we're configuring, but we want just the direct deps+        | let directDeps = Set.fromList+                           (map Installed.installedUnitId externalPkgDeps)+        , pkg <- PackageIndex.allPackages installedPackages+        , Installed.installedUnitId pkg `Set.member` directDeps+        , let exportingPackageName = packageName pkg+        , exposedModule <- visibleModuleDetails pkg+        ]+     ++ [ (visibleModuleName, [(exportingPackageName, exposedModule)])+        | visibleModuleName <- PD.exposedModules lib+                            ++ otherModules (libBuildInfo lib)+        , let exportingPackageName = packageName srcpkgid+              definingModuleName   = visibleModuleName+              definingPackageId    = key+              originalModule = Installed.OriginalModule definingPackageId+                                                        definingModuleName+              exposedModule  = Installed.ExposedModule visibleModuleName+                                                       (Just originalModule)+        ]++    -- All the modules exported from this package and their defining name and+    -- package (either defined here in this package or re-exported from some+    -- other package).  Return an ExposedModule because we want to hold onto+    -- signature information.+    visibleModuleDetails :: InstalledPackageInfo -> [Installed.ExposedModule]+    visibleModuleDetails pkg = do+        exposedModule <- Installed.exposedModules pkg+        case Installed.exposedReexport exposedModule of+        -- The first case is the modules actually defined in this package.+        -- In this case the reexport will point to this package.+            Nothing -> return exposedModule {+              Installed.exposedReexport =+                 Just (Installed.OriginalModule+                       (Installed.installedUnitId pkg)+                       (Installed.exposedName exposedModule)) }+        -- On the other hand, a visible module might actually be itself+        -- a re-export! In this case, the re-export info for the package+        -- doing the re-export will point us to the original defining+        -- module name and package, so we can reuse the entry.+            Just _ -> return exposedModule++    resolveModuleReexport reexport@ModuleReexport {+         moduleReexportOriginalPackage = moriginalPackageName,+         moduleReexportOriginalName    = originalName,+         moduleReexportName            = newName+      } =++      let filterForSpecificPackage =+            case moriginalPackageName of+              Nothing                  -> id+              Just originalPackageName ->+                filter (\(pkgname, _) -> pkgname == originalPackageName)++          matches = filterForSpecificPackage+                      (Map.findWithDefault [] originalName visibleModules)+      in+      case (matches, moriginalPackageName) of+        ((_, exposedModule):rest, _)+          -- TODO: Refine this check for signatures+          | all (\(_, exposedModule') ->+                  Installed.exposedReexport exposedModule+                  == Installed.exposedReexport exposedModule') rest+           -> Right exposedModule { Installed.exposedName = newName }++        ([], Just originalPackageName)+           -> Left $ (,) reexport+                   $ "The package " ++ display originalPackageName+                  ++ " does not export a module " ++ display originalName++        ([], Nothing)+           -> Left $ (,) reexport+                   $ "The module " ++ display originalName+                  ++ " is not exported by any suitable package (this package "+                  ++ "itself nor any of its 'build-depends' dependencies)."++        (ms, _)+           -> Left $ (,) reexport+                   $ "The module " ++ display originalName ++ " is exported "+                  ++ "by more than one package ("+                  ++ intercalate ", " [ display pkgname | (pkgname,_) <- ms ]+                  ++ ") and so the re-export is ambiguous. The ambiguity can "+                  ++ "be resolved by qualifying by the package name. The "+                  ++ "syntax is 'packagename:moduleName [as newname]'."++        -- Note: if in future Cabal allows directly depending on multiple+        -- instances of the same package (e.g. backpack) then an additional+        -- ambiguity case is possible here: (_, Just originalPackageName)+        -- with the module being ambiguous despite being qualified by a         -- package name. Presumably by that time we'll have a mechanism to         -- qualify the instance we're referring to.