diff options
| -rw-r--r-- | doc/guix.texi | 62 | ||||
| -rw-r--r-- | guix/channels.scm | 123 | ||||
| -rw-r--r-- | guix/tests/git.scm | 7 | ||||
| -rw-r--r-- | tests/channels.scm | 99 |
4 files changed, 282 insertions, 9 deletions
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 <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))))) 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") |