ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

channels: Add support for a news file.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2019-09-14 23:16:54 +02:00
parent 873f6f1334
commit 8ba7fd3cd6
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
4 changed files with 282 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
doc/guix.texi
View file

@ -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

123
guix/channels.scm
View file

@ -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 @@ (define-module (guix channels)
#: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 @@ (define-module (guix channels)
%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 @@ (define-record-type <channel-instance>
(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 @@ (define (read-channel-metadata 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 @@ (define (read-channel-metadata 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 @@ (define (read-channel-metadata-from-source source)
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 @@ (define (profile-channels profile)
;; 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)))))

7
guix/tests/git.scm
View file

@ -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 @@ (define (git command . args)
(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 ...)

99
tests/channels.scm
View file

@ -28,6 +28,10 @@ (define-module (test-channels)
#: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 @@ (define (lookup name)
(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")