guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#45919] [PATCH 7/8] channels: Add 'channel->code'.


From: Ludovic Courtès
Subject: [bug#45919] [PATCH 7/8] channels: Add 'channel->code'.
Date: Sat, 16 Jan 2021 19:34:08 +0100

* guix/channels.scm (channel->code): New procedure, taken from...
* guix/scripts/describe.scm (channel->sexp): ... here.
Adjust callers accordingly.
---
 guix/channels.scm         | 19 +++++++++++++++++++
 guix/scripts/describe.scm | 22 +++-------------------
 2 files changed, 22 insertions(+), 19 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index 743b4a25b7..cdef77637d 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -92,6 +92,7 @@
 
             profile-channels
             manifest-entry-channel
+            channel->code
 
             channel-news-entry?
             channel-news-entry-commit
@@ -957,6 +958,24 @@ PROFILE is not a profile created by 'guix pull', return 
the empty list."
               (reverse
                (manifest-entries (profile-manifest profile)))))
 
+(define* (channel->code channel #:key (include-introduction? #t))
+  "Return code (an sexp) to build CHANNEL.  When INCLUDE-INTRODUCTION? is
+true, include its introduction, if any."
+  (let ((intro (and include-introduction?
+                    (channel-introduction channel))))
+    `(channel
+      (name ',(channel-name channel))
+      (url ,(channel-url channel))
+      (commit ,(channel-commit channel))
+      ,@(if intro
+            `((introduction (make-channel-introduction
+                             ,(channel-introduction-first-signed-commit intro)
+                             (openpgp-fingerprint
+                              ,(openpgp-format-fingerprint
+                                (channel-introduction-first-commit-signer
+                                 intro))))))
+            '()))))
+
 
 ;;;
 ;;; News.
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index b7ec029ba8..e47d207ee0 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -113,22 +113,6 @@ Display information about the channels currently in 
use.\n"))
        (_
         (warning (G_ "'GUIX_PACKAGE_PATH' is set but it is not 
captured~%")))))))
 
-(define* (channel->sexp channel #:key (include-introduction? #t))
-  (let ((intro (and include-introduction?
-                    (channel-introduction channel))))
-    `(channel
-      (name ',(channel-name channel))
-      (url ,(channel-url channel))
-      (commit ,(channel-commit channel))
-      ,@(if intro
-            `((introduction (make-channel-introduction
-                             ,(channel-introduction-first-signed-commit intro)
-                             (openpgp-fingerprint
-                              ,(openpgp-format-fingerprint
-                                (channel-introduction-first-commit-signer
-                                 intro))))))
-            '()))))
-
 (define (channel->json channel)
   (scm->json-string
    (let ((intro (channel-introduction channel)))
@@ -183,7 +167,7 @@ string is ~a.~%")
        (format #t (G_ "  branch: ~a~%") (reference-shorthand head))
        (format #t (G_ "  commit: ~a~%") commit))
       ('channels
-       (pretty-print `(list ,(channel->sexp (channel (name 'guix)
+       (pretty-print `(list ,(channel->code (channel (name 'guix)
                                                      (url (dirname directory))
                                                      (commit commit))))))
       ('json
@@ -213,9 +197,9 @@ in the format specified by FMT."
     ('human
      (display-profile-content profile number))
     ('channels
-     (pretty-print `(list ,@(map channel->sexp channels))))
+     (pretty-print `(list ,@(map channel->code channels))))
     ('channels-sans-intro
-     (pretty-print `(list ,@(map (cut channel->sexp <>
+     (pretty-print `(list ,@(map (cut channel->code <>
                                       #:include-introduction? #f)
                                  channels))))
     ('json
-- 
2.30.0






reply via email to

[Prev in Thread] Current Thread [Next in Thread]