channels: Add support for a news file.
* guix/channels.scm (<channel-metadata>)[news-file]: New field.
(read-channel-metadata): Set the 'news-file' field.
(read-channel-metadata-from-source): Likewise.
(<channel-news>, <channel-news-entry>): New record types.
(sexp->channel-news-entry, read-channel-news)
(channel-news-for-commit): New procedures.
* guix/tests/git.scm (populate-git-repository): For 'add', allow
CONTENTS to be a procedure.
* tests/channels.scm ("channel-news, no news")
("channel-news, one entry"): New tests.
* doc/guix.texi (Channels): Document it.
master
Ludovic Courtès
parent
873f6f1334
commit
8ba7fd3cd6
|
|
@ -3991,6 +3991,68 @@ add a meta-data file @file{.guix-channel} that contains:
|
|||
(directory "guix"))
|
||||
@end lisp
|
||||
|
||||
@cindex news, for channels
|
||||
@subsection Writing Channel News
|
||||
|
||||
Channel authors may occasionally want to communicate to their users
|
||||
information about important changes in the channel. You'd send them all
|
||||
an email, but that's not convenient.
|
||||
|
||||
Instead, channels can provide a @dfn{news file}; when the channel users
|
||||
run @command{guix pull}, that news file is automatically read and
|
||||
@command{guix pull --news} can display the announcements that correspond
|
||||
to the new commits that have been pulled, if any.
|
||||
|
||||
To do that, channel authors must first declare the name of the news file
|
||||
in their @file{.guix-channel} file:
|
||||
|
||||
@lisp
|
||||
(channel
|
||||
(version 0)
|
||||
(news-file "etc/news.txt"))
|
||||
@end lisp
|
||||
|
||||
The news file itself, @file{etc/news.txt} in this example, must look
|
||||
something like this:
|
||||
|
||||
@lisp
|
||||
(channel-news
|
||||
(version 0)
|
||||
(entry (commit "d894ab8e9bfabcefa6c49d9ba2e834dd5a73a300")
|
||||
(title (en "Fixed terrible bug")
|
||||
(fr "Oh la la"))
|
||||
(body (en "@@emph@{Good news@}! It's fixed!")
|
||||
(eo "Certe ĝi pli bone funkcias nun!")))
|
||||
(entry (commit "bdcabe815cd28144a2d2b4bc3c5057b051fa9906")
|
||||
(title (en "Added a great package")
|
||||
(ca "Què vol dir guix?"))
|
||||
(body (en "Don't miss the @@code@{hello@} package!"))))
|
||||
@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.
|
||||
|
||||
The @code{title} field should be a one-line summary while @code{body}
|
||||
can be arbitrarily long, and both can contain Texinfo markup
|
||||
(@pxref{Overview,,, texinfo, GNU Texinfo}). Both the title and body are
|
||||
a list of language tag/message tuples, which allows @command{guix pull}
|
||||
to display news in the language that corresponds to the user's locale.
|
||||
|
||||
If you want to translate news using a gettext-based workflow, you can
|
||||
extract translatable strings with @command{xgettext} (@pxref{xgettext
|
||||
Invocation,,, gettext, GNU Gettext Utilities}). For example, assuming
|
||||
you write news entries in English first, the command below creates a PO
|
||||
file containing the strings to translate:
|
||||
|
||||
@example
|
||||
xgettext -o news.po -l scheme -ken etc/news.scm
|
||||
@end example
|
||||
|
||||
To sum up, yes, you could use your channel as a blog. But beware, this
|
||||
is @emph{not quite} what your users might expect.
|
||||
|
||||
@subsection Replicating Guix
|
||||
|
||||
@cindex pinning, channels
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@
|
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix channels)
|
||||
#:use-module (git)
|
||||
#:use-module (guix git)
|
||||
#:use-module (guix records)
|
||||
#:use-module (guix gexp)
|
||||
|
|
@ -29,6 +30,7 @@
|
|||
#:use-module (guix derivations)
|
||||
#:use-module (guix combinators)
|
||||
#:use-module (guix diagnostics)
|
||||
#:use-module (guix sets)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix i18n)
|
||||
#:use-module ((guix utils)
|
||||
|
|
@ -67,7 +69,14 @@
|
|||
%channel-profile-hooks
|
||||
channel-instances->derivation
|
||||
|
||||
profile-channels))
|
||||
profile-channels
|
||||
|
||||
channel-news-entry?
|
||||
channel-news-entry-commit
|
||||
channel-news-entry-title
|
||||
channel-news-entry-body
|
||||
|
||||
channel-news-for-commit))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -110,10 +119,11 @@
|
|||
(checkout channel-instance-checkout))
|
||||
|
||||
(define-record-type <channel-metadata>
|
||||
(channel-metadata directory dependencies)
|
||||
(channel-metadata directory dependencies news-file)
|
||||
channel-metadata?
|
||||
(directory channel-metadata-directory) ;string with leading slash
|
||||
(dependencies channel-metadata-dependencies)) ;list of <channel>
|
||||
(dependencies channel-metadata-dependencies) ;list of <channel>
|
||||
(news-file channel-metadata-news-file)) ;string | #f
|
||||
|
||||
(define (channel-reference channel)
|
||||
"Return the \"reference\" for CHANNEL, an sexp suitable for
|
||||
|
|
@ -129,12 +139,13 @@ if valid metadata could not be read from PORT."
|
|||
(match (read port)
|
||||
(('channel ('version 0) properties ...)
|
||||
(let ((directory (and=> (assoc-ref properties 'directory) first))
|
||||
(dependencies (or (assoc-ref properties 'dependencies) '())))
|
||||
(dependencies (or (assoc-ref properties 'dependencies) '()))
|
||||
(news-file (and=> (assoc-ref properties 'news-file) first)))
|
||||
(channel-metadata
|
||||
(cond ((not directory) "/")
|
||||
(cond ((not directory) "/") ;directory
|
||||
((string-prefix? "/" directory) directory)
|
||||
(else (string-append "/" directory)))
|
||||
(map (lambda (item)
|
||||
(map (lambda (item) ;dependencies
|
||||
(let ((get (lambda* (key #:optional default)
|
||||
(or (and=> (assoc-ref item key) first) default))))
|
||||
(and-let* ((name (get 'name))
|
||||
|
|
@ -145,7 +156,8 @@ if valid metadata could not be read from PORT."
|
|||
(branch branch)
|
||||
(url url)
|
||||
(commit (get 'commit))))))
|
||||
dependencies))))
|
||||
dependencies)
|
||||
news-file))) ;news-file
|
||||
((and ('channel ('version version) _ ...) sexp)
|
||||
(raise (condition
|
||||
(&message (message "unsupported '.guix-channel' version"))
|
||||
|
|
@ -169,7 +181,7 @@ doesn't exist."
|
|||
read-channel-metadata))
|
||||
(lambda args
|
||||
(if (= ENOENT (system-error-errno args))
|
||||
(channel-metadata "/" '())
|
||||
(channel-metadata "/" '() #f)
|
||||
(apply throw args)))))
|
||||
|
||||
(define (channel-instance-metadata instance)
|
||||
|
|
@ -560,3 +572,98 @@ PROFILE is not a profile created by 'guix pull', return the empty list."
|
|||
;; Show most recently installed packages last.
|
||||
(reverse
|
||||
(manifest-entries (profile-manifest profile)))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; News.
|
||||
;;;
|
||||
|
||||
;; Channel news.
|
||||
(define-record-type <channel-news>
|
||||
(channel-news entries)
|
||||
channel-news?
|
||||
(entries channel-news-entries)) ;list of <channel-news-entry>
|
||||
|
||||
;; 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 channel-news-entry-commit) ;hex string
|
||||
(title channel-news-entry-title) ;list of language tag/string pairs
|
||||
(body channel-news-entry-body)) ;list of language tag/string pairs
|
||||
|
||||
(define (sexp->channel-news-entry entry)
|
||||
"Return the <channel-news-entry> record corresponding to ENTRY, an sexp."
|
||||
(define (pair language message)
|
||||
(cons (symbol->string language) message))
|
||||
|
||||
(match entry
|
||||
(('entry ('commit commit)
|
||||
('title ((? symbol? title-tags) (? string? titles)) ...)
|
||||
('body ((? symbol? body-tags) (? string? bodies)) ...)
|
||||
_ ...)
|
||||
(channel-news-entry commit
|
||||
(map pair title-tags titles)
|
||||
(map pair body-tags bodies)))
|
||||
(_
|
||||
(raise (condition
|
||||
(&message (message "invalid channel news entry"))
|
||||
(&error-location
|
||||
(location (source-properties->location
|
||||
(source-properties entry)))))))))
|
||||
|
||||
(define (read-channel-news port)
|
||||
"Read a channel news feed from PORT and return it as a <channel-news>
|
||||
record."
|
||||
(match (false-if-exception (read port))
|
||||
(('channel-news ('version 0) entries ...)
|
||||
(channel-news (map sexp->channel-news-entry entries)))
|
||||
(('channel-news ('version version) _ ...)
|
||||
;; This is an unsupported version from the future. There's nothing wrong
|
||||
;; with that (the user may simply need to upgrade the 'guix' channel to
|
||||
;; be able to read it), so silently ignore it.
|
||||
(channel-news '()))
|
||||
(#f
|
||||
(raise (condition
|
||||
(&message (message "syntactically invalid channel news file")))))
|
||||
(sexp
|
||||
(raise (condition
|
||||
(&message (message "invalid channel news file"))
|
||||
(&error-location
|
||||
(location (source-properties->location
|
||||
(source-properties sexp)))))))))
|
||||
|
||||
(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."
|
||||
(catch 'git-error
|
||||
(lambda ()
|
||||
(let* ((checkout (update-cached-checkout (channel-url channel)
|
||||
#:ref `(commit . ,new)))
|
||||
(metadata (read-channel-metadata-from-source checkout))
|
||||
(news-file (channel-metadata-news-file metadata))
|
||||
(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
|
||||
(let* ((new (commit-lookup repository (string->oid new)))
|
||||
(old (commit-lookup repository (string->oid old)))
|
||||
(commits (list->set
|
||||
(map (compose oid->string commit-id)
|
||||
(commit-difference new old)))))
|
||||
(filter (lambda (entry)
|
||||
(set-contains? commits
|
||||
(channel-news-entry-commit entry)))
|
||||
entries)))
|
||||
entries))
|
||||
'())))
|
||||
(lambda (key error . rest)
|
||||
;; If commit NEW or commit OLD cannot be found, then something must be
|
||||
;; wrong (for example, the history of CHANNEL was rewritten and these
|
||||
;; commits no longer exist upstream), so quietly return the empty list.
|
||||
(if (= GIT_ENOTFOUND (git-error-code error))
|
||||
'()
|
||||
(apply throw key error rest)))))
|
||||
|
|
|
|||
|
|
@ -18,6 +18,7 @@
|
|||
|
||||
(define-module (guix tests git)
|
||||
#:use-module (git)
|
||||
#:use-module ((guix git) #:select (with-repository))
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (ice-9 match)
|
||||
|
|
@ -55,7 +56,11 @@ Return DIRECTORY on success."
|
|||
(mkdir-p (dirname file))
|
||||
(call-with-output-file file
|
||||
(lambda (port)
|
||||
(display contents port)))
|
||||
(display (if (string? contents)
|
||||
contents
|
||||
(with-repository directory repository
|
||||
(contents repository)))
|
||||
port)))
|
||||
(git "add" file)
|
||||
(loop rest)))
|
||||
((('commit text) rest ...)
|
||||
|
|
|
|||
|
|
@ -28,6 +28,10 @@
|
|||
#:use-module (guix gexp)
|
||||
#:use-module ((guix utils)
|
||||
#:select (error-location? error-location location-line))
|
||||
#:use-module ((guix build utils) #:select (which))
|
||||
#:use-module (git)
|
||||
#:use-module (guix git)
|
||||
#:use-module (guix tests git)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-34)
|
||||
|
|
@ -246,4 +250,99 @@
|
|||
(depends? drv3
|
||||
(list drv2 drv0) (list))))))))
|
||||
|
||||
(unless (which (git-command)) (test-skip 1))
|
||||
(test-equal "channel-news, no news"
|
||||
'()
|
||||
(with-temporary-git-repository directory
|
||||
'((add "a.txt" "A")
|
||||
(commit "the commit"))
|
||||
(with-repository directory repository
|
||||
(let ((channel (channel (url (string-append "file://" directory))
|
||||
(name 'foo)))
|
||||
(latest (reference-name->oid repository "HEAD")))
|
||||
(channel-news-for-commit channel (oid->string latest))))))
|
||||
|
||||
(unless (which (git-command)) (test-skip 1))
|
||||
(test-assert "channel-news, one entry"
|
||||
(with-temporary-git-repository directory
|
||||
`((add ".guix-channel"
|
||||
,(object->string
|
||||
'(channel (version 0)
|
||||
(news-file "news.scm"))))
|
||||
(commit "first commit")
|
||||
(add "src/a.txt" "A")
|
||||
(commit "second commit")
|
||||
(add "news.scm"
|
||||
,(lambda (repository)
|
||||
(let ((previous
|
||||
(reference-name->oid repository "HEAD")))
|
||||
(object->string
|
||||
`(channel-news
|
||||
(version 0)
|
||||
(entry (commit ,(oid->string previous))
|
||||
(title (en "New file!")
|
||||
(eo "Nova dosiero!"))
|
||||
(body (en "Yeah, a.txt."))))))))
|
||||
(commit "third commit")
|
||||
(add "src/b.txt" "B")
|
||||
(commit "fourth commit")
|
||||
(add "news.scm"
|
||||
,(lambda (repository)
|
||||
(let ((second
|
||||
(commit-id
|
||||
(find-commit repository "second commit")))
|
||||
(previous
|
||||
(reference-name->oid repository "HEAD")))
|
||||
(object->string
|
||||
`(channel-news
|
||||
(version 0)
|
||||
(entry (commit ,(oid->string previous))
|
||||
(title (en "Another file!"))
|
||||
(body (en "Yeah, b.txt.")))
|
||||
(entry (commit ,(oid->string second))
|
||||
(title (en "Old news.")
|
||||
(eo "Malnovaĵoj."))
|
||||
(body (en "For a.txt"))))))))
|
||||
(commit "fifth commit"))
|
||||
(with-repository directory repository
|
||||
(define (find-commit* message)
|
||||
(oid->string (commit-id (find-commit repository message))))
|
||||
|
||||
(let ((channel (channel (url (string-append "file://" directory))
|
||||
(name 'foo)))
|
||||
(commit1 (find-commit* "first commit"))
|
||||
(commit2 (find-commit* "second commit"))
|
||||
(commit3 (find-commit* "third commit"))
|
||||
(commit4 (find-commit* "fourth commit"))
|
||||
(commit5 (find-commit* "fifth commit")))
|
||||
;; First try fetching all the news up to a given commit.
|
||||
(and (null? (channel-news-for-commit channel commit2))
|
||||
(lset= string=?
|
||||
(map channel-news-entry-commit
|
||||
(channel-news-for-commit channel commit5))
|
||||
(list commit2 commit4))
|
||||
(lset= equal?
|
||||
(map channel-news-entry-title
|
||||
(channel-news-for-commit channel commit5))
|
||||
'((("en" . "Another file!"))
|
||||
(("en" . "Old news.") ("eo" . "Malnovaĵoj."))))
|
||||
(lset= string=?
|
||||
(map channel-news-entry-commit
|
||||
(channel-news-for-commit channel commit3))
|
||||
(list commit2))
|
||||
|
||||
;; Now fetch news entries that apply to a commit range.
|
||||
(lset= string=?
|
||||
(map channel-news-entry-commit
|
||||
(channel-news-for-commit channel commit3 commit1))
|
||||
(list commit2))
|
||||
(lset= string=?
|
||||
(map channel-news-entry-commit
|
||||
(channel-news-for-commit channel commit5 commit3))
|
||||
(list commit4))
|
||||
(lset= string=?
|
||||
(map channel-news-entry-commit
|
||||
(channel-news-for-commit channel commit5 commit1))
|
||||
(list commit4 commit2)))))))
|
||||
|
||||
(test-end "channels")
|
||||
|
|
|
|||
Loading…
Reference in New Issue