-- |Module for handling the Debian changelog file format -- -- -- Author: David Fox {- |package (version) distribution(s); urgency=urgency | [optional blank line(s), stripped] | * change details | more change details | [blank line(s), included in output of dpkg-parsechangelog] | * even more change details | [optional blank line(s), stripped] | -- maintainer name [two spaces] date -} module Linspire.Debian.ChangeLog (ChangeLogEntry(Entry), -- * Accessors package, Linspire.Debian.ChangeLog.version, dists, urgency, comments, who, date, -- * read, show parse, -- String -> [ChangeLogEntry] showHeader, -- ChangeLogEntry -> String -- * Helper getRFC822Date -- IO String ) where import Data.List import Data.Maybe import Linspire.Debian.Version import System.IO import System.Process import Text.Regex -- |A changelog is a series of ChangeLogEntries data ChangeLogEntry = Entry {package :: String, -- Package name version :: DebianVersion, -- Version number dists :: [String], -- distributions urgency :: String, -- urgency comments :: String, -- comments who :: String, -- who date :: String} -- date instance Show ChangeLogEntry where show (Entry package version dists urgency details who date) = package ++ " (" ++ show version ++ ") " ++ consperse " " dists ++ "; urgency=" ++ urgency ++ "\n\n" ++ details ++ "\n\n -- " ++ who ++ " " ++ date ++ "\n\n" -- |Show just the top line of a changelog entry (for debugging output.) showHeader :: ChangeLogEntry -> String showHeader (Entry package version dists urgency _ _ _) = package ++ " (" ++ show version ++ ") " ++ consperse " " dists ++ "; urgency=" ++ urgency ++ "..." -- |Parse a Debian Changelog and return a list of entries parse :: String -> [ChangeLogEntry] parse text = case matchRegexAll entryRE text of Nothing -> [] Just (_, _, remaining, submatches) -> case submatches of [name, version, dists, urgency, _, _, details, _, _, _, _, who, date, _] -> let entry = Entry name (parseDebianVersion version) (words dists) urgency details who date in entry : parse remaining _ -> error "Parse error in changelog" where entryRE = mkRegex (header ++ blankLines ++ details ++ blankLines ++ signature) header = package ++ version ++ dists ++ urgency package = "^([^ \t(]*)" ++ optWhite version = "\\(([^)]*)\\)" ++ optWhite dists = "([^;]*);" ++ optWhite urgency = "urgency=([^\n]*)\n" ++ blankLines details = "(" ++ prefixedLine ++ "(" ++ blankLines ++ prefixedLine ++ ")*)" signature = "( -- ([^\n]*) (...............................))[ \t]*\n" ++ blankLines prefixedLine = " [^\n]*\n" blankLines = "(" ++ optWhite ++ "\n)*" optWhite = "[ \t]*" -- FIXME: The %z formatting directive (rfc-822 conformant timezone) -- isn't working: -- date = getClockTime >>= toCalendarTime >>= -- return . formatCalendarTime defaultTimeLocale "%a, %d %b %Y %T %z" getRFC822Date :: IO String getRFC822Date = do (_, stdout, _, handle) <- runInteractiveCommand "date -R" date <- hGetContents stdout >>= return . lines >>= return . listToMaybe waitForProcess handle return $ maybe (error "Error running 'date -R'") id date -- |The mighty consperse function consperse :: [a] -> [[a]] -> [a] consperse sep items = concat (intersperse sep items)