branch master updated: Use our own sexp->channel procedure.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 9e3e9b6  Use our own sexp->channel procedure.
9e3e9b6 is described below

commit 9e3e9b691c9517034539ca7483defd88a9e12311
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Mar 10 16:29:35 2021 +0100

    Use our own sexp->channel procedure.
    
    The Guix version of sexp->channel doesn't support the branch field.
    
    * src/cuirass/specification.scm (sexp->channel): New procedure.
    * src/cuirass/database.scm (db-get-specifications): Use it.
---
 src/cuirass/database.scm      |  2 +-
 src/cuirass/specification.scm | 22 ++++++++++++++++++++++
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index e9f0385..81a622e 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -449,7 +449,7 @@ priority, systems FROM Specifications ORDER BY name ASC;")))
                       (name name)
                       (build (with-input-from-string build read))
                       (channels
-                       (map sexp->channel
+                       (map sexp->channel*
                             (with-input-from-string channels read)))
                       (build-outputs
                        (map sexp->build-output
diff --git a/src/cuirass/specification.scm b/src/cuirass/specification.scm
index 2d492cb..d212daf 100644
--- a/src/cuirass/specification.scm
+++ b/src/cuirass/specification.scm
@@ -36,6 +36,7 @@
             sexp->build-output
 
             channel->sexp
+            sexp->channel*
 
             specification
             specification?
@@ -114,6 +115,27 @@
                     intro))))))
             '()))))
 
+(define (sexp->channel* sexp)
+  "Return the channel corresponding to SEXP."
+  (match sexp
+    (('repository ('version 0)
+                  ('url url)
+                  ('branch branch)
+                  ('commit commit)
+                  ('name name)
+                  rest ...)
+     (channel (name name)
+              (url url)
+              (branch branch)
+              (commit commit)
+              (introduction
+               (match (assq 'introduction rest)
+                 (#f #f)
+                 (('introduction intro)
+                  (sexp->channel-introduction intro))))))
+
+    (_ #f)))
+
 
 ;;;
 ;;; Specification record.