WIP: bees service
[jackhill/guix/guix.git] / guix / self.scm
index 026dcd9..3154d18 100644 (file)
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
                (module-ref (resolve-interface module) variable))))
     (match-lambda
       ("guile"      (ref '(gnu packages guile) 'guile-3.0/libgc-7))
+      ("guile-avahi" (ref '(gnu packages guile-xyz) 'guile-avahi))
       ("guile-json" (ref '(gnu packages guile) 'guile-json-4))
       ("guile-ssh"  (ref '(gnu packages ssh)   'guile-ssh))
       ("guile-git"  (ref '(gnu packages guile) 'guile-git))
+      ("guile-semver"  (ref '(gnu packages guile-xyz) 'guile-semver))
+      ("guile-lib"  (ref '(gnu packages guile-xyz) 'guile-lib))
       ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
       ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib))
       ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib))
+      ("guile-zstd" (ref '(gnu packages guile) 'guile-zstd))
       ("guile-gcrypt"  (ref '(gnu packages gnupg) 'guile-gcrypt))
       ("gnutls"     (ref '(gnu packages tls) 'gnutls))
       ("gzip"       (ref '(gnu packages compression) 'gzip))
@@ -646,18 +651,26 @@ load path."
 
   (program-file "guix-command"
                 #~(begin
+                    ;; Remove the empty extension from the search path.
+                    (set! %load-extensions '(".scm"))
+
                     (set! %load-path
-                      (cons (string-append #$module-directory
-                                           "/share/guile/site/"
-                                           (effective-version))
-                            %load-path))
+                      (append (list (string-append #$module-directory
+                                                   "/share/guile/site/"
+                                                   (effective-version))
+                                    (string-append #$guile "/share/guile/"
+                                                   (effective-version)))
+                              %load-path))
 
                     (set! %load-compiled-path
-                      (cons (string-append #$module-directory
-                                           "/lib/guile/"
-                                           (effective-version)
-                                           "/site-ccache")
-                            %load-compiled-path))
+                      (append (list (string-append #$module-directory
+                                                   "/lib/guile/"
+                                                   (effective-version)
+                                                   "/site-ccache")
+                                    (string-append #$guile "/lib/guile/"
+                                                   (effective-version)
+                                                   "/ccache"))
+                              %load-compiled-path))
 
                     ;; To maximize the chances that locales are set up right
                     ;; out-of-the-box, bundle "common" UTF-8 locales.
@@ -774,7 +787,16 @@ Info manual."
                          (copy-recursively #$miscellany #$output
                                            #:log (%make-void-port "w")))))))
 
-(define* (compiled-guix source #:key (version %guix-version)
+(define (transitive-package-dependencies package)
+  "Return the list of packages propagated by PACKAGE, including PACKAGE
+itself."
+  (match (package-transitive-propagated-inputs package)
+    (((labels packages _ ...) ...)
+     (cons package packages))))
+
+(define* (compiled-guix source #:key
+                        (version %guix-version)
+                        (channel-metadata #f)
                         (pull-version 1)
                         (name (string-append "guix-" version))
                         (guile-version (effective-version))
@@ -784,12 +806,18 @@ Info manual."
                         (xz (specification->package "xz"))
                         (guix (specification->package "guix")))
   "Return a file-like object that contains a compiled Guix."
+  (define guile-avahi
+    (specification->package "guile-avahi"))
+
   (define guile-json
     (specification->package "guile-json"))
 
   (define guile-ssh
     (specification->package "guile-ssh"))
 
+  (define guile-lib
+    (specification->package "guile-lib"))
+
   (define guile-git
     (specification->package "guile-git"))
 
@@ -802,20 +830,23 @@ Info manual."
   (define guile-lzlib
     (specification->package "guile-lzlib"))
 
+  (define guile-zstd
+    (specification->package "guile-zstd"))
+
   (define guile-gcrypt
     (specification->package "guile-gcrypt"))
 
+  (define guile-semver
+    (specification->package "guile-semver"))
+
   (define gnutls
     (specification->package "gnutls"))
 
   (define dependencies
-    (match (append-map (lambda (package)
-                         (cons (list "x" package)
-                               (package-transitive-propagated-inputs package)))
-                       (list guile-gcrypt gnutls guile-git guile-json
-                             guile-ssh guile-sqlite3 guile-zlib guile-lzlib))
-      (((labels packages _ ...) ...)
-       packages)))
+    (append-map transitive-package-dependencies
+                (list guile-gcrypt gnutls guile-git guile-avahi
+                      guile-json guile-semver guile-ssh guile-sqlite3
+                      guile-lib guile-zlib guile-lzlib guile-zstd)))
 
   (define *core-modules*
     (scheme-node "guix-core"
@@ -859,6 +890,11 @@ Info manual."
                                (name name))
                              (scheme-modules* source "guix"))
                  (list *core-modules*)
+
+                 #:extra-files
+                 `(("guix/graph.js" ,(local-file "../guix/graph.js"))
+                   ("guix/d3.v3.js" ,(local-file "../guix/d3.v3.js")))
+
                  #:extensions dependencies
                  #:guile-for-build guile-for-build))
 
@@ -947,6 +983,8 @@ Info manual."
                                          %guix-package-name
                                          #:package-version
                                          version
+                                         #:channel-metadata
+                                         channel-metadata
                                          #:bug-report-address
                                          %guix-bug-report-address
                                          #:home-page-url
@@ -1040,6 +1078,7 @@ Info manual."
 (define* (make-config.scm #:key gzip xz bzip2
                           (package-name "GNU Guix")
                           (package-version "0")
+                          (channel-metadata #f)
                           (bug-report-address "bug-guix@gnu.org")
                           (home-page-url "https://guix.gnu.org"))
 
@@ -1053,6 +1092,7 @@ Info manual."
                                %guix-version
                                %guix-bug-report-address
                                %guix-home-page-url
+                               %channel-metadata
                                %system
                                %store-directory
                                %state-directory
@@ -1095,6 +1135,11 @@ Info manual."
                    (define %guix-bug-report-address #$bug-report-address)
                    (define %guix-home-page-url #$home-page-url)
 
+                   (define %channel-metadata
+                     ;; Metadata for the 'guix' channel in use.  This
+                     ;; information is used by (guix describe).
+                     '#$channel-metadata)
+
                    (define %gzip
                      #+(and gzip (file-append gzip "/bin/gzip")))
                    (define %bzip2
@@ -1219,11 +1264,14 @@ containing MODULE-FILES and possibly other files as well."
 
 (define* (guix-derivation source version
                           #:optional (guile-version (effective-version))
-                          #:key (pull-version 0))
+                          #:key (pull-version 0)
+                          channel-metadata)
   "Return, as a monadic value, the derivation to build the Guix from SOURCE
-for GUILE-VERSION.  Use VERSION as the version string.  PULL-VERSION specifies
-the version of the 'guix pull' protocol.  Return #f if this PULL-VERSION value
-is not supported."
+for GUILE-VERSION.  Use VERSION as the version string.  Use CHANNEL-METADATA
+as the channel metadata sexp to include in (guix config).
+
+PULL-VERSION specifies the version of the 'guix pull' protocol.  Return #f if
+this PULL-VERSION value is not supported."
   (define (shorten version)
     (if (and (string-every char-set:hex-digit version)
              (> (string-length version) 9))
@@ -1248,6 +1296,7 @@ is not supported."
     (set-guile-for-build guile)
     (let ((guix (compiled-guix source
                                #:version version
+                               #:channel-metadata channel-metadata
                                #:name (string-append "guix-"
                                                      (shorten version))
                                #:pull-version pull-version