From ce5d9ec875156f3de7479e861731edf48c984c16 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 17 Jul 2019 00:41:10 +0200 Subject: channels: Always provide a record. This simplifies the code since one no longer needs to think about whether '.guix-channel' was present. * guix/channels.scm (read-channel-metadata): Always pass a string as the first argument to 'channel-metadata'. (read-channel-metadata-from-source): Always return a record. (channel-instance-dependencies): Remove now unneeded 'match'. (standard-module-derivation): Assume DIRECTORY is never #f and contains a leading slash. * tests/channels.scm (channel-metadata-directory) (channel-metadata-dependencies): New procedures. ("channel-instance-metadata returns #f if .guix-channel does not exist"): Remove. ("channel-instance-metadata returns default if .guix-channel does not exist"): New test. (make-instance): Use 'write' instead of 'display' when creating '.guix-channel'. (instance--no-deps): Remove dependencies. (instance--sub-directory): New variable. ("channel-instance-metadata and default dependencies") ("channel-instance-metadata and directory"): New tests. ("latest-channel-instances excludes duplicate channel dependencies"): Expect 'channel-commit' to return a string and adjust accordingly. --- guix/channels.scm | 27 ++++++++++++--------------- tests/channels.scm | 45 +++++++++++++++++++++++++++++---------------- 2 files changed, 41 insertions(+), 31 deletions(-) diff --git a/guix/channels.scm b/guix/channels.scm index 87ad729a70..415246cbd1 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -110,8 +110,8 @@ (define-record-type (define-record-type (channel-metadata directory dependencies) channel-metadata? - (directory channel-metadata-directory) - (dependencies channel-metadata-dependencies)) + (directory channel-metadata-directory) ;string with leading slash + (dependencies channel-metadata-dependencies)) ;list of (define (channel-reference channel) "Return the \"reference\" for CHANNEL, an sexp suitable for @@ -129,7 +129,9 @@ (define (read-channel-metadata port) (let ((directory (and=> (assoc-ref properties 'directory) first)) (dependencies (or (assoc-ref properties 'dependencies) '()))) (channel-metadata - directory + (cond ((not directory) "/") + ((string-prefix? "/" directory) directory) + (else (string-append "/" directory))) (map (lambda (item) (let ((get (lambda* (key #:optional default) (or (and=> (assoc-ref item key) first) default)))) @@ -157,29 +159,26 @@ (define (read-channel-metadata port) (define (read-channel-metadata-from-source source) "Return a channel-metadata record read from channel's SOURCE/.guix-channel -description file, or return #F if SOURCE/.guix-channel does not exist." +description file, or return the default channel-metadata record if that file +doesn't exist." (catch 'system-error (lambda () (call-with-input-file (string-append source "/.guix-channel") read-channel-metadata)) (lambda args (if (= ENOENT (system-error-errno args)) - #f + (channel-metadata "/" '()) (apply throw args))))) (define (channel-instance-metadata instance) "Return a channel-metadata record read from the channel INSTANCE's -description file, or return #F if the channel instance does not include the -file." +description file or its default value." (read-channel-metadata-from-source (channel-instance-checkout instance))) (define (channel-instance-dependencies instance) "Return the list of channels that are declared as dependencies for the given channel INSTANCE." - (match (channel-instance-metadata instance) - (#f '()) - (($ directory dependencies) - dependencies))) + (channel-metadata-dependencies (channel-instance-metadata instance))) (define* (latest-channel-instances store channels #:optional (previous-channels '())) "Return a list of channel instances corresponding to the latest checkouts of @@ -261,7 +260,7 @@ (define (standard-module-derivation name source core dependencies) to '%package-module-path'." (let* ((metadata (read-channel-metadata-from-source source)) - (directory (and=> metadata channel-metadata-directory))) + (directory (channel-metadata-directory metadata))) (define build ;; This is code that we'll run in CORE, a Guix instance, with its own @@ -281,9 +280,7 @@ (define scm (string-append #$output "/share/guile/site/" (effective-version))) - (let* ((subdir (if #$directory - (string-append "/" #$directory) - "")) + (let* ((subdir #$directory) (source (string-append #$source subdir))) (compile-files source go (find-files source "\\.scm$")) (mkdir-p (dirname scm)) diff --git a/tests/channels.scm b/tests/channels.scm index 1f1357fca7..e83b5437d3 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -42,9 +42,9 @@ (define* (make-instance #:key (commit "cafebabe") (spec #f)) (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX")) - (and spec - (with-output-to-file (string-append instance-dir "/.guix-channel") - (lambda _ (format #t "~a" spec)))) + (when spec + (call-with-output-file (string-append instance-dir "/.guix-channel") + (lambda (port) (write spec port)))) (checkout->channel-instance instance-dir #:commit commit #:name name)) @@ -55,12 +55,10 @@ (define instance--unsupported-version '(channel (version 42) (dependencies whatever)))) (define instance--no-deps (make-instance #:spec - '(channel - (version 0) - (dependencies - (channel - (name test-channel) - (url "https://example.com/test-channel")))))) + '(channel (version 0)))) +(define instance--sub-directory + (make-instance #:spec + '(channel (version 0) (directory "modules")))) (define instance--simple (make-instance #:spec '(channel @@ -87,11 +85,26 @@ (define instance--with-dupes (define channel-instance-metadata (@@ (guix channels) channel-instance-metadata)) +(define channel-metadata-directory + (@@ (guix channels) channel-metadata-directory)) +(define channel-metadata-dependencies + (@@ (guix channels) channel-metadata-dependencies)) -(test-equal "channel-instance-metadata returns #f if .guix-channel does not exist" - #f - (channel-instance-metadata instance--boring)) +(test-equal "channel-instance-metadata returns default if .guix-channel does not exist" + '("/" ()) + (let ((metadata (channel-instance-metadata instance--boring))) + (list (channel-metadata-directory metadata) + (channel-metadata-dependencies metadata)))) + +(test-equal "channel-instance-metadata and default dependencies" + '() + (channel-metadata-dependencies (channel-instance-metadata instance--no-deps))) + +(test-equal "channel-instance-metadata and directory" + "/modules" + (channel-metadata-directory + (channel-instance-metadata instance--sub-directory))) (test-equal "channel-instance-metadata rejects unsupported version" 1 ;line number in the generated '.guix-channel' @@ -141,7 +154,7 @@ (define channel-instance-metadata ("test" (values test-dir 'whatever)) (_ (values "/not-important" 'not-important))))) (let ((instances (latest-channel-instances #f (list channel)))) - (and (eq? 2 (length instances)) + (and (= 2 (length instances)) (lset= eq? '(test test-channel) (map (compose channel-name channel-instance-channel) @@ -152,9 +165,9 @@ (define channel-instance-metadata (and (eq? (channel-name (channel-instance-channel instance)) 'test-channel) - (eq? (channel-commit - (channel-instance-channel instance)) - 'abc1234))) + (string=? (channel-commit + (channel-instance-channel instance)) + "abc1234"))) instances)))))) (test-assert "channel-instances->manifest" -- cgit v1.2.3