{-# 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 -> [Char]
changeDir :: FilePath             -- ^ The full pathname of the directory holding the .changes file.
            , ChangesFile -> [Char]
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
$c== :: ChangesFile -> ChangesFile -> Bool
== :: ChangesFile -> ChangesFile -> Bool
$c/= :: ChangesFile -> ChangesFile -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS ChangesFile
readsPrec :: Int -> ReadS ChangesFile
$creadList :: ReadS [ChangesFile]
readList :: ReadS [ChangesFile]
$creadPrec :: ReadPrec ChangesFile
readPrec :: ReadPrec ChangesFile
$creadListPrec :: ReadPrec [ChangesFile]
readListPrec :: ReadPrec [ChangesFile]
Read, Int -> ChangesFile -> ShowS
[ChangesFile] -> ShowS
ChangesFile -> [Char]
(Int -> ChangesFile -> ShowS)
-> (ChangesFile -> [Char])
-> ([ChangesFile] -> ShowS)
-> Show ChangesFile
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangesFile -> ShowS
showsPrec :: Int -> ChangesFile -> ShowS
$cshow :: ChangesFile -> [Char]
show :: ChangesFile -> [Char]
$cshowList :: [ChangesFile] -> ShowS
showList :: [ChangesFile] -> ShowS
Show)

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

-- |A changelog is a series of ChangeLogEntries
data ChangeLogEntry =
    Entry { ChangeLogEntry -> [Char]
logPackage :: String -- FIXME: Should be a SrcPkgName
          , ChangeLogEntry -> DebianVersion
logVersion :: DebianVersion
          , ChangeLogEntry -> [Codename]
logDists :: [Codename]
          , ChangeLogEntry -> [Char]
logUrgency :: String
          , ChangeLogEntry -> [Char]
logComments :: String
          , ChangeLogEntry -> [Char]
logWho :: String
          , ChangeLogEntry -> [Char]
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
$c== :: ChangeLogEntry -> ChangeLogEntry -> Bool
== :: ChangeLogEntry -> ChangeLogEntry -> Bool
$c/= :: ChangeLogEntry -> ChangeLogEntry -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS ChangeLogEntry
readsPrec :: Int -> ReadS ChangeLogEntry
$creadList :: ReadS [ChangeLogEntry]
readList :: ReadS [ChangeLogEntry]
$creadPrec :: ReadPrec ChangeLogEntry
readPrec :: ReadPrec ChangeLogEntry
$creadListPrec :: ReadPrec [ChangeLogEntry]
readListPrec :: ReadPrec [ChangeLogEntry]
Read, Int -> ChangeLogEntry -> ShowS
[ChangeLogEntry] -> ShowS
ChangeLogEntry -> [Char]
(Int -> ChangeLogEntry -> ShowS)
-> (ChangeLogEntry -> [Char])
-> ([ChangeLogEntry] -> ShowS)
-> Show ChangeLogEntry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeLogEntry -> ShowS
showsPrec :: Int -> ChangeLogEntry -> ShowS
$cshow :: ChangeLogEntry -> [Char]
show :: ChangeLogEntry -> [Char]
$cshowList :: [ChangeLogEntry] -> ShowS
showList :: [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
$c== :: ChangeLog -> ChangeLog -> Bool
== :: ChangeLog -> ChangeLog -> Bool
$c/= :: ChangeLog -> ChangeLog -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS ChangeLog
readsPrec :: Int -> ReadS ChangeLog
$creadList :: ReadS [ChangeLog]
readList :: ReadS [ChangeLog]
$creadPrec :: ReadPrec ChangeLog
readPrec :: ReadPrec ChangeLog
$creadListPrec :: ReadPrec [ChangeLog]
readListPrec :: ReadPrec [ChangeLog]
Read, Int -> ChangeLog -> ShowS
[ChangeLog] -> ShowS
ChangeLog -> [Char]
(Int -> ChangeLog -> ShowS)
-> (ChangeLog -> [Char])
-> ([ChangeLog] -> ShowS)
-> Show ChangeLog
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeLog -> ShowS
showsPrec :: Int -> ChangeLog -> ShowS
$cshow :: ChangeLog -> [Char]
show :: ChangeLog -> [Char]
$cshowList :: [ChangeLog] -> ShowS
showList :: [ChangeLog] -> ShowS
Show)

{-
instance Show ChangesFile where
    show = changesFileName
-}

changesFileName :: ChangesFile -> String
changesFileName :: ChangesFile -> [Char]
changesFileName = Doc -> [Char]
render (Doc -> [Char]) -> (ChangesFile -> Doc) -> ChangesFile -> [Char]
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) = [Char] -> Doc
text (ChangesFile -> [Char]
changePackage ChangesFile
changes [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"_") 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
<> [Char] -> Doc
text [Char]
"_" 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
<> [Char] -> Doc
text [Char]
".changes"

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

instance Pretty (PP ChangeLogEntry) where
    pretty :: PP ChangeLogEntry -> Doc
pretty (PP (Entry [Char]
package DebianVersion
ver [Codename]
dists [Char]
urgency [Char]
details [Char]
who [Char]
date)) =
        [Doc] -> Doc
hcat [ [Char] -> Doc
text [Char]
package Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
" (" 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
<> [Char] -> Doc
text ([Char]
") " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " ((Codename -> [Char]) -> [Codename] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Codename -> [Char]
codename [Codename]
dists) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"; urgency=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
urgency)
             , [Char] -> Doc
text [Char]
"\n\n"
             , [Char] -> Doc
text [Char]
"  " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text (ShowS
strip' [Char]
details)
             , [Char] -> Doc
text [Char]
"\n\n"
             , [Char] -> Doc
text ([Char]
" -- " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
who [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"  " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
date)
             , [Char] -> Doc
text [Char]
"\n" ]
    pretty (PP (WhiteSpace [Char]
_)) = [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"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 ([Char] -> Doc
text [Char]
"\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 -> [Char]
unpack (Text -> [Char]) -> ([Char] -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 ([Char] -> Doc
text [Char]
"\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 [Char]
package DebianVersion
ver [Codename]
dists [Char]
urgency [Char]
_ [Char]
_ [Char]
_) =
    [Char] -> Doc
text ([Char]
package [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" (") 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
<> [Char] -> Doc
text ([Char]
") " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " ((Codename -> [Char]) -> [Codename] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Codename -> [Char]
codename [Codename]
dists) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"; urgency=" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
urgency [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"...")
_showHeader (WhiteSpace [Char]
_) = [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"_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 :: [Char] -> Either [[[Char]]] ChangeLog
parseChangeLog [Char]
s =
    case [Either [[Char]] ChangeLogEntry] -> ([[[Char]]], [ChangeLogEntry])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Char] -> [Either [[Char]] ChangeLogEntry]
parseEntries [Char]
s) of
      ([], [ChangeLogEntry]
xs) -> ChangeLog -> Either [[[Char]]] ChangeLog
forall a b. b -> Either a b
Right ([ChangeLogEntry] -> ChangeLog
ChangeLog [ChangeLogEntry]
xs)
      ([[[Char]]]
ss, [ChangeLogEntry]
_) -> [[[Char]]] -> Either [[[Char]]] ChangeLog
forall a b. a -> Either a b
Left [[[Char]]]
ss

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

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

entryRE :: [Char]
entryRE = [Char]
bol [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
blankLines [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
headerRE [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
changeDetails [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
signature [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
blankLines
changeDetails :: [Char]
changeDetails = [Char]
"((\n| \n| -\n|([^ ]| [^--]| -[^--])[^\n]*\n)*)"
signature :: [Char]
signature = [Char]
" -- ([ ]*([^ ]+ )* )([^\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 -> [Char]
unpack Text
text [Char] -> [Char] -> MatchResult [Char]
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ [Char]
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 = [[Char]
_, [Char]
name, [Char]
ver, [Char]
dists, [Char]
urgency, [Char]
_, [Char]
details]} ->
          ChangeLogEntry -> Maybe ChangeLogEntry
forall a. a -> Maybe a
Just (ChangeLogEntry -> Maybe ChangeLogEntry)
-> ChangeLogEntry -> Maybe ChangeLogEntry
forall a b. (a -> b) -> a -> b
$ [Char]
-> DebianVersion
-> [Codename]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> ChangeLogEntry
Entry [Char]
name
                       ([Char] -> DebianVersion
forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' [Char]
ver)
                       (([Char] -> Codename) -> [[Char]] -> [Codename]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Codename
parseCodename ([[Char]] -> [Codename])
-> ([Char] -> [[Char]]) -> [Char] -> [Codename]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words ([Char] -> [Codename]) -> [Char] -> [Codename]
forall a b. (a -> b) -> a -> b
$ [Char]
dists)
                       [Char]
urgency
                       [Char]
details
                       [Char]
"" [Char]
""
      MR {mrSubList :: forall a. MatchResult a -> [a]
mrSubList = [[Char]]
x} -> [Char] -> Maybe ChangeLogEntry
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe ChangeLogEntry) -> [Char] -> Maybe ChangeLogEntry
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected match: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
x
    where
      changesRE :: [Char]
changesRE = [Char]
bol [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
blankLines [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
optWhite [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
headerRE [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"(.*)$"

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

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

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