debian-3.40: Debian/Changes.hs

-- |Changelog and changes file support.
module Debian.Changes
    ( ChangesFile(..)
    , ChangedFileSpec(..)
    , changesFileName
    , ChangeLogEntry(..)
    , parseLog
    , parseEntry
    , parseChanges
    ) where

import Data.List (intercalate)
import Data.Maybe
import qualified Debian.Control.String as S
import Debian.Release
import Debian.URI()
import Debian.Version
import System.Posix.Types
import Text.Regex

-- |A file generated by dpkg-buildpackage describing the result of a
-- package build
data ChangesFile =
    Changes { changeDir :: FilePath		-- ^ The full pathname of the directory holding the .changes file.
            , changePackage :: String		-- ^ The package name parsed from the .changes file name
            , changeVersion :: DebianVersion	-- ^ The version number parsed from the .changes file name
            , changeRelease :: ReleaseName	-- ^ The Distribution field of the .changes file
            , changeArch :: Arch		-- ^ The architecture parsed from the .changes file name
            , changeInfo :: S.Paragraph		-- ^ The contents of the .changes file
            , changeEntry :: ChangeLogEntry	-- ^ The value of the Changes field of the .changes file
            , changeFiles :: [ChangedFileSpec]	-- ^ The parsed value of the Files attribute
            }

-- |An entry in the list of files generated by the build.
data ChangedFileSpec =
    ChangedFileSpec { changedFileMD5sum :: String
                    , changedFileSHA1sum :: String
                    , changedFileSHA256sum :: String
                    , changedFileSize :: FileOffset
                    , changedFileSection :: SubSection
                    , changedFilePriority :: String
                    , changedFileName :: FilePath
                    }

-- |A changelog is a series of ChangeLogEntries
data ChangeLogEntry = Entry { logPackage :: String
                            , logVersion :: DebianVersion
                            , logDists :: [ReleaseName]
                            , logUrgency :: String
                            , logComments :: String
                            , logWho :: String
                            , logDate :: String
                            }

instance Show ChangesFile where
    show = changesFileName

changesFileName :: ChangesFile -> String
changesFileName changes =
    changePackage changes ++ "_" ++ show (changeVersion changes) ++ "_" ++ archName (changeArch changes) ++ ".changes"

instance Show ChangedFileSpec where
    show file = changedFileMD5sum file ++ " " ++
                show (changedFileSize file) ++ " " ++
                sectionName (changedFileSection file) ++ " " ++
                changedFilePriority file ++ " " ++
                changedFileName file

instance Show ChangeLogEntry where
    show (Entry package version dists urgency details who date) =
        package ++ " (" ++ show version ++ ") " ++ intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency ++ "\n\n" ++
             details ++ " -- " ++ 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 ++ ") " ++ intercalate " " (map releaseName' dists) ++ "; urgency=" ++ urgency ++ "..."

-- |Parse a Debian Changelog and return a lazy list of entries
parseLog :: String -> [Either String ChangeLogEntry]
parseLog text =
    case parseEntry text of
      Nothing -> []
      Just (Left message) -> [Left message]
      Just (Right (entry, text')) -> Right entry : parseLog text'

-- |Parse a single changelog entry, returning the entry and the remaining text.
parseEntry :: String -> Maybe (Either String (ChangeLogEntry, String))
parseEntry text | dropWhile (\ x -> elem x " \t\n") text == "" = Nothing
parseEntry text =
    case matchRegexAll entryRE text of
      Nothing -> Just (Left ("Parse error in changelog:\n" ++ text))
      Just ("", _, remaining, [_, name, version, dists, urgency, _, details, _, _, _, _, _, who, date, _]) ->
          let entry =
                  Entry name 
                        (parseDebianVersion version)
                        (map parseReleaseName . words $ dists)
                        urgency
			details
                        who
                        date in
          Just (Right (entry, remaining))
      Just ("", _, _remaining, submatches) -> Just (Left ("Internal error 15, submatches=" ++ show submatches))
      Just (before, _, _, _) -> Just (Left ("Parse error in changelog at:\n" ++ show before ++ "\nin:\n" ++ text))
    where
      entryRE = mkRegex $ bol ++ blankLines ++ headerRE ++ nonSigLines ++ blankLines ++ signature ++ blankLines
      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.
parseChanges :: String -> Maybe ChangeLogEntry
parseChanges text =
    case matchRegex changesRE text of
      Nothing -> Nothing
      Just [_, name, version, dists, urgency, _, details] ->
          Just $ Entry name 
                       (parseDebianVersion version)
                       (map parseReleaseName . words $ dists)
                       urgency
		       details
                       "" ""
      Just x -> error $ "Unexpected match: " ++ show x
    where
      changesRE = mkRegexWithOpts (bol ++ blankLines ++ optWhite ++ headerRE ++ "(.*)$") False False

headerRE =
    package ++ version ++ dists ++ urgency
    where
      package = "([^ \t(]*)" ++ optWhite
      version = "\\(([^)]*)\\)" ++ optWhite
      dists = "([^;]*);" ++ optWhite
      urgency = "urgency=([^\n]*)\n" ++ blankLines

blankLines = blankLine ++ "*"
blankLine = "(" ++ optWhite ++ "\n)"
optWhite = "[ \t]*"
bol = "^"