describe: Remove dependency on (guix scripts pull).

Until now, 'guix describe' would perform ~3K stat calls and ~1K openat
calls because it was pulling (guix scripts pull), which in turn pulls in
many (gnu packages …) modules.

* guix/scripts/pull.scm (display-profile-content, %vcs-web-views)
(channel-commit-hyperlink): Move to...
* guix/scripts/describe.scm: ... here.  Remove import of (guix scripts
pull).

2 files changed, 82 insertions, 78 deletions

diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index 99a88c50fa..f13f221da9 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -20,18 +20,22 @@
 (define-module (guix scripts describe)
   #:use-module ((guix config) #:select (%guix-version))
   #:use-module ((guix ui) #:hide (display-profile-content))
+  #:use-module ((guix utils) #:select (string-replace-substring))
   #:use-module (guix channels)
   #:use-module (guix scripts)
   #:use-module (guix describe)
   #:use-module (guix profiles)
-  #:use-module ((guix scripts pull) #:select (display-profile-content))
   #:use-module (git)
   #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:autoload   (ice-9 pretty-print) (pretty-print)
-  #:export (guix-describe))
+  #:use-module (web uri)
+  #:export (display-profile-content
+            channel-commit-hyperlink
+
+            guix-describe))
 
 
 ;;;
@@ -173,6 +177,76 @@ in the format specified by FMT."
                   channels))))
   (display-package-search-path fmt))
 
+(define (display-profile-content profile number)
+  "Display the packages in PROFILE, generation NUMBER, in a human-readable
+way and displaying details about the channel's source code."
+  (display-generation profile number)
+  (for-each (lambda (entry)
+              (format #t "  ~a ~a~%"
+                      (manifest-entry-name entry)
+                      (manifest-entry-version entry))
+              (match (assq 'source (manifest-entry-properties entry))
+                (('source ('repository ('version 0)
+                                       ('url url)
+                                       ('branch branch)
+                                       ('commit commit)
+                                       _ ...))
+                 (let ((channel (channel (name 'nameless)
+                                         (url url)
+                                         (branch branch)
+                                         (commit commit))))
+                   (format #t (G_ "    repository URL: ~a~%") url)
+                   (when branch
+                     (format #t (G_ "    branch: ~a~%") branch))
+                   (format #t (G_ "    commit: ~a~%")
+                           (if (supports-hyperlinks?)
+                               (channel-commit-hyperlink channel commit)
+                               commit))))
+                (_ #f)))
+
+            ;; Show most recently installed packages last.
+            (reverse
+             (manifest-entries
+              (profile-manifest (if (zero? number)
+                                    profile
+                                    (generation-file-name profile number)))))))
+
+(define %vcs-web-views
+  ;; Hard-coded list of host names and corresponding web view URL templates.
+  ;; TODO: Allow '.guix-channel' files to specify a URL template.
+  (let ((labhub-url (lambda (repository-url commit)
+                      (string-append
+                       (if (string-suffix? ".git" repository-url)
+                           (string-drop-right repository-url 4)
+                           repository-url)
+                       "/commit/" commit))))
+    `(("git.savannah.gnu.org"
+       ,(lambda (repository-url commit)
+          (string-append (string-replace-substring repository-url
+                                                   "/git/" "/cgit/")
+                         "/commit/?id=" commit)))
+      ("notabug.org" ,labhub-url)
+      ("framagit.org" ,labhub-url)
+      ("gitlab.com" ,labhub-url)
+      ("gitlab.inria.fr" ,labhub-url)
+      ("github.com" ,labhub-url))))
+
+(define* (channel-commit-hyperlink channel
+                                   #:optional
+                                   (commit (channel-commit channel)))
+  "Return a hyperlink for COMMIT in CHANNEL, using COMMIT as the hyperlink's
+text.  The hyperlink links to a web view of COMMIT, when available."
+  (let* ((url  (channel-url channel))
+         (uri  (string->uri url))
+         (host (and uri (uri-host uri))))
+    (if host
+        (match (assoc host %vcs-web-views)
+          (#f
+           commit)
+          ((_ template)
+           (hyperlink (template url commit) commit)))
+        commit)))
+
 
 ;;;
 ;;; Entry point.
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index cb1be989e1..51d4da209a 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -18,7 +18,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix scripts pull)
-  #:use-module (guix ui)
+  #:use-module ((guix ui) #:hide (display-profile-content))
   #:use-module (guix colors)
   #:use-module (guix utils)
   #:use-module ((guix status) #:select (with-status-verbosity))
@@ -37,6 +37,7 @@
                                 inferior-available-packages
                                 close-inferior)
   #:use-module (guix scripts build)
+  #:use-module (guix scripts describe)
   #:autoload   (guix build utils) (which)
   #:use-module ((guix build syscalls)
                 #:select (with-file-lock/no-wait))
@@ -56,13 +57,12 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
-  #:use-module (web uri)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 format)
-  #:export (display-profile-content
-            channel-list
-            channel-commit-hyperlink
+  #:re-export (display-profile-content
+               channel-commit-hyperlink)
+  #:export (channel-list
             with-git-error-handling
             guix-pull))
 
@@ -188,42 +188,6 @@ Download and deploy the latest version of Guix.\n"))
 
          %standard-build-options))
 
-(define %vcs-web-views
-  ;; Hard-coded list of host names and corresponding web view URL templates.
-  ;; TODO: Allow '.guix-channel' files to specify a URL template.
-  (let ((labhub-url (lambda (repository-url commit)
-                      (string-append
-                       (if (string-suffix? ".git" repository-url)
-                           (string-drop-right repository-url 4)
-                           repository-url)
-                       "/commit/" commit))))
-    `(("git.savannah.gnu.org"
-       ,(lambda (repository-url commit)
-          (string-append (string-replace-substring repository-url
-                                                   "/git/" "/cgit/")
-                         "/commit/?id=" commit)))
-      ("notabug.org" ,labhub-url)
-      ("framagit.org" ,labhub-url)
-      ("gitlab.com" ,labhub-url)
-      ("gitlab.inria.fr" ,labhub-url)
-      ("github.com" ,labhub-url))))
-
-(define* (channel-commit-hyperlink channel
-                                   #:optional
-                                   (commit (channel-commit channel)))
-  "Return a hyperlink for COMMIT in CHANNEL, using COMMIT as the hyperlink's
-text.  The hyperlink links to a web view of COMMIT, when available."
-  (let* ((url  (channel-url channel))
-         (uri  (string->uri url))
-         (host (and uri (uri-host uri))))
-    (if host
-        (match (assoc host %vcs-web-views)
-          (#f
-           commit)
-          ((_ template)
-           (hyperlink (template url commit) commit)))
-        commit)))
-
 (define* (display-profile-news profile #:key concise?
                                current-is-newer?)
   "Display what's up in PROFILE--new packages, and all that.  If
@@ -559,40 +523,6 @@ true, display what would be built without actually building it."
 ;;; Queries.
 ;;;
 
-(define (display-profile-content profile number)
-  "Display the packages in PROFILE, generation NUMBER, in a human-readable
-way and displaying details about the channel's source code."
-  (display-generation profile number)
-  (for-each (lambda (entry)
-              (format #t "  ~a ~a~%"
-                      (manifest-entry-name entry)
-                      (manifest-entry-version entry))
-              (match (assq 'source (manifest-entry-properties entry))
-                (('source ('repository ('version 0)
-                                       ('url url)
-                                       ('branch branch)
-                                       ('commit commit)
-                                       _ ...))
-                 (let ((channel (channel (name 'nameless)
-                                         (url url)
-                                         (branch branch)
-                                         (commit commit))))
-                   (format #t (G_ "    repository URL: ~a~%") url)
-                   (when branch
-                     (format #t (G_ "    branch: ~a~%") branch))
-                   (format #t (G_ "    commit: ~a~%")
-                           (if (supports-hyperlinks?)
-                               (channel-commit-hyperlink channel commit)
-                               commit))))
-                (_ #f)))
-
-            ;; Show most recently installed packages last.
-            (reverse
-             (manifest-entries
-              (profile-manifest (if (zero? number)
-                                    profile
-                                    (generation-file-name profile number)))))))
-
 (define (indented-string str indent)
   "Return STR with each newline preceded by IDENT spaces."
   (define indent-string