cabal-debian 4.31.7 → 4.31.9

raw patch · 47 files changed

+91/−5762 lines, 47 filesdep −HaXmldep −ListLikedep −bytestringdep ~Cabaldep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: HaXml, ListLike, bytestring, bzlib, network, old-locale, process-extras, regex-compat, template-haskell, time, zlib

Dependency ranges changed: Cabal, base

API changes (from Hackage documentation)

Files

• Tests.hs +4/−2
• cabal-debian.cabal +29/−69
• changelog +0/−1308
• debian-haskell/Debian/Apt/Dependencies.hs +0/−285
• debian-haskell/Debian/Apt/Index.hs +0/−300
• debian-haskell/Debian/Apt/Methods.hs +0/−486
• debian-haskell/Debian/Apt/Package.hs +0/−54
• debian-haskell/Debian/Arch.hs +0/−54
• debian-haskell/Debian/Changes.hs +0/−350
• debian-haskell/Debian/Control.hs +0/−74
• debian-haskell/Debian/Control/ByteString.hs +0/−289
• debian-haskell/Debian/Control/Common.hs +0/−191
• debian-haskell/Debian/Control/Policy.hs +0/−180
• debian-haskell/Debian/Control/String.hs +0/−110
• debian-haskell/Debian/Control/Text.hs +0/−155
• debian-haskell/Debian/Deb.hs +0/−24
• debian-haskell/Debian/Extra/Files.hs +0/−31
• debian-haskell/Debian/GenBuildDeps.hs +0/−329
• debian-haskell/Debian/Loc.hs +0/−23
• debian-haskell/Debian/Pretty.hs +0/−46
• debian-haskell/Debian/Relation.hs +0/−25
• debian-haskell/Debian/Relation/ByteString.hs +0/−30
• debian-haskell/Debian/Relation/Common.hs +0/−132
• debian-haskell/Debian/Relation/String.hs +0/−139
• debian-haskell/Debian/Relation/Text.hs +0/−30
• debian-haskell/Debian/Release.hs +0/−60
• debian-haskell/Debian/Report.hs +0/−87
• debian-haskell/Debian/Sources.hs +0/−171
• debian-haskell/Debian/Time.hs +0/−27
• debian-haskell/Debian/URI.hs +0/−90
• debian-haskell/Debian/UTF8.hs +0/−29
• debian-haskell/Debian/Util/FakeChanges.hs +0/−256
• debian-haskell/Debian/Version.hs +0/−16
• debian-haskell/Debian/Version/ByteString.hs +0/−18
• debian-haskell/Debian/Version/Common.hs +0/−185
• debian-haskell/Debian/Version/Internal.hs +0/−36
• debian-haskell/Debian/Version/String.hs +0/−25
• debian-haskell/Debian/Version/Text.hs +0/−18
• debian/changelog +20/−0
• debian/control +4/−3
• src/Debian/Debianize/DebianName.hs +2/−1
• src/Debian/Debianize/Details.hs +4/−1
• src/Debian/Debianize/Finalize.hs +15/−11
• src/Debian/Debianize/VersionSplits.hs +7/−3
• test-data/artvaluereport-data/output/debian/control +3/−3
• test-data/artvaluereport2/output/debian/control +3/−3
• test-data/creativeprompts/output/debian/control +0/−3

@@ -600,9 +600,11 @@ test7 label =     TestLabel label $     TestCase (do dist <- findBuildDir-                 new <- readProcessWithExitCode "runhaskell" ["--ghc-arg=-package-db=" ++ dist ++ "/package.conf.inplace", "debian/Debianize.hs", "--dry-run", "--native"] ""+                 result <- readProcessWithExitCode "runhaskell" ["--ghc-arg=-package-db=" ++ dist ++ "/package.conf.inplace", "debian/Debianize.hs", "--dry-run", "--native"] ""+                 assertEqual label (ExitSuccess, "Ignored debianization file: debian/cabal-debian.1\nIgnored debianization file: debian/cabal-debian.manpages\nDebianization (dry run):\n  No changes\n\n", "") result+{-                  assertBool label (elem new [(ExitSuccess, "Ignored debianization file: debian/cabal-debian.1\nIgnored debianization file: debian/cabal-debian.manpages\nDebianization (dry run):\n  No changes\n\n", ""),-                                             (ExitSuccess, "Ignored debianization file: debian/cabal-debian.manpages\nIgnored debianization file: debian/cabal-debian.1\nDebianization (dry run):\n  No changes\n\n", "")]))+                                             (ExitSuccess, "Ignored debianization file: debian/cabal-debian.manpages\nIgnored debianization file: debian/cabal-debian.1\nDebianization (dry run):\n  No changes\n\n", "")]) -})  test8 :: String -> Test test8 label =

@@ -1,5 +1,5 @@ Name:           cabal-debian-Version:        4.31.7+Version:        4.31.9 Copyright:      Copyright (c) 2007-2014, David Fox, Jeremy Shaw License:        BSD3 License-File:   LICENSE@@ -16,9 +16,8 @@  For documentation of the executable, run  @cabal-debian --help@, for documentation of the library API follow  the link to the @Debian.Debianize@ module below.-Cabal-Version: >= 1.8+Cabal-Version: >= 1.10 Extra-Source-Files:-  changelog   debian/cabal-debian.1   debian/cabal-debian.install   debian/cabal-debian.manpages@@ -150,11 +149,6 @@   Description: enable the unit test executable (disabled by default because it has a lot of wacky dependencies.)   Default: True -flag local-debian-  Description: Link directly to the source of the debian library-  Default: True-  Manual: True- flag pretty-112   Description: prettyclass was merged into pretty-1.1.2   Default: True@@ -164,6 +158,7 @@   location: https://github.com/ddssff/cabal-debian  Library+  Default-Language: Haskell2010   Hs-Source-Dirs: src   GHC-Options: -Wall -O2   Build-Depends:@@ -172,6 +167,7 @@     Cabal >= 1.18,     containers,     data-default,+    debian >= 3.89,     deepseq,     Diff >= 0.3.1,     directory,@@ -231,85 +227,49 @@     Build-Depends: pretty >= 1.1.2   else     Build-Depends: pretty < 1.1.2, prettyclass-  if flag(local-debian)-    Hs-Source-Dirs: debian-haskell-    Build-Depends:-      bytestring,-      bzlib,-      exceptions,-      HaXml,-      ListLike,-      network,-      network-uri,-      old-locale,-      process-extras,-      regex-compat,-      template-haskell,-      time,-      zlib-    Exposed-Modules:-      Debian.Apt.Dependencies,-      Debian.Apt.Index,-      Debian.Apt.Methods,-      Debian.Apt.Package,-      Debian.Arch,-      Debian.Changes,-      Debian.Control,-      Debian.Control.Common,-      Debian.Control.ByteString,-      Debian.Control.Policy,-      Debian.Control.String,-      Debian.Control.Text,-      Debian.Deb,-      Debian.Extra.Files,-      Debian.GenBuildDeps,-      Debian.Loc,-      Debian.Pretty,-      Debian.Relation,-      Debian.Relation.ByteString,-      Debian.Relation.Common,-      Debian.Relation.String,-      Debian.Relation.Text,-      Debian.Release,-      Debian.Sources,-      Debian.Version,-      Debian.Version.ByteString,-      Debian.Version.Common,-      Debian.Version.String,-      Debian.Version.Text,-      Debian.Report,-      Debian.Time,-      Debian.URI,-      Debian.UTF8,-      Debian.Util.FakeChanges-    Other-Modules:-      Debian.Version.Internal-  else-    Build-depends: debian >= 3.89  Executable cabal-debian+  Default-Language: Haskell2010   Hs-Source-Dirs: .   Main-is: CabalDebian.hs   ghc-options: -threaded -Wall -O2-  Build-Depends: base, cabal-debian, Cabal >= 1.18, lens, mtl, pretty, Unixutils >= 1.53+  Build-Depends:+    base,+    cabal-debian,+    Cabal >= 1.18,+    debian >= 3.89,+    lens,+    mtl,+    pretty,+    Unixutils >= 1.53   if flag(pretty-112)     Build-Depends: pretty >= 1.1.2   else     Build-Depends: pretty < 1.1.2, prettyclass-  if !flag(local-debian)-    Build-Depends: debian >= 3.89  Test-Suite cabal-debian-tests+  Default-Language: Haskell2010   if !flag(tests)     Buildable: False   Type: exitcode-stdio-1.0   Hs-Source-Dirs: .   Main-is: Tests.hs   ghc-options: -threaded -Wall -O2-  Build-Depends: base >= 4.8.1.0, cabal-debian, Cabal >= 1.18, containers, Diff >= 0.3.1, directory, filepath, hsemail, HUnit, lens, process, text+  Build-Depends:+    base < 5,+    cabal-debian,+    Cabal >= 1.16,+    containers,+    debian >= 3.89,+    Diff >= 0.3.1,+    directory,+    filepath,+    hsemail,+    HUnit,+    lens,+    process,+    text   if flag(pretty-112)     Build-Depends: pretty >= 1.1.2   else     Build-Depends: pretty < 1.1.2, prettyclass-  if !flag(local-debian)-    Build-Depends: debian >= 3.89

@@ -1,1308 +0,0 @@-haskell-cabal-debian (4.31.6) unstable; urgency=low--  * Signature change in Debian.Version.parseDebianVersion-- -- David Fox <dsf@seereason.com>  Tue, 22 Sep 2015 06:56:28 -0700--haskell-cabal-debian (4.31.5) unstable; urgency=low--  * If there is no Setup.hs or Setup.lhs file we cannot build-    debian/hlibrary.setup, therefore we should set DEB_SETUP_BIN_NAME to-    "cabal".-- -- David Fox <dsf@seereason.com>  Thu, 17 Sep 2015 08:21:46 -0700--haskell-cabal-debian (4.31.4) unstable; urgency=low--  * The test suite was failing during the debian package build because-    it assumes the buildDir is in dist/, look for it in dist-ghc/ first.-- -- David Fox <dsf@seereason.com>  Sat, 22 Aug 2015 07:56:04 -0700--haskell-cabal-debian (4.31.3) unstable; urgency=low--  * Fix error message formatting (Joachim Breitner)-  * Fix test suite result code (Joachim Breitner)-- -- David Fox <dsf@seereason.com>  Fri, 21 Aug 2015 17:29:57 -0700--haskell-cabal-debian (4.31.2) unstable; urgency=low--  * Fix some names in Extra-Source-Files and add some missing ones.-- -- David Fox <dsf@seereason.com>  Thu, 20 Aug 2015 16:01:40 -0700--haskell-cabal-debian (4.31.1) unstable; urgency=low--  * Map the cabal library Cabal library to the debian library packages-    libghc-cabal-dev et. al.-- -- David Fox <dsf@seereason.com>  Thu, 20 Aug 2015 15:48:59 -0700--haskell-cabal-debian (4.31) unstable; urgency=low--  * Add some mappings from cabal build tools to debian package names:-    ghc -> ghc, alex -> alex, happy -> happy-  * Support Multi-Arch field in binaries (Joachim Breitner)-  * Implement --roundtrip option (Joachim Breitner)-  * Fixes for changelog entry formatting (Joachim Breitner)-  * Fixes for License field of debian/copyright (Joachim Breitner)-  * Only depend on ghc-doc if the package builds a library-  * New mode of operation --upgrade-  * No -prof and -doc package dependencies for binary and test suite packages-- -- David Fox <dsf@seereason.com>  Thu, 20 Aug 2015 14:31:28 -0700--haskell-cabal-debian (4.30.2) unstable; urgency=low--  * have runDebianizeScript look for source in src/ as well as ./-- -- David Fox <dsf@seereason.com>  Sat, 08 Aug 2015 08:04:02 -0700--haskell-cabal-debian (4.30.1) unstable; urgency=low--  * Make sure apache configuration files end with .conf-- -- David Fox <dsf@seereason.com>  Mon, 29 Jun 2015 10:27:47 -0700--haskell-cabal-debian (4.30) unstable; urgency=low--  * Remove mechanism to pass arguments via the CABALDEBIAN environment-    variable.-  * Make compareDebianization a pure function.-  * Remove MonadIO superclass from some functions-- -- David Fox <dsf@seereason.com>  Thu, 18 Jun 2015 09:12:59 -0700--haskell-cabal-debian (4.29.3) unstable; urgency=low--  * Fix escaping of wildcard characters that are not meaningful in cabal (i.e. square brackets)-  * Fix generation of argument list when running an external debian/Debianization.hs script-    (the whole thing was being repeated.)-  * Make sure the enable tests and run tests options are handled correctly (not sure they were-    wrong, but pretty sure they're now right.)-  * Export Dmitry's performDebianization function instead of debianize in Debian.Debianize.-- -- David Fox <dsf@seereason.com>  Sat, 13 Jun 2015 05:24:03 -0700--haskell-cabal-debian (4.29) unstable; urgency=low--  * Restore the --epoch-map, --cabal-flag, --ghcjs, and --buildenvdir options-  * Export parseProgramArguments' for parsing internally constructed-    argument lists.-- -- David Fox <dsf@seereason.com>  Mon, 08 Jun 2015 06:37:25 -0700--haskell-cabal-debian (4.28) unstable; urgency=low--  * New command line parsing code from Dmitry Bogatov-  * Drop support for old package old package formats-  * Bug fixes and typos, API simplification, more-- -- David Fox <dsf@seereason.com>  Wed, 13 May 2015 06:49:04 -0700--haskell-cabal-debian (4.27.2) unstable; urgency=low--  * Change to the contents of the init.d file created for server packages.-    In Debian.Debianize.Goodies.serverAtoms, insert a line into the init.d-    script to set the datadir environment variable to /usr/share/cabalname-    before startup.-- -- David Fox <dsf@seereason.com>  Wed, 22 Apr 2015 10:25:52 -0700--haskell-cabal-debian (4.27.1) unstable; urgency=low--  * Fix spurious "Just" in debian/copyright file.-- -- David Fox <dsf@seereason.com>  Tue, 21 Apr 2015 07:01:35 -0700--haskell-cabal-debian (4.27) unstable; urgency=low--  * Remove all vestiges of the old data-lens package.  Thanks to-    Dmitry Bogatov for help with this.-- -- David Fox <dsf@seereason.com>  Fri, 17 Apr 2015 15:01:27 -0700--haskell-cabal-debian (4.26) unstable; urgency=low--  * Revamp the way the final debian version number is computed in-    Debian.Debianize.Finalize.debianVersion.-- -- David Fox <dsf@seereason.com>  Sun, 05 Apr 2015 10:49:33 -0700--haskell-cabal-debian (4.25) unstable; urgency=low--  * Make sure /proc is mounted when we run ghc to determine its version-    number.  This is only a concern when running in a build root.-  * Fix whitespace handling bugs in copyright file parser and renderer.-- -- David Fox <dsf@seereason.com>  Sun, 05 Apr 2015 08:14:09 -0700--haskell-cabal-debian (4.24.9) unstable; urgency=low--  * Make debian/Debianize.hs a standard debianization script-  * Make the test executable into a cabal test suite-  * Make ghc-7.10 support official-  * Simplify main in CabalDebian.hs-  * Get rid of old --substvars option-- -- David Fox <dsf@seereason.com>  Wed, 01 Apr 2015 10:00:45 -0700--haskell-cabal-debian (4.24.8) unstable; urgency=low--  * use ghcjs --numeric-ghc-version to set the compilerInfoCompat field-    of CompilerInfo.  This makes cabal file directives like impl(ghc >= 7.9)-    work for ghcjs packages.-- -- David Fox <dsf@seereason.com>  Sun, 29 Mar 2015 12:38:33 -0700--haskell-cabal-debian (4.24.7) unstable; urgency=low--  * Remove the Data.Algorithm.Diff modules, they have moved into Diff-0.3.1-- -- David Fox <dsf@seereason.com>  Tue, 24 Mar 2015 16:51:29 -0700--haskell-cabal-debian (4.24.6) unstable; urgency=low--  * Use build dependency haskell-devscripts >= 0.8 for unofficial, >= 0.9-    for official.-  * Straighten out the test suite options: --no-tests, --no-run-tests-- -- David Fox <dsf@seereason.com>  Mon, 23 Mar 2015 11:31:14 -0700--haskell-cabal-debian (4.24.5) unstable; urgency=low--  * Patch from Dmitry Bogatov for filling in debian/copyright fields-  * Patch from Dmitry Bogatov for debhelper and haskell-devscripts build deps-  * Patch from Dmitry Bogatov for default changelog message-  * Add a --no-run-tests flag to control the nocheck option-  * Compatibility with different GHC versions-- -- David Fox <dsf@seereason.com>  Sat, 21 Mar 2015 10:14:48 -0700--haskell-cabal-debian (4.24.3) unstable; urgency=low--  * Always include the test suite build dependencies in debian/control,-    even if the testEnabled flag is set to False (at the moment it seems-    as if it always is.)-- -- David Fox <dsf@seereason.com>  Mon, 02 Mar 2015 17:33:52 -0800--haskell-cabal-debian (4.24.2) unstable; urgency=low--  * Distinguish between the place we find the data files (dataTop) and the-    place we put then (dataDest)-  * Add a case for the ISC license-- -- David Fox <dsf@seereason.com>  Sun, 22 Feb 2015 15:09:56 -0800--haskell-cabal-debian (4.24.1) unstable; urgency=low--  * Don't assign the name "cabal-ghcjs" to newer Cabal library versions-- -- David Fox <dsf@seereason.com>  Sun, 22 Feb 2015 06:08:28 -0800--haskell-cabal-debian (4.24) unstable; urgency=low--  * Convert from old data-lens package to lens.-  * Implement --allow-debian-self-build-deps-- -- David Fox <dsf@seereason.com>  Sat, 14 Feb 2015 06:15:01 -0800--haskell-cabal-debian (4.23.1) unstable; urgency=low--  * ifdefs for Cabal-1.18, 1.20, and 1.22, ghc-7.6, and 7.8.-- -- David Fox <dsf@seereason.com>  Sun, 08 Feb 2015 23:21:07 -0800--haskell-cabal-debian (4.23) unstable; urgency=low--  * Add DEB_ENABLE_TESTS = yes to rules file when appropriate-  * Add test suite build dependencies when appropriate-  * Add --no-test-suite option-  * Add --allow-debian-self-build-deps-  * Filter out self dependencies in the debian package space, not the-    cabal package space.-  * Fix generation of machine readable debian/copyright files-  * Use the homepage value found in the cabal file-  * Add travis build file-- -- David Fox <dsf@seereason.com>  Fri, 06 Feb 2015 06:25:08 -0800--haskell-cabal-debian (4.22) unstable; urgency=low--  * Big module reorganization for more type safety.-- -- David Fox <dsf@seereason.com>  Tue, 03 Feb 2015 13:22:29 -0800--haskell-cabal-debian (4.21.1) unstable; urgency=low--  * Fix --buildenvdir command line option.-  * Add an option for cabal flags-- -- David Fox <dsf@seereason.com>  Fri, 30 Jan 2015 13:46:08 -0800--haskell-cabal-debian (4.21) unstable; urgency=low--  * Split the enormous Atoms record into three layers - the innermost is-    Flags, which contains information obtained from the command line-    arguments.  Flags is also the argument to the inputCabalization-    function, which inputs a Cabal PackageDescription.  The Flags record-    is embedded in a DebInfo, which holds information related to the-    Debianization only.  The DebInfo and the PackageDescription are used-    to build the old Atoms record.  DebInfo is the state value of the-    DebianT monad, while Atoms is the state value of the CabalT monad.--    The point of all this is to ensure that a PackageDescription exists-    before we start converting the Cabalization to a Debianization.-- -- David Fox <dsf@seereason.com>  Thu, 29 Jan 2015 12:29:52 -0800--haskell-cabal-debian (4.20.2) unstable; urgency=low--  * Do not lowercase the package name when constructing the data file-    destination directory (/usr/share/<packagename>).-- -- David Fox <dsf@seereason.com>  Fri, 16 Jan 2015 05:45:23 -0800--haskell-cabal-debian (4.20.1) unstable; urgency=low--  * Fix a bug in the computation of the debian maintainer field-  * Improve rules file generation-- -- David Fox <dsf@seereason.com>  Wed, 14 Jan 2015 14:38:56 -0800--haskell-cabal-debian (4.20) unstable; urgency=low--  * Add a --source-section option-  * Fix handling of debian maintainer and debian uploaders-  * Improve formatting of debian/rules file-  * Rename function debianization -> debianize-  * Rename function finalizeDebianization' -> finalizeDebianization-  * Rename function getDebianMaintainer -> getCurrentDebianUser-- -- David Fox <dsf@seereason.com>  Fri, 09 Jan 2015 11:49:04 -0800--haskell-cabal-debian (4.19.3) unstable; urgency=low--  * Fix issue #23, so that if you run 'cabal-debian' and then-    'cabal-debian --compare' it says there are no differences.-  * Fix issue #16 - set revision if format is Quilt3.-- -- David Fox <dsf@seereason.com>  Thu, 08 Jan 2015 05:20:32 -0800--haskell-cabal-debian (4.19.2) unstable; urgency=low--  * Use canonical to put the debianization in a standard form before-    trying to compare existing and generated.-  * Fix bug where cabal-debian program processed the command line options-    twice.-  * Avoid using paths that point to ../ in the cabal file (even if-    disabled by a flag), it causes the package to be rejected by hackage.-- -- David Fox <dsf@seereason.com>  Wed, 07 Jan 2015 13:26:33 -0800--haskell-cabal-debian (4.19.1) unstable; urgency=low--  * Support Cabal-1.22-  * Test whether apt-file is installed (from creichert)-  * Conditional compilation for new symbols MPL and BSD2 (from creichert)-- -- David Fox <dsf@seereason.com>  Wed, 07 Jan 2015 12:56:00 -0800--haskell-cabal-debian (4.19) unstable; urgency=low--  * Add remapCabal function here from a private package-  * Remove debianVersionSplits, which has long been replaced by-    debianDefaultAtoms.-- -- David Fox <dsf@seereason.com>  Mon, 08 Dec 2014 10:07:06 -0800--haskell-cabal-debian (4.18) unstable; urgency=low--  * Add types to support machine readable copyright files.-  * Add --debian-base-name option and overrideDebianBaseName lens.-  * Add --omit-prof-version-deps option flag, have --official imply it-- -- David Fox <dsf@seereason.com>  Thu, 27 Nov 2014 07:11:35 -0800--haskell-cabal-debian (4.17.5) unstable; urgency=low--  * Use the prettyclass package and the PP wrappers in the latest-    debian package to do pretty printing.-  * Change default priority to extra-  * Use the new watch file suggested by nomeata-  * Use the control file template suggested in issue #3-- -- David Fox <dsf@seereason.com>  Mon, 15 Sep 2014 13:28:36 -0700--haskell-cabal-debian (4.17.4) unstable; urgency=low--  * Add missing ifdefs to hide the GHCJS constructor when ghcjs-support-    flag is False.-  * Require Cabal < 1.21 when ghcjs-support flag is False.-- -- David Fox <dsf@seereason.com>  Tue, 02 Sep 2014 09:06:20 -0700--haskell-cabal-debian (4.17.3) unstable; urgency=low--  * Moved source repository to github.com.-- -- David Fox <dsf@seereason.com>  Fri, 29 Aug 2014 13:55:26 -0700--haskell-cabal-debian (4.17.2) unstable; urgency=low--  * Fix formatting of the generated debian/*.install files.-- -- David Fox <dsf@seereason.com>  Tue, 19 Aug 2014 16:04:27 -0700--haskell-cabal-debian (4.17.1) unstable; urgency=low--  * Fix install of ghcjs executables - there was an extra subdir.-  * Don't append -ghcjs to default package name.-- -- David Fox <dsf@seereason.com>  Tue, 19 Aug 2014 10:15:46 -0700--haskell-cabal-debian (4.17) unstable; urgency=low--  * Fix bug in architecture dependent build dependency generation - it-    was getting the indep dependencies as well.-  * Support GHCJS executable packages, which are directories with the-    extension .jsexe.-- -- David Fox <dsf@seereason.com>  Mon, 18 Aug 2014 17:31:35 -0700--haskell-cabal-debian (4.16.1) unstable; urgency=low--  * Support for packaging libraries produced by the GHCJS compiler.-  * Generate debianizations that include libraries for multiple compiler-    flavors (not yet suppored in haskell-devscripts and/or Cabal.)-  * Put a DEB_DEFAULT_COMPILER assignment in debian/rules if we can-    infer it from the command line options.-- -- David Fox <dsf@seereason.com>  Sat, 16 Aug 2014 07:56:50 -0700--haskell-cabal-debian (4.15.2) unstable; urgency=low--  * Lowercase the strings in the extraLibs argument of allBuildDepends-    before wrapping them in BinPkgName.  Those types, which come from the-    debian package, should be opaque and do this whenever a BinPkgName (or-    SrcPkgName) is created, because upper case is never ok in Debian-    source or binary package names.  In the meantime I will make this-    requested change.  Thanks to Sven Bartscher for pointing this out.-- -- David Fox <dsf@seereason.com>  Tue, 12 Aug 2014 07:47:17 -0700--haskell-cabal-debian (4.15.1) unstable; urgency=low--  * Add Data and Typeable instances.-- -- David Fox <dsf@seereason.com>  Thu, 17 Jul 2014 11:22:17 -0700--haskell-cabal-debian (4.15) unstable; urgency=low--  * Don't hardcode the compiler name in makefile targets.-- -- David Fox <dsf@seereason.com>  Sat, 12 Jul 2014 12:15:10 -0700--haskell-cabal-debian (4.14) unstable; urgency=low--  * Move the code to map the cabal package named "Cabal" to the debian-    package named "libghc-cabal-*" from the seereason defaults to the-    debian defaults.-- -- David Fox <dsf@seereason.com>  Mon, 07 Jul 2014 08:35:39 -0700--haskell-cabal-debian (4.13) unstable; urgency=low--  * Add a flag for ghcjs support.-- -- David Fox <dsf@seereason.com>  Thu, 03 Jul 2014 12:05:21 -0700--haskell-cabal-debian (4.12) unstable; urgency=low--  * Remove the Top type and argument - use getWorkingDirectory instead.-- -- David Fox <dsf@seereason.com>  Sun, 29 Jun 2014 08:11:01 -0700--haskell-cabal-debian (4.11) unstable; urgency=low--  * Use MonadIO instead of IO for all signatures.  This is so-    we can more easily use cabal debian from a Shelly script.-- -- David Fox <dsf@seereason.com>  Sun, 29 Jun 2014 07:16:45 -0700--haskell-cabal-debian (4.10.1) unstable; urgency=low--  * Fix a tail exception in builtIn.-- -- David Fox <dsf@seereason.com>  Tue, 17 Jun 2014 07:21:22 -0700--haskell-cabal-debian (4.10) unstable; urgency=low--  * Rename knownVersionSplits -> debianVersionSplits and move to-    Debian.Debianize.Details.  (Should that be renamed-    Debian.Debianize.Debian?)-  * Add HC=ghc or HC=ghcjs to header of debian/rules depending on-    the value of the compilerFlavor atom.-- -- David Fox <dsf@seereason.com>  Sat, 14 Jun 2014 10:20:01 -0700--haskell-cabal-debian (4.9) unstable; urgency=low--  * Generate the library package prefix, previously hard coded as libghc-,-    using the CompilerFlavor value, so we get libghcjs-foo-dev when using-    ghcjs.-- -- David Fox <dsf@seereason.com>  Fri, 13 Jun 2014 09:58:13 -0700--haskell-cabal-debian (4.8) unstable; urgency=low--  * Add a --no-hoogle flag to omit the hoogle documentation link.  This-    link doesn't contain the package's version number, so it will conflict-    with other versions of the library (such as those built into ghc.)-- -- David Fox <dsf@seereason.com>  Tue, 10 Jun 2014 10:42:38 -0700--haskell-cabal-debian (4.7.1) unstable; urgency=low--  * Fix the code added in 4.7.-  * Add --recommends and --suggests options, similar to --depends et. al.-- -- David Fox <dsf@seereason.com>  Tue, 03 Jun 2014 07:14:52 -0700--haskell-cabal-debian (4.7) unstable; urgency=low--  * Improve the treatment of dependencies which are built into ghc.  This-    will allow the use of newer libraries than the ones built into ghc,-    provided they are given deb names that are different than the one ghc-    specifically conflicts with.  For example, a newer version of Cabal-    could be used if it was in the deb package libghc-cabal-ghcjs-dev.  To-    change the debian names of libraries we need to use the mapCabal and-    splitCabal functions, as is done in the autobuilder-seereason module-    Debian.AutoBuilder.Details.Atoms.-- -- David Fox <dsf@seereason.com>  Mon, 02 Jun 2014 14:28:59 -0700--haskell-cabal-debian (4.6.2) unstable; urgency=low--  * Move a seereason specific function from here to the-    autobuilder-seereason package.-- -- David Fox <dsf@seereason.com>  Mon, 02 Jun 2014 11:03:13 -0700--haskell-cabal-debian (4.6.1) unstable; urgency=low--  * Don't compute the current ghc version so often.-- -- David Fox <dsf@seereason.com>  Fri, 30 May 2014 13:40:12 -0700--haskell-cabal-debian (4.6) unstable; urgency=low--  * Add a --default-package option to change haskell-packagename-utils to-    some other name.-  * Fix treatment of cabalfile Data-Dir field - it describes where the-    data files are in the source tree, but shouldn't affect where they will-    be installed.-- -- David Fox <dsf@seereason.com>  Thu, 29 May 2014 08:27:54 -0700--haskell-cabal-debian (4.5) unstable; urgency=low--  * Remove the ghcVersion field and lens.-- -- David Fox <dsf@seereason.com>  Mon, 05 May 2014 11:55:53 -0700--haskell-cabal-debian (4.4) unstable; urgency=low--  * Add the copytruncate directive to logrotate files we generate.-    As things were, hslogger would continue writing to the deleted-    log file after it was rotated.-- -- David Fox <dsf@seereason.com>  Sun, 30 Mar 2014 13:05:48 -0700--haskell-cabal-debian (4.3.2) unstable; urgency=low--  * Speed up debianization by computing the ghc version once when-    we enter the DebT monad rather than repeatedly.  It is slow-    because it needs to chroot.-- -- David Fox <dsf@seereason.com>  Fri, 28 Mar 2014 13:03:57 -0700--haskell-cabal-debian (4.3.1) unstable; urgency=low--  * Safer default value for buildEnv - "/" instead of "".  This is-    where we look for the GHC version number.-- -- David Fox <dsf@seereason.com>  Thu, 27 Mar 2014 06:12:28 -0700--haskell-cabal-debian (4.3) unstable; urgency=low--  * Make the default value for buildEnv "/", this makes it normally look-    at the version number of the ghc compiler installed in the root-    environment.-- -- David Fox <dsf@seereason.com>  Mon, 24 Mar 2014 06:01:49 -0700--haskell-cabal-debian (4.2) unstable; urgency=low--  * Get the GHC compiler version from the build environment, which-    now needs to be explicitly set.-- -- David Fox <dsf@seereason.com>  Fri, 07 Mar 2014 10:58:37 -0800--haskell-cabal-debian (4.1.1) unstable; urgency=low--  * Remove build dependency on ansi-wl-pprint.-  * Split module Debian.Debianize.BuildDependencies out of-    Debian.Debianize.Finalize-- -- David Fox <dsf@seereason.com>  Sun, 02 Feb 2014 07:37:03 -0800--haskell-cabal-debian (4.0.6) unstable; urgency=low--  * Ifdef out duplicate instances for Cabal-1.18.0 - thanks to Tom Nielsen.-- -- David Fox <dsf@seereason.com>  Tue, 28 Jan 2014 17:10:48 -0800--haskell-cabal-debian (4.0.5) unstable; urgency=low--  * Changes for debian-3.81 - use the pretty printer in Debian.Pretty-    instead of ansi-wl-pprint.-- -- David Fox <dsf@seereason.com>  Tue, 14 Jan 2014 05:02:59 -0800--haskell-cabal-debian (4.0.4) unstable; urgency=low--  * Restore the test data, the problem I had with long filenames-    is solved by using cabal sdist to create the tarball rather-    than runhaskell Setup sdist.-- -- David Fox <dsf@seereason.com>  Wed, 18 Dec 2013 09:37:34 -0800--haskell-cabal-debian (4.0.3) unstable; urgency=low--  * Include the build dependencies of the executables in the debian-    source deb build dependencies.-- -- David Fox <dsf@seereason.com>  Tue, 10 Dec 2013 14:37:20 -0800--haskell-cabal-debian (4.0.2) unstable; urgency=low--  * Export some lens state operators from Prelude.-- -- David Fox <dsf@seereason.com>  Tue, 10 Dec 2013 05:38:00 -0800--haskell-cabal-debian (4.0.1) unstable; urgency=low--  * Make sure the utilities package gets created even if no name-    has been specified for it - use the name generated in DebianNames.hs.-- -- David Fox <dsf@seereason.com>  Tue, 10 Dec 2013 05:10:11 -0800--haskell-cabal-debian (4.0.0) unstable; urgency=low--  * Massive lens overhaul-- -- David Fox <dsf@seereason.com>  Thu, 05 Dec 2013 12:26:31 -0800--haskell-cabal-debian (3.10.3) unstable; urgency=low--  * Go back to using lens interface directly-  * Collect debianization fact code in Facts/-- -- David Fox <dsf@seereason.com>  Sun, 24 Nov 2013 10:40:02 -0800--haskell-cabal-debian (3.10.2) unstable; urgency=low--  * Make some signatures in Monad.hs clearer-- -- David Fox <dsf@seereason.com>  Wed, 20 Nov 2013 14:26:28 -0800--haskell-cabal-debian (3.10.1) unstable; urgency=low--  * More API changes - want need to get all the clients in sync before-    proceeding.-- -- David Fox <dsf@seereason.com>  Tue, 19 Nov 2013 11:31:16 -0800--haskell-cabal-debian (3.10) unstable; urgency=low--  * Add a monadic interface-- -- David Fox <dsf@seereason.com>  Sat, 16 Nov 2013 10:42:02 -0800--haskell-cabal-debian (3.9) unstable; urgency=low--  * Clean up documentation-  * Allow more than one utility package name, each of which will-    get copies of the data-files and leftover executables.-  * Make the --debianize option a no-op, the behavior is now the-    default.-  * Update the unit tests and build an executable to run them.-  * Copy debian/changelog to top directory at beginning of build-    so hackage will see it.-- -- David Fox <dsf@seereason.com>  Tue, 05 Nov 2013 11:34:48 -0800--haskell-cabal-debian (3.8.3) unstable; urgency=low--  * Add an ifdef for compatibility with GHC-7.4.1.-- -- David Fox <dsf@seereason.com>  Sun, 20 Oct 2013 15:50:47 -0700--haskell-cabal-debian (3.8.2) unstable; urgency=low--  * Actually, copy changelog from debian/changelog before-    building sdist tarball.-- -- David Fox <dsf@seereason.com>  Tue, 15 Oct 2013 06:42:39 -0700--haskell-cabal-debian (3.8.1) unstable; urgency=low--  * Move changelog top top directory so hackage will see it.-- -- David Fox <dsf@seereason.com>  Tue, 15 Oct 2013 06:24:25 -0700--haskell-cabal-debian (3.8) unstable; urgency=low--  * Downcase the package name to build the datadir name in /usr/share,-    this matches the paths in dist/autogen/Paths_packagename.-- -- David Fox <dsf@seereason.com>  Mon, 14 Oct 2013 20:48:39 -0700--haskell-cabal-debian (3.7) unstable; urgency=low--  * Change path to hackage tarball in watch file for hackage2.-- -- David Fox <dsf@seereason.com>  Fri, 04 Oct 2013 09:22:51 -0700--haskell-cabal-debian (3.6) unstable; urgency=low--  * Require haskell-devscripts >= 0.8.19.  This version changes the-    value of datasubdir from /usr/share/packagename-packageversion to-    simply /usr/share/packagename.  This could break some packaging.-- -- David Fox <dsf@seereason.com>  Fri, 06 Sep 2013 16:48:18 -0700--haskell-cabal-debian (3.5) unstable; urgency=low--  * Allow full lists of debian relations to be passed to the --build-dep-    argument, not just a single package name.-- -- David Fox <dsf@seereason.com>  Sun, 01 Sep 2013 07:08:37 -0700--haskell-cabal-debian (3.4.3) unstable; urgency=low--  * Fix the repository location in the cabal file.-- -- David Fox <dsf@seereason.com>  Sat, 31 Aug 2013 07:57:15 -0700--haskell-cabal-debian (3.4.2) unstable; urgency=low--  * Notify user when debhelper isn't installed.-  * Avoid use of partial function read-- -- David Fox <dsf@seereason.com>  Mon, 24 Jun 2013 13:51:51 -0700--haskell-cabal-debian (3.4.1) unstable; urgency=low--  * Remove call to test script in Setup.hs-  * Remove unused dependencies-- -- David Fox <dsf@seereason.com>  Mon, 10 Jun 2013 09:12:38 -0700--haskell-cabal-debian (3.4) unstable; urgency=low--  * Add support for modifying the Provides and Replaces fields.-- -- David Fox <dsf@seereason.com>  Sun, 09 Jun 2013 14:18:39 -0700--haskell-cabal-debian (3.3.2) unstable; urgency=low--  * Changes for debian-3.71-- -- David Fox <dsf@seereason.com>  Sun, 14 Apr 2013 13:32:04 -0700--haskell-cabal-debian (3.3.1) unstable; urgency=low--  * Don't fail during dry run if the existing debianization has no-    copyright file.-- -- David Fox <dsf@seereason.com>  Wed, 13 Mar 2013 10:00:25 -0700--haskell-cabal-debian (3.3) unstable; urgency=low--  * Add Debian.Debianize.Details, with default Atoms values for Debian and-    SeeReason.-- -- David Fox <dsf@seereason.com>  Mon, 11 Mar 2013 11:44:10 -0700--haskell-cabal-debian (3.2.5) unstable; urgency=low--  * Add move the VersionSplits type into a module, and fix the code that-    splits the mapping of cabal to debian names over a version range.-- -- David Fox <dsf@seereason.com>  Tue, 05 Mar 2013 05:17:03 -0800--haskell-cabal-debian (3.2.4) unstable; urgency=low--  * Fix long standing bug in Debian.Debianize.Interspersed.foldTriples.-- -- David Fox <dsf@seereason.com>  Sun, 03 Mar 2013 09:45:14 -0800--haskell-cabal-debian (3.2.3) unstable; urgency=low--  * Clean up mapping from cabal names to debian names.-- -- David Fox <dsf@seereason.com>  Sat, 02 Mar 2013 07:36:16 -0800--haskell-cabal-debian (3.2.2) unstable; urgency=low--  * Remove unused Debian.Debianize.Generic and Triplets modules.-- -- David Fox <dsf@seereason.com>  Fri, 01 Mar 2013 11:14:33 -0800--haskell-cabal-debian (3.2.1) unstable; urgency=low--  * Do not add the options +RTS -IO -RTS to the server options, this-    is a security risk.  Instead, server executables should built with-    -with-rtsopts=-IO.-- -- David Fox <dsf@seereason.com>  Thu, 28 Feb 2013 09:02:39 -0800--haskell-cabal-debian (3.2) unstable; urgency=low--  * Strip executables when installing (well, at least some.  There-    may be more work to do here.)-  * Change the build dependency type from BinPkgName to Relation, so we-    can specify version dependencies (though as yet not or relations.)-- -- David Fox <dsf@seereason.com>  Tue, 26 Feb 2013 07:17:30 -0800--haskell-cabal-debian (3.1.1) unstable; urgency=low--  * Fix the code in the init file that checks for and sources a-    file in /etc/default.-- -- David Fox <dsf@seereason.com>  Mon, 25 Feb 2013 14:46:02 -0800--haskell-cabal-debian (3.1) unstable; urgency=low--  * Create a Top type to represent the top directory of a debianization-  * Change the signature of Debian.Debianize.debianization so it notices-    command line arguments and environment arguments.-- -- David Fox <dsf@seereason.com>  Fri, 22 Feb 2013 13:28:30 -0800--haskell-cabal-debian (3.0.7) unstable; urgency=low--  * Fix to copyright/license code-  * have the init script load /etc/default/packagename if available-  * Add an alternative function to showCommandForUser (called showCommand)-    that uses double quotes instead of single quotes so you can reference-    shell variables.-- -- David Fox <dsf@seereason.com>  Wed, 20 Feb 2013 09:29:11 -0800--haskell-cabal-debian (3.0.6) unstable; urgency=low--  * When packaging a web site or server, don't add code to the postinst-    to start a server, it gets generated by debhelper.-  * Add the changelog and the Debianize.hs file to extra-source-files.-  * Add HTTP=1 to the list of known epoch mappings.-- -- David Fox <dsf@seereason.com>  Thu, 14 Feb 2013 14:41:17 -0800--haskell-cabal-debian (3.0.5) unstable; urgency=low--  * Compatibility with ghc-7.4-- -- David Fox <dsf@seereason.com>  Wed, 13 Feb 2013 10:48:19 -0800--haskell-cabal-debian (3.0.4) unstable; urgency=low--  * Add dependency on debian-policy, so we can compute the latest-    standards-version.-  * Documentation improvements-  * Test case improvements-  * Error message improvements-- -- David Fox <dsf@seereason.com>  Sun, 10 Feb 2013 11:03:55 -0800--haskell-cabal-debian (3.0.3) unstable; urgency=low--  * Due to a typo, the noDocumentationLibrary lens was turning off-    profiling rather than documentation.-- -- David Fox <dsf@seereason.com>  Fri, 08 Feb 2013 17:14:09 -0800--haskell-cabal-debian (3.0.2) unstable; urgency=low--  * Fix argument and exception handling in cabal-debian-  * Make Standards-Version field non-mandatory-  * Make sure every binary deb paragraph has a non-empty description-- -- David Fox <dsf@seereason.com>  Thu, 07 Feb 2013 10:03:25 -0800--haskell-cabal-debian (3.0.1) unstable; urgency=low--  * Don't build Debian version numbers with revision (Just "").-  * Output the descriptions of the binary packages.-- -- David Fox <dsf@seereason.com>  Tue, 05 Feb 2013 14:48:33 -0800--haskell-cabal-debian (3.0) unstable; urgency=low--  * Moved the Distribution.Debian modules to Debian.Cabal and-    Debian.Debianize.-  * Refactored the debianize function for easier testing-  * Added test cases.-  * Add a Debianization type that intends to fully describe a debian-    package, with functions to read, build, modify, and write a-    Debianization.-- -- David Fox <dsf@seereason.com>  Wed, 26 Dec 2012 05:45:35 -0800--haskell-cabal-debian (2.6.3) unstable; urgency=low--  * Fix pretty printing of Relations (i.e. dependency lists.)  There-    is an instance for printing lists in ansi-wl-pprint which prevents-    us from writing customized Pretty instances for type aliases like-    Relations, AndRelation, and OrRelation.-- -- David Fox <dsf@seereason.com>  Fri, 04 Jan 2013 09:30:48 -0800--haskell-cabal-debian (2.6.2) unstable; urgency=low--  * Fix a bug constructing the destination pathnames that was dropping-    files that were supposed to be installed into packages.-- -- David Fox <dsf@seereason.com>  Thu, 20 Dec 2012 06:49:25 -0800--haskell-cabal-debian (2.6.1) unstable; urgency=low--  * Remove the modifyAtoms field from the Flags record, we want to-    be able to create instances like Read and Show for this type.-    The modifyAtoms function is now passed separately to debianize.-  * The flags field of Server was renamed serverFlags because the-    newly exported Config record has a flags field.-- -- David Fox <dsf@seereason.com>  Wed, 19 Dec 2012 09:45:22 -0800--haskell-cabal-debian (2.5.10) unstable; urgency=low--  * Filter cabal self dependencies out before generating-    Build-Depends-Indep, just as we added code to filter them out-    of Build-Depends in version 2.5.7.-- -- David Fox <dsf@seereason.com>  Tue, 18 Dec 2012 13:23:39 -0800--haskell-cabal-debian (2.5.9) unstable; urgency=low--  * Always add +RTS -IO -RTS to server flags.-- -- David Fox <dsf@seereason.com>  Sun, 16 Dec 2012 10:40:52 -0800--haskell-cabal-debian (2.5.8) unstable; urgency=low--  * Add a builtin list for ghc-7.6.1.-- -- David Fox <dsf@seereason.com>  Sat, 15 Dec 2012 07:04:49 -0800--haskell-cabal-debian (2.5.7) unstable; urgency=low--  * Filter out cabal self-dependencies before building the debian-    dependencies.  In cabal a self dependency means you need the library-    to build an executable, while in debian it means you need an older-    version installed to build the current version.-- -- David Fox <dsf@seereason.com>  Thu, 29 Nov 2012 08:42:30 -0800--haskell-cabal-debian (2.5.6) unstable; urgency=low--  * Don't add --base-uri and --http-port arguments automatically, they can be-    computed by calling the oldClckwrksFlags function and adding the value to-    the flags field.  Clckwrks-0.3 no longer needs the --base-uri argument.-- -- David Fox <dsf@seereason.com>  Tue, 27 Nov 2012 13:34:31 -0800--haskell-cabal-debian (2.5.5) unstable; urgency=low--  * Have the debianize function return False if there is no debian/Debianize.hs file,-    but throw an exception if running it failed, so we notice bad debianization code.-- -- David Fox <dsf@seereason.com>  Tue, 27 Nov 2012 07:34:51 -0800--haskell-cabal-debian (2.5.4) unstable; urgency=low--  * Insert "SetEnv proxy-sendcl 1" line into Apache config.-- -- David Fox <dsf@seereason.com>  Tue, 20 Nov 2012 13:43:54 -0800--haskell-cabal-debian (2.5.3) unstable; urgency=low--  * Remove extra copy of binary from the executable debs-  * Add a sourcePackageName field to Flags, and a --source-package-name-    command line option.-- -- David Fox <dsf@seereason.com>  Sat, 17 Nov 2012 00:16:21 -0800--haskell-cabal-debian (2.5.2) unstable; urgency=low--  * Fix the path to where the DHInstallTo and DHInstallCabalExecTo-    DebAtoms put their files.-- -- David Fox <dsf@seereason.com>  Fri, 16 Nov 2012 18:11:45 -0800--haskell-cabal-debian (2.5.1) unstable; urgency=low--  * Add a destName field to Executable so we can give installed-    executables a different name than they had in the build.-- -- David Fox <dsf@seereason.com>  Fri, 16 Nov 2012 15:37:16 -0800--haskell-cabal-debian (2.5) unstable; urgency=low--  * Add a debName field to the Executable record, before the deb-    package name had to equal the executable name.-- -- David Fox <dsf@seereason.com>  Fri, 16 Nov 2012 12:32:39 -0800--haskell-cabal-debian (2.4.2) unstable; urgency=low--  * Move location of cabal install files from dist/build/install to-    debian/cabalInstall, the dist directory was getting wiped at bad-    moments.-  * Split the autobuilder function autobuilderDebianize into two-    new functions in cabal-debian: runDebianize and callDebianize.-  * Custom debianization code now goes in debian/Debianize.hs rather than-    in setup, so we can distinguish it failing from it not existing more-    easily.-- -- David Fox <dsf@seereason.com>  Thu, 15 Nov 2012 11:00:08 -0800--haskell-cabal-debian (2.4.1) unstable; urgency=low--  * We need to verify that debian/compat was created after running the-    debianize function, because ghc still exits with ExitSuccess-- -- David Fox <dsf@seereason.com>  Thu, 15 Nov 2012 06:34:02 -0800--haskell-cabal-debian (2.4.0) unstable; urgency=low--  * You can run a function in Setup.hs other than main using ghc -e, so we-    will use this trick to run the debianize function directly rather than-    running main.-  * Eliminate the autobuilderDebianize function.-- -- David Fox <dsf@seereason.com>  Thu, 15 Nov 2012 04:05:49 -0800--haskell-cabal-debian (2.3.4) unstable; urgency=low--  * Fix the builddir used when running the cabal-debian standalone-    executable - it was dist-cabal/build, so the resulting debianization-    had files in places where cabal didn't expect them.-- -- David Fox <dsf@seereason.com>  Tue, 13 Nov 2012 06:20:51 -0800--haskell-cabal-debian (2.3.3) unstable; urgency=low--  * Eliminate class MonadBuild and the BuildT monad.-- -- David Fox <dsf@seereason.com>  Sun, 11 Nov 2012 17:46:31 -0800--haskell-cabal-debian (2.3.2) unstable; urgency=low--  * Fix exception that was keeping changelogs from being preserved.-- -- David Fox <dsf@seereason.com>  Sat, 10 Nov 2012 10:07:50 -0800--haskell-cabal-debian (2.3.1) unstable; urgency=low--  * Fix the extension of the debhelper links files-  * Add a general mechanism for installing a file into a deb when-    we have the file's text in a String (rather than in a file.)-- -- David Fox <dsf@seereason.com>  Sat, 10 Nov 2012 07:35:09 -0800--haskell-cabal-debian (2.3) unstable; urgency=low--  * Add MonadBuild.-- -- David Fox <dsf@seereason.com>  Fri, 09 Nov 2012 12:21:14 -0800--haskell-cabal-debian (2.2.1) unstable; urgency=low--  * Add a modifyAtoms function to Flags that is applied to final list of-    DebAtom before writing the debianization.-  * Add DHApacheSite and DHInstallCabalExec atoms so atoms don't depend on-    the build directory-  * Add #DEBHELPER# and exit 0 to default web server postinst.-- -- David Fox <dsf@seereason.com>  Fri, 09 Nov 2012 10:25:32 -0800--haskell-cabal-debian (2.2.0) unstable; urgency=low--  * Append a trailing slash to the --base-uri argument passed to the-    server.  This is required by Web.Routes.Site.runSite.-- -- David Fox <dsf@seereason.com>  Thu, 08 Nov 2012 04:40:08 -0800--haskell-cabal-debian (2.1.4) unstable; urgency=low--  * Merge the Executable and Script constructors of the Executable type-  * Add a destDir field to Executable to specify the destination.-- -- David Fox <dsf@seereason.com>  Tue, 06 Nov 2012 13:24:25 -0800--haskell-cabal-debian (2.1.3) unstable; urgency=low--  * Don't append a slash to the base-uri.-  * Construct the name of the data directory in /usr/share from the cabal-    package name rather than the debian source package name.-  * Add a --self-depend flag to include a build dependency on this library-    in all generated debianizations.-- -- David Fox <dsf@seereason.com>  Tue, 06 Nov 2012 07:07:57 -0800--haskell-cabal-debian (2.1.2) unstable; urgency=low--  * Output the server support files.-- -- David Fox <dsf@seereason.com>  Tue, 06 Nov 2012 06:37:18 -0800--haskell-cabal-debian (2.1.1) unstable; urgency=low--  * Restore code that checks for version number match when validating-    a debianization.  The autobuilder can now pass the version number-    to cabal-debian, so it should match.-- -- David Fox <dsf@seereason.com>  Mon, 05 Nov 2012 17:42:32 -0800--haskell-cabal-debian (2.1.0) unstable; urgency=low--  * Enable processing of Script, Server and WebSite executables.-- -- David Fox <dsf@seereason.com>  Mon, 05 Nov 2012 12:45:42 -0800--haskell-cabal-debian (2.0.9) unstable; urgency=low--  * Add a Library section, export all the modules.-- -- David Fox <dsf@seereason.com>  Mon, 05 Nov 2012 06:41:25 -0800--haskell-cabal-debian (2.0.8) unstable; urgency=low--  * Bypass abandoned versions.-- -- David Fox <dsf@seereason.com>  Sat, 03 Nov 2012 06:13:27 -0700--haskell-cabal-debian (1.26) unstable; urgency=low--  * Don't try to update the existing debianization, except for the-    changelog where we retain entries that look older than the one-    we generate.-  * Use .install files instead of adding rules to debian/rules-  * Add --depends and --conflicts options-- -- David Fox <dsf@seereason.com>  Thu, 25 Oct 2012 12:03:49 -0700--haskell-cabal-debian (1.25) unstable; urgency=low--  * If the --disable-haddock flag is given omit the doc package from the-    control file.-  * The tarball that was uploaded to Hackage as version 1.24 had a (buggy)-    change which was not pushed to darcs.  This resolves that confusion.-- -- David Fox <dsf@seereason.com>  Sat, 16 Jun 2012 14:42:12 -0700--haskell-cabal-debian (1.24) unstable; urgency=low--  * No wonder it doesn't build on hackage - none of the source-    modules were shipped.-- -- David Fox <dsf@seereason.com>  Thu, 14 Jun 2012 08:19:19 -0700--haskell-cabal-debian (1.23) unstable; urgency=low--  * Add a --quilt option to switch from native to quilt format.-    Without this option the file debian/source/format will contain-    '3.0 (native)', with it '3.0 (quilt)'.-- -- David Fox <dsf@seereason.com>  Fri, 01 Jun 2012 05:53:36 -0700--haskell-cabal-debian (1.22) unstable; urgency=low--  * Bump version to make sure all changes are uploaded.-- -- David Fox <dsf@seereason.com>  Wed, 23 May 2012 19:54:17 -0700--haskell-cabal-debian (1.21) unstable; urgency=low--  * fix conversion of wildcards into intersected ranges-- -- David Fox <dsf@seereason.com>  Wed, 23 May 2012 19:51:34 -0700--haskell-cabal-debian (1.20) unstable; urgency=low--  * Fix generation of debian library dependencies from the Extra-Libraries-    field of the cabal file.-- -- David Fox <dsf@seereason.com>  Wed, 23 May 2012 19:50:39 -0700--haskell-cabal-debian (1.19) unstable; urgency=low--  * Handle cabal equals dependencies.-- -- David Fox <dsf@seereason.com>  Tue, 20 Mar 2012 14:34:58 -0700--haskell-cabal-debian (1.18) unstable; urgency=low--  * High level of confidence this time.  Interesting new Interspersed-    class, and an implementation of invertVersionRanges which should be-    forwarded to the Cabal folks.-  * Removes dependency on logic-classes-- -- David Fox <dsf@seereason.com>  Tue, 20 Mar 2012 08:17:25 -0700--haskell-cabal-debian (1.17) unstable; urgency=low--  * Restore code to downcase cabal package name before using it as the-    base of the debian package name.-- -- David Fox <dsf@seereason.com>  Sun, 18 Mar 2012 15:32:04 -0700--haskell-cabal-debian (1.16) unstable; urgency=low--  * Remove code that implements a special case for the debian name of the-    haskell-src-exts package.-- -- David Fox <dsf@seereason.com>  Sun, 18 Mar 2012 14:11:21 -0700--haskell-cabal-debian (1.15) unstable; urgency=low--  * Yet another stab at fixing the code for converting cabal dependencies-    to debian dependencies, with support for splitting version ranges of-    cabal files among different debian packages.-- -- David Fox <dsf@seereason.com>  Fri, 16 Mar 2012 17:59:28 -0700--haskell-cabal-debian (1.14) unstable; urgency=low--  * Don't try to strip data files-  * Use permissions 644 for data files, not 755.-- -- David Fox <dsf@seereason.com>  Wed, 07 Mar 2012 14:46:04 -0800--haskell-cabal-debian (1.13) unstable; urgency=low--  * Append the version number when constructing the directory for data-    files.-- -- David Fox <dsf@seereason.com>  Wed, 07 Mar 2012 08:56:39 -0800--haskell-cabal-debian (1.12) unstable; urgency=low--  * Include any files listed in the Data-Files field of the cabal file-    in the utils package.-- -- David Fox <dsf@seereason.com>  Tue, 06 Mar 2012 11:31:47 -0800--haskell-cabal-debian (1.11) unstable; urgency=low--  * Replace --epoch flag with --epoch-map, so we can specify epoch numbers-    for both the package being built and for dependency packages.-- -- David Fox <dsf@seereason.com>  Thu, 09 Feb 2012 07:01:19 -0800--haskell-cabal-debian (1.10) unstable; urgency=low--  * Add bundled package list for ghc 7.4.1.-- -- David Fox <dsf@seereason.com>  Sat, 04 Feb 2012 14:44:33 -0800--haskell-cabal-debian (1.9) unstable; urgency=low--  * Add --dep-map flag to allow mapping of cabal package names to the base-    of a debian package name.  This modifies the name to which the prefix-    "lib" and the suffix "-dev" are added.-  * Fix dependency generation bug introduced in 1.8.-- -- David Fox <dsf@seereason.com>  Mon, 23 Jan 2012 14:13:05 -0800--haskell-cabal-debian (1.8) unstable; urgency=low--  * Add a --dev-dep flag to make one or more packages install dependencies-    of the dev package.-- -- David Fox <dsf@seereason.com>  Mon, 23 Jan 2012 05:00:46 -0800--haskell-cabal-debian (1.7) unstable; urgency=low--  * Add info about ghc 7.4.0 pre-release.-- -- David Fox <dsf@seereason.com>  Wed, 11 Jan 2012 09:57:45 -0800--haskell-cabal-debian (1.6) unstable; urgency=low--  * Don't omit dependencies built into ghc, they should be satisfied by-    the Provides in the compiler if they are not available in the-    repository.  However, we do need to make ghc an alterantive to any-    versioned dependencies that are bundled with the compiler, since the-    built in dependencies are virtual packages and thus unversioned.-- -- David Fox <dsf@seereason.com>  Wed, 07 Dec 2011 06:10:17 -0800--haskell-cabal-debian (1.5) unstable; urgency=low--  * Fix the generation of build dependency version ranges by using an-    intermediate version range type.-  * If the version range for the cabal file touches two different debian-    package, don't try to write build dependencies that allow either one,-    it can't really be done.  Just give the allowable versions of the-    newer package (e.g. libghc-parsec3-dev rather than libghc-parsec2-dev.)-- -- David Fox <dsf@seereason.com>  Sun, 04 Dec 2011 05:59:25 -0800--haskell-cabal-debian (1.4) unstable; urgency=low--  * Add a --revision <suffix> flag which appends a (perhaps empty) string-    cabal version number to get the debian version number.  Without this-    flag the string "-1~hackage1" is appended.-  * Make it an error to specify a debian version via --deb-version that is-    older than the current cabal version.-- -- David Fox <dsf@seereason.com>  Sun, 20 Nov 2011 06:45:33 -0800--haskell-cabal-debian (1.3) unstable; urgency=low--  * Fix error message when compiler version is not in bundled package list.-  * Add bundled package list for compiler 7.0.4 (same as 7.0.3.)-- -- David Fox <dsf@seereason.com>  Sat, 08 Oct 2011 07:58:19 -0700--haskell-cabal-debian (1.2) unstable; urgency=low--  * When computing the debian name from a package's cabal name, if we-    have no particular version number we are comparing to, use the name-    from the version split that corresponds to newer version numbers.-  * Add code to make the cabal package haskell-src-exts map to the debian-    packages libghc-src-exts-dev etc.  Normally it would map to-    libghc-haskell-src-exts-dev.-- -- David Fox <dsf@seereason.com>  Thu, 06 Oct 2011 09:27:02 -0700--haskell-cabal-debian (1.1) unstable; urgency=low--  * Use propositional logic package to compute normal form for dependencies-  * Make sure to correct format of cabal package synopsis before using as debian-    package description.-- -- David Fox <dsf@seereason.com>  Fri, 30 Sep 2011 06:16:34 -0700--haskell-cabal-debian (1.0) unstable; urgency=low--  * Debianization generated by cabal-debian-- -- David Fox <dsf@seereason.com>  Sun, 18 Sep 2011 06:40:21 -0700

@@ -1,285 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS -fno-warn-missing-signatures #-}-module Debian.Apt.Dependencies-{--    ( solve-    , State-    , binaryDepends-    , search-    , bj'-    , bt-    , CSP(..)-    ) -} where---- test gutsyPackages "libc6" (\csp -> bt csp)--import Control.Arrow (second)-import qualified Data.ByteString.Char8 as C-import Data.List as List (find, union)-import Data.Tree (Tree(rootLabel, Node))-import Debian.Apt.Package (PackageNameMap, packageNameMap, lookupPackageByRel)-import Debian.Control.ByteString (ControlFunctions(stripWS, lookupP, parseControlFromFile),-                                  Field'(Field, Comment), Control'(Control), Paragraph, Control)-import Debian.Relation (BinPkgName(..))-import Debian.Relation.ByteString (ParseRelations(..), Relation(..), OrRelation, AndRelation, Relations, checkVersionReq)-import Debian.Version (DebianVersion, parseDebianVersion, prettyDebianVersion)-import Debian.Version.ByteString ()-import Text.PrettyPrint (render)---- * Basic CSP Types and Functions--data Status-    = Remaining AndRelation-    | MissingDep Relation-    | Complete-      deriving (Eq)--type State a = (Status, [a])--complete :: State a -> Bool-complete (Complete, _) = True-complete _ = False--data CSP a-    = CSP { pnm :: PackageNameMap a-          , relations :: Relations-          , depFunction :: (a -> Relations)-          , conflicts :: a -> Relations-          , packageVersion :: a -> (BinPkgName, DebianVersion)-          }---- * Test CSP---- |TODO addProvides -- see DQL.Exec-controlCSP :: Control -> Relations -> (Paragraph -> Relations) -> CSP Paragraph-controlCSP (Control paragraphs) rels depF' =-    CSP { pnm = packageNameMap getName paragraphs-        , relations = rels-        , depFunction = depF'-        , conflicts = conflicts'-        , packageVersion = packageVersionParagraph-        }-    where-      getName :: Paragraph -> BinPkgName-      getName p = case lookupP "Package" p of-                    Nothing -> error "Missing Package field"-                    Just (Field (_,n)) -> BinPkgName (C.unpack (stripWS n))-                    Just (Comment _) -> error "controlCSP"-      conflicts' :: Paragraph -> Relations-      conflicts' p =-          case lookupP "Conflicts" p of-            Nothing -> []-            Just (Field (_, c)) -> either (error . show) id (parseRelations c)-            Just (Comment _) -> error "controlCSP"--testCSP :: FilePath -> (Paragraph -> Relations) -> String -> (CSP Paragraph -> IO a) -> IO a-testCSP controlFile depf relationStr cspf =-    do c' <- parseControlFromFile controlFile-       case c' of-         Left e -> error (show e)-         Right control@(Control _) ->-             case parseRelations relationStr of-               Left e -> error (show e)-               Right r ->-                     cspf (controlCSP control r depf)--depF :: Paragraph -> Relations-depF p =-    let preDepends =-            case lookupP "Pre-Depends" p of-              Nothing -> []-              Just (Field (_,pd)) ->-                  either (error . show) id (parseRelations pd)-              Just (Comment _) -> error "depF"-        depends =-            case lookupP "Depends" p of-              Nothing -> []-              Just (Field (_,pd)) ->-                  either (error . show) id (parseRelations pd)-              Just (Comment _) -> error "depF"-    in-      preDepends ++ depends--sidPackages = "/var/lib/apt/lists/ftp.debian.org_debian_dists_unstable_main_binary-i386_Packages"-gutsyPackages = "/var/lib/apt/lists/mirror.anl.gov_pub_ubuntu_dists_gutsy_main_binary-i386_Packages"--test controlFP rel labeler =-    testCSP controlFP depF rel (mapM_ (\ (_,p) -> mapM_ (print . second (render . prettyDebianVersion) . packageVersionParagraph) p ) . take 1 . search labeler)---- TODO: add better errors-packageVersionParagraph :: Paragraph -> (BinPkgName, DebianVersion)-packageVersionParagraph p =-    case lookupP "Package" p of-      Nothing -> error $ "Paragraph missing Package field"-      (Just (Field (_, name))) ->-          case lookupP "Version" p of-            Nothing -> error $ "Paragraph missing Version field"-            (Just (Field (_, str))) ->-                case parseDebianVersion str of-                  Right ver -> (BinPkgName (C.unpack (stripWS name)), ver)-                  Left e -> error $ "packageVersionParagraph: " ++ show e-            (Just (Comment _)) -> error "packageVersionParagraph"-      (Just (Comment _)) -> error "packageVersionParagraph"----conflict :: CSP p -> p -> p -> Bool-conflict csp p1 p2 =-    let (name1, version1) = (packageVersion csp) p1-        (name2, version2) = (packageVersion csp) p2-    in-      if name1 == name2-      then version1 /= version2-      else-        any (conflict' (name1, version1)) (concat $ (conflicts csp) p2) ||-        any (conflict' (name2, version2)) (concat $ (conflicts csp) p1)---- |JAS: deal with 'Provides' (can a package provide more than one package?)-conflict' :: (BinPkgName, DebianVersion) -> Relation -> Bool-conflict' (pName, pVersion) (Rel pkgName mVersionReq _) =-    (pName == pkgName) && (checkVersionReq mVersionReq (Just pVersion))------ * Tree Helper Functions--mkTree :: a -> [Tree a] -> Tree a-mkTree = Node--label :: Tree a -> a-label = rootLabel--initTree :: (a -> [a]) -> a -> Tree a-initTree f a = Node a (map (initTree f) (f a))--mapTree :: (a -> b) -> Tree a -> Tree b-mapTree = fmap--foldTree :: (a -> [b] -> b) -> Tree a -> b-foldTree f (Node a ts) = f a (map (foldTree f) ts)--zipTreesWith :: (a -> b -> c) -> Tree a -> Tree b -> Tree c-zipTreesWith f (Node a ts) (Node b us) =-    Node (f a b) (zipWith (zipTreesWith f) ts us)--prune :: (a -> Bool) -> Tree a -> Tree a-prune p = foldTree f-    where f a ts = Node a (filter (not . p . label) ts)--leaves :: Tree a -> [a]-leaves = foldTree f-    where f leaf [] = [leaf]-          f _ ts = concat ts--inhTree :: (b -> a -> b) -> b -> Tree a -> Tree b-inhTree f b (Node a ts) = Node b' (map (inhTree f b') ts)-    where b' = f b a--distrTree :: (a -> [b]) -> b -> Tree a -> Tree b-distrTree  f b (Node a ts) = Node b (zipWith (distrTree f) (f a) ts)---- * mkSearchTree---- TODO: might want to leave markers about what relation we are satisfying?-mkSearchTree :: forall a. CSP a -> Tree (State a)-mkSearchTree csp =-    Node (Remaining (relations csp),[]) (andRelation ([],[]) (relations csp))-    where-      andRelation :: ([a],AndRelation) -> AndRelation -> [Tree (State a)]-      andRelation (candidates,[]) [] = [Node (Complete, candidates) []]-      andRelation (candidates,remaining) [] = andRelation (candidates, []) remaining-      andRelation (candidates, remaining) (x:xs) =-          orRelation (candidates, xs ++ remaining) x-      orRelation :: ([a],AndRelation) -> OrRelation -> [Tree (State a)]-      orRelation acc x =-          concat (fmap (relation acc) x)-      relation :: ([a],AndRelation) -> Relation -> [Tree (State a)]-      relation acc@(candidates,_) rel =-          let packages = lookupPackageByRel (pnm csp) (packageVersion csp) rel in-          case packages of-            [] -> [Node (MissingDep rel, candidates) []]-            _ -> map (package acc) packages-      package :: ([a],AndRelation) -> a -> Tree (State a)-      package (candidates, remaining) p =-          if ((packageVersion csp) p) `elem` (map (packageVersion csp) candidates)-          then if null remaining-               then Node (Complete, candidates) []-               else Node (Remaining remaining, candidates) (andRelation (candidates, []) remaining)-          else Node (Remaining remaining, (p : candidates)) (andRelation ((p : candidates), remaining) ((depFunction csp) p))----- |earliestInconsistency does what it sounds like--- the 'reverse as' is because the vars are order high to low, but we--- want to find the lowest numbered (aka, eariest) inconsistency ??----earliestInconsistency :: CSP a -> State a -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion))-earliestInconsistency _ (_,[]) = Nothing-earliestInconsistency _ (_,[_p]) = Nothing-earliestInconsistency csp (_,(p:ps)) =-    case find ((conflict csp) p) (reverse ps) of-      Nothing -> Nothing-      (Just conflictingPackage) -> Just ((packageVersion csp) p, (packageVersion csp) conflictingPackage)---- * Conflict Set---- | conflicting packages and relations that require non-existant packages-type ConflictSet = ([(BinPkgName, DebianVersion)],[Relation])--isConflict :: ConflictSet -> Bool-isConflict ([],[]) = False-isConflict _ = True--solutions :: Tree (State a, ConflictSet) -> [State a]-solutions = filter complete . map fst . leaves . prune (isConflict . snd)--type Labeler a = CSP a -> Tree (State a) -> Tree (State a, ConflictSet)--search :: Labeler a -> CSP a -> [State a]-search labeler csp = (solutions . (labeler csp) . mkSearchTree) csp---- * Backtracking Labeler--bt :: Labeler a-bt csp = mapTree f-    where-      f s@(status,_) =-              case status of-                (MissingDep rel) -> (s, ([], [rel]))-                _ ->-                    (s,-                      case (earliestInconsistency csp) s of-                        Nothing -> ([],[])-                        Just (a,b) -> ([a,b], []))---- * BackJumping Solver--{-|bj - backjumping labeler--If the node already has a conflict set, then leave it alone.--Otherwise, the conflictset for the node is the combination of the-conflict sets of its direct children.--}-bj :: CSP p -> Tree (State p, ConflictSet) -> Tree (State p, ConflictSet)-bj csp = foldTree f-    where f (s, cs) ts-            | isConflict cs  = mkTree (s, cs) ts---            | isConflict cs' = mkTree (s, cs') [] -- prevent space leak-            | otherwise = mkTree (s, cs') ts-            where cs' =-                      let set = combine csp (map label ts) [] in-                      set `seq` set -- prevent space leak--unionCS :: [ConflictSet] -> ConflictSet-unionCS css = foldr (\(c1, m1) (c2, m2) -> ((c1 `union` c2), (m1 `union` m2))) ([],[]) css--combine :: CSP p -> [(State p, ConflictSet)] -> [ConflictSet] -> ConflictSet-combine _ [] acc = unionCS acc-combine csp ((s,cs@(c,m)):ns) acc-    | (not (lastvar `elem` c)) && null m = cs-    | null c && null m = ([],[]) -- is this case ever used?-    | otherwise = combine csp ns ((c, m):acc)-    where lastvar =-              let (_,(p:_)) = s in (packageVersion csp) p--

@@ -1,300 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}-module Debian.Apt.Index-    ( update-    , Fetcher-    , CheckSums(..)-    , Compression(..)-    , FileTuple-    , Size-    , controlFromIndex-    , controlFromIndex'-    , findContentsFiles-    , findIndexes-    , indexesInRelease-    , tupleFromFilePath-    ) where--import Control.Monad-import qualified Codec.Compression.GZip as GZip-import qualified Codec.Compression.BZip as BZip-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy.Char8 as L-import qualified Data.Digest.Pure.MD5 as MD5-import Data.Function-import Data.List as List (null, intercalate, sortBy, isSuffixOf, isPrefixOf)-import qualified Data.Map as M-import Data.Monoid ((<>))-import Data.Text as Text (Text, unpack, concat, lines, null, words)-import Data.Time-import Debian.Apt.Methods-import Debian.Control (formatControl)-import Debian.Control.ByteString-import Debian.Control.Common-import Debian.Control.Text (decodeControl)-import Debian.Release-import Debian.Sources-import Debian.URI-import System.Directory-import System.FilePath ((</>))-import System.Posix.Files-import System.FilePath (takeBaseName)---import qualified System.Unix.Misc as Misc-import Text.ParserCombinators.Parsec.Error-import Text.PrettyPrint (render)-import Text.PrettyPrint.HughesPJClass (pPrint)---- |Package indexes on the server are uncompressed or compressed with--- gzip or bzip2. We do not know what will exist on the server until we--- actually look. This type is used to mark the compression status of--- what was actually found.-data Compression-    = BZ2 | GZ | Uncompressed-      deriving (Read, Show, Eq, Ord, Enum, Bounded)--data CheckSums-    = CheckSums { md5sum :: Maybe String-                , sha1   :: Maybe String-                , sha256 :: Maybe String-                }-      deriving (Read, Show, Eq)---- |function-type for a function that downloads a file--- The timestamp is optional. If the local file is as new or newer--- than the remote copy, the download may be skipped.------ A good choice might be a partially parameterized call to--- 'Debian.Apt.Methods.fetch'-type Fetcher =-    URI ->              -- remote URI-    FilePath ->         -- local file name-    Maybe UTCTime ->    -- optional time stamp for local file-    IO Bool             -- True on success, False on failure---- |update - similar to apt-get update---- downloads the index files associated with a sources.list. The--- downloaded index files will have the same basenames that apt-get uses--- in \/var\/lib\/apt\/lists. You can almost use this function instead of--- calling apt-get update. However there are a few key differences:---  1. apt-get update also updates the binary cache files---  2. apt-get update uses the partial directory and lock file in\ /var\/lib\/apt\/lists---  3. apt-get update downloads the Release and Release.gpg files-update :: Fetcher -- ^ function that will do actually downloading-       -> FilePath -- ^ download indexes to the directory (must already exist)-       -> String -- ^ binary architecture-       -> [DebSource] -- ^ sources.list-       -> IO [Maybe (FilePath, Compression)] -- ^ (basename of index file, compression status)-update fetcher basePath arch sourcesList =-    mapM (uncurry $ fetchIndex fetcher) (map (\(uri, fp, _) -> (uri, (basePath </> fp))) (concatMap (indexURIs arch) sourcesList))---- | download possibly compressed files--- NOTE: index uri must not include the .bz2 or .gz extension-fetchIndex :: Fetcher -- ^ function that will do the actual fetch-           -> URI -- ^ remote URI of package index, without .bz2 or .gz extension-           -> FilePath -- ^ name to save downloaded file as, without .bz2 or .gz extension-           -> IO (Maybe (FilePath, Compression)) -- ^ (downloaded file name + extension, compression status)-fetchIndex fetcher uri localPath =-    do let localPath' = localPath ++ ".bz2"-       --lm <- getLastModified localPath'-       res <- fetcher (uri { uriPath = (uriPath uri) ++ ".bz2" }) localPath' Nothing-       if res-          then return $ Just (localPath', BZ2)-          else do let localPath' = localPath ++ ".gz"-                  lm <- getLastModified localPath'-                  res <- fetcher (uri { uriPath = (uriPath uri) ++ ".gz" }) localPath' lm-                  if res-                     then return $ Just (localPath', GZ)-                     else do lm <- getLastModified localPath-                             res <- fetcher (uri { uriPath = (uriPath uri) }) localPath lm-                             if res-                                then return (Just (localPath, Uncompressed))-                                else return Nothing---- |examine a DebSource line, and calculate for each section:---  - the URI to the uncompressed index file---  - the basename that apt-get would name the downloaded index--- FIXME: ExactPath dist will fail with error at runtime :(-indexURIs :: String -- ^ which binary architecture-          -> DebSource -- ^ line from sources.list-          -> [(URI, FilePath, DebSource)] -- ^ (remote uri, local name, deb source for just this section)-indexURIs arch debSource =-    map (\ section -> let (uri, fp) = calcPath (sourceType debSource) arch baseURI release section-                      in (uri,fp, debSource { sourceDist = (Right (release, [section])) }) ) sections-    where-      baseURI = sourceUri debSource-      (release, sections) =-          either (error $ "indexURIs: support not implemented for exact path: " ++ render (pPrint debSource)) id (sourceDist debSource)---- |return a tuple for the section---  - the URI to the uncompressed index file---  - the basename that apt-get uses for the downloaded index--- FIXME: support for Release and Release.gpg-calcPath :: SourceType -- ^ do we want Packages or Sources-         -> String  -- ^ The binary architecture to use for Packages-         -> URI -- ^ base URI as it appears in sources.list-         -> ReleaseName -- ^ the release (e.g., unstable, testing, stable, sid, etc)-         -> Section -- ^ the section (main, contrib, non-free, etc)-         -> (URI, [Char]) -- ^ (uri to index file, basename for the downloaded file)-calcPath srcType arch baseURI release section =-          let indexPath = case srcType of-                      DebSrc -> "source/Sources"-                      Deb -> "binary-" ++ arch </> "Packages"-              path = (uriPath baseURI) </> "dists" </> (releaseName' release) </> sectionName' section </> indexPath-          in (baseURI { uriPath = path }, addPrefix . escapePath $ path)-          where-            addPrefix s = prefix scheme user' pass' reg port ++ {- "_" ++ -} s-            prefix "http:" (Just user) Nothing (Just host) port = user ++ host ++ port-            prefix "http:" _ _ (Just host) port = host ++ port-            prefix "ftp:" _ _ (Just host) _ = host-            prefix "file:" Nothing Nothing Nothing "" = ""-            prefix "ssh:" (Just user) Nothing (Just host) port = user ++ host ++ port-            prefix "ssh:" _ _ (Just host) port = host ++ port-            prefix _ _ _ _ _ = error ("calcPath: unsupported uri: " ++ uriToString' baseURI)-            user' = maybeOfString user-            pass' = maybeOfString pass-            (user, pass) = break (== ':') userpass-            userpass = maybe "" uriUserInfo auth-            reg = maybeOfString $ maybe "" uriRegName auth-            port = maybe "" uriPort auth-            scheme = uriScheme baseURI-            auth = uriAuthority baseURI-            --path = uriPath baseURI--            escapePath :: String -> String-            escapePath s = intercalate "_" $ wordsBy (== '/') s--            maybeOfString :: String -> Maybe String-            maybeOfString "" = Nothing-            maybeOfString s = Just s--            wordsBy :: Eq a => (a -> Bool) -> [a] -> [[a]]-            wordsBy p s =-                case (break p s) of-                  (s, []) -> [s]-                  (h, t) -> h : wordsBy p (drop 1 t)---- |Parse a possibly compressed index file.-controlFromIndex :: Compression -> FilePath -> L.ByteString -> Either ParseError (Control' Text)-controlFromIndex GZ path s = either Left (Right . decodeControl) . parseControl path . B.concat . L.toChunks . GZip.decompress $ s-controlFromIndex BZ2 path s = either Left (Right . decodeControl) . parseControl path . B.concat . L.toChunks . BZip.decompress $ s-controlFromIndex Uncompressed path s = either Left (Right . decodeControl) . parseControl path . B.concat . L.toChunks $ s---- |parse an index possibly compressed file-controlFromIndex' :: Compression -> FilePath -> IO (Either ParseError (Control' Text))-controlFromIndex' compression path = L.readFile path >>= return . controlFromIndex compression path--type Size = Integer-type FileTuple = (CheckSums, Size, FilePath)---- |A release file contains a list of indexes (Packages\/Sources). Each--- Package or Source index may appear multiple times because it may be--- compressed several different ways. This function will return an--- assoc list where the key is the name of the uncompressed package--- index name and the value is the list of (file, compression) which--- decompress to the key.-groupIndexes :: [FileTuple] -> [(FilePath, [(FileTuple, Compression)])]-groupIndexes indexFiles =-    M.toList $ M.fromListWith combine $ map makeKV indexFiles-    where-      makeKV fileTuple@(_,_,fp) =-          let (name, compressionMethod) = uncompressedName fp-          in-            (name, [(fileTuple, compressionMethod)])-      combine = (\x y -> sortBy (compare `on` snd) (x ++ y))-{--      with t@(_,_,fp) m =-          let (un, compression) =-          in-            M.insertWith--}--{--groupIndexes' :: String ->[FileTuple] -> [(FilePath, [(FileTuple, Compression)])]-groupIndexes' iType indexFiles =-    M.toList (foldr (insertType iType) M.empty indexFiles)-    where-      insertType iType t@(_,_,fp) m =-          case uncompressedName' iType fp of-            Nothing -> m-            (Just (un, compression)) ->-                M.insertWith (\x y -> sortBy (compare `on` snd) (x ++ y)) un [(t, compression)] m--}---- |The release file contains the checksums for the uncompressed--- package indexes, even if the uncompressed package indexes are not--- stored on the server. This function returns the list of files that--- actually exist.-filterExists :: FilePath -> (FilePath, [(FileTuple, Compression)]) -> IO (FilePath, [(FileTuple, Compression)])-filterExists distDir (fp, alternatives) =-          do e <- filterM ( \((_,_,fp),_) -> fileExist (distDir </> fp)) alternatives-             -- when (null e) (error $ "None of these files exist: " ++ show alternatives)-             return (fp, e)--findIndexes :: FilePath -> String -> [FileTuple] -> IO [(FileTuple, Compression)]-findIndexes distDir iType controlFiles =-    let indexes = groupIndexes controlFiles-    in-      do indexes' <- mapM (filterExists distDir) (filter (isType iType) indexes)-         return $ map (head . snd) (filter (not . List.null . snd) indexes')-    where-      isType iType (fp, _) = iType `isSuffixOf` fp--{--findIndexes' :: FilePath -> String -> [FileTuple] -> IO [(FileTuple, Compression)]-findIndexes' distDir iType controlFiles =-    let m = groupIndexes' iType controlFiles-    in-      do m' <- mapM (filterExists distDir) m-         return $ map (head . snd) (filter (not . null . snd) m')--}--      -- insertType :: String -> (CheckSums, Integer, FilePath) -> M.Map FilePath ((CheckSums, Integer, FilePath), Compression) -> M.Map FilePath ((CheckSums, Integer, FilePath), Compression)--{--uncompressedName' :: String -> FilePath -> Maybe (FilePath, Compression)-uncompressedName' iType fp-          | isSuffixOf iType fp = Just (fp, Uncompressed)-          | isSuffixOf (iType ++".gz") fp = Just (reverse . (drop 3) . reverse $ fp, GZ)-          | isSuffixOf (iType ++".bz2") fp = Just (reverse . (drop 4) . reverse $ fp, BZ2)-          | otherwise = Nothing--}--uncompressedName :: FilePath -> (FilePath, Compression)-uncompressedName fp-          | isSuffixOf ".gz"  fp = (reverse . (drop 3) . reverse $ fp, GZ)-          | isSuffixOf ".bz2" fp = (reverse . (drop 4) . reverse $ fp, BZ2)-          | otherwise            = (fp, Uncompressed)--indexesInRelease :: (FilePath -> Bool)-                 -> Control' Text -- ^ A release file-                 -> [(CheckSums, Integer, FilePath)] -- ^-indexesInRelease filterp (Control [p]) =-    let md5sums =-            case md5sumField p of-              (Just md5) -> md5-              Nothing -> error $ "Did not find MD5Sum field."-    in-      filter (\(_,_,fp) -> filterp fp) $ map (makeTuple . Text.words) $ filter (not . Text.null) (Text.lines md5sums)-    where-      makeTuple :: [Text] -> (CheckSums, Integer, FilePath)-      makeTuple [md5sum, size, fp] = (CheckSums { md5sum = Just (Text.unpack md5sum), sha1 = Nothing, sha256 = Nothing }, read (Text.unpack size), Text.unpack fp)-      makeTuple x = error $ "Invalid line in release file: " ++ show x-indexesInRelease _ x = error $ "Invalid release file: " <> Text.unpack (Text.concat (formatControl x))---- |make a FileTuple for a file found on the local disk--- returns 'Nothing' if the file does not exist.-tupleFromFilePath :: FilePath -> FilePath -> IO (Maybe FileTuple)-tupleFromFilePath basePath fp =-          do e <- fileExist (basePath </> fp)-             if not e-              then return Nothing-              else do size <- getFileStatus (basePath </> fp) >>= return . fromIntegral . fileSize-                      md5 <- L.readFile (basePath </> fp) >>= return . show . MD5.md5-                      return $ Just (CheckSums { md5sum = Just md5, sha1 = Nothing, sha256 = Nothing }, size, fp)---- |find the Contents-* files. These are not listed in the Release file-findContentsFiles :: (FilePath -> Bool) -> FilePath -> IO [FilePath]-findContentsFiles filterP distDir =-          do files <- getDirectoryContents distDir-             return $ filter filterP $ filter (isPrefixOf "Contents-" . takeBaseName) files

@@ -1,486 +0,0 @@-{-# LANGUAGE PackageImports #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-name-shadowing #-}--- |an interface for using the methods in /var/lib/apt/methods-module Debian.Apt.Methods-    ( withMethodPath-    , withMethodURI-    , whichMethodPath-    , openMethod-    , closeMethod-    , recvStatus-    , sendCommand-    , getLastModified-    , simpleFetch-    , fetch-    , FetchCallbacks(..)-    , emptyFetchCallbacks-    , cliFetchCallbacks-    , Command(..)-    , Status(..)-    , Message, Site, User, Password, Media, Drive, Header, ConfigItem-    )-    where--import Debian.Time-import Debian.URI--import Control.Exception-import "mtl" Control.Monad.Error-import Data.Maybe-import Data.Time-import System.Directory-import System.Exit-import System.IO-import System.Posix.Files-import System.Process--type MethodHandle = (Handle, Handle, Handle, ProcessHandle)--capabilities, logMsg, status, uriStart, uriDone, uriFailure, generalFailure, authorizationRequired, mediaFailure, uriAcquire, configuration, authorizationCredentials, mediaChanged :: String-capabilities = "100"-logMsg = "101"-status = "102"-uriStart = "200"-uriDone = "201"-uriFailure = "400"-generalFailure = "401"-authorizationRequired = "402"-mediaFailure = "403"-uriAcquire = "600"-configuration = "601"-authorizationCredentials = "602"-mediaChanged = "603"--type Message = String-type Site = String-type User = String-type Password = String-type Media = String-type Drive = String--data Status-    = Capabilities { version :: String, singleInstance :: Bool, preScan :: Bool, pipeline :: Bool, sendConfig :: Bool-                   , needsCleanup :: Bool, localOnly :: Bool }-    | LogMsg Message-    | Status URI Message-    | URIStart { uri :: URI, size :: Maybe Integer, lastModified :: Maybe UTCTime, resumePoint :: Maybe Integer }-    | URIDone { uri :: URI, size :: Maybe Integer,  lastModified :: Maybe UTCTime, resumePoint :: Maybe Integer-              , filename :: Maybe FilePath, hashes :: Hashes, imsHit :: Bool }-    | URIFailure { uri :: URI, message :: Message }-    | GeneralFailure Message-    | AuthorizationRequired Site-    | MediaFailure Media Drive-      deriving (Show, Eq)--data Hashes-    = Hashes { md5 :: Maybe String-             , sha1 :: Maybe String-             , sha256 :: Maybe String-             }-      deriving (Show, Eq)--emptyHashes = Hashes Nothing Nothing Nothing--data Command-    = URIAcquire URI FilePath (Maybe UTCTime)-    | Configuration [ConfigItem]-    | AuthorizationCredentials Site User Password-    | MediaChanged Media (Maybe Bool) -- I don't really understand the Fail field, I am assuming it is 'Fail: true'-      deriving (Show, Eq)--type Header = (String, String)-type ConfigItem = (String, String)--withMethodURI :: URI -> (MethodHandle -> IO a) -> IO a-withMethodURI uri f =-    do  mp <- liftM fromJust (whichMethodPath uri)-        withMethodPath mp f---- |withMethod - run |methodPath| bracketed with--- openMethod\/closeMethod. |f| gets the open handle.-withMethodPath :: FilePath -> (MethodHandle -> IO a) -> IO a-withMethodPath methodPath f =-    bracket (openMethod methodPath) closeMethod $ f---- |whichMethodBinary - find the method executable associated with a URI--- throws an exception on failure-whichMethodPath :: URI -> IO (Maybe FilePath)-whichMethodPath uri =-    let scheme = init (uriScheme uri)-        path = "/usr/lib/apt/methods/" ++ scheme-    in-      doesFileExist path >>= return . bool Nothing (Just path)--{--The flow of messages starts with the method sending out a-100 Capabilities and APT sending out a 601 Configuration.--The flow is largely unsynchronized, but our function may have to-respond to things like authorization requests. Perhaps we do a-recvContents and then mapM_ over that ? Not all incoming messages-require a response, so...---}--parseStatus :: [String] -> Status-parseStatus [] = error "parseStatus"-parseStatus (code' : headers') =-    parseStatus' (take 3 code') (map parseHeader headers')-    where-      parseStatus' code headers-          | code == capabilities =-              foldr updateCapability defaultCapabilities headers-                  where-                    updateCapability (a,v) c-                        | a == "Version"         = c { version = v }-                        | a == "Single-Instance" = c { singleInstance = parseTrueFalse v }-                        | a == "Pre-Scan"        = c { preScan = parseTrueFalse v }-                        | a == "Pipeline"        = c { pipeline = parseTrueFalse v }-                        | a == "Send-Config"     = c { sendConfig = parseTrueFalse v }-                        | a == "Needs-Cleanup"   = c { needsCleanup = parseTrueFalse v }-                        | a == "Local-Only"      = c { localOnly = parseTrueFalse v }-                        | otherwise = error $ "unknown capability: " ++ show (a,v)-                    defaultCapabilities =-                        Capabilities { version = ""-                                     , singleInstance = False-                                     , preScan        = False-                                     , pipeline       = False-                                     , sendConfig     = False-                                     , needsCleanup   = False-                                     , localOnly      = False-                                     }-      parseStatus' code headers-          | code == logMsg =-              case headers of-                [("Message", msg)] -> LogMsg msg-                _ -> error "parseStatus'"-          | code == status =-                Status (fromJust $ parseURI $ fromJust $ lookup "URI" headers) (fromJust $ lookup "Message" headers)-          | code == uriStart =-              foldr updateUriStart (URIStart undefined Nothing Nothing Nothing) headers-                  where-                    updateUriStart (a,v) u-                        | a == "URI" = u { uri = fromJust $ parseURI v }-                        | a == "Size" = u { size = Just (read v) }-                        | a == "Last-Modified" = u { lastModified = parseTimeRFC822 v } -- if the date is unparseable, we silently truncate. Is that bad ?-                        | a == "Resume-Point" = u { resumePoint = Just (read v) }-                    updateUriStart _ _ = error "updateUriStart"-      parseStatus' code headers-          | code == uriDone =-              foldr updateUriDone (URIDone undefined Nothing Nothing Nothing Nothing emptyHashes False) headers-                  where-                    updateUriDone (a,v) u-                        | a == "URI" = u { uri = fromJust $ parseURI v }-                        | a == "Size" = u { size = Just (read v) }-                        | a == "Last-Modified" = u { lastModified = parseTimeRFC822 v } -- if the date is unparseable, we silently truncate. Is that bad ?-                        | a == "Filename" = u { filename = Just v }-                        | a == "MD5Sum-Hash" = u { hashes = (hashes u) { md5    = Just v } }-                        | a == "MD5-Hash" = u { hashes = (hashes u) { md5    = Just v } }-                        | a == "SHA1-Hash"   = u { hashes = (hashes u) { sha1   = Just v } }-                        | a == "SHA256-Hash" = u { hashes = (hashes u) { sha256 = Just v } }-                        | a == "Resume-Point" = u { resumePoint = Just (read v) }-                        | a == "IMS-Hit" && v == "true" = u { imsHit = True }-                        | otherwise = error $ "updateUriDone: unknown header: " ++ show (a,v)-      parseStatus' code headers-          | code == uriFailure =-              URIFailure (fromJust $ parseURI $ fromJust $ lookup "URI" headers) (fromJust $ lookup "Message" headers)-          | code == generalFailure =-              GeneralFailure (fromJust $ lookup "Message" headers)-          | code == authorizationRequired =-              AuthorizationRequired (fromJust $ lookup "Site" headers)-          | code == mediaFailure =-              MediaFailure (fromJust $ lookup "Media" headers) (fromJust $ lookup "Drive" headers)-      parseStatus' _ _ = error "parseStatus'"--formatCommand :: Command -> [String]-formatCommand (URIAcquire uri filepath mLastModified) =-    [ uriAcquire ++ " URI Acquire"-    , "URI: " ++ uriToString' uri -- will this get credentials correct ? Or do we always pass those in seperately-    , "FileName: " ++ filepath-    ] ++ maybe [] (\lm -> ["Last-Modified: " ++ formatTimeRFC822 lm ]) mLastModified-formatCommand (Configuration configItems) =-    (configuration ++ " Configuration") : (map formatConfigItem configItems)-    where-      formatConfigItem (a,v) = concat ["Config-Item: ", a, "=", v]-formatCommand (AuthorizationCredentials site user passwd) =-    (authorizationCredentials ++ " Authorization Credentials") :-    [ "Site: " ++ site-    , "User: " ++ user-    , "Password: " ++ passwd-    ]-formatCommand (MediaChanged media mFail) =-    [ mediaChanged ++ " Media Changed"-    , "Media: " ++ media-    ] ++ maybe [] (\b -> ["Fail: " ++ case b of True -> "true" ; False -> "false"]) mFail---parseTrueFalse :: String -> Bool-parseTrueFalse "true" = True-parseTrueFalse "false" = False-parseTrueFalse s = error $ "Invalid boolean string: " ++ s---recvStatus :: MethodHandle -> IO Status-recvStatus mh = liftM parseStatus $ recv mh--sendCommand :: MethodHandle -> Command -> IO ()-sendCommand mh cmd = sendMethod mh (formatCommand cmd)---parseHeader :: String -> Header-parseHeader str =-    let (a, r) = span (/= ':') str-        v = dropWhile (flip elem ": \t") r-    in-      (a, v)--openMethod :: FilePath -> IO MethodHandle-openMethod methodBinary =-    do-      -- hPutStrLn stderr ("openMethod " ++ methodBinary)-      runInteractiveCommand methodBinary-      -- runInteractiveProcess methodBinary [] Nothing Nothing--sendMethod :: MethodHandle -> [String] -> IO ()-sendMethod (pIn, _pOut, _, _) strings =-    do-      -- hPutStrLn stderr "send:"-      mapM_ put strings-      hPutStrLn pIn ""-      hFlush pIn-    where-      put line =-          do-            -- hPutStrLn stderr ("  " ++ line)-            hPutStrLn pIn line--closeMethod :: MethodHandle -> IO ExitCode-closeMethod (pIn, pOut, pErr, handle) =-    do-      -- hPutStrLn stderr "closeMethod"-      hClose pIn-      hClose pOut-      hClose pErr-      waitForProcess handle--recv :: MethodHandle -> IO [String]-recv (_pIn, pOut, _pErr, _pHandle) =-    do-      -- hPutStrLn stderr "recv:"-      readTillEmptyLine pOut-    where-      readTillEmptyLine pOut =-          do-            line <- hGetLine pOut-            case line of-              "" -> return []-              line ->-                  do-                    -- hPutStrLn stderr ("  " ++ line)-                    tail <- readTillEmptyLine pOut-                    return $ line : tail-{--The flow of messages starts with the method sending out a-<em>100 Capabilities</> and APT sending out a <em>601 Configuration</>.--The flow is largely unsynchronized, but our function may have to-respond to things like authorization requests. Perhaps we do a-recvContents and then mapM_ over that ? Not all incoming messages-require a response.--We probably also need to track state, for example, if we are-pipelining multiple downloads and want to show seperate progress bars-for each download.--If someone wants to use fetch, they will need to provide methods to:-- 1. prompt for and provide authentication- 2. show progress- 3. show media change dialog- 4. Show log messages- 5. Show failures- 6. Send Configuration--pipeline vs non-pipeline mode.-what if different methods are being used ?--when pipelining, we probably don't want to have too many pipelines to-the same server. Perhaps there can be a limit, and for non-pipelinable-methods, we set the limit to 1.--Each method can run in a seperate thread, since methods do not-interact with each other. In fact, each unique method+uri can be a-seperate thread. We can use a MVar to track the global max download-count. Perhaps we also want a per host throttle, since it is the host-connect that is likely to max out, not the access method.--Plan:--partition fetches by (host,method).-fork off threads for each (host, method).-Use MVar to throttle per host, and total connections--We don't know if a method supports pipelining until we connect atleast-once. So if we have a non-pipelined method, we might want to start-multiple streams. On the other hand, for something like a CDROM, that-will just cause the system to thrash.--cdrom, file, etc, don't have a host, so that is not a unique key then.-Pipelining on local methods is tricky, because it is hard to tell if-the local methods point to the same device or not.--Even though we have multiple threads, the interactor can view the-incoming Stream as a single Stream because all the events are tagged-with the URI (i think). But, sending commands involves a fancy-router. We could include a reference to corresponding command for each-stream.--For now, let's serialize the transfers, but allow pipeling for methods-that really allow pipelining.---}--data FetchCallbacks-    = FetchCallbacks { logCB :: Message ->  IO ()-                     , statusCB :: URI -> Message -> IO ()-                     , uriStartCB :: URI -> Maybe Integer -> Maybe UTCTime -> Maybe Integer -> IO ()-                     , uriDoneCB ::  URI -> Maybe Integer -> Maybe UTCTime -> Maybe Integer -> Maybe FilePath -> Hashes -> Bool -> IO ()-                     , uriFailureCB :: URI -> Message -> IO ()-                     , generalFailureCB :: Message -> IO ()-                     , authorizationRequiredCB :: Site -> IO (Maybe (User, Password))-                     , mediaFailureCB :: Media -> Drive -> IO ()-                     , debugCB :: String -> IO ()-                     }--simpleFetch :: [ConfigItem] -> URI -> FilePath -> Maybe UTCTime -> IO Bool-simpleFetch = fetch cliFetchCallbacks---- |fetch a single item, show console output--- see also: getLastModified-fetch :: FetchCallbacks -> [ConfigItem] -> URI -> FilePath -> Maybe UTCTime -> IO Bool-fetch cb configItems uri fp lastModified =-    do withMethodURI uri $ \mh ->-        do s <- recvStatus mh-           debugCB cb ("<- " ++ show s)-           sendCommand' mh (URIAcquire uri fp lastModified)-           loop mh-    where-      sendCommand' mh c =-          do mapM_ (debugCB cb . ("-> " ++)) (formatCommand c)-             sendCommand mh c-      loop mh =-          do r <- recvStatus mh-             case r of-               Capabilities {} ->-                   do unless (null configItems) (sendCommand' mh (Configuration configItems))-                      loop mh-               LogMsg m ->-                   do logCB cb m-                      loop mh-               Status uri m ->-                   do statusCB cb uri m-                      loop mh-               URIStart uri size lastModified resumePoint ->-                   uriStartCB cb uri size lastModified resumePoint >> loop mh-               URIDone uri size lastModified resumePoint filename hashes imsHit ->-                   uriDoneCB cb uri size lastModified resumePoint filename hashes imsHit >> return True-               URIFailure uri message ->-                   uriFailureCB cb uri message >> return False-               GeneralFailure m -> generalFailureCB cb m >> return False-               AuthorizationRequired site ->-                   do mCredentials <- authorizationRequiredCB cb site-                      case mCredentials of-                        Nothing -> return False -- FIXME: do we need a force close option for closeMethod ?-                        Just (user, passwd) ->-                            do sendCommand' mh (AuthorizationCredentials site user passwd)-                               loop mh-               MediaFailure media drive ->-                    do mediaFailureCB cb media drive-                       return False---- |set of callbacks which do nothing.--- suitable for non-interactive usage. In the case authorization is--- required, no credentials will be supplied and the download should--- abort.-emptyFetchCallbacks =-    FetchCallbacks { logCB = \ _m -> return ()-                   , statusCB = \ _uri _m -> return ()-                   , uriStartCB = \ _uri _size _lastModified _resumePoint -> return ()-                   , uriDoneCB = \ _uri _size _lastModified _resumePoint _filename _hashes _imsHit -> return ()-                   , uriFailureCB = \ _uri _message -> return ()-                   , generalFailureCB = \ _m -> return ()-                   , authorizationRequiredCB = \ _site -> return Nothing-                   , mediaFailureCB = \ _media _drive -> return ()-                   , debugCB = \ _m -> return ()-                   }--cliFetchCallbacks =-    emptyFetchCallbacks { statusCB = \uri m -> putStrLn $ uriToString' uri ++ " : " ++ m-                        , uriStartCB = \ uri _size lastModified _resumePoint -> putStrLn $ uriToString' uri ++ " started. " ++ show lastModified-                        , uriDoneCB = \uri _size _lastModified _resumePoint _filename _hashes imsHit -> putStrLn $ uriToString' uri ++ (if imsHit then " cached." else " downloaded.")-                        , uriFailureCB = \uri message -> hPutStrLn stderr $ "URI Failure: " ++ uriToString' uri ++ " : " ++ message-                        , generalFailureCB = \message -> hPutStrLn stderr $ "General Failure: " ++ message-                        , authorizationRequiredCB = \site ->-                                                    do putStrLn $ "Authorization Required for " ++ site-                                                       putStrLn "Username: " >> hFlush stdout-                                                       user <- getLine-                                                       putStrLn "Password: " >> hFlush stdout-                                                       passwd <- getLine -- TODO: write a getPasswd function which does not echo input-                                                       return (Just (user, passwd))-                        , mediaFailureCB = \media drive -> hPutStrLn stderr $ "Media Failure: media=" ++ media ++" drive="++ drive-                        , debugCB = \m -> print m-                        }--{--    FetchCallbacks { logCB = \m -> hPutStrLn stderr m-                   , statusCB = \uri m -> putStrLn (show uri ++" : "++ m)-                   , uriStartCB = \uri-                   }--defaultAuthenticate site =-    do putStrLn $ "Authorization Required for " ++ site-       putStrLn "Username: " >> hFlush stdout-       user <- getLine-       putStrLn "Password: " >> hFlush stdout-       passwd <- getLine -- TODO: write a getPasswd function which does not echo input-       return (user, passwd)--}--{--    let itemsByHost = groupOn (regName . fst) items-    in-      do totalQSem <- newQSem 16 -- max number of streams allowed for-         forkIO-    where-      regName = fmap uriRegName . uriAuthority-      withQSem :: QSem -> IO a -> IO a-      withQSem qSem f = bracket (waitQSem qSem) (const $ signalQSem qSem) (const f)--uris = map (fromJust . parseURI) [ "http://n-heptane.com/whee"-                                 , "file:/one/two/three"-                                 , "ssh://jeremy:aoeu@n-heptane.com"-                                 , "cdrom:/one"-                                 ]--}---- * Misc Helper Functions--bool :: a -> a -> Bool -> a-bool f _ False = f-bool _ t True = t---getLastModified :: FilePath -> IO (Maybe UTCTime)-getLastModified fp =-    do e <- doesFileExist fp-       if e-          then getFileStatus fp >>= return . Just . epochTimeToUTCTime . modificationTime-          else return Nothing--{--groupOn :: (Ord b) => (a -> b) -> [a] -> [[a]]-groupOn f = groupBy ((==) `on` f) . sortBy (compare `on` f)--on :: (a -> a -> b) -> (c -> a) -> c -> c -> b-on f g x y = f (g x) (g y)--}

@@ -1,54 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- |Functions for dealing with source and binary packages in an abstract-way-module Debian.Apt.Package where---- Standard GHC Modules--import qualified Data.Map as Map---- Local Modules--import Debian.Version-import Debian.Relation--type PackageNameMap a = Map.Map BinPkgName [a]---- |'packageNameMap' creates a map from a package name to all the versions of that package--- NOTE: Provides are not included in the map--- NOTE: the sort order is random -- this is perhaps a bug--- see also: 'addProvides'-packageNameMap :: (a -> BinPkgName) -> [a] -> PackageNameMap a-packageNameMap getName packages = foldl (\m p -> Map.insertWith (++) (getName p) [p] m) Map.empty packages---- |'addProvides' finds packages that Provide other packages and adds--- them to the PackageNameMap. They will be adde to the end of the--- list, so that real packages have 'higher priority' than virtual--- packages.--- NOTE: Does not check for duplication or multiple use-addProvides :: (p -> [BinPkgName]) -> [p] -> PackageNameMap p -> PackageNameMap p-addProvides providesf ps pnm =-    let provides = findProvides providesf ps in-    foldl (\m (packageName, package) -> Map.insertWith (flip (++)) packageName [package] m) pnm provides---- |'findProvides'-findProvides :: forall p. (p -> [BinPkgName]) -> [p] -> [(BinPkgName, p)]-findProvides providesf packages = foldl addProvides' [] packages-    where addProvides' :: [(BinPkgName, p)] -> p -> [(BinPkgName, p)]-          addProvides' providesList package =-              foldl (\pl pkgName -> (pkgName, package): pl) providesList (providesf package)---- |'lookupPackageByRel' returns all the packages that satisfy the specified relation--- TODO: Add architecture check-lookupPackageByRel :: PackageNameMap a -> (a -> (BinPkgName, DebianVersion)) -> Relation -> [a]-lookupPackageByRel pm packageVersionF (Rel pkgName mVerReq _mArch) =-    case Map.lookup pkgName pm of-      Nothing -> []-      Just packages -> filter filterVer packages-    where filterVer p =-              case mVerReq of-                Nothing -> True-                Just _verReq ->-                    let (pName, pVersion) = packageVersionF p-                    in if pName /= pkgName-                       then False -- package is a virtual package, hence we can not do a version req-                       else checkVersionReq mVerReq (Just pVersion)

@@ -1,54 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}-module Debian.Arch-    ( Arch(..)-    , ArchOS(..)-    , ArchCPU(..)-    , prettyArch-    , parseArch-    ) where--import Data.Data (Data)-import Data.Monoid ((<>))-import Data.Typeable (Typeable)-import Text.PrettyPrint (Doc, text)--data ArchOS = ArchOS String | ArchOSAny deriving (Eq, Ord, Read, Show, Data, Typeable)--prettyOS :: ArchOS -> Doc-prettyOS (ArchOS s) = text s-prettyOS ArchOSAny = text "any"--parseOS :: String -> ArchOS-parseOS "any" = ArchOSAny-parseOS s = ArchOS s--data ArchCPU = ArchCPU String | ArchCPUAny deriving (Eq, Ord, Read, Show, Data, Typeable)--prettyCPU :: ArchCPU -> Doc-prettyCPU (ArchCPU s) = text s-prettyCPU ArchCPUAny = text "any"--parseCPU :: String -> ArchCPU-parseCPU "any" = ArchCPUAny-parseCPU s = ArchCPU s--data Arch-    = Source-    | All-    | Binary ArchOS ArchCPU-    deriving (Eq, Ord, Read, Show, Data, Typeable)--prettyArch :: Arch -> Doc-prettyArch Source = text "source"-prettyArch All = text "all"-prettyArch (Binary (ArchOS "linux") cpu) = prettyCPU cpu-prettyArch (Binary os cpu) = prettyOS os <> text "-" <> prettyCPU cpu--parseArch :: String -> Arch-parseArch s =-    case span (/= '-') s of-      ("source", "") -> Source-      ("all", "") -> All-      (cpu, "") -> Binary (ArchOS "linux") (parseCPU cpu)-      (os, '-' : cpu) -> Binary (parseOS os) (parseCPU cpu)-      _ -> error "parseArch: internal error"

@@ -1,350 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-missing-signatures #-}--- |Changelog and changes file support.-module Debian.Changes-    ( ChangesFile(..)-    , ChangedFileSpec(..)-    , changesFileName-    , ChangeLog(..)-    , ChangeLogEntry(..)-    , parseChangeLog-    , parseEntries -- was parseLog-    , parseEntry-    , parseChanges-    ) where--import Data.Either (partitionEithers)-import Data.List (intercalate, intersperse)-import Data.Monoid ((<>))-import Data.Text (Text, pack, unpack, strip)-import Debian.Arch (Arch, prettyArch)-import qualified Debian.Control.String as S-import Debian.Pretty (PP(..))-import Debian.Release-import Debian.URI()-import Debian.Version-import System.Posix.Types-import Text.Regex.TDFA hiding (empty)-import Text.PrettyPrint (Doc, text, hcat, render)-import Text.PrettyPrint.HughesPJClass (Pretty(pPrint))---- |A file generated by dpkg-buildpackage describing the result of a--- package build-data ChangesFile =-    Changes { changeDir :: FilePath             -- ^ The full pathname of the directory holding the .changes file.-            , changePackage :: String           -- ^ The package name parsed from the .changes file name-            , changeVersion :: DebianVersion    -- ^ The version number parsed from the .changes file name-            , changeRelease :: ReleaseName      -- ^ The Distribution field of the .changes file-            , changeArch :: Arch                -- ^ The architecture parsed from the .changes file name-            , changeInfo :: S.Paragraph' Text   -- ^ The contents of the .changes file-            , changeEntry :: ChangeLogEntry     -- ^ The value of the Changes field of the .changes file-            , changeFiles :: [ChangedFileSpec]  -- ^ The parsed value of the Files attribute-            } deriving (Eq, Read, Show)---- |An entry in the list of files generated by the build.-data ChangedFileSpec =-    ChangedFileSpec { changedFileMD5sum :: String-                    , changedFileSHA1sum :: String-                    , changedFileSHA256sum :: String-                    , changedFileSize :: FileOffset-                    , changedFileSection :: SubSection-                    , changedFilePriority :: String-                    , changedFileName :: FilePath-                    } deriving (Eq, Read, Show)---- |A changelog is a series of ChangeLogEntries-data ChangeLogEntry =-    Entry { logPackage :: String -- FIXME: Should be a SrcPkgName-          , logVersion :: DebianVersion-          , logDists :: [ReleaseName]-          , logUrgency :: String-          , logComments :: String-          , logWho :: String-          , logDate :: String-          }-  | WhiteSpace String -- ^ The parser here never returns this-  deriving (Eq, Read, Show)--newtype ChangeLog = ChangeLog [ChangeLogEntry] deriving (Eq, Read, Show)--{--instance Show ChangesFile where-    show = changesFileName--}--changesFileName :: ChangesFile -> String-changesFileName = render . pPrint . PP--instance Pretty (PP ChangesFile) where-    pPrint (PP changes) = text (changePackage changes ++ "_") <> prettyDebianVersion (changeVersion changes) <> text "_" <> prettyArch (changeArch changes) <> text ".changes"--instance Pretty (PP ChangedFileSpec) where-    pPrint (PP file) =-        text (changedFileMD5sum file <> " " <>-              show (changedFileSize file) <> " " <>-              sectionName (changedFileSection file) <> " " <>-              changedFilePriority file <> " " <>-              changedFileName file)--instance Pretty (PP ChangeLogEntry) where-    pPrint (PP (Entry package ver dists urgency details who date)) =-        hcat [ text package <> text " (" <> prettyDebianVersion ver <> text (") " <> intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency)-             , text "\n\n"-             , text "  " <> text (strip' details)-             , text "\n\n"-             , text (" -- " <> who <> "  " <> date)-             , text "\n" ]-    pPrint (PP (WhiteSpace _)) = error "instance Pretty ChangeLogEntry"--instance Pretty (PP [ChangeLogEntry]) where-    pPrint = hcat . intersperse (text "\n") . map (pPrint . PP) . unPP--strip' = unpack . strip . pack--instance Pretty (PP ChangeLog) where-    pPrint (PP (ChangeLog xs)) = hcat (intersperse (text "\n") (map (pPrint . PP) xs))---- |Show just the top line of a changelog entry (for debugging output.)-_showHeader :: ChangeLogEntry -> Doc-_showHeader (Entry package ver dists urgency _ _ _) =-    text (package <> " (") <> prettyDebianVersion ver <> text (") " <> intercalate " " (map releaseName' dists) <> "; urgency=" <> urgency <> "...")-_showHeader (WhiteSpace _) = error "_showHeader"--{--format is a series of entries like this:--     package (version) distribution(s); urgency=urgency-    [optional blank line(s), stripped]-       * change details-         more change details-    [blank line(s), included in output of dpkg-parsechangelog]-       * even more change details-    [optional blank line(s), stripped]-      -- maintainer name <email address>[two spaces]  date--package and version are the source package name and version number.--distribution(s) lists the distributions where this version should be-installed when it is uploaded - it is copied to the Distribution field-in the .changes file. See Distribution, Section 5.6.14.--urgency is the value for the Urgency field in the .changes file for-the upload (see Urgency, Section 5.6.17). It is not possible to-specify an urgency containing commas; commas are used to separate-keyword=value settings in the dpkg changelog format (though there is-currently only one useful keyword, urgency).--The change details may in fact be any series of lines starting with at-least two spaces, but conventionally each change starts with an-asterisk and a separating space and continuation lines are indented so-as to bring them in line with the start of the text above. Blank lines-may be used here to separate groups of changes, if desired.--If this upload resolves bugs recorded in the Bug Tracking System-(BTS), they may be automatically closed on the inclusion of this-package into the Debian archive by including the string: closes:-Bug#nnnnn in the change details.[16] This information is conveyed via-the Closes field in the .changes file (see Closes, Section 5.6.22).--The maintainer name and email address used in the changelog should be-the details of the person uploading this version. They are not-necessarily those of the usual package maintainer. The information-here will be copied to the Changed-By field in the .changes file (see-Changed-By, Section 5.6.4), and then later used to send an-acknowledgement when the upload has been installed.--The date must be in RFC822 format[17]; it must include the time zone-specified numerically, with the time zone name or abbreviation-optionally present as a comment in parentheses.--The first "title" line with the package name must start at the left-hand margin. The "trailer" line with the maintainer and date details-must be preceded by exactly one space. The maintainer details and the-date must be separated by exactly two spaces.--The entire changelog must be encoded in UTF-8.--}---- | Parse the entries of a debian changelog and verify they are all--- valid.-parseChangeLog :: String -> ChangeLog-parseChangeLog s =-    case partitionEithers (parseEntries s) of-      ([], xs) -> ChangeLog xs-      (ss, _) -> error (intercalate "\n  " ("Error(s) parsing changelog:" : concat ss))---- |Parse a Debian Changelog and return a lazy list of entries-parseEntries :: String -> [Either [String] ChangeLogEntry]-parseEntries "" = []-parseEntries text =-    case parseEntry text of-      Left messages -> [Left messages]-      Right (entry, text') -> Right entry : parseEntries text'---- |Parse a single changelog entry, returning the entry and the remaining text.-{--parseEntry :: String -> Failing (ChangeLogEntry, String)-parseEntry text =-    case span (\ x -> elem x " \t\n") text of-      ("", _) ->-          case matchRegexAll entryRE text of-            Nothing -> Failure ["Parse error in changelog:\n" ++ show text]-            Just ("", _, remaining, [_, name, version, dists, urgency, _, details, _, _, _, _, _, who, date, _]) ->-                Success (Entry name-                               (parseDebianVersion version)-                               (map parseReleaseName . words $ dists)-                               urgency-                               details-                               who-                               date,-                         remaining)-            Just (before, _, remaining, submatches) ->-                Failure ["Internal error:\n  text=" ++ show text ++ "\n before=" ++ show before ++ "\n  remaining=" ++ show remaining ++ ", submatches=" ++ show submatches]-      (w, text') -> Success (WhiteSpace (trace ("whitespace: " ++ show w) w), text')--}--parseEntry :: String -> Either [String] (ChangeLogEntry, String)-parseEntry text =-    case text =~ entryRE :: MatchResult String of-      x | mrSubList x == [] -> Left ["Parse error in " ++ show text]-      MR {mrAfter = after, mrSubList = [_, name, ver, dists, urgency, _, details, _, _, who, _, date, _]} ->-          Right (Entry name-                         (parseDebianVersion' ver)-                         (map parseReleaseName . words $ dists)-                         urgency-                         ("  " ++ unpack (strip (pack details)) ++ "\n")-                         (take (length who - 2) who)-                         date,-                   after)-      MR {mrBefore = _before, mrMatch = _matched, mrAfter = after, mrSubList = matches} ->-          Left ["Internal error\n after=" ++ show after ++ "\n " ++ show (length matches) ++ " matches: " ++ show matches]-{--parseREs :: [Regex] -> String -> Failing ([String], String)-parseREs res text =-    foldr f (Success ([], text)) entryREs-    where-      f _ (Failure msgs) = Failure msgs-      f re (Success (oldMatches, text)) =-          case matchRegexAll re text of-            Nothing -> Failure ["Parse error at " ++ show text]-            Just (before, matched, after, newMatches) ->-                Success (oldMatches ++ trace ("newMatches=" ++ show newMatches) newMatches, after)--}--entryRE = bol ++ blankLines ++ headerRE ++ changeDetails ++ signature ++ blankLines-changeDetails = "((\n| \n| -\n|([^ ]| [^--]| -[^--])[^\n]*\n)*)"-signature = " -- ([ ]*([^ ]+ )* )([^\n]*)\n"--{--entryRE = mkRegexWithOpts (bol ++ blankLines ++ headerRE ++ nonSigLines ++ blankLines ++ signature ++ blankLines) False True-nonSigLines = "(((  .*|\t.*| \t.*)|([ \t]*)\n)+)"--- In the debian repository, sometimes the extra space in front of the--- day-of-month is missing, sometimes an extra one is added.-signature = "( -- ([^\n]*)  (..., ? ?.. ... .... ........ .....))[ \t]*\n"--}---- |Parse the changelog information that shows up in the .changes--- file, i.e. a changelog entry with no signature.-parseChanges :: Text -> Maybe ChangeLogEntry-parseChanges text =-    case unpack text =~ changesRE :: MatchResult String of-      MR {mrSubList = []} -> Nothing-      MR {mrSubList = [_, name, ver, dists, urgency, _, details]} ->-          Just $ Entry name-                       (parseDebianVersion' ver)-                       (map parseReleaseName . words $ dists)-                       urgency-                       details-                       "" ""-      MR {mrSubList = x} -> error $ "Unexpected match: " ++ show x-    where-      changesRE = bol ++ blankLines ++ optWhite ++ headerRE ++ "(.*)$"--headerRE =-    package ++ ver ++ dists ++ urgency-    where-      package = "([^ \t(]*)" ++ optWhite-      ver = "\\(([^)]*)\\)" ++ optWhite-      dists = "([^;]*);" ++ optWhite-      urgency = "urgency=([^\n]*)\n" ++ blankLines--blankLines = blankLine ++ "*"-blankLine = "(" ++ optWhite ++ "\n)"-optWhite = "[ \t]*"-bol = "^"---- This can be used for tests-_s1 = unlines-     ["haskell-regex-compat (0.92-3+seereason1~jaunty4) jaunty-seereason; urgency=low",-      "",-      "  [ Joachim Breitner ]",-      "  * Adjust priority according to override file",-      "  * Depend on hscolour (Closes: #550769)",-      "",-      "  [ Marco Túlio Gontijo e Silva ]",-      "  * debian/control: Use more sintetic name for Vcs-Darcs.",-      "  * Built from sid apt pool",-      "  * Build dependency changes:",-      "     cpphs:                    1.9-1+seereason1~jaunty5     -> 1.9-1+seereason1~jaunty6",-      "     ghc6:                     6.10.4-1+seereason5~jaunty1  -> 6.12.1-0+seereason1~jaunty1",-      "     ghc6-doc:                 6.10.4-1+seereason5~jaunty1  -> 6.12.1-0+seereason1~jaunty1",-      "     ghc6-prof:                6.10.4-1+seereason5~jaunty1  -> 6.12.1-0+seereason1~jaunty1",-      "     haddock:                  2.4.2-3+seereason3~jaunty1   -> 6.12.1-0+seereason1~jaunty1",-      "     haskell-devscripts:       0.6.18-21+seereason1~jaunty1 -> 0.6.18-23+seereason1~jaunty1",-      "     haskell-regex-base-doc:   0.93.1-5+seereason1~jaunty1  -> 0.93.1-5++1+seereason1~jaunty1",-      "     haskell-regex-posix-doc:  0.93.2-4+seereason1~jaunty1  -> 0.93.2-4+seereason1~jaunty2",-      "     libghc6-regex-base-dev:   0.93.1-5+seereason1~jaunty1  -> 0.93.1-5++1+seereason1~jaunty1",-      "     libghc6-regex-base-prof:  0.93.1-5+seereason1~jaunty1  -> 0.93.1-5++1+seereason1~jaunty1",-      "     libghc6-regex-posix-dev:  0.93.2-4+seereason1~jaunty1  -> 0.93.2-4+seereason1~jaunty2",-      "     libghc6-regex-posix-prof: 0.93.2-4+seereason1~jaunty1  -> 0.93.2-4+seereason1~jaunty2",-      "",-      " -- SeeReason Autobuilder <autobuilder@seereason.org>  Fri, 25 Dec 2009 01:55:37 -0800",-      "",-      "haskell-regex-compat (0.92-3) unstable; urgency=low",-      "",-      "  [ Joachim Breitner ]",-      "  * Adjust priority according to override file",-      "  * Depend on hscolour (Closes: #550769)",-      "",-      "  [ Marco Túlio Gontijo e Silva ]",-      "  * debian/control: Use more sintetic name for Vcs-Darcs.",-      "",-      " -- Joachim Breitner <nomeata@debian.org>  Mon, 20 Jul 2009 13:05:35 +0200",-      "",-      "haskell-regex-compat (0.92-2) unstable; urgency=low",-      "",-      "  * Adopt package for the Debian Haskell Group",-      "  * Fix \"FTBFS with new dpkg-dev\" by adding comma to debian/control",-      "    (Closes: #536473)",-      "",-      " -- Joachim Breitner <nomeata@debian.org>  Mon, 20 Jul 2009 12:05:40 +0200",-      "",-      "haskell-regex-compat (0.92-1.1) unstable; urgency=low",-      "",-      "  * Rebuild for GHC 6.10.",-      "  * NMU with permission of the author.",-      "",-      " -- John Goerzen <jgoerzen@complete.org>  Mon, 16 Mar 2009 10:12:04 -0500",-      "",-      "haskell-regex-compat (0.92-1) unstable; urgency=low",-      "",-      "  * New upstream release",-      "  * debian/control:",-      "    - Bump Standards-Version. No changes needed.",-      "",-      " -- Arjan Oosting <arjan@debian.org>  Sun, 18 Jan 2009 00:05:02 +0100",-      "",-      "haskell-regex-compat (0.91-1) unstable; urgency=low",-      "",-      "  * Take over package from Ian, as I already maintain haskell-regex-base,",-      "    and move Ian to the Uploaders field.",-      "  * Packaging complete redone (based on my haskell-regex-base package).",-      "",-      " -- Arjan Oosting <arjan@debian.org>  Sat, 19 Jan 2008 16:48:39 +0100",-      "",-      "haskell-regex-compat (0.71.0.1-1) unstable; urgency=low",-      " ",-      "  * Initial release (used to be part of ghc6).",-      "  * Using \"Generic Haskell cabal library packaging files v9\".",-      "  ",-      " -- Ian Lynagh (wibble) <igloo@debian.org>  Wed, 21 Nov 2007 01:26:57 +0000"]

@@ -1,74 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- |A module for working with Debian control files <http://www.debian.org/doc/debian-policy/ch-controlfields.html>-module Debian.Control-    ( -- * Types-      Control'(..)-    , Paragraph'(..)-    , Field'(..)-    , Control-    , Paragraph-    , Field-    , ControlParser-    , ControlFunctions(..)-    -- * Control File Parser-    , pControl-    -- * Helper Functions-    , mergeControls-    , fieldValue-    , removeField-    , prependFields-    , appendFields-    , renameField-    , modifyField-    , raiseFields-    , packParagraph-    , packField-    , formatControl-    , formatParagraph-    , formatField-    -- * Policy classes and functions-    , P.HasDebianControl(..)-    , P.ControlFileError(..)-    , P.parseDebianControlFromFile-    , P.validateDebianControl-    , P.unsafeDebianControl-    , P.debianSourceParagraph-    , P.debianBinaryParagraphs-    , P.debianPackageParagraphs-    , P.debianPackageNames-    , P.debianSourcePackageName-    , P.debianBinaryPackageNames-    , P.debianRelations-    , P.debianBuildDeps-    , P.debianBuildDepsIndep-    ) where----import Control.Monad---import Data.List---import Text.ParserCombinators.Parsec---import System.IO-import Debian.Control.Common-import Debian.Control.String-import Data.List-import Data.Text as T (Text, pack, concat)-import qualified Debian.Control.Text as T-import qualified Debian.Control.ByteString as B ()-import qualified Debian.Control.Policy as P-import qualified Debian.Control.String as S--packParagraph :: S.Paragraph -> T.Paragraph-packParagraph (S.Paragraph s) = T.Paragraph (map packField s)--packField :: Field' String -> Field' Text-packField (S.Field (name, value)) = T.Field (T.pack name, T.pack value)-packField (S.Comment s) = T.Comment (T.pack s)--formatControl :: Control' Text -> [Text]-formatControl (T.Control paragraphs) = intersperse (T.pack "\n") . map formatParagraph $ paragraphs--formatParagraph :: Paragraph' Text -> Text-formatParagraph (T.Paragraph fields) = T.concat . map formatField $ fields--formatField :: Field' Text -> Text-formatField (T.Field (name, value)) = T.concat [name, T.pack ":", value, T.pack "\n"]-formatField (T.Comment s) = s

@@ -1,289 +0,0 @@-{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses, PackageImports, ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}-module Debian.Control.ByteString-    ( Control'(..)-    , Paragraph'(..)-    , Field'(..)-    , Control-    , Paragraph-    , Field-    , ControlFunctions(..)-    -- * Helper Functions-    , mergeControls-    , fieldValue-    , removeField-    , prependFields-    , appendFields-    , renameField-    , modifyField-    , raiseFields-    ) where---- Standard GHC modules--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative (Applicative(..))-#endif-import Control.Applicative (Alternative(..))-import qualified Control.Exception as E-import "mtl" Control.Monad.State--import Data.Char(toLower, isSpace, chr, ord)-import Data.Word (Word8)-import Data.List-import qualified Data.ListLike as LL-import qualified Data.ListLike.String as LL--import Text.ParserCombinators.Parsec.Error-import Text.ParserCombinators.Parsec.Pos---- Third Party Modules--import qualified Data.ByteString.Char8 as C--import Debian.Control.Common hiding (protectFieldText')---- Local Modules---- import ByteStreamParser---- * Types-{--newtype Control = Control [Paragraph]-newtype Paragraph = Paragraph [Field]-newtype Field = Field (C.ByteString, C.ByteString)--}--type Control = Control' C.ByteString-type Paragraph = Paragraph' C.ByteString-type Field = Field'  C.ByteString--- * Control Parser--type ControlParser a = Parser C.ByteString a--pKey :: ControlParser C.ByteString-pKey = notEmpty $ pTakeWhile (\c -> (c /= ':') && (c /= '\n'))--pValue :: ControlParser C.ByteString-pValue = Parser $ \bs ->-    let newlines = C.elemIndices '\n' bs-        rest = dropWhile continuedAfter newlines ++ [C.length bs]-        continuedAfter i = bs `safeIndex` (i+1) `elem` map Just " \t#"-        (text, bs') = C.splitAt (head rest) bs-    in Ok (text, bs')--pField :: ControlParser Field-pField =-    do k <- pKey-       _ <- pChar ':'-       v <- pValue---       pChar '\n'-       (pChar '\n' >> return ()) <|> pEOF-       return (Field (k,v))--pComment :: ControlParser Field-pComment = Parser $ \bs ->-    let newlines = C.elemIndices '\n' bs-        linestarts = 0 : map (+1) newlines-        rest = dropWhile commentAt linestarts ++ [C.length bs]-        commentAt i = bs `safeIndex` i == Just '#'-        (text, bs') = C.splitAt (head rest) bs-    in if C.null text-       then Empty-       else Ok (Comment text, bs')--pParagraph :: ControlParser Paragraph-pParagraph =-    do f <- pMany1 (pComment <|> pField)-       pSkipMany (pChar '\n')-       return (Paragraph f)--pControl :: ControlParser Control-pControl =-    do pSkipMany (pChar '\n')-       c <- pMany pParagraph-       return (Control c)----- parseControlFromFile :: FilePath -> IO (Either String Control)--instance ControlFunctions C.ByteString where-    parseControlFromFile fp =-        do c <- C.readFile fp-           case parse pControl c of-             Nothing -> return (Left (newErrorMessage (Message ("Failed to parse " ++ fp)) (newPos fp 0 0)))-             (Just (cntl,_)) -> return (Right cntl)-    parseControlFromHandle sourceName handle =-        E.try (C.hGetContents handle) >>=-        either (\ (e :: E.SomeException) -> error ("parseControlFromHandle ByteString: Failure parsing " ++ sourceName ++ ": " ++ show e)) (return . parseControl sourceName)-    parseControl sourceName c =-        do case parse pControl c of-             Nothing -> Left (newErrorMessage (Message ("Failed to parse " ++ sourceName)) (newPos sourceName 0 0))-             Just (cntl,_) -> Right cntl-    lookupP fieldName (Paragraph fields) =-        let pFieldName = C.pack (map toLower fieldName) in-        find (\ (Field (fieldName',_)) -> C.map toLower fieldName' == pFieldName) fields-    -- NOTE: probably inefficient-    stripWS = C.reverse . strip . C.reverse . strip-        where strip = C.dropWhile (flip elem " \t")-    protectFieldText = protectFieldText'-    asString = C.unpack--protectFieldText' :: (LL.StringLike a, LL.ListLike a Word8) => ControlFunctions a => a -> a-protectFieldText' s =-    case LL.lines s of-      [] -> LL.empty-      (l : ls) -> dropWhileEnd (isSpace . chr . fromIntegral) $ LL.unlines $ l : map protect ls-    where-      dropWhileEnd :: (LL.StringLike a, LL.ListLike a Word8) => (Word8 -> Bool) -> a -> a-      dropWhileEnd func = LL.reverse . LL.dropWhile func . LL.reverse -- foldr (\x xs -> if func x && LL.null xs then LL.empty else LL.cons x xs) empty-      protect :: (LL.StringLike a, LL.ListLike a Word8) => a -> a-      protect l = maybe LL.empty (\ c -> if isHorizSpace c then l else LL.cons (ord' ' ' :: Word8) l) (LL.find (const True :: Word8 -> Bool) l)-      -- isSpace' = isSpace . chr'-      isHorizSpace c = elem c (map ord' " \t")-      ord' = fromIntegral . ord-      -- chr' = chr . fromIntegral--{--main =-    do [fp] <- getArgs-       C.readFile fp >>= \c -> maybe (putStrLn "failed.") (print . length . fst) (parse pControl c)--}--- * Helper Functions--safeIndex :: C.ByteString -> Int -> Maybe Char-bs `safeIndex` i = if i < C.length bs then Just (bs `C.index` i) else Nothing---- * Parser--data Result a-    = Ok a-    | Fail-    | Empty-      deriving Show---- m2r :: Maybe a -> Result a--- m2r (Just a) = Ok a--- m2r Nothing = Empty--r2m :: Result a -> Maybe a-r2m (Ok a) = Just a-r2m _ = Nothing--newtype Parser state a = Parser { unParser :: (state -> Result (a, state)) }--instance Functor (Parser state) where-    fmap f m =-        Parser $ \ state ->-            let r = (unParser m) state in-            case r of-              Ok (a,state') -> Ok (f a,state')-              Empty -> Empty-              Fail -> Fail--instance Applicative (Parser state) where-    pure = return-    (<*>) = ap--instance Alternative (Parser state) where-    empty =-        Parser $ \state ->-            (unParser mzero) state-    (<|>) = mplus--instance Monad (Parser state) where-    return a = Parser (\s -> Ok (a,s))-    m >>= f =-        Parser $ \state ->-            let r = (unParser m) state in-            case r of-              Ok (a,state') ->-                  case unParser (f a) $ state' of-                    Empty -> Fail-                    o -> o-              Empty -> Empty-              Fail -> Fail--instance MonadPlus (Parser state) where-    mzero = Parser (const Empty)-    mplus (Parser p1) (Parser p2) =-        Parser (\s -> case p1 s of-                        Empty -> p2 s-                        o -> o-               )----       Parser (\s -> maybe (p2 s) (Just) (p1 s))---_pSucceed :: a -> Parser state a-_pSucceed = return--_pFail :: Parser state a-_pFail = Parser (const Empty)---satisfy :: (Char -> Bool) -> Parser C.ByteString Char-satisfy f =-    Parser $ \bs ->-        if C.null bs-        then Empty-        else let (s,ss) = (C.head bs, C.tail bs) in-             if (f s)-                then Ok (s,ss)-                else Empty--pChar :: Char -> Parser C.ByteString Char-pChar c = satisfy ((==) c)---_try :: Parser state a -> Parser state a-_try (Parser p) =-    Parser $ \bs -> case (p bs) of-                      Fail -> Empty-                      o -> o--pEOF :: Parser C.ByteString ()-pEOF =-    Parser $ \bs -> if C.null bs then Ok ((),bs) else Empty--pTakeWhile :: (Char -> Bool) -> Parser C.ByteString C.ByteString-pTakeWhile f =-    Parser $ \bs -> Ok (C.span f bs)--_pSkipWhile :: (Char -> Bool) -> Parser C.ByteString ()-_pSkipWhile p =-    Parser $ \bs -> Ok ((), C.dropWhile p bs)--pMany ::  Parser st a -> Parser st [a]-pMany p-    = scan id-    where-      scan f = do x <- p-                  scan (\tail -> f (x:tail))-               <|> return (f [])--notEmpty :: Parser st C.ByteString -> Parser st C.ByteString-notEmpty (Parser p) =-    Parser $ \s -> case p s of-                     o@(Ok (a, _s)) ->-                         if C.null a-                         then Empty-                         else o-                     x -> x--pMany1 :: Parser st a -> Parser st [a]-pMany1 p =-    do x <- p-       xs <- pMany p-       return (x:xs)--pSkipMany :: Parser st a -> Parser st ()-pSkipMany p = scan-    where-      scan = (p >> scan) <|> return ()--_pSkipMany1 :: Parser st a -> Parser st ()-_pSkipMany1 p = p >> pSkipMany p--parse :: Parser state a -> state -> Maybe (a, state)-parse p s = r2m ((unParser p) s)

@@ -1,191 +0,0 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, UndecidableInstances #-}-module Debian.Control.Common-    ( -- * Types-      Control'(..)-    , Paragraph'(..)-    , Field'(..)-    , ControlFunctions(..)-    , mergeControls-    , fieldValue-    , removeField-    , prependFields-    , appendFields-    , renameField-    , modifyField-    , raiseFields-    , parseControlFromCmd-    , md5sumField-    , protectFieldText'-    )-    where--import Data.Char (isSpace)-import Data.List as List (dropWhileEnd, partition, intersperse)-import Data.ListLike as LL (ListLike, cons, dropWhileEnd, empty, find, null, singleton)-import Data.ListLike.String as LL (StringLike, lines, unlines)-import Data.Monoid ((<>))-import Debian.Pretty (PP(..))-import System.Exit (ExitCode(ExitSuccess, ExitFailure))-import System.IO (Handle)-import System.Process (runInteractiveCommand, waitForProcess)-import Text.ParserCombinators.Parsec (ParseError)-import Text.PrettyPrint (Doc, text, hcat)-import Text.PrettyPrint.HughesPJClass (Pretty(pPrint))--newtype Control' a-    = Control { unControl :: [Paragraph' a] } deriving (Eq, Ord, Read, Show)--newtype Paragraph' a-    = Paragraph [Field' a]-    deriving (Eq, Ord, Read, Show)---- |NOTE: we do not strip the leading or trailing whitespace in the--- name or value-data Field' a-    = Field (a, a)-    | Comment a     -- ^ Lines beginning with #-      deriving (Eq, Ord, Read, Show)--class ControlFunctions a where-    -- |'parseControlFromFile' @filepath@ is a simple wrapper function-    -- that parses @filepath@ using 'pControl'-    parseControlFromFile :: FilePath -> IO (Either ParseError (Control' a))-    -- |'parseControlFromHandle' @sourceName@ @handle@ - @sourceName@ is only used for error reporting-    parseControlFromHandle :: String -> Handle -> IO (Either ParseError (Control' a))-    -- |'parseControlFromString' @sourceName@ @text@ - @sourceName@ is only used for error reporting-    parseControl :: String -> a -> (Either ParseError (Control' a))-    -- | 'lookupP' @fieldName paragraph@ looks up a 'Field' in a 'Paragraph'.-    -- @N.B.@ trailing and leading whitespace is /not/ stripped.-    lookupP :: String -> (Paragraph' a) -> Maybe (Field' a)-    -- |Strip the trailing and leading space and tab characters from a-    -- string. Folded whitespace is /not/ unfolded. This should probably-    -- be moved to someplace more general purpose.-    stripWS :: a -> a-    -- |Protect field value text so the parser doesn't split it into-    -- multiple fields or paragraphs.  This must modify all field text-    -- to enforce two conditions: (1) All lines other than the initial-    -- one must begin with a space or a tab, and (2) the trailing-    -- white space must not contain newlines.  This is called before-    -- pretty printing to prevent the parser from misinterpreting-    -- field text as multiple fields or paragraphs.-    protectFieldText :: a -> a-    asString :: a -> String---- | This can usually be used as the implementation of protectFieldText-protectFieldText' :: forall a. (StringLike a, ListLike a Char) => ControlFunctions a => a -> a-protectFieldText' s =-    let trimmedLines :: [a]-        trimmedLines = map (LL.dropWhileEnd isSpace :: a -> a) $ (LL.lines s :: [a])-        strippedLines :: [a]-        strippedLines = List.dropWhileEnd LL.null trimmedLines in-    -- Split the text into lines, drop trailing whitespace from each-    -- line, and drop trailing blank lines.-    case strippedLines of-      [] -> empty-      (l : ls) ->-          let -- The first line is indented one space-              l' = {-LL.cons ' '-} l-              -- Null lines are replaced by a single '.'  If any line-              -- is unindented, all will get an additional space of-              -- indentation.-              ls' = case all indented ls of-                      True -> map (\ x -> if LL.null x then (LL.cons ' ' $ singleton '.') else x) ls-                      False -> map (LL.cons ' ') $ map (\ x -> if LL.null x then (singleton '.') else x) ls in-          LL.dropWhileEnd isSpace (LL.unlines (l' : ls'))-    where-      indented l = maybe True isSpace (LL.find (const True) l)---- | This may have bad performance issues (dsf: Whoever wrote this--- comment should have explained why.)-instance (ControlFunctions a, Pretty (PP a)) => Pretty (Control' a) where-    pPrint = ppControl-instance (ControlFunctions a, Pretty (PP a)) => Pretty (Paragraph' a) where-    pPrint = ppParagraph--instance (ControlFunctions a, Pretty (PP a)) => Pretty (Field' a) where-    pPrint = ppField--ppControl :: (ControlFunctions a, Pretty (PP a)) => Control' a -> Doc-ppControl (Control paragraph) =-    hcat (intersperse (text "\n") (map ppParagraph paragraph))--ppParagraph :: (ControlFunctions a, Pretty (PP a)) => Paragraph' a -> Doc-ppParagraph (Paragraph fields) =-    hcat (map (\ x -> ppField x <> text "\n") fields)--ppField :: (ControlFunctions a, Pretty (PP a)) => Field' a -> Doc-ppField (Field (n,v)) = pPrint (PP n) <> text ":" <> pPrint (PP (protectFieldText v))-ppField (Comment c) = pPrint (PP c)--mergeControls :: [Control' a] -> Control' a-mergeControls controls =-    Control (concatMap unControl controls)--fieldValue :: (ControlFunctions a) => String -> Paragraph' a -> Maybe a-fieldValue fieldName paragraph =-    case lookupP fieldName paragraph of-      Just (Field (_, val)) -> Just $ stripWS val-      _ -> Nothing--removeField :: (Eq a) => a -> Paragraph' a -> Paragraph' a-removeField toRemove (Paragraph fields) =-    Paragraph (filter remove fields)-    where-      remove (Field (name,_)) = name == toRemove-      remove (Comment _) = False--prependFields :: [Field' a] -> Paragraph' a -> Paragraph' a-prependFields newfields (Paragraph fields) = Paragraph (newfields ++ fields)--appendFields :: [Field' a] -> Paragraph' a -> Paragraph' a-appendFields newfields (Paragraph fields) = Paragraph (fields ++ newfields)--renameField :: (Eq a) => a -> a -> Paragraph' a -> Paragraph' a-renameField oldname newname (Paragraph fields) =-    Paragraph (map rename fields)-    where-      rename (Field (name, value)) | name == oldname = Field (newname, value)-      rename field = field--modifyField :: (Eq a) => a -> (a -> a) -> Paragraph' a -> Paragraph' a-modifyField name f (Paragraph fields) =-    Paragraph (map modify fields)-    where-      modify (Field (name', value)) | name' == name = Field (name, f value)-      modify field = field---- | Move selected fields to the beginning of a paragraph.-raiseFields :: (Eq a) => (a -> Bool) -> Paragraph' a -> Paragraph' a-raiseFields f (Paragraph fields) =-    let (a, b) = partition f' fields in Paragraph (a ++ b)-    where f' (Field (name, _)) = f name-          f' (Comment _) = False---- | Run a command and parse its output as a control file.-parseControlFromCmd :: ControlFunctions a => String -> IO (Either String (Control' a))-parseControlFromCmd cmd =-    do-      (_, outh, _, handle) <- runInteractiveCommand cmd-      result <- parseControlFromHandle cmd outh-      either (return . Left . show) (finish handle) result-    where-      finish handle control =-          do-            exitCode <- waitForProcess handle-            case exitCode of-              ExitSuccess -> return $ Right control-              ExitFailure n -> return $ Left ("Failure: " ++ cmd ++ " -> " ++ show n)---- |look up the md5sum file in a paragraph--- Tries several different variations:---  MD5Sum:---  Md5Sum:---  MD5sum:-md5sumField :: (ControlFunctions a) => Paragraph' a -> Maybe a-md5sumField p =-    case fieldValue "MD5Sum" p of-      m@(Just _) -> m-      Nothing ->-          case fieldValue "Md5Sum" p of-            m@(Just _) -> m-            Nothing -> fieldValue "MD5sum" p

@@ -1,180 +0,0 @@-{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-}-{-# OPTIONS_GHC -Wall #-}--- | Access to things that Debian policy says should be in a valid--- control file.  The pure functions will not throw ControlFileError--- if they are operating on a DebianControl value returned by--- validateDebianControl.  However, they might if they are created--- using unsafeDebianControl.-module Debian.Control.Policy-    ( -- * Validated debian control file type-      DebianControl(unDebianControl)-    , validateDebianControl-    , unsafeDebianControl-    , parseDebianControlFromFile-    , parseDebianControl-    , ControlFileError(..)-    -- * Class of things that contain one DebianControl value-    , HasDebianControl(debianControl)-    -- * Pure functions that operate on validated control files-    , debianSourceParagraph-    , debianBinaryParagraphs-    , debianPackageParagraphs-    , debianPackageNames-    , debianSourcePackageName-    , debianBinaryPackageNames-    , debianRelations-    , debianBuildDeps-    , debianBuildDepsIndep-    ) where--import Control.Exception (Exception, throw)-import Control.Monad.Catch (MonadCatch, try)-import Data.List (intercalate)-import Data.Text (Text)-import Data.Typeable (Typeable)-import Data.ListLike (toList)-import Debian.Control.Common (Control'(..), Paragraph'(..), Field'(..), fieldValue, ControlFunctions(parseControlFromFile, parseControl))-import Debian.Control.Text ()-import Debian.Loc (__LOC__)-import Debian.Pretty (prettyShow)-import Debian.Relation (SrcPkgName(..), BinPkgName(..), Relations, parseRelations)-import Debian.Relation.Text ()-import Language.Haskell.TH (Loc(..))-import Prelude hiding (ioError)--- import qualified Debug.ShowPlease as Please-import Text.Parsec.Error (ParseError)---- | Opaque (constructor not exported) type to hold a validated Debian--- Control File-data DebianControl = DebianControl {unDebianControl :: Control' Text}--instance Show DebianControl where-    show c = "(parseDebianControl \"\" " ++ show (prettyShow (unDebianControl c)) ++ ")"---- | Validate and return a control file in an opaque wrapper.  May--- throw a ControlFileError.  Currently we only verify that it has a--- Source field in the first paragraph and one or more subsequent--- paragraphs each with a Package field, and no syntax errors in the--- build dependencies (though they may be absent.)-validateDebianControl :: MonadCatch m => Control' Text -> m (Either ControlFileError DebianControl)-validateDebianControl ctl =-    try (do _ <- return $ debianPackageNames (DebianControl ctl)-            _ <- return $ debianBuildDeps (DebianControl ctl)-            _ <- return $ debianBuildDepsIndep (DebianControl ctl)-            return ()) >>=-    return . either Left (\ _ -> Right $ DebianControl ctl)--unsafeDebianControl :: Control' Text -> DebianControl-unsafeDebianControl = DebianControl--parseDebianControl :: MonadCatch m => String -> Text -> m (Either ControlFileError DebianControl)-parseDebianControl sourceName s = either (return . Left . ParseControlError [$__LOC__]) validateDebianControl (parseControl sourceName s)--parseDebianControlFromFile :: FilePath -> IO (Either ControlFileError DebianControl)-parseDebianControlFromFile controlPath =-  try (parseControlFromFile controlPath) >>=-  either (return . Left . IOError [$__LOC__])-         (either (return . Left . ParseControlError [$__LOC__]) validateDebianControl)---- | Class of things that contain a validated Debian control file.-class HasDebianControl a where-    debianControl :: a -> DebianControl--instance HasDebianControl DebianControl where-    debianControl = id--class HasControl a where-    control :: a -> Control' Text--instance HasControl (Control' Text) where-    control = id--instance HasControl DebianControl where-    control = unDebianControl---- | Errors that control files might throw, with source file name and--- line number generated by template haskell.-data ControlFileError-    = NoParagraphs        {locs :: [Loc]}-    | NoBinaryParagraphs  {locs :: [Loc]}-    | MissingField        {locs :: [Loc], field :: String}-    | ParseRelationsError {locs :: [Loc], parseError :: ParseError}-    | ParseControlError   {locs :: [Loc], parseError :: ParseError}-    | IOError             {locs :: [Loc], ioError :: IOError}-    deriving Typeable--instance Show ControlFileError where-    show (NoParagraphs {..}) = intercalate ", " (map showLoc locs) ++ ": NoParagraphs"-    show (NoBinaryParagraphs {..}) = intercalate ", " (map showLoc locs) ++ ": NoBinaryParagraphs"-    show (MissingField {..}) = intercalate ", " (map showLoc locs) ++ ": MissingField " ++ show field-    show (ParseRelationsError {..}) = intercalate ", " (map showLoc locs) ++ ": ParseRelationsError " ++ show parseError-    show (ParseControlError {..}) = intercalate ", " (map showLoc locs) ++ ": ParseControlError " ++ show parseError-    show (IOError {..}) = intercalate ", " (map showLoc locs) ++ ": IOError " ++ show ioError--showLoc :: Loc -> String-showLoc x = show (loc_filename x) ++ "(line " ++ show (fst (loc_start x)) ++ ", column " ++ show (snd (loc_start x)) ++ ")"---- instance Please.Show ControlFileError where---     show (IOError e) = "(IOError " ++ Please.show e ++ ")"---     show (ParseRelationsError e) = "(ParseRelationsError " ++ Please.show e ++ ")"---     show (ParseControlError e) = "(ParseControlError " ++ Please.show e ++ ")"---     show x = show x--instance Exception ControlFileError--instance Eq ControlFileError where-    _ == _ = False--debianPackageParagraphs :: HasDebianControl a => a -> (Paragraph' Text, [Paragraph' Text])-debianPackageParagraphs ctl =-    case removeCommentParagraphs ctl of-      DebianControl (Control [_]) -> throw $ NoBinaryParagraphs [$__LOC__]-      DebianControl (Control []) -> throw $ NoParagraphs [$__LOC__]-      DebianControl (Control (sourceParagraph : binParagraphs)) -> (sourceParagraph, binParagraphs)---- | Comment paragraphs are rare, but they happen.-removeCommentParagraphs :: HasDebianControl a => a -> DebianControl-removeCommentParagraphs c =-    DebianControl (Control (filter (not . isCommentParagraph) (unControl (unDebianControl (debianControl c)))))-    where-      isCommentParagraph (Paragraph fields) = all isCommentField fields-      isCommentField (Comment _) = True-      isCommentField _ = False--debianSourceParagraph :: HasDebianControl a => a -> Paragraph' Text-debianSourceParagraph = fst . debianPackageParagraphs--debianBinaryParagraphs :: HasDebianControl a => a -> [Paragraph' Text]-debianBinaryParagraphs = snd . debianPackageParagraphs--debianPackageNames :: HasDebianControl a => a -> (SrcPkgName, [BinPkgName])-debianPackageNames c =-  let (srcParagraph, binParagraphs) = debianPackageParagraphs c in-  (mapFieldValue (SrcPkgName . toList) "Source" srcParagraph, map (mapFieldValue (BinPkgName . toList) "Package") binParagraphs)--debianSourcePackageName :: HasDebianControl a => a -> SrcPkgName-debianSourcePackageName = fst . debianPackageNames--debianBinaryPackageNames :: HasDebianControl a => a -> [BinPkgName]-debianBinaryPackageNames = snd . debianPackageNames--debianBuildDepsIndep :: HasDebianControl a => a -> Maybe Relations-debianBuildDepsIndep ctl = either throw id $ debianRelations "Build-Depends-Indep" (debianControl ctl)--debianBuildDeps :: HasDebianControl a => a -> Maybe Relations-debianBuildDeps ctl = either throw id $ debianRelations "Build-Depends" (debianControl ctl)---- | Version of fieldValue that may throw a ControlFileError.  We only--- use this internally on fields that we already validated.-fieldValue' :: ControlFunctions text => String -> Paragraph' text -> text-fieldValue' fieldName paragraph = maybe (throw $ MissingField [$__LOC__] fieldName) id $ fieldValue fieldName paragraph---- | This could access fields we haven't validated, so--- it can return an error.  Additionally, the field might--- be absent, in which case it returns Nothing.-debianRelations :: HasDebianControl a => String -> a -> Either ControlFileError (Maybe Relations)-debianRelations fieldName ctl = maybe (Right Nothing) (either (Left . ParseRelationsError [$__LOC__]) (Right . Just) . parseRelations) $ fieldValue fieldName (debianSourceParagraph ctl)---- | Apply a function to the text from a named field in a control file paragraph.-mapFieldValue :: (Text -> a) -> String -> Paragraph' Text -> a-mapFieldValue f fieldName paragraph = f $ fieldValue' fieldName paragraph

@@ -1,110 +0,0 @@-{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}-module Debian.Control.String-    ( -- * Types-      Control'(..)-    , Paragraph'(..)-    , Field'(..)-    , Control-    , Paragraph-    , Field-    , ControlParser-    , ControlFunctions(..)-    -- * Control File Parser-    , pControl-    -- * Helper Functions-    , mergeControls-    , fieldValue-    , removeField-    , prependFields-    , appendFields-    , renameField-    , modifyField-    , raiseFields-    ) where--import qualified Control.Exception as E-import Data.Char (toLower)-import Data.List (find)-import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, protectFieldText, asString),-                              Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment),-                              mergeControls, fieldValue, removeField, prependFields, appendFields,-                              renameField, modifyField, raiseFields, protectFieldText')-import System.IO (hGetContents)-import Text.ParserCombinators.Parsec (CharParser, parse, parseFromFile, sepEndBy, satisfy, oneOf, string, lookAhead, try, many, many1, (<|>), noneOf, char, eof)--type Field = Field' String-type Control = Control' String-type Paragraph = Paragraph' String---- * ControlFunctions--instance ControlFunctions String where-    parseControlFromFile filepath =-        parseFromFile pControl filepath-    parseControlFromHandle sourceName handle =-        E.try (hGetContents handle) >>=-        either (\ (e :: E.SomeException) -> error ("parseControlFromHandle String: Failure parsing " ++ sourceName ++ ": " ++ show e)) (return . parseControl sourceName)-    parseControl sourceName c =-        parse pControl sourceName c-    lookupP fieldName (Paragraph paragraph) =-        find (hasFieldName (map toLower fieldName)) paragraph-        where hasFieldName name (Field (fieldName',_)) = name == map toLower fieldName'-              hasFieldName _ _ = False-    stripWS = reverse . strip . reverse . strip-        where strip = dropWhile (flip elem " \t")-    protectFieldText = protectFieldText'-    asString = id---- * Control File Parser--type ControlParser a = CharParser () a---- |A parser for debian control file. This parser handles control files--- that end without a newline as well as ones that have several blank--- lines at the end. It is very liberal and does not attempt validate--- the fields in any way. All trailing, leading, and folded whitespace--- is preserved in the field values. See 'stripWS'.-pControl :: ControlParser Control-pControl =-    do many $ char '\n'-       sepEndBy pParagraph pBlanks >>= return . Control--pParagraph :: ControlParser Paragraph-pParagraph = many1 (pComment <|> pField) >>= return . Paragraph---- |We are liberal in that we allow *any* field to have folded white--- space, even though the specific restricts that to a few fields.-pField :: ControlParser Field-pField =-    do c1 <- noneOf "#\n"-       fieldName <-  many1 $ noneOf ":\n"-       char ':'-       fieldValue <- many fcharfws-       (char '\n' >> return ()) <|> eof-       return $ Field (c1 : fieldName, fieldValue)--pComment :: ControlParser Field-pComment =-    do char '#'-       text <- many (satisfy (not . ((==) '\n')))-       char '\n'-       return $ Comment ("#" ++ text ++ "\n")--fcharfws :: ControlParser Char-fcharfws = fchar <|> (try $ lookAhead (string "\n ") >> char '\n') <|> (try $ lookAhead (string "\n\t") >> char '\n') <|> (try $ lookAhead (string "\n#") >> char '\n')--fchar :: ControlParser Char-fchar = satisfy (/='\n')--_fws :: ControlParser String-_fws =-    try $ do char '\n'-             ws <- many1 (char ' ')-             c <- many1 (satisfy (not . ((==) '\n')))-             return $ '\n' : (ws ++ c)---- |We go with the assumption that 'blank lines' mean lines that--- consist of entirely of zero or more whitespace characters.-pBlanks :: ControlParser String-pBlanks = many1 (oneOf " \n")

@@ -1,155 +0,0 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}-module Debian.Control.Text-    ( -- * Types-      Control'(..)-    , Paragraph'(..)-    , Field'(..)-    , Control-    , Paragraph-    , Field-    -- , ControlParser-    , ControlFunctions(..)-    -- * Control File Parser-    -- , pControl-    -- * Helper Functions-    , mergeControls-    , fieldValue-    , removeField-    , prependFields-    , appendFields-    , renameField-    , modifyField-    , raiseFields-    , decodeControl-    , decodeParagraph-    , decodeField-    ) where--import qualified Data.ByteString.Char8 as B-import Data.Char (toLower, chr)-import Data.List (find)-import qualified Data.Text as T (Text, pack, unpack, map, dropAround, reverse)-import Data.Text.Encoding (decodeUtf8With, encodeUtf8)---import Data.Text.IO as T (readFile)-import qualified Debian.Control.ByteString as B---import Text.Parsec.Error (ParseError)---import Text.Parsec.Text (Parser)---import Text.Parsec.Prim (runP)-import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, asString),-                              Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment),-                              mergeControls, fieldValue, removeField, prependFields, appendFields,-                              renameField, modifyField, raiseFields, protectFieldText')---- | @parseFromFile p filePath@ runs a string parser @p@ on the--- input read from @filePath@ using 'Prelude.readFile'. Returns either a 'ParseError'--- ('Left') or a value of type @a@ ('Right').------ >  main    = do{ result <- parseFromFile numbers "digits.txt"--- >              ; case result of--- >                  Left err  -> print err--- >                  Right xs  -> print (sum xs)--- >              }-{--parseFromFile :: Parser a -> String -> IO (Either ParseError a)-parseFromFile p fname-    = do input <- T.readFile fname `E.catch` (\ (_ :: E.SomeException) -> B.readFile fname >>= return . decode)-         return (runP p () fname input)--}--type Field = Field' T.Text-type Control = Control' T.Text-type Paragraph = Paragraph' T.Text--decodeControl :: B.Control -> Control-decodeControl (B.Control paragraphs) = Control (map decodeParagraph paragraphs)--decodeParagraph :: B.Paragraph -> Paragraph-decodeParagraph (B.Paragraph s) = B.Paragraph (map decodeField s)--decodeField :: Field' B.ByteString -> Field' T.Text-decodeField (B.Field (name, value)) = Field (decode name, decode value)-decodeField (B.Comment s) = Comment (decode s)--decode :: B.ByteString -> T.Text-decode = decodeUtf8With (\ _ w -> fmap (chr . fromIntegral) w)---- * ControlFunctions--instance ControlFunctions T.Text where-    parseControlFromFile filepath =-        -- The ByteString parser is far more efficient than the Text-        -- parser.  By calling decodeControl we tell the compiler to-        -- use it instead.-        parseControlFromFile filepath >>= return . either Left (Right . decodeControl)-    parseControlFromHandle sourceName handle =-        parseControlFromHandle sourceName handle >>= return . either Left (Right . decodeControl)-    parseControl sourceName c =-        -- Warning: This is very slow, it does a utf8 round trip-        either Left (Right . decodeControl) (parseControl sourceName (encodeUtf8 c))-    lookupP fieldName (Paragraph paragraph) =-        find (hasFieldName (map toLower fieldName)) paragraph-        where hasFieldName :: String -> Field' T.Text -> Bool-              hasFieldName name (Field (fieldName',_)) = T.pack name == T.map toLower fieldName'-              hasFieldName _ _ = False-    stripWS = T.dropAround (`elem` (" \t" :: String))-      -- T.strip would also strip newlines-    protectFieldText = protectFieldText'-    asString = T.unpack---- * Control File Parser-{---- type ControlParser = GenParser T.Text-type ControlParser a = Parsec T.Text () a---- |A parser for debian control file. This parser handles control files--- that end without a newline as well as ones that have several blank--- lines at the end. It is very liberal and does not attempt validate--- the fields in any way. All trailing, leading, and folded whitespace--- is preserved in the field values. See 'stripWS'.-pControl :: ControlParser Control-pControl =-    do many $ char '\n'-       sepEndBy pParagraph pBlanks >>= return . Control--pParagraph :: ControlParser Paragraph-pParagraph = many1 (pComment <|> pField) >>= return . Paragraph---- |We are liberal in that we allow *any* field to have folded white--- space, even though the specific restricts that to a few fields.-pField :: ControlParser Field-pField =-    do c1 <- noneOf "#\n"-       fieldName <-  many1 $ noneOf ":\n"-       char ':'-       fieldValue <- many fcharfws-       (char '\n' >> return ()) <|> eof-       return $ Field (T.cons c1 (T.pack fieldName), T.pack fieldValue)--pComment :: ControlParser Field-pComment =-    do char '#'-       text <- many (satisfy (not . ((==) '\n')))-       char '\n'-       return $ Comment (T.pack ("#" <> text <> "\n"))--fcharfws :: ControlParser Char-fcharfws = fchar <|> (try $ lookAhead (string "\n ") >> char '\n') <|> (try $ lookAhead (string "\n\t") >> char '\n') <|> (try $ lookAhead (string "\n#") >> char '\n')--fchar :: ControlParser Char-fchar = satisfy (/='\n')--_fws :: ControlParser T.Text-_fws =-    try $ do char '\n'-             ws <- many1 (char ' ')-             c <- many1 (satisfy (not . ((==) '\n')))-             return $ T.cons '\n' (T.pack ws <> T.pack c)---- |We go with the assumption that 'blank lines' mean lines that--- consist of entirely of zero or more whitespace characters.-pBlanks :: ControlParser T.Text-pBlanks =-    do s <- many1 (oneOf " \n")-       return . T.pack $ s--}

@@ -1,24 +0,0 @@-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}-module Debian.Deb where--import Control.Monad--import Debian.Control.Common-import System.Directory (canonicalizePath)-import System.Exit (ExitCode(..))-import System.Process (readProcessWithExitCode)-import System.Unix.Directory (withTemporaryDirectory, withWorkingDirectory)--fields :: (ControlFunctions a) => FilePath -> IO (Control' a)-fields debFP =-    withTemporaryDirectory ("fields.XXXXXX") $ \tmpdir ->-      do debFP <- canonicalizePath debFP-         withWorkingDirectory tmpdir $-           do (res, out, err) <- readProcessWithExitCode "ar" ["x",debFP,"control.tar.gz"] ""-              when (res /= ExitSuccess) (error $ "Dpkg.fields: " ++ show out ++ "\n" ++ show err ++ "\n" ++ show res)-              (res, out, err) <- readProcessWithExitCode "tar" ["xzf", "control.tar.gz", "./control"] ""-              when (res /= ExitSuccess) (error $ "Dpkg.fields: " ++ show out ++ "\n" ++ show err ++ "\n" ++ show res)-              c <- parseControlFromFile "control"-              case c of-                Left e -> error (show e)-                (Right c) -> return c -- I don't think we need seq because parsec will force everything from the file

@@ -1,31 +0,0 @@-{-# LANGUAGE PackageImports #-}--- |Domain independent functions used by the haskell-debian package.-module Debian.Extra.Files-    ( withTemporaryFile-    ) where--import "mtl" Control.Monad.Trans (MonadIO, liftIO)-import System.Directory (getTemporaryDirectory, removeFile)-import System.IO (hPutStr, hClose, openBinaryTempFile)--withTemporaryFile :: MonadIO m-                  => (FilePath -> m a)  -- ^ The function we want to pass a FilePath to-                  -> String             -- ^ The text that the file should contain-                  -> m a                -- ^ The function's return value-withTemporaryFile f text =-    do path <- liftIO writeTemporaryFile-       result <- f path-       liftIO $ removeFile path-       return result-    where-      writeTemporaryFile =-          do dir <- getTemporaryDirectory-             (path, h) <- openBinaryTempFile dir "wtf.tmp"-             hPutStr h text-             hClose h-             return path---- Example: write the path of the temporary file and its contents into /tmp/result:--- test =---   withTemporaryFile f "Some text\n"---   where f path = readFile path >>= return . (("Contents of " ++ path ++ ":\n") ++) >>= writeFile "/tmp/result"

@@ -1,329 +0,0 @@-{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-}--- |Figure out the dependency relation between debianized source--- directories.  The code to actually solve these dependency relations--- for a particular set of binary packages is in Debian.Repo.Dependency.-module Debian.GenBuildDeps-    ( DepInfo(..)-    , sourceName'-    , relations'-    , binaryNames'-    -- * Preparing dependency info-    , buildDependencies-    , RelaxInfo-    , relaxDeps-    -- * Using dependency info-    , BuildableInfo(..)-    , ReadyTarget(..)-    , buildable-    , compareSource-    -- * Obsolete?-    , orderSource-    , genDeps-    , failPackage-    , getSourceOrder-    ) where--#if !MIN_VERSION_base(4,8,0)-import           Control.Applicative ((<$>))-#endif-import           Control.Exception (throw)-import           Control.Monad (filterM, foldM)-import           Control.Monad.State (evalState, get, modify, State)-import           Data.Graph (Graph, Edge, Vertex, buildG, topSort, reachable, transposeG, edges, scc)-import           Data.List as List (elemIndex, find, map, nub, partition, tails)-import           Data.Map as Map (empty, findWithDefault, fromList, insert, Map, lookup)-import           Data.Maybe-import           Data.Set as Set (fromList, intersection, null, Set)-import           Data.Tree as Tree (Tree(Node, rootLabel, subForest))-import           Debian.Control (parseControlFromFile)-import           Debian.Control.Policy (HasDebianControl, DebianControl, ControlFileError(..), validateDebianControl, debianSourcePackageName, debianBinaryPackageNames, debianBuildDeps, debianBuildDepsIndep)-import           Debian.Loc (__LOC__)-import           Debian.Relation-import           Debian.Relation.Text ()--- import           Debug.Trace (trace)-import           System.Directory (getDirectoryContents, doesFileExist)---- | This type describes the build dependencies of a source package.-data DepInfo = DepInfo {-      sourceName :: SrcPkgName          -- ^ source package name-    , relations :: Relations            -- ^ dependency relations-    , binaryNames :: [BinPkgName]       -- ^ binary dependency names (is this a function of relations?)-    , depSet :: Set.Set BinPkgName          -- ^ Set containing all binary package names mentioned in relations-    , binSet :: Set.Set BinPkgName          -- ^ Set containing binaryNames-    } deriving Show--instance Eq DepInfo where-    a == b = (sourceName a == sourceName b) &&-             Set.fromList (map Set.fromList (relations a)) == Set.fromList (map Set.fromList (relations b)) &&-             Set.fromList (binaryNames a) == Set.fromList (binaryNames b)---- |Return the dependency info for a source package with the given dependency relaxation.--- |According to debian policy, only the first paragraph in debian\/control can be a source package--- <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-sourcecontrolfiles>-buildDependencies :: HasDebianControl control => control -> DepInfo-buildDependencies control = do-  let rels = concat [fromMaybe [] (debianBuildDeps control),-                     fromMaybe [] (debianBuildDepsIndep control)]-      bins = debianBinaryPackageNames control-  DepInfo { sourceName = debianSourcePackageName control-          , relations = rels-          , binaryNames = bins-          , depSet = Set.fromList (List.map (\(Rel x _ _) -> x) (concat rels))-          , binSet = Set.fromList bins }---- | source package name-sourceName' :: HasDebianControl control => control -> SrcPkgName-sourceName' control = debianSourcePackageName control---- | dependency relations-relations' :: HasDebianControl control => control -> Relations-relations' control = concat [fromMaybe [] (debianBuildDeps control),-                            fromMaybe [] (debianBuildDepsIndep control)]---- | binary dependency names (is this a function of relations?)-binaryNames' :: HasDebianControl control => control -> [BinPkgName]-binaryNames' control = debianBinaryPackageNames control---- |Specifies build dependencies that should be ignored during the build--- decision.  If the pair is (BINARY, Nothing) it means the binary package--- BINARY should always be ignored when deciding whether to build.  If the--- pair is (BINARY, Just SOURCE) it means that binary package BINARY should--- be ignored when deiciding whether to build package SOURCE.-newtype OldRelaxInfo = RelaxInfo [(BinPkgName, Maybe SrcPkgName)] deriving Show---- | Given a source package name and a binary package name, return--- False if the binary package should be ignored hwen deciding whether--- to build the source package.  This is used to prevent build--- dependency cycles from triggering unnecessary rebuilds.  (This is a--- replacement for the RelaxInfo type, which we temporarily rename--- OldRelaxInfo.)-type RelaxInfo = SrcPkgName -> BinPkgName -> Bool---- |Remove any dependencies that are designated \"relaxed\" by relaxInfo.-relaxDeps :: RelaxInfo -> [DepInfo] -> [DepInfo]-relaxDeps relaxInfo deps =-    List.map relaxDep deps-    where-      relaxDep :: DepInfo -> DepInfo-      relaxDep info = info {relations = filteredDependencies}-          where-            -- Discard any dependencies not on the filtered package name list.  If-            -- this results in an empty list in an or-dep the entire dependency can-            -- be discarded.-            filteredDependencies :: Relations-            filteredDependencies = filter (/= []) (List.map (filter keepDep) (relations info))-            keepDep :: Relation -> Bool-            keepDep (Rel name _ _) = not (relaxInfo (sourceName info) name)--data ReadyTarget a-    = ReadyTarget { ready :: a-                  -- ^ Some target whose build dependencies are all satisfied-                  , waiting :: [a]-                  -- ^ The targets that are waiting for the ready target-                  , other :: [a]-                  -- ^ The rest of the targets that need to be built-                  }--data BuildableInfo a-    = BuildableInfo-      { readyTargets :: [ReadyTarget a]-      , allBlocked :: [a] }-    | CycleInfo-      { depPairs :: [(a, a)] }---- | Given an ordering function representing the dependencies on a--- list of packages, return a ReadyTarget triple: One ready package,--- the packages that depend on the ready package directly or--- indirectly, and all the other packages.-buildable :: forall a. (a -> DepInfo) -> [a] -> BuildableInfo a-buildable relax packages =-    -- Find all packages which can't reach any other packages in the-    -- graph of the "has build dependency" relation on the-    -- yet-to-be-built packages-    case partition (\ x -> reachable hasDep x == [x]) verts of-      -- None of the packages are buildable, return information-      -- about how to break this build dependency cycle.-      ([], _) -> CycleInfo {depPairs = List.map ofEdge $ head $ (allCycles hasDep)}-      -- We have some buildable packages, return them along with-      -- the list of packages each one directly blocks-      (allReady, blocked) ->-          BuildableInfo { readyTargets = List.map (makeReady blocked allReady) allReady-                        , allBlocked = List.map ofVertex blocked }-    where-      makeReady :: [Vertex] -> [Vertex] -> Vertex -> ReadyTarget a-      makeReady blocked ready thisReady =-          let otherReady = filter (/= thisReady) ready-              (directlyBlocked, otherBlocked) = partition (\ x -> elem x (reachable isDep thisReady)) blocked in-          ReadyTarget { ready = ofVertex thisReady-                      , waiting = List.map ofVertex directlyBlocked-                      , other = List.map ofVertex (otherReady ++ otherBlocked) }-      --allDeps x = (ofVertex x, List.map ofVertex (filter (/= x) (reachable hasDep x)))-      isDep :: Graph-      isDep = transposeG hasDep-      hasDep :: Graph-      hasDep = buildG (0, length packages - 1) hasDepEdges--      hasDepEdges :: [(Int, Int)]-      hasDepEdges =-#if 0-          nub (foldr f [] (tails vertPairs))-          where f :: [(Int, DepInfo)] -> [(Int, Int)] -> [(Int, Int)]-                f [] es = es-                f (x : xs) es = catMaybes (List.map (toEdge x) xs) ++ es-                toEdge :: (Int, DepInfo) -> (Int, DepInfo) -> Maybe Edge-                toEdge (xv, xa) (yv, ya) =-                    case compareSource xa ya of-                      EQ -> Nothing-                      LT -> Just (yv, xv)-                      GT -> Just (xv, yv)-#else-          nub (evalState (foldM f [] (tails vertPairs)) Map.empty)-          where f :: [(Int, Int)] -> [(Int, DepInfo)] -> State (Map.Map (Int, Int) Ordering) [(Int, Int)]-                f es [] = return es-                f es (x : xs) = mapM (toEdge x) xs >>= \es' -> return (catMaybes es' ++ es)-                toEdge :: (Int, DepInfo) -> (Int, DepInfo) -> State (Map.Map (Int, Int) Ordering) (Maybe Edge)-                toEdge (xv, xa) (yv, ya) = do-                  mp <- get-                  r <- case Map.lookup (xv, yv) mp of-                         Just r' -> return r'-                         Nothing -> do-                           let r' = compareSource xa ya-                           -- trace ("compareSource " ++ show (unSrcPkgName $ sourceName xa) ++ " " ++ show (unSrcPkgName $ sourceName ya) ++ " -> " ++ show r') (return ())-                           modify (Map.insert (xv, yv) r')-                           return r'-                  case r of-                    EQ -> return Nothing-                    LT -> return $ Just (yv, xv)-                    GT -> return $ Just (xv, yv)-#endif-      ofEdge :: Edge -> (a, a)-      ofEdge (a, b) = (ofVertex a, ofVertex b)-      ofVertex :: Int -> a-      ofVertex n = fromJust (Map.findWithDefault Nothing n (Map.fromList (zip [0..] (map Just packages))))-      verts :: [Int]-      verts = map fst vertPairs-      vertPairs :: [(Int, DepInfo)]-      vertPairs = zip [0..] $ map relax packages---- | Find a cycle in a graph that involves-allCycles :: Graph -> [[Edge]]-allCycles g =-    -- Every cycle is confined to an SCC (strongly connected component).-    -- Every node in an SCC is part of some cycle.-    concatMap sccCycles (scc g)-    where-      -- Find all the cycles in an SCC-      sccCycles :: Tree Vertex -> [[Edge]]-      sccCycles t = mapMaybe addBackEdge (treePaths t)--      addBackEdge :: [Vertex] -> Maybe [Edge]-      addBackEdge path@(root : _) =-          let back = (last path, root) in-          if elem back (edges g) then Just (pathEdges (path ++ [root])) else Nothing---- | All the paths from root to a leaf-treePaths :: Tree a -> [[a]]-treePaths (Node {rootLabel = r, subForest = []}) = [[r]]-treePaths (Node {rootLabel = r, subForest = ts}) = map (r :) (concatMap treePaths ts)--pathEdges :: [a] -> [(a, a)]-pathEdges (v1 : v2 : vs) = (v1, v2) : pathEdges (v2 : vs)-pathEdges _ = []---- | Remove any packages which can't be built given that a package has failed.-failPackage :: Eq a => (a -> a -> Ordering) -> a -> [a] -> ([a], [a])-failPackage cmp failed packages =-    let graph = buildGraph cmp packages in-    let root = elemIndex failed packages in-    let victims = maybe [] (map (fromJust . vertex) . reachable graph) root in-    partition (\ x -> not . elem x $ victims) packages-    where-      vertex n = Map.findWithDefault Nothing n vertexMap-      vertexMap = Map.fromList (zip [0..] (map Just packages))---- | Given a list of packages, sort them according to their apparant--- build dependencies so that the first element doesn't depend on any--- of the other packages.-orderSource :: (a -> a -> Ordering) -> [a] -> [a]-orderSource cmp packages =-    map (fromJust . vertex) (topSort graph)-    where-      graph = buildGraph cmp packages-      vertex n = Map.findWithDefault Nothing n vertexMap-      vertexMap = Map.fromList (zip [0..] (map Just packages))---- | Build a graph with the list of packages as its nodes and the--- build dependencies as its edges.-buildGraph :: (a -> a -> Ordering) -> [a] -> Graph-buildGraph cmp packages =-    let es = someEdges (zip packages [0..]) in-    buildG (0, length packages - 1) es-    where-      someEdges [] = []-      someEdges (a : etc) = aEdges a etc ++ someEdges etc-      aEdges (ap, an) etc =-          concat (map (\ (bp, bn) ->-                           case cmp ap bp of-                             LT -> [(an, bn)]-                             GT -> [(bn, an)]-                             EQ -> []) etc)---- |This is a nice start. It ignores circular build depends and takes--- a pretty simplistic approach to 'or' build depends. However, I--- think this should work pretty nicely in practice.-compareSource :: DepInfo -> DepInfo -> Ordering-compareSource p1 p2-#if 0-    | any (\rel -> isJust (find (checkPackageNameReq rel) (binaryNames p2))) (concat (relations p1)) = GT-    | any (\rel -> isJust (find (checkPackageNameReq rel) (binaryNames p1))) (concat (relations p2)) = LT-    | otherwise = EQ-    where-      checkPackageNameReq :: Relation -> BinPkgName -> Bool-      checkPackageNameReq (Rel rPkgName _ _) bPkgName = rPkgName == bPkgName-#else-    | not (Set.null (Set.intersection (depSet p1) (binSet p2))) = GT-    | not (Set.null (Set.intersection (depSet p2) (binSet p1))) = LT-    | otherwise = EQ-#endif--compareSource' :: HasDebianControl control => control -> control -> Ordering-compareSource' control1 control2-    | any (\rel -> isJust (find (checkPackageNameReq rel) bins2)) (concat depends1) = GT-    | any (\rel -> isJust (find (checkPackageNameReq rel) bins1)) (concat depends2) = LT-    | otherwise = EQ-    where-      bins1 = binaryNames' control1-      bins2 = binaryNames' control2-      depends1 = relations' control1-      depends2 = relations' control2-      checkPackageNameReq :: Relation -> BinPkgName -> Bool-      checkPackageNameReq (Rel rPkgName _ _) bPkgName = rPkgName == bPkgName---- |Return the dependency info for a list of control files.-genDeps :: [FilePath] -> IO [DebianControl]-genDeps controlFiles = do-  orderSource compareSource' <$> mapM genDep' controlFiles-    where-      -- Parse the control file and extract the build dependencies-      genDep' controlPath = parseControlFromFile controlPath >>=-                            either (\ x -> throw (ParseRelationsError [$__LOC__] x))-                                   (\ x -> validateDebianControl x {- `mapExn` (pushLoc $__LOC__) -} >>= either throw return)---- pushLoc :: Loc -> ControlFileError -> ControlFileError--- pushLoc loc e = e {locs = loc : locs e}---- |One example of how to tie the below functions together. In this--- case 'fp' is the path to a directory that contains a bunch of--- checked out source packages. The code will automatically look for--- debian\/control. It returns a list with the packages in the--- order they should be built.-getSourceOrder :: FilePath -> IO [SrcPkgName]-getSourceOrder fp =-    findControlFiles fp >>= genDeps >>= return . map sourceName'-    where-      -- Return a list of the files that look like debian\/control.-      findControlFiles :: FilePath -> IO [FilePath]-      findControlFiles root =-          getDirectoryContents root >>=-          mapM (\ x -> return $ root ++ "/" ++ x ++ "/debian/control") >>=-          filterM doesFileExist

@@ -1,23 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-}-module Debian.Loc-    ( __LOC__-    , mapExn-    ) where--import Control.Applicative ((<$>), (<*>), pure)-import Control.Exception (Exception, throw)-import Control.Monad.Catch (MonadCatch, catch)-import Language.Haskell.TH--__LOC__ :: Q Exp-__LOC__ = location >>= \ x ->-             recConE 'Loc [ (,) <$> (pure 'loc_filename) <*> litE (stringL (loc_filename x))-                          , (,) <$> (pure 'loc_package) <*> litE (stringL (loc_package x))-                          , (,) <$> (pure 'loc_module) <*> litE (stringL (loc_module x))-                          , (,) <$> (pure 'loc_start) <*> [|($(litE (integerL (fromIntegral (fst (loc_start x))))),-                                                             $(litE (integerL (fromIntegral (snd (loc_start x)))))) :: (Int, Int)|]-                          , (,) <$> (pure 'loc_end) <*> [|($(litE (integerL (fromIntegral (fst (loc_end x))))),-                                                           $(litE (integerL (fromIntegral (snd (loc_end x)))))) :: (Int, Int)|] ]--mapExn :: forall e m a. (MonadCatch m, Exception e) => m a -> (e -> e) -> m a-mapExn task f = task `catch` (\ (e :: e) -> throw (f e))

@@ -1,46 +0,0 @@--- | A constructor we can wrap around values to avoid any built in--- Pretty instance - for example, instance Pretty [a].------  * display is now prettyShow---  * display' is now prettyText---  * ppDisplay is now ppShow---  * ppDisplay' is now ppText-{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-}-module Debian.Pretty-    ( PP(PP, unPP)-    , prettyShow-    , prettyText-    , ppPrint-    , ppShow-    , ppText-    ) where--import Data.Text (Text, unpack, pack)-import Text.PrettyPrint.HughesPJClass (Doc, Pretty(pPrint), text, empty, prettyShow)---- | This type is wrapped around values before we pretty print them so--- we can write our own Pretty instances for common types without--- polluting the name space of clients of this package with instances--- they don't want.-newtype PP a = PP {unPP :: a} deriving (Functor)--instance Pretty (PP Text) where-    pPrint = text . unpack . unPP--instance Pretty (PP String) where-    pPrint = text . unPP--instance Pretty (PP a) => Pretty (PP (Maybe a)) where-    pPrint = maybe empty ppPrint . unPP--prettyText :: Pretty a => a -> Text-prettyText = pack . prettyShow--ppPrint :: Pretty (PP a) => a -> Doc-ppPrint = pPrint . PP--ppShow :: Pretty (PP a) => a -> String-ppShow = prettyShow . PP--ppText :: Pretty (PP a) => a -> Text-ppText = pack . prettyShow . PP

@@ -1,25 +0,0 @@--- |A module for working with debian relationships <http://www.debian.org/doc/debian-policy/ch-relationships.html>-module Debian.Relation-    ( -- * Types-      PkgName(..)-    , SrcPkgName(..)-    , BinPkgName(..)-    , Relations-    , AndRelation-    , OrRelation-    , Relation(..)-    , ArchitectureReq(..)-    , Arch(..)-    , ArchOS(..)-    , ArchCPU(..)-    , VersionReq(..)-    -- * Helper Functions-    , checkVersionReq-    -- * Relation Parser-    , RelParser-    , ParseRelations(..)-    ) where--import Debian.Arch (Arch(..), ArchOS(..), ArchCPU(..))-import Debian.Relation.Common (SrcPkgName(..), BinPkgName(..), PkgName(pkgNameFromString))-import Debian.Relation.String

@@ -1,30 +0,0 @@-{-# OPTIONS -fno-warn-orphans #-}--- |A module for working with debian relationships <http://www.debian.org/doc/debian-policy/ch-relationships.html>-module Debian.Relation.ByteString-    ( -- * Types-      AndRelation-    , OrRelation-    , Relations-    , Relation(..)-    , ArchitectureReq(..)-    , VersionReq(..)-    -- * Helper Functions-    , checkVersionReq-    -- * Relation Parser-    , RelParser-    , ParseRelations(..)-    ) where--import qualified Data.ByteString.Char8 as C---- Local Modules----import Debian.Relation.Common-import Debian.Relation.String---import Debian.Version---- * ParseRelations---- For now we just wrap the string version-instance ParseRelations C.ByteString where-    parseRelations byteStr = parseRelations (C.unpack byteStr)

@@ -1,132 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-}-module Debian.Relation.Common where---- Standard GHC Modules--import Data.Data (Data)-import Data.List as List (map, intersperse)-import Data.Monoid (mconcat, (<>))-import Data.Function-import Data.Set as Set (Set, toList)-import Data.Typeable (Typeable)-import Debian.Arch (Arch, prettyArch)-import Debian.Pretty (PP(..))-import Prelude hiding (map)-import Text.ParserCombinators.Parsec-import Text.PrettyPrint (Doc, text, empty)-import Text.PrettyPrint.HughesPJClass (Pretty(pPrint))---- Local Modules--import Debian.Version---- Datatype for relations--type Relations = AndRelation-type AndRelation = [OrRelation]-type OrRelation = [Relation]--data Relation = Rel BinPkgName (Maybe VersionReq) (Maybe ArchitectureReq) deriving (Eq, Read, Show)--newtype SrcPkgName = SrcPkgName {unSrcPkgName :: String} deriving (Read, Show, Eq, Ord, Data, Typeable)-newtype BinPkgName = BinPkgName {unBinPkgName :: String} deriving (Read, Show, Eq, Ord, Data, Typeable)--class Pretty (PP a) => PkgName a where-    pkgNameFromString :: String -> a--instance PkgName BinPkgName where-    pkgNameFromString = BinPkgName--instance PkgName SrcPkgName where-    pkgNameFromString = SrcPkgName--class ParseRelations a where-    -- |'parseRelations' parse a debian relation (i.e. the value of a-    -- Depends field). Return a parsec error or a value of type-    -- 'Relations'-    parseRelations :: a -> Either ParseError Relations---- | This needs to be indented for use in a control file: intercalate "\n     " . lines . show-prettyRelations :: [[Relation]] -> Doc-prettyRelations xss = mconcat . intersperse (text "\n, ") . List.map prettyOrRelation $ xss--prettyOrRelation :: [Relation] -> Doc-prettyOrRelation xs = mconcat . intersperse (text " | ") . List.map prettyRelation $ xs--prettyRelation :: Relation -> Doc-prettyRelation (Rel name ver arch) =-    pPrint (PP name) <> maybe empty prettyVersionReq ver <> maybe empty prettyArchitectureReq arch--instance Ord Relation where-    compare (Rel pkgName1 mVerReq1 _mArch1) (Rel pkgName2 mVerReq2 _mArch2) =-        case compare pkgName1 pkgName2 of-             LT -> LT-             GT -> GT-             EQ -> compare mVerReq1 mVerReq2--data ArchitectureReq-    = ArchOnly (Set Arch)-    | ArchExcept (Set Arch)-    deriving (Eq, Ord, Read, Show)--prettyArchitectureReq :: ArchitectureReq -> Doc-prettyArchitectureReq (ArchOnly arch) = text " [" <> mconcat (List.map prettyArch (toList arch)) <> text "]"-prettyArchitectureReq (ArchExcept arch) = text " [" <> mconcat (List.map ((text "!") <>) (List.map prettyArch (toList arch))) <> text "]"--data VersionReq-    = SLT DebianVersion-    | LTE DebianVersion-    | EEQ  DebianVersion-    | GRE  DebianVersion-    | SGR DebianVersion-      deriving (Eq, Read, Show)--prettyVersionReq :: VersionReq -> Doc-prettyVersionReq (SLT v) = text " (<< " <> prettyDebianVersion v <> text ")"-prettyVersionReq (LTE v) = text " (<= " <> prettyDebianVersion v <> text ")"-prettyVersionReq (EEQ v) = text " (= " <> prettyDebianVersion v <> text ")"-prettyVersionReq (GRE v) = text " (>= " <> prettyDebianVersion v <> text ")"-prettyVersionReq (SGR v) = text " (>> " <> prettyDebianVersion v <> text ")"---- |The sort order is based on version number first, then on the kind of--- relation, sorting in the order <<, <= , ==, >= , >>-instance Ord VersionReq where-    compare = compare `on` extr-      where extr (SLT v) = (v,0 :: Int)-            extr (LTE v) = (v,1 :: Int)-            extr (EEQ v) = (v,2 :: Int)-            extr (GRE v) = (v,3 :: Int)-            extr (SGR v) = (v,4 :: Int)---- |Check if a version number satisfies a version requirement.-checkVersionReq :: Maybe VersionReq -> Maybe DebianVersion -> Bool-checkVersionReq Nothing _ = True-checkVersionReq _ Nothing = False-checkVersionReq (Just (SLT v1)) (Just v2) = v2 < v1-checkVersionReq (Just (LTE v1)) (Just v2) = v2 <= v1-checkVersionReq (Just (EEQ v1)) (Just v2) = v2 == v1-checkVersionReq (Just (GRE v1)) (Just v2) = v2 >= v1-checkVersionReq (Just (SGR v1)) (Just v2) = v2 > v1--instance Pretty (PP BinPkgName) where-    pPrint = text . unBinPkgName . unPP--instance Pretty (PP SrcPkgName) where-    pPrint = text . unSrcPkgName . unPP---- | Wrap `PP` around type synonyms that might overlap with the--- `Pretty [a]` instance.-instance Pretty (PP Relations) where-    pPrint = prettyRelations . unPP--instance Pretty (PP OrRelation) where-    pPrint = prettyOrRelation . unPP--instance Pretty (PP Relation) where-    pPrint = prettyRelation . unPP--instance Pretty (PP VersionReq) where-    pPrint = prettyVersionReq . unPP--instance Pretty (PP ArchitectureReq) where-    pPrint = prettyArchitectureReq . unPP

@@ -1,139 +0,0 @@-{-# LANGUAGE FlexibleInstances, PackageImports, TypeSynonymInstances #-}-{-# OPTIONS -fno-warn-unused-do-bind -fno-warn-orphans #-}--- |A module for working with debian relationships <http://www.debian.org/doc/debian-policy/ch-relationships.html>-module Debian.Relation.String-    ( -- * Types-      AndRelation-    , OrRelation-    , Relations-    , Relation(..)-    , ArchitectureReq(..)-    , VersionReq(..)-    -- * Helper Functions-    , checkVersionReq-    -- * Relation Parser-    , RelParser-    , ParseRelations(..)-    , pRelations-    ) where---- Standard GHC Modules--import "mtl" Control.Monad.Identity (Identity)-import Data.Set (fromList)-import Text.ParserCombinators.Parsec-import Text.Parsec.Prim (ParsecT)---- Local Modules--import Debian.Arch (Arch, parseArch)-import Debian.Relation.Common-import Debian.Version---- * ParseRelations--instance ParseRelations String where-    parseRelations str =-        let str' = scrub str in-        case parse pRelations str' str' of-          Right relations -> Right (filter (/= []) relations)-          x -> x-        where-          scrub = unlines . filter (not . comment) . lines-          comment s = case dropWhile (`elem` " \t") s of-                           ('#' : _) -> True-                           _ -> False---- * Relation Parser--type RelParser a = CharParser () a---- "Correct" dependency lists are separated by commas, but sometimes they--- are omitted and it is possible to parse relations without them.-pRelations :: RelParser Relations-pRelations = do -- rel <- sepBy pOrRelation (char ',')-                rel <- many pOrRelation-                eof-                return rel--pOrRelation :: RelParser OrRelation-pOrRelation = do skipMany (char ',' <|> whiteChar)-                 rel <- sepBy1 pRelation (char '|')-                 skipMany (char ',' <|> whiteChar)-                 return rel--whiteChar :: ParsecT String u Identity Char-whiteChar = oneOf [' ','\t','\n']--pRelation :: RelParser Relation-pRelation =-    do skipMany whiteChar-       pkgName <- many1 (noneOf [' ',',','|','\t','\n','('])-       skipMany whiteChar-       mVerReq <- pMaybeVerReq-       skipMany whiteChar-       mArch <- pMaybeArch-       return $ Rel (BinPkgName pkgName) mVerReq mArch--pMaybeVerReq :: RelParser (Maybe VersionReq)-pMaybeVerReq =-    do char '('-       skipMany whiteChar-       op <- pVerReq-       skipMany whiteChar-       ver <- many1 (noneOf [' ',')','\t','\n'])-       skipMany whiteChar-       char ')'-       return $ Just (op (parseDebianVersion' ver))-    <|>-    do return $ Nothing--pVerReq :: ParsecT [Char] u Identity (DebianVersion -> VersionReq)-pVerReq =-    do char '<'-       (do char '<' <|> char ' ' <|> char '\t'-           return $ SLT-        <|>-        do char '='-           return $ LTE)-    <|>-    do string "="-       return $ EEQ-    <|>-    do char '>'-       (do char '='-           return $ GRE-        <|>-        do char '>' <|> char ' ' <|> char '\t'-           return $ SGR)--pMaybeArch :: RelParser (Maybe ArchitectureReq)-pMaybeArch =-    do char '['-       (do archs <- pArchExcept-           char ']'-           skipMany whiteChar-           return (Just (ArchExcept (fromList . map parseArchExcept $ archs)))-        <|>-        do archs <- pArchOnly-           char ']'-           skipMany whiteChar-           return (Just (ArchOnly (fromList . map parseArch $ archs)))-        )-    <|>-    return Nothing---- Some packages (e.g. coreutils) have architecture specs like [!i386--- !hppa], even though this doesn't really make sense: once you have--- one !, anything else you include must also be (implicitly) a !.-pArchExcept :: RelParser [String]-pArchExcept = sepBy (char '!' >> many1 (noneOf [']',' '])) (skipMany1 whiteChar)--pArchOnly :: RelParser [String]-pArchOnly = sepBy (many1 (noneOf [']',' '])) (skipMany1 whiteChar)---- | Ignore the ! if it is present, we already know this list has at--- least one, and the rest are implicit.-parseArchExcept :: String -> Arch-parseArchExcept ('!' : s) = parseArch s-parseArchExcept s = parseArch s

@@ -1,30 +0,0 @@-{-# OPTIONS -fno-warn-orphans #-}--- |A module for working with debian relationships <http://www.debian.org/doc/debian-policy/ch-relationships.html>-module Debian.Relation.Text-    ( -- * Types-      AndRelation-    , OrRelation-    , Relations-    , Relation(..)-    , ArchitectureReq(..)-    , VersionReq(..)-    -- * Helper Functions-    , checkVersionReq-    -- * Relation Parser-    , RelParser-    , ParseRelations(..)-    ) where--import qualified Data.Text as T---- Local Modules----import Debian.Relation.Common-import Debian.Relation.String---import Debian.Version---- * ParseRelations---- For now we just wrap the string version-instance ParseRelations T.Text where-    parseRelations text = parseRelations (T.unpack text)

@@ -1,60 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module Debian.Release-    ( ReleaseName(..)-    , parseReleaseName-    , releaseName'-    , Section(..)-    , SubSection(..)-    , sectionName-    , sectionName'-    , sectionNameOfSubSection-    , parseSection-    , parseSection'-    ) where--import Data.Data (Data)-import Data.Typeable (Typeable)-import Network.URI (unEscapeString, escapeURIString, isAllowedInURI)---- |A distribution (aka release) name.  This type is expected to refer--- to a subdirectory of the dists directory which is at the top level--- of a repository.-data ReleaseName = ReleaseName { relName :: String } deriving (Eq, Ord, Read, Show, Data, Typeable)--parseReleaseName :: String -> ReleaseName-parseReleaseName name = ReleaseName {relName = unEscapeString name}--releaseName' :: ReleaseName -> String-releaseName' (ReleaseName {relName = s}) = escapeURIString isAllowedInURI s---- |A section of a repository such as main, contrib, non-free,--- restricted.  The indexes for a section are located below the--- distribution directory.-newtype Section = Section String deriving (Read, Show, Eq, Ord)---- |A package's subsection is only evident in its control information,--- packages from different subsections all reside in the same index.-data SubSection = SubSection { section :: Section, subSectionName :: String } deriving (Read, Show, Eq, Ord)--sectionName :: SubSection -> String-sectionName (SubSection (Section "main") y) = y-sectionName (SubSection x y) = sectionName' x ++ "/" ++ y--sectionName' :: Section -> String-sectionName' (Section s) = escapeURIString isAllowedInURI s--sectionNameOfSubSection :: SubSection -> String-sectionNameOfSubSection = sectionName' . section---- |Parse the value that appears in the @Section@ field of a .changes file.--- (Does this need to be unesacped?)-parseSection :: String -> SubSection-parseSection s =-    case span (/= '/') s of-      (x, "") -> SubSection (Section "main") x-      ("main", y) -> SubSection (Section "main") y-      (x, y) -> SubSection (Section x) (tail y)--parseSection' :: String -> Section-parseSection' name =-    Section (unEscapeString name)

@@ -1,87 +0,0 @@-module Debian.Report where--import Data.Maybe-import qualified Data.Map as M-import Data.Text as Text (Text, unpack)-import Debian.Apt.Index (Fetcher, Compression(..), update, controlFromIndex')-import Debian.Control.Text-import Debian.Sources-import Debian.Version-import Text.XML.HaXml (CFilter, mkElem, cdata)-import Text.XML.HaXml.Posn-import Text.PrettyPrint (render)---- * General Package Map Builders---- |create a map of (package name, extracted field) from a list of index files------ NOTE: we could merge all the files into a single control and then--- run packageMap over that. We currently do it one control file at a--- time to avoid having all the control files loaded in memory at--- once. However, I am not sure that property is actually occuring--- anyway. So, this should be revisited.-makePackageMap :: (Paragraph -> a) -> (a -> a -> a) -> [(FilePath, Compression)] -> IO (M.Map Text a)-makePackageMap _ _ [] = return M.empty-makePackageMap extractValue resolveConflict ((path, compression):is) =-    do r <- controlFromIndex' compression path-       case r of-         (Left e) -> error (show e)-         (Right c) ->-             do let pm = packageMap extractValue resolveConflict c-                pms <- makePackageMap extractValue resolveConflict is-                return $ M.unionWith resolveConflict pm pms---- |create a map of (package name, max version) from a single control file-packageMap :: (Paragraph -> a) -> (a -> a -> a) -> Control' Text -> M.Map Text a-packageMap extractValue resolveConflict control =-    M.fromListWith resolveConflict (map packageTuple (unControl control))-    where-      packageTuple paragraph = (fromJust $ fieldValue "Package" paragraph, extractValue paragraph)---- |extract the version number from a control paragraph-extractVersion :: Paragraph -> Maybe DebianVersion-extractVersion paragraph = fmap (parseDebianVersion' . unpack)  $ fieldValue "Version" paragraph---- * Trump Report---- |compare two sources.list and find all the packages in the second that trump packages in the first--- see also: |trumpedMap|-trumped :: Fetcher -- ^ function for downloading package indexes-        -> FilePath -- ^ cache directory to store index files in (must already exist)-        -> String -- ^ binary architecture-        -> [DebSource] -- ^ sources.list a-        -> [DebSource] -- ^ sources.list b-        -> IO (M.Map Text (DebianVersion, DebianVersion)) -- ^ a map of trumped package names to (version a, version b)-trumped fetcher cacheDir arch sourcesA sourcesB =-    do indexesA <- update fetcher cacheDir arch (filter isDebSrc sourcesA)-       pmA <- makePackageMap (fromJust . extractVersion) max (map fromJust indexesA)-       indexesB <- update fetcher cacheDir arch (filter isDebSrc sourcesB)-       pmB <- makePackageMap (fromJust . extractVersion) max (map fromJust indexesB)-       return (trumpedMap pmA pmB)-    where-      isDebSrc ds = sourceType ds == DebSrc---- |calculate all the trumped packages-trumpedMap :: M.Map Text DebianVersion -- ^ package map a-           -> M.Map Text DebianVersion -- ^ package map b-           -> M.Map Text (DebianVersion, DebianVersion) -- ^ trumped packages (version a, version b)-trumpedMap pmA pmB =-    M.foldWithKey (checkTrumped pmB) M.empty pmA-    where-      checkTrumped pm package aVersion trumpedPM =-          case M.lookup package pm of-            (Just bVersion)-              | bVersion > aVersion -> M.insert package (aVersion, bVersion) trumpedPM-            _ -> trumpedPM---- |create <trumped /> XML element and children from a trumped Map-trumpedXML :: M.Map Text (DebianVersion, DebianVersion) -> CFilter Posn-trumpedXML trumpedMap' =-    mkElem "trumped" (map mkTrumpedPackage (M.toAscList trumpedMap' ))-    where-      mkTrumpedPackage (package, (oldVersion, newVersion)) =-          mkElem "trumpedPackage"-                     [ mkElem "package" [ cdata (unpack package) ]-                     , mkElem "oldVersion" [ cdata (render . prettyDebianVersion $ oldVersion) ]-                     , mkElem "newVersion" [ cdata (render . prettyDebianVersion $ newVersion) ]-                     ]

@@ -1,171 +0,0 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}-module Debian.Sources where--import Data.List (intercalate)-import Data.Monoid ((<>))-import Debian.Pretty (PP(..))-import Debian.Release-import Network.URI (URI, uriToString, parseURI, unEscapeString, escapeURIString, isAllowedInURI)-import Text.PrettyPrint (text, hcat)-import Text.PrettyPrint.HughesPJClass (Pretty(pPrint))--data SourceType-    = Deb | DebSrc-    deriving (Eq, Ord, Show)--data DebSource-    = DebSource-    { sourceType :: SourceType-    , sourceUri :: URI-    , sourceDist :: Either String (ReleaseName, [Section])-    } deriving (Eq, Ord, Show)--instance Pretty SourceType where-    pPrint Deb = text "deb"-    pPrint DebSrc = text "deb-src"--instance Pretty DebSource where-    pPrint (DebSource thetype theuri thedist) =-        pPrint thetype <>-        text (" " <> uriToString id theuri " " <>-              case thedist of-                Left exactPath -> escape exactPath-                Right (dist, sections) -> releaseName' dist <> " " <> intercalate " " (map sectionName' sections))-            where escape = escapeURIString isAllowedInURI--instance Pretty (PP [DebSource]) where-    pPrint = hcat . map (\ x -> pPrint x <> text "\n") . unPP---- |This is a name given to a combination of parts of one or more--- releases that can be specified by a sources.list file.-type SliceName = ReleaseName--- data SliceName = SliceName { sliceName :: String } deriving (Eq, Ord, Show)--{---deb uri distribution [component1] [componenent2] [...]--The URI for the deb type must specify the base of the Debian-distribution, from which APT will find the information it needs.--distribution can specify an exact path, in which case the components-must be omitted and distribution must end with a slash (/).--If distribution does not specify an exact path, at least one component-must be present.--Distribution may also contain a variable, $(ARCH), which expands to-the Debian architecture (i386, m68k, powerpc, ...)  used on the-system.--The rest of the line can be marked as a comment by using a #.--Additional Notes:-- + Lines can begin with leading white space.-- + If the dist ends with slash (/), then it must be an absolute path-   and it is an error to specify components after it.---}---- |quoteWords - similar to words, but with special handling of--- double-quotes and brackets.------ The handling double quotes and [] is supposed to match:--- apt-0.6.44.2\/apt-pkg\/contrib\/strutl.cc:ParseQuoteWord()------ The behaviour can be defined as:------  Break the string into space seperated words ignoring spaces that---  appear between \"\" or []. Strip trailing and leading white space---  around words. Strip out double quotes, but leave the square---  brackets intact.-quoteWords :: String -> [String]-quoteWords [] = []-quoteWords s = quoteWords' (dropWhile (==' ') s)-    where-      quoteWords' :: String -> [String]-      quoteWords' [] = []-      quoteWords' str =-          case break (flip elem (" [\"" :: String)) str of-            ([],[]) -> []-            (w, []) -> [w]-            (w, (' ':rest)) -> w : (quoteWords' (dropWhile (==' ') rest))-            (w, ('"':rest)) ->-                case break (== '"') rest of-                  (w',('"':rest)) ->-                      case quoteWords' rest of-                        [] ->  [w ++ w']-                        (w'':ws) -> ((w ++ w' ++ w''): ws)-                  (_w',[]) -> error ("quoteWords: missing \" in the string: "  ++ s)-                  _ -> error ("the impossible happened in SourcesList.quoteWords")-            (w, ('[':rest)) ->-                case break (== ']') rest of-                  (w',(']':rest)) ->-                      case quoteWords' rest of-                        []       -> [w ++ "[" ++ w' ++ "]"]-                        (w'':ws) -> ((w ++ "[" ++ w' ++ "]" ++ w''): ws)-                  (_w',[]) -> error ("quoteWords: missing ] in the string: "  ++ s)-                  _ -> error ("the impossible happened in SourcesList.quoteWords")-            _ -> error ("the impossible happened in SourcesList.quoteWords")--stripLine :: String -> String-stripLine = takeWhile (/= '#') . dropWhile (== ' ')--sourceLines :: String -> [String]-sourceLines = filter (not . null) . map stripLine . lines---- |parseSourceLine -- parses a source line--- the argument must be a non-empty, valid source line with comments stripped--- see: 'sourceLines'-parseSourceLine :: String -> DebSource-parseSourceLine str =-    case quoteWords str of-      (theTypeStr : theUriStr : theDistStr : sectionStrs) ->-          let sections = map parseSection' sectionStrs-              theType = case unEscapeString theTypeStr of-                          "deb" -> Deb-                          "deb-src" -> DebSrc-                          o -> error ("parseSourceLine: invalid type " ++ o ++ " in line:\n" ++ str)-              theUri = case parseURI theUriStr of-                         Nothing -> error ("parseSourceLine: invalid uri " ++ theUriStr ++ " in the line:\n" ++ str)-                         Just u -> u-              theDist = unEscapeString theDistStr-          in-            case last theDist of-              '/' -> if null sections-                      then DebSource { sourceType = theType, sourceUri = theUri, sourceDist = Left theDist }-                      else error ("parseSourceLine: Dist is an exact path, so sections are not allowed on the line:\n" ++ str)-              _ -> if null sections-                    then error ("parseSourceLine: Dist is not an exact path, so at least one section is required on the line:\n" ++ str)-                    else DebSource { sourceType = theType, sourceUri = theUri, sourceDist = Right (parseReleaseName theDist, sections) }-      _ -> error ("parseSourceLine: invalid line in sources.list:\n" ++ str)--parseSourceLine' :: String -> Maybe DebSource-parseSourceLine' str =-    case quoteWords str of-      (theTypeStr : theUriStr : theDistStr : sectionStrs) ->-          let sections = map parseSection' sectionStrs-              theType = case unEscapeString theTypeStr of-                          "deb" -> Just Deb-                          "deb-src" -> Just DebSrc-                          _ -> Nothing-              theUri = case parseURI theUriStr of-                         Nothing -> Nothing-                         Just u -> Just u-              theDist = unEscapeString theDistStr-          in-            case (last theDist, theType, theUri) of-              ('/', Just typ, Just uri) -> if null sections-                      then Just $ DebSource { sourceType = typ, sourceUri = uri, sourceDist = Left theDist }-                      else error ("parseSourceLine: Dist is an exact path, so sections are not allowed on the line:\n" ++ str)-              (_, Just typ, Just uri) -> if null sections-                    then Nothing-                    else Just $ DebSource { sourceType = typ, sourceUri = uri, sourceDist = Right ((parseReleaseName theDist), sections) }-              _ -> Nothing-      _ -> Nothing--parseSourcesList :: String -> [DebSource]-parseSourcesList = map parseSourceLine . sourceLines

@@ -1,27 +0,0 @@-{-# LANGUAGE CPP #-}-module Debian.Time where--import Data.Time-#if !MIN_VERSION_time(1,5,0)-import System.Locale (defaultTimeLocale)-#endif-import Data.Time.Clock.POSIX-import System.Posix.Types---- * Time Helper Functions--rfc822DateFormat' :: String-rfc822DateFormat' = "%a, %d %b %Y %T %z"--epochTimeToUTCTime :: EpochTime -> UTCTime-epochTimeToUTCTime = posixSecondsToUTCTime . fromIntegral . fromEnum--formatTimeRFC822 :: (FormatTime t) => t -> String-formatTimeRFC822 = formatTime defaultTimeLocale rfc822DateFormat'--parseTimeRFC822 :: (ParseTime t) => String -> Maybe t-parseTimeRFC822 = parseTime defaultTimeLocale rfc822DateFormat'--getCurrentLocalRFC822Time :: IO String-getCurrentLocalRFC822Time = getCurrentTime >>= utcToLocalZonedTime >>= return . formatTime defaultTimeLocale rfc822DateFormat'-

@@ -1,90 +0,0 @@-{-# LANGUAGE PackageImports #-}-{-# OPTIONS -fno-warn-orphans #-}-module Debian.URI-    ( module Network.URI-    , URI'-    , toURI'-    , fromURI'-    , readURI'-    , uriToString'-    , fileFromURI-    , fileFromURIStrict-    , dirFromURI-    ) where--import Control.Exception (SomeException, try)-import Data.ByteString.Lazy.UTF8 as L-import qualified Data.ByteString.Lazy.Char8 as L-import Data.Maybe (catMaybes, fromJust)-import Network.URI (URI(..), URIAuth(..), parseURI, uriToString)-import System.Directory (getDirectoryContents)--- import System.Process.ByteString (readProcessWithExitCode)-import System.Process.ByteString.Lazy (readProcessWithExitCode)-import Text.Regex (mkRegex, matchRegex)---- | A wrapper around a String containing a known parsable URI.  Not--- absolutely safe, because you could say read "URI' \"bogus string\""--- :: URI'.  But enough to save me from myself.-newtype URI' = URI' String deriving (Read, Show, Eq, Ord)--readURI' :: String -> Maybe URI'-readURI' s = maybe Nothing (const (Just (URI' s))) (parseURI s)--fromURI' :: URI' -> URI-fromURI' (URI' s) = fromJust (parseURI s)---- | Using the bogus Show instance of URI here.  If it ever gets fixed--- this will stop working.  Worth noting that show will obscure any--- password info embedded in the URI, so that's nice.-toURI' :: URI -> URI'-toURI' = URI' . show--uriToString' :: URI -> String-uriToString' uri = uriToString id uri ""--fileFromURI :: URI -> IO (Either SomeException L.ByteString)-fileFromURI uri = fileFromURIStrict uri--fileFromURIStrict :: URI -> IO (Either SomeException L.ByteString)-fileFromURIStrict uri = try $-    case (uriScheme uri, uriAuthority uri) of-      ("file:", Nothing) -> L.readFile (uriPath uri)-      -- ("ssh:", Just auth) -> cmdOutputStrict ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " cat " ++ show (uriPath uri))-      ("ssh:", Just auth) -> do-          let cmd = "ssh"-              args = [uriUserInfo auth ++ uriRegName auth ++ uriPort auth, "cat", uriPath uri]-          (_code, out, _err) <- readProcessWithExitCode cmd args L.empty-          return out-      _ -> do-          let cmd = "curl"-              args = ["-s", "-g", uriToString' uri]-          (_code, out, _err) <- readProcessWithExitCode cmd args L.empty-          return out---- | Parse the text returned when a directory is listed by a web--- server.  This is currently only known to work with Apache.--- NOTE: there is a second copy of this function in--- Extra:Extra.Net. Please update both locations if you make changes.-webServerDirectoryContents :: L.ByteString -> [String]-webServerDirectoryContents text =-    catMaybes . map (second . matchRegex re) . Prelude.lines . L.toString $ text-    where-      re = mkRegex "( <A HREF|<a href)=\"([^/][^\"]*)/\""-      second (Just [_, b]) = Just b-      second _ = Nothing---dirFromURI :: URI -> IO (Either SomeException [String])-dirFromURI uri = try $-    case (uriScheme uri, uriAuthority uri) of-      ("file:", Nothing) -> getDirectoryContents (uriPath uri)-      ("ssh:", Just auth) ->-          do let cmd = "ssh"-                 args = [uriUserInfo auth ++ uriRegName auth ++ uriPort auth, "ls", "-1", uriPath uri]-             (_code, out, _err) <- readProcessWithExitCode cmd args L.empty-             return . Prelude.lines . L.toString $ out-      _ ->-          do let cmd = "curl"-                 args = ["-s", "-g", uriToString' uri]-             (_code, out, _err) <- readProcessWithExitCode cmd args L.empty-             return . webServerDirectoryContents $ out

@@ -1,29 +0,0 @@-{-# LANGUAGE CPP #-}--- | There are old index files that have funky characters like 'ø'--- that are not properly UTF8 encoded.  As far as I can tell, these--- files are otherwise plain ascii, so just naivelyinsert the--- character into the output stream.-module Debian.UTF8-    ( decode-    , readFile-    ) where--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif-import qualified Data.ByteString.Char8 as B (concat)-import qualified Data.ByteString.Lazy.Char8 as L (ByteString, readFile, toChunks)-import Data.Char (chr)-import Data.Text as T-import Data.Text.Encoding (decodeUtf8With)-import Data.Word (Word8)-import Prelude hiding (readFile)--decode :: L.ByteString -> T.Text-decode b = decodeUtf8With e (B.concat (L.toChunks b))-    where-      e :: String -> Maybe Word8 -> Maybe Char-      e _description w = fmap (chr . fromIntegral) w--readFile :: FilePath -> IO T.Text-readFile path = decode <$> L.readFile path

@@ -1,256 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}-module Debian.Util.FakeChanges (fakeChanges) where----import Control.Arrow-import Control.Exception-import Control.Monad hiding (mapM)-import qualified Data.ByteString.Lazy.Char8 as L-import Data.Data (Data, Typeable)-import qualified Data.Digest.Pure.MD5 as MD5-import Data.Foldable (concat, all, foldr)-import Data.List as List (intercalate, nub, partition, isSuffixOf)-import Data.Maybe-import Debian.Pretty (prettyShow)-import Data.Traversable-import Debian.Control-import qualified Debian.Deb as Deb-import Debian.Time-import Network.BSD (getHostName)-import Prelude hiding (concat, foldr, all, mapM, sum)-import System.Environment-import System.FilePath-import System.Posix.Files-import Text.Regex.TDFA--data Error-    = NoDebs-    | TooManyDscs [FilePath]-    | TooManyTars [FilePath]-    | TooManyDiffs [FilePath]-    | UnknownFiles [FilePath]-    | MalformedDebFilename [FilePath]-    | VersionMismatch [Maybe String]-    deriving (Read, Show, Eq, Typeable, Data)--data Files-    = Files { dsc :: Maybe (FilePath, Paragraph)-            , debs :: [(FilePath, Paragraph)]-            , tar :: Maybe FilePath-            , diff :: Maybe FilePath-            }--fakeChanges :: [FilePath] -> IO (FilePath, String)-fakeChanges fps =-    do files <- loadFiles fps-       let version      = getVersion files-           source       = getSource files-           maintainer   = getMaintainer files-           arches       = getArches files-           binArch      = getBinArch files-           dist         = "unstable"-           urgency      = "low"-           (invalid, binaries) = unzipEithers $ map (debNameSplit . fst) (debs files)-       when (not . null $ invalid) (error $ "Some .deb names are invalid: " ++ show invalid)-       uploader <- getUploader-       date <- getCurrentLocalRFC822Time-       fileLines <- mapM mkFileLine fps-       let changes = Control $ return . Paragraph $ map Field-               [ ("Format"," 1.7")-               , ("Date", ' ' : date)-               , ("Source", ' ' : source)-               , ("Binary", ' ' : (intercalate " " $ map (\(n,_,_) -> n) binaries))-               , ("Architecture", ' ' : intercalate " " arches)-               , ("Version", ' ' : version)-               , ("Distribution", ' ' : dist)-               , ("Urgency", ' ' : urgency)-               , ("Maintainer", ' ' : maintainer)-               , ("Changed-By", ' ' : uploader)-               , ("Description", "\n Simulated description")-               , ("Changes", "\n" ++ unlines (map (' ':) [ source ++ " (" ++ version ++") " ++ dist ++ "; urgency=" ++ urgency-                                                         , "."-                                                         , "  * Simulated changes"-                                                         ]-                                             ))-               , ("Files", "\n" ++ unlines fileLines)-               ]-       return $ (concat [ source, "_", version, "_", binArch, ".changes"], prettyShow changes)---       let (invalid, binaries) = unzipEithers $ map debNameSplit debs-{--       when (not . null $ invalid) (throwDyn [MalformedDebFilename invalid])-       version <- getVersion dsc debs-       putStrLn version-       source <- getSource dsc debs-       putStrLn source--}--- TODO: seems like this could be more aggressive about ensure the--- versions make sense. Except with packages like libc, the versions--- don't make sense. Maybe we want a flag that disables version check--- ?-getVersion :: Files -> String-getVersion files-    | isNothing (dsc files) =-        let versions = map (fieldValue "Version" . snd) (debs files)-        in-          if (all isJust versions) && (length (nub versions) == 1)-          then fromJust (head versions)-          else error (show [VersionMismatch (nub versions)])-    | otherwise =-        case fieldValue "Version" (snd . fromJust $ dsc files) of-          (Just v) -> v-          Nothing  -> error $ "show (dsc files)" ++ " does not have a Version field :("---getSource :: Files -> String-getSource files =-    let dscSource =-            case (dsc files) of-              Nothing -> []-              (Just (fp, p)) ->-                  case fieldValue "Source" p of-                    (Just v) -> [v]-                    Nothing -> error $ fp ++ " does not have a Source field :("-        debSources = map debSource (debs files)-        srcs = nub (dscSource ++ debSources)-    in-      if (singleton srcs)-         then (head srcs)-         else error $ "Could not determine source."-    where-      debSource (deb,p) =-          case (fieldValue "Source" p) of-            (Just v) -> v-            Nothing ->-                case fieldValue "Package" p of-                  (Just v) -> v-                  Nothing -> error $ "Could not find Source or Package field in " ++ deb----getMaintainer :: Files -> String-getMaintainer files-    | isJust (dsc files) =-        let (fp, p) = fromJust (dsc files)-        in-          case fieldValue "Maintainer" p of-            Nothing -> error $ fp ++ " is missing the Maintainer field."-            (Just v) -> v-    | otherwise =-        let maintainers = catMaybes $ map (fieldValue "Maintainer" . snd) (debs files)-            maintainer = nub maintainers-        in-          if singleton maintainer-             then head maintainer-             else error $ "Could not uniquely determine the maintainer: " ++ show maintainer--getArches :: Files -> [String]-getArches files =-    let debArchs = map (fieldValue "Architecture" . snd) (debs files)-        tarArch  = fmap (const "source") (tar files)-        diffArch = fmap (const "source") (diff files)-    in-      nub $ catMaybes (tarArch : diffArch : debArchs)---getBinArch :: Files -> String-getBinArch files =-    let binArch = nub $ mapMaybe (fieldValue "Architecture" . snd) (debs files)-    in-      if singleton binArch-         then head binArch-         else case (filter (/= "all") binArch) of-                [b] -> b-                _ -> error $ "Could not uniquely determine binary architecture: " ++ show binArch--mkFileLine :: FilePath -> IO String-mkFileLine fp-    | ".deb" `isSuffixOf` fp =-        do sum <- L.readFile fp >>= return . show . MD5.md5-           size <- liftM fileSize $ getFileStatus fp-           (Control (p:_)) <- Deb.fields fp-           return $ concat [ " ", sum, " ", show size, " ", fromMaybe "unknown" (fieldValue "Section" p), " "-                           , fromMaybe "optional" (fieldValue "Priority" p), " ", (takeBaseName fp)-                           ]-    | otherwise =-        do sum <- L.readFile fp >>= return . show . MD5.md5-           size <- liftM fileSize $ getFileStatus fp-           return $ concat [ " ", sum, " ", show size, " ", "unknown", " "-                           , "optional"," ", (takeBaseName fp)-                           ]---- more implementations can be found at:--- http://www.google.com/codesearch?hl=en&lr=&q=%22%5BEither+a+b%5D+-%3E+%28%5Ba%5D%2C%5Bb%5D%29%22&btnG=Search-unzipEithers :: [Either a b] -> ([a],[b])-unzipEithers = foldr unzipEither ([],[])-    where-      unzipEither (Left l) ~(ls, rs) = (l:ls, rs)-      unzipEither (Right r) ~(ls, rs) = (ls, r:rs)---- move to different library-debNameSplit :: String -> Either FilePath (String, String, String)-debNameSplit fp =-    case (takeFileName fp) =~ "^(.*)_(.*)_(.*).deb$" of-      [[_, name, version, arch]] -> Right (name, version, arch)-      _ -> Left fp---loadFiles :: [FilePath] -> IO Files-loadFiles files =-       let (dscs', files'') = partition (isSuffixOf ".dsc") files'-           (debs', files') = partition (isSuffixOf ".deb") files-           (tars', files''') = partition (isSuffixOf ".tar.gz") files''-           (diffs', rest) = partition (isSuffixOf ".diff.gz") files'''-           errors = concat [ if (length debs'  < 1) then [NoDebs] else []-                           , if (length dscs'  > 1) then [TooManyDscs dscs']   else []-                           , if (length tars'  > 1) then [TooManyTars tars']   else []-                           , if (length diffs' > 1) then [TooManyDiffs diffs'] else []-                           , if (length rest  > 0) then [UnknownFiles rest]  else []-                           ]-       in-         do when (not . null $ errors) (error $ show errors)-            dsc' <- mapM loadDsc (listToMaybe dscs')-            debs'' <- mapM loadDeb debs'-            return $ Files { dsc = dsc', debs = debs'', tar = listToMaybe tars', diff = listToMaybe diffs' }-         -- if (not . null $ errors) then throwDyn errors else return (debs, listToMaybe dscs, listToMaybe tars, listToMaybe diffs)-    where-      loadDsc :: FilePath -> IO (FilePath, Paragraph)-      loadDsc dsc' =-          do res <- parseControlFromFile dsc'-             case  res of-               (Left e) -> error $ "Error parsing " ++ dsc' ++ "\n" ++ show e-               (Right (Control [p])) -> return (dsc', p)-               (Right c) -> error $ dsc' ++ " did not have exactly one paragraph: " ++ prettyShow c-      loadDeb :: FilePath -> IO (FilePath, Paragraph)-      loadDeb deb =-          do res <- Deb.fields deb-             case res of-               (Control [p]) -> return (deb, p)-               _ -> error $ deb ++ " did not have exactly one paragraph: " ++ prettyShow res---getUploader :: IO String-getUploader =-    do debFullName <--           do dfn <- try (getEnv "DEBFULLNAME")-              case dfn of-                (Right n) -> return n-                (Left (_ :: SomeException)) ->-                    do dfn' <-try (getEnv "USER")-                       case dfn' of-                         (Right n) -> return n-                         (Left (_ :: SomeException)) -> error $ "Could not determine user name, neither DEBFULLNAME nor USER enviroment variables were set."-       emailAddr <--           do eml <- try (getEnv "DEBEMAIL")-              case eml of-                (Right e) -> return e-                (Left (_ :: SomeException)) ->-                    do eml' <- try (getEnv "EMAIL")-                       case eml' of-                         (Right e) -> return e-                         (Left (_ :: SomeException)) -> getHostName -- FIXME: this is not a FQDN-       return $ debFullName ++ " <" ++ emailAddr ++ ">"---- * Utils--singleton :: [a] -> Bool-singleton [_] = True-singleton _ = False

@@ -1,16 +0,0 @@--- |A module for parsing, comparing, and (eventually) modifying debian version--- numbers. <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version>-module Debian.Version-    (DebianVersion -- |Exported abstract because the internal representation is likely to change-    , prettyDebianVersion-    , parseDebianVersion-    , parseDebianVersion'-    , epoch-    , version-    , revision-    , buildDebianVersion-    , evr-    ) where--import Debian.Version.Common-import Debian.Version.String ()

@@ -1,18 +0,0 @@-{-# OPTIONS -fno-warn-orphans #-}-module Debian.Version.ByteString-    ( ParseDebianVersion(..)-    ) where--import Text.ParserCombinators.Parsec--import qualified Data.ByteString.Char8 as C--import Debian.Version.Common-import Debian.Version.Internal--instance ParseDebianVersion C.ByteString where-    parseDebianVersion byteStr =-        let str = C.unpack byteStr in-        case parse parseDV str str of-          Left e -> Left e-          Right dv -> Right (DebianVersion str dv)

@@ -1,185 +0,0 @@--- |A module for parsing, comparing, and (eventually) modifying debian version--- numbers. <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version>-{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS -fno-warn-orphans -fno-warn-unused-do-bind #-}-module Debian.Version.Common-    ( DebianVersion -- |Exported abstract because the internal representation is likely to change-    , prettyDebianVersion-    , ParseDebianVersion(..)-    , parseDebianVersion'-    , evr               -- DebianVersion -> (Maybe Int, String, Maybe String)-    , epoch-    , version-    , revision-    , buildDebianVersion-    , parseDV-    ) where--import Data.Char (ord, isDigit, isAlpha)-import Debian.Pretty (PP(..))-import Debian.Version.Internal-import Text.ParserCombinators.Parsec-import Text.Regex-import Text.PrettyPrint (Doc, render)-import Text.PrettyPrint.HughesPJClass (Pretty(pPrint), text)--prettyDebianVersion :: DebianVersion -> Doc-prettyDebianVersion (DebianVersion s _) = text s--instance Pretty (PP DebianVersion) where-    pPrint = prettyDebianVersion . unPP--instance Eq DebianVersion where-    (DebianVersion _ v1) == (DebianVersion _ v2) = v1 == v2--instance Ord DebianVersion where-    compare (DebianVersion _ v1) (DebianVersion _ v2) = compare v1 v2--instance Show DebianVersion where-    show v = "(Debian.Version.parseDebianVersion (" ++ show (render (prettyDebianVersion v)) ++ " :: String))"---- make ~ less than everything, and everything else higher that letters-order :: Char -> Int-order c-    | isDigit c = 0-    | isAlpha c = ord c-    | c == '~' = -1-    | otherwise = (ord c) + 256---- |We have to do this wackiness because ~ is less than the empty string-compareNonNumeric :: [Char] -> [Char] -> Ordering-compareNonNumeric "" "" = EQ-compareNonNumeric "" ('~':_cs) = GT-compareNonNumeric ('~':_cs) "" = LT-compareNonNumeric "" _ = LT-compareNonNumeric _ "" = GT-compareNonNumeric (c1:cs1) (c2:cs2) =-    if (order c1) == (order c2)-       then compareNonNumeric cs1 cs2-       else compare (order c1) (order c2)--instance Eq NonNumeric where-    (NonNumeric s1 n1) == (NonNumeric s2 n2) =-        case compareNonNumeric s1 s2 of-          EQ -> n1 == n2-          _o -> False--instance Ord NonNumeric where-    compare (NonNumeric s1 n1) (NonNumeric s2 n2) =-        case compareNonNumeric s1 s2 of-          EQ -> compare n1 n2-          o -> o--instance Eq Numeric where-    (Numeric n1 mnn1) == (Numeric n2 mnn2) =-        case compare n1 n2 of-          EQ -> case compareMaybeNonNumeric mnn1 mnn2 of-                  EQ -> True-                  _ -> False-          _ -> False--compareMaybeNonNumeric :: Maybe NonNumeric -> Maybe NonNumeric -> Ordering-compareMaybeNonNumeric mnn1 mnn2 =-    case (mnn1, mnn2) of-      (Nothing, Nothing) -> EQ-      (Just (NonNumeric nn _), Nothing) -> compareNonNumeric nn ""-      (Nothing, Just (NonNumeric nn _)) -> compareNonNumeric "" nn-      (Just nn1, Just nn2) -> compare nn1 nn2--instance Ord Numeric where-    compare (Numeric n1 mnn1) (Numeric n2 mnn2) =-        case compare n1 n2 of-          EQ -> compareMaybeNonNumeric mnn1 mnn2-          o -> o---- * Parser--class ParseDebianVersion a where-    parseDebianVersion :: a-> Either ParseError DebianVersion--- |Convert a string to a debian version number. May throw an--- exception if the string is unparsable -- but I am not sure if that--- can currently happen. Are there any invalid version strings?--- Perhaps ones with underscore, or something?--parseDebianVersion' :: ParseDebianVersion string => string -> DebianVersion-parseDebianVersion' str = either (\e -> error (show e)) id (parseDebianVersion str)--{--showNN :: NonNumeric -> String-showNN (NonNumeric s n) = s ++ showN n--showN :: Found Numeric -> String-showN (Found (Numeric n nn)) = show n ++ maybe "" showNN nn-showN (Simulated _) = ""--}--parseDV :: CharParser () (Found Int, NonNumeric, Found NonNumeric)-parseDV =-    do skipMany $ oneOf " \t"-       e <- parseEpoch-       upstreamVersion <- parseNonNumeric True True-       debianRevision <- option (Simulated (NonNumeric "" (Simulated (Numeric 0 Nothing)))) (char '-' >> parseNonNumeric True False >>= return . Found)-       return (e, upstreamVersion, debianRevision)--parseEpoch :: CharParser () (Found Int)-parseEpoch =-    option (Simulated 0) (try (many1 digit >>= \d -> char ':' >> return (Found (read d))))---parseNonNumeric :: Bool -> Bool -> CharParser () NonNumeric-parseNonNumeric zeroOk upstream =-    do nn <- (if zeroOk then many else many1) ((noneOf "-0123456789") <|> (if upstream then upstreamDash else pzero))-       n <- parseNumeric upstream-       return $ NonNumeric nn n-    where-      upstreamDash :: CharParser () Char-      upstreamDash = try $ do char '-'-                              lookAhead $ (many (noneOf "- \n\t") >> char '-')-                              return '-'--parseNumeric :: Bool -> CharParser () (Found Numeric)-parseNumeric upstream =-    do n <- many1 (satisfy isDigit)-       nn <- option Nothing  (parseNonNumeric False upstream >>= return . Just)-       return $ Found (Numeric (read n) nn)-    <|>-    return (Simulated (Numeric 0 Nothing))--{--compareTest :: String -> String -> Ordering-compareTest str1 str2 =-    let v1 = either (error . show) id $ parse parseDV str1 str1-        v2 = either (error . show) id $ parse parseDV str2 str2-        in-          compare v1 v2--}---- |Split a DebianVersion into its three components: epoch, version,--- revision.  It is not safe to use the parsed version number for--- this because you will lose information, such as leading zeros.-evr :: DebianVersion -> (Maybe Int, String, Maybe String)-evr (DebianVersion s _) =-    let re = mkRegex "^(([0-9]+):)?(([^-]*)|((.*)-([^-]*)))$" in-    --                 (         ) (        (            ))-    --                  (   e  )    (  v  )  (v2) (  r  )-    case matchRegex re s of-      Just ["", _, _, v, "", _, _] -> (Nothing, v, Nothing)-      Just ["", _, _, _, _,  v, r] -> (Nothing, v, Just r)-      Just [_,  e, _, v, "", _, _] -> (Just (read e), v, Nothing)-      Just [_,  e, _, _, _,  v, r] -> (Just (read e), v, Just r)-      -- I really don't think this can happen.-      _ -> error ("Invalid Debian Version String: " ++ s)--epoch :: DebianVersion -> Maybe Int-epoch v = case evr v of (x, _, _) -> x-version :: DebianVersion -> String-version v = case evr v of (_, x, _) -> x-revision :: DebianVersion -> Maybe String-revision v = case evr v of (_, _, x) -> x---- Build a Debian version number from epoch, version, revision-buildDebianVersion :: Maybe Int -> String -> Maybe String -> DebianVersion-buildDebianVersion e v r =-    either (error . show) (DebianVersion str) $ parse parseDV str str-    where-      str = (maybe "" (\ n -> show n ++ ":") e ++ v ++ maybe "" (\ s -> "-" ++ s) r)

@@ -1,36 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}-module Debian.Version.Internal-    ( DebianVersion(..)-    , Numeric(..)-    , NonNumeric(..)-    , Found(..)-    ) where--import Data.Data (Data)-import Data.Typeable (Typeable)---- Currently we store the original version string in the data-type so--- that we can faithfully reproduce it quickly. Currently we do not--- have any way to modify a version number -- so this works fine. May--- have to change later.-data DebianVersion-    = DebianVersion String (Found Int, NonNumeric, Found NonNumeric) deriving (Data, Typeable)--data NonNumeric-    = NonNumeric String (Found Numeric)-      deriving (Show, Data, Typeable)--data Numeric-    = Numeric Int (Maybe NonNumeric)-      deriving (Show, Data, Typeable)--data Found a-    = Found { unFound :: a }-    | Simulated { unFound :: a }-      deriving (Show, Data, Typeable)--instance (Eq a) => Eq (Found a) where-    f1 == f2 = (unFound f1) == (unFound f2)--instance (Ord a) => Ord (Found a) where-    compare f1 f2 = compare (unFound f1) (unFound f2)

@@ -1,25 +0,0 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}-{-# OPTIONS -fno-warn-orphans #-}-module Debian.Version.String-    ( ParseDebianVersion(..)-    ) where--import Text.ParserCombinators.Parsec--import Data.List (stripPrefix)-import Debian.Version.Common-import Debian.Version.Internal--instance ParseDebianVersion String where-    parseDebianVersion str =-        case parse parseDV str str of-          Left e -> Left e-          Right dv -> Right (DebianVersion str dv)- -instance Read DebianVersion where-    readsPrec _ s =-        case stripPrefix "Debian.Version.parseDebianVersion " s of-          Just s' -> case reads s' :: [(String, String)] of-                       []-> []-                       (v, s'') : _ -> [(parseDebianVersion' v, s'')]-          Nothing -> []

@@ -1,18 +0,0 @@-{-# OPTIONS -fno-warn-orphans #-}-module Debian.Version.Text-    ( ParseDebianVersion(..)-    ) where--import Text.ParserCombinators.Parsec--import qualified Data.Text as T--import Debian.Version.Common-import Debian.Version.Internal--instance ParseDebianVersion T.Text where-    parseDebianVersion text =-        let str = T.unpack text in-        case parse parseDV str str of-          Left e -> Left e-          Right dv -> Right (DebianVersion str dv)

@@ -1,3 +1,23 @@+haskell-cabal-debian (4.31.9) unstable; urgency=low++  * Fix official haskell packages repository URI+  * Update expected test results++ -- David Fox <dsf@seereason.com>  Mon, 21 Dec 2015 09:14:14 -0800++haskell-cabal-debian (4.31.8) unstable; urgency=low++  * Handle some idempotent cases in mapCabal and splitCabal+  * Add version split for happstack-authenticate package++ -- David Fox <dsf@seereason.com>  Thu, 08 Oct 2015 11:42:13 -0400++haskell-cabal-debian (4.31.7) unstable; urgency=low++  * Allow optparse-applicative-0.12.++ -- David Fox <dsf@seereason.com>  Fri, 25 Sep 2015 11:18:00 -0700+ haskell-cabal-debian (4.31.6) unstable; urgency=low    * Signature change in Debian.Version.parseDebianVersion

@@ -7,8 +7,9 @@  cdbs,  ghc,  ghc-prof,- libghc-cabal-dev (>= 1.18) | ghc,- libghc-cabal-prof (>= 1.18) | ghc-prof,+ libghc-cabal-dev (>= 1.16),+ libghc-cabal-dev (>= 1.18),+ libghc-cabal-prof (>= 1.18),  libghc-diff-dev (>= 0.3.1),  libghc-diff-prof (>= 0.3.1),  libghc-hunit-dev,@@ -112,7 +113,7 @@ Depends: ${haskell:Depends},  ${misc:Depends},  ${shlibs:Depends},- debian-policy+ debian-policy, Recommends: ${haskell:Recommends}, Suggests: ${haskell:Suggests}, Conflicts: ${haskell:Conflicts},

@@ -21,7 +21,7 @@ import Debian.Debianize.CabalInfo as A (debianNameMap, packageDescription, debInfo) import Debian.Debianize.BinaryDebDescription as Debian (PackageType(..)) import Debian.Debianize.DebInfo as D (overrideDebianNameBase, utilsPackageNameBase)-import Debian.Debianize.VersionSplits (DebBase(DebBase, unDebBase), doSplits, insertSplit, makePackage, VersionSplits)+import Debian.Debianize.VersionSplits (DebBase(DebBase, unDebBase), doSplits, insertSplit, makePackage, VersionSplits(oldestPackage, splits)) import Debian.Orphans () import Debian.Relation (PkgName(..), Relations) import qualified Debian.Relation as D (VersionReq(EEQ))@@ -107,6 +107,7 @@     where       f :: Maybe VersionSplits -> Maybe VersionSplits       f Nothing = Just (makePackage dname)+      f (Just sp) | any (== dname) (oldestPackage sp : map snd (splits sp)) = Just sp       f (Just sp) = error $ "mapCabal " ++ show pname ++ " " ++ show dname ++ ": - already mapped: " ++ show sp  -- | Map versions less than ver of Cabal Package pname to Debian package ltname

@@ -27,7 +27,7 @@        A.epochMap %= Map.insert (PackageName "HTTP") 1        -- Associate some build tools and their corresponding        -- (eponymous) debian package names-       mapM (\name -> (A.debInfo . D.execMap) %= Map.insert name [[Rel (BinPkgName name) Nothing Nothing]])+       mapM_ (\name -> (A.debInfo . D.execMap) %= Map.insert name [[Rel (BinPkgName name) Nothing Nothing]])             ["ghc", "happy", "alex", "hsx2hs"]        -- The parsec debs are suffixed with either "2" or "3"        mapCabal (PackageName "parsec") (DebBase "parsec3")@@ -42,3 +42,6 @@        mapCabal (PackageName "haskell-src-exts") (DebBase "src-exts")        mapCabal (PackageName "haskell-src-meta") (DebBase "src-meta")        mapCabal (PackageName "Cabal") (DebBase "cabal")++       mapCabal (PackageName "happstack-authenticate") (DebBase "happstack-authenticate")+       splitCabal (PackageName "happstack-authenticate") (DebBase "happstack-authenticate-0") (Version [2] [])

@@ -351,19 +351,23 @@                   _ -> error $ "There is no official packaging for " ++ show flavor  officialSettings :: (Monad m, Functor m) => CabalT m ()-officialSettings =-    do pkgDesc <- use A.packageDescription-       let PackageName cabal = pkgName (Cabal.package pkgDesc)+officialSettings = do+    pkgDesc <- use A.packageDescription+    let PackageName cabal = pkgName (Cabal.package pkgDesc)+    zoom A.debInfo $ do+        let officialError = error "officialSettings: no sourcePackageName" -       (A.debInfo . D.control . S.standardsVersion) .?= Just (parseStandardsVersion "3.9.6")-       (A.debInfo . D.control . S.homepage) .?= Just ("http://hackage.haskell.org/package/" <> pack cabal)-       (A.debInfo . D.omitProfVersionDeps) .= True-       SrcPkgName src <- use (A.debInfo . D.sourcePackageName) >>= maybe (error "officialSettings: no sourcePackageName") return+        D.omitProfVersionDeps .= True+        SrcPkgName src <- fromMaybe officialError <$> use D.sourcePackageName -       (A.debInfo . D.control . S.vcsFields) %= Set.union (Set.fromList-          [ S.VCSBrowser $ "http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/" <> pack src-          , S.VCSDarcs  $ "http://darcs.debian.org/pkg-haskell/" <> pack src-          ])+        let packagesURI = "https://anonscm.debian.org/cgit/pkg-haskell/DHG_packages.git/tree/p/" <> pack src+        zoom D.control $ do+           S.standardsVersion .?= Just (parseStandardsVersion "3.9.6")+           S.homepage .?= Just ("http://hackage.haskell.org/package/" <> pack cabal)+           S.vcsFields %= Set.union (Set.fromList+              [ S.VCSBrowser packagesURI+              , S.VCSGit  "git://git.debian.org/git/pkg-haskell/DHG_packages.git"+              ])  putBuildDeps :: (Monad m, Functor m) => (Relations -> Relations) -> PackageDescription -> CabalT m () putBuildDeps finalizeRelations pkgDesc =

@@ -4,7 +4,7 @@ module Debian.Debianize.VersionSplits     ( DebBase(DebBase, unDebBase)     -- * Combinators for VersionSplits-    , VersionSplits+    , VersionSplits(..)     , makePackage     , insertSplit     -- * Operators on VersionSplits@@ -43,7 +43,7 @@       -- ^ Each pair is The version where the split occurs, and the       -- name to use for versions greater than or equal to that       -- version.  This list assumed to be in (must be kept in)-      -- ascending version number order.+      -- descending version number order, newest to oldest       } deriving (Eq, Ord, Data, Typeable)  instance Show VersionSplits where@@ -59,12 +59,16 @@ makePackage name = VersionSplits {oldestPackage = name, splits = []}  -- | Split the version range and give the older packages a new name.-insertSplit :: Version -> DebBase -> VersionSplits -> VersionSplits+insertSplit :: Version -- ^ Where to split the version range+            -> DebBase -- ^ The name to use for versions older than the split+            -> VersionSplits+            -> VersionSplits insertSplit ver@(Version _ _) ltname sp@(VersionSplits {}) =     -- (\ x -> trace ("insertSplit " ++ show (ltname, ver, sp) ++ " -> " ++ show x) x) $     case splits sp of       -- This is the oldest split, change oldestPackage and insert a new head pair       (ver', _) : _ | ver' > ver -> sp {oldestPackage = ltname, splits = (ver, oldestPackage sp) : splits sp}+      (ver', name) : _ | ver' == ver && name == ltname -> sp       [] -> sp {oldestPackage = ltname, splits = [(ver, oldestPackage sp)]}       -- Not the oldest split, insert it in its proper place.       _ -> sp {splits = reverse (insert (reverse (splits sp)))}

@@ -62,8 +62,6 @@                , libghc-mtl-prof                , libghc-network-dev (>= 2.4)                , libghc-network-prof (>= 2.4)-	       , libghc-old-time-dev-	       , libghc-old-time-prof                , libghc-pandoc-dev                , libghc-pandoc-prof                , libghc-pandoc-types-dev@@ -92,6 +90,8 @@                , libghc-text-prof                , libghc-utf8-string-dev                , libghc-utf8-string-prof+               , libghc-xhtml-dev+               , libghc-xhtml-prof Build-Depends-Indep: ghc-doc                      , libghc-extra-doc                      , libghc-hunit-doc@@ -120,7 +120,6 @@                      , libghc-maccatcher-doc                      , libghc-mtl-doc                      , libghc-network-doc-		     , libghc-old-time-doc                      , libghc-pandoc-doc                      , libghc-pandoc-types-doc                      , libghc-parsec3-doc (>= 3) | libghc-parsec2-doc (<< 3)@@ -135,6 +134,7 @@                      , libghc-syb-with-class-doc                      , libghc-text-doc                      , libghc-utf8-string-doc+                     , libghc-xhtml-doc Standards-Version: 3.9.6 Homepage: http://artvaluereportonline.com X-Description: Data structures used by the fine art appraisal application

@@ -30,7 +30,7 @@                , libghc-fb-dev                , libghc-groom-dev                , libghc-happstack-dev-               , libghc-happstack-authenticate-dev+               , libghc-happstack-authenticate-dev (>= 2) | libghc-happstack-authenticate-0-dev (<< 2),                , libghc-happstack-extra-dev                , libghc-happstack-hsp-dev                , libghc-happstack-scaffolding-dev (>= 0.23)@@ -49,8 +49,6 @@                , libghc-lifted-base-dev                , libghc-mtl-dev                , libghc-network-dev (>= 2.4)-	       , libghc-old-locale-dev-	       , libghc-old-time-dev                , libghc-pandoc-dev 	       , libghc-parsec3-dev                , libghc-process-extras-dev (>= 0.5)@@ -64,12 +62,14 @@                , libghc-syb-with-class-dev                , libghc-tagged-dev                , libghc-text-dev+               , libghc-transformers-dev                , libghc-uniplate-dev                , libghc-utf8-string-dev                , libghc-web-routes-dev                , libghc-web-routes-happstack-dev                , libghc-web-routes-hsp-dev                , libghc-web-routes-th-dev+               , libghc-xhtml-dev Standards-Version: 3.9.6 Homepage: http://appraisalreportonline.com X-Description: Haskell modules for fine art appraisal applications

@@ -22,7 +22,6 @@                , libghc-digestive-functors-dev (>= 0.2)                , libghc-digestive-functors-happstack-dev (>= 0.1)                , libghc-digestive-functors-hsp-dev (>= 0.3.1)-               , libghc-extensible-exceptions-dev                , libghc-happstack-authenticate-dev (>= 0.6)                , libghc-happstack-hsp-dev (>= 7.1)                , libghc-happstack-hsp-dev (<< 7.2)@@ -38,8 +37,6 @@                , libghc-json-dev                , libghc-mtl-dev                , libghc-network-dev-               , libghc-old-locale-dev-               , libghc-old-time-dev                , libghc-parsec3-dev (>= 3) | libghc-parsec2-dev (<< 3)                , libghc-random-dev                , libghc-safecopy-dev (>= 0.6.0)