Cabal 3.6.3.0 → 3.8.1.0

raw patch · 188 files changed

+1535/−26633 lines, 188 filesdep +Cabal-syntaxdep −binarydep −faildep −semigroupsdep ~Win32dep ~bytestringdep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal-syntax

Dependencies removed: binary, fail, semigroups, tagged, void

Dependency ranges changed: Win32, bytestring, mtl, process, transformers, unix

API changes (from Hackage documentation)

Files

• Cabal.cabal +158/−177
• ChangeLog.md +10/−4
• LICENSE +1/−1
• README.md +3/−3
• src/Distribution/Backpack.hs +0/−269
• src/Distribution/Backpack/Id.hs +1/−1
• src/Distribution/CabalSpecVersion.hs +0/−150
• src/Distribution/Compat/Binary.hs +0/−71
• src/Distribution/Compat/Binary/Class.hs +0/−519
• src/Distribution/Compat/Binary/Generic.hs +0/−128
• src/Distribution/Compat/CharParsing.hs +0/−357
• src/Distribution/Compat/CopyFile.hs +13/−11
• src/Distribution/Compat/CreatePipe.hs +3/−79
• src/Distribution/Compat/DList.hs +0/−53
• src/Distribution/Compat/Environment.hs +1/−50
• src/Distribution/Compat/Exception.hs +0/−37
• src/Distribution/Compat/Graph.hs +0/−408
• src/Distribution/Compat/Lens.hs +0/−262
• src/Distribution/Compat/MonadFail.hs +0/−5
• src/Distribution/Compat/Newtype.hs +0/−91
• src/Distribution/Compat/NonEmptySet.hs +0/−155
• src/Distribution/Compat/Parsing.hs +0/−362
• src/Distribution/Compat/Prelude.hs +0/−316
• src/Distribution/Compat/Process.hs +2/−11
• src/Distribution/Compat/Semigroup.hs +0/−119
• src/Distribution/Compat/Typeable.hs +0/−18
• src/Distribution/Compiler.hs +0/−223
• src/Distribution/FieldGrammar.hs +0/−88
• src/Distribution/FieldGrammar/Class.hs +0/−205
• src/Distribution/FieldGrammar/FieldDescrs.hs +0/−121
• src/Distribution/FieldGrammar/Newtypes.hs +0/−392
• src/Distribution/FieldGrammar/Parsec.hs +0/−439
• src/Distribution/FieldGrammar/Pretty.hs +0/−104
• src/Distribution/Fields.hs +0/−42
• src/Distribution/Fields/ConfVar.hs +0/−126
• src/Distribution/Fields/Field.hs +0/−141
• src/Distribution/Fields/Lexer.hs +0/−496
• src/Distribution/Fields/LexerMonad.hs +0/−155
• src/Distribution/Fields/ParseResult.hs +0/−196
• src/Distribution/Fields/Parser.hs +0/−377
• src/Distribution/Fields/Pretty.hs +0/−176
• src/Distribution/GetOpt.hs +50/−18
• src/Distribution/InstalledPackageInfo.hs +0/−145
• src/Distribution/License.hs +0/−252
• src/Distribution/ModuleName.hs +0/−131
• src/Distribution/Package.hs +0/−96
• src/Distribution/PackageDescription.hs +0/−113
• src/Distribution/PackageDescription/Check.hs +192/−168
• src/Distribution/PackageDescription/Configuration.hs +0/−600
• src/Distribution/PackageDescription/FieldGrammar.hs +0/−802
• src/Distribution/PackageDescription/Parsec.hs +0/−980
• src/Distribution/PackageDescription/PrettyPrint.hs +0/−282
• src/Distribution/PackageDescription/Quirks.hs +0/−340
• src/Distribution/PackageDescription/Utils.hs +0/−23
• src/Distribution/Parsec.hs +0/−524
• src/Distribution/Parsec/Error.hs +0/−21
• src/Distribution/Parsec/FieldLineStream.hs +0/−91
• src/Distribution/Parsec/Position.hs +0/−44
• src/Distribution/Parsec/Warning.hs +0/−61
• src/Distribution/Pretty.hs +0/−110
• src/Distribution/ReadE.hs +22/−8
• src/Distribution/SPDX.hs +0/−40
• src/Distribution/SPDX/License.hs +0/−65
• src/Distribution/SPDX/LicenseExceptionId.hs +0/−316
• src/Distribution/SPDX/LicenseExpression.hs +0/−162
• src/Distribution/SPDX/LicenseId.hs +0/−2152
• src/Distribution/SPDX/LicenseListVersion.hs +0/−22
• src/Distribution/SPDX/LicenseReference.hs +0/−80
• src/Distribution/Simple.hs +1/−29
• src/Distribution/Simple/Bench.hs +1/−1
• src/Distribution/Simple/Build.hs +120/−24
• src/Distribution/Simple/Build/Macros.hs +1/−1
• src/Distribution/Simple/BuildPaths.hs +5/−1
• src/Distribution/Simple/BuildToolDepends.hs +1/−1
• src/Distribution/Simple/Command.hs +6/−12
• src/Distribution/Simple/Compiler.hs +8/−1
• src/Distribution/Simple/Configure.hs +54/−14
• src/Distribution/Simple/GHC.hs +108/−73
• src/Distribution/Simple/GHC/Internal.hs +9/−2
• src/Distribution/Simple/GHCJS.hs +29/−8
• src/Distribution/Simple/Glob.hs +30/−12
• src/Distribution/Simple/Haddock.hs +13/−17
• src/Distribution/Simple/PackageDescription.hs +103/−0
• src/Distribution/Simple/PreProcess.hs +125/−65
• src/Distribution/Simple/Program/Ar.hs +12/−2
• src/Distribution/Simple/Program/GHC.hs +15/−3
• src/Distribution/Simple/Program/HcPkg.hs +1/−0
• src/Distribution/Simple/Program/Script.hs +1/−1
• src/Distribution/Simple/Register.hs +12/−0
• src/Distribution/Simple/Setup.hs +104/−115
• src/Distribution/Simple/ShowBuildInfo.hs +106/−67
• src/Distribution/Simple/SrcDist.hs +25/−8
• src/Distribution/Simple/Test/ExeV10.hs +4/−4
• src/Distribution/Simple/Test/LibV09.hs +7/−9
• src/Distribution/Simple/UHC.hs +1/−1
• src/Distribution/Simple/Utils.hs +62/−79
• src/Distribution/Simple/Utils/Json.hs +0/−46
• src/Distribution/System.hs +0/−275
• src/Distribution/Text.hs +0/−12
• src/Distribution/Types/AbiDependency.hs +0/−44
• src/Distribution/Types/AbiHash.hs +0/−61
• src/Distribution/Types/Benchmark.hs +0/−77
• src/Distribution/Types/Benchmark/Lens.hs +0/−27
• src/Distribution/Types/BenchmarkInterface.hs +0/−46
• src/Distribution/Types/BenchmarkType.hs +0/−40
• src/Distribution/Types/BuildInfo.hs +0/−266
• src/Distribution/Types/BuildInfo/Lens.hs +0/−342
• src/Distribution/Types/BuildType.hs +0/−55
• src/Distribution/Types/Component.hs +0/−91
• src/Distribution/Types/ComponentId.hs +0/−69
• src/Distribution/Types/ComponentName.hs +0/−78
• src/Distribution/Types/ComponentRequestedSpec.hs +0/−127
• src/Distribution/Types/CondTree.hs +0/−181
• src/Distribution/Types/Condition.hs +0/−135
• src/Distribution/Types/ConfVar.hs +0/−25
• src/Distribution/Types/Dependency.hs +0/−179
• src/Distribution/Types/DependencyMap.hs +0/−57
• src/Distribution/Types/DumpBuildInfo.hs +15/−0
• src/Distribution/Types/ExeDependency.hs +0/−71
• src/Distribution/Types/Executable.hs +0/−65
• src/Distribution/Types/Executable/Lens.hs +0/−31
• src/Distribution/Types/ExecutableScope.hs +0/−43
• src/Distribution/Types/ExposedModule.hs +0/−45
• src/Distribution/Types/Flag.hs +0/−346
• src/Distribution/Types/ForeignLib.hs +0/−199
• src/Distribution/Types/ForeignLib/Lens.hs +0/−45
• src/Distribution/Types/ForeignLibOption.hs +0/−39
• src/Distribution/Types/ForeignLibType.hs +0/−69
• src/Distribution/Types/GenericPackageDescription.hs +0/−105
• src/Distribution/Types/GenericPackageDescription/Lens.hs +0/−131
• src/Distribution/Types/HookedBuildInfo.hs +0/−66
• src/Distribution/Types/IncludeRenaming.hs +0/−68
• src/Distribution/Types/InstalledPackageInfo.hs +0/−173
• src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +0/−317
• src/Distribution/Types/InstalledPackageInfo/Lens.hs +0/−190
• src/Distribution/Types/LegacyExeDependency.hs +0/−47
• src/Distribution/Types/Lens.hs +0/−25
• src/Distribution/Types/Library.hs +0/−96
• src/Distribution/Types/Library/Lens.hs +0/−45
• src/Distribution/Types/LibraryName.hs +0/−73
• src/Distribution/Types/LibraryVisibility.hs +0/−52
• src/Distribution/Types/Mixin.hs +0/−93
• src/Distribution/Types/Module.hs +0/−46
• src/Distribution/Types/ModuleReexport.hs +0/−50
• src/Distribution/Types/ModuleRenaming.hs +0/−134
• src/Distribution/Types/MungedPackageId.hs +0/−83
• src/Distribution/Types/MungedPackageName.hs +0/−157
• src/Distribution/Types/PackageDescription.hs +0/−457
• src/Distribution/Types/PackageDescription/Lens.hs +0/−221
• src/Distribution/Types/PackageId.hs +0/−74
• src/Distribution/Types/PackageId/Lens.hs +0/−22
• src/Distribution/Types/PackageName.hs +0/−73
• src/Distribution/Types/PackageName/Magic.hs +5/−1
• src/Distribution/Types/PackageVersionConstraint.hs +0/−74
• src/Distribution/Types/PkgconfigDependency.hs +0/−39
• src/Distribution/Types/PkgconfigName.hs +0/−68
• src/Distribution/Types/PkgconfigVersion.hs +0/−119
• src/Distribution/Types/PkgconfigVersionRange.hs +0/−161
• src/Distribution/Types/SetupBuildInfo.hs +0/−41
• src/Distribution/Types/SetupBuildInfo/Lens.hs +0/−21
• src/Distribution/Types/SourceRepo.hs +0/−201
• src/Distribution/Types/SourceRepo/Lens.hs +0/−39
• src/Distribution/Types/TestSuite.hs +0/−83
• src/Distribution/Types/TestSuite/Lens.hs +0/−27
• src/Distribution/Types/TestSuiteInterface.hs +0/−52
• src/Distribution/Types/TestType.hs +0/−43
• src/Distribution/Types/UnitId.hs +0/−134
• src/Distribution/Types/UnqualComponentName.hs +0/−93
• src/Distribution/Types/Version.hs +0/−242
• src/Distribution/Types/VersionInterval.hs +0/−345
• src/Distribution/Types/VersionInterval/Legacy.hs +0/−368
• src/Distribution/Types/VersionRange.hs +0/−180
• src/Distribution/Types/VersionRange/Internal.hs +0/−526
• src/Distribution/Utils/Base62.hs +0/−22
• src/Distribution/Utils/Generic.hs +0/−576
• src/Distribution/Utils/IOData.hs +1/−0
• src/Distribution/Utils/Json.hs +58/−0
• src/Distribution/Utils/MD5.hs +0/−79
• src/Distribution/Utils/MapAccum.hs +2/−14
• src/Distribution/Utils/NubList.hs +2/−2
• src/Distribution/Utils/Path.hs +0/−103
• src/Distribution/Utils/ShortText.hs +0/−159
• src/Distribution/Utils/String.hs +0/−93
• src/Distribution/Utils/Structured.hs +0/−477
• src/Distribution/Verbosity.hs +31/−15
• src/Distribution/Verbosity/Internal.hs +1/−0
• src/Distribution/Version.hs +0/−185
• src/Language/Haskell/Extension.hs +0/−933

@@ -1,7 +1,7 @@-cabal-version: >=1.10+cabal-version: 1.22 name:          Cabal-version:       3.6.3.0-copyright:     2003-2021, Cabal Development Team (see AUTHORS file)+version:       3.8.1.0+copyright:     2003-2022, Cabal Development Team (see AUTHORS file) license:       BSD3 license-file:  LICENSE author:        Cabal Development Team <cabal-devel@haskell.org>@@ -29,14 +29,12 @@   location: https://github.com/haskell/cabal/   subdir:   Cabal -flag bundled-binary-generic-  default: False- library   default-language: Haskell2010   hs-source-dirs: src    build-depends:+    Cabal-syntax >= 3.8    && < 3.9,     array      >= 0.4.0.1  && < 0.6,     base       >= 4.6      && < 5,     bytestring >= 0.10.0.0 && < 0.12,@@ -45,40 +43,25 @@     directory  >= 1.2      && < 1.4,     filepath   >= 1.3.0.1  && < 1.5,     pretty     >= 1.1.1    && < 1.2,-    process    >= 1.1.0.2  && < 1.7,+    process    >= 1.2.1.0  && < 1.7,     time       >= 1.4.0.1  && < 1.13 -  if flag(bundled-binary-generic)-    build-depends: binary >= 0.5.1.1 && < 0.7-  else-    build-depends: binary >= 0.7 && < 0.9+  -- pull in process version with fixed waitForProcess error+  if impl(ghc >=8.2)+    build-depends: process >= 1.6.14.0    if os(windows)-    build-depends: Win32 >= 2.3.0.0 && < 2.13+    build-depends: Win32 >= 2.3.0.0 && < 2.14   else     build-depends: unix  >= 2.6.0.0 && < 2.8    ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates-  if impl(ghc >= 8.0)-    ghc-options: -Wcompat -Wnoncanonical-monad-instances--    if impl(ghc <8.8)-      ghc-options: -Wnoncanonical-monadfail-instances--  if !impl(ghc >= 8.0)-    -- at least one of lib:Cabal's dependency (i.e. `parsec`)-    -- already depends on `fail` and `semigroups` transitively-    build-depends: fail == 4.9.*, semigroups >= 0.18.3 && < 0.21--  if !impl(ghc >= 7.10)-    build-depends: void >= 0.7.3 && < 0.8+  ghc-options: -Wcompat -Wnoncanonical-monad-instances -  if !impl(ghc >= 7.8)-    -- semigroups depends on tagged.-    build-depends:  tagged >=0.8.6 && <0.9+  if impl(ghc <8.8)+    ghc-options: -Wnoncanonical-monadfail-instances    exposed-modules:-    Distribution.Backpack     Distribution.Backpack.Configure     Distribution.Backpack.ComponentsGraph     Distribution.Backpack.ConfiguredComponent@@ -88,45 +71,21 @@     Distribution.Backpack.ModSubst     Distribution.Backpack.ModuleShape     Distribution.Backpack.PreModuleShape-    Distribution.CabalSpecVersion     Distribution.Utils.IOData-    Distribution.Utils.Path     Distribution.Utils.LogProgress     Distribution.Utils.MapAccum-    Distribution.Utils.MD5-    Distribution.Utils.Structured     Distribution.Compat.CreatePipe     Distribution.Compat.Directory     Distribution.Compat.Environment-    Distribution.Compat.Exception     Distribution.Compat.FilePath-    Distribution.Compat.Graph     Distribution.Compat.Internal.TempFile-    Distribution.Compat.Newtype-    Distribution.Compat.NonEmptySet     Distribution.Compat.ResponseFile     Distribution.Compat.Prelude.Internal     Distribution.Compat.Process-    Distribution.Compat.Semigroup     Distribution.Compat.Stack     Distribution.Compat.Time-    Distribution.Compat.Typeable-    Distribution.Compat.DList-    Distribution.Compiler-    Distribution.InstalledPackageInfo-    Distribution.Types.AbiDependency-    Distribution.Types.ExposedModule-    Distribution.Types.InstalledPackageInfo-    Distribution.Types.InstalledPackageInfo.FieldGrammar-    Distribution.License     Distribution.Make-    Distribution.ModuleName-    Distribution.Package-    Distribution.PackageDescription     Distribution.PackageDescription.Check-    Distribution.PackageDescription.Configuration-    Distribution.PackageDescription.PrettyPrint-    Distribution.PackageDescription.Utils     Distribution.ReadE     Distribution.Simple     Distribution.Simple.Bench@@ -151,6 +110,7 @@     Distribution.Simple.InstallDirs     Distribution.Simple.InstallDirs.Internal     Distribution.Simple.LocalBuildInfo+    Distribution.Simple.PackageDescription     Distribution.Simple.PackageIndex     Distribution.Simple.PreProcess     Distribution.Simple.PreProcess.Unlit@@ -180,88 +140,162 @@     Distribution.Simple.UHC     Distribution.Simple.UserHooks     Distribution.Simple.Utils-    Distribution.SPDX-    Distribution.SPDX.License-    Distribution.SPDX.LicenseId-    Distribution.SPDX.LicenseExceptionId-    Distribution.SPDX.LicenseExpression-    Distribution.SPDX.LicenseListVersion-    Distribution.SPDX.LicenseReference-    Distribution.System     Distribution.TestSuite-    Distribution.Text-    Distribution.Pretty-    Distribution.Types.AbiHash     Distribution.Types.AnnotatedId-    Distribution.Types.Benchmark-    Distribution.Types.BenchmarkInterface-    Distribution.Types.BenchmarkType-    Distribution.Types.BuildInfo-    Distribution.Types.BuildType     Distribution.Types.ComponentInclude-    Distribution.Types.ConfVar-    Distribution.Types.Dependency-    Distribution.Types.ExeDependency-    Distribution.Types.LegacyExeDependency-    Distribution.Types.PkgconfigDependency-    Distribution.Types.DependencyMap-    Distribution.Types.ComponentId-    Distribution.Types.MungedPackageId-    Distribution.Types.PackageId-    Distribution.Types.UnitId-    Distribution.Types.Executable-    Distribution.Types.ExecutableScope-    Distribution.Types.Library-    Distribution.Types.LibraryVisibility-    Distribution.Types.Flag-    Distribution.Types.ForeignLib-    Distribution.Types.ForeignLibType-    Distribution.Types.ForeignLibOption-    Distribution.Types.Module-    Distribution.Types.ModuleReexport-    Distribution.Types.ModuleRenaming-    Distribution.Types.ComponentName-    Distribution.Types.LibraryName-    Distribution.Types.MungedPackageName-    Distribution.Types.PackageName+    Distribution.Types.DumpBuildInfo     Distribution.Types.PackageName.Magic-    Distribution.Types.PkgconfigName-    Distribution.Types.PkgconfigVersion-    Distribution.Types.PkgconfigVersionRange-    Distribution.Types.UnqualComponentName-    Distribution.Types.IncludeRenaming-    Distribution.Types.Mixin-    Distribution.Types.SetupBuildInfo-    Distribution.Types.TestSuite-    Distribution.Types.TestSuiteInterface-    Distribution.Types.TestType-    Distribution.Types.GenericPackageDescription-    Distribution.Types.Condition-    Distribution.Types.CondTree-    Distribution.Types.HookedBuildInfo-    Distribution.Types.PackageDescription-    Distribution.Types.SourceRepo-    Distribution.Types.Component     Distribution.Types.ComponentLocalBuildInfo     Distribution.Types.LocalBuildInfo-    Distribution.Types.ComponentRequestedSpec     Distribution.Types.TargetInfo-    Distribution.Types.Version-    Distribution.Types.VersionRange-    Distribution.Types.VersionRange.Internal-    Distribution.Types.VersionInterval-    Distribution.Types.VersionInterval.Legacy     Distribution.Types.GivenComponent-    Distribution.Types.PackageVersionConstraint-    Distribution.Utils.Generic+    Distribution.Utils.Json     Distribution.Utils.NubList-    Distribution.Utils.ShortText     Distribution.Utils.Progress     Distribution.Verbosity     Distribution.Verbosity.Internal-    Distribution.Version++  -- We reexport all of Cabal-syntax to aid in compatibility for downstream+  -- users. In the future we may opt to deprecate some or all of these exports.+  -- See haskell/Cabal#7974.+  reexported-modules:+    Distribution.Backpack,+    Distribution.CabalSpecVersion,+    Distribution.Compat.Binary,+    Distribution.Compat.CharParsing,+    Distribution.Compat.DList,+    Distribution.Compat.Exception,+    Distribution.Compat.Graph,+    Distribution.Compat.Lens,+    Distribution.Compat.MonadFail,+    Distribution.Compat.Newtype,+    Distribution.Compat.NonEmptySet,+    Distribution.Compat.Parsing,+    Distribution.Compat.Prelude,+    Distribution.Compat.Semigroup,+    Distribution.Compat.Typeable,+    Distribution.Compiler,+    Distribution.FieldGrammar,+    Distribution.FieldGrammar.Class,+    Distribution.FieldGrammar.FieldDescrs,+    Distribution.FieldGrammar.Newtypes,+    Distribution.FieldGrammar.Parsec,+    Distribution.FieldGrammar.Pretty,+    Distribution.Fields,+    Distribution.Fields.ConfVar,+    Distribution.Fields.Field,+    Distribution.Fields.Lexer,+    Distribution.Fields.LexerMonad,+    Distribution.Fields.ParseResult,+    Distribution.Fields.Parser,+    Distribution.Fields.Pretty,+    Distribution.InstalledPackageInfo,+    Distribution.License,+    Distribution.ModuleName,+    Distribution.Package,+    Distribution.PackageDescription,+    Distribution.PackageDescription.Configuration,+    Distribution.PackageDescription.FieldGrammar,+    Distribution.PackageDescription.Parsec,+    Distribution.PackageDescription.PrettyPrint,+    Distribution.PackageDescription.Quirks,+    Distribution.PackageDescription.Utils,+    Distribution.Parsec,+    Distribution.Parsec.Error,+    Distribution.Parsec.FieldLineStream,+    Distribution.Parsec.Position,+    Distribution.Parsec.Warning,+    Distribution.Pretty,+    Distribution.SPDX,+    Distribution.SPDX.License,+    Distribution.SPDX.LicenseExceptionId,+    Distribution.SPDX.LicenseExpression,+    Distribution.SPDX.LicenseId,+    Distribution.SPDX.LicenseListVersion,+    Distribution.SPDX.LicenseReference,+    Distribution.System,+    Distribution.Text,+    Distribution.Types.AbiDependency,+    Distribution.Types.AbiHash,+    Distribution.Types.Benchmark,+    Distribution.Types.Benchmark.Lens,+    Distribution.Types.BenchmarkInterface,+    Distribution.Types.BenchmarkType,+    Distribution.Types.BuildInfo,+    Distribution.Types.BuildInfo.Lens,+    Distribution.Types.BuildType,+    Distribution.Types.Component,+    Distribution.Types.ComponentId,+    Distribution.Types.ComponentName,+    Distribution.Types.ComponentRequestedSpec,+    Distribution.Types.CondTree,+    Distribution.Types.Condition,+    Distribution.Types.ConfVar,+    Distribution.Types.Dependency,+    Distribution.Types.DependencyMap,+    Distribution.Types.ExeDependency,+    Distribution.Types.Executable,+    Distribution.Types.Executable.Lens,+    Distribution.Types.ExecutableScope,+    Distribution.Types.ExposedModule,+    Distribution.Types.Flag,+    Distribution.Types.ForeignLib,+    Distribution.Types.ForeignLib.Lens,+    Distribution.Types.ForeignLibOption,+    Distribution.Types.ForeignLibType,+    Distribution.Types.GenericPackageDescription,+    Distribution.Types.GenericPackageDescription.Lens,+    Distribution.Types.HookedBuildInfo,+    Distribution.Types.IncludeRenaming,+    Distribution.Types.InstalledPackageInfo,+    Distribution.Types.InstalledPackageInfo.Lens,+    Distribution.Types.InstalledPackageInfo.FieldGrammar,+    Distribution.Types.LegacyExeDependency,+    Distribution.Types.Lens,+    Distribution.Types.Library,+    Distribution.Types.Library.Lens,+    Distribution.Types.LibraryName,+    Distribution.Types.LibraryVisibility,+    Distribution.Types.Mixin,+    Distribution.Types.Module,+    Distribution.Types.ModuleReexport,+    Distribution.Types.ModuleRenaming,+    Distribution.Types.MungedPackageId,+    Distribution.Types.MungedPackageName,+    Distribution.Types.PackageDescription,+    Distribution.Types.PackageDescription.Lens,+    Distribution.Types.PackageId,+    Distribution.Types.PackageId.Lens,+    Distribution.Types.PackageName,+    Distribution.Types.PackageVersionConstraint,+    Distribution.Types.PkgconfigDependency,+    Distribution.Types.PkgconfigName,+    Distribution.Types.PkgconfigVersion,+    Distribution.Types.PkgconfigVersionRange,+    Distribution.Types.SetupBuildInfo,+    Distribution.Types.SetupBuildInfo.Lens,+    Distribution.Types.SourceRepo,+    Distribution.Types.SourceRepo.Lens,+    Distribution.Types.TestSuite,+    Distribution.Types.TestSuite.Lens,+    Distribution.Types.TestSuiteInterface,+    Distribution.Types.TestType,+    Distribution.Types.UnitId,+    Distribution.Types.UnqualComponentName,+    Distribution.Types.Version,+    Distribution.Types.VersionInterval,+    Distribution.Types.VersionInterval.Legacy,+    Distribution.Types.VersionRange,+    Distribution.Types.VersionRange.Internal,+    Distribution.Utils.Base62,+    Distribution.Utils.Generic,+    Distribution.Utils.MD5,+    Distribution.Utils.Path,+    Distribution.Utils.ShortText,+    Distribution.Utils.String,+    Distribution.Utils.Structured,+    Distribution.Version,     Language.Haskell.Extension-    Distribution.Compat.Binary    -- Parsec parser-related modules   build-depends:@@ -271,49 +305,7 @@     mtl           >= 2.1      && < 2.3,     text         (>= 1.2.3.0  && < 1.3) || (>= 2.0 && < 2.1),     parsec        >= 3.1.13.0 && < 3.2-  exposed-modules:-    Distribution.Compat.Parsing-    Distribution.Compat.CharParsing-    Distribution.FieldGrammar-    Distribution.FieldGrammar.Class-    Distribution.FieldGrammar.FieldDescrs-    Distribution.FieldGrammar.Newtypes-    Distribution.FieldGrammar.Parsec-    Distribution.FieldGrammar.Pretty-    Distribution.PackageDescription.FieldGrammar-    Distribution.PackageDescription.Parsec-    Distribution.PackageDescription.Quirks-    Distribution.Parsec-    Distribution.Parsec.Error-    Distribution.Parsec.Position-    Distribution.Parsec.Warning-    Distribution.Parsec.FieldLineStream-    Distribution.Fields-    Distribution.Fields.ConfVar-    Distribution.Fields.Field-    Distribution.Fields.Lexer-    Distribution.Fields.LexerMonad-    Distribution.Fields.ParseResult-    Distribution.Fields.Parser-    Distribution.Fields.Pretty -  -- Lens functionality-  exposed-modules:-    Distribution.Compat.Lens-    Distribution.Types.Lens-    Distribution.Types.Benchmark.Lens-    Distribution.Types.BuildInfo.Lens-    Distribution.Types.Executable.Lens-    Distribution.Types.ForeignLib.Lens-    Distribution.Types.GenericPackageDescription.Lens-    Distribution.Types.InstalledPackageInfo.Lens-    Distribution.Types.Library.Lens-    Distribution.Types.PackageDescription.Lens-    Distribution.Types.PackageId.Lens-    Distribution.Types.SetupBuildInfo.Lens-    Distribution.Types.SourceRepo.Lens-    Distribution.Types.TestSuite.Lens-   other-modules:     Distribution.Backpack.PreExistingComponent     Distribution.Backpack.ReadyComponent@@ -322,30 +314,20 @@     Distribution.Backpack.UnifyM     Distribution.Backpack.Id     Distribution.Utils.UnionFind-    Distribution.Utils.Base62     Distribution.Compat.Async     Distribution.Compat.CopyFile     Distribution.Compat.GetShortPathName-    Distribution.Compat.MonadFail-    Distribution.Compat.Prelude     Distribution.Compat.SnocList     Distribution.GetOpt     Distribution.Lex-    Distribution.Utils.String     Distribution.Simple.Build.Macros.Z     Distribution.Simple.Build.PathsModule.Z     Distribution.Simple.GHC.EnvironmentParser     Distribution.Simple.GHC.Internal     Distribution.Simple.GHC.ImplInfo-    Distribution.Simple.Utils.Json     Distribution.ZinzaPrelude     Paths_Cabal -  if flag(bundled-binary-generic)-    other-modules:-      Distribution.Compat.Binary.Class-      Distribution.Compat.Binary.Generic-   other-extensions:     BangPatterns     CPP@@ -361,8 +343,10 @@     GeneralizedNewtypeDeriving     ImplicitParams     KindSignatures+    LambdaCase     NondecreasingIndentation     OverloadedStrings+    PatternSynonyms     RankNTypes     RecordWildCards     ScopedTypeVariables@@ -372,6 +356,3 @@     TypeOperators     TypeSynonymInstances     UndecidableInstances--  if impl(ghc >= 7.11)-    other-extensions: PatternSynonyms

@@ -1,16 +1,22 @@+# 3.8.1.0 [Mikolaj Konarski](mailto:mikolaj@well-typed.com) August 2022+  * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.8.1.0.md+ # 3.6.3.0 March 2022   * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.6.3.0.md -# 3.6.2.0 [Emily Pillmore](mailgo:emilypi@cohomolo.gy) October 2021+# 3.6.2.0 [Emily Pillmore](mailto:emilypi@cohomolo.gy) October 2021   * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.6.2.0.md -# 3.6.1.0 [Emily Pillmore](mailgo:emilypi@cohomolo.gy) August 2021+# 3.6.1.0 [Emily Pillmore](mailto:emilypi@cohomolo.gy) August 2021   * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.6.1.0.md -# 3.6.0.0 [Emily Pillmore](mailgo:emilypi@cohomolo.gy) August 2021+# 3.6.0.0 [Emily Pillmore](mailto:emilypi@cohomolo.gy) August 2021   * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.6.0.0.md -# 3.4.0.0 [Oleg Grenrus](mailgo:oleg.grnerus@iki.fi) February 2021+# 3.4.1.0 [Emily Pillmore](mailto:emilypi@cohomolo.gy) October 2021+  * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.4.1.0.md++# 3.4.0.0 [Oleg Grenrus](mailto:oleg.grnerus@iki.fi) February 2021   * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.4.0.0.md  # 3.2.1.0 [Oleg Grenrus](mailto:oleg.grenris@iki.fi) October 2020

@@ -1,4 +1,4 @@-Copyright (c) 2003-2020, Cabal Development Team.+Copyright (c) 2003-2022, Cabal Development Team. See the AUTHORS file for the full list of copyright holders.  See */LICENSE for the copyright holders of the subcomponents.

@@ -6,17 +6,17 @@ If you also want the `cabal` command-line program, you need the [cabal-install] package in addition to this library. -[cabal-install]: ../cabal-install/README.md+[cabal-install]: ../cabal-install  More information ================ -Please see the [Cabal web site] for the [user guide] and [API+Please see the [Cabal web site], the [user guide] and the [API documentation]. There is additional information available on the [development wiki].  [user guide]:        http://www.haskell.org/cabal/users-guide-[API documentation]: http://www.haskell.org/cabal/release/cabal-latest/doc/API/Cabal/Distribution-Simple.html+[API documentation]: https://hackage.haskell.org/package/Cabal/docs/Distribution-Simple.html [development wiki]:  https://github.com/haskell/cabal/wiki  

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

@@ -41,7 +41,7 @@ computeComponentId deterministic mb_ipid mb_cid pid cname mb_details =     -- show is found to be faster than intercalate and then replacement of     -- special character used in intercalating. We cannot simply hash by-    -- doubly concating list, as it just flatten out the nested list, so+    -- doubly concatenating list, as it just flatten out the nested list, so     -- different sources can produce same hash     let hash_suffix             | Just (dep_ipids, flags) <- mb_details

@@ -1,150 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-module Distribution.CabalSpecVersion where--import Prelude ()-import Distribution.Compat.Prelude---- | Different Cabal-the-spec versions.------ We branch based on this at least in the parser.----data CabalSpecVersion-    = CabalSpecV1_0 -- ^ this is older than 'CabalSpecV1_2'-    | CabalSpecV1_2 -- ^ new syntax (sections)-    | CabalSpecV1_4-    | CabalSpecV1_6-    | CabalSpecV1_8-    | CabalSpecV1_10-    | CabalSpecV1_12-    -- 1.16 -- 1.14: no changes-    | CabalSpecV1_18-    | CabalSpecV1_20-    | CabalSpecV1_22-    | CabalSpecV1_24-    | CabalSpecV2_0-    | CabalSpecV2_2-    | CabalSpecV2_4-    | CabalSpecV3_0-    -- 3.2: no changes-    | CabalSpecV3_4-    | CabalSpecV3_6-  deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data, Generic)--instance Binary CabalSpecVersion-instance Structured CabalSpecVersion-instance NFData CabalSpecVersion where rnf = genericRnf---- | Show cabal spec version, but not the way in the .cabal files------ @since 3.0.0.0-showCabalSpecVersion :: CabalSpecVersion -> String-showCabalSpecVersion CabalSpecV3_6  = "3.6"-showCabalSpecVersion CabalSpecV3_4  = "3.4"-showCabalSpecVersion CabalSpecV3_0  = "3.0"-showCabalSpecVersion CabalSpecV2_4  = "2.4"-showCabalSpecVersion CabalSpecV2_2  = "2.2"-showCabalSpecVersion CabalSpecV2_0  = "2.0"-showCabalSpecVersion CabalSpecV1_24 = "1.24"-showCabalSpecVersion CabalSpecV1_22 = "1.22"-showCabalSpecVersion CabalSpecV1_20 = "1.20"-showCabalSpecVersion CabalSpecV1_18 = "1.18"-showCabalSpecVersion CabalSpecV1_12 = "1.12"-showCabalSpecVersion CabalSpecV1_10 = "1.10"-showCabalSpecVersion CabalSpecV1_8  = "1.8"-showCabalSpecVersion CabalSpecV1_6  = "1.6"-showCabalSpecVersion CabalSpecV1_4  = "1.4"-showCabalSpecVersion CabalSpecV1_2  = "1.2"-showCabalSpecVersion CabalSpecV1_0  = "1.0"--cabalSpecLatest :: CabalSpecVersion-cabalSpecLatest = CabalSpecV3_6---- | Parse 'CabalSpecVersion' from version digits.------ It may fail if for recent versions the version is not exact.----cabalSpecFromVersionDigits :: [Int] -> Maybe CabalSpecVersion-cabalSpecFromVersionDigits v-    | v == [3,6]  = Just CabalSpecV3_6-    | v == [3,4]  = Just CabalSpecV3_4-    | v == [3,0]  = Just CabalSpecV3_0-    | v == [2,4]  = Just CabalSpecV2_4-    | v == [2,2]  = Just CabalSpecV2_2-    | v == [2,0]  = Just CabalSpecV2_0-    | v >= [1,25] = Nothing-    | v >= [1,23] = Just CabalSpecV1_24-    | v >= [1,21] = Just CabalSpecV1_22-    | v >= [1,19] = Just CabalSpecV1_20-    | v >= [1,17] = Just CabalSpecV1_18-    | v >= [1,11] = Just CabalSpecV1_12-    | v >= [1,9]  = Just CabalSpecV1_10-    | v >= [1,7]  = Just CabalSpecV1_8-    | v >= [1,5]  = Just CabalSpecV1_6-    | v >= [1,3]  = Just CabalSpecV1_4-    | v >= [1,1]  = Just CabalSpecV1_2-    | otherwise   = Just CabalSpecV1_0---- | @since 3.4.0.0-cabalSpecToVersionDigits :: CabalSpecVersion -> [Int]-cabalSpecToVersionDigits CabalSpecV3_6   = [3,6]-cabalSpecToVersionDigits CabalSpecV3_4   = [3,4]-cabalSpecToVersionDigits CabalSpecV3_0   = [3,0]-cabalSpecToVersionDigits CabalSpecV2_4   = [2,4]-cabalSpecToVersionDigits CabalSpecV2_2   = [2,2]-cabalSpecToVersionDigits CabalSpecV2_0   = [2,0]-cabalSpecToVersionDigits CabalSpecV1_24  = [1,24]-cabalSpecToVersionDigits CabalSpecV1_22  = [1,22]-cabalSpecToVersionDigits CabalSpecV1_20  = [1,20]-cabalSpecToVersionDigits CabalSpecV1_18  = [1,18]-cabalSpecToVersionDigits CabalSpecV1_12  = [1,12]-cabalSpecToVersionDigits CabalSpecV1_10  = [1,10]-cabalSpecToVersionDigits CabalSpecV1_8   = [1,8]-cabalSpecToVersionDigits CabalSpecV1_6   = [1,6]-cabalSpecToVersionDigits CabalSpecV1_4   = [1,4]-cabalSpecToVersionDigits CabalSpecV1_2   = [1,2]-cabalSpecToVersionDigits CabalSpecV1_0   = [1,0]---- | What is the minimum Cabal library version which knows how handle--- this spec version.------ /Note:/ this is a point where we could decouple cabal-spec and Cabal--- versions, if we ever want that.------ >>> cabalSpecMinimumLibraryVersion CabalSpecV3_0--- [2,5]------ >>> cabalSpecMinimumLibraryVersion CabalSpecV2_4--- [2,3]------ @since 3.4.0.0-cabalSpecMinimumLibraryVersion :: CabalSpecVersion -> [Int]-cabalSpecMinimumLibraryVersion CabalSpecV1_0 = [1,0]-cabalSpecMinimumLibraryVersion csv = case cabalSpecToVersionDigits (pred csv) of-    [x,y] -> [x, y+1]-    xs    -> xs--specHasCommonStanzas :: CabalSpecVersion -> HasCommonStanzas-specHasCommonStanzas v =-    if v >= CabalSpecV2_2-    then HasCommonStanzas-    else NoCommonStanzas--specHasElif :: CabalSpecVersion -> HasElif-specHasElif v = -    if v >= CabalSpecV2_2-    then HasElif-    else NoElif------------------------------------------------------------------------------------ Booleans------------------------------------------------------------------------------------ IDEA: make some kind of tagged booleans?-data HasElif = HasElif | NoElif-  deriving (Eq, Show)--data HasCommonStanzas = HasCommonStanzas | NoCommonStanzas-  deriving (Eq, Show)--data HasGlobstar = HasGlobstar | NoGlobstar

@@ -1,71 +0,0 @@-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 711-{-# LANGUAGE PatternSynonyms #-}-#endif--#ifndef MIN_VERSION_binary-#define MIN_VERSION_binary(x, y, z) 0-#endif--module Distribution.Compat.Binary-       ( decodeOrFailIO-       , decodeFileOrFail'-#if __GLASGOW_HASKELL__ >= 708 || MIN_VERSION_binary(0,7,0)-       , module Data.Binary-#else-       , Binary(..)-       , decode, encode, encodeFile-#endif-       ) where--import Control.Exception (ErrorCall (..), catch, evaluate)-import Data.ByteString.Lazy (ByteString)--#if __GLASGOW_HASKELL__ >= 708 || MIN_VERSION_binary(0,7,0)--import Data.Binary---- | Lazily reconstruct a value previously written to a file.-decodeFileOrFail' :: Binary a => FilePath -> IO (Either String a)-decodeFileOrFail' f = either (Left . snd) Right `fmap` decodeFileOrFail f--#else--import Data.Binary.Get-import Data.Binary.Put-import qualified Data.ByteString.Lazy as BSL--import Distribution.Compat.Binary.Class-import Distribution.Compat.Binary.Generic ()---- | Decode a value from a lazy ByteString, reconstructing the--- original structure.----decode :: Binary a => ByteString -> a-decode = runGet get---- | Encode a value using binary serialisation to a lazy ByteString.----encode :: Binary a => a -> ByteString-encode = runPut . put-{-# INLINE encode #-}---- | Lazily reconstruct a value previously written to a file.-decodeFileOrFail' :: Binary a => FilePath -> IO (Either String a)-decodeFileOrFail' f = decodeOrFailIO =<< BSL.readFile f---- | Lazily serialise a value to a file-encodeFile :: Binary a => FilePath -> a -> IO ()-encodeFile f = BSL.writeFile f . encode--#endif--decodeOrFailIO :: Binary a => ByteString -> IO (Either String a)-decodeOrFailIO bs =-    catch (evaluate (decode bs) >>= return . Right) handler-  where-#if MIN_VERSION_base(4,9,0)-    handler (ErrorCallWithLocation str _) = return $ Left str-#else-    handler (ErrorCall str) = return $ Left str-#endif

@@ -1,519 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE DefaultSignatures #-}--------------------------------------------------------------------------------- |--- Module      : Distribution.Compat.Binary.Class--- Copyright   : Lennart Kolmodin--- License     : BSD3-style (see LICENSE)------ Maintainer  : Lennart Kolmodin <kolmodin@gmail.com>--- Stability   : unstable--- Portability : portable to Hugs and GHC. Requires the FFI and some flexible instances------ Typeclass and instances for binary serialization.-----------------------------------------------------------------------------------module Distribution.Compat.Binary.Class (--    -- * The Binary class-      Binary(..)--    -- * Support for generics-    , GBinary(..)--    ) where--import Data.Word--import Data.Binary.Put-import Data.Binary.Get--import Control.Applicative ((<$>), (<*>), (*>))-import Foreign--import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as L--import Data.Char     (chr,ord)-import Data.List     (unfoldr)-import Data.Foldable (traverse_)---- And needed for the instances:-import qualified Data.ByteString as B-import qualified Data.Map        as Map-import qualified Data.Set        as Set-import qualified Data.IntMap     as IntMap-import qualified Data.IntSet     as IntSet-import qualified Data.Ratio      as R--import qualified Data.Tree as T--import Data.Array.Unboxed--import GHC.Generics--import qualified Data.Sequence as Seq-import qualified Data.Foldable as Fold----------------------------------------------------------------------------class GBinary f where-    gput :: f t -> Put-    gget :: Get (f t)---- | The 'Binary' class provides 'put' and 'get', methods to encode and--- decode a Haskell value to a lazy 'ByteString'. It mirrors the 'Read' and--- 'Show' classes for textual representation of Haskell types, and is--- suitable for serialising Haskell values to disk, over the network.------ For decoding and generating simple external binary formats (e.g. C--- structures), Binary may be used, but in general is not suitable--- for complex protocols. Instead use the 'Put' and 'Get' primitives--- directly.------ Instances of Binary should satisfy the following property:------ > decode . encode == id------ That is, the 'get' and 'put' methods should be the inverse of each--- other. A range of instances are provided for basic Haskell types.----class Binary t where-    -- | Encode a value in the Put monad.-    put :: t -> Put-    -- | Decode a value in the Get monad-    get :: Get t--    default put :: (Generic t, GBinary (Rep t)) => t -> Put-    put = gput . from--    default get :: (Generic t, GBinary (Rep t)) => Get t-    get = to `fmap` gget----------------------------------------------------------------------------- Simple instances---- The () type need never be written to disk: values of singleton type--- can be reconstructed from the type alone-instance Binary () where-    put ()  = return ()-    get     = return ()---- Bools are encoded as a byte in the range 0 .. 1-instance Binary Bool where-    put     = putWord8 . fromIntegral . fromEnum-    get     = fmap (toEnum . fromIntegral) getWord8---- Values of type 'Ordering' are encoded as a byte in the range 0 .. 2-instance Binary Ordering where-    put     = putWord8 . fromIntegral . fromEnum-    get     = fmap (toEnum . fromIntegral) getWord8----------------------------------------------------------------------------- Words and Ints---- Words8s are written as bytes-instance Binary Word8 where-    put     = putWord8-    get     = getWord8---- Words16s are written as 2 bytes in big-endian (network) order-instance Binary Word16 where-    put     = putWord16be-    get     = getWord16be---- Words32s are written as 4 bytes in big-endian (network) order-instance Binary Word32 where-    put     = putWord32be-    get     = getWord32be---- Words64s are written as 8 bytes in big-endian (network) order-instance Binary Word64 where-    put     = putWord64be-    get     = getWord64be---- Int8s are written as a single byte.-instance Binary Int8 where-    put i   = put (fromIntegral i :: Word8)-    get     = fmap fromIntegral (get :: Get Word8)---- Int16s are written as a 2 bytes in big endian format-instance Binary Int16 where-    put i   = put (fromIntegral i :: Word16)-    get     = fmap fromIntegral (get :: Get Word16)---- Int32s are written as a 4 bytes in big endian format-instance Binary Int32 where-    put i   = put (fromIntegral i :: Word32)-    get     = fmap fromIntegral (get :: Get Word32)---- Int64s are written as a 4 bytes in big endian format-instance Binary Int64 where-    put i   = put (fromIntegral i :: Word64)-    get     = fmap fromIntegral (get :: Get Word64)------------------------------------------------------------------------------ Words are are written as Word64s, that is, 8 bytes in big endian format-instance Binary Word where-    put i   = put (fromIntegral i :: Word64)-    get     = fmap fromIntegral (get :: Get Word64)---- Ints are are written as Int64s, that is, 8 bytes in big endian format-instance Binary Int where-    put i   = put (fromIntegral i :: Int64)-    get     = fmap fromIntegral (get :: Get Int64)-------------------------------------------------------------------------------- Portable, and pretty efficient, serialisation of Integer------- Fixed-size type for a subset of Integer-type SmallInt = Int32---- Integers are encoded in two ways: if they fit inside a SmallInt,--- they're written as a byte tag, and that value.  If the Integer value--- is too large to fit in a SmallInt, it is written as a byte array,--- along with a sign and length field.--instance Binary Integer where--    {-# INLINE put #-}-    put n | n >= lo && n <= hi = do-        putWord8 0-        put (fromIntegral n :: SmallInt)  -- fast path-     where-        lo = fromIntegral (minBound :: SmallInt) :: Integer-        hi = fromIntegral (maxBound :: SmallInt) :: Integer--    put n = do-        putWord8 1-        put sign-        put (unroll (abs n))         -- unroll the bytes-     where-        sign = fromIntegral (signum n) :: Word8--    {-# INLINE get #-}-    get = do-        tag <- get :: Get Word8-        case tag of-            0 -> fmap fromIntegral (get :: Get SmallInt)-            _ -> do sign  <- get-                    bytes <- get-                    let v = roll bytes-                    return $! if sign == (1 :: Word8) then v else - v------- Fold and unfold an Integer to and from a list of its bytes----unroll :: Integer -> [Word8]-unroll = unfoldr step-  where-    step 0 = Nothing-    step i = Just (fromIntegral i, i `shiftR` 8)--roll :: [Word8] -> Integer-roll   = foldr unstep 0-  where-    unstep b a = a `shiftL` 8 .|. fromIntegral b--{-------- An efficient, raw serialisation for Integer (GHC only)------- TODO  This instance is not architecture portable.  GMP stores numbers as--- arrays of machine sized words, so the byte format is not portable across--- architectures with different endianness and word size.--import Data.ByteString.Base (toForeignPtr,unsafePackAddress, memcpy)-import GHC.Base     hiding (ord, chr)-import GHC.Prim-import GHC.Ptr (Ptr(..))-import GHC.IOBase (IO(..))--instance Binary Integer where-    put (S# i)    = putWord8 0 *> put (I# i)-    put (J# s ba) = do-        putWord8 1-        put (I# s)-        put (BA ba)--    get = do-        b <- getWord8-        case b of-            0 -> do (I# i#) <- get-                    return (S# i#)-            _ -> do (I# s#) <- get-                    (BA a#) <- get-                    return (J# s# a#)--instance Binary ByteArray where--    -- Pretty safe.-    put (BA ba) =-        let sz   = sizeofByteArray# ba   -- (primitive) in *bytes*-            addr = byteArrayContents# ba-            bs   = unsafePackAddress (I# sz) addr-        in put bs   -- write as a ByteString. easy, yay!--    -- Pretty scary. Should be quick though-    get = do-        (fp, off, n@(I# sz)) <- fmap toForeignPtr get      -- so decode a ByteString-        assert (off == 0) $ return $ unsafePerformIO $ do-            (MBA arr) <- newByteArray sz                    -- and copy it into a ByteArray#-            let to = byteArrayContents# (unsafeCoerce# arr) -- urk, is this safe?-            withForeignPtr fp $ \from -> memcpy (Ptr to) from (fromIntegral n)-            freezeByteArray arr---- wrapper for ByteArray#-data ByteArray = BA  {-# UNPACK #-} !ByteArray#-data MBA       = MBA {-# UNPACK #-} !(MutableByteArray# RealWorld)--newByteArray :: Int# -> IO MBA-newByteArray sz = IO $ \s ->-  case newPinnedByteArray# sz s of { (# s', arr #) ->-  (# s', MBA arr #) }--freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray-freezeByteArray arr = IO $ \s ->-  case unsafeFreezeByteArray# arr s of { (# s', arr' #) ->-  (# s', BA arr' #) }---}--instance (Binary a,Integral a) => Binary (R.Ratio a) where-    put r = put (R.numerator r) *> put (R.denominator r)-    get = (R.%) <$> get <*> get------------------------------------------------------------------------------ Char is serialised as UTF-8-instance Binary Char where-    put a | c <= 0x7f     = put (fromIntegral c :: Word8)-          | c <= 0x7ff    = do put (0xc0 .|. y)-                               put (0x80 .|. z)-          | c <= 0xffff   = do put (0xe0 .|. x)-                               put (0x80 .|. y)-                               put (0x80 .|. z)-          | c <= 0x10ffff = do put (0xf0 .|. w)-                               put (0x80 .|. x)-                               put (0x80 .|. y)-                               put (0x80 .|. z)-          | otherwise     = error "Not a valid Unicode code point"-     where-        c = ord a-        z, y, x, w :: Word8-        z = fromIntegral (c           .&. 0x3f)-        y = fromIntegral (shiftR c 6  .&. 0x3f)-        x = fromIntegral (shiftR c 12 .&. 0x3f)-        w = fromIntegral (shiftR c 18 .&. 0x7)--    get = do-        let getByte = fmap (fromIntegral :: Word8 -> Int) get-            shiftL6 = flip shiftL 6 :: Int -> Int-        w <- getByte-        r <- case () of-                _ | w < 0x80  -> return w-                  | w < 0xe0  -> do-                                    x <- fmap (xor 0x80) getByte-                                    return (x .|. shiftL6 (xor 0xc0 w))-                  | w < 0xf0  -> do-                                    x <- fmap (xor 0x80) getByte-                                    y <- fmap (xor 0x80) getByte-                                    return (y .|. shiftL6 (x .|. shiftL6-                                            (xor 0xe0 w)))-                  | otherwise -> do-                                x <- fmap (xor 0x80) getByte-                                y <- fmap (xor 0x80) getByte-                                z <- fmap (xor 0x80) getByte-                                return (z .|. shiftL6 (y .|. shiftL6-                                        (x .|. shiftL6 (xor 0xf0 w))))-        return $! chr r----------------------------------------------------------------------------- Instances for the first few tuples--instance (Binary a, Binary b) => Binary (a,b) where-    put (a,b)           = put a *> put b-    get                 = (,) <$> get <*> get--instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where-    put (a,b,c)         = put a *> put b *> put c-    get                 = (,,) <$> get <*> get <*> get--instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where-    put (a,b,c,d)       = put a *> put b *> put c *> put d-    get                 = (,,,) <$> get <*> get <*> get <*> get--instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d,e) where-    put (a,b,c,d,e)     = put a *> put b *> put c *> put d *> put e-    get                 = (,,,,) <$> get <*> get <*> get <*> get <*> get------- and now just recurse:-----instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f)-        => Binary (a,b,c,d,e,f) where-    put (a,b,c,d,e,f)   = put (a,(b,c,d,e,f))-    get                 = do (a,(b,c,d,e,f)) <- get ; return (a,b,c,d,e,f)--instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g)-        => Binary (a,b,c,d,e,f,g) where-    put (a,b,c,d,e,f,g) = put (a,(b,c,d,e,f,g))-    get                 = do (a,(b,c,d,e,f,g)) <- get ; return (a,b,c,d,e,f,g)--instance (Binary a, Binary b, Binary c, Binary d, Binary e,-          Binary f, Binary g, Binary h)-        => Binary (a,b,c,d,e,f,g,h) where-    put (a,b,c,d,e,f,g,h) = put (a,(b,c,d,e,f,g,h))-    get                   = do (a,(b,c,d,e,f,g,h)) <- get ; return (a,b,c,d,e,f,g,h)--instance (Binary a, Binary b, Binary c, Binary d, Binary e,-          Binary f, Binary g, Binary h, Binary i)-        => Binary (a,b,c,d,e,f,g,h,i) where-    put (a,b,c,d,e,f,g,h,i) = put (a,(b,c,d,e,f,g,h,i))-    get                     = do (a,(b,c,d,e,f,g,h,i)) <- get ; return (a,b,c,d,e,f,g,h,i)--instance (Binary a, Binary b, Binary c, Binary d, Binary e,-          Binary f, Binary g, Binary h, Binary i, Binary j)-        => Binary (a,b,c,d,e,f,g,h,i,j) where-    put (a,b,c,d,e,f,g,h,i,j) = put (a,(b,c,d,e,f,g,h,i,j))-    get                       = do (a,(b,c,d,e,f,g,h,i,j)) <- get ; return (a,b,c,d,e,f,g,h,i,j)----------------------------------------------------------------------------- Container types--instance Binary a => Binary [a] where-    put l  = put (length l) *> traverse_ put l-    get    = do n <- get :: Get Int-                getMany n---- | 'getMany n' get 'n' elements in order, without blowing the stack.-getMany :: Binary a => Int -> Get [a]-getMany n = go [] n- where-    go xs 0 = return $! reverse xs-    go xs i = do x <- get-                 -- we must seq x to avoid stack overflows due to laziness in-                 -- (>>=)-                 x `seq` go (x:xs) (i-1)-{-# INLINE getMany #-}--instance (Binary a) => Binary (Maybe a) where-    put Nothing  = putWord8 0-    put (Just x) = putWord8 1 *> put x-    get = do-        w <- getWord8-        case w of-            0 -> return Nothing-            _ -> fmap Just get--instance (Binary a, Binary b) => Binary (Either a b) where-    put (Left  a) = putWord8 0 *> put a-    put (Right b) = putWord8 1 *> put b-    get = do-        w <- getWord8-        case w of-            0 -> fmap Left  get-            _ -> fmap Right get----------------------------------------------------------------------------- ByteStrings (have specially efficient instances)--instance Binary B.ByteString where-    put bs = do put (B.length bs)-                putByteString bs-    get    = get >>= getByteString------- Using old versions of fps, this is a type synonym, and non portable------ Requires 'flexible instances'----instance Binary ByteString where-    put bs = do put (fromIntegral (L.length bs) :: Int)-                putLazyByteString bs-    get    = get >>= getLazyByteString----------------------------------------------------------------------------- Maps and Sets--instance (Binary a) => Binary (Set.Set a) where-    put s = put (Set.size s) *> traverse_ put (Set.toAscList s)-    get   = fmap Set.fromDistinctAscList get--instance (Binary k, Binary e) => Binary (Map.Map k e) where-    put m = put (Map.size m) *> traverse_ put (Map.toAscList m)-    get   = fmap Map.fromDistinctAscList get--instance Binary IntSet.IntSet where-    put s = put (IntSet.size s) *> traverse_ put (IntSet.toAscList s)-    get   = fmap IntSet.fromDistinctAscList get--instance (Binary e) => Binary (IntMap.IntMap e) where-    put m = put (IntMap.size m) *> traverse_ put (IntMap.toAscList m)-    get   = fmap IntMap.fromDistinctAscList get----------------------------------------------------------------------------- Queues and Sequences--instance (Binary e) => Binary (Seq.Seq e) where-    put s = put (Seq.length s) *> Fold.traverse_ put s-    get = do n <- get :: Get Int-             rep Seq.empty n get-      where rep xs 0 _ = return $! xs-            rep xs n g = xs `seq` n `seq` do-                           x <- g-                           rep (xs Seq.|> x) (n-1) g----------------------------------------------------------------------------- Floating point--instance Binary Double where-    put d = put (decodeFloat d)-    get   = encodeFloat <$> get <*> get--instance Binary Float where-    put f = put (decodeFloat f)-    get   = encodeFloat <$> get <*> get----------------------------------------------------------------------------- Trees--instance (Binary e) => Binary (T.Tree e) where-    put (T.Node r s) = put r *> put s-    get = T.Node <$> get <*> get----------------------------------------------------------------------------- Arrays--instance (Binary i, Ix i, Binary e) => Binary (Array i e) where-    put a = do-        put (bounds a)-        put (rangeSize $ bounds a) -- write the length-        traverse_ put (elems a)        -- now the elems.-    get = do-        bs <- get-        n  <- get                  -- read the length-        xs <- getMany n            -- now the elems.-        return (listArray bs xs)------- The IArray UArray e constraint is non portable. Requires flexible instances----instance (Binary i, Ix i, Binary e, IArray UArray e) => Binary (UArray i e) where-    put a = do-        put (bounds a)-        put (rangeSize $ bounds a) -- now write the length-        traverse_ put (elems a)-    get = do-        bs <- get-        n  <- get-        xs <- getMany n-        return (listArray bs xs)

@@ -1,128 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, KindSignatures,-    ScopedTypeVariables, Trustworthy, TypeOperators, TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---------------------------------------------------------------------------------- |--- Module      : Distribution.Compat.Binary.Generic--- Copyright   : Bryan O'Sullivan--- License     : BSD3-style (see LICENSE)------ Maintainer  : Bryan O'Sullivan <bos@serpentine.com>--- Stability   : unstable--- Portability : Only works with GHC 7.2 and newer------ Instances for supporting GHC generics.----------------------------------------------------------------------------------module Distribution.Compat.Binary.Generic-    (-    ) where--import Control.Applicative-import Distribution.Compat.Binary.Class-import Data.Binary.Get-import Data.Binary.Put-import Data.Bits-import Data.Word-import GHC.Generics---- Type without constructors-instance GBinary V1 where-    gput _ = return ()-    gget   = return undefined---- Constructor without arguments-instance GBinary U1 where-    gput U1 = return ()-    gget    = return U1---- Product: constructor with parameters-instance (GBinary a, GBinary b) => GBinary (a :*: b) where-    gput (x :*: y) = gput x >> gput y-    gget = (:*:) <$> gget <*> gget---- Metadata (constructor name, etc)-instance GBinary a => GBinary (M1 i c a) where-    gput = gput . unM1-    gget = M1 <$> gget---- Constants, additional parameters, and rank-1 recursion-instance Binary a => GBinary (K1 i a) where-    gput = put . unK1-    gget = K1 <$> get---- Borrowed from the cereal package.---- The following GBinary instance for sums has support for serializing--- types with up to 2^64-1 constructors. It will use the minimal--- number of bytes needed to encode the constructor. For example when--- a type has 2^8 constructors or less it will use a single byte to--- encode the constructor. If it has 2^16 constructors or less it will--- use two bytes, and so on till 2^64-1.--#define GUARD(WORD) (size - 1) <= fromIntegral (maxBound :: WORD)-#define PUTSUM(WORD) GUARD(WORD) = putSum (0 :: WORD) (fromIntegral size)-#define GETSUM(WORD) GUARD(WORD) = (get :: Get WORD) >>= checkGetSum (fromIntegral size)--instance ( GSum     a, GSum     b-         , GBinary a, GBinary b-         , SumSize    a, SumSize    b) => GBinary (a :+: b) where-    gput | PUTSUM(Word8) | PUTSUM(Word16) | PUTSUM(Word32) | PUTSUM(Word64)-         | otherwise = sizeError "encode" size-      where-        size = unTagged (sumSize :: Tagged (a :+: b) Word64)--    gget | GETSUM(Word8) | GETSUM(Word16) | GETSUM(Word32) | GETSUM(Word64)-         | otherwise = sizeError "decode" size-      where-        size = unTagged (sumSize :: Tagged (a :+: b) Word64)--sizeError :: Show size => String -> size -> error-sizeError s size =-    error $ "Can't " ++ s ++ " a type with " ++ show size ++ " constructors"----------------------------------------------------------------------------checkGetSum :: (Ord word, Num word, Bits word, GSum f)-            => word -> word -> Get (f a)-checkGetSum size code | code < size = getSum code size-                      | otherwise   = fail "Unknown encoding for constructor"-{-# INLINE checkGetSum #-}--class GSum f where-    getSum :: (Ord word, Num word, Bits word) => word -> word -> Get (f a)-    putSum :: (Num w, Bits w, Binary w) => w -> w -> f a -> Put--instance (GSum a, GSum b, GBinary a, GBinary b) => GSum (a :+: b) where-    getSum !code !size | code < sizeL = L1 <$> getSum code           sizeL-                       | otherwise    = R1 <$> getSum (code - sizeL) sizeR-        where-          sizeL = size `shiftR` 1-          sizeR = size - sizeL--    putSum !code !size s = case s of-                             L1 x -> putSum code           sizeL x-                             R1 x -> putSum (code + sizeL) sizeR x-        where-          sizeL = size `shiftR` 1-          sizeR = size - sizeL--instance GBinary a => GSum (C1 c a) where-    getSum _ _ = gget--    putSum !code _ x = put code *> gput x----------------------------------------------------------------------------class SumSize f where-    sumSize :: Tagged f Word64--newtype Tagged (s :: * -> *) b = Tagged {unTagged :: b}--instance (SumSize a, SumSize b) => SumSize (a :+: b) where-    sumSize = Tagged $ unTagged (sumSize :: Tagged a Word64) +-                       unTagged (sumSize :: Tagged b Word64)--instance SumSize (C1 c a) where-    sumSize = Tagged 1

@@ -1,357 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -fspec-constr -fspec-constr-count=8 #-}--------------------------------------------------------------------------------- |--- Module      :  Distribution.Compat.CharParsing--- Copyright   :  (c) Edward Kmett 2011--- License     :  BSD3------ Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable------ Parsers for character streams------ Originally in @parsers@ package.----------------------------------------------------------------------------------module Distribution.Compat.CharParsing-  (-  -- * Combinators-    oneOf        -- :: CharParsing m => [Char] -> m Char-  , noneOf       -- :: CharParsing m => [Char] -> m Char-  , spaces       -- :: CharParsing m => m ()-  , space        -- :: CharParsing m => m Char-  , newline      -- :: CharParsing m => m Char-  , tab          -- :: CharParsing m => m Char-  , upper        -- :: CharParsing m => m Char-  , lower        -- :: CharParsing m => m Char-  , alphaNum     -- :: CharParsing m => m Char-  , letter       -- :: CharParsing m => m Char-  , digit        -- :: CharParsing m => m Char-  , hexDigit     -- :: CharParsing m => m Char-  , octDigit     -- :: CharParsing m => m Char-  , satisfyRange -- :: CharParsing m => Char -> Char -> m Char-  -- * Class-  , CharParsing(..)-  -- * Cabal additions-  , integral-  , signedIntegral-  , munch1-  , munch-  , skipSpaces1-  , module Distribution.Compat.Parsing-  ) where--import Prelude ()-import Distribution.Compat.Prelude--import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State.Lazy as Lazy-import Control.Monad.Trans.State.Strict as Strict-import Control.Monad.Trans.Writer.Lazy as Lazy-import Control.Monad.Trans.Writer.Strict as Strict-import Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.RWS.Strict as Strict-import Control.Monad.Trans.Reader (ReaderT (..))-import Control.Monad.Trans.Identity (IdentityT (..))-import Data.Char-import Data.Text (Text, unpack)--import qualified Text.Parsec as Parsec--import Distribution.Compat.Parsing---- | @oneOf cs@ succeeds if the current character is in the supplied--- list of characters @cs@. Returns the parsed character. See also--- 'satisfy'.------ >   vowel  = oneOf "aeiou"-oneOf :: CharParsing m => [Char] -> m Char-oneOf xs = satisfy (\c -> c `elem` xs)-{-# INLINE oneOf #-}---- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current--- character is /not/ in the supplied list of characters @cs@. Returns the--- parsed character.------ >  consonant = noneOf "aeiou"-noneOf :: CharParsing m => [Char] -> m Char-noneOf xs = satisfy (\c -> c `notElem` xs)-{-# INLINE noneOf #-}---- | Skips /zero/ or more white space characters. See also 'skipMany'.-spaces :: CharParsing m => m ()-spaces = skipMany space <?> "white space"-{-# INLINE spaces #-}---- | Parses a white space character (any character which satisfies 'isSpace')--- Returns the parsed character.-space :: CharParsing m => m Char-space = satisfy isSpace <?> "space"-{-# INLINE space #-}---- | Parses a newline character (\'\\n\'). Returns a newline character.-newline :: CharParsing m => m Char-newline = char '\n' <?> "new-line"-{-# INLINE newline #-}---- | Parses a tab character (\'\\t\'). Returns a tab character.-tab :: CharParsing m => m Char-tab = char '\t' <?> "tab"-{-# INLINE tab #-}---- | Parses an upper case letter. Returns the parsed character.-upper :: CharParsing m => m Char-upper = satisfy isUpper <?> "uppercase letter"-{-# INLINE upper #-}---- | Parses a lower case character. Returns the parsed character.-lower :: CharParsing m => m Char-lower = satisfy isLower <?> "lowercase letter"-{-# INLINE lower #-}---- | Parses a letter or digit. Returns the parsed character.-alphaNum :: CharParsing m => m Char-alphaNum = satisfy isAlphaNum <?> "letter or digit"-{-# INLINE alphaNum #-}---- | Parses a letter (an upper case or lower case character). Returns the--- parsed character.-letter :: CharParsing m => m Char-letter = satisfy isAlpha <?> "letter"-{-# INLINE letter #-}---- | Parses a digit. Returns the parsed character.-digit :: CharParsing m => m Char-digit = satisfy isDigit <?> "digit"-{-# INLINE digit #-}---- | Parses a hexadecimal digit (a digit or a letter between \'a\' and--- \'f\' or \'A\' and \'F\'). Returns the parsed character.-hexDigit :: CharParsing m => m Char-hexDigit = satisfy isHexDigit <?> "hexadecimal digit"-{-# INLINE hexDigit #-}---- | Parses an octal digit (a character between \'0\' and \'7\'). Returns--- the parsed character.-octDigit :: CharParsing m => m Char-octDigit = satisfy isOctDigit <?> "octal digit"-{-# INLINE octDigit #-}--satisfyRange :: CharParsing m => Char -> Char -> m Char-satisfyRange a z = satisfy (\c -> c >= a && c <= z)-{-# INLINE satisfyRange #-}---- | Additional functionality needed to parse character streams.-class Parsing m => CharParsing m where-  -- | Parse a single character of the input, with UTF-8 decoding-  satisfy :: (Char -> Bool) -> m Char--  -- | @char c@ parses a single character @c@. Returns the parsed-  -- character (i.e. @c@).-  ---  -- /e.g./-  ---  -- @semiColon = 'char' ';'@-  char :: Char -> m Char-  char c = satisfy (c ==) <?> show [c]-  {-# INLINE char #-}--  -- | @notChar c@ parses any single character other than @c@. Returns the parsed-  -- character.-  notChar :: Char -> m Char-  notChar c = satisfy (c /=)-  {-# INLINE notChar #-}--  -- | This parser succeeds for any character. Returns the parsed character.-  anyChar :: m Char-  anyChar = satisfy (const True)-  {-# INLINE anyChar #-}--  -- | @string s@ parses a sequence of characters given by @s@. Returns-  -- the parsed string (i.e. @s@).-  ---  -- >  divOrMod    =   string "div"-  -- >              <|> string "mod"-  string :: String -> m String-  string s = s <$ try (traverse_ char s) <?> show s-  {-# INLINE string #-}--  -- | @text t@ parses a sequence of characters determined by the text @t@ Returns-  -- the parsed text fragment (i.e. @t@).-  ---  -- Using @OverloadedStrings@:-  ---  -- >  divOrMod    =   text "div"-  -- >              <|> text "mod"-  text :: Text -> m Text-  text t = t <$ string (unpack t)-  {-# INLINE text #-}--instance (CharParsing m, MonadPlus m) => CharParsing (Lazy.StateT s m) where-  satisfy = lift . satisfy-  {-# INLINE satisfy #-}-  char    = lift . char-  {-# INLINE char #-}-  notChar = lift . notChar-  {-# INLINE notChar #-}-  anyChar = lift anyChar-  {-# INLINE anyChar #-}-  string  = lift . string-  {-# INLINE string #-}-  text = lift . text-  {-# INLINE text #-}--instance (CharParsing m, MonadPlus m) => CharParsing (Strict.StateT s m) where-  satisfy = lift . satisfy-  {-# INLINE satisfy #-}-  char    = lift . char-  {-# INLINE char #-}-  notChar = lift . notChar-  {-# INLINE notChar #-}-  anyChar = lift anyChar-  {-# INLINE anyChar #-}-  string  = lift . string-  {-# INLINE string #-}-  text = lift . text-  {-# INLINE text #-}--instance (CharParsing m, MonadPlus m) => CharParsing (ReaderT e m) where-  satisfy = lift . satisfy-  {-# INLINE satisfy #-}-  char    = lift . char-  {-# INLINE char #-}-  notChar = lift . notChar-  {-# INLINE notChar #-}-  anyChar = lift anyChar-  {-# INLINE anyChar #-}-  string  = lift . string-  {-# INLINE string #-}-  text = lift . text-  {-# INLINE text #-}--instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Strict.WriterT w m) where-  satisfy = lift . satisfy-  {-# INLINE satisfy #-}-  char    = lift . char-  {-# INLINE char #-}-  notChar = lift . notChar-  {-# INLINE notChar #-}-  anyChar = lift anyChar-  {-# INLINE anyChar #-}-  string  = lift . string-  {-# INLINE string #-}-  text = lift . text-  {-# INLINE text #-}--instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Lazy.WriterT w m) where-  satisfy = lift . satisfy-  {-# INLINE satisfy #-}-  char    = lift . char-  {-# INLINE char #-}-  notChar = lift . notChar-  {-# INLINE notChar #-}-  anyChar = lift anyChar-  {-# INLINE anyChar #-}-  string  = lift . string-  {-# INLINE string #-}-  text = lift . text-  {-# INLINE text #-}--instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Lazy.RWST r w s m) where-  satisfy = lift . satisfy-  {-# INLINE satisfy #-}-  char    = lift . char-  {-# INLINE char #-}-  notChar = lift . notChar-  {-# INLINE notChar #-}-  anyChar = lift anyChar-  {-# INLINE anyChar #-}-  string  = lift . string-  {-# INLINE string #-}-  text = lift . text-  {-# INLINE text #-}--instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Strict.RWST r w s m) where-  satisfy = lift . satisfy-  {-# INLINE satisfy #-}-  char    = lift . char-  {-# INLINE char #-}-  notChar = lift . notChar-  {-# INLINE notChar #-}-  anyChar = lift anyChar-  {-# INLINE anyChar #-}-  string  = lift . string-  {-# INLINE string #-}-  text = lift . text-  {-# INLINE text #-}--instance (CharParsing m, MonadPlus m) => CharParsing (IdentityT m) where-  satisfy = lift . satisfy-  {-# INLINE satisfy #-}-  char    = lift . char-  {-# INLINE char #-}-  notChar = lift . notChar-  {-# INLINE notChar #-}-  anyChar = lift anyChar-  {-# INLINE anyChar #-}-  string  = lift . string-  {-# INLINE string #-}-  text = lift . text-  {-# INLINE text #-}--instance Parsec.Stream s m Char => CharParsing (Parsec.ParsecT s u m) where-  satisfy   = Parsec.satisfy-  char      = Parsec.char-  notChar c = Parsec.satisfy (/= c)-  anyChar   = Parsec.anyChar-  string    = Parsec.string------------------------------------------------------------------------------------ Our additions----------------------------------------------------------------------------------integral :: (CharParsing m, Integral a) => m a-integral = toNumber <$> some d <?> "integral"-  where-    toNumber = foldl' (\a b -> a * 10 + b) 0-    d = f <$> satisfyRange '0' '9'-    f '0' = 0-    f '1' = 1-    f '2' = 2-    f '3' = 3-    f '4' = 4-    f '5' = 5-    f '6' = 6-    f '7' = 7-    f '8' = 8-    f '9' = 9-    f _   = error "panic! integral"-{-# INLINE integral #-}---- | Accepts negative (starting with @-@) and positive (without sign) integral--- numbers.--- --- @since 3.4.0.0-signedIntegral :: (CharParsing m, Integral a) => m a-signedIntegral = negate <$ char '-' <*> integral <|> integral-{-# INLINE signedIntegral #-}---- | Greedily munch characters while predicate holds.--- Require at least one character.-munch1 :: CharParsing m => (Char -> Bool) -> m String-munch1 = some . satisfy-{-# INLINE munch1 #-}---- | Greedely munch characters while predicate holds.--- Always succeeds.-munch :: CharParsing m => (Char -> Bool) -> m String-munch = many . satisfy-{-# INLINE munch #-}--skipSpaces1 :: CharParsing m => m ()-skipSpaces1 = skipSome space-{-# INLINE skipSpaces1 #-}

@@ -20,6 +20,8 @@ import Control.Exception          ( bracketOnError ) import qualified Data.ByteString.Lazy as BSL+import Data.Bits+         ( (.|.) ) import System.IO.Error          ( ioeSetLocation ) import System.Directory@@ -34,10 +36,8 @@  import System.Posix.Types          ( FileMode )-import System.Posix.Internals-         ( c_chmod, withFilePath )-import Foreign.C-         ( throwErrnoPathIfMinus1_ )+import System.Posix.Files+         ( getFileStatus, fileMode, setFileMode )  #else /* else mingw32_HOST_OS */ @@ -69,15 +69,17 @@ copyOrdinaryFile   src dest = copyFile src dest >> setFileOrdinary   dest copyExecutableFile src dest = copyFile src dest >> setFileExecutable dest -setFileOrdinary,  setFileExecutable, setDirOrdinary  :: FilePath -> IO ()+setFileOrdinary, setFileExecutable, setDirOrdinary :: FilePath -> IO () #ifndef mingw32_HOST_OS-setFileOrdinary   path = setFileMode path 0o644 -- file perms -rw-r--r---setFileExecutable path = setFileMode path 0o755 -- file perms -rwxr-xr-x+-- When running with a restrictive UMASK such as 0077 we still want to+-- install files and directories that are accessible to other users.+setFileOrdinary   path = addFileMode path 0o644 -- file perms -rw-r--r--+setFileExecutable path = addFileMode path 0o755 -- file perms -rwxr-xr-x -setFileMode :: FilePath -> FileMode -> IO ()-setFileMode name m =-  withFilePath name $ \s -> do-    throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)+addFileMode :: FilePath -> FileMode -> IO ()+addFileMode name m = do+  o <- fileMode <$> getFileStatus name+  setFileMode name (m .|. o) #else setFileOrdinary   _ = return () setFileExecutable _ = return ()

@@ -1,81 +1,5 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}--module Distribution.Compat.CreatePipe (createPipe) where+module Distribution.Compat.CreatePipe+  {-# DEPRECATED "Use System.Process from package process directly" #-}+  (createPipe) where -#if MIN_VERSION_process(1,2,1) import System.Process (createPipe)-#else-import System.IO (Handle, hSetBinaryMode)--import Prelude ()-import Distribution.Compat.Prelude-import Distribution.Compat.Stack---- The mingw32_HOST_OS CPP macro is GHC-specific-#ifdef mingw32_HOST_OS-import qualified Prelude-import Control.Exception (onException)-import Foreign.C.Error (throwErrnoIfMinus1_)-import Foreign.C.Types (CInt(..), CUInt(..))-import Foreign.Ptr (Ptr)-import Foreign.Marshal.Array (allocaArray)-import Foreign.Storable (peek, peekElemOff)-import GHC.IO.FD (mkFD)-import GHC.IO.Device (IODeviceType(Stream))-import GHC.IO.Handle.FD (mkHandleFromFD)-import System.IO (IOMode(ReadMode, WriteMode))-#elif defined ghcjs_HOST_OS-#else-import System.Posix.IO (fdToHandle)-import qualified System.Posix.IO as Posix-#endif--createPipe :: IO (Handle, Handle)--- The mingw32_HOST_OS CPP macro is GHC-specific-#ifdef mingw32_HOST_OS-createPipe = do-    (readfd, writefd) <- allocaArray 2 $ \ pfds -> do-        throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 ({- _O_BINARY -} 32768)-        readfd <- peek pfds-        writefd <- peekElemOff pfds 1-        return (readfd, writefd)-    (do readh <- fdToHandle readfd ReadMode-        writeh <- fdToHandle writefd WriteMode-        hSetBinaryMode readh True-        hSetBinaryMode writeh True-        return (readh, writeh)) `onException` (close readfd >> close writefd)-  where-    fdToHandle :: CInt -> IOMode -> IO Handle-    fdToHandle fd mode = do-        (fd', deviceType) <- mkFD fd mode (Just (Stream, 0, 0)) False False-        mkHandleFromFD fd' deviceType "" mode False Nothing--    close :: CInt -> IO ()-    close = throwErrnoIfMinus1_ "_close" . c__close-      where _ = callStack -- TODO: attach call stack to exception--    _ = callStack -- TODO: attach call stack to exceptions--foreign import ccall "io.h _pipe" c__pipe ::-    Ptr CInt -> CUInt -> CInt -> Prelude.IO CInt--foreign import ccall "io.h _close" c__close ::-    CInt -> Prelude.IO CInt-#elif defined ghcjs_HOST_OS-createPipe = error "createPipe"-  where-    _ = callStack-#else-createPipe = do-    (readfd, writefd) <- Posix.createPipe-    readh <- fdToHandle readfd-    writeh <- fdToHandle writefd-    hSetBinaryMode readh True-    hSetBinaryMode writeh True-    return (readh, writeh)-  where-    _ = callStack-#endif-#endif

@@ -1,53 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Distribution.Compat.DList--- Copyright   :  (c) Ben Gamari 2015-2019--- License     :  BSD3------ Maintainer  :  cabal-dev@haskell.org--- Stability   :  experimental--- Portability :  portable------ A very simple difference list.-module Distribution.Compat.DList (-    DList,-    runDList,-    empty,-    singleton,-    fromList,-    toList,-    snoc,-) where--import Prelude ()-import Distribution.Compat.Prelude hiding (toList, empty)---- | Difference list.-newtype DList a = DList ([a] -> [a])--runDList :: DList a -> [a]-runDList (DList run) = run []---- | Make 'DList' containing single element.-singleton :: a -> DList a-singleton a = DList (a:)---- | @since 3.4.0.0-empty :: DList a-empty = DList id--fromList :: [a] -> DList a-fromList as = DList (as ++)--toList :: DList a -> [a]-toList = runDList--snoc :: DList a -> a -> DList a-snoc xs x = xs <> singleton x--instance Monoid (DList a) where-  mempty  = empty-  mappend = (<>)--instance Semigroup (DList a) where-  DList a <> DList b = DList (a . b)

@@ -11,25 +11,13 @@ import qualified Prelude import Distribution.Compat.Prelude -#ifndef mingw32_HOST_OS-#if __GLASGOW_HASKELL__ < 708-import Foreign.C.Error (throwErrnoIf_)-#endif-#endif- import qualified System.Environment as System-import System.Environment (lookupEnv)-#if __GLASGOW_HASKELL__ >= 708-import System.Environment (unsetEnv)-#endif+import System.Environment (lookupEnv, unsetEnv)  import Distribution.Compat.Stack  #ifdef mingw32_HOST_OS import Foreign.C-#if __GLASGOW_HASKELL__ < 708-import Foreign.Ptr (nullPtr)-#endif import GHC.Windows #else import Foreign.C.Types@@ -95,40 +83,3 @@ foreign import ccall unsafe "setenv"    c_setenv :: CString -> CString -> CInt -> Prelude.IO CInt #endif /* mingw32_HOST_OS */--#if __GLASGOW_HASKELL__ < 708---- | @unsetEnv name@ removes the specified environment variable from the--- environment of the current process.------ Throws `Control.Exception.IOException` if @name@ is the empty string or--- contains an equals sign.------ @since 4.7.0.0-unsetEnv :: String -> IO ()-#ifdef mingw32_HOST_OS-unsetEnv key = withCWString key $ \k -> do-  success <- c_SetEnvironmentVariable k nullPtr-  unless success $ do-    -- We consider unsetting an environment variable that does not exist not as-    -- an error, hence we ignore eRROR_ENVVAR_NOT_FOUND.-    err <- c_GetLastError-    unless (err == eRROR_ENVVAR_NOT_FOUND) $ do-      throwGetLastError "unsetEnv"--eRROR_ENVVAR_NOT_FOUND :: DWORD-eRROR_ENVVAR_NOT_FOUND = 203--foreign import WINDOWS_CCONV unsafe "windows.h GetLastError"-    c_GetLastError:: IO DWORD-#else-unsetEnv key = withFilePath key (throwErrnoIf_ (/= 0) "unsetEnv" . c_unsetenv)-#if __GLASGOW_HASKELL__ > 706-foreign import ccall unsafe "__hsbase_unsetenv" c_unsetenv :: CString -> Prelude.IO CInt-#else--- HACK: We hope very hard that !UNSETENV_RETURNS_VOID-foreign import ccall unsafe "unsetenv" c_unsetenv :: CString -> Prelude.IO CInt-#endif-#endif--#endif

@@ -1,37 +0,0 @@-{-# LANGUAGE CPP #-}-module Distribution.Compat.Exception (-  catchIO,-  catchExit,-  tryIO,-  displayException,-  ) where--#ifdef MIN_VERSION_base-#define MINVER_base_48 MIN_VERSION_base(4,8,0)-#else-#define MINVER_base_48 (__GLASGOW_HASKELL__ >= 710)-#endif--import System.Exit-import qualified Control.Exception as Exception--#if MINVER_base_48-import Control.Exception (displayException)-#endif---- | Try 'IOException'.-tryIO :: IO a -> IO (Either Exception.IOException a)-tryIO = Exception.try---- | Catch 'IOException'.-catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a-catchIO = Exception.catch---- | Catch 'ExitCode'-catchExit :: IO a -> (ExitCode -> IO a) -> IO a-catchExit = Exception.catch--#if !MINVER_base_48-displayException :: Exception.Exception e => e -> String-displayException = show-#endif

@@ -1,408 +0,0 @@-{-# LANGUAGE BangPatterns         #-}-{-# LANGUAGE CPP                  #-}-{-# LANGUAGE DeriveDataTypeable   #-}-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module      :  Distribution.Compat.Graph--- Copyright   :  (c) Edward Z. Yang 2016--- License     :  BSD3------ Maintainer  :  cabal-dev@haskell.org--- Stability   :  experimental--- Portability :  portable------ A data type representing directed graphs, backed by "Data.Graph".--- It is strict in the node type.------ This is an alternative interface to "Data.Graph".  In this interface,--- nodes (identified by the 'IsNode' type class) are associated with a--- key and record the keys of their neighbors.  This interface is more--- convenient than 'Data.Graph.Graph', which requires vertices to be--- explicitly handled by integer indexes.------ The current implementation has somewhat peculiar performance--- characteristics.  The asymptotics of all map-like operations mirror--- their counterparts in "Data.Map".  However, to perform a graph--- operation, we first must build the "Data.Graph" representation, an--- operation that takes /O(V + E log V)/.  However, this operation can--- be amortized across all queries on that particular graph.------ Some nodes may be broken, i.e., refer to neighbors which are not--- stored in the graph.  In our graph algorithms, we transparently--- ignore such edges; however, you can easily query for the broken--- vertices of a graph using 'broken' (and should, e.g., to ensure that--- a closure of a graph is well-formed.)  It's possible to take a closed--- subset of a broken graph and get a well-formed graph.-----------------------------------------------------------------------------------module Distribution.Compat.Graph (-    -- * Graph type-    Graph,-    IsNode(..),-    -- * Query-    null,-    size,-    member,-    lookup,-    -- * Construction-    empty,-    insert,-    deleteKey,-    deleteLookup,-    -- * Combine-    unionLeft,-    unionRight,-    -- * Graph algorithms-    stronglyConnComp,-    SCC(..),-    cycles,-    broken,-    neighbors,-    revNeighbors,-    closure,-    revClosure,-    topSort,-    revTopSort,-    -- * Conversions-    -- ** Maps-    toMap,-    -- ** Lists-    fromDistinctList,-    toList,-    keys,-    -- ** Sets-    keysSet,-    -- ** Graphs-    toGraph,-    -- * Node type-    Node(..),-    nodeValue,-) where--import Distribution.Compat.Prelude hiding (empty, lookup, null, toList)-import Prelude ()--import Data.Array                    ((!))-import Data.Graph                    (SCC (..))-import Distribution.Utils.Structured (Structure (..), Structured (..))--import qualified Data.Array                  as Array-import qualified Data.Foldable               as Foldable-import qualified Data.Graph                  as G-import qualified Data.Map.Strict             as Map-import qualified Data.Set                    as Set-import qualified Data.Tree                   as Tree-import qualified Distribution.Compat.Prelude as Prelude---- | A graph of nodes @a@.  The nodes are expected to have instance--- of class 'IsNode'.-data Graph a-    = Graph {-        graphMap          :: !(Map (Key a) a),-        -- Lazily cached graph representation-        graphForward      :: G.Graph,-        graphAdjoint      :: G.Graph,-        graphVertexToNode :: G.Vertex -> a,-        graphKeyToVertex  :: Key a -> Maybe G.Vertex,-        graphBroken       :: [(a, [Key a])]-    }-    deriving (Typeable)---- NB: Not a Functor! (or Traversable), because you need--- to restrict Key a ~ Key b.  We provide our own mapping--- functions.---- General strategy is most operations are deferred to the--- Map representation.--instance Show a => Show (Graph a) where-    show = show . toList--instance (IsNode a, Read a, Show (Key a)) => Read (Graph a) where-    readsPrec d s = map (\(a,r) -> (fromDistinctList a, r)) (readsPrec d s)--instance (IsNode a, Binary a, Show (Key a)) => Binary (Graph a) where-    put x = put (toList x)-    get = fmap fromDistinctList get--instance Structured a => Structured (Graph a) where-    structure p = Nominal (typeRep p) 0 "Graph" [structure (Proxy :: Proxy a)]--instance (Eq (Key a), Eq a) => Eq (Graph a) where-    g1 == g2 = graphMap g1 == graphMap g2--instance Foldable.Foldable Graph where-    fold = Foldable.fold . graphMap-    foldr f z = Foldable.foldr f z . graphMap-    foldl f z = Foldable.foldl f z . graphMap-    foldMap f = Foldable.foldMap f . graphMap-    foldl' f z = Foldable.foldl' f z . graphMap-    foldr' f z = Foldable.foldr' f z . graphMap-#ifdef MIN_VERSION_base-#if MIN_VERSION_base(4,8,0)-    length = Foldable.length . graphMap-    null   = Foldable.null   . graphMap-    toList = Foldable.toList . graphMap-    elem x = Foldable.elem x . graphMap-    maximum = Foldable.maximum . graphMap-    minimum = Foldable.minimum . graphMap-    sum     = Foldable.sum     . graphMap-    product = Foldable.product . graphMap-#endif-#endif--instance (NFData a, NFData (Key a)) => NFData (Graph a) where-    rnf Graph {-        graphMap = m,-        graphForward = gf,-        graphAdjoint = ga,-        graphVertexToNode = vtn,-        graphKeyToVertex = ktv,-        graphBroken = b-    } = gf `seq` ga `seq` vtn `seq` ktv `seq` b `seq` rnf m---- TODO: Data instance?---- | The 'IsNode' class is used for datatypes which represent directed--- graph nodes.  A node of type @a@ is associated with some unique key of--- type @'Key' a@; given a node we can determine its key ('nodeKey')--- and the keys of its neighbors ('nodeNeighbors').-class Ord (Key a) => IsNode a where-    type Key a-    nodeKey :: a -> Key a-    nodeNeighbors :: a -> [Key a]--instance (IsNode a, IsNode b, Key a ~ Key b) => IsNode (Either a b) where-    type Key (Either a b) = Key a-    nodeKey (Left x)  = nodeKey x-    nodeKey (Right x) = nodeKey x-    nodeNeighbors (Left x)  = nodeNeighbors x-    nodeNeighbors (Right x) = nodeNeighbors x---- | A simple, trivial data type which admits an 'IsNode' instance.-data Node k a = N a k [k]-    deriving (Show, Eq)---- | Get the value from a 'Node'.-nodeValue :: Node k a -> a-nodeValue (N a _ _) = a--instance Functor (Node k) where-    fmap f (N a k ks) = N (f a) k ks--instance Ord k => IsNode (Node k a) where-    type Key (Node k a) = k-    nodeKey (N _ k _) = k-    nodeNeighbors (N _ _ ks) = ks---- TODO: Maybe introduce a typeclass for items which just--- keys (so, Key associated type, and nodeKey method).  But--- I didn't need it here, so I didn't introduce it.---- Query---- | /O(1)/. Is the graph empty?-null :: Graph a -> Bool-null = Map.null . toMap---- | /O(1)/. The number of nodes in the graph.-size :: Graph a -> Int-size = Map.size . toMap---- | /O(log V)/. Check if the key is in the graph.-member :: IsNode a => Key a -> Graph a -> Bool-member k g = Map.member k (toMap g)---- | /O(log V)/. Lookup the node at a key in the graph.-lookup :: IsNode a => Key a -> Graph a -> Maybe a-lookup k g = Map.lookup k (toMap g)---- Construction---- | /O(1)/. The empty graph.-empty :: IsNode a => Graph a-empty = fromMap Map.empty---- | /O(log V)/. Insert a node into a graph.-insert :: IsNode a => a -> Graph a -> Graph a-insert !n g = fromMap (Map.insert (nodeKey n) n (toMap g))---- | /O(log V)/. Delete the node at a key from the graph.-deleteKey :: IsNode a => Key a -> Graph a -> Graph a-deleteKey k g = fromMap (Map.delete k (toMap g))---- | /O(log V)/. Lookup and delete.  This function returns the deleted--- value if it existed.-deleteLookup :: IsNode a => Key a -> Graph a -> (Maybe a, Graph a)-deleteLookup k g =-    let (r, m') = Map.updateLookupWithKey (\_ _ -> Nothing) k (toMap g)-    in (r, fromMap m')---- Combining---- | /O(V + V')/. Right-biased union, preferring entries--- from the second map when conflicts occur.--- @'nodeKey' x = 'nodeKey' (f x)@.-unionRight :: IsNode a => Graph a -> Graph a -> Graph a-unionRight g g' = fromMap (Map.union (toMap g') (toMap g))---- | /O(V + V')/. Left-biased union, preferring entries from--- the first map when conflicts occur.-unionLeft :: IsNode a => Graph a -> Graph a -> Graph a-unionLeft = flip unionRight---- Graph-like operations---- | /Ω(V + E)/. Compute the strongly connected components of a graph.--- Requires amortized construction of graph.-stronglyConnComp :: Graph a -> [SCC a]-stronglyConnComp g = map decode forest-  where-    forest = G.scc (graphForward g)-    decode (Tree.Node v [])-        | mentions_itself v = CyclicSCC  [graphVertexToNode g v]-        | otherwise         = AcyclicSCC (graphVertexToNode g v)-    decode other = CyclicSCC (dec other [])-        where dec (Tree.Node v ts) vs-                = graphVertexToNode g v : foldr dec vs ts-    mentions_itself v = v `elem` (graphForward g ! v)--- Implementation copied from 'stronglyConnCompR' in 'Data.Graph'.---- | /Ω(V + E)/. Compute the cycles of a graph.--- Requires amortized construction of graph.-cycles :: Graph a -> [[a]]-cycles g = [ vs | CyclicSCC vs <- stronglyConnComp g ]---- | /O(1)/.  Return a list of nodes paired with their broken--- neighbors (i.e., neighbor keys which are not in the graph).--- Requires amortized construction of graph.-broken :: Graph a -> [(a, [Key a])]-broken g = graphBroken g---- | Lookup the immediate neighbors from a key in the graph.--- Requires amortized construction of graph.-neighbors :: Graph a -> Key a -> Maybe [a]-neighbors g k = do-    v <- graphKeyToVertex g k-    return (map (graphVertexToNode g) (graphForward g ! v))---- | Lookup the immediate reverse neighbors from a key in the graph.--- Requires amortized construction of graph.-revNeighbors :: Graph a -> Key a -> Maybe [a]-revNeighbors g k = do-    v <- graphKeyToVertex g k-    return (map (graphVertexToNode g) (graphAdjoint g ! v))---- | Compute the subgraph which is the closure of some set of keys.--- Returns @Nothing@ if one (or more) keys are not present in--- the graph.--- Requires amortized construction of graph.-closure :: Graph a -> [Key a] -> Maybe [a]-closure g ks = do-    vs <- traverse (graphKeyToVertex g) ks-    return (decodeVertexForest g (G.dfs (graphForward g) vs))---- | Compute the reverse closure of a graph from some set--- of keys.  Returns @Nothing@ if one (or more) keys are not present in--- the graph.--- Requires amortized construction of graph.-revClosure :: Graph a -> [Key a] -> Maybe [a]-revClosure g ks = do-    vs <- traverse (graphKeyToVertex g) ks-    return (decodeVertexForest g (G.dfs (graphAdjoint g) vs))--flattenForest :: Tree.Forest a -> [a]-flattenForest = concatMap Tree.flatten--decodeVertexForest :: Graph a -> Tree.Forest G.Vertex -> [a]-decodeVertexForest g = map (graphVertexToNode g) . flattenForest---- | Topologically sort the nodes of a graph.--- Requires amortized construction of graph.-topSort :: Graph a -> [a]-topSort g = map (graphVertexToNode g) $ G.topSort (graphForward g)---- | Reverse topologically sort the nodes of a graph.--- Requires amortized construction of graph.-revTopSort :: Graph a -> [a]-revTopSort g = map (graphVertexToNode g) $ G.topSort (graphAdjoint g)---- Conversions---- | /O(1)/. Convert a map from keys to nodes into a graph.--- The map must satisfy the invariant that--- @'fromMap' m == 'fromList' ('Data.Map.elems' m)@;--- if you can't fulfill this invariant use @'fromList' ('Data.Map.elems' m)@--- instead.  The values of the map are assumed to already--- be in WHNF.-fromMap :: IsNode a => Map (Key a) a -> Graph a-fromMap m-    = Graph { graphMap = m-            -- These are lazily computed!-            , graphForward = g-            , graphAdjoint = G.transposeG g-            , graphVertexToNode = vertex_to_node-            , graphKeyToVertex = key_to_vertex-            , graphBroken = broke-            }-  where-    try_key_to_vertex k = maybe (Left k) Right (key_to_vertex k)--    (brokenEdges, edges)-        = unzip-        $ [ partitionEithers (map try_key_to_vertex (nodeNeighbors n))-          | n <- ns ]-    broke = filter (not . Prelude.null . snd) (zip ns brokenEdges)--    g = Array.listArray bounds edges--    ns              = Map.elems m -- sorted ascending-    vertices        = zip (map nodeKey ns) [0..]-    vertex_map      = Map.fromAscList vertices-    key_to_vertex k = Map.lookup k vertex_map--    vertex_to_node vertex = nodeTable ! vertex--    nodeTable   = Array.listArray bounds ns-    bounds = (0, Map.size m - 1)---- | /O(V log V)/. Convert a list of nodes (with distinct keys) into a graph.-fromDistinctList :: (IsNode a, Show (Key a)) => [a] -> Graph a-fromDistinctList = fromMap-                 . Map.fromListWith (\_ -> duplicateError)-                 . map (\n -> n `seq` (nodeKey n, n))-  where-    duplicateError n = error $ "Graph.fromDistinctList: duplicate key: "-                            ++ show (nodeKey n)---- Map-like operations---- | /O(V)/. Convert a graph into a list of nodes.-toList :: Graph a -> [a]-toList g = Map.elems (toMap g)---- | /O(V)/. Convert a graph into a list of keys.-keys :: Graph a -> [Key a]-keys g = Map.keys (toMap g)---- | /O(V)/. Convert a graph into a set of keys.-keysSet :: Graph a -> Set.Set (Key a)-keysSet g = Map.keysSet (toMap g)---- | /O(1)/. Convert a graph into a map from keys to nodes.--- The resulting map @m@ is guaranteed to have the property that--- @'Prelude.all' (\(k,n) -> k == 'nodeKey' n) ('Data.Map.toList' m)@.-toMap :: Graph a -> Map (Key a) a-toMap = graphMap---- Graph-like operations---- | /O(1)/. Convert a graph into a 'Data.Graph.Graph'.--- Requires amortized construction of graph.-toGraph :: Graph a -> (G.Graph, G.Vertex -> a, Key a -> Maybe G.Vertex)-toGraph g = (graphForward g, graphVertexToNode g, graphKeyToVertex g)