debian 3.89 → 3.91

raw patch · 8 files changed

+338/−53 lines, 8 filesdep ~ListLikesetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ListLike

API changes (from Hackage documentation)

Files

• Debian/Changes.hs +3/−44
• Debian/Control.hs +2/−0
• Debian/Control/Builder.hs +161/−0
• Debian/Control/TextLazy.hs +155/−0
• Setup.hs +1/−7
• changelog +6/−0
• debian.cabal +4/−2
• debian/changelog +6/−0

@@ -167,11 +167,11 @@  -- | Parse the entries of a debian changelog and verify they are all -- valid.-parseChangeLog :: String -> ChangeLog+parseChangeLog :: String -> Either [[String]] ChangeLog parseChangeLog s =     case partitionEithers (parseEntries s) of-      ([], xs) -> ChangeLog xs-      (ss, _) -> error (intercalate "\n  " ("Error(s) parsing changelog:" : concat ss))+      ([], xs) -> Right (ChangeLog xs)+      (ss, _) -> Left ss  -- |Parse a Debian Changelog and return a lazy list of entries parseEntries :: String -> [Either [String] ChangeLogEntry]@@ -182,27 +182,6 @@       Right (entry, text') -> Right entry : parseEntries text'  -- |Parse a single changelog entry, returning the entry and the remaining text.-{--parseEntry :: String -> Failing (ChangeLogEntry, String)-parseEntry 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@@ -218,30 +197,10 @@                    after)       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-      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.

@@ -51,7 +51,9 @@ import Debian.Control.String import Data.List import Data.Text as T (Text, pack, concat)+import qualified Debian.Control.Builder () import qualified Debian.Control.Text as T+import qualified Debian.Control.TextLazy as TL import qualified Debian.Control.ByteString as B () import qualified Debian.Control.Policy as P import qualified Debian.Control.String as S

@@ -0,0 +1,161 @@+{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}+module Debian.Control.Builder+    ( -- * Types+      Control'(..)+    , Paragraph'(..)+    , Field'(..)+    , Control+    , Paragraph+    , Field+    -- , ControlParser+    , ControlFunctions(..)+    -- * Control File Parser+    -- , pControl+    -- * Helper Functions+    , mergeControls+    , fieldValue+    , removeField+    , prependFields+    , appendFields+    , renameField+    , modifyField+    , raiseFields+    , decodeControl+    , decodeParagraph+    , decodeField+    ) where++import qualified Data.ByteString.Char8 as B+import Data.Char (toLower, chr)+import Data.List (find)+import qualified Data.ListLike as LL+import Data.ListLike.Text.Builder ()+import qualified Data.Text as T (pack, unpack, map, reverse)+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Builder (Builder, fromLazyText, fromText, toLazyText)+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)+--import Data.Text.IO as T (readFile)+import qualified Debian.Control.ByteString as B+--import Text.Parsec.Error (ParseError)+--import Text.Parsec.Text (Parser)+--import Text.Parsec.Prim (runP)+import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, asString),+                              Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment),+                              mergeControls, fieldValue, removeField, prependFields, appendFields,+                              renameField, modifyField, raiseFields, protectFieldText')++-- | @parseFromFile p filePath@ runs a string parser @p@ on the+-- input read from @filePath@ using 'Prelude.readFile'. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- >  main    = do{ result <- parseFromFile numbers "digits.txt"+-- >              ; case result of+-- >                  Left err  -> print err+-- >                  Right xs  -> print (sum xs)+-- >              }+{-+parseFromFile :: Parser a -> String -> IO (Either ParseError a)+parseFromFile p fname+    = do input <- T.readFile fname `E.catch` (\ (_ :: E.SomeException) -> B.readFile fname >>= return . decode)+         return (runP p () fname input)+-}++type Field = Field' Builder+type Control = Control' Builder+type Paragraph = Paragraph' Builder++decodeControl :: B.Control -> Control+decodeControl (B.Control paragraphs) = Control (map decodeParagraph paragraphs)++decodeParagraph :: B.Paragraph -> Paragraph+decodeParagraph (B.Paragraph s) = B.Paragraph (map decodeField s)++decodeField :: Field' B.ByteString -> Field' Builder+decodeField (B.Field (name, value)) = Field (decode name, decode value)+decodeField (B.Comment s) = Comment (decode s)++decode :: B.ByteString -> Builder+decode = fromText . decodeUtf8With (\ _ w -> fmap (chr . fromIntegral) w)++-- * ControlFunctions++instance ControlFunctions Builder where+    parseControlFromFile filepath =+        -- The ByteString parser is far more efficient than the Text+        -- parser.  By calling decodeControl we tell the compiler to+        -- use it instead.+        parseControlFromFile filepath >>= return . either Left (Right . decodeControl)+    parseControlFromHandle sourceName handle =+        parseControlFromHandle sourceName handle >>= return . either Left (Right . decodeControl)+    parseControl sourceName c =+        -- Warning: This is very slow, it does a utf8 round trip+        either Left (Right . decodeControl) (parseControl sourceName (encodeUtf8 (toStrict (toLazyText c))))+    lookupP fieldName (Paragraph paragraph) =+        find (hasFieldName (map toLower fieldName)) paragraph+        where hasFieldName :: String -> Field' Builder -> Bool+              hasFieldName name (Field (fieldName',_)) = name == LL.map toLower (LL.toString fieldName')+              hasFieldName _ _ = False+    stripWS = dropAround (`elem` (" \t" :: String))+      -- T.strip would also strip newlines+    protectFieldText = protectFieldText'+    asString = LL.toString++dropAround p = LL.dropWhile p . LL.dropWhileEnd p++-- * Control File Parser+{-+-- type ControlParser = GenParser T.Text+type ControlParser a = Parsec T.Text () a++-- |A parser for debian control file. This parser handles control files+-- that end without a newline as well as ones that have several blank+-- lines at the end. It is very liberal and does not attempt validate+-- the fields in any way. All trailing, leading, and folded whitespace+-- is preserved in the field values. See 'stripWS'.+pControl :: ControlParser Control+pControl =+    do many $ char '\n'+       sepEndBy pParagraph pBlanks >>= return . Control++pParagraph :: ControlParser Paragraph+pParagraph = many1 (pComment <|> pField) >>= return . Paragraph++-- |We are liberal in that we allow *any* field to have folded white+-- space, even though the specific restricts that to a few fields.+pField :: ControlParser Field+pField =+    do c1 <- noneOf "#\n"+       fieldName <-  many1 $ noneOf ":\n"+       char ':'+       fieldValue <- many fcharfws+       (char '\n' >> return ()) <|> eof+       return $ Field (T.cons c1 (T.pack fieldName), T.pack fieldValue)++pComment :: ControlParser Field+pComment =+    do char '#'+       text <- many (satisfy (not . ((==) '\n')))+       char '\n'+       return $ Comment (T.pack ("#" <> text <> "\n"))++fcharfws :: ControlParser Char+fcharfws = fchar <|> (try $ lookAhead (string "\n ") >> char '\n') <|> (try $ lookAhead (string "\n\t") >> char '\n') <|> (try $ lookAhead (string "\n#") >> char '\n')++fchar :: ControlParser Char+fchar = satisfy (/='\n')++_fws :: ControlParser T.Text+_fws =+    try $ do char '\n'+             ws <- many1 (char ' ')+             c <- many1 (satisfy (not . ((==) '\n')))+             return $ T.cons '\n' (T.pack ws <> T.pack c)++-- |We go with the assumption that 'blank lines' mean lines that+-- consist of entirely of zero or more whitespace characters.+pBlanks :: ControlParser T.Text+pBlanks =+    do s <- many1 (oneOf " \n")+       return . T.pack $ s+-}

@@ -0,0 +1,155 @@+{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}+module Debian.Control.TextLazy+    ( -- * Types+      Control'(..)+    , Paragraph'(..)+    , Field'(..)+    , Control+    , Paragraph+    , Field+    -- , ControlParser+    , ControlFunctions(..)+    -- * Control File Parser+    -- , pControl+    -- * Helper Functions+    , mergeControls+    , fieldValue+    , removeField+    , prependFields+    , appendFields+    , renameField+    , modifyField+    , raiseFields+    , decodeControl+    , decodeParagraph+    , decodeField+    ) where++import qualified Data.ByteString.Char8 as B+import Data.Char (toLower, chr)+import Data.List (find)+import qualified Data.Text.Lazy as T (Text, pack, unpack, map, dropAround, reverse, fromStrict, toStrict)+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)+--import Data.Text.IO as T (readFile)+import qualified Debian.Control.ByteString as B+--import Text.Parsec.Error (ParseError)+--import Text.Parsec.Text (Parser)+--import Text.Parsec.Prim (runP)+import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, asString),+                              Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment),+                              mergeControls, fieldValue, removeField, prependFields, appendFields,+                              renameField, modifyField, raiseFields, protectFieldText')++-- | @parseFromFile p filePath@ runs a string parser @p@ on the+-- input read from @filePath@ using 'Prelude.readFile'. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- >  main    = do{ result <- parseFromFile numbers "digits.txt"+-- >              ; case result of+-- >                  Left err  -> print err+-- >                  Right xs  -> print (sum xs)+-- >              }+{-+parseFromFile :: Parser a -> String -> IO (Either ParseError a)+parseFromFile p fname+    = do input <- T.readFile fname `E.catch` (\ (_ :: E.SomeException) -> B.readFile fname >>= return . decode)+         return (runP p () fname input)+-}++type Field = Field' T.Text+type Control = Control' T.Text+type Paragraph = Paragraph' T.Text++decodeControl :: B.Control -> Control+decodeControl (B.Control paragraphs) = Control (map decodeParagraph paragraphs)++decodeParagraph :: B.Paragraph -> Paragraph+decodeParagraph (B.Paragraph s) = B.Paragraph (map decodeField s)++decodeField :: Field' B.ByteString -> Field' T.Text+decodeField (B.Field (name, value)) = Field (decode name, decode value)+decodeField (B.Comment s) = Comment (decode s)++decode :: B.ByteString -> T.Text+decode = T.fromStrict . decodeUtf8With (\ _ w -> fmap (chr . fromIntegral) w)++-- * ControlFunctions++instance ControlFunctions T.Text where+    parseControlFromFile filepath =+        -- The ByteString parser is far more efficient than the Text+        -- parser.  By calling decodeControl we tell the compiler to+        -- use it instead.+        parseControlFromFile filepath >>= return . either Left (Right . decodeControl)+    parseControlFromHandle sourceName handle =+        parseControlFromHandle sourceName handle >>= return . either Left (Right . decodeControl)+    parseControl sourceName c =+        -- Warning: This is very slow, it does a utf8 round trip+        either Left (Right . decodeControl) (parseControl sourceName (encodeUtf8 (T.toStrict c)))+    lookupP fieldName (Paragraph paragraph) =+        find (hasFieldName (map toLower fieldName)) paragraph+        where hasFieldName :: String -> Field' T.Text -> Bool+              hasFieldName name (Field (fieldName',_)) = T.pack name == T.map toLower fieldName'+              hasFieldName _ _ = False+    stripWS = T.dropAround (`elem` (" \t" :: String))+      -- T.strip would also strip newlines+    protectFieldText = protectFieldText'+    asString = T.unpack++-- * Control File Parser+{-+-- type ControlParser = GenParser T.Text+type ControlParser a = Parsec T.Text () a++-- |A parser for debian control file. This parser handles control files+-- that end without a newline as well as ones that have several blank+-- lines at the end. It is very liberal and does not attempt validate+-- the fields in any way. All trailing, leading, and folded whitespace+-- is preserved in the field values. See 'stripWS'.+pControl :: ControlParser Control+pControl =+    do many $ char '\n'+       sepEndBy pParagraph pBlanks >>= return . Control++pParagraph :: ControlParser Paragraph+pParagraph = many1 (pComment <|> pField) >>= return . Paragraph++-- |We are liberal in that we allow *any* field to have folded white+-- space, even though the specific restricts that to a few fields.+pField :: ControlParser Field+pField =+    do c1 <- noneOf "#\n"+       fieldName <-  many1 $ noneOf ":\n"+       char ':'+       fieldValue <- many fcharfws+       (char '\n' >> return ()) <|> eof+       return $ Field (T.cons c1 (T.pack fieldName), T.pack fieldValue)++pComment :: ControlParser Field+pComment =+    do char '#'+       text <- many (satisfy (not . ((==) '\n')))+       char '\n'+       return $ Comment (T.pack ("#" <> text <> "\n"))++fcharfws :: ControlParser Char+fcharfws = fchar <|> (try $ lookAhead (string "\n ") >> char '\n') <|> (try $ lookAhead (string "\n\t") >> char '\n') <|> (try $ lookAhead (string "\n#") >> char '\n')++fchar :: ControlParser Char+fchar = satisfy (/='\n')++_fws :: ControlParser T.Text+_fws =+    try $ do char '\n'+             ws <- many1 (char ' ')+             c <- many1 (satisfy (not . ((==) '\n')))+             return $ T.cons '\n' (T.pack ws <> T.pack c)++-- |We go with the assumption that 'blank lines' mean lines that+-- consist of entirely of zero or more whitespace characters.+pBlanks :: ControlParser T.Text+pBlanks =+    do s <- many1 (oneOf " \n")+       return . T.pack $ s+-}

@@ -1,11 +1,5 @@ #!/usr/bin/runhaskell  import Distribution.Simple-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(buildDir))-import Distribution.Simple.Program-import System.Directory-import System.Exit-import System.FilePath ((</>))-import System.Process -main = copyFile "debian/changelog" "changelog" >> defaultMainWithHooks simpleUserHooks+main = defaultMainWithHooks simpleUserHooks

@@ -1,3 +1,9 @@+haskell-debian (3.91) unstable; urgency=low++  * Eliminate error call in parseChangeLog++ -- David Fox <dsf@seereason.com>  Thu, 06 Oct 2016 09:42:06 -0700+ haskell-debian (3.89) unstable; urgency=low    * Change signature of parseDebianVersion to return Either ParseError DebianVerions.

@@ -1,5 +1,5 @@ Name:           debian-Version:        3.89+Version:        3.91 License:        BSD3 License-File:   debian/copyright Author:         David Fox <dsf@seereason.com>, Jeremy Shaw <jeremy@seereason.com>, Clifford Beshers <beshers@seereason.com>@@ -37,7 +37,7 @@    filepath,    HaXml >= 1.20,    HUnit,-   ListLike >= 4.1.1,+   ListLike >= 4.3.5,    mtl,    old-locale,    parsec >= 2 && <4,@@ -72,10 +72,12 @@         Debian.Changes,         Debian.Control,         Debian.Control.Common,+        Debian.Control.Builder         Debian.Control.ByteString,         Debian.Control.Policy,         Debian.Control.String,         Debian.Control.Text,+        Debian.Control.TextLazy,         Debian.Deb,         Debian.Extra.Files,         Debian.GenBuildDeps,

@@ -1,3 +1,9 @@+haskell-debian (3.91) unstable; urgency=low++  * Eliminate error call in parseChangeLog++ -- David Fox <dsf@seereason.com>  Thu, 06 Oct 2016 09:42:06 -0700+ haskell-debian (3.89) unstable; urgency=low    * Change signature of parseDebianVersion to return Either ParseError DebianVerions.