{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-missing-signatures #-}
-- |Changelog and changes file support.
module Debian.Changes
    ( ChangesFile(..)
    , ChangedFileSpec(..)
    , changesFileName
    , ChangeLog(..)
    , ChangeLogEntry(..)
    , parseChangeLog
    , parseEntries -- was parseLog
    , parseEntry
    , parseChanges
    ) where

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 Debian.Codename (Codename, codename, parseCodename)
import qualified Debian.Control.String as S
import Debian.Pretty (PP(..))
import Debian.Release
import Debian.Version
import System.Posix.Types
import Text.Regex.TDFA hiding (empty)
import Text.PrettyPrint (Doc, text, hcat, render)
import Distribution.Pretty (Pretty(pretty))

-- |A file generated by dpkg-buildpackage describing the result of a
-- package build
data ChangesFile =
    Changes { ChangesFile -> FilePath
changeDir :: FilePath             -- ^ The full pathname of the directory holding the .changes file.
            , ChangesFile -> FilePath
changePackage :: String           -- ^ The package name parsed from the .changes file name
            , ChangesFile -> DebianVersion
changeVersion :: DebianVersion    -- ^ The version number parsed from the .changes file name
            , ChangesFile -> Codename
changeRelease :: Codename         -- ^ The Distribution field of the .changes file
            , ChangesFile -> Arch
changeArch :: Arch                -- ^ The architecture parsed from the .changes file name
            , ChangesFile -> Paragraph' Text
changeInfo :: S.Paragraph' Text   -- ^ The contents of the .changes file
            , ChangesFile -> ChangeLogEntry
changeEntry :: ChangeLogEntry     -- ^ The value of the Changes field of the .changes file
            , ChangesFile -> [ChangedFileSpec]
changeFiles :: [ChangedFileSpec]  -- ^ The parsed value of the Files attribute
            } deriving (ChangesFile -> ChangesFile -> Bool
(ChangesFile -> ChangesFile -> Bool)
-> (ChangesFile -> ChangesFile -> Bool) -> Eq ChangesFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangesFile -> ChangesFile -> Bool
$c/= :: ChangesFile -> ChangesFile -> Bool
== :: ChangesFile -> ChangesFile -> Bool
$c== :: ChangesFile -> ChangesFile -> Bool
Eq, ReadPrec [ChangesFile]
ReadPrec ChangesFile
Int -> ReadS ChangesFile
ReadS [ChangesFile]
(Int -> ReadS ChangesFile)
-> ReadS [ChangesFile]
-> ReadPrec ChangesFile
-> ReadPrec [ChangesFile]
-> Read ChangesFile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangesFile]
$creadListPrec :: ReadPrec [ChangesFile]
readPrec :: ReadPrec ChangesFile
$creadPrec :: ReadPrec ChangesFile
readList :: ReadS [ChangesFile]
$creadList :: ReadS [ChangesFile]
readsPrec :: Int -> ReadS ChangesFile
$creadsPrec :: Int -> ReadS ChangesFile
Read, Int -> ChangesFile -> ShowS
[ChangesFile] -> ShowS
ChangesFile -> FilePath
(Int -> ChangesFile -> ShowS)
-> (ChangesFile -> FilePath)
-> ([ChangesFile] -> ShowS)
-> Show ChangesFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChangesFile] -> ShowS
$cshowList :: [ChangesFile] -> ShowS
show :: ChangesFile -> FilePath
$cshow :: ChangesFile -> FilePath
showsPrec :: Int -> ChangesFile -> ShowS
$cshowsPrec :: Int -> ChangesFile -> ShowS
Show)

-- |An entry in the list of files generated by the build.
data ChangedFileSpec =
    ChangedFileSpec { ChangedFileSpec -> FilePath
changedFileMD5sum :: String
                    , ChangedFileSpec -> FilePath
changedFileSHA1sum :: String
                    , ChangedFileSpec -> FilePath
changedFileSHA256sum :: String
                    , ChangedFileSpec -> FileOffset
changedFileSize :: FileOffset
                    , ChangedFileSpec -> SubSection
changedFileSection :: SubSection
                    , ChangedFileSpec -> FilePath
changedFilePriority :: String
                    , ChangedFileSpec -> FilePath
changedFileName :: FilePath
                    } deriving (ChangedFileSpec -> ChangedFileSpec -> Bool
(ChangedFileSpec -> ChangedFileSpec -> Bool)
-> (ChangedFileSpec -> ChangedFileSpec -> Bool)
-> Eq ChangedFileSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangedFileSpec -> ChangedFileSpec -> Bool
$c/= :: ChangedFileSpec -> ChangedFileSpec -> Bool
== :: ChangedFileSpec -> ChangedFileSpec -> Bool
$c== :: ChangedFileSpec -> ChangedFileSpec -> Bool
Eq, ReadPrec [ChangedFileSpec]
ReadPrec ChangedFileSpec
Int -> ReadS ChangedFileSpec
ReadS [ChangedFileSpec]
(Int -> ReadS ChangedFileSpec)
-> ReadS [ChangedFileSpec]
-> ReadPrec ChangedFileSpec
-> ReadPrec [ChangedFileSpec]
-> Read ChangedFileSpec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangedFileSpec]
$creadListPrec :: ReadPrec [ChangedFileSpec]
readPrec :: ReadPrec ChangedFileSpec
$creadPrec :: ReadPrec ChangedFileSpec
readList :: ReadS [ChangedFileSpec]
$creadList :: ReadS [ChangedFileSpec]
readsPrec :: Int -> ReadS ChangedFileSpec
$creadsPrec :: Int -> ReadS ChangedFileSpec
Read, Int -> ChangedFileSpec -> ShowS
[ChangedFileSpec] -> ShowS
ChangedFileSpec -> FilePath
(Int -> ChangedFileSpec -> ShowS)
-> (ChangedFileSpec -> FilePath)
-> ([ChangedFileSpec] -> ShowS)
-> Show ChangedFileSpec
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChangedFileSpec] -> ShowS
$cshowList :: [ChangedFileSpec] -> ShowS
show :: ChangedFileSpec -> FilePath
$cshow :: ChangedFileSpec -> FilePath
showsPrec :: Int -> ChangedFileSpec -> ShowS
$cshowsPrec :: Int -> ChangedFileSpec -> ShowS
Show)

-- |A changelog is a series of ChangeLogEntries
data ChangeLogEntry =
    Entry { ChangeLogEntry -> FilePath
logPackage :: String -- FIXME: Should be a SrcPkgName
          , ChangeLogEntry -> DebianVersion
logVersion :: DebianVersion
          , ChangeLogEntry -> [Codename]
logDists :: [Codename]
          , ChangeLogEntry -> FilePath
logUrgency :: String
          , ChangeLogEntry -> FilePath
logComments :: String
          , ChangeLogEntry -> FilePath
logWho :: String
          , ChangeLogEntry -> FilePath
logDate :: String
          }
  | WhiteSpace String -- ^ The parser here never returns this
  deriving (ChangeLogEntry -> ChangeLogEntry -> Bool
(ChangeLogEntry -> ChangeLogEntry -> Bool)
-> (ChangeLogEntry -> ChangeLogEntry -> Bool) -> Eq ChangeLogEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeLogEntry -> ChangeLogEntry -> Bool
$c/= :: ChangeLogEntry -> ChangeLogEntry -> Bool
== :: ChangeLogEntry -> ChangeLogEntry -> Bool
$c== :: ChangeLogEntry -> ChangeLogEntry -> Bool
Eq, ReadPrec [ChangeLogEntry]
ReadPrec ChangeLogEntry
Int -> ReadS ChangeLogEntry
ReadS [ChangeLogEntry]
(Int -> ReadS ChangeLogEntry)
-> ReadS [ChangeLogEntry]
-> ReadPrec ChangeLogEntry
-> ReadPrec [ChangeLogEntry]
-> Read ChangeLogEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangeLogEntry]
$creadListPrec :: ReadPrec [ChangeLogEntry]
readPrec :: ReadPrec ChangeLogEntry
$creadPrec :: ReadPrec ChangeLogEntry
readList :: ReadS [ChangeLogEntry]
$creadList :: ReadS [ChangeLogEntry]
readsPrec :: Int -> ReadS ChangeLogEntry
$creadsPrec :: Int -> ReadS ChangeLogEntry
Read, Int -> ChangeLogEntry -> ShowS
[ChangeLogEntry] -> ShowS
ChangeLogEntry -> FilePath
(Int -> ChangeLogEntry -> ShowS)
-> (ChangeLogEntry -> FilePath)
-> ([ChangeLogEntry] -> ShowS)
-> Show ChangeLogEntry
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChangeLogEntry] -> ShowS
$cshowList :: [ChangeLogEntry] -> ShowS
show :: ChangeLogEntry -> FilePath
$cshow :: ChangeLogEntry -> FilePath
showsPrec :: Int -> ChangeLogEntry -> ShowS
$cshowsPrec :: Int -> ChangeLogEntry -> ShowS
Show)

newtype ChangeLog = ChangeLog [ChangeLogEntry] deriving (ChangeLog -> ChangeLog -> Bool
(ChangeLog -> ChangeLog -> Bool)
-> (ChangeLog -> ChangeLog -> Bool) -> Eq ChangeLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeLog -> ChangeLog -> Bool
$c/= :: ChangeLog -> ChangeLog -> Bool
== :: ChangeLog -> ChangeLog -> Bool
$c== :: ChangeLog -> ChangeLog -> Bool
Eq, ReadPrec [ChangeLog]
ReadPrec ChangeLog
Int -> ReadS ChangeLog
ReadS [ChangeLog]
(Int -> ReadS ChangeLog)
-> ReadS [ChangeLog]
-> ReadPrec ChangeLog
-> ReadPrec [ChangeLog]
-> Read ChangeLog
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangeLog]
$creadListPrec :: ReadPrec [ChangeLog]
readPrec :: ReadPrec ChangeLog
$creadPrec :: ReadPrec ChangeLog
readList :: ReadS [ChangeLog]
$creadList :: ReadS [ChangeLog]
readsPrec :: Int -> ReadS ChangeLog
$creadsPrec :: Int -> ReadS ChangeLog
Read, Int -> ChangeLog -> ShowS
[ChangeLog] -> ShowS
ChangeLog -> FilePath
(Int -> ChangeLog -> ShowS)
-> (ChangeLog -> FilePath)
-> ([ChangeLog] -> ShowS)
-> Show ChangeLog
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChangeLog] -> ShowS
$cshowList :: [ChangeLog] -> ShowS
show :: ChangeLog -> FilePath
$cshow :: ChangeLog -> FilePath
showsPrec :: Int -> ChangeLog -> ShowS
$cshowsPrec :: Int -> ChangeLog -> ShowS
Show)

{-
instance Show ChangesFile where
    show = changesFileName
-}

changesFileName :: ChangesFile -> String
changesFileName :: ChangesFile -> FilePath
changesFileName = Doc -> FilePath
render (Doc -> FilePath)
-> (ChangesFile -> Doc) -> ChangesFile -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP ChangesFile -> Doc
forall a. Pretty a => a -> Doc
pretty (PP ChangesFile -> Doc)
-> (ChangesFile -> PP ChangesFile) -> ChangesFile -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangesFile -> PP ChangesFile
forall a. a -> PP a
PP

instance Pretty (PP ChangesFile) where
    pretty :: PP ChangesFile -> Doc
pretty (PP ChangesFile
changes) = FilePath -> Doc
text (ChangesFile -> FilePath
changePackage ChangesFile
changes FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"_") Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DebianVersion -> Doc
prettyDebianVersion (ChangesFile -> DebianVersion
changeVersion ChangesFile
changes) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc
text FilePath
"_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Arch -> Doc
prettyArch (ChangesFile -> Arch
changeArch ChangesFile
changes) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc
text FilePath
".changes"

instance Pretty (PP ChangedFileSpec) where
    pretty :: PP ChangedFileSpec -> Doc
pretty (PP ChangedFileSpec
file) =
        FilePath -> Doc
text (ChangedFileSpec -> FilePath
changedFileMD5sum ChangedFileSpec
file FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
              FileOffset -> FilePath
forall a. Show a => a -> FilePath
show (ChangedFileSpec -> FileOffset
changedFileSize ChangedFileSpec
file) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
              SubSection -> FilePath
sectionName (ChangedFileSpec -> SubSection
changedFileSection ChangedFileSpec
file) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
              ChangedFileSpec -> FilePath
changedFilePriority ChangedFileSpec
file FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
              ChangedFileSpec -> FilePath
changedFileName ChangedFileSpec
file)

instance Pretty (PP ChangeLogEntry) where
    pretty :: PP ChangeLogEntry -> Doc
pretty (PP (Entry FilePath
package DebianVersion
ver [Codename]
dists FilePath
urgency FilePath
details FilePath
who FilePath
date)) =
        [Doc] -> Doc
hcat [ FilePath -> Doc
text FilePath
package Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc
text FilePath
" (" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DebianVersion -> Doc
prettyDebianVersion DebianVersion
ver Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc
text (FilePath
") " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" " ((Codename -> FilePath) -> [Codename] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Codename -> FilePath
codename [Codename]
dists) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"; urgency=" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
urgency)
             , FilePath -> Doc
text FilePath
"\n\n"
             , FilePath -> Doc
text FilePath
"  " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc
text (ShowS
strip' FilePath
details)
             , FilePath -> Doc
text FilePath
"\n\n"
             , FilePath -> Doc
text (FilePath
" -- " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
who FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"  " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
date)
             , FilePath -> Doc
text FilePath
"\n" ]
    pretty (PP (WhiteSpace FilePath
_)) = FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error FilePath
"instance Pretty ChangeLogEntry"

instance Pretty (PP [ChangeLogEntry]) where
    pretty :: PP [ChangeLogEntry] -> Doc
pretty = [Doc] -> Doc
hcat ([Doc] -> Doc)
-> (PP [ChangeLogEntry] -> [Doc]) -> PP [ChangeLogEntry] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (FilePath -> Doc
text FilePath
"\n") ([Doc] -> [Doc])
-> (PP [ChangeLogEntry] -> [Doc]) -> PP [ChangeLogEntry] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChangeLogEntry -> Doc) -> [ChangeLogEntry] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PP ChangeLogEntry -> Doc
forall a. Pretty a => a -> Doc
pretty (PP ChangeLogEntry -> Doc)
-> (ChangeLogEntry -> PP ChangeLogEntry) -> ChangeLogEntry -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangeLogEntry -> PP ChangeLogEntry
forall a. a -> PP a
PP) ([ChangeLogEntry] -> [Doc])
-> (PP [ChangeLogEntry] -> [ChangeLogEntry])
-> PP [ChangeLogEntry]
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP [ChangeLogEntry] -> [ChangeLogEntry]
forall a. PP a -> a
unPP

strip' :: ShowS
strip' = Text -> FilePath
unpack (Text -> FilePath) -> (FilePath -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip (Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack

instance Pretty (PP ChangeLog) where
    pretty :: PP ChangeLog -> Doc
pretty (PP (ChangeLog [ChangeLogEntry]
xs)) = [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (FilePath -> Doc
text FilePath
"\n") ((ChangeLogEntry -> Doc) -> [ChangeLogEntry] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PP ChangeLogEntry -> Doc
forall a. Pretty a => a -> Doc
pretty (PP ChangeLogEntry -> Doc)
-> (ChangeLogEntry -> PP ChangeLogEntry) -> ChangeLogEntry -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangeLogEntry -> PP ChangeLogEntry
forall a. a -> PP a
PP) [ChangeLogEntry]
xs))

-- |Show just the top line of a changelog entry (for debugging output.)
_showHeader :: ChangeLogEntry -> Doc
_showHeader :: ChangeLogEntry -> Doc
_showHeader (Entry FilePath
package DebianVersion
ver [Codename]
dists FilePath
urgency FilePath
_ FilePath
_ FilePath
_) =
    FilePath -> Doc
text (FilePath
package FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" (") Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DebianVersion -> Doc
prettyDebianVersion DebianVersion
ver Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc
text (FilePath
") " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" " ((Codename -> FilePath) -> [Codename] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Codename -> FilePath
codename [Codename]
dists) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"; urgency=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
urgency FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"...")
_showHeader (WhiteSpace FilePath
_) = FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error FilePath
"_showHeader"

{-
format is a series of entries like this:

     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

package and version are the source package name and version number.

distribution(s) lists the distributions where this version should be
installed when it is uploaded - it is copied to the Distribution field
in the .changes file. See Distribution, Section 5.6.14.

urgency is the value for the Urgency field in the .changes file for
the upload (see Urgency, Section 5.6.17). It is not possible to
specify an urgency containing commas; commas are used to separate
keyword=value settings in the dpkg changelog format (though there is
currently only one useful keyword, urgency).

The change details may in fact be any series of lines starting with at
least two spaces, but conventionally each change starts with an
asterisk and a separating space and continuation lines are indented so
as to bring them in line with the start of the text above. Blank lines
may be used here to separate groups of changes, if desired.

If this upload resolves bugs recorded in the Bug Tracking System
(BTS), they may be automatically closed on the inclusion of this
package into the Debian archive by including the string: closes:
Bug#nnnnn in the change details.[16] This information is conveyed via
the Closes field in the .changes file (see Closes, Section 5.6.22).

The maintainer name and email address used in the changelog should be
the details of the person uploading this version. They are not
necessarily those of the usual package maintainer. The information
here will be copied to the Changed-By field in the .changes file (see
Changed-By, Section 5.6.4), and then later used to send an
acknowledgement when the upload has been installed.

The date must be in RFC822 format[17]; it must include the time zone
specified numerically, with the time zone name or abbreviation
optionally present as a comment in parentheses.

The first "title" line with the package name must start at the left
hand margin. The "trailer" line with the maintainer and date details
must be preceded by exactly one space. The maintainer details and the
date must be separated by exactly two spaces.

The entire changelog must be encoded in UTF-8.
-}

-- | Parse the entries of a debian changelog and verify they are all
-- valid.
parseChangeLog :: String -> Either [[String]] ChangeLog
parseChangeLog :: FilePath -> Either [[FilePath]] ChangeLog
parseChangeLog FilePath
s =
    case [Either [FilePath] ChangeLogEntry]
-> ([[FilePath]], [ChangeLogEntry])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (FilePath -> [Either [FilePath] ChangeLogEntry]
parseEntries FilePath
s) of
      ([], [ChangeLogEntry]
xs) -> ChangeLog -> Either [[FilePath]] ChangeLog
forall a b. b -> Either a b
Right ([ChangeLogEntry] -> ChangeLog
ChangeLog [ChangeLogEntry]
xs)
      ([[FilePath]]
ss, [ChangeLogEntry]
_) -> [[FilePath]] -> Either [[FilePath]] ChangeLog
forall a b. a -> Either a b
Left [[FilePath]]
ss

-- |Parse a Debian Changelog and return a lazy list of entries
parseEntries :: String -> [Either [String] ChangeLogEntry]
parseEntries :: FilePath -> [Either [FilePath] ChangeLogEntry]
parseEntries FilePath
"" = []
parseEntries FilePath
text =
    case FilePath -> Either [FilePath] (ChangeLogEntry, FilePath)
parseEntry FilePath
text of
      Left [FilePath]
messages -> [[FilePath] -> Either [FilePath] ChangeLogEntry
forall a b. a -> Either a b
Left [FilePath]
messages]
      Right (ChangeLogEntry
entry, FilePath
text') -> ChangeLogEntry -> Either [FilePath] ChangeLogEntry
forall a b. b -> Either a b
Right ChangeLogEntry
entry Either [FilePath] ChangeLogEntry
-> [Either [FilePath] ChangeLogEntry]
-> [Either [FilePath] ChangeLogEntry]
forall a. a -> [a] -> [a]
: FilePath -> [Either [FilePath] ChangeLogEntry]
parseEntries FilePath
text'

-- |Parse a single changelog entry, returning the entry and the remaining text.
parseEntry :: String -> Either [String] (ChangeLogEntry, String)
parseEntry :: FilePath -> Either [FilePath] (ChangeLogEntry, FilePath)
parseEntry FilePath
text =
    case FilePath
text FilePath -> FilePath -> MatchResult FilePath
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
entryRE :: MatchResult String of
      MatchResult FilePath
x | MatchResult FilePath -> [FilePath]
forall a. MatchResult a -> [a]
mrSubList MatchResult FilePath
x [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [] -> [FilePath] -> Either [FilePath] (ChangeLogEntry, FilePath)
forall a b. a -> Either a b
Left [FilePath
"Parse error in " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> FilePath
show FilePath
text]
      MR {mrAfter :: forall a. MatchResult a -> a
mrAfter = FilePath
after, mrSubList :: forall a. MatchResult a -> [a]
mrSubList = [FilePath
_, FilePath
name, FilePath
ver, FilePath
dists, FilePath
urgency, FilePath
_, FilePath
details, FilePath
_, FilePath
_, FilePath
who, FilePath
_, FilePath
date, FilePath
_]} ->
          (ChangeLogEntry, FilePath)
-> Either [FilePath] (ChangeLogEntry, FilePath)
forall a b. b -> Either a b
Right (FilePath
-> DebianVersion
-> [Codename]
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> ChangeLogEntry
Entry FilePath
name
                         (FilePath -> DebianVersion
forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' FilePath
ver)
                         ((FilePath -> Codename) -> [FilePath] -> [Codename]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Codename
parseCodename ([FilePath] -> [Codename])
-> (FilePath -> [FilePath]) -> FilePath -> [Codename]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words (FilePath -> [Codename]) -> FilePath -> [Codename]
forall a b. (a -> b) -> a -> b
$ FilePath
dists)
                         FilePath
urgency
                         (FilePath
"  " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
unpack (Text -> Text
strip (FilePath -> Text
pack FilePath
details)) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n")
                         (Int -> ShowS
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
who Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) FilePath
who)
                         FilePath
date,
                   FilePath
after)
      MR {mrBefore :: forall a. MatchResult a -> a
mrBefore = FilePath
_before, mrMatch :: forall a. MatchResult a -> a
mrMatch = FilePath
_matched, mrAfter :: forall a. MatchResult a -> a
mrAfter = FilePath
after, mrSubList :: forall a. MatchResult a -> [a]
mrSubList = [FilePath]
matches} ->
          [FilePath] -> Either [FilePath] (ChangeLogEntry, FilePath)
forall a b. a -> Either a b
Left [FilePath
"Internal error\n after=" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> FilePath
show FilePath
after FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
matches) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" matches: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
matches]

entryRE :: FilePath
entryRE = FilePath
bol FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
blankLines FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
headerRE FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
changeDetails FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
signature FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
blankLines
changeDetails :: FilePath
changeDetails = FilePath
"((\n| \n| -\n|([^ ]| [^--]| -[^--])[^\n]*\n)*)"
signature :: FilePath
signature = FilePath
" -- ([ ]*([^ ]+ )* )([^\n]*)\n"

-- |Parse the changelog information that shows up in the .changes
-- file, i.e. a changelog entry with no signature.
parseChanges :: Text -> Maybe ChangeLogEntry
parseChanges :: Text -> Maybe ChangeLogEntry
parseChanges Text
text =
    case Text -> FilePath
unpack Text
text FilePath -> FilePath -> MatchResult FilePath
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
changesRE :: MatchResult String of
      MR {mrSubList :: forall a. MatchResult a -> [a]
mrSubList = []} -> Maybe ChangeLogEntry
forall a. Maybe a
Nothing
      MR {mrSubList :: forall a. MatchResult a -> [a]
mrSubList = [FilePath
_, FilePath
name, FilePath
ver, FilePath
dists, FilePath
urgency, FilePath
_, FilePath
details]} ->
          ChangeLogEntry -> Maybe ChangeLogEntry
forall a. a -> Maybe a
Just (ChangeLogEntry -> Maybe ChangeLogEntry)
-> ChangeLogEntry -> Maybe ChangeLogEntry
forall a b. (a -> b) -> a -> b
$ FilePath
-> DebianVersion
-> [Codename]
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> ChangeLogEntry
Entry FilePath
name
                       (FilePath -> DebianVersion
forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' FilePath
ver)
                       ((FilePath -> Codename) -> [FilePath] -> [Codename]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Codename
parseCodename ([FilePath] -> [Codename])
-> (FilePath -> [FilePath]) -> FilePath -> [Codename]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words (FilePath -> [Codename]) -> FilePath -> [Codename]
forall a b. (a -> b) -> a -> b
$ FilePath
dists)
                       FilePath
urgency
                       FilePath
details
                       FilePath
"" FilePath
""
      MR {mrSubList :: forall a. MatchResult a -> [a]
mrSubList = [FilePath]
x} -> FilePath -> Maybe ChangeLogEntry
forall a. HasCallStack => FilePath -> a
error (FilePath -> Maybe ChangeLogEntry)
-> FilePath -> Maybe ChangeLogEntry
forall a b. (a -> b) -> a -> b
$ FilePath
"Unexpected match: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
x
    where
      changesRE :: FilePath
changesRE = FilePath
bol FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
blankLines FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
optWhite FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
headerRE FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"(.*)$"

headerRE :: FilePath
headerRE =
    FilePath
package FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
ver FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
dists FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
urgency
    where
      package :: FilePath
package = FilePath
"([^ \t(]*)" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
optWhite
      ver :: FilePath
ver = FilePath
"\\(([^)]*)\\)" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
optWhite
      dists :: FilePath
dists = FilePath
"([^;]*);" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
optWhite
      urgency :: FilePath
urgency = FilePath
"urgency=([^\n]*)\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
blankLines

blankLines :: FilePath
blankLines = FilePath
blankLine FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"*"
blankLine :: FilePath
blankLine = FilePath
"(" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
optWhite FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n)"
optWhite :: FilePath
optWhite = FilePath
"[ \t]*"
bol :: FilePath
bol = FilePath
"^"

-- This can be used for tests
_s1 :: FilePath
_s1 = [FilePath] -> FilePath
unlines
     [FilePath
"haskell-regex-compat (0.92-3+seereason1~jaunty4) jaunty-seereason; urgency=low",
      FilePath
"",
      FilePath
"  [ Joachim Breitner ]",
      FilePath
"  * Adjust priority according to override file",
      FilePath
"  * Depend on hscolour (Closes: #550769)",
      FilePath
"",
      FilePath
"  [ Marco Túlio Gontijo e Silva ]",
      FilePath
"  * debian/control: Use more sintetic name for Vcs-Darcs.",
      FilePath
"  * Built from sid apt pool",
      FilePath
"  * Build dependency changes:",
      FilePath
"     cpphs:                    1.9-1+seereason1~jaunty5     -> 1.9-1+seereason1~jaunty6",
      FilePath
"     ghc6:                     6.10.4-1+seereason5~jaunty1  -> 6.12.1-0+seereason1~jaunty1",
      FilePath
"     ghc6-doc:                 6.10.4-1+seereason5~jaunty1  -> 6.12.1-0+seereason1~jaunty1",
      FilePath
"     ghc6-prof:                6.10.4-1+seereason5~jaunty1  -> 6.12.1-0+seereason1~jaunty1",
      FilePath
"     haddock:                  2.4.2-3+seereason3~jaunty1   -> 6.12.1-0+seereason1~jaunty1",
      FilePath
"     haskell-devscripts:       0.6.18-21+seereason1~jaunty1 -> 0.6.18-23+seereason1~jaunty1",
      FilePath
"     haskell-regex-base-doc:   0.93.1-5+seereason1~jaunty1  -> 0.93.1-5++1+seereason1~jaunty1",
      FilePath
"     haskell-regex-posix-doc:  0.93.2-4+seereason1~jaunty1  -> 0.93.2-4+seereason1~jaunty2",
      FilePath
"     libghc6-regex-base-dev:   0.93.1-5+seereason1~jaunty1  -> 0.93.1-5++1+seereason1~jaunty1",
      FilePath
"     libghc6-regex-base-prof:  0.93.1-5+seereason1~jaunty1  -> 0.93.1-5++1+seereason1~jaunty1",
      FilePath
"     libghc6-regex-posix-dev:  0.93.2-4+seereason1~jaunty1  -> 0.93.2-4+seereason1~jaunty2",
      FilePath
"     libghc6-regex-posix-prof: 0.93.2-4+seereason1~jaunty1  -> 0.93.2-4+seereason1~jaunty2",
      FilePath
"",
      FilePath
" -- SeeReason Autobuilder <autobuilder@seereason.org>  Fri, 25 Dec 2009 01:55:37 -0800",
      FilePath
"",
      FilePath
"haskell-regex-compat (0.92-3) unstable; urgency=low",
      FilePath
"",
      FilePath
"  [ Joachim Breitner ]",
      FilePath
"  * Adjust priority according to override file",
      FilePath
"  * Depend on hscolour (Closes: #550769)",
      FilePath
"",
      FilePath
"  [ Marco Túlio Gontijo e Silva ]",
      FilePath
"  * debian/control: Use more sintetic name for Vcs-Darcs.",
      FilePath
"",
      FilePath
" -- Joachim Breitner <nomeata@debian.org>  Mon, 20 Jul 2009 13:05:35 +0200",
      FilePath
"",
      FilePath
"haskell-regex-compat (0.92-2) unstable; urgency=low",
      FilePath
"",
      FilePath
"  * Adopt package for the Debian Haskell Group",
      FilePath
"  * Fix \"FTBFS with new dpkg-dev\" by adding comma to debian/control",
      FilePath
"    (Closes: #536473)",
      FilePath
"",
      FilePath
" -- Joachim Breitner <nomeata@debian.org>  Mon, 20 Jul 2009 12:05:40 +0200",
      FilePath
"",
      FilePath
"haskell-regex-compat (0.92-1.1) unstable; urgency=low",
      FilePath
"",
      FilePath
"  * Rebuild for GHC 6.10.",
      FilePath
"  * NMU with permission of the author.",
      FilePath
"",
      FilePath
" -- John Goerzen <jgoerzen@complete.org>  Mon, 16 Mar 2009 10:12:04 -0500",
      FilePath
"",
      FilePath
"haskell-regex-compat (0.92-1) unstable; urgency=low",
      FilePath
"",
      FilePath
"  * New upstream release",
      FilePath
"  * debian/control:",
      FilePath
"    - Bump Standards-Version. No changes needed.",
      FilePath
"",
      FilePath
" -- Arjan Oosting <arjan@debian.org>  Sun, 18 Jan 2009 00:05:02 +0100",
      FilePath
"",
      FilePath
"haskell-regex-compat (0.91-1) unstable; urgency=low",
      FilePath
"",
      FilePath
"  * Take over package from Ian, as I already maintain haskell-regex-base,",
      FilePath
"    and move Ian to the Uploaders field.",
      FilePath
"  * Packaging complete redone (based on my haskell-regex-base package).",
      FilePath
"",
      FilePath
" -- Arjan Oosting <arjan@debian.org>  Sat, 19 Jan 2008 16:48:39 +0100",
      FilePath
"",
      FilePath
"haskell-regex-compat (0.71.0.1-1) unstable; urgency=low",
      FilePath
" ",
      FilePath
"  * Initial release (used to be part of ghc6).",
      FilePath
"  * Using \"Generic Haskell cabal library packaging files v9\".",
      FilePath
"  ",
      FilePath
" -- Ian Lynagh (wibble) <igloo@debian.org>  Wed, 21 Nov 2007 01:26:57 +0000"]