[bug#37413] [PATCH v2 05/11] channels: Allow news entries to refer to a tag.

["Ludovic Courtès" <ludo@gnu.org>]

Suggested by Ricardo Wurmus <rekado@elephly.net>.

* guix/channels.scm (<channel-news-entry>)[tag]: New field.
(sexp->channel-news-entry): Accept either 'commit' or 'tag' in 'entry'
forms.
(resolve-channel-news-entry-tag): New procedure.
(channel-news-for-commit): Move 'with-repository' form one level
higher.  Call 'resolve-channel-news-entry-tag' on all the news entries.
* guix/tests/git.scm (populate-git-repository): Add clause for 'tag'.
* tests/channels.scm ("channel-news, one entry"): Create a tag and add
an entry with a tag.  Check that the tag is resolved and also visible in
the <channel-news-entry> record.
* doc/guix.texi (Channels): Mention tags in news entries.
---
 doc/guix.texi      |  8 ++++----
 guix/channels.scm  | 42 ++++++++++++++++++++++++++++++++----------
 guix/tests/git.scm |  3 +++
 tests/channels.scm |  9 +++++++--
 4 files changed, 46 insertions(+), 16 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 712c0811a5..5addb1f5ee 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4018,7 +4018,7 @@ something like this:
 @lisp
 (channel-news
   (version 0)
-  (entry (commit "d894ab8e9bfabcefa6c49d9ba2e834dd5a73a300")
+  (entry (tag "the-bug-fix")
          (title (en "Fixed terrible bug")
                 (fr "Oh la la"))
          (body (en "@@emph@{Good news@}!  It's fixed!")
@@ -4030,9 +4030,9 @@ something like this:
 @end lisp
 
 The file consists of a list of @dfn{news entries}.  Each entry is
-associated with a commit: it describes changes made in this commit,
-possibly in preceding commits as well.  Users see entries only the first
-time they obtain the commit the entry refers to.
+associated with a commit or tag: it describes changes made in this
+commit, possibly in preceding commits as well.  Users see entries only
+the first time they obtain the commit the entry refers to.
 
 The @code{title} field should be a one-line summary while @code{body}
 can be arbitrary long, and both can contain Texinfo markup
diff --git a/guix/channels.scm b/guix/channels.scm
index 0dadba616f..4e6e7090ac 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -40,6 +40,7 @@
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:autoload   (guix self) (whole-package make-config.scm)
@@ -73,6 +74,7 @@
 
             channel-news-entry?
             channel-news-entry-commit
+            channel-news-entry-tag
             channel-news-entry-title
             channel-news-entry-body
 
@@ -586,9 +588,10 @@ PROFILE is not a profile created by 'guix pull', return the empty list."
 
 ;; News entry, associated with a specific commit of the channel.
 (define-record-type <channel-news-entry>
-  (channel-news-entry commit title body)
+  (channel-news-entry commit tag title body)
   channel-news-entry?
-  (commit  channel-news-entry-commit)             ;hex string
+  (commit  channel-news-entry-commit)             ;hex string | #f
+  (tag     channel-news-entry-tag)                ;#f | string
   (title   channel-news-entry-title)              ;list of language tag/string pairs
   (body    channel-news-entry-body))              ;list of language tag/string pairs
 
@@ -598,11 +601,12 @@ PROFILE is not a profile created by 'guix pull', return the empty list."
     (cons (symbol->string language) message))
 
   (match entry
-    (('entry ('commit commit)
+    (('entry ((and (or 'commit 'tag) type) commit-or-tag)
              ('title ((? symbol? title-tags) (? string? titles)) ...)
              ('body ((? symbol? body-tags) (? string? bodies)) ...)
              _ ...)
-     (channel-news-entry commit
+     (channel-news-entry (and (eq? type 'commit) commit-or-tag)
+                         (and (eq? type 'tag) commit-or-tag)
                          (map pair title-tags titles)
                          (map pair body-tags bodies)))
     (_
@@ -633,6 +637,20 @@ record."
               (location (source-properties->location
                          (source-properties sexp)))))))))
 
+(define (resolve-channel-news-entry-tag repository entry)
+  "If ENTRY has its 'commit' field set, return ENTRY.  Otherwise, lookup
+ENTRY's 'tag' in REPOSITORY and return ENTRY with its 'commit' field set to
+the field its 'tag' refers to.  A 'git-error' exception is raised if the tag
+cannot be found."
+  (if (channel-news-entry-commit entry)
+      entry
+      (let* ((tag       (channel-news-entry-tag entry))
+             (reference (string-append "refs/tags/" tag))
+             (oid       (reference-name->oid repository reference)))
+        (channel-news-entry (oid->string oid) tag
+                            (channel-news-entry-title entry)
+                            (channel-news-entry-body entry)))))
+
 (define* (channel-news-for-commit channel new #:optional old)
   "Return a list of <channel-news-entry> for CHANNEL between commits OLD and
 NEW.  When OLD is omitted or is #f, return all the news entries of CHANNEL."
@@ -645,10 +663,14 @@ NEW.  When OLD is omitted or is #f, return all the news entries of CHANNEL."
              (news-file (and news-file
                              (string-append checkout "/" news-file))))
         (if (and news-file (file-exists? news-file))
-            (let ((entries (channel-news-entries (call-with-input-file news-file
-                                                   read-channel-news))))
-              (if old
-                  (with-repository checkout repository
+            (with-repository checkout repository
+              (let* ((news    (call-with-input-file news-file
+                                read-channel-news))
+                     (entries (map (lambda (entry)
+                                     (resolve-channel-news-entry-tag repository
+                                                                     entry))
+                                   (channel-news-entries news))))
+                (if old
                     (let* ((new     (commit-lookup repository (string->oid new)))
                            (old     (commit-lookup repository (string->oid old)))
                            (commits (list->set
@@ -657,8 +679,8 @@ NEW.  When OLD is omitted or is #f, return all the news entries of CHANNEL."
                       (filter (lambda (entry)
                                 (set-contains? commits
                                                (channel-news-entry-commit entry)))
-                              entries)))
-                  entries))
+                              entries))
+                    entries)))
             '())))
     (lambda (key error . rest)
       ;; If commit NEW or commit OLD cannot be found, then something must be
diff --git a/guix/tests/git.scm b/guix/tests/git.scm
index 9d5b1ae321..21573ac14e 100644
--- a/guix/tests/git.scm
+++ b/guix/tests/git.scm
@@ -66,6 +66,9 @@ Return DIRECTORY on success."
       ((('commit text) rest ...)
        (git "commit" "-m" text)
        (loop rest))
+      ((('tag name) rest ...)
+       (git "tag" name)
+       (loop rest))
       ((('branch name) rest ...)
        (git "branch" name)
        (loop rest))
diff --git a/tests/channels.scm b/tests/channels.scm
index 58101bcb72..f5a7955483 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -272,6 +272,7 @@
         (commit "first commit")
         (add "src/a.txt" "A")
         (commit "second commit")
+        (tag "tag-for-first-news-entry")
         (add "news.scm"
              ,(lambda (repository)
                 (let ((previous
@@ -299,7 +300,7 @@
                      (entry (commit ,(oid->string previous))
                             (title (en "Another file!"))
                             (body (en "Yeah, b.txt.")))
-                     (entry (commit ,(oid->string second))
+                     (entry (tag "tag-for-first-news-entry")
                             (title (en "Old news.")
                                    (eo "Malnovaĵoj."))
                             (body (en "For a.txt"))))))))
@@ -343,6 +344,10 @@
              (lset= string=?
                     (map channel-news-entry-commit
                          (channel-news-for-commit channel commit5 commit1))
-                    (list commit4 commit2)))))))
+                    (list commit4 commit2))
+             (lset= equal?
+                    (map channel-news-entry-tag
+                         (channel-news-for-commit channel commit5 commit1))
+                    '(#f "tag-for-first-news-entry")))))))
 
 (test-end "channels")
-- 
2.23.0