debian 3.80.1 → 3.81
raw patch · 22 files changed
+242/−280 lines, 22 filesdep −ansi-wl-pprint
Dependencies removed: ansi-wl-pprint
Files
- Debian/Apt/Dependencies.hs +2/−1
- Debian/Apt/Index.hs +12/−13
- Debian/Arch.hs +4/−4
- Debian/Changes.hs +15/−15
- Debian/Control/ByteString.hs +22/−113
- Debian/Control/Common.hs +30/−2
- Debian/Control/PrettyPrint.hs +0/−32
- Debian/Control/String.hs +2/−13
- Debian/Control/Text.hs +0/−12
- Debian/Pretty.hs +54/−0
- Debian/Relation.hs +1/−3
- Debian/Relation/Common.hs +14/−18
- Debian/Report.hs +13/−13
- Debian/Sources.hs +11/−8
- Debian/Util/FakeChanges.hs +8/−8
- Debian/Version/Common.hs +4/−4
- Test/Changes.hs +4/−3
- Test/Control.hs +10/−10
- Test/SourcesList.hs +7/−4
- changelog +13/−0
- debian.cabal +3/−4
- debian/changelog +13/−0
Debian/Apt/Dependencies.hs view
@@ -20,6 +20,7 @@ import Debian.Apt.Package(PackageNameMap, packageNameMap, lookupPackageByRel) import Debian.Control.ByteString(ControlFunctions(stripWS, lookupP, parseControlFromFile), Field'(Field, Comment), Control'(Control), Paragraph, Control)+import Debian.Pretty (render) import Debian.Relation (BinPkgName(..)) import Debian.Relation.ByteString(ParseRelations(..), Relation(..), OrRelation, AndRelation, Relations, checkVersionReq) import Debian.Version(DebianVersion, parseDebianVersion, prettyDebianVersion)@@ -102,7 +103,7 @@ gutsyPackages = "/var/lib/apt/lists/mirror.anl.gov_pub_ubuntu_dists_gutsy_main_binary-i386_Packages" test controlFP rel labeler =- testCSP controlFP depF rel (mapM_ (\ (_,p) -> mapM_ (print . second prettyDebianVersion . packageVersionParagraph) p ) . take 1 . search labeler)+ testCSP controlFP depF rel (mapM_ (\ (_,p) -> mapM_ (print . second (render . prettyDebianVersion) . packageVersionParagraph) p ) . take 1 . search labeler) -- TODO: add better errors packageVersionParagraph :: Paragraph -> (BinPkgName, DebianVersion)
Debian/Apt/Index.hs view
@@ -22,17 +22,17 @@ import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Digest.Pure.MD5 as MD5 import Data.Function-import Data.List+import Data.List as List (null, intercalate, sortBy, isSuffixOf, isPrefixOf) import qualified Data.Map as M import Data.Monoid ((<>))-import qualified Data.Text as T (Text, unpack, concat, lines, null, words)+import Data.Text as Text (Text, unpack, concat, lines, null, words) import Data.Time import Debian.Apt.Methods import Debian.Control (formatControl) import Debian.Control.ByteString import Debian.Control.Common import Debian.Control.Text (decodeControl)---import Debian.Repo.Types+import Debian.Pretty (pretty, render) import Debian.Release import Debian.Sources import Debian.URI@@ -42,7 +42,6 @@ import System.FilePath (takeBaseName) --import qualified System.Unix.Misc as Misc import Text.ParserCombinators.Parsec.Error-import Text.PrettyPrint.ANSI.Leijen (pretty) -- |Package indexes on the server are uncompressed or compressed with -- gzip or bzip2. We do not know what will exist on the server until we@@ -124,7 +123,7 @@ where baseURI = sourceUri debSource (release, sections) =- either (error $ "indexURIs: support not implemented for exact path: " ++ show (pretty debSource)) id (sourceDist debSource)+ either (error $ "indexURIs: support not implemented for exact path: " ++ unpack (render (pretty debSource))) id (sourceDist debSource) -- |return a tuple for the section -- - the URI to the uncompressed index file@@ -175,13 +174,13 @@ (h, t) -> h : wordsBy p (drop 1 t) -- |Parse a possibly compressed index file.-controlFromIndex :: Compression -> FilePath -> L.ByteString -> Either ParseError (Control' T.Text)+controlFromIndex :: Compression -> FilePath -> L.ByteString -> Either ParseError (Control' Text) controlFromIndex GZ path s = either Left (Right . decodeControl) . parseControl path . B.concat . L.toChunks . GZip.decompress $ s controlFromIndex BZ2 path s = either Left (Right . decodeControl) . parseControl path . B.concat . L.toChunks . BZip.decompress $ s controlFromIndex Uncompressed path s = either Left (Right . decodeControl) . parseControl path . B.concat . L.toChunks $ s -- |parse an index possibly compressed file-controlFromIndex' :: Compression -> FilePath -> IO (Either ParseError (Control' T.Text))+controlFromIndex' :: Compression -> FilePath -> IO (Either ParseError (Control' Text)) controlFromIndex' compression path = L.readFile path >>= return . controlFromIndex compression path type Size = Integer@@ -236,7 +235,7 @@ let indexes = groupIndexes controlFiles in do indexes' <- mapM (filterExists distDir) (filter (isType iType) indexes)- return $ map (head . snd) (filter (not . null . snd) indexes')+ return $ map (head . snd) (filter (not . List.null . snd) indexes') where isType iType (fp, _) = iType `isSuffixOf` fp @@ -267,7 +266,7 @@ | otherwise = (fp, Uncompressed) indexesInRelease :: (FilePath -> Bool)- -> Control' T.Text -- ^ A release file+ -> Control' Text -- ^ A release file -> [(CheckSums, Integer, FilePath)] -- ^ indexesInRelease filterp (Control [p]) = let md5sums =@@ -275,12 +274,12 @@ (Just md5) -> md5 Nothing -> error $ "Did not find MD5Sum field." in- filter (\(_,_,fp) -> filterp fp) $ map (makeTuple . T.words) $ filter (not . T.null) (T.lines md5sums)+ filter (\(_,_,fp) -> filterp fp) $ map (makeTuple . Text.words) $ filter (not . Text.null) (Text.lines md5sums) where- makeTuple :: [T.Text] -> (CheckSums, Integer, FilePath)- makeTuple [md5sum, size, fp] = (CheckSums { md5sum = Just (T.unpack md5sum), sha1 = Nothing, sha256 = Nothing }, read (T.unpack size), T.unpack fp)+ makeTuple :: [Text] -> (CheckSums, Integer, FilePath)+ makeTuple [md5sum, size, fp] = (CheckSums { md5sum = Just (Text.unpack md5sum), sha1 = Nothing, sha256 = Nothing }, read (Text.unpack size), Text.unpack fp) makeTuple x = error $ "Invalid line in release file: " ++ show x-indexesInRelease _ x = error $ "Invalid release file: " <> T.unpack (T.concat (formatControl x))+indexesInRelease _ x = error $ "Invalid release file: " <> Text.unpack (Text.concat (formatControl x)) -- |make a FileTuple for a file found on the local disk -- returns 'Nothing' if the file does not exist.
Debian/Arch.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} module Debian.Arch ( Arch(..) , ArchOS(..)@@ -10,12 +10,12 @@ import Data.Data (Data) import Data.Monoid ((<>)) import Data.Typeable (Typeable)-import Text.PrettyPrint.ANSI.Leijen (Doc, text)+import Debian.Pretty (Doc, Pretty(pretty), text) data ArchOS = ArchOS String | ArchOSAny deriving (Eq, Ord, Read, Show, Data, Typeable) prettyOS :: ArchOS -> Doc-prettyOS (ArchOS s) = text s+prettyOS (ArchOS s) = pretty s prettyOS ArchOSAny = text "any" parseOS :: String -> ArchOS@@ -25,7 +25,7 @@ data ArchCPU = ArchCPU String | ArchCPUAny deriving (Eq, Ord, Read, Show, Data, Typeable) prettyCPU :: ArchCPU -> Doc-prettyCPU (ArchCPU s) = text s+prettyCPU (ArchCPU s) = pretty s prettyCPU ArchCPUAny = text "any" parseCPU :: String -> ArchCPU
Debian/Changes.hs view
@@ -14,15 +14,16 @@ import Data.Either (partitionEithers) import Data.List (intercalate, intersperse)+import Data.Monoid ((<>)) import Data.Text (Text, pack, unpack, strip) import Debian.Arch (Arch, prettyArch) import qualified Debian.Control.String as S+import Debian.Pretty (Doc, empty, Pretty(pretty), cat, vcat, render) import Debian.Release import Debian.URI() import Debian.Version import System.Posix.Types import Text.Regex.TDFA hiding (empty)-import Text.PrettyPrint.ANSI.Leijen -- |A file generated by dpkg-buildpackage describing the result of a -- package build@@ -69,36 +70,35 @@ -} changesFileName :: ChangesFile -> String-changesFileName changes =- changePackage changes ++ "_" ++ show (prettyDebianVersion (changeVersion changes) <> text "_" <> prettyArch (changeArch changes) <> text ".changes")+changesFileName = unpack . render . pretty instance Pretty ChangesFile where- pretty = text . changesFileName+ pretty changes = pretty (changePackage changes ++ "_") <> prettyDebianVersion (changeVersion changes) <> pretty "_" <> prettyArch (changeArch changes) <> pretty ".changes" instance Pretty ChangedFileSpec where pretty file =- text (changedFileMD5sum file ++ " " ++- show (changedFileSize file) ++ " " ++- sectionName (changedFileSection file) ++ " " ++- changedFilePriority file ++ " " +++ pretty (changedFileMD5sum file <> " " <>+ show (changedFileSize file) <> " " <>+ sectionName (changedFileSection file) <> " " <>+ changedFilePriority file <> " " <> changedFileName file) instance Pretty ChangeLogEntry where pretty (Entry package ver dists urgency details who date) =- vcat [ text (package ++ " (" ++ show (prettyDebianVersion ver) ++ ") " ++ intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency)- , empty- , text (" " ++ unpack (strip (pack details)))- , empty- , text (" -- " ++ who ++ " " ++ date) ]+ cat [ pretty (package <> " (") <> prettyDebianVersion ver <> pretty (") " <> intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency)+ , pretty "\n\n"+ , pretty " " <> pretty (strip (pack details))+ , pretty "\n\n"+ , pretty (" -- " <> who <> " " <> date) ] pretty (WhiteSpace _) = error "instance Pretty ChangeLogEntry" instance Pretty ChangeLog where- pretty (ChangeLog xs) = vcat (intersperse empty (map pretty xs)) <> text "\n"+ pretty (ChangeLog xs) = vcat (intersperse empty (map pretty xs)) -- |Show just the top line of a changelog entry (for debugging output.) _showHeader :: ChangeLogEntry -> Doc _showHeader (Entry package ver dists urgency _ _ _) =- text (package ++ " (" ++ show (prettyDebianVersion ver) ++ ") " ++ intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency ++ "...")+ pretty (package <> " (") <> prettyDebianVersion ver <> pretty (") " <> intercalate " " (map releaseName' dists) <> "; urgency=" <> urgency <> "...") _showHeader (WhiteSpace _) = error "_showHeader" {-
Debian/Control/ByteString.hs view
@@ -24,24 +24,14 @@ import qualified Control.Exception as E import "mtl" Control.Monad.State -import Data.Char(chr,ord,toLower)+import Data.Char(toLower) import Data.List-import Data.Word -import Foreign.ForeignPtr-import Foreign.Ptr-import Foreign.Storable (Storable(..))--import System.IO.Unsafe- import Text.ParserCombinators.Parsec.Error import Text.ParserCombinators.Parsec.Pos -- Third Party Modules -import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as BB-import qualified Data.ByteString.Internal as BB import qualified Data.ByteString.Char8 as C import Debian.Control.Common@@ -68,15 +58,12 @@ pKey = notEmpty $ pTakeWhile (\c -> (c /= ':') && (c /= '\n')) pValue :: ControlParser C.ByteString-pValue = pTakeWhile2 (\a b -> not (endOfValue a b))- where- endOfValue :: Char -> Maybe Char -> Bool- endOfValue '\n' Nothing = True- endOfValue '\n' (Just ' ') = False- endOfValue '\n' (Just '\t') = False- endOfValue '\n' (Just '#') = False- endOfValue '\n' _ = True- endOfValue _ _ = False+pValue = Parser $ \bs ->+ let newlines = C.elemIndices '\n' bs+ rest = dropWhile continuedAfter newlines ++ [C.length bs]+ continuedAfter i = bs `safeIndex` (i+1) `elem` map Just " \t#"+ (text, bs') = C.splitAt (head rest) bs+ in Ok (text, bs') pField :: ControlParser Field pField =@@ -88,15 +75,15 @@ return (Field (k,v)) pComment :: ControlParser Field-pComment =- do c1 <- pChar '#'- text <- pTakeWhile2 (\ a b -> not (endOfComment a b))- return . Comment $ (B.append (B.singleton . c2w $ c1) text)- where- endOfComment '\n' Nothing = True- endOfComment '\n' (Just '#') = False- endOfComment '\n' _ = True- endOfComment _ _ = False+pComment = Parser $ \bs ->+ let newlines = C.elemIndices '\n' bs+ linestarts = 0 : map (+1) newlines+ rest = dropWhile commentAt linestarts ++ [C.length bs]+ commentAt i = bs `safeIndex` i == Just '#'+ (text, bs') = C.splitAt (head rest) bs+ in if C.null text+ then Empty+ else Ok (Comment text, bs') pParagraph :: ControlParser Paragraph pParagraph = @@ -141,82 +128,8 @@ -} -- * Helper Functions --- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@,--- returns the longest prefix (possibly empty) of @xs@ of elements that--- satisfy @p@.-_takeWhile2 :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> B.ByteString-_takeWhile2 f ps = BB.unsafeTake (findIndex2OrEnd (\w1 w2 -> not (f w1 w2)) ps) ps-{-# INLINE _takeWhile2 #-}--break2 :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> Maybe (B.ByteString, B.ByteString)-break2 p ps = case findIndex2OrEnd p ps of n -> Just (BB.unsafeTake n ps, BB.unsafeDrop n ps)--span2 :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> Maybe (B.ByteString, B.ByteString)-span2 p ps = break2 (\a b -> not (p a b)) ps----- | 'findIndexOrEnd' is a variant of findIndex, that returns the length--- of the string if no element is found, rather than Nothing.--findIndex2OrEnd :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> Int-findIndex2OrEnd k (BB.PS x s l) = unsafePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0- where- go a b | a `seq` b `seq` False = undefined- go ptr n | n >= l = return l- | otherwise = do w1 <- peek ptr- w2 <- if (n + 1 < l) then (peek (ptr `plusPtr` 1) >>= return . Just) else return Nothing- if k w1 w2- then return n- else go (ptr `plusPtr` 1) (n+1)---{--findIndex2OrEnd :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> Int-findIndex2OrEnd k (B.PS x s l) = unsafePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0- where- go a b | a `seq` b `seq` False = undefined- go ptr n | n >= l = return l- | otherwise = do w1 <- peek ptr- case (w2c w1) of- '\n' ->- if (n + 1 < l)- then do w2 <- peek (ptr `plusPtr` 1)- case (w2c w2) of- ' ' -> go (ptr `plusPtr` 2) (n + 2)- _ -> return n- else return l -- go (ptr `plusPtr` 1) (n + 1)- _ -> go (ptr `plusPtr` 1) (n + 1)--}-{-- w2 <- if (n + 1 < l) then (peek (ptr `plusPtr` 1) >>= return . Just) else return Nothing- if k w1 w2- then return n- else go (ptr `plusPtr` 1) (n+1)--}-{-# INLINE findIndex2OrEnd #-}---- | The 'findIndex' function takes a predicate and a 'ByteString' and--- returns the index of the first element in the ByteString--- satisfying the predicate.-_findIndex2 :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> Maybe Int-_findIndex2 k (BB.PS x s l) = unsafePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0- where- go a b | a `seq` b `seq` False = undefined- go ptr n | n >= l = return Nothing- | otherwise = do w1 <- peek ptr- w2 <- if (n + 1 < l) then (peek (ptr `plusPtr` 1) >>= return . Just) else return Nothing- if k w1 w2- then return (Just n)- else go (ptr `plusPtr` 1) (n+1)-{-# INLINE _findIndex2 #-}---- Copied from ByteStream because they are not exported--w2c :: Word8 -> Char-w2c = chr . fromIntegral--c2w :: Char -> Word8-c2w = fromIntegral . ord+safeIndex :: C.ByteString -> Int -> Maybe Char+bs `safeIndex` i = if i < C.length bs then Just (bs `C.index` i) else Nothing -- * Parser @@ -226,9 +139,9 @@ | Empty deriving Show -m2r :: Maybe a -> Result a-m2r (Just a) = Ok a-m2r Nothing = Empty +-- m2r :: Maybe a -> Result a+-- m2r (Just a) = Ok a+-- m2r Nothing = Empty r2m :: Result a -> Maybe a r2m (Ok a) = Just a@@ -295,13 +208,9 @@ pEOF = Parser $ \bs -> if C.null bs then Ok ((),bs) else Empty -pTakeWhile2 :: (Char -> Maybe Char -> Bool) -> Parser C.ByteString C.ByteString-pTakeWhile2 f =- Parser $ \bs -> m2r (span2 (\w1 w2 -> f (w2c w1) (fmap w2c w2)) bs)- pTakeWhile :: (Char -> Bool) -> Parser C.ByteString C.ByteString pTakeWhile f =- Parser $ \bs -> Ok (B.span (\w -> f (w2c w)) bs)+ Parser $ \bs -> Ok (C.span f bs) _pSkipWhile :: (Char -> Bool) -> Parser C.ByteString () _pSkipWhile p =
Debian/Control/Common.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Debian.Control.Common ( -- * Types Control'(..)@@ -17,11 +18,13 @@ ) where -import Text.ParserCombinators.Parsec (ParseError)+import Data.List (partition, intersperse)+import Data.Monoid ((<>))+import Debian.Pretty (Doc, text, Pretty(pretty), cat, vcat) import System.Exit (ExitCode(ExitSuccess, ExitFailure)) import System.IO (Handle) import System.Process (runInteractiveCommand, waitForProcess)-import Data.List (partition)+import Text.ParserCombinators.Parsec (ParseError) newtype Control' a = Control { unControl :: [Paragraph' a] }@@ -53,6 +56,31 @@ -- be moved to someplace more general purpose. stripWS :: a -> a asString :: a -> String++-- |This may have bad performance issues (why?)+instance Pretty a => Pretty (Control' a) where+ pretty = ppControl+ -- pretty (Control paragraphs) = vcat (map pretty paragraphs)+instance Pretty a => Pretty (Paragraph' a) where+ pretty = ppParagraph+ -- pretty (Paragraph fields) = vcat (map pretty fields ++ [empty])++instance Pretty a => Pretty (Field' a) where+ pretty = ppField+ -- pretty (Field (name,value)) = pretty name <> text ":" <> pretty value+ -- pretty (Comment s) = pretty s++ppControl :: (Pretty a) => Control' a -> Doc+ppControl (Control paragraph) =+ cat (intersperse (text "\n") (map ppParagraph paragraph))++ppParagraph :: (Pretty a) => Paragraph' a -> Doc+ppParagraph (Paragraph fields) =+ vcat (map ppField fields)++ppField :: (Pretty a) => Field' a -> Doc+ppField (Field (n,v)) = pretty n <> text ":" <> pretty v+ppField (Comment c) = pretty c mergeControls :: [Control' a] -> Control' a mergeControls controls =
− Debian/Control/PrettyPrint.hs
@@ -1,32 +0,0 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}-module Debian.Control.PrettyPrint where--import qualified Data.ByteString.Char8 as C-import Data.Text as T (Text, unpack)-import Text.PrettyPrint.ANSI.Leijen--import Debian.Control.Common--ppControl :: (ToText a) => Control' a -> Doc-ppControl (Control paragraph) =- vcat (map ppParagraph paragraph)--ppParagraph :: (ToText a) => Paragraph' a -> Doc-ppParagraph (Paragraph fields) =- vcat (map ppField fields ++ [empty])--ppField :: (ToText a) => Field' a -> Doc-ppField (Field (n,v)) = totext n <> text ":" <> totext v-ppField (Comment c) = totext c--class ToText a where- totext :: a -> Doc--instance ToText String where- totext = text--instance ToText C.ByteString where- totext = text . C.unpack--instance ToText Text where- totext = text . T.unpack
Debian/Control/String.hs view
@@ -26,23 +26,12 @@ import qualified Control.Exception as E import Data.Char (toLower) import Data.List (find)-import Text.ParserCombinators.Parsec (CharParser, parse, parseFromFile, sepEndBy, satisfy, oneOf, string, lookAhead, try, many, many1, (<|>), noneOf, char, eof)-import System.IO (hGetContents) 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)-import Text.PrettyPrint.ANSI.Leijen (Pretty(pretty), text, vcat, empty)---- |This may have bad performance issues (why?)-instance Pretty (Control' String) where- pretty (Control paragraphs) = vcat (map (\ p -> pretty p) paragraphs)-instance Pretty (Paragraph' String) where- pretty (Paragraph fields) = vcat (map pretty fields ++ [empty])--instance Pretty (Field' String) where- pretty (Field (name,value)) = text $ name ++":"++ value- pretty (Comment s) = text s+import System.IO (hGetContents)+import Text.ParserCombinators.Parsec (CharParser, parse, parseFromFile, sepEndBy, satisfy, oneOf, string, lookAhead, try, many, many1, (<|>), noneOf, char, eof) type Field = Field' String type Control = Control' String
Debian/Control/Text.hs view
@@ -29,7 +29,6 @@ import qualified Data.ByteString.Char8 as B import Data.Char (toLower, chr) import Data.List (find)-import Data.Monoid ((<>)) import qualified Data.Text as T (Text, pack, unpack, map, strip, reverse) import Data.Text.Encoding (decodeUtf8With, encodeUtf8) --import Data.Text.IO as T (readFile)@@ -41,7 +40,6 @@ Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment), mergeControls, fieldValue, removeField, prependFields, appendFields, renameField, modifyField, raiseFields)-import Text.PrettyPrint.ANSI.Leijen (Pretty(pretty), text, vcat, empty) -- | @parseFromFile p filePath@ runs a string parser @p@ on the -- input read from @filePath@ using 'Prelude.readFile'. Returns either a 'ParseError'@@ -58,16 +56,6 @@ = do input <- T.readFile fname `E.catch` (\ (_ :: E.SomeException) -> B.readFile fname >>= return . decode) return (runP p () fname input) -}---- |This may have bad performance issues (why?)-instance Pretty (Control' T.Text) where- pretty (Control paragraphs) = vcat (map (\ p -> pretty p) paragraphs)-instance Pretty (Paragraph' T.Text) where- pretty (Paragraph fields) = vcat (map pretty fields ++ [empty])--instance Pretty (Field' T.Text) where- pretty (Field (name,value)) = text . T.unpack $ name <>":"<> value- pretty (Comment s) = text (T.unpack s) type Field = Field' T.Text type Control = Control' T.Text
+ Debian/Pretty.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-}+module Debian.Pretty+ ( Doc+ , text+ , empty+ , cat+ , vcat+ , Pretty(pretty)+ , render+ , (<>)+ ) where++-- import qualified Data.ByteString.Char8 as C+import Data.List (intersperse)+import Data.Monoid (Monoid(mempty, mappend), (<>))+import Data.Text (Text, pack, unpack)++data Doc = Doc {unDoc :: Text}++instance Monoid Doc where+ mempty = Doc mempty+ mappend (Doc a) (Doc b) = Doc (a <> b)++empty :: Doc+empty = Doc mempty++text :: Text -> Doc+text = Doc++cat :: [Doc] -> Doc+cat = foldl (<>) empty++vcat :: [Doc] -> Doc+vcat xs = cat (intersperse (Doc "\n") xs) <> Doc "\n"++class Pretty a where+ pretty :: a -> Doc++instance Pretty String where+ pretty = text . pack++instance Pretty Text where+ pretty = text++-- instance ToText C.ByteString where+-- totext = text . C.unpack++render :: Doc -> Text+render = unDoc++-- I'm keeping this for backwards compatibility, though it doesn't seem like+-- a proper use of the Show class to me.+instance Show Doc where+ show = unpack . render
Debian/Relation.hs view
@@ -7,8 +7,6 @@ , Relations , AndRelation , OrRelation- , prettyOrRelation- , prettyRelations , Relation(..) , ArchitectureReq(..) , Arch(..)@@ -23,5 +21,5 @@ ) where import Debian.Arch (Arch(..), ArchOS(..), ArchCPU(..))-import Debian.Relation.Common (SrcPkgName(..), BinPkgName(..), PkgName(pkgNameFromString), prettyOrRelation, prettyRelations)+import Debian.Relation.Common (SrcPkgName(..), BinPkgName(..), PkgName(pkgNameFromString)) import Debian.Relation.String
Debian/Relation/Common.hs view
@@ -1,16 +1,16 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-} module Debian.Relation.Common where -- Standard GHC Modules import Data.List as List (map, intersperse)-import Data.Monoid (mconcat)+import Data.Monoid (mconcat, (<>)) import Data.Function import Data.Set as Set (Set, toList) import Debian.Arch (Arch, prettyArch)+import Debian.Pretty (Pretty(pretty), Doc, text, empty) import Prelude hiding (map) import Text.ParserCombinators.Parsec-import Text.PrettyPrint.ANSI.Leijen (Pretty(pretty), Doc, text, empty, (<>)) -- Local Modules @@ -78,11 +78,11 @@ deriving (Eq, Show) prettyVersionReq :: VersionReq -> Doc-prettyVersionReq (SLT v) = text $ " (<< " ++ show (prettyDebianVersion v) ++ ")"-prettyVersionReq (LTE v) = text $ " (<= " ++ show (prettyDebianVersion v) ++ ")"-prettyVersionReq (EEQ v) = text $ " (= " ++ show (prettyDebianVersion v) ++ ")"-prettyVersionReq (GRE v) = text $ " (>= " ++ show (prettyDebianVersion v) ++ ")"-prettyVersionReq (SGR v) = text $ " (>> " ++ show (prettyDebianVersion v) ++ ")"+prettyVersionReq (SLT v) = text " (<< " <> prettyDebianVersion v <> text ")"+prettyVersionReq (LTE v) = text " (<= " <> prettyDebianVersion v <> text ")"+prettyVersionReq (EEQ v) = text " (= " <> prettyDebianVersion v <> text ")"+prettyVersionReq (GRE v) = text " (>= " <> prettyDebianVersion v <> text ")"+prettyVersionReq (SGR v) = text " (>> " <> prettyDebianVersion v <> text ")" -- |The sort order is based on version number first, then on the kind of -- relation, sorting in the order <<, <= , ==, >= , >>@@ -105,20 +105,16 @@ checkVersionReq (Just (SGR v1)) (Just v2) = v2 > v1 instance Pretty BinPkgName where- pretty = text . unBinPkgName+ pretty = pretty . unBinPkgName instance Pretty SrcPkgName where- pretty = text . unSrcPkgName+ pretty = pretty . unSrcPkgName --- Unfortunately, the ansi-wl-pprint package has an instance @Pretty a--- => Pretty [a]@, so we can't create an instance for a list of one--- particular type.+instance Pretty Relations where+ pretty = prettyRelations --- instance Pretty Relations where--- pretty = prettyRelations------ instance Pretty OrRelation where--- pretty = prettyOrRelation+instance Pretty OrRelation where+ pretty = prettyOrRelation instance Pretty Relation where pretty = prettyRelation
Debian/Report.hs view
@@ -1,14 +1,14 @@ module Debian.Report where import Debian.Apt.Index (Fetcher, Compression(..), update, controlFromIndex')-import Debian.Control.Common (unControl) import Debian.Control.Text+import Debian.Pretty (render) import Debian.Sources import Debian.Version import Data.Maybe import qualified Data.Map as M-import qualified Data.Text as T+import Data.Text as Text (Text, unpack) import Text.XML.HaXml (CFilter, mkElem, cdata) import Text.XML.HaXml.Posn @@ -21,7 +21,7 @@ -- time to avoid having all the control files loaded in memory at -- once. However, I am not sure that property is actually occuring -- anyway. So, this should be revisited.-makePackageMap :: (Paragraph -> a) -> (a -> a -> a) -> [(FilePath, Compression)] -> IO (M.Map T.Text a)+makePackageMap :: (Paragraph -> a) -> (a -> a -> a) -> [(FilePath, Compression)] -> IO (M.Map Text a) makePackageMap _ _ [] = return M.empty makePackageMap extractValue resolveConflict ((path, compression):is) = do r <- controlFromIndex' compression path@@ -33,7 +33,7 @@ return $ M.unionWith resolveConflict pm pms -- |create a map of (package name, max version) from a single control file-packageMap :: (Paragraph -> a) -> (a -> a -> a) -> Control' T.Text -> M.Map T.Text a+packageMap :: (Paragraph -> a) -> (a -> a -> a) -> Control' Text -> M.Map Text a packageMap extractValue resolveConflict control = M.fromListWith resolveConflict (map packageTuple (unControl control)) where@@ -41,7 +41,7 @@ -- |extract the version number from a control paragraph extractVersion :: Paragraph -> Maybe DebianVersion-extractVersion paragraph = fmap (parseDebianVersion . T.unpack) $ fieldValue "Version" paragraph+extractVersion paragraph = fmap (parseDebianVersion . unpack) $ fieldValue "Version" paragraph -- * Trump Report @@ -52,7 +52,7 @@ -> String -- ^ binary architecture -> [DebSource] -- ^ sources.list a -> [DebSource] -- ^ sources.list b- -> IO (M.Map T.Text (DebianVersion, DebianVersion)) -- ^ a map of trumped package names to (version a, version b)+ -> IO (M.Map Text (DebianVersion, DebianVersion)) -- ^ a map of trumped package names to (version a, version b) trumped fetcher cacheDir arch sourcesA sourcesB = do indexesA <- update fetcher cacheDir arch (filter isDebSrc sourcesA) pmA <- makePackageMap (fromJust . extractVersion) max (map fromJust indexesA)@@ -63,9 +63,9 @@ isDebSrc ds = sourceType ds == DebSrc -- |calculate all the trumped packages-trumpedMap :: M.Map T.Text DebianVersion -- ^ package map a- -> M.Map T.Text DebianVersion -- ^ package map b- -> M.Map T.Text (DebianVersion, DebianVersion) -- ^ trumped packages (version a, version b)+trumpedMap :: M.Map Text DebianVersion -- ^ package map a+ -> M.Map Text DebianVersion -- ^ package map b+ -> M.Map Text (DebianVersion, DebianVersion) -- ^ trumped packages (version a, version b) trumpedMap pmA pmB = M.foldWithKey (checkTrumped pmB) M.empty pmA where@@ -76,13 +76,13 @@ _ -> trumpedPM -- |create <trumped /> XML element and children from a trumped Map-trumpedXML :: M.Map T.Text (DebianVersion, DebianVersion) -> CFilter Posn+trumpedXML :: M.Map Text (DebianVersion, DebianVersion) -> CFilter Posn trumpedXML trumpedMap' = mkElem "trumped" (map mkTrumpedPackage (M.toAscList trumpedMap' )) where mkTrumpedPackage (package, (oldVersion, newVersion)) = mkElem "trumpedPackage"- [ mkElem "package" [ cdata (T.unpack package) ]- , mkElem "oldVersion" [ cdata (show (prettyDebianVersion oldVersion)) ]- , mkElem "newVersion" [ cdata (show (prettyDebianVersion newVersion)) ]+ [ mkElem "package" [ cdata (unpack package) ]+ , mkElem "oldVersion" [ cdata (unpack . render . prettyDebianVersion $ oldVersion) ]+ , mkElem "newVersion" [ cdata (unpack . render . prettyDebianVersion $ newVersion) ] ]
Debian/Sources.hs view
@@ -1,10 +1,13 @@+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Debian.Sources where import Data.List (intercalate)+import Data.Monoid ((<>))+import Data.Text (pack)+import Debian.Pretty (Pretty(pretty), text) import Debian.Release import Network.URI (URI, uriToString, parseURI, unEscapeString, escapeURIString, isAllowedInURI)-import Text.PrettyPrint.ANSI.Leijen (Pretty(pretty), text) data SourceType = Deb | DebSrc@@ -22,13 +25,13 @@ pretty DebSrc = text "deb-src" instance Pretty DebSource where- pretty (DebSource thetype theuri thedist) = text $- (show (pretty thetype)) ++ " "++ uriToString id theuri " " ++- (case thedist of- Left exactPath -> escape exactPath- Right (dist, sections) ->- releaseName' dist ++ " " ++ intercalate " " (map sectionName' sections))- where escape = escapeURIString isAllowedInURI+ pretty (DebSource thetype theuri thedist) =+ pretty thetype <>+ text (" " <> pack (uriToString id theuri " ") <>+ case thedist of+ Left exactPath -> escape exactPath+ Right (dist, sections) -> pack (releaseName' dist <> " " <> intercalate " " (map sectionName' sections)))+ where escape = pack . escapeURIString isAllowedInURI -- |This is a name given to a combination of parts of one or more -- releases that can be specified by a sources.list file.
Debian/Util/FakeChanges.hs view
@@ -5,24 +5,24 @@ import Control.Exception import Control.Monad hiding (mapM) import qualified Data.ByteString.Lazy.Char8 as L+import Data.Data (Data, Typeable) import qualified Data.Digest.Pure.MD5 as MD5 import Data.Foldable (concat, all, foldr) import Data.List as List (intercalate, nub, partition, isSuffixOf)-import Data.Maybe ---import Data.Typeable-import Data.Data (Data, Typeable)+import Data.Maybe+import Data.Text (unpack) import Data.Traversable-import Debian.Time import System.Environment import System.FilePath import System.Posix.Files import Text.Regex.TDFA import Prelude hiding (concat, foldr, all, mapM, sum) import Network.BSD-import Text.PrettyPrint.ANSI.Leijen (pretty) import Debian.Control import qualified Debian.Deb as Deb+import Debian.Pretty (pretty, render)+import Debian.Time -- import System.Unix.FilePath -- import System.Unix.Misc @@ -78,7 +78,7 @@ )) , ("Files", "\n" ++ unlines fileLines) ]- return $ (concat [ source, "_", version, "_", binArch, ".changes"], show (pretty changes))+ return $ (concat [ source, "_", version, "_", binArch, ".changes"], unpack (render (pretty changes))) -- let (invalid, binaries) = unzipEithers $ map debNameSplit debs {- when (not . null $ invalid) (throwDyn [MalformedDebFilename invalid])@@ -223,13 +223,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: " ++ show (pretty c)+ (Right c) -> error $ dsc' ++ " did not have exactly one paragraph: " ++ unpack (render (pretty 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: " ++ show (pretty res)+ _ -> error $ deb ++ " did not have exactly one paragraph: " ++ unpack (render (pretty res)) getUploader :: IO String
Debian/Version/Common.hs view
@@ -14,13 +14,13 @@ ) where import Data.Char (ord, isDigit, isAlpha)+import Debian.Pretty (Doc, pretty, render)+import Debian.Version.Internal import Text.ParserCombinators.Parsec import Text.Regex-import Debian.Version.Internal-import Text.PrettyPrint.ANSI.Leijen (Doc, text) prettyDebianVersion :: DebianVersion -> Doc-prettyDebianVersion (DebianVersion s _) = text s+prettyDebianVersion (DebianVersion s _) = pretty s instance Eq DebianVersion where (DebianVersion _ v1) == (DebianVersion _ v2) = v1 == v2@@ -29,7 +29,7 @@ compare (DebianVersion _ v1) (DebianVersion _ v2) = compare v1 v2 instance Show DebianVersion where- show v = "(Debian.Version.parseDebianVersion (" ++ show (show (prettyDebianVersion v)) ++ " :: String))"+ show v = "(Debian.Version.parseDebianVersion (" ++ show (render (prettyDebianVersion v)) ++ " :: String))" -- make ~ less than everything, and everything else higher that letters order :: Char -> Int
Test/Changes.hs view
@@ -3,14 +3,15 @@ module Test.Changes where import Test.HUnit+import Data.Text (unpack) import Debian.Changes+import Debian.Pretty (pretty, render) import Debian.Release (ReleaseName(ReleaseName, relName)) import Debian.Version (parseDebianVersion)-import Text.PrettyPrint.ANSI.Leijen deriving instance Show ChangeLogEntry instance Show ChangeLog where- show = show . pretty+ show = unpack . render . pretty s3 = unlines ["name (version) dist; urgency=urgency",@@ -159,7 +160,7 @@ " -- Marco Túlio Gontijo e Silva <marcot@holoscopio.com> Wed, 11 Mar 2009 18:58:06 -0300", ""] -test5 = TestCase (assertEqual "haskell-regex-compat changelog" s1 (show (pretty (parseChangeLog s1))))+test5 = TestCase (assertEqual "haskell-regex-compat changelog" s1 (unpack . render . pretty . parseChangeLog $ s1)) test3 = TestCase (assertEqual "haskell-regex-compat changelog" expected (parseEntries s3))
Test/Control.hs view
@@ -7,27 +7,26 @@ import Data.Text as T (Text, pack, intercalate) import Debian.Control import Debian.Control.Common (unControl)-import Debian.Control.PrettyPrint (ppControl, ppParagraph) import Debian.Control.Text ({- Pretty instances -})-import Text.PrettyPrint.ANSI.Leijen (pretty)+import Debian.Pretty (pretty, render) deriving instance Eq (Control' Text)-deriving instance Show (Control' Text)-deriving instance Show (Paragraph' Text)-deriving instance Show (Field' Text)+-- deriving instance Show (Control' Text)+-- deriving instance Show (Paragraph' Text)+-- deriving instance Show (Field' Text) -- Additional tests of the results of parsing additional -- inter-paragraph newlines, or missing terminating newlines, would be -- good. controlTests =- [ TestCase (assertEqual "pretty1" control (either (error "parser failed") id (parseControl "debian/control" sample)))- , TestCase (assertEqual "pretty2" sample (pack (show (ppControl control))))- , TestCase (assertEqual "pretty3" (head paragraphs <> "\n") (pack (show (ppParagraph (head (unControl control))))))+ [ TestCase (assertEqual "pretty1" (show . pretty $ control) (either (error "parser failed") (show . pretty) (parseControl "debian/control" sample)))+ , TestCase (assertEqual "pretty2" sample (render (pretty control)))+ , TestCase (assertEqual "pretty3" (head paragraphs <> "\n") (render (pretty (head (unControl control))))) -- The Pretty class instances are distinct implementations from -- those in Debian.Control.PrettyPrint. Not sure why, there is a -- terse note about performance concerns.- , TestCase (assertEqual "pretty4" sample (pack (show (pretty control))))- , TestCase (assertEqual "pretty5" (head paragraphs <> "\n") (pack (show (pretty (head (unControl control)))))) ]+ , TestCase (assertEqual "pretty4" sample (render (pretty control)))+ , TestCase (assertEqual "pretty5" (head paragraphs <> "\n") (render (pretty (head (unControl control))))) ] -- | These paragraphs have no terminating newlines. They are added -- where appropriate to the expected test results.@@ -43,6 +42,7 @@ sample = T.intercalate "\n\n" paragraphs <> "\n" -- | The expecte result of parsing the sample control file.+control :: Control' Text control = Control { unControl = [Paragraph [Field ("Source"," haskell-debian")
Test/SourcesList.hs view
@@ -1,7 +1,10 @@+{-# LANGUAGE OverloadedStrings #-} module Test.SourcesList where +import Data.Text (Text, unpack)+import Data.Monoid (mconcat, (<>))+import Debian.Pretty (vcat, pretty, render) import Test.HUnit-import Text.PrettyPrint.ANSI.Leijen (pretty) import Debian.Sources --import Data.Maybe@@ -22,7 +25,7 @@ testSourcesList :: Test testSourcesList =- test [ assertEqual "valid sources.list" validSourcesListExpected (unlines . map (show . pretty) . parseSourcesList $ validSourcesListStr) ]+ test [ assertEqual "valid sources.list" validSourcesListExpected (unpack . render . vcat . map pretty . parseSourcesList $ validSourcesListStr) ] where validSourcesListStr = unlines $ [ " # A comment only line "@@ -41,11 +44,11 @@ , "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"+ _invalidSourcesListStr1 = "deb http://pkg-kde.alioth.debian.org/kde-3.5.0/ ./ main contrib non-free # exact path with sections" :: Text testSourcesListParse :: Test testSourcesListParse =- test [ assertEqual "" gutsy (concat . map (++ "\n") . map (show . pretty) . parseSourcesList $ gutsy) ]+ test [ assertEqual "" gutsy (unpack . mconcat . map (<> "\n") . map (render . pretty) . parseSourcesList $ gutsy) ] where gutsy = 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",
changelog view
@@ -1,3 +1,16 @@+haskell-debian (3.81) unstable; urgency=low++ * Replace library pretty and library ansi-wl-pprint with an ultra-simple+ custom pretty printing library in Debian.Pretty.++ -- David Fox <dsf@seereason.com> Sun, 12 Jan 2014 07:34:21 -0800++haskell-debian (3.80.2) unstable; urgency=low++ * Neil Mayhew's patch to greatly speed parsing of control files.++ -- David Fox <dsf@seereason.com> Mon, 06 Jan 2014 04:36:37 -0800+ haskell-debian (3.80.1) unstable; urgency=low * Fix for fakechanges from Neil Mayhew - don't reject all .deb files.
debian.cabal view
@@ -1,5 +1,5 @@ Name: debian-Version: 3.80.1+Version: 3.81 License: BSD3 License-File: debian/copyright Author: David Fox <dsf@seereason.com>, Jeremy Shaw <jeremy@seereason.com>, Clifford Beshers <beshers@seereason.com>@@ -25,7 +25,6 @@ Library Build-Depends:- ansi-wl-pprint, base >= 4 && < 5, bytestring, bzlib,@@ -38,7 +37,6 @@ network >= 2.4, old-locale, parsec >= 2 && <4,- pretty, process, pureMD5, regex-compat,@@ -70,13 +68,13 @@ Debian.Changes, Debian.Control, Debian.Control.Common,- Debian.Control.PrettyPrint, Debian.Control.ByteString, Debian.Control.String, Debian.Control.Text, Debian.Deb, Debian.Extra.Files, Debian.GenBuildDeps,+ Debian.Pretty, Debian.Relation, Debian.Relation.ByteString, Debian.Relation.Common,@@ -119,6 +117,7 @@ Include-Dirs: cbits Install-Includes: gwinsz.h Extensions: ExistentialQuantification CPP+ Build-Depends: pretty if flag(cabal19) build-depends: Cabal >= 1.9 cpp-options: -DCABAL19
debian/changelog view
@@ -1,3 +1,16 @@+haskell-debian (3.81) unstable; urgency=low++ * Replace library pretty and library ansi-wl-pprint with an ultra-simple+ custom pretty printing library in Debian.Pretty.++ -- David Fox <dsf@seereason.com> Sun, 12 Jan 2014 07:34:21 -0800++haskell-debian (3.80.2) unstable; urgency=low++ * Neil Mayhew's patch to greatly speed parsing of control files.++ -- David Fox <dsf@seereason.com> Mon, 06 Jan 2014 04:36:37 -0800+ haskell-debian (3.80.1) unstable; urgency=low * Fix for fakechanges from Neil Mayhew - don't reject all .deb files.