debian 3.47 → 3.54

raw patch · 9 files changed

+67/−92 lines, 9 filesdep ~UnixutilsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Unixutils

API changes (from Hackage documentation)

Files

• Debian/Changes.hs +4/−4
• Debian/Deb.hs +3/−2
• Debian/Relation/String.hs +2/−1
• Debian/Release.hs +15/−2
• Debian/URI.hs +26/−43
• Distribution/Package/Debian.hs +11/−7
• Distribution/Package/Debian/Bundled.hs +4/−29
• Test/Changes.hs +0/−2
• debian.cabal +2/−2

@@ -34,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+            } deriving (Eq, Show)  -- |An entry in the list of files generated by the build. data ChangedFileSpec =@@ -45,7 +45,7 @@                     , changedFileSection :: SubSection                     , changedFilePriority :: String                     , changedFileName :: FilePath-                    } deriving Eq+                    } deriving (Eq, Show)  -- |A changelog is a series of ChangeLogEntries data ChangeLogEntry =@@ -58,7 +58,7 @@           , logDate :: String           }   | WhiteSpace String-  deriving Eq+  deriving (Eq, Show)  {- instance Show ChangesFile where@@ -177,7 +177,7 @@ parseEntry :: String -> Either [String] (ChangeLogEntry, String) parseEntry text =     case text =~ entryRE :: MatchResult String of-      x | mrSubList x == [] -> Left ["Parse error at " ++ show text]+      x | mrSubList x == [] -> Left ["Parse error in " ++ show text]       x@MR {mrAfter = after, mrSubList = [_, name, version, dists, urgency, _, details, _, _, who, _, date, _]} ->           Right (Entry name                           (parseDebianVersion version)

@@ -2,6 +2,7 @@  import Control.Monad +import Data.ByteString.Lazy (empty) import Debian.Control.Common import System.Unix.Directory import System.Unix.FilePath@@ -12,9 +13,9 @@     withTemporaryDirectory ("fields.XXXXXX") $ \tmpdir ->       do debFP <- realpath debFP          withWorkingDirectory tmpdir $ -           do (out, err, res) <- simpleProcess "ar" ["x",debFP,"control.tar.gz"] +           do (out, err, res) <- lazyProcess "ar" ["x",debFP,"control.tar.gz"] Nothing Nothing empty >>= return . collectOutputUnpacked                when (res /= ExitSuccess) (error $ "Dpkg.fields: " ++ out ++ "\n" ++ err ++ "\n" ++ show res)-              (out, err, res) <- simpleProcess "tar" ["xzf", "control.tar.gz", "./control"]+              (out, err, res) <- lazyProcess "tar" ["xzf", "control.tar.gz", "./control"] Nothing Nothing empty >>= return . collectOutputUnpacked               when (res /= ExitSuccess) (error $ "Dpkg.fields: " ++ out ++ "\n" ++ err ++ "\n" ++ show res)               c <- parseControlFromFile "control"                case c of

@@ -48,7 +48,8 @@                 return rel  pOrRelation :: RelParser OrRelation-pOrRelation = do rel <- sepBy1 pRelation (char '|')+pOrRelation = do skipMany (char ',' <|> whiteChar)+                 rel <- sepBy1 pRelation (char '|')                  skipMany (char ',' <|> whiteChar)                  return rel 

@@ -1,4 +1,17 @@-module Debian.Release where+module Debian.Release+    ( ReleaseName(..)+    , parseReleaseName+    , releaseName'+    , Arch(..)+    , archName+    , Section(..)+    , SubSection(..)+    , sectionName+    , sectionName'+    , sectionNameOfSubSection+    , parseSection+    , parseSection'+    ) where  import Debian.URI @@ -28,7 +41,7 @@  -- |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)+data SubSection = SubSection { section :: Section, subSectionName :: String } deriving (Read, Show, Eq, Ord)  sectionName :: SubSection -> String sectionName (SubSection (Section "main") y) = y

@@ -7,17 +7,21 @@     , dirFromURI     ) where -import Control.Exception (ErrorCall(ErrorCall), try)+import Control.Exception (SomeException, {-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)-import System.Exit-import System.Unix.Process (lazyCommand, collectOutput)+--import System.Exit+--import System.Unix.Process (lazyCommand, collectOutput)+import System.Unix.Process (collectStdout)+import System.Unix.Progress (lazyCommandSF, quieter)+--import System.Unix.ProcessExtra (cmdOutput, cmdOutputStrict) import Text.Regex (mkRegex, matchRegex) +uriToString' :: URI -> String uriToString' uri = uriToString id uri ""  instance Ord URI where@@ -26,21 +30,26 @@ -- |If the URI type could be read and showed this wouldn't be necessary. type URIString = String -fileFromURI :: URI -> IO (Either ErrorCall L.ByteString)+fileFromURI :: URI -> IO (Either SomeException L.ByteString) fileFromURI uri =     case (uriScheme uri, uriAuthority uri) of       ("file:", Nothing) -> try (L.readFile (uriPath uri))-      ("ssh:", Just auth) -> cmdOutput ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++-                                        " cat " ++ show (uriPath uri))-      _ -> cmdOutput ("curl -s -g '" ++ uriToString' uri ++ "'")+      -- ("ssh:", Just auth) -> cmdOutput ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " cat " ++ show (uriPath uri))+      ("ssh:", Just auth) -> try (lazyCommandSF ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " cat " ++ show (uriPath uri)) L.empty >>=+                                  return . fst . collectStdout)+      _ -> try (lazyCommandSF ("curl -s -g '" ++ uriToString' uri ++ "'") L.empty >>=+                return . fst . collectStdout) -fileFromURIStrict :: URI -> IO (Either ErrorCall B.ByteString)+fileFromURIStrict :: URI -> IO (Either SomeException 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 ++ "'")+      -- ("ssh:", Just auth) -> cmdOutputStrict ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " cat " ++ show (uriPath uri))+      ("ssh:", Just auth) -> try (lazyCommandSF ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " cat " ++ show (uriPath uri)) L.empty >>=+                                  return . B.concat . L.toChunks . fst . collectStdout)+      _ -> try (lazyCommandSF ("curl -s -g '" ++ uriToString' uri ++ "'") L.empty >>=+                return . B.concat . L.toChunks . fst . collectStdout)+      -- _ -> 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.@@ -55,38 +64,12 @@       second _ = Nothing  -dirFromURI :: URI -> IO (Either ErrorCall [String])+dirFromURI :: URI -> IO (Either SomeException [String]) dirFromURI uri =     case (uriScheme uri, uriAuthority uri) of       ("file:", Nothing) -> try (getDirectoryContents (uriPath uri))-      ("ssh:", Just auth) -> cmdOutput ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++-                                        " ls -1 " ++ uriPath uri) >>=-                             return . either Left (Right . lines . L.unpack)-      _ -> cmdOutput ("curl -s -g '" ++ uriToString' uri ++ "/'") >>= return . either Left (Right . webServerDirectoryContents)----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)+      -- ("ssh:", Just auth) -> cmdOutput ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " ls -1 " ++ uriPath uri) >>=+      ("ssh:", Just auth) -> try (lazyCommandSF ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " ls -1 " ++ uriPath uri) L.empty >>=+                                  return . lines . L.unpack . fst . collectStdout)+      -- _ -> cmdOutput ("curl -s -g '" ++ uriToString' uri ++ "/'") >>= return . either Left (Right . webServerDirectoryContents)+      _ -> try (lazyCommandSF ("curl -s -g '" ++ uriToString' uri ++ "/'") L.empty >>= return . webServerDirectoryContents . fst . collectStdout)

@@ -62,7 +62,7 @@ import Distribution.PackageDescription.Configuration (finalizePackageDescription) import Distribution.ParseUtils (parseQuoted) import Distribution.Verbosity (Verbosity)-import Distribution.Version (VersionRange(..))+import Distribution.Version (Version(..),VersionRange(..)) import Distribution.Simple.Setup (defaultDistPref) import Distribution.Package.Debian.Setup (Flags(..), DebAction(..), DebType(..)) import Distribution.Package.Debian.Bundled@@ -333,7 +333,7 @@ debOfFile s =     do (out, _err, code) <- lazyCommand cmd L.empty >>= return . collectOutputUnpacked        case code of-         [ExitSuccess] -> return (takePackageName out)+         ExitSuccess -> return (takePackageName out)          _ -> return Nothing     where       cmd = "cd /var/lib/dpkg/info && grep '" ++ s ++ "' *.list"@@ -731,7 +731,7 @@  debianRelations :: String -> VersionRange -> D.Relations debianRelations name range =-    map (merge . map (relation name)) (canon range)+    map (merge . concat . map (relation name)) (canon range)     where       -- A debian dependency list is always a list of or-relations       -- which are anded.  This function turns the more freeform cabal@@ -741,10 +741,11 @@       canon (UnionVersionRanges a b) = map concat (cartesianProduct [canon a, canon b])       canon x = [[x]]       -- Turn simple Cabal relations into Debian relations-      relation name AnyVersion = D.Rel name Nothing Nothing-      relation name (ThisVersion version) = D.Rel name (Just (D.EEQ (parseDebianVersion (showVersion version)))) Nothing-      relation name (EarlierVersion version) = D.Rel name (Just (D.SLT (parseDebianVersion (showVersion version)))) Nothing-      relation name (LaterVersion version) = D.Rel name (Just (D.SGR (parseDebianVersion (showVersion version)))) Nothing+      relation name AnyVersion = [D.Rel name Nothing Nothing]+      relation name (ThisVersion version) = [D.Rel name (Just (D.EEQ (parseDebianVersion (showVersion version)))) Nothing]+      relation name (EarlierVersion version) = [D.Rel name (Just (D.SLT (parseDebianVersion (showVersion version)))) Nothing]+      relation name (LaterVersion version) = [D.Rel name (Just (D.SGR (parseDebianVersion (showVersion version)))) Nothing]+      relation name (WildcardVersion version) = [D.Rel name (Just (D.GRE (parseDebianVersion (showVersion version)))) Nothing, D.Rel name (Just (D.SLT (parseDebianVersion (showVersion (upperBound version))))) Nothing]       relation _ _ = error $ "Invalid argument to debianRelations: " ++ show range       -- Merge some combinations that frequently show up.       merge (D.Rel name1 (Just (D.EEQ ver1)) arch1 : D.Rel name2 (Just (D.SLT ver2)) arch2 : xs)@@ -755,6 +756,9 @@               = merge (D.Rel name1 (Just (D.GRE ver1)) arch1 : xs)       merge (x : xs) = x : merge xs       merge [] = []+      upperBound v = v { versionBranch = bump (versionBranch v) }+      bump = reverse . (zipWith (+) (1:(repeat 0))) . reverse+  debianDocumentationPackageName :: String -> String debianDocumentationPackageName x =

@@ -74,7 +74,7 @@                         , (GHC, Version [6,6] [], ghc66BuiltIns)                         ] ghc6BuiltIns :: Compiler -> IO (Maybe (CompilerFlavor, Version, [PackageIdentifier]))-ghc6BuiltIns compiler@(Compiler (CompilerId GHC compilerVersion) _) =+ghc6BuiltIns compiler@(Compiler {compilerId = CompilerId GHC compilerVersion}) = #ifdef CABAL19     do installedPackages <- getInstalledPackageIndex compiler        ghc6Files <- fmap lines $ readFile "/var/lib/dpkg/info/ghc6.list"@@ -92,7 +92,7 @@ ghc6BuiltIns _ = return Nothing  ghc6BuiltIns' :: Compiler -> IO (Maybe (CompilerFlavor, Version, [PackageIdentifier]))-ghc6BuiltIns' compiler@(Compiler (CompilerId GHC compilerVersion) _) =+ghc6BuiltIns' compiler@(Compiler {compilerId = CompilerId GHC compilerVersion}) =     do eDebs <- ghc6Provides        case eDebs of          Left e -> error e@@ -113,7 +113,7 @@     where       fromRight (Right r) = r       fromRight (Left e) = error e-ghc6BuiltIns' compiler@(Compiler _ _) = return Nothing+ghc6BuiltIns' compiler@(Compiler {}) = return Nothing  ghc6Provides :: IO (Either String [String]) ghc6Provides = @@ -299,29 +299,4 @@ isLibrary _ _ = True  docPrefix :: String -> String-{--docPrefix "alut" = "libghc6-"-docPrefix "arrows" = "libghc6-"-docPrefix "binary" = "libghc6-"-docPrefix "cgi" = "libghc6-"-docPrefix "fgl" = "libghc6-"-docPrefix "glut" = "libghc6-"-docPrefix "haskell-src" = "libghc6-"-docPrefix "hgl" = "libghc6-"-docPrefix "html" = "libghc6-"-docPrefix "hunit" = "libghc6-"-docPrefix "mtl" = "libghc6-"-docPrefix "network" = "libghc6-"-docPrefix "openal" = "libghc6-"-docPrefix "opengl" = "libghc6-"-docPrefix "parallel" = "libghc6-"-docPrefix "parsec" = "libghc6-"-docPrefix "quickcheck" = "libghc6-"-docPrefix "stm" = "libghc6-"-docPrefix "stream" = "libghc6-"-docPrefix "time" = "libghc6-"-docPrefix "x11" = "libghc6-"-docPrefix "xhtml" = "libghc6-"-docPrefix "xmonad" = "libghc6-"--}-docPrefix _ = "haskell-"+docPrefix _ = "libghc6-"

@@ -7,8 +7,6 @@ import Debian.Release (ReleaseName(ReleaseName, relName)) import Debian.Version (parseDebianVersion) -deriving instance Show ChangeLogEntry- s3 = intercalate "\n"       ["name (version) dist; urgency=urgency",       "  * details",

@@ -1,5 +1,5 @@ Name:           debian-Version:        3.47+Version:        3.54 License:        BSD3 License-File:   debian/copyright Author:         David Fox@@ -22,7 +22,7 @@ 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 < 1.14, Unixutils, zlib, HUnit+                 regex-tdfa, regex-compat, time, unix, bzlib, HaXml < 1.14, Unixutils >= 1.32, zlib, HUnit  ghc-options: -O2 -W -Wall  if flag(cabal19)    build-depends: Cabal >= 1.9