[bug#36699] [PATCH 3/4] channels: Always provide a <channel-metadata> record.

[Ludovic Courtès]

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.
---
 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 <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))
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 @@
                         (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"
-- 
2.22.0