diff --git a/doc/guix.texi b/doc/guix.texi
index af1903f6ff..cd108faa8f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
diff --git a/guix/channels.scm b/guix/channels.scm
index ebb2cacbc7..0dadba616f 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -19,6 +19,7 @@
;;; along with GNU Guix. If not, see .
(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 directory dependencies)
+ (channel-metadata directory dependencies news-file)
channel-metadata?
(directory channel-metadata-directory) ;string with leading slash
- (dependencies channel-metadata-dependencies)) ;list of
+ (dependencies channel-metadata-dependencies) ;list of
+ (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 entries)
+ channel-news?
+ (entries channel-news-entries)) ;list of
+
+;; News entry, associated with a specific commit of the channel.
+(define-record-type
+ (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 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
+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 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)))))
diff --git a/guix/tests/git.scm b/guix/tests/git.scm
index 52abe77c83..9d5b1ae321 100644
--- a/guix/tests/git.scm
+++ b/guix/tests/git.scm
@@ -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 ...)
diff --git a/tests/channels.scm b/tests/channels.scm
index e83b5437d3..58101bcb72 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -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")