debian 3.40 → 3.46
raw patch · 19 files changed
+1116/−195 lines, 19 filesdep +HUnitdep +regex-tdfadep −regex-posixdep −sybdep ~Cabaldep ~parsecsetup-changed
Dependencies added: HUnit, regex-tdfa
Dependencies removed: regex-posix, syb
Dependency ranges changed: Cabal, parsec
Files
- Debian/Changes.hs +235/−53
- Debian/Control/ByteString.hs +7/−4
- Debian/Control/Common.hs +1/−0
- Debian/Control/String.hs +8/−6
- Debian/GenBuildDeps.hs +2/−2
- Debian/Relation/Common.hs +9/−10
- Debian/URI.hs +31/−4
- Debian/Util/FakeChanges.hs +8/−8
- Distribution/Package/Debian.hs +34/−27
- Distribution/Package/Debian/Bundled.hs +21/−8
- Setup.hs +10/−1
- Test/Changes.hs +212/−0
- Test/Dependencies.hs +180/−0
- Test/Main.hs +17/−0
- Test/SourcesList.hs +59/−0
- Test/VersionPolicy.hs +68/−0
- Test/Versions.hs +111/−0
- debian.cabal +103/−56
- tests/Main.hs +0/−16
Debian/Changes.hs view
@@ -7,8 +7,12 @@ , parseLog , parseEntry , parseChanges+ , prettyChanges+ , prettyChangesFile+ , prettyEntry ) where +import Data.Char (chr) import Data.List (intercalate) import Data.Maybe import qualified Debian.Control.String as S@@ -16,7 +20,8 @@ import Debian.URI() import Debian.Version import System.Posix.Types-import Text.Regex+import Text.Regex.TDFA+import Text.PrettyPrint.HughesPJ -- |A file generated by dpkg-buildpackage describing the result of a -- package build@@ -29,7 +34,7 @@ , changeInfo :: S.Paragraph -- ^ 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 -- |An entry in the list of files generated by the build. data ChangedFileSpec =@@ -40,91 +45,191 @@ , changedFileSection :: SubSection , changedFilePriority :: String , changedFileName :: FilePath- }+ } deriving Eq -- |A changelog is a series of ChangeLogEntries-data ChangeLogEntry = Entry { logPackage :: String- , logVersion :: DebianVersion- , logDists :: [ReleaseName]- , logUrgency :: String- , logComments :: String- , logWho :: String- , logDate :: String- }+data ChangeLogEntry =+ Entry { logPackage :: String+ , logVersion :: DebianVersion+ , logDists :: [ReleaseName]+ , logUrgency :: String+ , logComments :: String+ , logWho :: String+ , logDate :: String+ }+ | WhiteSpace String+ deriving Eq +{- instance Show ChangesFile where show = changesFileName+-} changesFileName :: ChangesFile -> String changesFileName changes = changePackage changes ++ "_" ++ show (changeVersion changes) ++ "_" ++ archName (changeArch changes) ++ ".changes" -instance Show ChangedFileSpec where- show file = changedFileMD5sum file ++ " " ++- show (changedFileSize file) ++ " " ++- sectionName (changedFileSection file) ++ " " ++- changedFilePriority file ++ " " ++- changedFileName file+prettyChangesFile :: ChangesFile -> Doc+prettyChangesFile = text . changesFileName -instance Show ChangeLogEntry where- show (Entry package version dists urgency details who date) =- package ++ " (" ++ show version ++ ") " ++ intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency ++ "\n\n" ++- details ++ " -- " ++ who ++ " " ++ date ++ "\n\n"+prettyChanges :: ChangedFileSpec -> Doc+prettyChanges file =+ text (changedFileMD5sum file ++ " " +++ show (changedFileSize file) ++ " " +++ sectionName (changedFileSection file) ++ " " +++ changedFilePriority file ++ " " +++ changedFileName file) +prettyEntry (Entry package version dists urgency details who date) =+ text (package ++ " (" ++ show version ++ ") " ++ intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency ++ "\n\n" +++ details ++ " -- " ++ who ++ " " ++ date ++ "\n\n")+ -- |Show just the top line of a changelog entry (for debugging output.)-showHeader :: ChangeLogEntry -> String+showHeader :: ChangeLogEntry -> Doc showHeader (Entry package version dists urgency _ _ _) =- package ++ " (" ++ show version ++ ") " ++ intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency ++ "..."+ text (package ++ " (" ++ show version ++ ") " ++ intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency ++ "...") +{-+format is a series of entries like this:++ package (version) distribution(s); urgency=urgency+ [optional blank line(s), stripped]+ * change details+ more change details+ [blank line(s), included in output of dpkg-parsechangelog]+ * even more change details+ [optional blank line(s), stripped]+ -- maintainer name <email address>[two spaces] date++package and version are the source package name and version number.++distribution(s) lists the distributions where this version should be+installed when it is uploaded - it is copied to the Distribution field+in the .changes file. See Distribution, Section 5.6.14.++urgency is the value for the Urgency field in the .changes file for+the upload (see Urgency, Section 5.6.17). It is not possible to+specify an urgency containing commas; commas are used to separate+keyword=value settings in the dpkg changelog format (though there is+currently only one useful keyword, urgency).++The change details may in fact be any series of lines starting with at+least two spaces, but conventionally each change starts with an+asterisk and a separating space and continuation lines are indented so+as to bring them in line with the start of the text above. Blank lines+may be used here to separate groups of changes, if desired.++If this upload resolves bugs recorded in the Bug Tracking System+(BTS), they may be automatically closed on the inclusion of this+package into the Debian archive by including the string: closes:+Bug#nnnnn in the change details.[16] This information is conveyed via+the Closes field in the .changes file (see Closes, Section 5.6.22).++The maintainer name and email address used in the changelog should be+the details of the person uploading this version. They are not+necessarily those of the usual package maintainer. The information+here will be copied to the Changed-By field in the .changes file (see+Changed-By, Section 5.6.4), and then later used to send an+acknowledgement when the upload has been installed.++The date must be in RFC822 format[17]; it must include the time zone+specified numerically, with the time zone name or abbreviation+optionally present as a comment in parentheses.++The first "title" line with the package name must start at the left+hand margin. The "trailer" line with the maintainer and date details+must be preceded by exactly one space. The maintainer details and the+date must be separated by exactly two spaces.++The entire changelog must be encoded in UTF-8. +-}+ -- |Parse a Debian Changelog and return a lazy list of entries-parseLog :: String -> [Either String ChangeLogEntry]+parseLog :: String -> [Either [String] ChangeLogEntry]+parseLog "" = [] parseLog text = case parseEntry text of- Nothing -> []- Just (Left message) -> [Left message]- Just (Right (entry, text')) -> Right entry : parseLog text'+ Left messages -> [Left messages]+ Right (entry, text') -> Right entry : parseLog text' -- |Parse a single changelog entry, returning the entry and the remaining text.-parseEntry :: String -> Maybe (Either String (ChangeLogEntry, String))-parseEntry text | dropWhile (\ x -> elem x " \t\n") text == "" = Nothing+{-+parseEntry :: String -> Failing (ChangeLogEntry, String) parseEntry text =- case matchRegexAll entryRE text of- Nothing -> Just (Left ("Parse error in changelog:\n" ++ text))- Just ("", _, remaining, [_, name, version, dists, urgency, _, details, _, _, _, _, _, who, date, _]) ->- let entry =- Entry name - (parseDebianVersion version)- (map parseReleaseName . words $ dists)- urgency- details- who- date in- Just (Right (entry, remaining))- Just ("", _, _remaining, submatches) -> Just (Left ("Internal error 15, submatches=" ++ show submatches))- Just (before, _, _, _) -> Just (Left ("Parse error in changelog at:\n" ++ show before ++ "\nin:\n" ++ text))+ case span (\ x -> elem x " \t\n") text of+ ("", _) ->+ case matchRegexAll entryRE text of+ Nothing -> Failure ["Parse error in changelog:\n" ++ show text]+ Just ("", _, remaining, [_, name, version, dists, urgency, _, details, _, _, _, _, _, who, date, _]) ->+ Success (Entry name + (parseDebianVersion version)+ (map parseReleaseName . words $ dists)+ urgency+ details+ who+ date,+ remaining)+ Just (before, _, remaining, submatches) ->+ Failure ["Internal error:\n text=" ++ show text ++ "\n before=" ++ show before ++ "\n remaining=" ++ show remaining ++ ", submatches=" ++ show submatches]+ (w, text') -> Success (WhiteSpace (trace ("whitespace: " ++ show w) w), text')+-}++parseEntry :: String -> Either [String] (ChangeLogEntry, String)+parseEntry text =+ case text =~ entryRE :: MatchResult String of+ x | mrSubList x == [] -> Left ["Parse error at " ++ show text]+ x@MR {mrAfter = after, mrSubList = [_, name, version, dists, urgency, _, details, _, _, who, _, date, _]} ->+ Right (Entry name + (parseDebianVersion version)+ (map parseReleaseName . words $ dists)+ urgency+ details+ (take (length who - 2) who)+ date,+ after)+ x@MR {mrBefore = before, mrMatch = matched, mrAfter = after, mrSubList = matches} ->+ Left ["Internal error\n after=" ++ show after ++ "\n " ++ show (length matches) ++ " matches: " ++ show matches]+{-+parseREs :: [Regex] -> String -> Failing ([String], String)+parseREs res text =+ foldr f (Success ([], text)) entryREs where- entryRE = mkRegex $ bol ++ blankLines ++ headerRE ++ nonSigLines ++ blankLines ++ signature ++ blankLines- nonSigLines = "((( .*|\t.*| \t.*)|([ \t]*)\n)+)"- -- In the debian repository, sometimes the extra space in front of the- -- day-of-month is missing, sometimes an extra one is added.- signature = "( -- ([^\n]*) (..., ? ?.. ... .... ........ .....))[ \t]*\n"+ f _ (Failure msgs) = Failure msgs+ f re (Success (oldMatches, text)) =+ case matchRegexAll re text of+ Nothing -> Failure ["Parse error at " ++ show text]+ Just (before, matched, after, newMatches) ->+ Success (oldMatches ++ trace ("newMatches=" ++ show newMatches) newMatches, after)+-} +entryRE = bol ++ blankLines ++ headerRE ++ changeDetails ++ signature ++ blankLines+changeDetails = "((\n| \n| -\n|([^ ]| [^--]| -[^--])[^\n]*\n)*)"+signature = " -- ([ ]*([^ ]+ )* )([^\n]*)\n"++{-+entryRE = mkRegexWithOpts (bol ++ blankLines ++ headerRE ++ nonSigLines ++ blankLines ++ signature ++ blankLines) False True+nonSigLines = "((( .*|\t.*| \t.*)|([ \t]*)\n)+)"+-- In the debian repository, sometimes the extra space in front of the+-- day-of-month is missing, sometimes an extra one is added.+signature = "( -- ([^\n]*) (..., ? ?.. ... .... ........ .....))[ \t]*\n"+-}+ -- |Parse the changelog information that shows up in the .changes -- file, i.e. a changelog entry with no signature. parseChanges :: String -> Maybe ChangeLogEntry parseChanges text =- case matchRegex changesRE text of- Nothing -> Nothing- Just [_, name, version, dists, urgency, _, details] ->+ case text =~ changesRE :: MatchResult String of+ MR {mrSubList = []} -> Nothing+ MR {mrSubList = [_, name, version, dists, urgency, _, details]} -> Just $ Entry name (parseDebianVersion version) (map parseReleaseName . words $ dists) urgency details "" ""- Just x -> error $ "Unexpected match: " ++ show x+ MR {mrSubList = x} -> error $ "Unexpected match: " ++ show x where- changesRE = mkRegexWithOpts (bol ++ blankLines ++ optWhite ++ headerRE ++ "(.*)$") False False+ changesRE = bol ++ blankLines ++ optWhite ++ headerRE ++ "(.*)$" headerRE = package ++ version ++ dists ++ urgency@@ -138,3 +243,80 @@ blankLine = "(" ++ optWhite ++ "\n)" optWhite = "[ \t]*" bol = "^"++s1 = intercalate "\n" + ["haskell-regex-compat (0.92-3+seereason1~jaunty4) jaunty-seereason; urgency=low",+ "",+ " [ Joachim Breitner ]",+ " * Adjust priority according to override file",+ " * Depend on hscolour (Closes: #550769)",+ "",+ " [ Marco Túlio Gontijo e Silva ]",+ " * debian/control: Use more sintetic name for Vcs-Darcs.",+ " * Built from sid apt pool",+ " * Build dependency changes:",+ " cpphs: 1.9-1+seereason1~jaunty5 -> 1.9-1+seereason1~jaunty6",+ " ghc6: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1",+ " ghc6-doc: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1",+ " ghc6-prof: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1",+ " haddock: 2.4.2-3+seereason3~jaunty1 -> 6.12.1-0+seereason1~jaunty1",+ " haskell-devscripts: 0.6.18-21+seereason1~jaunty1 -> 0.6.18-23+seereason1~jaunty1",+ " haskell-regex-base-doc: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1",+ " haskell-regex-posix-doc: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2",+ " libghc6-regex-base-dev: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1",+ " libghc6-regex-base-prof: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1",+ " libghc6-regex-posix-dev: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2",+ " libghc6-regex-posix-prof: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2",+ "",+ " -- SeeReason Autobuilder <autobuilder@seereason.org> Fri, 25 Dec 2009 01:55:37 -0800",+ "",+ "haskell-regex-compat (0.92-3) unstable; urgency=low",+ "",+ " [ Joachim Breitner ]",+ " * Adjust priority according to override file",+ " * Depend on hscolour (Closes: #550769)",+ "",+ " [ Marco Túlio Gontijo e Silva ]",+ " * debian/control: Use more sintetic name for Vcs-Darcs.",+ "",+ " -- Joachim Breitner <nomeata@debian.org> Mon, 20 Jul 2009 13:05:35 +0200",+ "",+ "haskell-regex-compat (0.92-2) unstable; urgency=low",+ "",+ " * Adopt package for the Debian Haskell Group",+ " * Fix \"FTBFS with new dpkg-dev\" by adding comma to debian/control",+ " (Closes: #536473)",+ "",+ " -- Joachim Breitner <nomeata@debian.org> Mon, 20 Jul 2009 12:05:40 +0200",+ "",+ "haskell-regex-compat (0.92-1.1) unstable; urgency=low",+ "",+ " * Rebuild for GHC 6.10.",+ " * NMU with permission of the author.",+ "",+ " -- John Goerzen <jgoerzen@complete.org> Mon, 16 Mar 2009 10:12:04 -0500",+ "",+ "haskell-regex-compat (0.92-1) unstable; urgency=low",+ "",+ " * New upstream release",+ " * debian/control:",+ " - Bump Standards-Version. No changes needed.",+ "",+ " -- Arjan Oosting <arjan@debian.org> Sun, 18 Jan 2009 00:05:02 +0100",+ "",+ "haskell-regex-compat (0.91-1) unstable; urgency=low",+ "",+ " * Take over package from Ian, as I already maintain haskell-regex-base,",+ " and move Ian to the Uploaders field.",+ " * Packaging complete redone (based on my haskell-regex-base package).",+ "",+ " -- Arjan Oosting <arjan@debian.org> Sat, 19 Jan 2008 16:48:39 +0100",+ "",+ "haskell-regex-compat (0.71.0.1-1) unstable; urgency=low",+ " ",+ " * Initial release (used to be part of ghc6).",+ " * Using \"Generic Haskell cabal library packaging files v9\".",+ " ",+ " -- Ian Lynagh (wibble) <igloo@debian.org> Wed, 21 Nov 2007 01:26:57 +0000",+ " ",+ ""]
Debian/Control/ByteString.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} module Debian.Control.ByteString ( Control'(..) , Paragraph'(..)@@ -19,9 +20,10 @@ -- Standard GHC modules +import qualified Control.Exception as E import Control.Monad.State -import Data.Char(chr,ord)+import Data.Char(chr,ord,toLower) import Data.List import Data.Maybe import Data.Word@@ -122,14 +124,15 @@ Nothing -> return (Left (newErrorMessage (Message ("Failed to parse " ++ fp)) (newPos fp 0 0))) (Just (cntl,_)) -> return (Right cntl) parseControlFromHandle sourceName handle =- C.hGetContents handle >>= return . parseControl sourceName+ 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 fieldName in- find (\ (Field (fieldName',_)) -> fieldName' == pFieldName) 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")
Debian/Control/Common.hs view
@@ -28,6 +28,7 @@ newtype Paragraph' a = Paragraph [Field' a]+ deriving Eq -- |NOTE: we do not strip the leading or trailing whitespace in the -- name or value
Debian/Control/String.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-} module Debian.Control.String ( -- * Types Control'(..)@@ -22,7 +22,8 @@ , raiseFields ) where -import Control.Monad+import qualified Control.Exception as E +import Data.Char (toLower) import Data.List import Text.ParserCombinators.Parsec import System.IO@@ -49,13 +50,14 @@ parseControlFromFile filepath = parseFromFile pControl filepath parseControlFromHandle sourceName handle = - hGetContents handle >>= return . parseControl sourceName+ 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 paragraph- where hasFieldName (Field (fieldName',_)) = fieldName == fieldName'- hasFieldName _ = False+ 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") asString = id
Debian/GenBuildDeps.hs view
@@ -115,7 +115,7 @@ -- list of packages, return a triple: One ready package, the packages -- that depend on the ready package directly or indirectly, and all -- the other packages.-buildable :: Show a => (a -> a -> Ordering) -> [a] -> BuildableInfo a+buildable :: (a -> a -> Ordering) -> [a] -> BuildableInfo a buildable cmp packages = -- Find all packages which can't reach any other packages in the -- graph of the "has build dependency" relation.@@ -228,7 +228,7 @@ -- |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--- fp\/*\/debian\/control. It returns a list with the packages in the+-- debian\/control. It returns a list with the packages in the -- order they should be built. getSourceOrder :: FilePath -> IO (Either String [SrcPkgName]) getSourceOrder fp =
Debian/Relation/Common.hs view
@@ -4,6 +4,7 @@ import Data.List import Text.ParserCombinators.Parsec+import Data.Function -- Local Modules @@ -63,17 +64,15 @@ show (GRE v) = " (>= " ++ show v ++ ")" show (SGR v) = " (>> " ++ show v ++ ")" --- |@FIXME:@ This instance is currently incomplete and only handles the case--- where two version requirements are equal.+-- |The sort order is based on version number first, then on the kind of+-- relation, sorting in the order <<, <= , ==, >= , >> instance Ord VersionReq where- compare r1 r2 =- if r1 == r2 - then EQ - else- case (r1, r2) of- (EEQ v1, EEQ v2) -> compare v1 v2- (a,b) -> error $ "Ord VersionReq does not handle (" ++ show a ++", "++ show b++")"-+ compare = compare `on` extr+ where extr (SLT v) = (v,0)+ extr (LTE v) = (v,1)+ extr (EEQ v) = (v,2)+ extr (GRE v) = (v,3)+ extr (SGR v) = (v,4) -- |Check if a version number satisfies a version requirement. checkVersionReq :: Maybe VersionReq -> Maybe DebianVersion -> Bool
Debian/URI.hs view
@@ -3,12 +3,14 @@ , URIString , uriToString' , fileFromURI+ , fileFromURIStrict , dirFromURI ) where -import Control.OldException (Exception(..), try)+import Control.Exception (ErrorCall(ErrorCall), try) --import Control.Monad.Trans (MonadIO) import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString as B import Data.Maybe (catMaybes) import Network.URI import System.Directory (getDirectoryContents)@@ -24,7 +26,7 @@ -- |If the URI type could be read and showed this wouldn't be necessary. type URIString = String -fileFromURI :: URI -> IO (Either Exception L.ByteString)+fileFromURI :: URI -> IO (Either ErrorCall L.ByteString) fileFromURI uri = case (uriScheme uri, uriAuthority uri) of ("file:", Nothing) -> try (L.readFile (uriPath uri))@@ -32,6 +34,14 @@ " cat " ++ show (uriPath uri)) _ -> cmdOutput ("curl -s -g '" ++ uriToString' uri ++ "'") +fileFromURIStrict :: URI -> IO (Either ErrorCall B.ByteString)+fileFromURIStrict uri =+ case (uriScheme uri, uriAuthority uri) of+ ("file:", Nothing) -> try (B.readFile (uriPath uri))+ ("ssh:", Just auth) -> cmdOutputStrict ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth +++ " cat " ++ show (uriPath uri))+ _ -> cmdOutputStrict ("curl -s -g '" ++ uriToString' uri ++ "'")+ -- | 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@@ -45,7 +55,7 @@ second _ = Nothing -dirFromURI :: URI -> IO (Either Exception [String])+dirFromURI :: URI -> IO (Either ErrorCall [String]) dirFromURI uri = case (uriScheme uri, uriAuthority uri) of ("file:", Nothing) -> try (getDirectoryContents (uriPath uri))@@ -56,10 +66,27 @@ -cmdOutput :: String -> IO (Either Exception L.ByteString)+cmdOutput :: String -> IO (Either ErrorCall L.ByteString) cmdOutput cmd = do (out, _err, code) <- lazyCommand cmd L.empty >>= return . collectOutput case code of (ExitSuccess : _) -> return (Right out) (ExitFailure _ : _) -> return . Left . ErrorCall $ "Failure: " ++ show cmd [] -> return . Left . ErrorCall $ "Failure: no exit code"++cmdOutputStrict :: String -> IO (Either ErrorCall B.ByteString)+cmdOutputStrict cmd =+ do (out, _err, code) <- lazyCommand cmd L.empty >>= return . f . collectOutput+ case code of+ (ExitSuccess : _) -> return (Right out)+ (ExitFailure _ : _) -> return . Left . ErrorCall $ "Failure: " ++ show cmd+ [] -> return . Left . ErrorCall $ "Failure: no exit code"+ where+ f :: (L.ByteString, L.ByteString, [ExitCode]) -> (B.ByteString, B.ByteString, [ExitCode])+ f (o, e, c) = (toStrict o, toStrict e, c)++toLazy :: B.ByteString -> L.ByteString+toLazy b = L.fromChunks [b]++toStrict :: L.ByteString -> B.ByteString+toStrict b = B.concat (L.toChunks b)
Debian/Util/FakeChanges.hs view
@@ -1,19 +1,19 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-} module Debian.Util.FakeChanges (fakeChanges) where --import Control.Arrow-import Control.OldException+import Control.Exception import Control.Monad hiding (mapM) import Data.Foldable import Data.List hiding (concat, foldr, all) import Data.Maybe --import Data.Typeable-import Data.Generics+import Data.Data (Data, Typeable) import Data.Traversable import Debian.Time import System.Environment import System.Posix.Files-import Text.Regex.Posix+import Text.Regex.TDFA import Prelude hiding (catch, concat, foldr, all, mapM) import Network.BSD @@ -235,20 +235,20 @@ do dfn <- try (getEnv "DEBFULLNAME") case dfn of (Right n) -> return n- (Left _) ->+ (Left (_ :: SomeException)) -> do dfn <-try (getEnv "USER") case dfn of (Right n) -> return n- (Left _) -> error $ "Could not determine user name, neither DEBFULLNAME nor USER enviroment variables were set."+ (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 _) ->+ (Left (_ :: SomeException)) -> do eml <- try (getEnv "EMAIL") case eml of (Right e) -> return e- (Left _) -> getHostName -- FIXME: this is not a FQDN+ (Left (_ :: SomeException)) -> getHostName -- FIXME: this is not a FQDN return $ debFullName ++ " <" ++ emailAddr ++ ">" -- * Utils
Distribution/Package/Debian.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, TypeSynonymInstances #-}+{-# LANGUAGE CPP, ScopedTypeVariables, TypeSynonymInstances #-} -- | -- Module : Distribution.Package.Debian@@ -17,7 +17,7 @@ ( debian ) where -import Control.OldException (try, bracket)+import Control.Exception (SomeException, try, bracket) import Control.Monad (when,mplus) import qualified Data.ByteString.Lazy.Char8 as L import Data.Char (toLower, isSpace)@@ -28,7 +28,7 @@ import Debian.Control import qualified Debian.Relation as D import Debian.Release (parseReleaseName)-import Debian.Changes (ChangeLogEntry(..))+import Debian.Changes (ChangeLogEntry(..), prettyEntry) import Debian.Time (getCurrentLocalRFC822Time) import Debian.Version import Debian.Version.String@@ -44,13 +44,13 @@ import Distribution.Text (display) import Distribution.Simple.Compiler (CompilerFlavor(..), compilerFlavor, Compiler(..)) --import Distribution.Simple.Configure (localBuildInfoFile)-import Distribution.System (buildOS, buildArch)+import Distribution.System (Platform(..), buildOS, buildArch) import Distribution.License (License(..)) import Distribution.Package (Package(..), PackageIdentifier(..), PackageName(..), Dependency(..)) import Distribution.Simple.Program (defaultProgramConfiguration) import Distribution.Simple.Configure (configCompiler, maybeGetPersistBuildConfig) import Distribution.Simple.InstallDirs (InstallDirs(..), InstallDirTemplates, toPathTemplate)-import Distribution.Simple.Register (writeInstalledConfig)+--import Distribution.Simple.Register (writeInstalledConfig) --import Distribution.Simple.Setup (defaultRegisterFlags) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..)) import Distribution.Simple.PackageIndex (PackageIndex,fromList)@@ -68,6 +68,7 @@ import Distribution.Package.Debian.Bundled import qualified Distribution.Compat.ReadP as ReadP import Distribution.Text ( Text(parse) )+import Text.PrettyPrint.HughesPJ parsePackageId' :: ReadP.ReadP PackageIdentifier PackageIdentifier parsePackageId' = parseQuoted parse ReadP.<++ parse@@ -99,7 +100,8 @@ trim = dropWhile isSpace --- installedPackages :: Package pkg => IO [PackageIndex pkg]+--installedPackages :: Package pkg => IO [PackageIndex]+{- installedPackages = do (out, err, code) <- lazyCommand cmd L.empty >>= return . collectOutputUnpacked case code of@@ -107,6 +109,7 @@ result -> error $ "Failure: " ++ cmd ++ " -> " ++ show result ++ " (" ++ err ++ ")" where cmd = "ghc-pkg list --simple-output"+-} simplePackageDescription :: GenericPackageDescription -> Flags -> IO (Compiler, PackageDescription)@@ -114,10 +117,11 @@ (compiler, _) <- configCompiler (Just (rpmCompiler flags)) Nothing Nothing defaultProgramConfiguration (rpmVerbosity flags)- installed <- installedPackages+ --installed <- installedPackages case finalizePackageDescription (rpmConfigurationsFlags flags)- (Nothing :: Maybe (PackageIndex PackageIdentifier))- buildOS buildArch (compilerId compiler) [] genPkgDesc of+ (const True) (Platform buildArch buildOS) (compilerId compiler)+ {- (Nothing :: Maybe PackageIndex) -}+ [] genPkgDesc of Left e -> die $ "finalize failed: " ++ show e Right (pd, _) -> return (compiler, pd) @@ -159,6 +163,7 @@ ExitSuccess -> return () ExitFailure n -> die ("autoreconf failed with status " ++ show n) +{- localBuildInfo :: PackageDescription -> Flags -> IO LocalBuildInfo localBuildInfo pkgDesc flags = maybeGetPersistBuildConfig defaultDistPref >>=@@ -174,6 +179,7 @@ if isNothing (library pkgDesc) then error "cabal-debian - Unsupported: package without a library section" else writeInstalledConfig defaultDistPref pkgDesc lbi False Nothing >> return lbi+-} data PackageInfo = PackageInfo { libDir :: FilePath , cabalName :: String@@ -209,7 +215,7 @@ -- haskell-cabal-debian-doc.substvars: -- haskell:Depends=ghc6-doc, haddock (>= 2.1.0), haddock (<< 2.1.0-999) ([], Just path') ->- do old <- try (readFile path') >>= return . either (const "") id+ do old <- try (readFile path') >>= return . either (\ (_ :: SomeException) -> "") id let new = addDeps old hPutStrLn stderr (if new /= old then ("cabal-debian - Updated " ++ show path' ++ ":\n " ++ old ++ "\n ->\n " ++ new)@@ -282,10 +288,10 @@ -- order to compute the text argument. replaceFile :: FilePath -> String -> IO () replaceFile path text =- try (removeFile back) >> -- This may not exist- try (renameFile path back) >> -- This may not exist- try (writeFile path text) >>= -- This must succeed- either (\ e -> error ("writeFile " ++ show path ++ ": " ++ show e)) return+ try (removeFile back >> -- This may not exist+ renameFile path back >> -- This may not exist+ writeFile path text) >>= -- This must succeed+ either (\ (e :: SomeException) -> error ("writeFile " ++ show path ++ ": " ++ show e)) return where back = path ++ "~" @@ -298,7 +304,7 @@ mapM (packageInfo compiler debVersions) (a ++ b) >>= return . catMaybes | True = error $ "Can't handle compiler flavor: " ++ show (compilerFlavor compiler) where- getDirPaths path = try (getDirectoryContents path) >>= return . map (\ x -> (path, x)) . either (const []) id+ getDirPaths path = try (getDirectoryContents path) >>= return . map (\ x -> (path, x)) . either (\ (_ :: SomeException) -> []) id packageInfo :: Compiler -> DebMap -> (FilePath, String) -> IO (Maybe PackageInfo) packageInfo compiler debVersions (d, f) =@@ -391,7 +397,7 @@ do createDirectoryIfMissing True "debian" date <- getCurrentLocalRFC822Time copyright <- try (readFile (licenseFile pkgDesc)) >>= - return . either (const . showLicense . license $ pkgDesc) id+ return . either (\ (_ :: SomeException) -> showLicense . license $ pkgDesc) id debianMaintainer <- getDebianMaintainer flags >>= maybe (error "Missing value for --maintainer") return controlUpdate (tgtPfx </> "control") flags compiler debianMaintainer pkgDesc changelogUpdate (tgtPfx </> "changelog") debianMaintainer pkgDesc date@@ -479,7 +485,7 @@ controlUpdate path flags compiler debianMaintainer pkgDesc = builtIns compiler >>= \bundled -> try (readFile path) >>=- either (\ _ -> writeFile path (show (newCtl bundled))) (\ s -> writeFile (path ++ ".new") $! show (merge (newCtl bundled) (oldCtl s)))+ either (\ (_ :: SomeException) -> writeFile path (show (newCtl bundled))) (\ s -> writeFile (path ++ ".new") $! show (merge (newCtl bundled) (oldCtl s))) where newCtl bundled = control flags bundled compiler debianMaintainer pkgDesc oldCtl s = either (const (Control [])) id (parseControl "debian/control" s)@@ -656,19 +662,20 @@ changelogUpdate :: FilePath -> String -> PackageDescription -> String -> IO () changelogUpdate path debianMaintainer pkgDesc date =- try (readFile path) >>= either (const (writeFile path log)) (const (writeFile (path ++ ".new") log))+ try (readFile path) >>= either (\ (_ :: SomeException) -> writeFile path log) (const (writeFile (path ++ ".new") log)) where log = changelog debianMaintainer pkgDesc date changelog :: String -> PackageDescription -> String -> String changelog debianMaintainer pkgDesc date =- show (Entry { logPackage = debianSourcePackageName pkgDesc- , logVersion = debianVersionNumber pkgDesc- , logDists = [parseReleaseName "unstable"]- , logUrgency = "low"- , logComments = " * Debianization generated by cabal-debian\n\n"- , logWho = debianMaintainer- , logDate = date })+ render (prettyEntry+ (Entry { logPackage = debianSourcePackageName pkgDesc+ , logVersion = debianVersionNumber pkgDesc+ , logDists = [parseReleaseName "unstable"]+ , logUrgency = "low"+ , logComments = " * Debianization generated by cabal-debian\n\n"+ , logWho = debianMaintainer+ , logDate = date })) unPackageName :: PackageName -> String unPackageName (PackageName s) = s@@ -761,8 +768,8 @@ -- taken from TagsCheck.py in the rpmlint distribution. showLicense :: License -> String-showLicense GPL = "GPL"-showLicense LGPL = "LGPL"+showLicense (GPL _) = "GPL"+showLicense (LGPL _) = "LGPL" showLicense BSD3 = "BSD" showLicense BSD4 = "BSD-like" showLicense PublicDomain = "Public Domain"
Distribution/Package/Debian/Bundled.hs view
@@ -30,7 +30,7 @@ import Debian.Control(Control'(Control), fieldValue, parseControlFromFile) import Debian.Relation.ByteString() import Debian.Relation(Relation(Rel),parseRelations)-import Distribution.InstalledPackageInfo(InstalledPackageInfo, libraryDirs, package)+import Distribution.InstalledPackageInfo(InstalledPackageInfo, libraryDirs, sourcePackageId) import Distribution.Simple.Compiler (Compiler(..), CompilerId(..), CompilerFlavor(..), PackageDB(GlobalPackageDB), compilerFlavor) import Distribution.Simple.Configure (getInstalledPackages) -- import Distribution.Simple.GHC (getInstalledPackages)@@ -40,7 +40,7 @@ import Distribution.Verbosity(normal) import Distribution.Version (withinRange) import Text.ParserCombinators.Parsec(ParseError)-import Text.Regex.Posix ((=~))+import Text.Regex.TDFA ((=~)) -- | List the packages bundled with this version of the given -- compiler. If the answer is not known, return the empty list.@@ -75,13 +75,20 @@ ] ghc6BuiltIns :: Compiler -> IO (Maybe (CompilerFlavor, Version, [PackageIdentifier])) ghc6BuiltIns compiler@(Compiler (CompilerId GHC compilerVersion) _) =+#ifdef CABAL19+ do installedPackages <- getInstalledPackageIndex compiler+ ghc6Files <- fmap lines $ readFile "/var/lib/dpkg/info/ghc6.list"+ let ghcProvides = filter (\package -> any (\dir -> elem dir ghc6Files) (libraryDirs package)) (allPackages installedPackages)+ return (Just (GHC, compilerVersion, map sourcePackageId ghcProvides))+#else do mInstalledPackages <- getInstalledPackageIndex compiler case mInstalledPackages of Nothing -> error "Could not find the installed package database." (Just installedPackages) -> do ghc6Files <- fmap lines $ readFile "/var/lib/dpkg/info/ghc6.list" let ghcProvides = filter (\package -> any (\dir -> elem dir ghc6Files) (libraryDirs package)) (allPackages installedPackages)- return (Just (GHC, compilerVersion, map package ghcProvides))+ return (Just (GHC, compilerVersion, map sourcePackageId ghcProvides))+#endif ghc6BuiltIns _ = return Nothing ghc6BuiltIns' :: Compiler -> IO (Maybe (CompilerFlavor, Version, [PackageIdentifier]))@@ -90,6 +97,11 @@ case eDebs of Left e -> error e Right debNames ->+#ifdef CABAL19+ do installedPackages <- getInstalledPackageIndex compiler+ let packages = concatMap (\n -> fromRight $ installedVersions (fromRight $ extractBaseName n) installedPackages) debNames+ return $ Just (GHC, compilerVersion, packages)+#else do mInstalledPackages <- getInstalledPackageIndex compiler case mInstalledPackages of Nothing -> error "Could not find the installed package database."@@ -97,6 +109,7 @@ let packages = concatMap (\n -> fromRight $ installedVersions (fromRight $ extractBaseName n) installedPackages) debNames in return $ Just (GHC, compilerVersion, packages)+#endif where fromRight (Right r) = r fromRight (Left e) = error e@@ -127,19 +140,19 @@ [base] -> Right base _ -> Left ("When attempt to extract the base name of " ++ name ++ " I found the following matches: " ++ show subs) -getInstalledPackageIndex :: Compiler -> IO (Maybe (PackageIndex InstalledPackageInfo))+--getInstalledPackageIndex :: Compiler -> IO (Maybe PackageIndex) getInstalledPackageIndex compiler = do pc <- configureAllKnownPrograms normal defaultProgramConfiguration- getInstalledPackages normal compiler GlobalPackageDB pc+ getInstalledPackages normal compiler [GlobalPackageDB] pc -installedVersions :: String -> PackageIndex InstalledPackageInfo -> Either String [PackageIdentifier]+installedVersions :: String -> PackageIndex -> Either String [PackageIdentifier] installedVersions name packageIndex = case searchByName packageIndex name of None -> Left $ "The package " ++ name ++ " does not seem to be installed." Unambiguous pkgs -> - case sortBy (compare `on` (pkgVersion . package)) pkgs of+ case sortBy (compare `on` (pkgVersion . sourcePackageId)) pkgs of [] -> Left $ "Odd. searchByName returned an empty Unambiguous match for " ++ name- ps -> Right (map package ps)+ ps -> Right (map sourcePackageId ps) v :: String -> [Int] -> PackageIdentifier v n x = PackageIdentifier (PackageName n) (Version x [])
Setup.hs view
@@ -1,5 +1,14 @@ #!/usr/bin/runhaskell import Distribution.Simple+import Distribution.Simple.Program+import System.Cmd+import System.Exit -main = defaultMainWithHooks simpleUserHooks+main = defaultMainWithHooks simpleUserHooks {+ runTests = runTestScript+ }++runTestScript _args _flag _pd _lbi =+ system "runhaskell Test/Main.hs" >>=+ \ code -> if code == ExitSuccess then return () else error "Test Failure"
+ Test/Changes.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE StandaloneDeriving #-}+module Test.Changes where++import Test.HUnit+import Data.List (intercalate)+import Debian.Changes+import Debian.Release (ReleaseName(ReleaseName, relName))+import Debian.Version (parseDebianVersion)++deriving instance Show ChangeLogEntry++s3 = intercalate "\n" + ["name (version) dist; urgency=urgency",+ " * details",+ " -- David Fox <dsf@seereason.com> Wed, 21 Nov 2007 01:26:57 +0000",+ ""]++s4 = intercalate "\n" + ["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 <dsf@seereason.com> Wed, 21 Nov 2007 01:26:57 +0000",+ ""]++s1 = intercalate "\n" + ["haskell-regex-compat (0.92-3+seereason1~jaunty4) jaunty-seereason; urgency=low",+ "",+ " [ Joachim Breitner ]",+ " * Adjust priority according to override file",+ " * Depend on hscolour (Closes: #550769)",+ "",+ " [ Marco Túlio Gontijo e Silva ]",+ " * debian/control: Use more sintetic name for Vcs-Darcs.",+ " * Built from sid apt pool",+ " * Build dependency changes:",+ " cpphs: 1.9-1+seereason1~jaunty5 -> 1.9-1+seereason1~jaunty6",+ " ghc6: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1",+ " ghc6-doc: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1",+ " ghc6-prof: 6.10.4-1+seereason5~jaunty1 -> 6.12.1-0+seereason1~jaunty1",+ " haddock: 2.4.2-3+seereason3~jaunty1 -> 6.12.1-0+seereason1~jaunty1",+ " haskell-devscripts: 0.6.18-21+seereason1~jaunty1 -> 0.6.18-23+seereason1~jaunty1",+ " haskell-regex-base-doc: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1",+ " haskell-regex-posix-doc: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2",+ " libghc6-regex-base-dev: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1",+ " libghc6-regex-base-prof: 0.93.1-5+seereason1~jaunty1 -> 0.93.1-5++1+seereason1~jaunty1",+ " libghc6-regex-posix-dev: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2",+ " libghc6-regex-posix-prof: 0.93.2-4+seereason1~jaunty1 -> 0.93.2-4+seereason1~jaunty2",+ "",+ " -- SeeReason Autobuilder <autobuilder@seereason.org> Fri, 25 Dec 2009 01:55:37 -0800",+ "",+ "haskell-regex-compat (0.92-3) unstable; urgency=low",+ "",+ " [ Joachim Breitner ]",+ " * Adjust priority according to override file",+ " * Depend on hscolour (Closes: #550769)",+ "",+ " [ Marco Túlio Gontijo e Silva ]",+ " * debian/control: Use more sintetic name for Vcs-Darcs.",+ "",+ " -- Joachim Breitner <nomeata@debian.org> Mon, 20 Jul 2009 13:05:35 +0200",+ "",+ "haskell-regex-compat (0.92-2) unstable; urgency=low",+ "",+ " * Adopt package for the Debian Haskell Group",+ " * Fix \"FTBFS with new dpkg-dev\" by adding comma to debian/control",+ " (Closes: #536473)",+ "",+ " -- Joachim Breitner <nomeata@debian.org> Mon, 20 Jul 2009 12:05:40 +0200",+ "",+ "haskell-regex-compat (0.92-1.1) unstable; urgency=low",+ "",+ " * Rebuild for GHC 6.10.",+ " * NMU with permission of the author.",+ "",+ " -- John Goerzen <jgoerzen@complete.org> Mon, 16 Mar 2009 10:12:04 -0500",+ "",+ "haskell-regex-compat (0.92-1) unstable; urgency=low",+ "",+ " * New upstream release",+ " * debian/control:",+ " - Bump Standards-Version. No changes needed.",+ "",+ " -- Arjan Oosting <arjan@debian.org> Sun, 18 Jan 2009 00:05:02 +0100",+ "",+ "haskell-regex-compat (0.91-1) unstable; urgency=low",+ "",+ " * Take over package from Ian, as I already maintain haskell-regex-base,",+ " and move Ian to the Uploaders field.",+ " * Packaging complete redone (based on my haskell-regex-base package).",+ "",+ " -- Arjan Oosting <arjan@debian.org> Sat, 19 Jan 2008 16:48:39 +0100",+ "",+ "haskell-regex-compat (0.71.0.1-1) unstable; urgency=low",+ " ",+ " * Initial release (used to be part of ghc6).",+ " * Using \"Generic Haskell cabal library packaging files v9\".",+ " ",+ " -- Ian Lynagh (wibble) <igloo@debian.org> Wed, 21 Nov 2007 01:26:57 +0000",+ " ",+ ""]++s2 = intercalate "\n"+ ["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 <autobuilder@seereason.org> 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 <marcot@holoscopio.com> 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 <marcot@holoscopio.com> Wed, 11 Mar 2009 18:58:06 -0300",+ "",+ ""]++test3 =+ TestCase (assertEqual "haskell-regex-compat changelog" expected (parseLog s3))+ where expected = [Right (Entry {logPackage = "name", logVersion = parseDebianVersion "version", logDists = [ReleaseName {relName = "dist"}], logUrgency = "urgency", logComments = " * details\n", logWho = "David Fox <dsf@seereason.com>", logDate = "Wed, 21 Nov 2007 01:26:57 +0000"})]++test4 =+ TestCase (assertEqual "haskell-regex-compat changelog" expected (parseLog 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\n",+ logWho = "David Fox <dsf@seereason.com>",+ logDate = "Wed, 21 Nov 2007 01:26:57 +0000"})]++test1 =+ TestCase (assertEqual "haskell-regex-compat changelog" expected (parseLog s1))+ 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 * 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\n", logWho = "SeeReason Autobuilder <autobuilder@seereason.org>", logDate = "Fri, 25 Dec 2009 01:55:37 -0800"}),+ Right (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\n", logWho = "Joachim Breitner <nomeata@debian.org>", logDate = "Mon, 20 Jul 2009 13:05:35 +0200"}),+ Right (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\n", logWho = "Joachim Breitner <nomeata@debian.org>", logDate = "Mon, 20 Jul 2009 12:05:40 +0200"}),+ Right (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\n", logWho = "John Goerzen <jgoerzen@complete.org>", logDate = "Mon, 16 Mar 2009 10:12:04 -0500"}),+ Right (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\n", logWho = "Arjan Oosting <arjan@debian.org>", logDate = "Sun, 18 Jan 2009 00:05:02 +0100"}),+ Right (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\n", logWho = "Arjan Oosting <arjan@debian.org>", logDate = "Sat, 19 Jan 2008 16:48:39 +0100"}),+ Right (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 \n", logWho = "Ian Lynagh (wibble) <igloo@debian.org>", logDate = "Wed, 21 Nov 2007 01:26:57 +0000"})]++test2 =+ TestCase (assertEqual "haskell-regex-compat changelog" expected (parseLog 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\n",+ logWho = "SeeReason Autobuilder <autobuilder@seereason.org>",+ 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\n",+ logWho = "Marco T\250lio Gontijo e Silva <marcot@holoscopio.com>",+ 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\n",+ logWho = "Marco T\250lio Gontijo e Silva <marcot@holoscopio.com>",+ logDate = "Wed, 11 Mar 2009 18:58:06 -0300"})]++changesTests = [test3, test4, test1, test2]
+ Test/Dependencies.hs view
@@ -0,0 +1,180 @@+module Test.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)] -> String+ getName p = case lookup "Package" p of Nothing -> error "Missing Package field" ; (Just n) -> 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)] -> [String]+ providesF p =+ case lookup "Provides" p of+ Nothing -> []+ (Just v) ->+ parseCommaList v++parseCommaList :: String -> [String]+parseCommaList str =+ words $ map (\c -> if c == ',' then ' ' else c) str++packageVersionParagraph :: [(String, String)] -> (String, 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) -> + (stripWS n, parseDebianVersion v)++mapSnd :: (b -> c) -> [(a,b)] -> [(a,c)]+mapSnd f = map (second f)++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 "")
+ Test/Main.hs view
@@ -0,0 +1,17 @@+module Main where++import Test.HUnit+import System.Exit+import Test.Changes+import Test.Versions+--import Test.VersionPolicy+import Test.SourcesList+import Test.Dependencies++main =+ do (c,st) <- runTestText putTextToShowS (TestList (versionTests ++ sourcesListTests ++ dependencyTests ++ changesTests))+ putStrLn (st "")+ case (failures c) + (errors c) of+ 0 -> return ()+ n -> exitFailure+
+ Test/SourcesList.hs view
@@ -0,0 +1,59 @@+module Test.SourcesList where++import Test.HUnit++import Debian.Sources+import Data.Maybe++-- * 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 (unlines . map show . 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"++testSourcesListParse :: Test+testSourcesListParse =+ test [ assertEqual "" text (concat . map (++ "\n") . map show . parseSourcesList $ text) ]+ where+ text = (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 =+ [ testQuoteWords, testSourcesList, testSourcesListParse ]
+ Test/VersionPolicy.hs view
@@ -0,0 +1,68 @@+module Test.VersionPolicy where++import Test.HUnit++import Debian.Version+import Debian.VersionPolicy++-- * Tag parsing++versionPolicyTests =+ map (\ (vendor, release, versionString) ->+ let version = (parseDebianVersion versionString) in+ TestCase (assertEqual versionString (rebuildTag vendor version) version)) versionStrings +++ [ TestCase (assertEqual+ "setTag"+ (parseDebianVersion "1.2-3seereason4~feisty7")+ (either (error "setTag failed!") id+ (setTag id "seereason" (Just "feisty") Nothing + -- version currently uploaded to the build release+ (Just (parseDebianVersion "1.2-3seereason4~feisty4"))+ -- All the versions in the repository+ [parseDebianVersion "1.2-3seereason4~feisty5",+ parseDebianVersion "1.2-3seereason4~feisty6"] + -- The version retrieved from the changelog+ (parseDebianVersion "1.2-3seereason4"))))+ , TestCase (assertEqual+ "setTag2"+ (Right (parseDebianVersion "3000.0.2.1-2+6seereason1~feisty1"))+ (setTag id "seereason" (Just "feisty") Nothing+ (Just (parseDebianVersion "3000.0.2.1-1+6seereason1~feisty3"))+ [parseDebianVersion "3000.0.2.1-1+6seereason3",+ parseDebianVersion "3000.0.2.1-1+6seereason1~feisty3",+ parseDebianVersion "3000.0.2.1-1+6seereason1~feisty2",+ parseDebianVersion "3000.0.2.1-1+6seereason1~feisty1",+ parseDebianVersion "3000.0.2.1-1+6seereason0~gutsy4",+ parseDebianVersion "3000.0.2.1-1+6seereason0~gutsy3",+ parseDebianVersion "3000.0.2.1-1+6seereason0~gutsy2",+ parseDebianVersion "3000.0.2-2+6"]+ (parseDebianVersion "3000.0.2.1-2+6"))) + , TestCase (assertEqual+ "setTag"+ (parseDebianVersion "0.4.0.1")+ (fst (parseTag "seereason" (parseDebianVersion "0.4.0.1-0seereason1"))))+ , TestCase (assertEqual+ "appendTag (parseTag \"seereason\" (parseDebianVersion \"0.4.0.1-0seereason1\")) -> \"0.4.0.1-0seereason1\""+ (parseDebianVersion "0.4.0.1-0seereason1")+ (uncurry (appendTag id) (parseTag "seereason" (parseDebianVersion "0.4.0.1-0seereason1"))))+ , TestCase (assertEqual+ "setTag \"seereason\" (Just \"gutsy\") \"0.4.0.1-0seereason1\" -> \"0.4.0.1-0seereason1~gutsy1\""+ (parseDebianVersion "0.4.0.1-0seereason1~gutsy1")+ (either (error "setTag failed!") id+ (setTag id "seereason" (Just "gutsy") Nothing + -- version currently uploaded to the build release+ Nothing+ -- All the versions in the repository+ [] + -- The version retrieved from the changelog+ (parseDebianVersion "0.4.0.1-0seereason1")))) ]++versionStrings = [ ("seereason", Just "feisty", "1.2-3seereason4~feisty5")+ , ("seereason", Just "feisty", "1.2-3")+ , ("seereason", Nothing, "1.2-3seereason4")+ , ("seereason", Nothing, "1.2-0seereason4") ]++rebuildTag vendor version = + case parseTag vendor version of+ (version, Just tag) -> appendTag id version (Just tag)+ (version, Nothing) -> version
+ Test/Versions.hs view
@@ -0,0 +1,111 @@+module Test.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.cabal view
@@ -1,72 +1,119 @@ Name: debian-Version: 3.40+Version: 3.46 License: BSD3-License-File: debian/copyright+License-File: debian/copyright Author: David Fox-Category: System+Category: System Maintainer: david@seereason.com-Homepage: http://src.seereason.com/ghc6103/haskell-debian-3-Build-Depends: base >= 4 && < 5, syb, bytestring, containers, directory, filepath, mtl, network, old-locale, parsec >= 3, pretty, process, regex-compat, regex-posix, time, unix, bzlib, HaXml, Unixutils, zlib-Build-Type: Simple+Homepage: http://src.seereason.com/haskell-debian+Build-Type: Simple Synopsis: Modules for working with the Debian package system+Cabal-Version: >= 1.2 Description: This library includes modules covering some basic data types defined by the Debian policy manual - version numbers, control file syntax, etc.-ghc-options: -O2 -threaded -W-Extensions: ExistentialQuantification-Exposed-modules:- Debian.Apt.Dependencies,- Debian.Apt.Index,- Debian.Apt.Methods,- Debian.Apt.Package,- Debian.Changes,- Debian.Control,- Debian.Control.Common,- Debian.Control.PrettyPrint,- Debian.Control.ByteString,- Debian.Control.String,- Debian.Deb,- Debian.Extra.Files,- Debian.GenBuildDeps,- Debian.Relation,- Debian.Relation.ByteString,- Debian.Relation.Common,- Debian.Relation.String,+extra-source-files:+ Test/Main.hs, Test/Changes.hs, Test/Dependencies.hs,+ Test/SourcesList.hs, Test/VersionPolicy.hs, Test/Versions.hs++Flag cabal19+ Description: True if Cabal >= 1.9 is available++Library+ Build-Depends: base >= 4 && < 5, bytestring, containers, directory,+ filepath, mtl, network, old-locale, parsec >= 2 && <4, pretty, process,+ regex-tdfa, regex-compat, time, unix, bzlib, HaXml, Unixutils, zlib, HUnit+ ghc-options: -O2 -W -Wall+ if flag(cabal19)+ build-depends: Cabal >= 1.9+ cpp-options: -DCABAL19+ else+ build-depends: Cabal >= 1.8+ cpp-options: -DCABAL18+ Extensions: ExistentialQuantification CPP+ Exposed-modules:+ Debian.Apt.Dependencies,+ Debian.Apt.Index,+ Debian.Apt.Methods,+ Debian.Apt.Package,+ Debian.Changes,+ Debian.Control,+ Debian.Control.Common,+ Debian.Control.PrettyPrint,+ Debian.Control.ByteString,+ Debian.Control.String,+ Debian.Deb,+ Debian.Extra.Files,+ Debian.GenBuildDeps,+ Debian.Relation,+ Debian.Relation.ByteString,+ Debian.Relation.Common,+ Debian.Relation.String, Debian.Release, Debian.Sources,- Debian.Version,- Debian.Version.Common,- Debian.Version.String,- Debian.Version.ByteString,- Debian.Report,+ Debian.Version,+ Debian.Version.Common,+ Debian.Version.String,+ Debian.Version.ByteString,+ Debian.Report, Debian.Time, Debian.URI,- Debian.Util.FakeChanges-other-modules:- Debian.Version.Internal,- Distribution.Package.Debian.Bundled,- Distribution.Package.Debian.Setup,- Distribution.Package.Debian.Main,- Distribution.Package.Debian-extra-source-files:- tests/Main.hs+ Debian.Util.FakeChanges+ other-modules:+ Debian.Version.Internal,+ Distribution.Package.Debian.Bundled,+ Distribution.Package.Debian.Setup,+ Distribution.Package.Debian.Main,+ Distribution.Package.Debian,+ Test.Changes,+ Test.Dependencies,+ Test.SourcesList,+ Test.Versions -Executable: fakechanges-Main-is: utils/FakeChanges.hs-ghc-options: -O2 -threaded -W+Executable fakechanges+ Main-is: utils/FakeChanges.hs+ ghc-options: -O2 -threaded -W+ Extensions: ExistentialQuantification CPP+ if flag(cabal19)+ build-depends: Cabal >= 1.9+ cpp-options: -DCABAL19+ else+ build-depends: Cabal >= 1.8+ cpp-options: -DCABAL18 -Executable: debian-report-Main-is: utils/Report.hs-ghc-options: -O2 -threaded -W-C-Sources: cbits/gwinsz.c-Include-Dirs: cbits-Install-Includes: gwinsz.h+Executable debian-report+ Main-is: utils/Report.hs+ ghc-options: -O2 -threaded -W+ C-Sources: cbits/gwinsz.c+ Include-Dirs: cbits+ Install-Includes: gwinsz.h+ Extensions: ExistentialQuantification CPP+ if flag(cabal19)+ build-depends: Cabal >= 1.9+ cpp-options: -DCABAL19+ else+ build-depends: Cabal >= 1.8+ cpp-options: -DCABAL18 -Executable: cabal-debian-Main-is: utils/CabalDebian.hs-ghc-options: -O2 -threaded -W-Build-Depends: Cabal >= 1.6.0.1+Executable cabal-debian+ Main-is: utils/CabalDebian.hs+ ghc-options: -O2 -threaded -W+ Build-Depends: Cabal >= 1.6.0.1+ Extensions: ExistentialQuantification CPP+ if flag(cabal19)+ build-depends: Cabal >= 1.9+ cpp-options: -DCABAL19+ else+ build-depends: Cabal >= 1.8+ cpp-options: -DCABAL18 -Executable: apt-get-build-depends-Main-is: utils/AptGetBuildDeps.hs-ghc-options: -O2 -threaded -W+Executable apt-get-build-depends+ Main-is: utils/AptGetBuildDeps.hs+ ghc-options: -O2 -threaded -W+ Extensions: ExistentialQuantification CPP+ if flag(cabal19)+ build-depends: Cabal >= 1.9+ cpp-options: -DCABAL19+ else+ build-depends: Cabal >= 1.8+ cpp-options: -DCABAL18
− tests/Main.hs
@@ -1,16 +0,0 @@-module Main where--import Test.HUnit-import System.Exit-import Versions-import VersionPolicy-import SourcesList-import Dependencies--main =- do (c,st) <- runTestText putTextToShowS (TestList (versionTests ++ versionPolicyTests ++ sourcesListTests ++ dependencyTests))- putStrLn (st "")- case (failures c) + (errors c) of- 0 -> return ()- n -> exitFailure-