nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

channels: Always provide a <channel-metadata> 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 <channel-metadata>
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.
This commit is contained in:
Ludovic Courtès 2019-07-17 00:41:10 +02:00
parent 5d9daa85b0
commit ce5d9ec875
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 41 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
guix/channels.scm
View File

@ -110,8 +110,8 @@
(define-record-type <channel-metadata> (define-record-type <channel-metadata>
(channel-metadata directory dependencies) (channel-metadata directory dependencies)
channel-metadata? channel-metadata?
(directory channel-metadata-directory) (directory channel-metadata-directory) ;string with leading slash
(dependencies channel-metadata-dependencies)) (dependencies channel-metadata-dependencies)) ;list of <channel>
(define (channel-reference channel) (define (channel-reference channel)
"Return the \"reference\" for CHANNEL, an sexp suitable for "Return the \"reference\" for CHANNEL, an sexp suitable for
@ -129,7 +129,9 @@ if valid metadata could not be read from PORT."
(let ((directory (and=> (assoc-ref properties 'directory) first)) (let ((directory (and=> (assoc-ref properties 'directory) first))
(dependencies (or (assoc-ref properties 'dependencies) '()))) (dependencies (or (assoc-ref properties 'dependencies) '())))
(channel-metadata (channel-metadata
directory (cond ((not directory) "/")
((string-prefix? "/" directory) directory)
(else (string-append "/" directory)))
(map (lambda (item) (map (lambda (item)
(let ((get (lambda* (key #:optional default) (let ((get (lambda* (key #:optional default)
(or (and=> (assoc-ref item key) first) default)))) (or (and=> (assoc-ref item key) first) default))))
@ -157,29 +159,26 @@ if valid metadata could not be read from PORT."
(define (read-channel-metadata-from-source source) (define (read-channel-metadata-from-source source)
"Return a channel-metadata record read from channel's SOURCE/.guix-channel "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 (catch 'system-error
(lambda () (lambda ()
(call-with-input-file (string-append source "/.guix-channel") (call-with-input-file (string-append source "/.guix-channel")
read-channel-metadata)) read-channel-metadata))
(lambda args (lambda args
(if (= ENOENT (system-error-errno args)) (if (= ENOENT (system-error-errno args))
#f (channel-metadata "/" '())
(apply throw args))))) (apply throw args)))))
(define (channel-instance-metadata instance) (define (channel-instance-metadata instance)
"Return a channel-metadata record read from the channel INSTANCE's "Return a channel-metadata record read from the channel INSTANCE's
description file, or return #F if the channel instance does not include the description file or its default value."
file."
(read-channel-metadata-from-source (channel-instance-checkout instance))) (read-channel-metadata-from-source (channel-instance-checkout instance)))
(define (channel-instance-dependencies instance) (define (channel-instance-dependencies instance)
"Return the list of channels that are declared as dependencies for the given "Return the list of channels that are declared as dependencies for the given
channel INSTANCE." channel INSTANCE."
(match (channel-instance-metadata instance) (channel-metadata-dependencies (channel-instance-metadata instance)))
(#f '())
(($ <channel-metadata> directory dependencies)
dependencies)))
(define* (latest-channel-instances store channels #:optional (previous-channels '())) (define* (latest-channel-instances store channels #:optional (previous-channels '()))
"Return a list of channel instances corresponding to the latest checkouts of "Return a list of channel instances corresponding to the latest checkouts of
@ -261,7 +260,7 @@ objects. The assumption is that SOURCE contains package modules to be added
to '%package-module-path'." to '%package-module-path'."
(let* ((metadata (read-channel-metadata-from-source source)) (let* ((metadata (read-channel-metadata-from-source source))
(directory (and=> metadata channel-metadata-directory))) (directory (channel-metadata-directory metadata)))
(define build (define build
;; This is code that we'll run in CORE, a Guix instance, with its own ;; This is code that we'll run in CORE, a Guix instance, with its own
@ -281,9 +280,7 @@ to '%package-module-path'."
(string-append #$output "/share/guile/site/" (string-append #$output "/share/guile/site/"
(effective-version))) (effective-version)))
(let* ((subdir (if #$directory (let* ((subdir #$directory)
(string-append "/" #$directory)
""))
(source (string-append #$source subdir))) (source (string-append #$source subdir)))
(compile-files source go (find-files source "\\.scm$")) (compile-files source go (find-files source "\\.scm$"))
(mkdir-p (dirname scm)) (mkdir-p (dirname scm))

43
tests/channels.scm
View File

@ -42,9 +42,9 @@
(commit "cafebabe") (commit "cafebabe")
(spec #f)) (spec #f))
(define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX")) (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
(and spec (when spec
(with-output-to-file (string-append instance-dir "/.guix-channel") (call-with-output-file (string-append instance-dir "/.guix-channel")
(lambda _ (format #t "~a" spec)))) (lambda (port) (write spec port))))
(checkout->channel-instance instance-dir (checkout->channel-instance instance-dir
#:commit commit #:commit commit
#:name name)) #:name name))
@ -55,12 +55,10 @@
'(channel (version 42) (dependencies whatever)))) '(channel (version 42) (dependencies whatever))))
(define instance--no-deps (define instance--no-deps
(make-instance #:spec (make-instance #:spec
'(channel '(channel (version 0))))
(version 0) (define instance--sub-directory
(dependencies (make-instance #:spec
(channel '(channel (version 0) (directory "modules"))))
(name test-channel)
(url "https://example.com/test-channel"))))))
(define instance--simple (define instance--simple
(make-instance #:spec (make-instance #:spec
'(channel '(channel
@ -87,11 +85,26 @@
(define channel-instance-metadata (define channel-instance-metadata
(@@ (guix channels) 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" (test-equal "channel-instance-metadata returns default if .guix-channel does not exist"
#f '("/" ())
(channel-instance-metadata instance--boring)) (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" (test-equal "channel-instance-metadata rejects unsupported version"
1 ;line number in the generated '.guix-channel' 1 ;line number in the generated '.guix-channel'
@ -141,7 +154,7 @@
("test" (values test-dir 'whatever)) ("test" (values test-dir 'whatever))
(_ (values "/not-important" 'not-important))))) (_ (values "/not-important" 'not-important)))))
(let ((instances (latest-channel-instances #f (list channel)))) (let ((instances (latest-channel-instances #f (list channel))))
(and (eq? 2 (length instances)) (and (= 2 (length instances))
(lset= eq? (lset= eq?
'(test test-channel) '(test test-channel)
(map (compose channel-name channel-instance-channel) (map (compose channel-name channel-instance-channel)
@ -152,9 +165,9 @@
(and (eq? (channel-name (and (eq? (channel-name
(channel-instance-channel instance)) (channel-instance-channel instance))
'test-channel) 'test-channel)
(eq? (channel-commit (string=? (channel-commit
(channel-instance-channel instance)) (channel-instance-channel instance))
'abc1234))) "abc1234")))
instances)))))) instances))))))
(test-assert "channel-instances->manifest" (test-assert "channel-instances->manifest"