debian-3.91.1/0000755000000000000000000000000012775511355011230 5ustar0000000000000000debian-3.91.1/debian.cabal0000644000000000000000000000740712775511355013446 0ustar0000000000000000Name: debian Version: 3.91.1 License: BSD3 License-File: debian/copyright Author: David Fox , Jeremy Shaw , Clifford Beshers Category: Debian Maintainer: David Fox Homepage: https://github.com/ddssff/debian-haskell Build-Type: Simple Synopsis: Modules for working with the Debian package system Cabal-Version: >= 1.9 Description: This library includes modules covering some basic data types defined by the Debian policy manual - version numbers, control file syntax, etc. extra-source-files: Test/Main.hs, Test/Changes.hs, Test/Dependencies.hs, Test/SourcesList.hs, Test/Versions.hs, Test/Control.hs, changelog, debian/changelog, debian/changelog.pre-debian flag network-uri Description: Get Network.URI from the network-uri package Default: True flag pretty-new Description: pretty-1.1.2 includes the Text.PrettyPrint.HughesPJClass module from prettyclass Default: True Library Hs-Source-Dirs: . Build-Depends: base >= 4 && < 5, bytestring, bzlib, containers, directory, either, exceptions, filepath, HaXml >= 1.20, HUnit, ListLike >= 4.3.5, mtl, old-locale, parsec >= 2 && <4, process, process-extras >= 0.2.0, pureMD5, regex-compat, regex-tdfa, template-haskell, text, time, unix, Unixutils >= 1.52.4, utf8-string, zlib if flag(network-uri) Build-Depends: network >= 2.6, network-uri >= 2.6 else Build-Depends: network >= 2.4 && < 2.6 if flag(pretty-new) Build-Depends: pretty >= 1.1.2 else Build-Depends: pretty, prettyclass ghc-options: -Wall -O2 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.Builder Debian.Control.ByteString, Debian.Control.Policy, Debian.Control.String, Debian.Control.Text, Debian.Control.TextLazy, 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 Executable fakechanges Hs-Source-Dirs: utils Main-is: FakeChanges.hs Build-Depends: base, debian, directory, filepath ghc-options: -threaded -W -O2 Extensions: ExistentialQuantification CPP Executable debian-report Hs-Source-Dirs: utils Main-is: Report.hs Build-Depends: base, debian, HaXml, unix ghc-options: -threaded -W -O2 C-Sources: cbits/gwinsz.c Include-Dirs: cbits Install-Includes: gwinsz.h Extensions: ExistentialQuantification CPP Build-Depends: pretty Executable apt-get-build-depends Hs-Source-Dirs: utils Main-is: AptGetBuildDeps.hs Build-Depends: base, debian, process ghc-options: -threaded -W -O2 Extensions: ExistentialQuantification CPP Test-Suite debian-tests Type: exitcode-stdio-1.0 Hs-Source-Dirs: Test Main-Is: Main.hs Build-Depends: base, debian, HUnit, parsec, regex-tdfa, text if flag(pretty-new) Build-Depends: pretty >= 1.1.2 else Build-Depends: pretty, prettyclass source-repository head type: git location: https://github.com/ddssff/debian-haskell debian-3.91.1/Setup.hs0000644000000000000000000000013712775511355012665 0ustar0000000000000000#!/usr/bin/runhaskell import Distribution.Simple main = defaultMainWithHooks simpleUserHooks debian-3.91.1/changelog0000644000000000000000000004160712775511355013112 0ustar0000000000000000haskell-debian (3.91) unstable; urgency=low * Eliminate error call in parseChangeLog -- David Fox Thu, 06 Oct 2016 09:42:06 -0700 haskell-debian (3.89) unstable; urgency=low * Change signature of parseDebianVersion to return Either ParseError DebianVerions. * Provide the old signature as parseDebianVersion'. -- David Fox Mon, 21 Sep 2015 15:23:32 -0700 haskell-debian (3.88.1) unstable; urgency=low * Make ghc-7.10.2 a required travis test * Sort out the List/Map/Set imports in Debian.GenBuildDeps -- David Fox Mon, 24 Aug 2015 10:29:00 -0700 haskell-debian (3.88) unstable; urgency=low * Improved handling of white space * Speed up Debian.GenBuildDeps.buildable -- David Fox Mon, 24 Aug 2015 06:29:29 -0700 haskell-debian (3.87.2) unstable; urgency=low * Functor, Applicative, and Alternative instances for ghc-7.10 * Fiddle with imports and ifdefs to fix build * Switch from ansi-wl-pprint package to pretty -- David Fox Sun, 22 Mar 2015 12:55:39 -0700 haskell-debian (3.87.1) unstable; urgency=low * Version bump to match cabal -- David Fox Mon, 02 Mar 2015 13:13:00 -0800 haskell-debian (3.86) unstable; urgency=low * Avoid dependency on th-orphans * Turn test program into a test-suite * add DEB_ENABLE_TESTS = yes to debian/rules * Support builds on older versions of GHC -- David Fox Sun, 15 Feb 2015 07:32:42 -0800 haskell-debian (3.85.3) unstable; urgency=low * Handle new pretty-1.1.2 package, which supercedes prettyclass. * Make a change to trigger a travis build. -- David Fox Fri, 06 Feb 2015 10:18:30 -0800 haskell-debian (3.85.2) unstable; urgency=low * If any of the lines of a multi-line control file field are not indented, indent all the lines by one space. * When formatting multi-line control file fields, make sure empty lines are replaced by a single (indented) '.'. -- David Fox Wed, 04 Feb 2015 11:23:42 -0800 haskell-debian (3.85.1) unstable; urgency=low * Allow build with process-extras-0.2.0 -- David Fox Thu, 04 Dec 2014 06:23:38 -0800 haskell-debian (3.85) unstable; urgency=low * Fix some cases where the pretty printer output parsed to something different from its input -- David Fox Sat, 29 Nov 2014 09:27:42 -0800 haskell-debian (3.84.1) unstable; urgency=low * Remove a Show instance that overlaps the one derived in the Control type declaration. -- David Fox Sat, 29 Nov 2014 05:18:40 -0800 haskell-debian (3.84) unstable; urgency=low * Replace the Debian.Pretty module with a module copied from the pretty-class package, Text.PrettyPrint.HughesPJClass. This is almost identical to the module in Lennart's prettyclass package, but has what I believe to be a more correct pPrintList method for type Char. -- David Fox Sun, 14 Sep 2014 12:37:57 -0700 haskell-debian (3.83.4.2) unstable; urgency=low * Require a better version of process-listlike. * Trigger a new build on hackage to get documentation. -- David Fox Tue, 02 Sep 2014 08:29:32 -0700 haskell-debian (3.83.4.1) unstable; urgency=low * Merge change from version 3.83.3.1 (which only went to hackage) and 3.83.4 (whose version change didn't get checked into git.) * Require ListLike >= 4. * Fix repository type in the cabal file. -- David Fox Tue, 02 Sep 2014 07:24:27 -0700 haskell-debian (3.83.3) unstable; urgency=low * Moved repository to https://github.com/ddssff/debian-haskell -- David Fox Thu, 28 Aug 2014 08:36:16 -0700 haskell-debian (3.83.2) unstable; urgency=low * Add some Read, Show, Data, and Typeable instances. -- David Fox Mon, 25 Aug 2014 03:47:38 -0700 haskell-debian (3.83.1) unstable; urgency=low * Support new network-uri package. -- David Fox Sun, 24 Aug 2014 17:17:55 -0700 haskell-debian (3.83) unstable; urgency=low * Add a Loc value to the ControlFileError type, the template haskell location where the exception was created. -- David Fox Thu, 07 Aug 2014 13:54:27 -0700 haskell-debian (3.82) unstable; urgency=low * Add Debian.Control.Policy which has knowledge of specific fields, such as Source and Package, which are expected to be present in a debian control file. * Replace a 3-tuple in Debian.GenBuildDeps with a record named ReadyTargets. * Add Debian.Pretty.display :: Pretty a => a -> String -- David Fox Wed, 06 Aug 2014 06:13:15 -0700 haskell-debian (3.81.3) unstable; urgency=low * Remove spurious dependency on Cabal. -- David Fox Tue, 15 Jul 2014 06:58:42 -0700 haskell-debian (3.81.2) unstable; urgency=low * Update debian build dependencies. -- David Fox Sat, 05 Jul 2014 22:30:43 -0700 haskell-debian (3.81.1) unstable; urgency=low * Modernize cabal file. -- David Fox Sat, 17 May 2014 06:36:43 -0700 haskell-debian (3.81) unstable; urgency=low * Replace library pretty and library ansi-wl-pprint with an ultra-simple custom pretty printing library in Debian.Pretty. -- David Fox Sun, 12 Jan 2014 07:34:21 -0800 haskell-debian (3.80.2) unstable; urgency=low * Neil Mayhew's patch to greatly speed parsing of control files. -- David Fox Mon, 06 Jan 2014 04:36:37 -0800 haskell-debian (3.80.1) unstable; urgency=low * Fix for fakechanges from Neil Mayhew - don't reject all .deb files. -- David Fox Mon, 30 Dec 2013 08:02:08 -0800 haskell-debian (3.80) unstable; urgency=low * Make the SliceName type an alias for ReleaseName. Pretty sure they are the same thing. -- David Fox Thu, 19 Dec 2013 11:41:38 -0800 haskell-debian (3.79.4) unstable; urgency=low * Add changelog to list of extra source files so it is added to the tarball. -- David Fox Tue, 15 Oct 2013 07:36:41 -0700 haskell-debian (3.79.3) unstable; urgency=low * Make the changelog visible in hackage2. -- David Fox Tue, 15 Oct 2013 07:33:02 -0700 haskell-debian (3.79.2) unstable; urgency=low * Allow package to build with either process-listlike or process-extra. -- David Fox Fri, 04 Oct 2013 09:02:48 -0700 haskell-debian (3.79.1) unstable; urgency=low * Switch from using package process-extras to process-listlike. -- David Fox Wed, 05 Jun 2013 06:22:26 -0700 haskell-debian (3.79) unstable; urgency=low * Efficiency fix for the Text instance of Debian.Control. * Get rid of the Data.Text parser, instead parse the ByteString and then decode the resulting control file. Much faster I think. -- David Fox Mon, 29 Apr 2013 21:33:55 -0700 haskell-debian (3.78) unstable; urgency=low * Change URI' to simplify its Read and Show instances, it is now just a private constructor applied to a string for which parseURI was known to succeed. * Add changelog.pre-debian to the source file list -- David Fox Sun, 28 Apr 2013 12:51:11 -0700 haskell-debian (3.77) unstable; urgency=low * Add a URI' type that is a wrapper around URI with working Read and Show instances. -- David Fox Fri, 26 Apr 2013 11:00:10 -0700 haskell-debian (3.76) unstable; urgency=low * Add Debian.UTF, with support for reading and decoding "almost-utf8" files -- David Fox Thu, 25 Apr 2013 07:56:45 -0700 haskell-debian (3.75) unstable; urgency=low * If we get a UTF8 decoding error just insert the offending character into the output stream. There is an -- David Fox Wed, 24 Apr 2013 15:30:30 -0700 haskell-debian (3.74) unstable; urgency=low * Add Debian.Relation.Text and Debian.Version.Text. -- David Fox Tue, 23 Apr 2013 18:11:00 -0700 haskell-debian (3.73) unstable; urgency=low * Use Text instead of ByteString in the functions exported by Debian.Control. -- David Fox Tue, 23 Apr 2013 17:59:21 -0700 haskell-debian (3.72) unstable; urgency=low * Add Debian.Control.Text, Data.Text support for control files. -- David Fox Tue, 23 Apr 2013 17:19:22 -0700 haskell-debian (3.71) unstable; urgency=low * Refine the ArchitectureReq type to parse things like !linux-any. -- David Fox Sat, 13 Apr 2013 15:55:27 -0700 haskell-debian (3.70.2) unstable; urgency=low * Fix source repository location in cabal file. -- David Fox Sat, 13 Apr 2013 11:11:45 -0700 haskell-debian (3.70.1) unstable; urgency=low * Add Show and Read instances for DebianVersion. -- David Fox Tue, 09 Apr 2013 08:58:44 -0700 haskell-debian (3.70) unstable; urgency=low * Make Pretty instances for all the types in Debian.Relation: Relation, Relations, BinPkgName, etc. Don't export the individual functions like prettyRelation, clients can just call pretty. -- David Fox Thu, 27 Dec 2012 05:50:56 -0800 haskell-debian (3.69.3) unstable; urgency=low * Add a missing newline in the generated log entry comments. -- David Fox Wed, 26 Dec 2012 16:42:41 -0800 haskell-debian (3.69.2) unstable; urgency=low * Fix formatting of pretty printed changelog entries - There were two newlines before the signature and none after, there should be one and one. -- David Fox Wed, 26 Dec 2012 16:05:49 -0800 haskell-debian (3.69.1) unstable; urgency=low * Fix the darcs repo path. -- David Fox Mon, 19 Nov 2012 16:35:37 -0800 haskell-debian (3.69) unstable; urgency=low * Fix changelog formatting by adding a newtype named ChangeLog with a Pretty instance. * Rename parseLog -> parseEntries, add a parseChangeLog function. -- David Fox Mon, 19 Nov 2012 11:10:37 -0800 haskell-debian (3.68) unstable; urgency=low * Fix the formatting of changelog entries (an extra newline was being appended) and replace the functions prettyChanges, prettyChangesFile, and prettyEntry with instances of Pretty. -- David Fox Sun, 18 Nov 2012 07:04:28 -0800 haskell-debian (3.67) unstable; urgency=low * Eliminate the PkgName type, instead make BinPkgName and SrcPkgName instances of a class named PkgName. -- David Fox Sat, 17 Nov 2012 06:11:06 -0800 haskell-debian (3.66) unstable; urgency=low * Eliminate the use of the tiny pretty-class package, use the Pretty class from ansi-wl-pprint instead. * Improve the pretty printing of control files in terms of terminating newlines and the newlines between paragraphs. * Add some control file unit tests. -- David Fox Sun, 11 Nov 2012 08:21:07 -0800 haskell-debian (3.65) unstable; urgency=low * Replace the Show instances for control files with Pretty instances. -- David Fox Thu, 18 Oct 2012 12:26:37 -0700 haskell-debian (3.64.1) unstable; urgency=low * Fix typo in maintainer name. -- David Fox Mon, 01 Oct 2012 09:19:45 -0700 haskell-debian (3.64) unstable; urgency=low * Eliminate dependency on progress, eliminate most of the Unixutils dependency. We still need the ByteString versions of the functions from System.Process, and a couple of other process functions. -- David Fox Mon, 26 Mar 2012 17:25:17 -0700 haskell-debian (3.63) unstable; urgency=low * Use distinct types for Debian source package names and binary package names everywhere, instead of strings. -- David Fox Thu, 15 Mar 2012 12:33:05 -0700 haskell-debian (3.62.2) unstable; urgency=low * When parsing a list of package version relations, strip any lines that begin with a '#' - they are comments. -- David Fox Thu, 08 Mar 2012 10:22:13 -0800 haskell-debian (3.62.1) unstable; urgency=low * Export old relaxinfo functions and data structures for diagnosing performance problems. -- David Fox Thu, 01 Mar 2012 13:14:53 -0800 haskell-debian (3.62) unstable; urgency=low * New type for RelaxInfo, was RelaxInfo [(BinPkgName, Maybe SrcPkgName)] now (SrcPkgName -> BinPkgName -> Bool). -- David Fox Sat, 25 Feb 2012 18:07:16 -0800 haskell-debian (3.61.1) unstable; urgency=low * Add some Data and Typeable instances. -- David Fox Thu, 12 Jan 2012 10:18:58 -0800 haskell-debian (3.61) unstable; urgency=low * Uploading to hackage. * Remove crypto++ dependency (it was a mistake.) * Add optimization flag to ghc-options * Reference seereason darcs repo -- David Fox Thu, 06 Oct 2011 09:04:38 -0700 haskell-debian (3.60) unstable; urgency=low * Replace bogus Show instances in Debian.Relation.Common with pretty printing functions. * Change cabal category from System to Debian (to join the dpkg package) * Fix some of the compiler warnings. * Change the Show instances in Debian.Version into pretty printing functions too. -- David Fox Sun, 25 Sep 2011 07:33:25 -0700 haskell-debian (3.59) unstable; urgency=low * Move the cabal-debian program into a separate pacakge. -- David Fox Sun, 18 Sep 2011 06:43:36 -0700 haskell-debian (3.58-0.2) unstable; urgency=low * Remove the --deb-name option, all the package name special cases need to be encoded in the Distribution.Package.Debian.Bundled.debianName function so that we can fix both the names for the package we are building and the names of its dependencies. -- David Fox Thu, 25 Aug 2011 10:58:11 -0700 haskell-debian (3.58-0.1) unstable; urgency=low * Add --deb-name option, which sets the part of the package name between the prefix libghc- and the suffix -dev. * Add --epoch * Add --deb-version -- David Fox Wed, 24 Aug 2011 20:45:33 -0700 haskell-debian (3.58) unstable; urgency=low * Add a --ghc-version option to specify what the ghc version is in the build environment, in case it is different from the one where the autobuilder is being run. This affects what packages cabal-debian thinks are built into the compiler. I have non-working code to actually look in the environment for this information, but it depends on having the compiler already installed there. * Greatly sped-up cabal-debian. * Add --build-dep to specify extra build dependencies. * Generate a haskell-packagename-utils deb with all the executables, rather than one deb per executable. -- David Fox Fri, 19 Aug 2011 08:34:36 -0700 haskell-debian (3.57) unstable; urgency=low * Re-order generated dependencies so we are more likely to build with newer packages installed. -- David Fox Tue, 16 Aug 2011 19:04:29 -0700 haskell-debian (3.56-1) unstable; urgency=low * I created a new repository by importing the sid version of haskell-debian-3.55 and then applying my patches. This is because I don't understand why Marco's repository is so different from the code in sid. At some point we will get this all sorted out. -- David Fox Tue, 16 Aug 2011 13:00:15 -0700 haskell-debian (3.55-2) unstable; urgency=low * Build against parsec 3 -- Joachim Breitner Mon, 13 Jun 2011 18:13:10 +0200 haskell-debian (3.55-1) unstable; urgency=low * Use ghc instead of ghc6 * control: Standards-Version: Bump, no changes needed. * control: haskell-debian-utils: Adds Recommends: apt-file. * New upstream version. * patches/dont-build-teste.patch: Update patch to new upstream version. * control: Update dependency on haxml to 1.20.*. * control: Depends on utf8-string. -- Marco Túlio Gontijo e Silva Fri, 03 Jun 2011 22:49:23 -0300 haskell-debian (3.47-3) unstable; urgency=low * Re-add dont-build-tests.patch, lost in the previous upload -- Joachim Breitner Thu, 24 Jun 2010 19:33:30 +0200 haskell-debian (3.47-2) unstable; urgency=low [ Erik de Castro Lopo ] * debian/control: Fix lintian warnings. * Add man pages for apt-get-build-depends, cabal-debian, debian-report and fakechanges. * Add libghc6-debian-doc.doc-base. * Move installation of binaries and man pages from rules file to new file haskell-debian-utils.install. [ Joachim Breitner ] * Adjust copyright file per FTP master request. * Bump haskell-regex-tdfa dependency -- Joachim Breitner Thu, 24 Jun 2010 09:47:55 +0200 haskell-debian (3.47-1) unstable; urgency=low * Initial release. -- Joachim Breitner Sun, 09 May 2010 19:08:20 +0200 debian-3.91.1/cbits/0000755000000000000000000000000012775511355012334 5ustar0000000000000000debian-3.91.1/cbits/gwinsz.c0000644000000000000000000000027112775511355014021 0ustar0000000000000000#include unsigned long c_get_window_size(void) { struct winsize w; if (ioctl (0, TIOCGWINSZ, &w) >= 0) return (w.ws_row << 16) + w.ws_col; else return 0x190050; } debian-3.91.1/Test/0000755000000000000000000000000012775511355012147 5ustar0000000000000000debian-3.91.1/Test/Changes.hs0000644000000000000000000004275212775511355014065 0ustar0000000000000000{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS -fno-warn-missing-signatures -fno-warn-orphans #-} module Changes where import Debian.Changes import Debian.Pretty (PP(..)) import Debian.Release (ReleaseName(ReleaseName, relName)) import Debian.Version (parseDebianVersion, parseDebianVersion') import Test.HUnit import Text.PrettyPrint (render) import Text.PrettyPrint.HughesPJClass (pPrint) s3 = unlines ["name (version) dist; urgency=urgency", " * details", " -- David Fox Wed, 21 Nov 2007 01:26:57 +0000"] s4 = 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 ]", "", " -- David Fox Wed, 21 Nov 2007 01:26:57 +0000"] 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 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 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 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 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 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 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) Wed, 21 Nov 2007 01:26:57 +0000"] s2 = unlines ["haskell-haskeline (0.6.1.6-1+seereason1~jaunty6) jaunty-seereason; urgency=low", "", " * New upstream version.", " * Remove extensible-exceptions patch, since ghc6 now ships it.", " * debian/control:", " - Use versioned Build-Depends.", " - Use unversioned Recommends for ghc6-doc in libghc6-terminfo-doc.", " - Use haskell Section.", " - Use new Standards-Version: 3.8.1.", " - Use DM-Upload-Allowed: yes.", " - Use haskell:Recommends and haskell:Suggests.", " - Don't use shlibs:Depends for -prof.", " - Split dependencies in more than one line.", " * Built from sid apt pool", " * Build dependency changes:", " 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", " libghc6-mtl-dev: 1.1.0.2-7+seereason3~jaunty7 -> 1.1.0.2-7+seereason3~jaunty8", " libghc6-mtl-doc: 1.1.0.2-7+seereason3~jaunty7 -> 1.1.0.2-7+seereason3~jaunty8", " libghc6-mtl-prof: 1.1.0.2-7+seereason3~jaunty7 -> 1.1.0.2-7+seereason3~jaunty8", " libghc6-terminfo-dev: 0.3.0.2-2+seereason1~jaunty5 -> 0.3.0.2-2+seereason1~jaunty6", " libghc6-terminfo-doc: 0.3.0.2-2+seereason1~jaunty5 -> 0.3.0.2-2+seereason1~jaunty6", " libghc6-terminfo-prof: 0.3.0.2-2+seereason1~jaunty5 -> 0.3.0.2-2+seereason1~jaunty6", " libghc6-utf8-string-dev: 0.3.5-1+seereason3~jaunty7 -> 0.3.5-1++1+seereason1~jaunty1", " libghc6-utf8-string-doc: 0.3.5-1+seereason3~jaunty7 -> 0.3.5-1++1+seereason1~jaunty1", " libghc6-utf8-string-prof: 0.3.5-1+seereason3~jaunty7 -> 0.3.5-1++1+seereason1~jaunty1", "", " -- SeeReason Autobuilder Fri, 25 Dec 2009 13:48:18 -0800", "", "haskell-haskeline (0.6.1.6-1) unstable; urgency=low", "", " * New upstream version.", " * Remove extensible-exceptions patch, since ghc6 now ships it.", " * debian/control:", " - Use versioned Build-Depends.", " - Use unversioned Recommends for ghc6-doc in libghc6-terminfo-doc.", " - Use haskell Section.", " - Use new Standards-Version: 3.8.1.", " - Use DM-Upload-Allowed: yes.", " - Use haskell:Recommends and haskell:Suggests.", " - Don't use shlibs:Depends for -prof.", " - Split dependencies in more than one line.", "", " -- Marco Túlio Gontijo e Silva Tue, 02 Jun 2009 10:18:27 -0300", "", "haskell-haskeline (0.6.1.3-1) unstable; urgency=low", "", " * Initial Debian package. (Closes: #496961)", "", " -- Marco Túlio Gontijo e Silva Wed, 11 Mar 2009 18:58:06 -0300", ""] test5 = TestCase (assertEqual "haskell-regex-compat changelog 1" s1 (render . pPrint . PP . either (const (error "parse")) id . parseChangeLog $ s1)) test3 = TestCase (assertEqual "haskell-regex-compat changelog 2" expected (parseEntries s3)) where expected = [Right (Entry {logPackage = "name", logVersion = parseDebianVersion' "version", logDists = [ReleaseName {relName = "dist"}], logUrgency = "urgency", logComments = " * details\n", logWho = "David Fox ", logDate = "Wed, 21 Nov 2007 01:26:57 +0000"})] test4 = TestCase (assertEqual "haskell-regex-compat changelog 3" expected (parseEntries s4)) where expected = [Right (Entry {logPackage = "haskell-regex-compat", logVersion = parseDebianVersion' "0.92-3+seereason1~jaunty4", logDists = [ReleaseName {relName = "jaunty-seereason"}], logUrgency = "low", logComments = " [ Joachim Breitner ]\n * Adjust priority according to override file\n * Depend on hscolour (Closes: #550769)\n\n [ Marco T\250lio Gontijo e Silva ]\n", logWho = "David Fox ", logDate = "Wed, 21 Nov 2007 01:26:57 +0000"})] test1 = TestCase (assertEqual "haskell-regex-compat changelog 4" expected (either (const (error "parse")) id (parseChangeLog s1))) where expected = ChangeLog [(Entry {logPackage = "haskell-regex-compat", logVersion = parseDebianVersion' "0.92-3+seereason1~jaunty4", logDists = [ReleaseName {relName = "jaunty-seereason"}], logUrgency = "low", logComments = " [ Joachim Breitner ]\n * Adjust priority according to override file\n * Depend on hscolour (Closes: #550769)\n\n [ Marco T\250lio Gontijo e Silva ]\n * debian/control: Use more sintetic name for Vcs-Darcs.\n * Built from sid apt pool\n * Build dependency changes:\n cpphs: 1.9-1+seereason1~jaunty5 -> 1.9-1+seereason1~jaunty6\n ghc6: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1\n ghc6-doc: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1\n ghc6-prof: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1\n haddock: 2.4.2-3+seereason3~jaunty1 -> 6.12.1-0+seereason1~jaunty1\n haskell-devscripts: 0.6.18-21+seereason1~jaunty1 -> 0.6.18-23+seereason1~jaunty1\n haskell-regex-base-doc: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1\n haskell-regex-posix-doc: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2\n libghc6-regex-base-dev: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1\n libghc6-regex-base-prof: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1\n libghc6-regex-posix-dev: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2\n libghc6-regex-posix-prof: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2\n", logWho = "SeeReason Autobuilder ", logDate = "Fri, 25 Dec 2009 01:55:37 -0800"}), (Entry {logPackage = "haskell-regex-compat", logVersion = parseDebianVersion' "0.92-3", logDists = [ReleaseName {relName = "unstable"}], logUrgency = "low", logComments = " [ Joachim Breitner ]\n * Adjust priority according to override file\n * Depend on hscolour (Closes: #550769)\n\n [ Marco T\250lio Gontijo e Silva ]\n * debian/control: Use more sintetic name for Vcs-Darcs.\n", logWho = "Joachim Breitner ", logDate = "Mon, 20 Jul 2009 13:05:35 +0200"}), (Entry {logPackage = "haskell-regex-compat", logVersion = parseDebianVersion' "0.92-2", logDists = [ReleaseName {relName = "unstable"}], logUrgency = "low", logComments = " * Adopt package for the Debian Haskell Group\n * Fix \"FTBFS with new dpkg-dev\" by adding comma to debian/control\n (Closes: #536473)\n", logWho = "Joachim Breitner ", logDate = "Mon, 20 Jul 2009 12:05:40 +0200"}), (Entry {logPackage = "haskell-regex-compat", logVersion = parseDebianVersion' "0.92-1.1", logDists = [ReleaseName {relName = "unstable"}], logUrgency = "low", logComments = " * Rebuild for GHC 6.10.\n * NMU with permission of the author.\n", logWho = "John Goerzen ", logDate = "Mon, 16 Mar 2009 10:12:04 -0500"}), (Entry {logPackage = "haskell-regex-compat", logVersion = parseDebianVersion' "0.92-1", logDists = [ReleaseName {relName = "unstable"}], logUrgency = "low", logComments = " * New upstream release\n * debian/control:\n - Bump Standards-Version. No changes needed.\n", logWho = "Arjan Oosting ", logDate = "Sun, 18 Jan 2009 00:05:02 +0100"}), (Entry {logPackage = "haskell-regex-compat", logVersion = parseDebianVersion' "0.91-1", logDists = [ReleaseName {relName = "unstable"}], logUrgency = "low", logComments = " * Take over package from Ian, as I already maintain haskell-regex-base,\n and move Ian to the Uploaders field.\n * Packaging complete redone (based on my haskell-regex-base package).\n", logWho = "Arjan Oosting ", logDate = "Sat, 19 Jan 2008 16:48:39 +0100"}), (Entry {logPackage = "haskell-regex-compat", logVersion = parseDebianVersion' "0.71.0.1-1", logDists = [ReleaseName {relName = "unstable"}], logUrgency = "low", logComments = " * Initial release (used to be part of ghc6).\n * Using \"Generic Haskell cabal library packaging files v9\".\n", logWho = "Ian Lynagh (wibble) ", logDate = "Wed, 21 Nov 2007 01:26:57 +0000"})] test2 = TestCase (assertEqual "haskell-regex-compat changelog" expected (parseEntries s2)) where expected = [Right (Entry {logPackage = "haskell-haskeline", logVersion = parseDebianVersion' "0.6.1.6-1+seereason1~jaunty6", logDists = [ReleaseName {relName = "jaunty-seereason"}], logUrgency = "low", logComments = " * New upstream version.\n * Remove extensible-exceptions patch, since ghc6 now ships it.\n * debian/control:\n - Use versioned Build-Depends.\n - Use unversioned Recommends for ghc6-doc in libghc6-terminfo-doc.\n - Use haskell Section.\n - Use new Standards-Version: 3.8.1.\n - Use DM-Upload-Allowed: yes.\n - Use haskell:Recommends and haskell:Suggests.\n - Don't use shlibs:Depends for -prof.\n - Split dependencies in more than one line.\n * Built from sid apt pool\n * Build dependency changes:\n ghc6: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1\n ghc6-doc: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1\n ghc6-prof: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1\n haddock: 2.4.2-3+seereason3~jaunty1 -> 6.12.1-0+seereason1~jaunty1\n haskell-devscripts: 0.6.18-21+seereason1~jaunty1 -> 0.6.18-23+seereason1~jaunty1\n libghc6-mtl-dev: 1.1.0.2-7+seereason3~jaunty7 -> 1.1.0.2-7+seereason3~jaunty8\n libghc6-mtl-doc: 1.1.0.2-7+seereason3~jaunty7 -> 1.1.0.2-7+seereason3~jaunty8\n libghc6-mtl-prof: 1.1.0.2-7+seereason3~jaunty7 -> 1.1.0.2-7+seereason3~jaunty8\n libghc6-terminfo-dev: 0.3.0.2-2+seereason1~jaunty5 -> 0.3.0.2-2+seereason1~jaunty6\n libghc6-terminfo-doc: 0.3.0.2-2+seereason1~jaunty5 -> 0.3.0.2-2+seereason1~jaunty6\n libghc6-terminfo-prof: 0.3.0.2-2+seereason1~jaunty5 -> 0.3.0.2-2+seereason1~jaunty6\n libghc6-utf8-string-dev: 0.3.5-1+seereason3~jaunty7 -> 0.3.5-1++1+seereason1~jaunty1\n libghc6-utf8-string-doc: 0.3.5-1+seereason3~jaunty7 -> 0.3.5-1++1+seereason1~jaunty1\n libghc6-utf8-string-prof: 0.3.5-1+seereason3~jaunty7 -> 0.3.5-1++1+seereason1~jaunty1\n", logWho = "SeeReason Autobuilder ", logDate = "Fri, 25 Dec 2009 13:48:18 -0800"}), Right (Entry {logPackage = "haskell-haskeline", logVersion = parseDebianVersion' "0.6.1.6-1", logDists = [ReleaseName {relName = "unstable"}], logUrgency = "low", logComments = " * New upstream version.\n * Remove extensible-exceptions patch, since ghc6 now ships it.\n * debian/control:\n - Use versioned Build-Depends.\n - Use unversioned Recommends for ghc6-doc in libghc6-terminfo-doc.\n - Use haskell Section.\n - Use new Standards-Version: 3.8.1.\n - Use DM-Upload-Allowed: yes.\n - Use haskell:Recommends and haskell:Suggests.\n - Don't use shlibs:Depends for -prof.\n - Split dependencies in more than one line.\n", logWho = "Marco T\250lio Gontijo e Silva ", logDate = "Tue, 02 Jun 2009 10:18:27 -0300"}), Right (Entry {logPackage = "haskell-haskeline", logVersion = parseDebianVersion' "0.6.1.3-1", logDists = [ReleaseName {relName = "unstable"}], logUrgency = "low", logComments = " * Initial Debian package. (Closes: #496961)\n", logWho = "Marco T\250lio Gontijo e Silva ", logDate = "Wed, 11 Mar 2009 18:58:06 -0300"})] changesTests = [test3, test4, test1, test2, test5] debian-3.91.1/Test/Versions.hs0000644000000000000000000000677412775511355014331 0ustar0000000000000000{-# OPTIONS -fno-warn-missing-signatures -fno-warn-orphans #-} module Versions where import Test.HUnit import Debian.Version -- * Implicit Values implicit1 = TestCase (assertEqual "1.0 == 1.0-" EQ (compare (parseDebianVersion' "1.0") (parseDebianVersion' "1.0-"))) implicit2 = TestCase (assertEqual "1.0 == 1.0-0" EQ (compare (parseDebianVersion' "1.0") (parseDebianVersion' "1.0-0"))) implicit3 = TestCase (assertEqual "1.0 == 0:1.0-0" EQ (compare (parseDebianVersion' "1.0") (parseDebianVersion' "0:1.0-0"))) implicit4 = TestCase (assertEqual "1.0 == 1.0-" EQ (compare (parseDebianVersion' "1.0") (parseDebianVersion' "1.0-"))) implicit5 = TestCase (assertEqual "apple = apple0" EQ (compare (parseDebianVersion' "apple") (parseDebianVersion' "apple0"))) implicit6 = TestCase (assertEqual "apple = apple0-" EQ (compare (parseDebianVersion' "apple") (parseDebianVersion' "apple0-"))) implicit7 = TestCase (assertEqual "apple = apple0-0" EQ (compare (parseDebianVersion' "apple") (parseDebianVersion' "apple0-0"))) -- * epoch, version, revision epoch1 = TestCase (assertEqual "epoch 0:0" (Just 0) (epoch $ parseDebianVersion' "0:0")) epoch2 = TestCase (assertEqual "epoch 0" Nothing(epoch $ parseDebianVersion' "0")) epoch3 = TestCase (assertEqual "epoch 1:0" (Just 1) (epoch $ parseDebianVersion' "1:0")) version1 = TestCase (assertEqual "version apple" "apple" (version $ parseDebianVersion' "apple")) version2 = TestCase (assertEqual "version apple0" "apple0" (version $ parseDebianVersion' "apple0")) version3 = TestCase (assertEqual "version apple1" "apple1" (version $ parseDebianVersion' "apple1")) revision1 = TestCase (assertEqual "revision 1.0" Nothing (revision $ parseDebianVersion' "1.0")) revision2 = TestCase (assertEqual "revision 1.0-" (Just "") (revision $ parseDebianVersion' "1.0-")) revision3 = TestCase (assertEqual "revision 1.0-0" (Just "0") (revision $ parseDebianVersion' "1.0-0")) revision4 = TestCase (assertEqual "revision 1.0-apple" (Just "apple") (revision $ parseDebianVersion' "1.0-apple")) -- * Ordering compareV str1 str2 = compare (parseDebianVersion' str1) (parseDebianVersion' str2) order1 = TestCase (assertEqual "1:1-1 > 0:1-1" GT (compareV "1:1-1" "0:1-1")) order2 = TestCase (assertEqual "1-1-1 > 1-1" GT (compareV "1-1-1" "1-1")) -- * Dashes in upstream version dash1 = TestCase (assertEqual "version of upstream-version-revision" "upstream-version" (version (parseDebianVersion' "upstream-version-revision"))) dash2 = TestCase (assertEqual "revision of upstream-version-revision" (Just "revision") (revision (parseDebianVersion' "upstream-version-revision"))) -- * Insignificant Zero's zero1 = TestCase (assertEqual "0.09 = 0.9" EQ (compareV "0.09" "0.9")) -- * Tests versionTests = [ TestLabel "implicit1" implicit1 , TestLabel "implicit2" implicit2 , TestLabel "implicit3" implicit3 , TestLabel "implicit4" implicit4 , TestLabel "implicit5" implicit5 , TestLabel "implicit5" implicit6 , TestLabel "implicit5" implicit7 , TestLabel "epoch1" epoch1 , TestLabel "epoch2" epoch2 , TestLabel "epoch3" epoch3 , TestLabel "version1" version1 , TestLabel "version2" version2 , TestLabel "version3" version3 , TestLabel "revision1" revision1 , TestLabel "revision2" revision2 , TestLabel "revision3" revision3 , TestLabel "revision4" revision4 , TestLabel "order1" order1 , TestLabel "order2" order2 , dash1 , dash2 , zero1 ] debian-3.91.1/Test/Control.hs0000644000000000000000000005167412775511355014140 0ustar0000000000000000{-# LANGUAGE CPP, FlexibleInstances, OverloadedStrings, StandaloneDeriving #-} module Control where import Test.HUnit import Data.Monoid ((<>)) import Data.List as L (intercalate) import Data.Text as T (Text) import Data.Version (showVersion) import Debian.Control import Debian.Control.Policy import Debian.Control.Text ({- Pretty instances -}) import Debian.Pretty (prettyShow) import Debian.Relation import Debian.Version (parseDebianVersion, parseDebianVersion') import Paths_debian (version) import Text.Parsec.Error (ParseError) import Text.PrettyPrint.HughesPJClass (Doc, text, pPrint) import Text.Regex.TDFA ((=~), MatchResult(..)) #if !MIN_VERSION_pretty(1,1,2) instance Eq Doc where a == b = show a == show b #endif instance Eq DebianControl where a == b = unDebianControl a == unDebianControl b -- deriving instance Show (Control' Text) -- deriving instance Show (Paragraph' Text) -- deriving instance Show (Field' Text) replaceString :: String -> String -> String -> String replaceString old new x = case x =~ old of mr | null (mrMatch mr) -> x mr -> mrBefore mr <> new <> mrAfter mr -- Additional tests of the results of parsing additional -- inter-paragraph newlines, or missing terminating newlines, would be -- good. controlTests = [ TestCase (assertEqual "pretty1" (pPrint control) (either (error "parser failed") pPrint (parseControl "debian/control" sample))) , TestCase (assertEqual "pretty2" (text sample) (pPrint control)) , TestCase (assertEqual "pretty3" (text (head paragraphs <> "\n")) (pPrint (head (unControl control)))) -- The Pretty class instances are distinct implementations from -- those in Debian.Control.PrettyPrint. Not sure why, there is a -- terse note about performance concerns. , TestCase (assertEqual "pretty4" (text sample) (pPrint control)) , TestCase (assertEqual "pretty5" (text (head paragraphs <> "\n")) (pPrint (head (unControl control)))) , TestCase (validateDebianControl control >>= \ vc -> assertEqual "policy1" (Right (unsafeDebianControl control)) vc) -- validate control file , TestCase (validateDebianControl control >>= \ vc -> assertEqual "policy2" (Right (Just builddeps)) (either Left (debianRelations "Build-Depends") vc)) -- parse build deps , TestCase (validateDebianControl control >>= \ vc -> assertEqual "policy3" (Right Nothing) (either Left (debianRelations "Foo") vc)) -- absent field , TestCase (parseDebianControlFromFile "Test/Control.hs" >>= \ vc -> assertEqual "policy4" -- Exceptions have bogus Eq instances, so we need to show then compare. "Left \"./Debian/Control/Policy.hs\"(line 77, column 54): ParseControlError \"Test/Control.hs\" (line 0, column 0):\nFailed to parse Test/Control.hs" (show (either Left (either Left Right . debianRelations "Foo") vc))) , TestCase (parseDebianControlFromFile "nonexistant" >>= \ vc -> assertEqual "policy5" "Left \"./Debian/Control/Policy.hs\"(line 76, column 36): IOError nonexistant: openBinaryFile: does not exist (No such file or directory)" (replaceString "openFile" "openBinaryFile" (show (either Left (debianRelations "Foo") (vc :: Either ControlFileError DebianControl))))) -- Test whether embedded newlines in field values can be mistaken -- for field or paragraph divisions. In cases pretty7 and pretty9 -- the parsed output is not correct, so the buggy result is placed -- in the "expected" position. , TestCase (assertEqual "pretty6" input6 parsed6) , TestCase (assertEqual "pretty7" expected7 parsed7) , TestCase (assertEqual "pretty8" input8 parsed8) , TestCase (assertEqual "pretty9" expected9 parsed9) ] where input6 = Control {unControl = [Paragraph [Field ("Field1", " field1 begins\n Field1a: indented text that looks like a field")]]} :: Control' String input7 = Control {unControl = [Paragraph [Field ("Field1", " field1 begins\nField1a: text that looks like a field")]]} :: Control' String -- parsed7buggy = Control {unControl = [Paragraph [Field ("Field1"," field1 begins"),Field ("Field1a"," text that looks like a field")]]} :: Control' String expected7 = Control {unControl = [Paragraph [Field ("Field1"," field1 begins\n Field1a: text that looks like a field")]]} input8 = Control {unControl = [Paragraph [Field ("Field1", " field1 content"), Field ("Field2", " an actual second field")]]} :: Control' String input9 = Control {unControl = [Paragraph [Field ("Field1", " field1 content\n"), Field ("Field2", " an actual second field")]]} :: Control' String -- parsed9buggy = Control {unControl = [Paragraph [Field ("Field1"," field1 content")],Paragraph [Field ("Field2"," an actual second field")]]} :: Control' String expected9 = Control {unControl = [Paragraph [Field ("Field1"," field1 content"),Field ("Field2"," an actual second field")]]} (Right parsed6) = parseControl "string" (prettyShow input6) :: Either ParseError (Control' String) (Right parsed7) = parseControl "string" (prettyShow input7) :: Either ParseError (Control' String) (Right parsed8) = parseControl "string" (prettyShow input8) :: Either ParseError (Control' String) (Right parsed9) = parseControl "string" (prettyShow input9) :: Either ParseError (Control' String) -- | These paragraphs have no terminating newlines. They are added -- where appropriate to the expected test results. paragraphs :: [String] paragraphs = [ "Source: haskell-debian\nSection: haskell\nPriority: extra\nMaintainer: Debian Haskell Group \nUploaders: Joachim Breitner \nBuild-Depends: debhelper (>= 7)\n , cdbs\n , haskell-devscripts (>= 0.7)\n , ghc\n , ghc-prof\n , libghc-hunit-dev\n , libghc-hunit-prof\n , libghc-mtl-dev\n , libghc-mtl-prof\n , libghc-parsec3-dev\n , libghc-parsec3-prof\n , libghc-pretty-class-dev\n , libghc-pretty-class-prof\n , libghc-process-extras-dev (>= 0.4)\n , libghc-process-extras-prof (>= 0.4)\n , libghc-regex-compat-dev\n , libghc-regex-compat-prof\n , libghc-regex-tdfa-dev (>= 1.1.3)\n , libghc-regex-tdfa-prof\n , libghc-bzlib-dev (>= 0.5.0.0-4)\n , libghc-bzlib-prof\n , libghc-haxml-prof (>= 1:1.20)\n , libghc-unixutils-dev (>= 1.50)\n , libghc-unixutils-prof (>= 1.50)\n , libghc-zlib-dev\n , libghc-zlib-prof\n , libghc-network-dev (>= 2.4)\n , libghc-network-prof (>= 2.4)\n , libghc-utf8-string-dev\n , libghc-utf8-string-prof,\n , libcrypto++-dev\nBuild-Depends-Indep: ghc-doc\n , libghc-hunit-doc\n , libghc-mtl-doc\n , libghc-parsec3-doc\n , libghc-pretty-class-doc\n , libghc-process-extras-doc (>= 0.4)\n , libghc-regex-compat-doc\n , libghc-regex-tdfa-doc\n , libghc-bzlib-doc\n , libghc-haxml-doc (>= 1:1.20)\n , libghc-unixutils-doc (>= 1.50)\n , libghc-zlib-doc\n , libghc-network-doc (>= 2.4)\n , libghc-utf8-string-doc\nStandards-Version: 3.9.2\nHomepage: http://hackage.haskell.org/package/debian\nVcs-Darcs: http://darcs.debian.org/pkg-haskell/haskell-debian\nVcs-Browser: http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/haskell-debian", "Package: libghc-debian-dev\nArchitecture: any\nDepends: ${haskell:Depends}\n , ${shlibs:Depends}\n , ${misc:Depends}\nRecommends: ${haskell:Recommends}\nSuggests: ${haskell:Suggests}\nProvides: ${haskell:Provides}\nDescription: Haskell library for working with the Debian package system\n This package provides a library for the Haskell programming language.\n See http://www.haskell.org/ for more information on Haskell.\n .\n This library includes modules covering almost every aspect of the Debian\n packaging system, including low level data types such as version numbers\n and dependency relations, on up to the types necessary for computing and\n installing build dependencies, building source and binary packages,\n and inserting them into a repository.\n .\n This package contains the libraries compiled for GHC 6.", "Package: libghc-debian-prof\nArchitecture: any\nDepends: ${haskell:Depends}\n , ${shlibs:Depends}\n , ${misc:Depends}\nRecommends: ${haskell:Recommends}\nSuggests: ${haskell:Suggests}\nProvides: ${haskell:Provides}\nDescription: Profiling library for working with the Debian package system\n This package provides a library for the Haskell programming language,\n compiled for profiling.\n See http://www.haskell.org/ for more information on Haskell.\n .\n This library includes modules covering almost every aspect of the Debian\n packaging system, including low level data types such as version numbers\n and dependency relations, on up to the types necessary for computing and\n installing build dependencies, building source and binary packages,\n and inserting them into a repository.\n .\n This package contains the profiling libraries compiled for GHC 6.", "Package: libghc-debian-doc\nSection: doc\nArchitecture: all\nDepends: ${misc:Depends}, ${haskell:Depends}\nRecommends: ${haskell:Recommends}\nSuggests: ${haskell:Suggests}\nDescription: Documentation for Debian package system library\n This package provides the documentation for a library for the Haskell\n programming language.\n See http://www.haskell.org/ for more information on Haskell.\n .\n This library includes modules covering almost every aspect of the Debian\n packaging system, including low level data types such as version numbers\n and dependency relations, on up to the types necessary for computing and\n installing build dependencies, building source and binary packages,\n and inserting them into a repository.\n .\n This package contains the library documentation.", "Package: haskell-debian-utils\nSection: devel\nArchitecture: any\nDepends: ghc, ${misc:Depends}, ${shlibs:Depends}\nRecommends: apt-file\nDescription: Various helpers to work with Debian packages\n This package contains tools shipped with the Haskell library \8220debian\8221:\n .\n * fakechanges:\n Sometimes you have the .debs, .dsc, .tar.gz, .diff.gz, etc from a package\n build, but not the .changes file. This package lets you create a fake\n .changes file in case you need one.\n .\n * debian-report:\n Analyze Debian repositories and generate reports about their contents and\n relations. For example, a list of all packages in a distribution that are\n trumped by another distribution.\n .\n * cabal-debian:\n Tool for creating debianizations of Haskell packages based on the .cabal\n file. If apt-file is installed it will use it to discover what is the\n debian package name of a C library.\n .\n * apt-get-build-depends:\n Tool which will parse the Build-Depends{-Indep} lines from debian/control\n and apt-get install the required packages" ] -- The parsed build dependencies builddeps :: Relations builddeps = [[Rel (BinPkgName {unBinPkgName = "debhelper"}) (Just (GRE (Debian.Version.parseDebianVersion' ("7" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "cdbs"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "haskell-devscripts"}) (Just (GRE (Debian.Version.parseDebianVersion' ("0.7" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "ghc"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "ghc-prof"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-hunit-dev"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-hunit-prof"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-mtl-dev"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-mtl-prof"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-parsec3-dev"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-parsec3-prof"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-pretty-class-dev"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-pretty-class-prof"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-process-extras-dev"}) (Just (GRE (Debian.Version.parseDebianVersion' ("0.4" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-process-extras-prof"}) (Just (GRE (Debian.Version.parseDebianVersion' ("0.4" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-regex-compat-dev"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-regex-compat-prof"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-regex-tdfa-dev"}) (Just (GRE (Debian.Version.parseDebianVersion' ("1.1.3" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-regex-tdfa-prof"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-bzlib-dev"}) (Just (GRE (Debian.Version.parseDebianVersion' ("0.5.0.0-4" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-bzlib-prof"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-haxml-prof"}) (Just (GRE (Debian.Version.parseDebianVersion' ("1:1.20" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-unixutils-dev"}) (Just (GRE (Debian.Version.parseDebianVersion' ("1.50" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-unixutils-prof"}) (Just (GRE (Debian.Version.parseDebianVersion' ("1.50" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-zlib-dev"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-zlib-prof"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-network-dev"}) (Just (GRE (Debian.Version.parseDebianVersion' ("2.4" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-network-prof"}) (Just (GRE (Debian.Version.parseDebianVersion' ("2.4" :: String)))) Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-utf8-string-dev"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libghc-utf8-string-prof"}) Nothing Nothing], [Rel (BinPkgName {unBinPkgName = "libcrypto++-dev"}) Nothing Nothing]] sample :: String sample = intercalate "\n\n" paragraphs <> "\n" -- | The expecte result of parsing the sample control file. control :: Control' Text control = Control { unControl = [Paragraph [Field ("Source"," haskell-debian") ,Field ("Section"," haskell") ,Field ("Priority"," extra") ,Field ("Maintainer"," Debian Haskell Group ") ,Field ("Uploaders"," Joachim Breitner ") ,Field ("Build-Depends"," debhelper (>= 7)\n , cdbs\n , haskell-devscripts (>= 0.7)\n , ghc\n , ghc-prof\n , libghc-hunit-dev\n , libghc-hunit-prof\n , libghc-mtl-dev\n , libghc-mtl-prof\n , libghc-parsec3-dev\n , libghc-parsec3-prof\n , libghc-pretty-class-dev\n , libghc-pretty-class-prof\n , libghc-process-extras-dev (>= 0.4)\n , libghc-process-extras-prof (>= 0.4)\n , libghc-regex-compat-dev\n , libghc-regex-compat-prof\n , libghc-regex-tdfa-dev (>= 1.1.3)\n , libghc-regex-tdfa-prof\n , libghc-bzlib-dev (>= 0.5.0.0-4)\n , libghc-bzlib-prof\n , libghc-haxml-prof (>= 1:1.20)\n , libghc-unixutils-dev (>= 1.50)\n , libghc-unixutils-prof (>= 1.50)\n , libghc-zlib-dev\n , libghc-zlib-prof\n , libghc-network-dev (>= 2.4)\n , libghc-network-prof (>= 2.4)\n , libghc-utf8-string-dev\n , libghc-utf8-string-prof,\n , libcrypto++-dev") ,Field ("Build-Depends-Indep"," ghc-doc\n , libghc-hunit-doc\n , libghc-mtl-doc\n , libghc-parsec3-doc\n , libghc-pretty-class-doc\n , libghc-process-extras-doc (>= 0.4)\n , libghc-regex-compat-doc\n , libghc-regex-tdfa-doc\n , libghc-bzlib-doc\n , libghc-haxml-doc (>= 1:1.20)\n , libghc-unixutils-doc (>= 1.50)\n , libghc-zlib-doc\n , libghc-network-doc (>= 2.4)\n , libghc-utf8-string-doc") ,Field ("Standards-Version"," 3.9.2") ,Field ("Homepage"," http://hackage.haskell.org/package/debian") ,Field ("Vcs-Darcs"," http://darcs.debian.org/pkg-haskell/haskell-debian") ,Field ("Vcs-Browser"," http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/haskell-debian")] ,Paragraph [Field ("Package"," libghc-debian-dev") ,Field ("Architecture"," any") ,Field ("Depends"," ${haskell:Depends}\n , ${shlibs:Depends}\n , ${misc:Depends}") ,Field ("Recommends"," ${haskell:Recommends}") ,Field ("Suggests"," ${haskell:Suggests}") ,Field ("Provides"," ${haskell:Provides}") ,Field ("Description"," Haskell library for working with the Debian package system\n This package provides a library for the Haskell programming language.\n See http://www.haskell.org/ for more information on Haskell.\n .\n This library includes modules covering almost every aspect of the Debian\n packaging system, including low level data types such as version numbers\n and dependency relations, on up to the types necessary for computing and\n installing build dependencies, building source and binary packages,\n and inserting them into a repository.\n .\n This package contains the libraries compiled for GHC 6.")] ,Paragraph [Field ("Package"," libghc-debian-prof") ,Field ("Architecture"," any") ,Field ("Depends"," ${haskell:Depends}\n , ${shlibs:Depends}\n , ${misc:Depends}") ,Field ("Recommends"," ${haskell:Recommends}") ,Field ("Suggests"," ${haskell:Suggests}") ,Field ("Provides"," ${haskell:Provides}") ,Field ("Description"," Profiling library for working with the Debian package system\n This package provides a library for the Haskell programming language,\n compiled for profiling.\n See http://www.haskell.org/ for more information on Haskell.\n .\n This library includes modules covering almost every aspect of the Debian\n packaging system, including low level data types such as version numbers\n and dependency relations, on up to the types necessary for computing and\n installing build dependencies, building source and binary packages,\n and inserting them into a repository.\n .\n This package contains the profiling libraries compiled for GHC 6.")], Paragraph [Field ("Package"," libghc-debian-doc") ,Field ("Section"," doc") ,Field ("Architecture"," all") ,Field ("Depends"," ${misc:Depends}, ${haskell:Depends}") ,Field ("Recommends"," ${haskell:Recommends}") ,Field ("Suggests"," ${haskell:Suggests}") ,Field ("Description"," Documentation for Debian package system library\n This package provides the documentation for a library for the Haskell\n programming language.\n See http://www.haskell.org/ for more information on Haskell.\n .\n This library includes modules covering almost every aspect of the Debian\n packaging system, including low level data types such as version numbers\n and dependency relations, on up to the types necessary for computing and\n installing build dependencies, building source and binary packages,\n and inserting them into a repository.\n .\n This package contains the library documentation.")], Paragraph [Field ("Package"," haskell-debian-utils") ,Field ("Section"," devel") ,Field ("Architecture"," any") ,Field ("Depends"," ghc, ${misc:Depends}, ${shlibs:Depends}") ,Field ("Recommends"," apt-file") ,Field ("Description"," Various helpers to work with Debian packages\n This package contains tools shipped with the Haskell library \8220debian\8221:\n .\n * fakechanges:\n Sometimes you have the .debs, .dsc, .tar.gz, .diff.gz, etc from a package\n build, but not the .changes file. This package lets you create a fake\n .changes file in case you need one.\n .\n * debian-report:\n Analyze Debian repositories and generate reports about their contents and\n relations. For example, a list of all packages in a distribution that are\n trumped by another distribution.\n .\n * cabal-debian:\n Tool for creating debianizations of Haskell packages based on the .cabal\n file. If apt-file is installed it will use it to discover what is the\n debian package name of a C library.\n .\n * apt-get-build-depends:\n Tool which will parse the Build-Depends{-Indep} lines from debian/control\n and apt-get install the required packages")]]} debian-3.91.1/Test/Main.hs0000644000000000000000000000252112775511355013367 0ustar0000000000000000module Main where import Test.HUnit import System.Exit import Changes import Control import Versions import SourcesList import Dependencies import Text.PrettyPrint main = do (c,st) <- runTestText putTextToShowS (TestList (versionTests ++ sourcesListTests ++ dependencyTests ++ changesTests ++ controlTests ++ prettyTests)) putStrLn (st "") case (failures c) + (errors c) of 0 -> return () _ -> exitFailure -- | I was converting from one pretty printing package to another and -- was unclear how this should work. prettyTests = [ TestCase (assertEqual "pretty0" (unlines ["Usage: debian-report ", "", "Find all the packages referenced by the", "second sources.list which trump packages", "found in the first sources.list."]) (renderStyle (style {lineLength = 60}) (helpText "debian-report")) ) ] helpText :: String -> Doc helpText progName = (text "Usage:" <+> text progName <+> text "" <+> text "" $$ text [] $$ (fsep $ map text $ words $ "Find all the packages referenced by the second sources.list which trump packages found in the first sources.list.") $$ text [] ) debian-3.91.1/Test/Dependencies.hs0000644000000000000000000001111612775511355015071 0ustar0000000000000000{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS -fno-warn-missing-signatures -fno-warn-orphans #-} module Dependencies where import Control.Arrow import Test.HUnit import Debian.Control.String import Debian.Apt.Dependencies hiding (packageVersionParagraph) import Debian.Relation import Debian.Version import Debian.Apt.Package packageA = [ ("Package", " a") , ("Version", " 1.0") , ("Depends", " b") ] packageB = [ ("Package", " b") , ("Version", " 1.0") ] packageC = [ ("Package", " c") , ("Version", " 1.0") , ("Depends", " doesNotExist") ] packageD = [ ("Package", " d") , ("Version", " 1.0") , ("Depends", " e | f, g | h") ] packageE = [ ("Package", " e") , ("Version", " 1.0") ] packageF = [ ("Package", " f") , ("Version", " 1.0") ] packageG = [ ("Package", " g") , ("Version", " 1.0") ] packageH = [ ("Package", " h") , ("Version", " 1.0") ] packageI = [ ("Package", " i") , ("Version", " 1.0") , ("Depends", " k") ] packageJ = [ ("Package", " j") , ("Version", " 1.0") , ("Provides", " k") ] packageK = [ ("Package", " k") , ("Version", " 1.0") ] control = [ packageA , packageB , packageC , packageD , packageE , packageF , packageG , packageH , packageI , packageJ , packageK ] depends p = case lookup "Depends" p of Nothing -> [] (Just v) -> either (error . show) id (parseRelations v) mkCSP :: [[(String, String)]] -> String -> ([(String, String)] -> Relations) -> CSP [(String, String)] mkCSP paragraphs relStr depF' = CSP { pnm = addProvides providesF paragraphs $ packageNameMap getName paragraphs , relations = either (error . show) id (parseRelations relStr) , depFunction = depF' , conflicts = conflicts' , packageVersion = packageVersionParagraph } where getName :: [(String, String)] -> BinPkgName getName p = case lookup "Package" p of Nothing -> error "Missing Package field" ; (Just n) -> BinPkgName (stripWS n) conflicts' :: [(String, String)] -> Relations conflicts' p = case lookup "Conflicts" p of Nothing -> [] (Just c) -> either (error . show) id (parseRelations c) providesF :: [(String, String)] -> [BinPkgName] providesF p = case lookup "Provides" p of Nothing -> [] (Just v) -> map BinPkgName $ parseCommaList v parseCommaList :: String -> [String] parseCommaList str = words $ map (\c -> if c == ',' then ' ' else c) str packageVersionParagraph :: [(String, String)] -> (BinPkgName, DebianVersion) packageVersionParagraph p = case lookup "Package" p of Nothing -> error $ "Could not find Package in " ++ show p (Just n) -> case lookup "Version" p of Nothing -> error $ "Could not find Package in " ++ show p (Just v) -> (BinPkgName (stripWS n), parseDebianVersion' v) mapSnd :: (b -> c) -> [(a,b)] -> [(a,c)] mapSnd f = map (second f) deriving instance Show Status -- deriving instance Show Relation -- deriving instance Show VersionReq -- deriving instance Show ArchitectureReq test1 = let csp = mkCSP control "a" depends expected = [ (Complete, [packageB, packageA])] in TestCase (assertEqual "test1" expected (search bt csp)) missing1 = let csp = mkCSP control "c" depends expected = [] in TestCase (assertEqual "missing1" expected (search bt csp)) ors1 = let csp = mkCSP control "d" depends expected = [ (Complete, [packageG, packageE, packageD]) , (Complete, [packageH, packageE, packageD]) , (Complete, [packageG, packageF, packageD]) , (Complete, [packageH, packageF, packageD]) ] in TestCase (assertEqual "ors1" expected (search bt csp)) provides1 = let csp = mkCSP control "i" depends expected = [ (Complete, [packageK, packageI]) , (Complete, [packageJ, packageI]) ] in TestCase (assertEqual "provides1" expected (search bt csp)) provides2 = let csp = mkCSP control "k" depends expected = [ (Complete, [packageK]) , (Complete, [packageJ]) ] in TestCase (assertEqual "provides2" expected (search bt csp)) dependencyTests = [ test1 , missing1 , ors1 , provides1 , provides2 ] -- runTestText putTextToShowS test1 >>= \(c,st) -> putStrLn (st "") debian-3.91.1/Test/SourcesList.hs0000644000000000000000000000746212775511355014773 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module SourcesList where import Data.Text (Text) import Data.Monoid (mconcat, (<>)) import Debian.Pretty (PP(PP)) import Debian.Sources import Test.HUnit import Text.PrettyPrint (render) import Text.PrettyPrint.HughesPJClass (pPrint) -- * Unit Tests -- TODO: add test cases that test for unterminated double-quote or bracket testQuoteWords :: Test testQuoteWords = test [ assertEqual "Space seperate words, no quoting" ["hello", "world","!"] (quoteWords " hello world ! ") , assertEqual "Space seperate words, double quotes" ["hello world","!"] (quoteWords " hel\"lo world\" ! ") , assertEqual "Space seperate words, square brackets" ["hel[lo worl]d","!"] (quoteWords " hel[lo worl]d ! ") , assertEqual "Space seperate words, square-bracket at end" ["hel[lo world]"] (quoteWords " hel[lo world]") , assertEqual "Space seperate words, double quote at end" ["hello world"] (quoteWords " hel\"lo world\"") , assertEqual "Space seperate words, square-bracket at beginning" ["[hello wo]rld","!"] (quoteWords "[hello wo]rld !") , assertEqual "Space seperate words, double quote at beginning" ["hello world","!"] (quoteWords "\"hello wor\"ld !") ] testSourcesList :: Test testSourcesList = test [ assertEqual "valid sources.list" validSourcesListExpected (render . pPrint . PP . parseSourcesList $ validSourcesListStr) ] where validSourcesListStr = unlines $ [ " # A comment only line " , " deb ftp://ftp.debian.org/debian unstable main contrib non-free # typical deb line" , " deb-src ftp://ftp.debian.org/debian unstable main contrib non-free # typical deb-src line" , "" , "# comment line" , "deb http://pkg-kde.alioth.debian.org/kde-3.5.0/ ./ # exact path" , "deb http://ftp.debian.org/whee \"space dist\" main" , "deb http://ftp.debian.org/whee dist space%20section" ] validSourcesListExpected = unlines $ [ "deb ftp://ftp.debian.org/debian unstable main contrib non-free" , "deb-src ftp://ftp.debian.org/debian unstable main contrib non-free" , "deb http://pkg-kde.alioth.debian.org/kde-3.5.0/ ./" , "deb http://ftp.debian.org/whee space%20dist main" , "deb http://ftp.debian.org/whee dist space%20section" ] _invalidSourcesListStr1 = "deb http://pkg-kde.alioth.debian.org/kde-3.5.0/ ./ main contrib non-free # exact path with sections" :: Text testSourcesListParse :: Test testSourcesListParse = test [ assertEqual "" gutsy (mconcat . map (<> "\n") . map (render . pPrint) . parseSourcesList $ gutsy) ] where gutsy = concat ["deb http://us.archive.ubuntu.com/ubuntu/ gutsy main restricted universe multiverse\n", "deb-src http://us.archive.ubuntu.com/ubuntu/ gutsy main restricted universe multiverse\n", "deb http://us.archive.ubuntu.com/ubuntu/ gutsy-updates main restricted universe multiverse\n", "deb-src http://us.archive.ubuntu.com/ubuntu/ gutsy-updates main restricted universe multiverse\n", "deb http://us.archive.ubuntu.com/ubuntu/ gutsy-backports main restricted universe multiverse\n", "deb-src http://us.archive.ubuntu.com/ubuntu/ gutsy-backports main restricted universe multiverse\n", "deb http://security.ubuntu.com/ubuntu/ gutsy-security main restricted universe multiverse\n", "deb-src http://security.ubuntu.com/ubuntu/ gutsy-security main restricted universe multiverse\n"] sourcesListTests :: [Test] sourcesListTests = [ testQuoteWords, testSourcesList, testSourcesListParse ] debian-3.91.1/debian/0000755000000000000000000000000012775511355012452 5ustar0000000000000000debian-3.91.1/debian/changelog.pre-debian0000644000000000000000000005027612775511355016343 0ustar0000000000000000haskell-debian (3.53) unstable; urgency=low * Changes for unixutils-1.30 * Changes for unixutils-1.31 -- David Fox Sun, 26 Dec 2010 09:12:20 -0800 haskell-debian (3.52) unstable; urgency=low * Update to work with Cabal 1.10, shipped with ghc7. -- David Fox Sat, 20 Nov 2010 07:54:52 -0800 haskell-debian (3.51) unstable; urgency=low * Remove dependency on haskell-utils, it is no longer in the repository. * Change the doc package prefix generated by cabal-debian from haskell- to libghc6-, this is the prefix chosen by the Debian packaging team. and I believe that if haskell- is used the documentation ends up in a directory in /usr/share/doc with the libghc6- prefix anyway. -- David Fox Mon, 19 Jul 2010 10:37:39 -0700 haskell-debian (3.50) unstable; urgency=low * Switch back to regex-tdfa, regex-posix can't match extended ASCII like "\250" =~ "[\249\250]" -- David Fox Sun, 18 Jul 2010 22:34:13 +0100 haskell-debian (3.49) unstable; urgency=low * Add Show instances. -- David Fox Fri, 16 Jul 2010 14:35:15 -0700 haskell-debian (3.48) unstable; urgency=low * Switch from regex-tdfa to regex-posix to avoid this failure, which seems to have appeared going from 1.1.2 to 1.1.3: "Explict error in module Text.Regex.TDFA.NewDFA : compressOrbit,1" -- David Fox Fri, 16 Jul 2010 10:43:13 -0700 haskell-debian (3.47) unstable; urgency=low * require HaXml < 1.14 -- Jeremy Shaw Wed, 05 May 2010 14:23:26 -0500 haskell-debian (3.46) unstable; urgency=low * Relax the Cabal >= 1.9 requirement by conditionalizing the code that is affected by the change. * Remove the applicative-extras dependency, instead of Failing a use Either [String] a. * Include Joachim Breitner's fixes for the Relation Ord instance. * Do case insensitive field name comparisons in Debian.Control. -- David Fox Tue, 04 May 2010 11:55:24 -0700 haskell-debian (3.45) unstable; urgency=low * Don't require targets to be Show instance in GenBuildDeps.buildable. * Eliminate use of OldException. -- David Fox Fri, 19 Feb 2010 06:47:04 -0800 haskell-debian (3.44) unstable; urgency=low * Add a rule to debian/rules to install the executables. -- David Fox Thu, 18 Feb 2010 12:16:18 -0800 haskell-debian (3.43) unstable; urgency=low * Add a strict version of fileFromURI. * Catch errors thrown by hGetContents when reading control files -- David Fox Sat, 02 Jan 2010 12:29:45 -0800 haskell-debian (3.42) unstable; urgency=low * Fix signature regex so we always split at the first pair of spaces. -- David Fox Tue, 29 Dec 2009 19:25:27 -0800 haskell-debian (3.41) unstable; urgency=low * Use Text.Regex.TDFA for parsing changelog instead of Text.Regex.Compat, it can handle Unicode. * Run unit tests during build, add some changelog unit tests. -- David Fox Tue, 29 Dec 2009 12:22:40 -0800 haskell-debian (3.40) unstable; urgency=low * Remove the now unused Extra.CIO and Debian.Extra.CIO modules -- David Fox Mon, 14 Sep 2009 09:41:52 -0700 haskell-debian (3.39) unstable; urgency=low * Remove dependency on Extra * Remove debian directory from .cabal -- Jeremy Shaw Wed, 09 Sep 2009 11:57:03 -0500 haskell-debian (3.38) unstable; urgency=low * Use parsec 3 -- Jeremy Shaw Tue, 28 Jul 2009 19:12:03 -0500 haskell-debian (3.37) unstable; urgency=low * Escape the vendor tag before embedding it in a regular expression. (I wrote an escapeForRegex that only escapes +, the character I want to use right now. This function should be available somewhere in the haskell standard libraries, right?) * Moved the VersionPolicy module to haskell-debian-repo. -- David Fox Thu, 23 Jul 2009 07:38:00 -0700 haskell-debian (3.36) unstable; urgency=low * Make the changelog parser more liberal, allow a tab character at the beginning of a text line instead of two spaces. This parses the new changelog entry for hscolour. -- David Fox Tue, 21 Jul 2009 06:45:24 -0700 haskell-debian (3.35) unstable; urgency=low * removed dependencies on Extra.HaXml * Updated to base >= 4 && < 5 * Fixed test suite -- Jeremy Shaw Wed, 01 Jul 2009 09:48:00 -0500 haskell-debian (3.34) unstable; urgency=low * cabal-debian: move -doc packages to Build-Depends-Indep * cabal-debian: properly nub Build-Depends and Build-Depends-Indep -- Jeremy Shaw Sun, 03 May 2009 12:15:52 -0500 haskell-debian (3.33) unstable; urgency=low * cabal-debian: Setion: libdevel -> haskell -- Jeremy Shaw Thu, 16 Apr 2009 16:22:35 -0500 haskell-debian (3.32) unstable; urgency=low * Add fields to Debian.Changes.ChangedFileSpec for SHA1 and SHA256 checksums. -- David Fox Fri, 03 Apr 2009 07:14:59 -0700 haskell-debian (3.31) unstable; urgency=low * update to use newer haskell-devscripts which includes hlibrary.mk * change libghc6-*-doc to haskell-*-doc * move haskell-*-doc to Section: doc * build haskell-*-doc for Architecture 'all' instead of 'any' * make ghc6-doc and haddock Build-Depends-Indep * update Standards-Version to 3.8.1 * depend on cdbs and haskell-devscripts instead of haskell-cdbs * only use one space at the beginning of lines in the long description * add ${misc:Depends} to Depends lines -- Jeremy Shaw Mon, 23 Mar 2009 20:18:41 -0500 haskell-debian (3.30) unstable; urgency=low * Move the modules for dealing with the repository into a new package named haskell-debian-repo. The cabal-debian tool remains in this package, so this split means that the repo package can change without triggering massive rebuilding due to build dependencies on cabal-debian. -- David Fox Wed, 18 Feb 2009 06:36:25 -0800 haskell-debian (3.29) unstable; urgency=low * Add System.Chroot to list of exported modules * Reduce number of modules loaded by CabalDebian. -- David Fox Tue, 10 Feb 2009 17:06:47 -0800 haskell-debian (3.28) unstable; urgency=low * Add System.Chroot.useEnv, and use it to allow contact with the ssh agent from inside of changeroots. -- David Fox Mon, 09 Feb 2009 11:18:59 -0800 haskell-debian (3.27) unstable; urgency=low * Added apt-get-build-deps. not librarized yet :( -- Jeremy Shaw Fri, 06 Feb 2009 18:52:36 -0600 haskell-debian (3.26) unstable; urgency=low * Improve the code that decides whether the sources.list has changed, to avoid recreating the build environment as often. -- David Fox Thu, 05 Feb 2009 08:56:32 -0800 haskell-debian (3.25) unstable; urgency=low * Use State monad instead of RWS monad for AptIO * Rename IOState to AptState -- David Fox Wed, 04 Feb 2009 09:34:24 -0800 haskell-debian (3.24) unstable; urgency=low * Use Data.Time instead of System.Time * Fix code to compute the elapsed time for the dpkg-buildpackage. * Restore some generated dependencies that got dropped out of cabal-debian. -- David Fox Sat, 31 Jan 2009 08:45:51 -0800 haskell-debian (3.23) unstable; urgency=low * Eliminate the use of EnvPath in most places, just use a regular path instead. There were very few places where we actually were inside a changeroot. -- David Fox Thu, 29 Jan 2009 16:48:23 -0800 haskell-debian (3.22) unstable; urgency=low * cabal-debian now has autodetection of ghc6 bundled packages -- Jeremy Shaw Thu, 29 Jan 2009 15:26:25 -0600 haskell-debian (3.21) unstable; urgency=low * Don't write out postinst and postrm for the doc package, they are now automatically added by haskell-cdbs. -- David Fox Tue, 27 Jan 2009 10:14:20 -0800 haskell-debian (3.20) unstable; urgency=low * Modify the buildable function in GenBuildDeps so it returns more info about the ready packages and what packages each one blocks. -- David Fox Tue, 27 Jan 2009 06:55:39 -0800 haskell-debian (3.19) unstable; urgency=low * Make cabal-debian depend on haskell-cdbs, it used to be the opposite. -- David Fox Sun, 25 Jan 2009 15:22:41 -0800 haskell-debian (3.18) unstable; urgency=low * Modify cabal-debian to it creates debianizations that use the new haskell-cdbs package instead of our modified haskell-devscripts with the cdbs file hlibrary.mk added in. * Have cabal-debian explain what changes it is making to the dependency list. -- David Fox Sat, 24 Jan 2009 07:27:47 -0800 haskell-debian (3.17) unstable; urgency=low * Have cabal-debian --substvar print its result to stderr. -- David Fox Fri, 23 Jan 2009 10:33:48 -0800 haskell-debian (3.16) unstable; urgency=low * Back out register/unregister stuff, just have cabal-debian die if the package doesn't have a library section. -- David Fox Thu, 22 Jan 2009 15:33:43 -0800 haskell-debian (3.15) unstable; urgency=low * Don't leave package registered after computing lbi. -- David Fox Thu, 22 Jan 2009 14:19:23 -0800 haskell-debian (3.14) unstable; urgency=low * Fix a bug that resulted in a fromJust Nothing error. -- David Fox Thu, 22 Jan 2009 09:59:16 -0800 haskell-debian (3.13) unstable; urgency=low * Add the cabal-debian executable to this package to ease bootstrapping. -- David Fox Fri, 16 Jan 2009 06:41:40 -0800 haskell-debian (3.12) unstable; urgency=low * Export some functions and types from Debian.Apt.Index that were already being used by other applications * Allow relation parser to skip empty relations like such as: a, ,c -- Jeremy Shaw Fri, 09 Jan 2009 18:22:09 -0600 haskell-debian (3.11) unstable; urgency=low * Gather code to retrieve the text an URI points to into the Debian.URI module. -- David Fox Tue, 04 Nov 2008 13:53:33 -0800 haskell-debian (3.10) unstable; urgency=low * Change name and arch of doc package. -- David Fox Sat, 20 Sep 2008 12:07:38 -0700 haskell-debian (3.9) unstable; urgency=low * Compute exactly which packages participate in dependency cycles. -- David Fox Mon, 18 Aug 2008 12:42:56 -0700 haskell-debian (3.8) unstable; urgency=low * Don't add an extra newline at the end of the Files section when editing the .changes file. -- David Fox Mon, 21 Jul 2008 10:57:49 -0700 haskell-debian (3.7) unstable; urgency=low * Eliminate all direct uses of TIO, we always use CIO m => so that all functions can be called from the regular IO monad. -- David Fox Sat, 19 Jul 2008 10:27:49 -0700 haskell-debian (3.6) unstable; urgency=low * Remove useless arguments from insertRelease. * Replace debianization -- David Fox Tue, 01 Jul 2008 10:41:22 -0700 haskell-debian (3.5) unstable; urgency=low * Debianization generated by cabal-debian -- David Fox Sat, 28 Jun 2008 15:49:07 -0700 haskell-debian (3.4) unstable; urgency=low * Even correcter code for doing Relax-Depends. The relaxDeps function is now seperate from the other build depenency functions, which makes things a bit simpler and easier to document. -- David Fox Wed, 18 Jun 2008 21:00:36 +0000 haskell-debian (3.3) unstable; urgency=low * Add code to correctly implement Relax-Depends for non-global dependencies. -- David Fox Sat, 31 May 2008 07:31:15 +0000 haskell-debian (3.2) unstable; urgency=low * Redo the buildable function in GenBuildDeps. * Improve message from OSImage.updateLists. -- David Fox Sat, 24 May 2008 13:06:09 +0000 haskell-debian (3.1-1) unstable; urgency=low * Version number follies. -- David Fox Thu, 22 May 2008 16:18:47 -0700 haskell-debian (3.1) unstable; urgency=low * Re-worked the build dependency computation -- David Fox Thu, 22 May 2008 10:59:22 -0700 haskell-debian (3.0) unstable; urgency=low * Re-organization of module heirarchy. -- David Fox Mon, 19 May 2008 12:47:25 -0700 haskell-debian (2.28) unstable; urgency=low * Eliminate use of haskell-ugly library. -- David Fox Wed, 14 May 2008 12:30:40 -0700 haskell-debian (2.27) unstable; urgency=low * Changes for switch to lazy bytestrings in haskell-unixutils. -- David Fox Tue, 06 May 2008 05:52:51 -0700 haskell-debian (2.26) unstable; urgency=low * Improve error report from "Missing control file or changelog" -- David Fox Mon, 05 May 2008 05:59:27 -0700 haskell-debian (2.25) unstable; urgency=low * Packaging changes for haskell-devscripts 0.6.10. -- David Fox Sat, 29 Mar 2008 10:25:54 -0700 haskell-debian (2.24) unstable; urgency=low * New version of dupload reads both /etc/dupload.conf and ~/.dupload.conf, so we have to explicitly unset $preupload in ~/.dupload.conf. -- David Fox Tue, 25 Mar 2008 05:49:08 -0700 haskell-debian (2.23) unstable; urgency=low * Fix a divide by zero error in Debian.Shell. This should also improve the behavior of the code that outputs one dot per 128 characters of shell command output. -- David Fox Wed, 12 Mar 2008 16:55:59 +0000 haskell-debian (2.22) unstable; urgency=low * Add a chars/dot argument to Shell.dotOutput * Moved some functions from Shell to haskell-unixutils * Moved TIO module to haskell-extra -- David Fox Sun, 02 Mar 2008 10:14:13 -0800 haskell-debian (2.21) unstable; urgency=low * Change some writeFile calls to avoid lazyness in evaluating the second argument, which appears to lead to locked file errors. -- David Fox Sun, 24 Feb 2008 11:06:53 -0800 haskell-debian (2.20) unstable; urgency=low * Message Improvements * Discard duplicate dependency relations * Fix rfc822DateFormat -- Jeremy Shaw Wed, 20 Feb 2008 13:34:34 -0800 haskell-debian (2.19) unstable; urgency=low * Added more functions for working with index files -- Jeremy Shaw Tue, 19 Feb 2008 16:07:46 -0800 haskell-debian (2.18) unstable; urgency=low * Hack: Debian.Local.Insert.addPackagesToIndexes work-around for optimizer bug * Debian.Package: use controlFromIndex instead of calling zcat -- Jeremy Shaw Mon, 11 Feb 2008 23:08:30 -0800 haskell-debian (2.17) unstable; urgency=low * TIO module fixes and cleanups. -- David Fox Thu, 07 Feb 2008 05:45:00 -0800 haskell-debian (2.16) unstable; urgency=low * Add setRepoMap to install cached repository info * Print more info about what happened when a repository appears not to exist. -- David Fox Wed, 06 Feb 2008 16:00:45 -0800 haskell-debian (2.15) unstable; urgency=low * Fix bug in Debian.VersionPolicy * Split a simple TIO monad out of the AptIO monad. * Simplify Repository type, eliminate parameterized Release etc. * Improve type safety of the SourcesList related types -- David Fox Wed, 06 Feb 2008 05:38:12 -0800 haskell-debian (2.14) unstable; urgency=low * Rewrite of Debian.VersionPolicy. * Run unit tests during build -- David Fox Mon, 28 Jan 2008 13:07:00 -0800 haskell-debian (2.13) unstable; urgency=low * Improvements in code currently used to compute the build dependencies. This allows builds of packages which previously caused an combinatoric explosion in memory and time use. The specific modifications are to avoid making a huge list of all the solution candidates that failed, and to put the relations into a normal form which only involves equals dependencies on packages that are actually available for installation. Finally, a bug in handling of architecture specific dependencies was fixed which might have been causing the extremely long and fruitless searches for some packages' build dependencies. -- David Fox Sat, 19 Jan 2008 19:28:32 +0000 haskell-debian (2.12) unstable; urgency=low * Add Debian.Apt.Dependecies and Debian.Apt.Package to debian.cabal -- Jeremy Shaw Fri, 18 Jan 2008 17:13:24 -0800 haskell-debian (2.11) unstable; urgency=low * Added trump detector * Added code to find parents and siblings of a binary package from the Packages/Sources files * Packaging updates -- Jeremy Shaw Fri, 14 Dec 2007 13:55:20 -0800 haskell-debian (2.10) unstable; urgency=low * Added new interface, Apt.Debian.Methods.fetch which allows the UI portion of fetching (status, authentication), to be controlled by providing a set of callback functions. -- Jeremy Shaw Tue, 20 Nov 2007 14:07:43 -0800 haskell-debian (2.9) unstable; urgency=low * Add caching of loaded package indexes based on the path and the file status of the cached index file. Also splits Debian.Types into several modules. -- David Fox Fri, 9 Nov 2007 11:05:11 -0800 haskell-debian (2.8) unstable; urgency=low * Last version had bogus dependencies due to an unknown build error. Make loading of package indexes less lazy in an attempt to reduce memory usage. -- David Fox Wed, 7 Nov 2007 10:54:27 -0800 haskell-debian (2.7) unstable; urgency=low * Make loading of package indexes lazy. -- David Fox Mon, 22 Oct 2007 11:11:34 -0700 haskell-debian (2.6) unstable; urgency=low * Pass --immediate-configure-false to build-env so we can create environments for gutsy, lenny, and sid. -- David Fox Sat, 20 Oct 2007 16:17:59 -0700 haskell-debian (2.5) unstable; urgency=low * Reduce amount of apt-get updating that occurs. -- David Fox Sat, 20 Oct 2007 13:50:25 +0000 haskell-debian (2.4) unstable; urgency=low * Fix parsing of version tags in VersionPolicy. It was always failing and therefore not understanding versions we had generated. -- David Fox Sat, 13 Oct 2007 04:44:39 -0700 haskell-debian (2.3) unstable; urgency=low * The EnvPath and EnvRoot types had show methods that were not invertable by read. Now they use deriving Show, and use rootPath and the new outsidePath to convert EnvRoot and EnvPath to the FilePath type. This is a big looking change, but safe. * Replace code that looked at the "Package" and "Version" fields of a parsed control file with calls to packageName and packageVersion, which just returns values already computed and saved in the Package object. * Use EnvPath instead of FilePath in places where it makes sense, such as the copyDebianBuildTree and other places in Debian.SourceTree. This change propagated down in various places, and the cutoff may be a little out of whack in some places, but it is all typesafe (and therefore wonderful?) -- David Fox Thu, 11 Oct 2007 15:43:03 +0000 haskell-debian (2.2) unstable; urgency=low * Fix a bug in parsing of dependency relations when there is whitespace after a right square brace. -- David Fox Tue, 9 Oct 2007 21:00:24 +0000 haskell-debian (2.1) unstable; urgency=low * Fix show method of SliceList, the elements need to be terminated by newlines. -- David Fox Fri, 5 Oct 2007 00:11:33 -0700 haskell-debian (2.0) unstable; urgency=low * Change Apt. to Debian. * Added Debian.Apt.Methods * Added Debian.Deb * Added Debian.Time -- Jeremy Shaw Wed, 19 Sep 2007 15:14:10 -0700 haskell-apt (1.0) unstable; urgency=low * Initial Debian package. -- David Fox Tue, 18 Sep 2007 09:33:24 -0700 debian-3.91.1/debian/changelog0000644000000000000000000004160712775511355014334 0ustar0000000000000000haskell-debian (3.91) unstable; urgency=low * Eliminate error call in parseChangeLog -- David Fox Thu, 06 Oct 2016 09:42:06 -0700 haskell-debian (3.89) unstable; urgency=low * Change signature of parseDebianVersion to return Either ParseError DebianVerions. * Provide the old signature as parseDebianVersion'. -- David Fox Mon, 21 Sep 2015 15:23:32 -0700 haskell-debian (3.88.1) unstable; urgency=low * Make ghc-7.10.2 a required travis test * Sort out the List/Map/Set imports in Debian.GenBuildDeps -- David Fox Mon, 24 Aug 2015 10:29:00 -0700 haskell-debian (3.88) unstable; urgency=low * Improved handling of white space * Speed up Debian.GenBuildDeps.buildable -- David Fox Mon, 24 Aug 2015 06:29:29 -0700 haskell-debian (3.87.2) unstable; urgency=low * Functor, Applicative, and Alternative instances for ghc-7.10 * Fiddle with imports and ifdefs to fix build * Switch from ansi-wl-pprint package to pretty -- David Fox Sun, 22 Mar 2015 12:55:39 -0700 haskell-debian (3.87.1) unstable; urgency=low * Version bump to match cabal -- David Fox Mon, 02 Mar 2015 13:13:00 -0800 haskell-debian (3.86) unstable; urgency=low * Avoid dependency on th-orphans * Turn test program into a test-suite * add DEB_ENABLE_TESTS = yes to debian/rules * Support builds on older versions of GHC -- David Fox Sun, 15 Feb 2015 07:32:42 -0800 haskell-debian (3.85.3) unstable; urgency=low * Handle new pretty-1.1.2 package, which supercedes prettyclass. * Make a change to trigger a travis build. -- David Fox Fri, 06 Feb 2015 10:18:30 -0800 haskell-debian (3.85.2) unstable; urgency=low * If any of the lines of a multi-line control file field are not indented, indent all the lines by one space. * When formatting multi-line control file fields, make sure empty lines are replaced by a single (indented) '.'. -- David Fox Wed, 04 Feb 2015 11:23:42 -0800 haskell-debian (3.85.1) unstable; urgency=low * Allow build with process-extras-0.2.0 -- David Fox Thu, 04 Dec 2014 06:23:38 -0800 haskell-debian (3.85) unstable; urgency=low * Fix some cases where the pretty printer output parsed to something different from its input -- David Fox Sat, 29 Nov 2014 09:27:42 -0800 haskell-debian (3.84.1) unstable; urgency=low * Remove a Show instance that overlaps the one derived in the Control type declaration. -- David Fox Sat, 29 Nov 2014 05:18:40 -0800 haskell-debian (3.84) unstable; urgency=low * Replace the Debian.Pretty module with a module copied from the pretty-class package, Text.PrettyPrint.HughesPJClass. This is almost identical to the module in Lennart's prettyclass package, but has what I believe to be a more correct pPrintList method for type Char. -- David Fox Sun, 14 Sep 2014 12:37:57 -0700 haskell-debian (3.83.4.2) unstable; urgency=low * Require a better version of process-listlike. * Trigger a new build on hackage to get documentation. -- David Fox Tue, 02 Sep 2014 08:29:32 -0700 haskell-debian (3.83.4.1) unstable; urgency=low * Merge change from version 3.83.3.1 (which only went to hackage) and 3.83.4 (whose version change didn't get checked into git.) * Require ListLike >= 4. * Fix repository type in the cabal file. -- David Fox Tue, 02 Sep 2014 07:24:27 -0700 haskell-debian (3.83.3) unstable; urgency=low * Moved repository to https://github.com/ddssff/debian-haskell -- David Fox Thu, 28 Aug 2014 08:36:16 -0700 haskell-debian (3.83.2) unstable; urgency=low * Add some Read, Show, Data, and Typeable instances. -- David Fox Mon, 25 Aug 2014 03:47:38 -0700 haskell-debian (3.83.1) unstable; urgency=low * Support new network-uri package. -- David Fox Sun, 24 Aug 2014 17:17:55 -0700 haskell-debian (3.83) unstable; urgency=low * Add a Loc value to the ControlFileError type, the template haskell location where the exception was created. -- David Fox Thu, 07 Aug 2014 13:54:27 -0700 haskell-debian (3.82) unstable; urgency=low * Add Debian.Control.Policy which has knowledge of specific fields, such as Source and Package, which are expected to be present in a debian control file. * Replace a 3-tuple in Debian.GenBuildDeps with a record named ReadyTargets. * Add Debian.Pretty.display :: Pretty a => a -> String -- David Fox Wed, 06 Aug 2014 06:13:15 -0700 haskell-debian (3.81.3) unstable; urgency=low * Remove spurious dependency on Cabal. -- David Fox Tue, 15 Jul 2014 06:58:42 -0700 haskell-debian (3.81.2) unstable; urgency=low * Update debian build dependencies. -- David Fox Sat, 05 Jul 2014 22:30:43 -0700 haskell-debian (3.81.1) unstable; urgency=low * Modernize cabal file. -- David Fox Sat, 17 May 2014 06:36:43 -0700 haskell-debian (3.81) unstable; urgency=low * Replace library pretty and library ansi-wl-pprint with an ultra-simple custom pretty printing library in Debian.Pretty. -- David Fox Sun, 12 Jan 2014 07:34:21 -0800 haskell-debian (3.80.2) unstable; urgency=low * Neil Mayhew's patch to greatly speed parsing of control files. -- David Fox Mon, 06 Jan 2014 04:36:37 -0800 haskell-debian (3.80.1) unstable; urgency=low * Fix for fakechanges from Neil Mayhew - don't reject all .deb files. -- David Fox Mon, 30 Dec 2013 08:02:08 -0800 haskell-debian (3.80) unstable; urgency=low * Make the SliceName type an alias for ReleaseName. Pretty sure they are the same thing. -- David Fox Thu, 19 Dec 2013 11:41:38 -0800 haskell-debian (3.79.4) unstable; urgency=low * Add changelog to list of extra source files so it is added to the tarball. -- David Fox Tue, 15 Oct 2013 07:36:41 -0700 haskell-debian (3.79.3) unstable; urgency=low * Make the changelog visible in hackage2. -- David Fox Tue, 15 Oct 2013 07:33:02 -0700 haskell-debian (3.79.2) unstable; urgency=low * Allow package to build with either process-listlike or process-extra. -- David Fox Fri, 04 Oct 2013 09:02:48 -0700 haskell-debian (3.79.1) unstable; urgency=low * Switch from using package process-extras to process-listlike. -- David Fox Wed, 05 Jun 2013 06:22:26 -0700 haskell-debian (3.79) unstable; urgency=low * Efficiency fix for the Text instance of Debian.Control. * Get rid of the Data.Text parser, instead parse the ByteString and then decode the resulting control file. Much faster I think. -- David Fox Mon, 29 Apr 2013 21:33:55 -0700 haskell-debian (3.78) unstable; urgency=low * Change URI' to simplify its Read and Show instances, it is now just a private constructor applied to a string for which parseURI was known to succeed. * Add changelog.pre-debian to the source file list -- David Fox Sun, 28 Apr 2013 12:51:11 -0700 haskell-debian (3.77) unstable; urgency=low * Add a URI' type that is a wrapper around URI with working Read and Show instances. -- David Fox Fri, 26 Apr 2013 11:00:10 -0700 haskell-debian (3.76) unstable; urgency=low * Add Debian.UTF, with support for reading and decoding "almost-utf8" files -- David Fox Thu, 25 Apr 2013 07:56:45 -0700 haskell-debian (3.75) unstable; urgency=low * If we get a UTF8 decoding error just insert the offending character into the output stream. There is an -- David Fox Wed, 24 Apr 2013 15:30:30 -0700 haskell-debian (3.74) unstable; urgency=low * Add Debian.Relation.Text and Debian.Version.Text. -- David Fox Tue, 23 Apr 2013 18:11:00 -0700 haskell-debian (3.73) unstable; urgency=low * Use Text instead of ByteString in the functions exported by Debian.Control. -- David Fox Tue, 23 Apr 2013 17:59:21 -0700 haskell-debian (3.72) unstable; urgency=low * Add Debian.Control.Text, Data.Text support for control files. -- David Fox Tue, 23 Apr 2013 17:19:22 -0700 haskell-debian (3.71) unstable; urgency=low * Refine the ArchitectureReq type to parse things like !linux-any. -- David Fox Sat, 13 Apr 2013 15:55:27 -0700 haskell-debian (3.70.2) unstable; urgency=low * Fix source repository location in cabal file. -- David Fox Sat, 13 Apr 2013 11:11:45 -0700 haskell-debian (3.70.1) unstable; urgency=low * Add Show and Read instances for DebianVersion. -- David Fox Tue, 09 Apr 2013 08:58:44 -0700 haskell-debian (3.70) unstable; urgency=low * Make Pretty instances for all the types in Debian.Relation: Relation, Relations, BinPkgName, etc. Don't export the individual functions like prettyRelation, clients can just call pretty. -- David Fox Thu, 27 Dec 2012 05:50:56 -0800 haskell-debian (3.69.3) unstable; urgency=low * Add a missing newline in the generated log entry comments. -- David Fox Wed, 26 Dec 2012 16:42:41 -0800 haskell-debian (3.69.2) unstable; urgency=low * Fix formatting of pretty printed changelog entries - There were two newlines before the signature and none after, there should be one and one. -- David Fox Wed, 26 Dec 2012 16:05:49 -0800 haskell-debian (3.69.1) unstable; urgency=low * Fix the darcs repo path. -- David Fox Mon, 19 Nov 2012 16:35:37 -0800 haskell-debian (3.69) unstable; urgency=low * Fix changelog formatting by adding a newtype named ChangeLog with a Pretty instance. * Rename parseLog -> parseEntries, add a parseChangeLog function. -- David Fox Mon, 19 Nov 2012 11:10:37 -0800 haskell-debian (3.68) unstable; urgency=low * Fix the formatting of changelog entries (an extra newline was being appended) and replace the functions prettyChanges, prettyChangesFile, and prettyEntry with instances of Pretty. -- David Fox Sun, 18 Nov 2012 07:04:28 -0800 haskell-debian (3.67) unstable; urgency=low * Eliminate the PkgName type, instead make BinPkgName and SrcPkgName instances of a class named PkgName. -- David Fox Sat, 17 Nov 2012 06:11:06 -0800 haskell-debian (3.66) unstable; urgency=low * Eliminate the use of the tiny pretty-class package, use the Pretty class from ansi-wl-pprint instead. * Improve the pretty printing of control files in terms of terminating newlines and the newlines between paragraphs. * Add some control file unit tests. -- David Fox Sun, 11 Nov 2012 08:21:07 -0800 haskell-debian (3.65) unstable; urgency=low * Replace the Show instances for control files with Pretty instances. -- David Fox Thu, 18 Oct 2012 12:26:37 -0700 haskell-debian (3.64.1) unstable; urgency=low * Fix typo in maintainer name. -- David Fox Mon, 01 Oct 2012 09:19:45 -0700 haskell-debian (3.64) unstable; urgency=low * Eliminate dependency on progress, eliminate most of the Unixutils dependency. We still need the ByteString versions of the functions from System.Process, and a couple of other process functions. -- David Fox Mon, 26 Mar 2012 17:25:17 -0700 haskell-debian (3.63) unstable; urgency=low * Use distinct types for Debian source package names and binary package names everywhere, instead of strings. -- David Fox Thu, 15 Mar 2012 12:33:05 -0700 haskell-debian (3.62.2) unstable; urgency=low * When parsing a list of package version relations, strip any lines that begin with a '#' - they are comments. -- David Fox Thu, 08 Mar 2012 10:22:13 -0800 haskell-debian (3.62.1) unstable; urgency=low * Export old relaxinfo functions and data structures for diagnosing performance problems. -- David Fox Thu, 01 Mar 2012 13:14:53 -0800 haskell-debian (3.62) unstable; urgency=low * New type for RelaxInfo, was RelaxInfo [(BinPkgName, Maybe SrcPkgName)] now (SrcPkgName -> BinPkgName -> Bool). -- David Fox Sat, 25 Feb 2012 18:07:16 -0800 haskell-debian (3.61.1) unstable; urgency=low * Add some Data and Typeable instances. -- David Fox Thu, 12 Jan 2012 10:18:58 -0800 haskell-debian (3.61) unstable; urgency=low * Uploading to hackage. * Remove crypto++ dependency (it was a mistake.) * Add optimization flag to ghc-options * Reference seereason darcs repo -- David Fox Thu, 06 Oct 2011 09:04:38 -0700 haskell-debian (3.60) unstable; urgency=low * Replace bogus Show instances in Debian.Relation.Common with pretty printing functions. * Change cabal category from System to Debian (to join the dpkg package) * Fix some of the compiler warnings. * Change the Show instances in Debian.Version into pretty printing functions too. -- David Fox Sun, 25 Sep 2011 07:33:25 -0700 haskell-debian (3.59) unstable; urgency=low * Move the cabal-debian program into a separate pacakge. -- David Fox Sun, 18 Sep 2011 06:43:36 -0700 haskell-debian (3.58-0.2) unstable; urgency=low * Remove the --deb-name option, all the package name special cases need to be encoded in the Distribution.Package.Debian.Bundled.debianName function so that we can fix both the names for the package we are building and the names of its dependencies. -- David Fox Thu, 25 Aug 2011 10:58:11 -0700 haskell-debian (3.58-0.1) unstable; urgency=low * Add --deb-name option, which sets the part of the package name between the prefix libghc- and the suffix -dev. * Add --epoch * Add --deb-version -- David Fox Wed, 24 Aug 2011 20:45:33 -0700 haskell-debian (3.58) unstable; urgency=low * Add a --ghc-version option to specify what the ghc version is in the build environment, in case it is different from the one where the autobuilder is being run. This affects what packages cabal-debian thinks are built into the compiler. I have non-working code to actually look in the environment for this information, but it depends on having the compiler already installed there. * Greatly sped-up cabal-debian. * Add --build-dep to specify extra build dependencies. * Generate a haskell-packagename-utils deb with all the executables, rather than one deb per executable. -- David Fox Fri, 19 Aug 2011 08:34:36 -0700 haskell-debian (3.57) unstable; urgency=low * Re-order generated dependencies so we are more likely to build with newer packages installed. -- David Fox Tue, 16 Aug 2011 19:04:29 -0700 haskell-debian (3.56-1) unstable; urgency=low * I created a new repository by importing the sid version of haskell-debian-3.55 and then applying my patches. This is because I don't understand why Marco's repository is so different from the code in sid. At some point we will get this all sorted out. -- David Fox Tue, 16 Aug 2011 13:00:15 -0700 haskell-debian (3.55-2) unstable; urgency=low * Build against parsec 3 -- Joachim Breitner Mon, 13 Jun 2011 18:13:10 +0200 haskell-debian (3.55-1) unstable; urgency=low * Use ghc instead of ghc6 * control: Standards-Version: Bump, no changes needed. * control: haskell-debian-utils: Adds Recommends: apt-file. * New upstream version. * patches/dont-build-teste.patch: Update patch to new upstream version. * control: Update dependency on haxml to 1.20.*. * control: Depends on utf8-string. -- Marco Túlio Gontijo e Silva Fri, 03 Jun 2011 22:49:23 -0300 haskell-debian (3.47-3) unstable; urgency=low * Re-add dont-build-tests.patch, lost in the previous upload -- Joachim Breitner Thu, 24 Jun 2010 19:33:30 +0200 haskell-debian (3.47-2) unstable; urgency=low [ Erik de Castro Lopo ] * debian/control: Fix lintian warnings. * Add man pages for apt-get-build-depends, cabal-debian, debian-report and fakechanges. * Add libghc6-debian-doc.doc-base. * Move installation of binaries and man pages from rules file to new file haskell-debian-utils.install. [ Joachim Breitner ] * Adjust copyright file per FTP master request. * Bump haskell-regex-tdfa dependency -- Joachim Breitner Thu, 24 Jun 2010 09:47:55 +0200 haskell-debian (3.47-1) unstable; urgency=low * Initial release. -- Joachim Breitner Sun, 09 May 2010 19:08:20 +0200 debian-3.91.1/debian/copyright0000644000000000000000000000337312775511355014413 0ustar0000000000000000This package was debianized by David Fox on September 18, 2007. The packageing was adjusted to Debian conventions by Joachim Breitner on Sat, 01 May 2010 21:16:18 +0200, and is licenced under the same terms as the package itself.. Copyright (c) 2007, David Fox Copyright (c) 2007, Jeremy Shaw All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. debian-3.91.1/utils/0000755000000000000000000000000012775511355012370 5ustar0000000000000000debian-3.91.1/utils/Report.hs0000644000000000000000000000726212775511355014206 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module Main where import Control.Monad import Data.Maybe (fromMaybe) import Debian.Apt.Methods import Debian.Report import Debian.Sources import Foreign.C.Types import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) import Text.XML.HaXml import Text.XML.HaXml.Pretty (document) import Text.XML.HaXml.Posn import Text.PrettyPrint.HughesPJ import System.IO import System.Posix.Env -- * main main :: IO () main = do (sourcesAFP, sourcesBFP) <- parseArgs let arch = "i386" -- not actually used for anything right now, could be when binary package list is enabled cacheDir = "." -- FIXME: replace with tempdir later sourcesA <- liftM parseSourcesList $ readFile sourcesAFP sourcesB <- liftM parseSourcesList $ readFile sourcesBFP trumpMap <- trumped (fetch emptyFetchCallbacks []) cacheDir arch sourcesA sourcesB print (showXML "trump.xsl" (trumpedXML trumpMap)) where showXML :: String -> CFilter Posn -> Doc showXML styleSheet = document . mkDocument styleSheet . cfilterToElem -- cliff says this is broken with regards to cdata cfilterToElem :: CFilter Posn -> Element Posn cfilterToElem f = case f (CString False "" noPos) of [CElem e _] -> xmlEscape stdXmlEscaper e [] -> error "RSS produced no output" _ -> error "RSS produced more than one output" -- mkDocument :: String -> Element Posn -> Document Posn mkDocument styleSheet elem = let xmlDecl = XMLDecl "1.0" (Just (EncodingDecl "utf-8")) (Just True) prolog = Prolog (Just xmlDecl) [] Nothing [PI ("xml-stylesheet","type=\"text/xsl\" href=\""++styleSheet++"\"")] -- symTable = [] in Document prolog [] elem [] -- * command-line helper functions helpText :: String -> Doc helpText progName = (text "Usage:" <+> text progName <+> text "" <+> text ""$+$ text [] $+$ (fsep $ map text $ words $ "Find all the packages referenced by the second sources.list which trump packages find in the first sources.list.") ) parseArgs :: IO (String, String) parseArgs = do args <- getArgs case args of [dista, distb] -> return (dista, distb) _ -> exitWithHelp helpText where -- |exitFailure with nicely formatted help text on stderr exitWithHelp :: (String -> Doc) -- ^ generate help text, the argument is the result of getProgName -> IO a -- ^ no value is returned, this function always calls exitFailure exitWithHelp helpText = do progName <- getProgName hPutStrLn stderr =<< renderWidth (helpText progName) exitFailure -- |render a Doc using the current terminal width renderWidth :: Doc -> IO String renderWidth doc = do columns <- return . fromMaybe 80 =<< getWidth return $ renderStyle (Style PageMode columns 1.0) doc foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size :: IO CLong -- get the number of rows and columns using ioctl (0, TIOCGWINSZ, &w) -- @see also: getWidth getWinSize :: IO (Int,Int) getWinSize = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size return (fromIntegral b, fromIntegral a) -- get the number of colums. -- First tries getWinSize, if that returns 0, then try the COLUMNS -- shell variable. getWidth :: IO (Maybe Int) getWidth = do (cols, _) <- getWinSize case cols of 0 -> return . fmap read =<< getEnv "COLUMNS" _ -> return (Just cols) debian-3.91.1/utils/FakeChanges.hs0000644000000000000000000000206312775511355015064 0ustar0000000000000000module Main where import Debian.Util.FakeChanges import System.Environment import System.Console.GetOpt import System.Directory (canonicalizePath) import System.FilePath data Flag = OutputDir FilePath deriving Show options :: [OptDescr Flag] options = [ Option ['o'] ["output"] (ReqArg OutputDir "DIRECTORY") "output DIRECTORY" ] fakeChangesOpts :: [String] -> IO ([Flag], [FilePath]) fakeChangesOpts argv = case getOpt Permute options argv of (o,files,[]) | not (null files) -> return (o, files) (_,_,errs) -> do h <- header error $ (concat errs ++ usageInfo h options) where header = do pn <- getProgName return $ "\nUsage: " ++ pn ++ " [OPTION...] files..." main = do args <- getArgs (opts, files) <- fakeChangesOpts args (changesFP, contents) <- fakeChanges files outdir <- case opts of [OutputDir dir] -> canonicalizePath dir _ -> return "." writeFile (outdir changesFP) $! contents debian-3.91.1/utils/AptGetBuildDeps.hs0000644000000000000000000000270612775511355015711 0ustar0000000000000000module Main where import Debian.Control -- (Control(..),lookupP,parseControlFromFile) import Debian.Relation import System.Process import System.Exit import System.Environment lookupBuildDeps :: FilePath -> IO [BinPkgName] lookupBuildDeps fp = do control <- parseControlFromFile fp case control of (Left e) -> error (show e) (Right (Control [])) -> error "Empty control file" (Right (Control (p:_))) -> return $ ((lookupDepends "Build-Depends" p) ++ (lookupDepends "Build-Depends-Indep" p)) lookupDepends :: String -> Paragraph' String -> [BinPkgName] lookupDepends key paragraph = case fieldValue key paragraph of Nothing -> [] -- (Left $ "could not find key " ++ key) (Just relationString) -> case parseRelations relationString of (Left e) -> error (show e) (Right andRelations) -> map pkgName (concatMap (take 1) andRelations) where pkgName :: Relation -> BinPkgName pkgName (Rel name _ _) = name aptGetInstall :: [String] -> [BinPkgName] -> IO ExitCode aptGetInstall options pkgnames = do (_,_,_,ph) <- createProcess $ proc "apt-get" $ ["install"] ++ options ++ map unBinPkgName pkgnames waitForProcess ph main :: IO () main = do options <- getArgs lookupBuildDeps "debian/control" >>= aptGetInstall options >>= exitWith debian-3.91.1/Debian/0000755000000000000000000000000012775511355012412 5ustar0000000000000000debian-3.91.1/Debian/Relation.hs0000644000000000000000000000125512775511355014526 0ustar0000000000000000-- |A module for working with debian relationships 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 debian-3.91.1/Debian/Arch.hs0000644000000000000000000000262212775511355013625 0ustar0000000000000000{-# 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" debian-3.91.1/Debian/Changes.hs0000644000000000000000000003272712775511355014331 0ustar0000000000000000{-# 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 [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 -> Either [[String]] ChangeLog parseChangeLog s = case partitionEithers (parseEntries s) of ([], xs) -> Right (ChangeLog xs) (ss, _) -> Left 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 -> 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] entryRE = bol ++ blankLines ++ headerRE ++ changeDetails ++ signature ++ blankLines changeDetails = "((\n| \n| -\n|([^ ]| [^--]| -[^--])[^\n]*\n)*)" signature = " -- ([ ]*([^ ]+ )* )([^\n]*)\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 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 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 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 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 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 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) Wed, 21 Nov 2007 01:26:57 +0000"] debian-3.91.1/Debian/Deb.hs0000644000000000000000000000226612775511355013446 0ustar0000000000000000{-# 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 debian-3.91.1/Debian/Version.hs0000644000000000000000000000100112775511355014363 0ustar0000000000000000-- |A module for parsing, comparing, and (eventually) modifying debian version -- numbers. 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 () debian-3.91.1/Debian/Report.hs0000644000000000000000000001004212775511355014216 0ustar0000000000000000module 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 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) ] ] debian-3.91.1/Debian/Sources.hs0000644000000000000000000001604312775511355014375 0ustar0000000000000000{-# 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 debian-3.91.1/Debian/Control.hs0000644000000000000000000000435412775511355014374 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- |A module for working with Debian control files 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.Builder () import qualified Debian.Control.Text as T import qualified Debian.Control.TextLazy as TL 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 debian-3.91.1/Debian/URI.hs0000644000000000000000000000675212775511355013417 0ustar0000000000000000{-# 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 "( 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 debian-3.91.1/Debian/Release.hs0000644000000000000000000000412312775511355014326 0ustar0000000000000000{-# 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) debian-3.91.1/Debian/GenBuildDeps.hs0000644000000000000000000003570012775511355015260 0ustar0000000000000000{-# 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 -- 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 debian-3.91.1/Debian/Pretty.hs0000644000000000000000000000253412775511355014241 0ustar0000000000000000-- | 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 debian-3.91.1/Debian/Loc.hs0000644000000000000000000000233512775511355013466 0ustar0000000000000000{-# 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)) debian-3.91.1/Debian/Time.hs0000644000000000000000000000145312775511355013647 0ustar0000000000000000{-# 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' debian-3.91.1/Debian/UTF8.hs0000644000000000000000000000166012775511355013477 0ustar0000000000000000{-# 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 debian-3.91.1/Debian/Util/0000755000000000000000000000000012775511355013327 5ustar0000000000000000debian-3.91.1/Debian/Util/FakeChanges.hs0000644000000000000000000002430112775511355016022 0ustar0000000000000000{-# 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 debian-3.91.1/Debian/Control/0000755000000000000000000000000012775511355014032 5ustar0000000000000000debian-3.91.1/Debian/Control/Common.hs0000644000000000000000000001711612775511355015624 0ustar0000000000000000{-# 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 debian-3.91.1/Debian/Control/ByteString.hs0000644000000000000000000002023412775511355016461 0ustar0000000000000000{-# 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) debian-3.91.1/Debian/Control/Text.hs0000644000000000000000000001336412775511355015321 0ustar0000000000000000{-# 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 -} debian-3.91.1/Debian/Control/TextLazy.hs0000644000000000000000000001345712775511355016164 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} module Debian.Control.TextLazy ( -- * 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.Lazy as T (Text, pack, unpack, map, dropAround, reverse, fromStrict, toStrict) 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 = T.fromStrict . 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 (T.toStrict 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 -} debian-3.91.1/Debian/Control/Builder.hs0000644000000000000000000001400212775511355015751 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} module Debian.Control.Builder ( -- * 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.ListLike as LL import Data.ListLike.Text.Builder () import qualified Data.Text as T (pack, unpack, map, reverse) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (Builder, fromLazyText, fromText, toLazyText) 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' Builder type Control = Control' Builder type Paragraph = Paragraph' Builder 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' Builder decodeField (B.Field (name, value)) = Field (decode name, decode value) decodeField (B.Comment s) = Comment (decode s) decode :: B.ByteString -> Builder decode = fromText . decodeUtf8With (\ _ w -> fmap (chr . fromIntegral) w) -- * ControlFunctions instance ControlFunctions Builder 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 (toStrict (toLazyText c)))) lookupP fieldName (Paragraph paragraph) = find (hasFieldName (map toLower fieldName)) paragraph where hasFieldName :: String -> Field' Builder -> Bool hasFieldName name (Field (fieldName',_)) = name == LL.map toLower (LL.toString fieldName') hasFieldName _ _ = False stripWS = dropAround (`elem` (" \t" :: String)) -- T.strip would also strip newlines protectFieldText = protectFieldText' asString = LL.toString dropAround p = LL.dropWhile p . LL.dropWhileEnd p -- * 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 -} debian-3.91.1/Debian/Control/Policy.hs0000644000000000000000000002054312775511355015631 0ustar0000000000000000{-# 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 debian-3.91.1/Debian/Control/String.hs0000644000000000000000000000776212775511355015650 0ustar0000000000000000{-# 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") debian-3.91.1/Debian/Relation/0000755000000000000000000000000012775511355014167 5ustar0000000000000000debian-3.91.1/Debian/Relation/Common.hs0000644000000000000000000001124412775511355015755 0ustar0000000000000000{-# 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 debian-3.91.1/Debian/Relation/ByteString.hs0000644000000000000000000000137412775511355016622 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} -- |A module for working with debian relationships 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) debian-3.91.1/Debian/Relation/Text.hs0000644000000000000000000000133612775511355015452 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} -- |A module for working with debian relationships 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) debian-3.91.1/Debian/Relation/String.hs0000644000000000000000000000775612775511355016010 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, PackageImports, TypeSynonymInstances #-} {-# OPTIONS -fno-warn-unused-do-bind -fno-warn-orphans #-} -- |A module for working with debian relationships 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 debian-3.91.1/Debian/Version/0000755000000000000000000000000012775511355014037 5ustar0000000000000000debian-3.91.1/Debian/Version/Common.hs0000644000000000000000000001523612775511355015632 0ustar0000000000000000-- |A module for parsing, comparing, and (eventually) modifying debian version -- numbers. {-# 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) debian-3.91.1/Debian/Version/Internal.hs0000644000000000000000000000204112775511355016144 0ustar0000000000000000{-# 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) debian-3.91.1/Debian/Version/ByteString.hs0000644000000000000000000000074712775511355016475 0ustar0000000000000000{-# 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) debian-3.91.1/Debian/Version/Text.hs0000644000000000000000000000071112775511355015316 0ustar0000000000000000{-# 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) debian-3.91.1/Debian/Version/String.hs0000644000000000000000000000142212775511355015640 0ustar0000000000000000{-# 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 -> [] debian-3.91.1/Debian/Apt/0000755000000000000000000000000012775511355013136 5ustar0000000000000000debian-3.91.1/Debian/Apt/Package.hs0000644000000000000000000000453612775511355015035 0ustar0000000000000000{-# 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) debian-3.91.1/Debian/Apt/Index.hs0000644000000000000000000003353412775511355014551 0ustar0000000000000000{-# 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 debian-3.91.1/Debian/Apt/Dependencies.hs0000644000000000000000000002422212775511355016062 0ustar0000000000000000{-# 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 debian-3.91.1/Debian/Apt/Methods.hs0000644000000000000000000004674412775511355015114 0ustar0000000000000000{-# 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 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. 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) -} debian-3.91.1/Debian/Extra/0000755000000000000000000000000012775511355013475 5ustar0000000000000000debian-3.91.1/Debian/Extra/Files.hs0000644000000000000000000000227412775511355015100 0ustar0000000000000000{-# 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"