From 9719e8d37aaa63e1c8f9d4ab1e28d49e2e56d85b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 21 Sep 2019 21:29:30 +0200 Subject: channels: Allow news entries to refer to a tag. Suggested by Ricardo Wurmus . * guix/channels.scm ()[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 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 cd108faa8f..33bf08e9dd 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 arbitrarily 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 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 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") -- cgit v1.2.3