summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-09-14 23:16:54 +0200
committerLudovic Courtès <ludo@gnu.org>2019-09-23 10:38:44 +0200
commit8ba7fd3cd6962f1c1aaaa5f71eed7f9222094f25 (patch)
tree55b4dd25f2b16a9786f08e331b743f4289ccb053 /guix
parent873f6f1334ab06a69e768a8aea0054404237542f (diff)
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.
Diffstat (limited to 'guix')
-rw-r--r--guix/channels.scm123
-rw-r--r--guix/tests/git.scm7
2 files changed, 121 insertions, 9 deletions
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 ...)