ChangeLog.hs

-- |Module for handling the Debian changelog file format
-- <http://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog>
--
-- 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 <email address>[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)