channels: Allow news entries to refer to a tag.
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.
This commit is contained in:
Ludovic Courtès
parent
8ba7fd3cd6
commit
9719e8d37a
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
Loading…
Reference in New Issue