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.
master
Ludovic Courtès
parent
5d9daa85b0
commit
ce5d9ec875
|
|
@ -110,8 +110,8 @@
|
|||
(define-record-type <channel-metadata>
|
||||
(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 <channel>
|
||||
|
||||
(define (channel-reference channel)
|
||||
"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))
|
||||
(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 @@ if valid metadata could not be read from 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 '())
|
||||
(($ <channel-metadata> 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 @@ objects. The assumption is that SOURCE contains package modules to be added
|
|||
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 @@ to '%package-module-path'."
|
|||
(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))
|
||||
|
|
|
|||
|
|
@ -42,9 +42,9 @@
|
|||
(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 @@
|
|||
'(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 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 @@
|
|||
("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 @@
|
|||
(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"
|
||||
|
|
|
|||
Loading…
Reference in New Issue