debian 3.85.2 → 3.87

raw patch · 18 files changed

+233/−217 lines, 18 filesdep ~Unixutilsdep ~networkdep ~prettyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Unixutils, network, pretty

API changes (from Hackage documentation)

Files

• Debian/Apt/Index.hs +1/−2
• Debian/Control/Common.hs +6/−6
• Debian/Control/Policy.hs +18/−5
• Debian/GenBuildDeps.hs +85/−68
• Debian/Loc.hs +8/−10
• Debian/Pretty.hs +18/−14
• Debian/Sources.hs +9/−9
• Debian/Util/FakeChanges.hs +4/−4
• Test/Changes.hs +1/−1
• Test/Control.hs +14/−4
• Test/Dependencies.hs +1/−1
• Test/Main.hs +5/−6
• Test/SourcesList.hs +1/−1
• Test/VersionPolicy.hs +0/−68
• Test/Versions.hs +1/−1
• changelog +25/−0
• debian.cabal +20/−17
• debian/changelog +16/−0

@@ -32,7 +32,6 @@ import Debian.Control.ByteString import Debian.Control.Common import Debian.Control.Text (decodeControl)-import Debian.Pretty (PP(..)) import Debian.Release import Debian.Sources import Debian.URI@@ -125,7 +124,7 @@     where       baseURI = sourceUri debSource       (release, sections) =-          either (error $ "indexURIs: support not implemented for exact path: " ++ render (pPrint (PP debSource))) id (sourceDist debSource)+          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

@@ -97,13 +97,13 @@  -- | This may have bad performance issues (dsf: Whoever wrote this -- comment should have explained why.)-instance (ControlFunctions a, Pretty (PP a)) => Pretty (PP (Control' a)) where-    pPrint = ppControl . unPP-instance (ControlFunctions a, Pretty (PP a)) => Pretty (PP (Paragraph' a)) where-    pPrint = ppParagraph . unPP+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 (PP (Field' a)) where-    pPrint = ppField . unPP+instance (ControlFunctions a, Pretty (PP a)) => Pretty (Field' a) where+    pPrint = ppField  ppControl :: (ControlFunctions a, Pretty (PP a)) => Control' a -> Doc ppControl (Control paragraph) =

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, ScopedTypeVariables, TemplateHaskell #-}+{-# 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@@ -29,16 +29,18 @@  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 (ppDisplay)+import Debian.Pretty (prettyShow) import Debian.Relation (SrcPkgName(..), BinPkgName(..), Relations, parseRelations) import Debian.Relation.Text ()-import Language.Haskell.TH (Loc)+import Language.Haskell.TH (Loc(..))+import Prelude hiding (ioError) -- import qualified Debug.ShowPlease as Please import Text.Parsec.Error (ParseError) @@ -47,7 +49,7 @@ data DebianControl = DebianControl {unDebianControl :: Control' Text}  instance Show DebianControl where-    show c = "(parseDebianControl \"\" " ++ show (ppDisplay (unDebianControl c)) ++ ")"+    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@@ -99,7 +101,18 @@     | ParseRelationsError {locs :: [Loc], parseError :: ParseError}     | ParseControlError   {locs :: [Loc], parseError :: ParseError}     | IOError             {locs :: [Loc], ioError :: IOError}-    deriving (Show, Typeable)+    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 ++ ")"

@@ -2,14 +2,15 @@ -- |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 +module Debian.GenBuildDeps     ( DepInfo(..)+    , sourceName'+    , relations'+    , binaryNames'     -- * Preparing dependency info     , buildDependencies     , RelaxInfo     , relaxDeps-    , OldRelaxInfo(..)-    , oldRelaxDeps     -- * Using dependency info     , BuildableInfo(..)     , ReadyTarget(..)@@ -25,17 +26,17 @@ import           Control.Applicative ((<$>)) import           Control.Exception (throw) import		 Control.Monad (filterM)-import		 Data.Graph (Graph, Edge, buildG, topSort, reachable, transposeG, vertices, edges)+import		 Data.Graph (Graph, Edge, Vertex, buildG, topSort, reachable, transposeG, edges, scc) import		 Data.List import qualified Data.Map as Map import		 Data.Maybe import qualified Data.Set as Set+import           Data.Tree as Tree (Tree(Node, rootLabel, subForest)) import		 Debian.Control (parseControlFromFile)-import		 Debian.Control.Policy (HasDebianControl, ControlFileError(..), validateDebianControl, debianSourcePackageName, debianBinaryPackageNames, debianBuildDeps, debianBuildDepsIndep)+import		 Debian.Control.Policy (HasDebianControl, DebianControl, ControlFileError(..), validateDebianControl, debianSourcePackageName, debianBinaryPackageNames, debianBuildDeps, debianBuildDepsIndep) import           Debian.Loc (__LOC__) import		 Debian.Relation import		 Debian.Relation.Text ()-import           Language.Haskell.TH (Loc) import		 System.Directory (getDirectoryContents, doesFileExist)  -- | This type describes the build dependencies of a source package.@@ -43,8 +44,13 @@       sourceName :: SrcPkgName		-- ^ source package name     , relations :: Relations		-- ^ dependency relations     , binaryNames :: [BinPkgName]	-- ^ binary dependency names (is this a function of relations?)-    }+    } deriving Show +instance Eq DepInfo where+    a == b = (sourceName a == sourceName b) &&+             Set.fromList (map Set.fromList (relations a)) == Set.fromList (map Set.fromList (relations b)) &&+             Set.fromList (binaryNames a) == Set.fromList (binaryNames b)+ -- |Return the dependency info for a source package with the given dependency relaxation. -- |According to debian policy, only the first paragraph in debian\/control can be a source package -- <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-sourcecontrolfiles>@@ -55,6 +61,19 @@                                 fromMaybe [] (debianBuildDepsIndep control)]           , binaryNames = debianBinaryPackageNames control } +-- | 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@@ -70,16 +89,6 @@ -- OldRelaxInfo.) type RelaxInfo = SrcPkgName -> BinPkgName -> Bool -_makeRelaxInfo :: OldRelaxInfo -> RelaxInfo-_makeRelaxInfo (RelaxInfo xs) srcPkgName binPkgName =-    Set.member binPkgName global || maybe False (Set.member binPkgName) (Map.lookup srcPkgName mp)-    where-      (global :: Set.Set BinPkgName, mp :: Map.Map SrcPkgName (Set.Set BinPkgName)) =-          foldr (\ entry (global', mp') ->-                     case entry of-                       (b, Just s) -> (global', Map.insertWith Set.union s (Set.singleton b) mp')-                       (b, Nothing) -> (Set.insert b global', mp')) (Set.empty, Map.empty) xs- -- |Remove any dependencies that are designated \"relaxed\" by relaxInfo. relaxDeps :: RelaxInfo -> [DepInfo] -> [DepInfo] relaxDeps relaxInfo deps =@@ -96,31 +105,6 @@             keepDep :: Relation -> Bool             keepDep (Rel name _ _) = not (relaxInfo (sourceName info) name) --- |Remove any dependencies that are designated \"relaxed\" by relaxInfo.-oldRelaxDeps :: OldRelaxInfo -> [DepInfo] -> [DepInfo]-oldRelaxDeps relaxInfo deps =-    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 (/= []) (map (filter keepDep) (relations info))-            keepDep :: Relation -> Bool-            keepDep (Rel name _ _) = not (elem name ignored)-            -- Binary packages to be ignored wrt this source package's build decision-            ignored = ignoredForSourcePackage (sourceName info) relaxInfo-            -- Return a list of binary packages which should be ignored for this-            -- source package.-            ignoredForSourcePackage :: SrcPkgName -> OldRelaxInfo -> [BinPkgName]-            ignoredForSourcePackage source (RelaxInfo pairs) =-                map fst . filter (maybe True (== source) . snd) $ pairs-                -- concat . map binaries . catMaybes . map snd . filter (\ (_, x) -> maybe True (== source) x) $ pairs---- |  data ReadyTarget a     = ReadyTarget { ready :: a                   -- ^ Some target whose build dependencies are all satisfied@@ -141,20 +125,21 @@ -- 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 :: (a -> a -> Ordering) -> [a] -> BuildableInfo a-buildable cmp 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.     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 = map ofEdge (cycleEdges hasDep)}+      ([], _) -> CycleInfo {depPairs = 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 = map (makeReady blocked allReady) allReady                         , allBlocked = 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@@ -162,37 +147,57 @@                       , waiting = map ofVertex directlyBlocked                       , other = map ofVertex (otherReady ++ otherBlocked) }       --allDeps x = (ofVertex x, map ofVertex (filter (/= x) (reachable hasDep x)))-      isDep = buildG (0, length packages - 1) edges'-      edges' = map (\ (a, b) -> (b, a)) edges''-      hasDep = buildG (0, length packages - 1) edges''-      edges'' :: [(Int, Int)]-      edges'' =+      isDep :: Graph+      isDep = transposeG hasDep+      hasDep :: Graph+      hasDep = buildG (0, length packages - 1) hasDepEdges++      hasDepEdges :: [(Int, Int)]+      hasDepEdges =           nub (foldr f [] (tails vertPairs))-          where f [] es = es+          where f :: [(Int, DepInfo)] -> [(Int, Int)] -> [(Int, Int)]+                f [] es = es                 f (x : xs) es = catMaybes (map (toEdge x) xs) ++ es+                toEdge :: (Int, DepInfo) -> (Int, DepInfo) -> Maybe Edge                 toEdge (xv, xa) (yv, ya) =-                    case cmp xa ya of+                    case compareSource xa ya of                       EQ -> Nothing                       LT -> Just (yv, xv)                       GT -> Just (xv, yv)+      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 = zip [0..] packages+      vertPairs :: [(Int, DepInfo)]+      vertPairs = zip [0..] $ map relax packages -cycleEdges :: Graph -> [Edge]-cycleEdges g =-    filter (`elem` (edges g))-               (Set.toList (Set.intersection-                            (Set.fromList (closure g))-                            (Set.fromList (closure (transposeG g)))))+-- | 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-      closure g' = concat (map (\ v -> (map (\ u -> (v, u)) (reachable g' v))) (vertices g'))-      --self (a, b) = a == b-      --distrib = concat . map (\ (n, ms) -> map (\ m -> (n, m)) ms) -      --swap (a, b) = (b, a)+      -- 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 =@@ -243,16 +248,28 @@       checkPackageNameReq :: Relation -> BinPkgName -> Bool       checkPackageNameReq (Rel rPkgName _ _) bPkgName = rPkgName == bPkgName +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 [DepInfo]+genDeps :: [FilePath] -> IO [DebianControl] genDeps controlFiles = do-  orderSource compareSource <$> mapM genDep' controlFiles+  orderSource compareSource' <$> mapM genDep' controlFiles     where       -- Parse the control file and extract the build dependencies-      genDep' :: FilePath -> IO DepInfo       genDep' controlPath = parseControlFromFile controlPath >>=                             either (\ x -> throw (ParseRelationsError [$__LOC__] x))-                                   (\ x -> validateDebianControl x {- `mapExn` (pushLoc $__LOC__) -} >>= either throw (return . buildDependencies))+                                   (\ x -> validateDebianControl x {- `mapExn` (pushLoc $__LOC__) -} >>= either throw return)  -- pushLoc :: Loc -> ControlFileError -> ControlFileError -- pushLoc loc e = e {locs = loc : locs e}@@ -264,7 +281,7 @@ -- order they should be built. getSourceOrder :: FilePath -> IO [SrcPkgName] getSourceOrder fp =-    findControlFiles fp >>= genDeps >>= return . map sourceName+    findControlFiles fp >>= genDeps >>= return . map sourceName'     where       -- Return a list of the files that look like debian\/control.       findControlFiles :: FilePath -> IO [FilePath]

@@ -1,25 +1,23 @@ {-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-}-module Debian.Loc where+module Debian.Loc+    ( __LOC__+    , mapExn+    ) where -import Control.Applicative+import Control.Applicative ((<$>), (<*>), pure) import Control.Exception (Exception, throw) import Control.Monad.Catch (MonadCatch, catch) import Language.Haskell.TH-import Language.Haskell.TH.Syntax -deriving instance Show Loc--instance Lift Loc where-    lift x = recConE 'Loc [ (,) <$> (pure 'loc_filename) <*> litE (stringL (loc_filename x))+__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)|] ]--__LOC__ :: Q Exp-__LOC__ = lift =<< location  mapExn :: forall e m a. (MonadCatch m, Exception e) => m a -> (e -> e) -> m a mapExn task f = task `catch` (\ (e :: e) -> throw (f e))

@@ -1,15 +1,22 @@+-- | 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)-    , display-    , display'+    , prettyShow+    , prettyText     , ppPrint-    , ppDisplay-    , ppDisplay'+    , ppShow+    , ppText     ) where  import Data.Text (Text, unpack, pack)-import Text.PrettyPrint.HughesPJClass (Doc, Pretty(pPrint), text, empty)+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@@ -26,17 +33,14 @@ instance Pretty (PP a) => Pretty (PP (Maybe a)) where     pPrint = maybe empty ppPrint . unPP -display :: Pretty a => a -> String-display = show . pPrint--display' :: Pretty a => a -> Text-display' = pack .show . pPrint+prettyText :: Pretty a => a -> Text+prettyText = pack . prettyShow  ppPrint :: Pretty (PP a) => a -> Doc ppPrint = pPrint . PP -ppDisplay :: Pretty (PP a) => a -> String-ppDisplay = display . PP+ppShow :: Pretty (PP a) => a -> String+ppShow = prettyShow . PP -ppDisplay' :: Pretty (PP a) => a -> Text-ppDisplay' = pack . display . PP+ppText :: Pretty (PP a) => a -> Text+ppText = pack . prettyShow . PP

@@ -12,22 +12,22 @@  data SourceType     = Deb | DebSrc-    deriving (Eq, Ord)+    deriving (Eq, Ord, Show)  data DebSource     = DebSource     { sourceType :: SourceType     , sourceUri :: URI     , sourceDist :: Either String (ReleaseName, [Section])-    } deriving (Eq, Ord)+    } deriving (Eq, Ord, Show) -instance Pretty (PP SourceType) where-    pPrint (PP Deb) = text "deb"-    pPrint (PP DebSrc) = text "deb-src"+instance Pretty SourceType where+    pPrint Deb = text "deb"+    pPrint DebSrc = text "deb-src" -instance Pretty (PP DebSource) where-    pPrint (PP (DebSource thetype theuri thedist)) =-        pPrint (PP thetype) <>+instance Pretty DebSource where+    pPrint (DebSource thetype theuri thedist) =+        pPrint thetype <>         text (" " <> uriToString id theuri " " <>               case thedist of                 Left exactPath -> escape exactPath@@ -35,7 +35,7 @@             where escape = escapeURIString isAllowedInURI  instance Pretty (PP [DebSource]) where-    pPrint = hcat . map (\ x -> pPrint (PP x) <> text "\n") . unPP+    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.

@@ -10,7 +10,7 @@ import Data.Foldable (concat, all, foldr) import Data.List as List (intercalate, nub, partition, isSuffixOf) import Data.Maybe-import Debian.Pretty (ppDisplay)+import Debian.Pretty (prettyShow) import Data.Traversable import Debian.Control import qualified Debian.Deb as Deb@@ -73,7 +73,7 @@                                              ))                , ("Files", "\n" ++ unlines fileLines)                ]-       return $ (concat [ source, "_", version, "_", binArch, ".changes"], ppDisplay changes)+       return $ (concat [ source, "_", version, "_", binArch, ".changes"], prettyShow changes) --       let (invalid, binaries) = unzipEithers $ map debNameSplit debs {-        when (not . null $ invalid) (throwDyn [MalformedDebFilename invalid])@@ -218,13 +218,13 @@              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: " ++ ppDisplay c+               (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: " ++ ppDisplay res+               _ -> error $ deb ++ " did not have exactly one paragraph: " ++ prettyShow res   getUploader :: IO String

@@ -1,6 +1,6 @@ {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS -fno-warn-missing-signatures -fno-warn-orphans #-}-module Test.Changes where+module Changes where  import Debian.Changes import Debian.Pretty (PP(..))

@@ -1,18 +1,21 @@ {-# LANGUAGE FlexibleInstances, OverloadedStrings, StandaloneDeriving #-}-module Test.Control where+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 (ppPrint, ppDisplay) import Debian.Relation import Debian.Version (parseDebianVersion)+import Paths_debian (version) import Text.Parsec.Error (ParseError) import Text.PrettyPrint.HughesPJClass (Doc, text)+import Text.Regex.TDFA ((=~), MatchResult(..))  instance Eq Doc where     a == b = show a == show b@@ -23,6 +26,12 @@ -- 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.@@ -41,12 +50,13 @@     , TestCase (parseDebianControlFromFile "Test/Control.hs" >>= \ vc ->                 assertEqual "policy4"                             -- Exceptions have bogus Eq instances, so we need to show then compare.-                            "Left (ParseControlError {locs = [Loc {loc_filename = \"./Debian/Control/Policy.hs\", loc_package = \"main\", loc_module = \"Debian.Control.Policy\", loc_start = (75,54), loc_end = (75,62)}], parseError = \"Test/Control.hs\" (line 0, column 0):\nFailed to parse Test/Control.hs})"+                            "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 (IOError {locs = [Loc {loc_filename = \"./Debian/Control/Policy.hs\", loc_package = \"main\", loc_module = \"Debian.Control.Policy\", loc_start = (74,36), loc_end = (74,44)}], ioError = nonexistant: openBinaryFile: does not exist (No such file or directory)})"-                            (show (either Left (debianRelations "Foo") (vc :: Either ControlFileError DebianControl))))+                            "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

@@ -1,6 +1,6 @@ {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS -fno-warn-missing-signatures -fno-warn-orphans #-}-module Test.Dependencies where+module Dependencies where  import Control.Arrow import Test.HUnit

@@ -2,12 +2,11 @@  import Test.HUnit import System.Exit-import Test.Changes-import Test.Control-import Test.Versions---import Test.VersionPolicy-import Test.SourcesList-import Test.Dependencies+import Changes+import Control+import Versions+import SourcesList+import Dependencies import Text.PrettyPrint.ANSI.Leijen (Doc, text, (<+>), (<$>), fillSep, renderPretty, displayS)  main =

@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-module Test.SourcesList where+module SourcesList where  import Data.Text (Text) import Data.Monoid (mconcat, (<>))

@@ -1,68 +0,0 @@-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

@@ -1,5 +1,5 @@ {-# OPTIONS -fno-warn-missing-signatures -fno-warn-orphans #-}-module Test.Versions where+module Versions where  import Test.HUnit 

@@ -1,3 +1,28 @@+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 <dsf@seereason.com>  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 <dsf@seereason.com>  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 <dsf@seereason.com>  Wed, 04 Feb 2015 11:23:42 -0800+ haskell-debian (3.85.1) unstable; urgency=low    * Allow build with process-extras-0.2.0

@@ -1,5 +1,5 @@ Name:           debian-Version:        3.85.2+Version:        3.87 License:        BSD3 License-File:   debian/copyright Author:         David Fox <dsf@seereason.com>, Jeremy Shaw <jeremy@seereason.com>, Clifford Beshers <beshers@seereason.com>@@ -14,12 +14,16 @@   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/VersionPolicy.hs, Test/Versions.hs, Test/Control.hs, changelog, debian/changelog, debian/changelog.pre-debian+  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:@@ -37,8 +41,6 @@    mtl,    old-locale,    parsec >= 2 && <4,-   pretty,-   prettyclass,    process,    process-extras >= 0.2.0,    pureMD5,@@ -48,13 +50,17 @@    text,    time,    unix,-   Unixutils >= 1.50,+   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:@@ -93,11 +99,7 @@         Debian.UTF8,         Debian.Util.FakeChanges  other-modules:-        Debian.Version.Internal,-        Test.Changes,-        Test.Dependencies,-        Test.SourcesList,-        Test.Versions+        Debian.Version.Internal  Executable fakechanges  Hs-Source-Dirs: utils@@ -124,14 +126,15 @@  ghc-options: -threaded -W -O2  Extensions:           ExistentialQuantification CPP -Executable debian-tests- Main-is: Test/Main.hs- ghc-options: -threaded -W -O2- Build-Depends: ansi-wl-pprint, base, bytestring, containers, debian, directory, exceptions, HUnit, ListLike >= 4.1.1, mtl, parsec, pretty, prettyclass, process, process-extras >= 0.2.0, regex-compat, regex-tdfa, template-haskell, text, utf8-string- if flag(network-uri)-   Build-Depends: network >= 2.6, network-uri >= 2.6+Test-Suite debian-tests+  Type: exitcode-stdio-1.0+  Hs-Source-Dirs: Test+  Main-Is: Main.hs+ Build-Depends: ansi-wl-pprint, base, debian, HUnit, parsec, regex-tdfa, text+ if flag(pretty-new)+   Build-Depends: pretty >= 1.1.2  else-   Build-Depends: network >= 2.4 && < 2.6+   Build-Depends: pretty, prettyclass  source-repository head   type:     git

@@ -1,3 +1,19 @@+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 <dsf@seereason.com>  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 <dsf@seereason.com>  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