;;; 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.
;;;
#:use-module (guix packages)
#:use-module (guix sets)
#:use-module (guix modules)
+ #:use-module ((guix utils) #:select (version-major+minor))
#:use-module ((guix build utils) #:select (find-files))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
(module-ref (resolve-interface module) variable))))
(match-lambda
("guile" (ref '(gnu packages guile) 'guile-3.0/libgc-7))
- ("guile-json" (ref '(gnu packages guile) 'guile-json-3))
+ ("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) 'guile3.0-gnutls))
- ("zlib" (ref '(gnu packages compression) 'zlib))
- ("lzlib" (ref '(gnu packages compression) 'lzlib))
+ ("gnutls" (ref '(gnu packages tls) 'gnutls))
("gzip" (ref '(gnu packages compression) 'gzip))
("bzip2" (ref '(gnu packages compression) 'bzip2))
("xz" (ref '(gnu packages compression) 'xz))
("po4a" (ref '(gnu packages gettext) 'po4a))
("gettext" (ref '(gnu packages gettext) 'gettext-minimal))
+ ("gcc-toolchain" (ref '(gnu packages commencement) 'gcc-toolchain))
(_ #f)))) ;no such package
\f
#~(begin
(use-modules (guix build utils) (guix build po)
(ice-9 match) (ice-9 regex) (ice-9 textual-ports)
- (ice-9 vlist)
+ (ice-9 vlist) (ice-9 threads)
(srfi srfi-1))
- (mkdir #$output)
-
- (copy-recursively #$documentation "."
- #:log (%make-void-port "w"))
-
- (for-each
- (lambda (file)
- (copy-file file (basename file)))
- (find-files #$documentation-po ".*.po$"))
-
- (setenv "GUIX_LOCPATH"
- #+(file-append glibc-utf8-locales "/lib/locale"))
- (setenv "PATH" #+(file-append gettext "/bin"))
- (setenv "LC_ALL" "en_US.UTF-8")
- (setlocale LC_ALL "en_US.UTF-8")
-
(define (translate-tmp-texi po source output)
"Translate Texinfo file SOURCE using messages from PO, and write
the result to OUTPUT."
(find-files directory
"\\.[a-z]{2}(_[A-Z]{2})?\\.po$")))
- (for-each (match-lambda
- ((language . po)
- (translate-texi "guix" po language
- #:extras '("contributing"))))
- (available-translations "." "guix-manual"))
+ (define parallel-jobs
+ ;; Limit thread creation by 'n-par-for-each'. Going beyond can
+ ;; lead libgc 8.0.4 to abort with:
+ ;; mmap(PROT_NONE) failed
+ (min (parallel-job-count) 4))
+
+ (mkdir #$output)
+ (copy-recursively #$documentation "."
+ #:log (%make-void-port "w"))
+
+ (for-each
+ (lambda (file)
+ (copy-file file (basename file)))
+ (find-files #$documentation-po ".*.po$"))
+
+ (setenv "GUIX_LOCPATH"
+ #+(file-append glibc-utf8-locales "/lib/locale"))
+ (setenv "PATH" #+(file-append gettext "/bin"))
+ (setenv "LC_ALL" "en_US.UTF-8")
+ (setlocale LC_ALL "en_US.UTF-8")
+
+ (n-par-for-each parallel-jobs
+ (match-lambda
+ ((language . po)
+ (translate-texi "guix" po language
+ #:extras '("contributing"))))
+ (available-translations "." "guix-manual"))
- (for-each (match-lambda
- ((language . po)
- (translate-texi "guix-cookbook" po language)))
- (available-translations "." "guix-cookbook"))
+ (n-par-for-each parallel-jobs
+ (match-lambda
+ ((language . po)
+ (translate-texi "guix-cookbook" po language)))
+ (available-translations "." "guix-cookbook"))
(for-each (lambda (file)
(install-file file #$output))
(computed-file name build))
+(define (quiet-guile guile)
+ "Return a wrapper that does the same as the 'guile' executable of GUILE,
+except that it does not complain about locales and falls back to 'en_US.utf8'
+instead of 'C'."
+ (define gcc
+ (specification->package "gcc-toolchain"))
+
+ (define source
+ (search-path %load-path
+ "gnu/packages/aux-files/guile-launcher.c"))
+
+ (define effective
+ (version-major+minor (package-version guile)))
+
+ (define build
+ ;; XXX: Reuse <c-compiler> from (guix scripts pack) instead?
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-26))
+
+ (mkdir-p (string-append #$output "/bin"))
+
+ (setenv "PATH" #$(file-append gcc "/bin"))
+ (setenv "C_INCLUDE_PATH"
+ (string-join
+ (map (cut string-append <> "/include")
+ '#$(match (bag-transitive-build-inputs
+ (package->bag guile))
+ (((labels packages . _) ...)
+ (filter package? packages))))
+ ":"))
+ (setenv "LIBRARY_PATH" #$(file-append gcc "/lib"))
+
+ (invoke "gcc" #$(local-file source) "-Wall" "-g0" "-O2"
+ "-I" #$(file-append guile "/include/guile/" effective)
+ "-L" #$(file-append guile "/lib")
+ #$(string-append "-lguile-" effective)
+ "-o" (string-append #$output "/bin/guile")))))
+
+ (computed-file "guile-wrapper" build))
+
(define* (guix-command modules
#:key source (dependencies '())
guile (guile-version (effective-version)))
(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.
;; XXX: It would be more convenient to change it to:
;; (exit (apply guix-main (command-line)))
(apply guix-main (command-line))))
- #:guile guile))
+
+ ;; Use a 'guile' variant that doesn't complain about locales.
+ #:guile (quiet-guile guile)))
(define (miscellaneous-files source)
"Return data files taken from SOURCE."
,(file-append* source "/etc/completion/zsh/_guix"))
("share/fish/vendor_completions.d/guix.fish"
,(file-append* source "/etc/completion/fish/guix.fish"))
- ("share/guix/berlin.guixsd.org.pub"
+ ("share/guix/berlin.guix.gnu.org.pub"
,(file-append* source
- "/etc/substitutes/berlin.guixsd.org.pub"))
+ "/etc/substitutes/berlin.guix.gnu.org.pub"))
("share/guix/ci.guix.gnu.org.pub" ;alias
- ,(file-append* source "/etc/substitutes/berlin.guixsd.org.pub"))
+ ,(file-append* source "/etc/substitutes/berlin.guix.gnu.org.pub"))
("share/guix/ci.guix.info.pub" ;alias
- ,(file-append* source "/etc/substitutes/berlin.guixsd.org.pub")))))
+ ,(file-append* source "/etc/substitutes/berlin.guix.gnu.org.pub")))))
(define* (whole-package name modules dependencies
#:key
(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))
(guile-for-build (default-guile))
- (zlib (specification->package "zlib"))
- (lzlib (specification->package "lzlib"))
(gzip (specification->package "gzip"))
(bzip2 (specification->package "bzip2"))
(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"))
(define guile-sqlite3
(specification->package "guile-sqlite3"))
+ (define guile-zlib
+ (specification->package "guile-zlib"))
+
+ (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))
- (((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"
(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))
'()
#:extra-modules
`(((guix config)
- => ,(make-config.scm #:zlib zlib
- #:lzlib lzlib
- #:gzip gzip
+ => ,(make-config.scm #:gzip gzip
#:bzip2 bzip2
#:xz xz
#:package-name
%guix-package-name
#:package-version
version
+ #:channel-metadata
+ channel-metadata
#:bug-report-address
%guix-bug-report-address
#:home-page-url
(variables rest ...))))))
(variables %localstatedir %storedir %sysconfdir)))
-(define* (make-config.scm #:key zlib lzlib gzip xz bzip2
+(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"))
%guix-version
%guix-bug-report-address
%guix-home-page-url
+ %channel-metadata
%system
%store-directory
%state-directory
%store-database-directory
%config-directory
- %libz
- %liblz
%gzip
%bzip2
%xz))
(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
#+(and bzip2 (file-append bzip2 "/bin/bzip2")))
(define %xz
- #+(and xz (file-append xz "/bin/xz")))
-
- (define %libz
- #+(and zlib
- (file-append zlib "/lib/libz")))
-
- (define %liblz
- #+(and lzlib
- (file-append lzlib "/lib/liblz"))))
+ #+(and xz (file-append xz "/bin/xz"))))
;; Guile 2.0 *requires* the 'define-module' to be at the
;; top-level or the 'toplevel-ref' in the resulting .go file are
(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))
(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
HCoop / jackhill / guix / guix.git / blobdiff