debian 3.84 → 3.85

raw patch · 9 files changed

+116/−23 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Debian/Control/ByteString.hs +22/−3
• Debian/Control/Common.hs +32/−8
• Debian/Control/Policy.hs +0/−3
• Debian/Control/String.hs +3/−2
• Debian/Control/Text.hs +4/−3
• Test/Control.hs +26/−3
• changelog +14/−0
• debian.cabal +1/−1
• debian/changelog +14/−0

@@ -1,4 +1,4 @@-{-# LANGUAGE PackageImports, ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, PackageImports, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Control.ByteString     ( Control'(..)@@ -24,8 +24,11 @@ import qualified Control.Exception as E import "mtl" Control.Monad.State -import Data.Char(toLower)+import Data.Char(toLower, isSpace, chr, ord)+import Data.Word (Word8) import Data.List+import qualified Data.ListLike as LL+import qualified Data.ListLike.String as LL  import Text.ParserCombinators.Parsec.Error import Text.ParserCombinators.Parsec.Pos@@ -34,7 +37,7 @@  import qualified Data.ByteString.Char8 as C -import Debian.Control.Common+import Debian.Control.Common hiding (protectFieldText')  -- Local Modules @@ -119,7 +122,23 @@     -- NOTE: probably inefficient     stripWS = C.reverse . strip . C.reverse . strip         where strip = C.dropWhile (flip elem " \t")+    protectFieldText = protectFieldText'     asString = C.unpack++protectFieldText' :: (LL.StringLike a, LL.ListLike a Word8) => ControlFunctions a => a -> a+protectFieldText' s =+    case LL.lines s of+      [] -> LL.empty+      (l : ls) -> dropWhileEnd (isSpace . chr . fromIntegral) $ LL.unlines $ l : map protect ls+    where+      dropWhileEnd :: (LL.StringLike a, LL.ListLike a Word8) => (Word8 -> Bool) -> a -> a+      dropWhileEnd func = LL.reverse . LL.dropWhile func . LL.reverse -- foldr (\x xs -> if func x && LL.null xs then LL.empty else LL.cons x xs) empty+      protect :: (LL.StringLike a, LL.ListLike a Word8) => a -> a+      protect l = maybe LL.empty (\ c -> if isHorizSpace c then l else LL.cons (ord' ' ' :: Word8) l) (LL.find (const True :: Word8 -> Bool) l)+      isSpace' = isSpace . chr'+      isHorizSpace c = elem c (map ord' " \t")+      ord' = fromIntegral . ord+      chr' = chr . fromIntegral  {- main = 

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, UndecidableInstances #-} module Debian.Control.Common     ( -- * Types       Control'(..)@@ -15,10 +15,14 @@     , raiseFields     , parseControlFromCmd     , md5sumField+    , protectFieldText'     )     where +import Data.Char (isSpace) import Data.List (partition, intersperse)+import Data.ListLike as LL (ListLike, dropWhile, empty, cons, find, reverse)+import Data.ListLike.String as LL (StringLike, lines, unlines) import Data.Monoid ((<>)) import Debian.Pretty (PP(..)) import System.Exit (ExitCode(ExitSuccess, ExitFailure))@@ -57,28 +61,48 @@     -- string. Folded whitespace is /not/ unfolded. This should probably     -- be moved to someplace more general purpose.     stripWS :: a -> a+    -- |Protect field value text so the parser doesn't split it into+    -- multiple fields or paragraphs.  This must modify all field text+    -- to enforce two conditions: (1) All lines other than the initial+    -- one must begin with a space or a tab, and (2) the trailing+    -- white space must not contain newlines.  This is called before+    -- pretty printing to prevent the parser from misinterpreting+    -- field text as multiple fields or paragraphs.+    protectFieldText :: a -> a     asString :: a -> String +-- | This can usually be used as the implementation of protectFieldText+protectFieldText' :: forall a. (StringLike a, ListLike a Char) => ControlFunctions a => a -> a+protectFieldText' s =+    case LL.lines s of+      [] -> empty+      (l : ls) -> dropWhileEnd isSpace $ LL.unlines $ l : map protect ls+    where+      dropWhileEnd :: (Char -> Bool) -> a -> a+      dropWhileEnd func = LL.reverse . LL.dropWhile func . LL.reverse -- foldr (\x xs -> if func x && LL.null xs then LL.empty else LL.cons x xs) empty+      protect :: a -> a+      protect l = maybe empty (\ c -> if elem c " \t" then l else LL.cons ' ' l) (LL.find (const True) l)+ -- | This may have bad performance issues (dsf: Whoever wrote this -- comment should have explained why.)-instance Pretty (PP a) => Pretty (PP (Control' a)) where+instance (ControlFunctions a, Pretty (PP a)) => Pretty (PP (Control' a)) where     pPrint = ppControl . unPP-instance Pretty (PP a) => Pretty (PP (Paragraph' a)) where+instance (ControlFunctions a, Pretty (PP a)) => Pretty (PP (Paragraph' a)) where     pPrint = ppParagraph . unPP -instance Pretty (PP a) => Pretty (PP (Field' a)) where+instance (ControlFunctions a, Pretty (PP a)) => Pretty (PP (Field' a)) where     pPrint = ppField . unPP -ppControl :: Pretty (PP a) => Control' a -> Doc+ppControl :: (ControlFunctions a, Pretty (PP a)) => Control' a -> Doc ppControl (Control paragraph) =     hcat (intersperse (text "\n") (map ppParagraph paragraph)) -ppParagraph :: Pretty (PP a) => Paragraph' a -> Doc+ppParagraph :: (ControlFunctions a, Pretty (PP a)) => Paragraph' a -> Doc ppParagraph (Paragraph fields) =     hcat (map (\ x -> ppField x <> text "\n") fields) -ppField :: Pretty (PP a) => Field' a -> Doc-ppField (Field (n,v)) = pPrint (PP n) <> text ":" <> pPrint (PP v)+ppField :: (ControlFunctions a, Pretty (PP a)) => Field' a -> Doc+ppField (Field (n,v)) = pPrint (PP n) <> text ":" <> pPrint (PP (protectFieldText v)) ppField (Comment c) = pPrint (PP c)  mergeControls :: [Control' a] -> Control' a

@@ -49,9 +49,6 @@ instance Show DebianControl where     show c = "(parseDebianControl \"\" " ++ show (ppDisplay (unDebianControl c)) ++ ")" -instance Show (Control' Text) where-    show c = "(parseControl \"\" " ++ show (ppDisplay c) ++ ")"- -- | Validate and return a control file in an opaque wrapper.  May -- throw a ControlFileError.  Currently we only verify that it has a -- Source field in the first paragraph and one or more subsequent

@@ -26,10 +26,10 @@ import qualified Control.Exception as E import Data.Char (toLower) import Data.List (find)-import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, asString),+import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, protectFieldText, asString),                               Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment),                               mergeControls, fieldValue, removeField, prependFields, appendFields,-                              renameField, modifyField, raiseFields)+                              renameField, modifyField, raiseFields, protectFieldText') import System.IO (hGetContents) import Text.ParserCombinators.Parsec (CharParser, parse, parseFromFile, sepEndBy, satisfy, oneOf, string, lookAhead, try, many, many1, (<|>), noneOf, char, eof) @@ -53,6 +53,7 @@               hasFieldName _ _ = False     stripWS = reverse . strip . reverse . strip         where strip = dropWhile (flip elem " \t")+    protectFieldText = protectFieldText'     asString = id  -- * Control File Parser

@@ -27,9 +27,9 @@     ) where  import qualified Data.ByteString.Char8 as B-import Data.Char (toLower, chr)+import Data.Char (toLower, chr, isSpace) import Data.List (find)-import qualified Data.Text as T (Text, pack, unpack, map, strip, reverse)+import qualified Data.Text as T (Text, pack, unpack, map, strip, reverse, dropWhileEnd) import Data.Text.Encoding (decodeUtf8With, encodeUtf8) --import Data.Text.IO as T (readFile) import qualified Debian.Control.ByteString as B@@ -39,7 +39,7 @@ import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, asString),                               Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment),                               mergeControls, fieldValue, removeField, prependFields, appendFields,-                              renameField, modifyField, raiseFields)+                              renameField, modifyField, raiseFields, protectFieldText')  -- | @parseFromFile p filePath@ runs a string parser @p@ on the -- input read from @filePath@ using 'Prelude.readFile'. Returns either a 'ParseError'@@ -93,6 +93,7 @@               hasFieldName name (Field (fieldName',_)) = T.pack name == T.map toLower fieldName'               hasFieldName _ _ = False     stripWS = T.reverse . T.strip . T.reverse . T.strip+    protectFieldText = protectFieldText'     asString = T.unpack  -- * Control File Parser

@@ -8,9 +8,10 @@ import Debian.Control import Debian.Control.Policy import Debian.Control.Text ({- Pretty instances -})-import Debian.Pretty (ppPrint)+import Debian.Pretty (ppPrint, ppDisplay) import Debian.Relation import Debian.Version (parseDebianVersion)+import Text.Parsec.Error (ParseError) import Text.PrettyPrint.HughesPJClass (Doc, text)  instance Eq Doc where@@ -40,13 +41,35 @@     , 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 = (78,54), loc_end = (78,62)}], parseError = \"Test/Control.hs\" (line 0, column 0):\nFailed to parse Test/Control.hs})"+                            "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})"                             (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 = (77,36), loc_end = (77,44)}], ioError = nonexistant: openBinaryFile: does not exist (No such file or directory)})"+                            "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))))++    -- Test whether embedded newlines in field values can be mistaken+    -- for field or paragraph divisions.  In cases pretty7 and pretty9+    -- the parsed output is not correct, so the buggy result is placed+    -- in the "expected" position.+    , TestCase (assertEqual "pretty6" input6 parsed6)+    , TestCase (assertEqual "pretty7" expected7 parsed7)+    , TestCase (assertEqual "pretty8" input8 parsed8)+    , TestCase (assertEqual "pretty9" expected9 parsed9)     ]+    where+      input6 = Control {unControl = [Paragraph [Field ("Field1", " field1 begins\n  Field1a: indented text that looks like a field")]]} :: Control' String+      input7 = Control {unControl = [Paragraph [Field ("Field1", " field1 begins\nField1a: text that looks like a field")]]} :: Control' String+      -- parsed7buggy = Control {unControl = [Paragraph [Field ("Field1"," field1 begins"),Field ("Field1a"," text that looks like a field")]]} :: Control' String+      expected7 =    Control {unControl = [Paragraph [Field ("Field1"," field1 begins\n Field1a: text that looks like a field")]]}+      input8 = Control {unControl = [Paragraph [Field ("Field1", " field1 content"), Field ("Field2", " an actual second field")]]} :: Control' String+      input9 = Control {unControl = [Paragraph [Field ("Field1", " field1 content\n"), Field ("Field2", " an actual second field")]]} :: Control' String+      -- parsed9buggy = Control {unControl = [Paragraph [Field ("Field1"," field1 content")],Paragraph [Field ("Field2"," an actual second field")]]} :: Control' String+      expected9 =    Control {unControl = [Paragraph [Field ("Field1"," field1 content"),Field ("Field2"," an actual second field")]]}+      (Right parsed6) = parseControl "string" (ppDisplay input6) :: Either ParseError (Control' String)+      (Right parsed7) = parseControl "string" (ppDisplay input7) :: Either ParseError (Control' String)+      (Right parsed8) = parseControl "string" (ppDisplay input8) :: Either ParseError (Control' String)+      (Right parsed9) = parseControl "string" (ppDisplay input9) :: Either ParseError (Control' String)  -- | These paragraphs have no terminating newlines.  They are added -- where appropriate to the expected test results.

@@ -1,3 +1,17 @@+haskell-debian (3.84.2) unstable; urgency=low++  * Fix some cases where the pretty printer output parsed to something+    different from its input++ -- David Fox <dsf@seereason.com>  Sat, 29 Nov 2014 09:27:42 -0800++haskell-debian (3.84.1) unstable; urgency=low++  * Remove a Show instance that overlaps the one derived in the Control+    type declaration.++ -- David Fox <dsf@seereason.com>  Sat, 29 Nov 2014 05:18:40 -0800+ haskell-debian (3.84) unstable; urgency=low    * Replace the Debian.Pretty module with a module copied from the

@@ -1,5 +1,5 @@ Name:           debian-Version:        3.84+Version:        3.85 License:        BSD3 License-File:   debian/copyright Author:         David Fox <dsf@seereason.com>, Jeremy Shaw <jeremy@seereason.com>, Clifford Beshers <beshers@seereason.com>

@@ -1,3 +1,17 @@+haskell-debian (3.84.2) unstable; urgency=low++  * Fix some cases where the pretty printer output parsed to something+    different from its input++ -- David Fox <dsf@seereason.com>  Sat, 29 Nov 2014 09:27:42 -0800++haskell-debian (3.84.1) unstable; urgency=low++  * Remove a Show instance that overlaps the one derived in the Control+    type declaration.++ -- David Fox <dsf@seereason.com>  Sat, 29 Nov 2014 05:18:40 -0800+ haskell-debian (3.84) unstable; urgency=low    * Replace the Debian.Pretty module with a module copied from the