;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module ((guix build compile) #:select (%lightweight-optimizations))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-35)
#:use-module (ice-9 match)
#:export (make-config.scm
whole-package ;for internal use in 'guix pull'
compiled-guix
- guix-derivation
- reload-guix))
+ guix-derivation))
\f
;;;
;;; Dependency handling.
;;;
-(define* (false-if-wrong-guile package
- #:optional (guile-version (effective-version)))
- "Return #f if PACKAGE depends on the \"wrong\" major version of Guile (e.g.,
-2.0 instead of 2.2), otherwise return PACKAGE."
- (let ((guile (any (match-lambda
- ((label (? package? dep) _ ...)
- (and (string=? (package-name dep) "guile")
- dep)))
- (package-direct-inputs package))))
- (and (or (not guile)
- (string-prefix? guile-version
- (package-version guile)))
- package)))
-
-(define (package-for-guile guile-version . names)
- "Return the package with one of the given NAMES that depends on
-GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches."
- (let loop ((names names))
- (match names
- (()
- #f)
- ((name rest ...)
- (match (specification->package name)
- (#f
- (loop rest))
- ((? package? package)
- (or (false-if-wrong-guile package guile-version)
- (loop rest))))))))
-
(define specification->package
;; Use our own variant of that procedure because that of (gnu packages)
;; would traverse all the .scm files, which is wasteful.
(module-ref (resolve-interface module) variable))))
(match-lambda
("guile" (ref '(gnu packages commencement) 'guile-final))
- ("guile-json" (ref '(gnu packages guile) 'guile-json))
+ ("guile-json" (ref '(gnu packages guile) 'guile-json-3))
("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh))
("guile-git" (ref '(gnu packages guile) 'guile-git))
("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
+ ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile-gcrypt))
("gnutls" (ref '(gnu packages tls) 'gnutls))
- ("libgcrypt" (ref '(gnu packages gnupg) 'libgcrypt))
("zlib" (ref '(gnu packages compression) 'zlib))
+ ("lzlib" (ref '(gnu packages compression) 'lzlib))
("gzip" (ref '(gnu packages compression) 'gzip))
("bzip2" (ref '(gnu packages compression) 'bzip2))
("xz" (ref '(gnu packages compression) 'xz))
- ("guile2.0-json" (ref '(gnu packages guile) 'guile2.0-json))
- ("guile2.0-ssh" (ref '(gnu packages ssh) 'guile2.0-ssh))
- ("guile2.0-git" (ref '(gnu packages guile) 'guile2.0-git))
- ;; XXX: No "guile2.0-sqlite3".
- ("guile2.0-gnutls" (ref '(gnu packages tls) 'gnutls/guile-2.0))
- (_ #f)))) ;no such package
+ ("po4a" (ref '(gnu packages gettext) 'po4a))
+ ("gettext" (ref '(gnu packages gettext) 'gettext-minimal))
+ (_ #f)))) ;no such package
\f
;;;
#:name (file-mapping-name mapping)
#:system system))
+(define (node-source+compiled node)
+ "Return a \"bundle\" containing both the source code and object files for
+NODE's modules, under their FHS directories: share/guile/site and lib/guile."
+ (define build
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (define source
+ (string-append #$output "/share/guile/site/"
+ (effective-version)))
+
+ (define object
+ (string-append #$output "/lib/guile/" (effective-version)
+ "/site-ccache"))
+
+ (mkdir-p (dirname source))
+ (symlink #$(node-source node) source)
+ (mkdir-p (dirname object))
+ (symlink #$(node-compiled node) object))))
+
+ (computed-file (string-append (node-name node) "-modules")
+ build))
+
(define (node-fold proc init nodes)
(let loop ((nodes nodes)
(visited (setq))
(local-file file #:recursive? #t)))
(find-files (string-append directory "/" sub-directory) pred)))
-(define (scheme-modules* directory sub-directory)
- "Return the list of module names found under SUB-DIRECTORY in DIRECTORY."
- (let ((prefix (string-length directory)))
- (map (lambda (file)
- (file-name->module-name (string-drop file prefix)))
- (scheme-files (string-append directory "/" sub-directory)))))
-
-(define* (sub-directory item sub-directory)
- "Return SUB-DIRECTORY within ITEM, which may be a file name or a file-like
-object."
+(define* (file-append* item file #:key (recursive? #t))
+ "Return FILE within ITEM, which may be a file name or a file-like object.
+When ITEM is a plain file name (a string), simply return a 'local-file'
+record with the new file name."
(match item
((? string?)
;; This is the optimal case: we return a new "source". Thus, a
;; derivation that depends on this sub-directory does not depend on ITEM
;; itself.
- (local-file (string-append item "/" sub-directory)
- #:recursive? #t))
+ (local-file (string-append item "/" file)
+ #:recursive? recursive?))
;; TODO: Add 'local-file?' case.
(_
;; In this case, anything that refers to the result also depends on ITEM,
;; which isn't great.
- (file-append item "/" sub-directory))))
+ (file-append item "/" file))))
(define* (locale-data source domain
#:optional (directory domain))
(ice-9 match) (ice-9 ftw))
(define po-directory
- #+(sub-directory source (string-append "po/" directory)))
+ #+(file-append* source (string-append "po/" directory)))
(define (compile language)
(let ((gmo (string-append #$output "/" language "/LC_MESSAGES/"
(computed-file (string-append "guix-locale-" domain)
build))
+(define (translate-texi-manuals source)
+ "Return the translated texinfo manuals built from SOURCE."
+ (define po4a
+ (specification->package "po4a"))
+
+ (define gettext
+ (specification->package "gettext"))
+
+ (define glibc-utf8-locales
+ (module-ref (resolve-interface '(gnu packages base))
+ 'glibc-utf8-locales))
+
+ (define documentation
+ (file-append* source "doc"))
+
+ (define documentation-po
+ (file-append* source "po/doc"))
+
+ (define build
+ (with-imported-modules '((guix build utils) (guix build po))
+ #~(begin
+ (use-modules (guix build utils) (guix build po)
+ (ice-9 match) (ice-9 regex) (ice-9 textual-ports)
+ (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."
+ (invoke #+(file-append po4a "/bin/po4a-translate")
+ "-M" "UTF-8" "-L" "UTF-8" "-k" "0" "-f" "texinfo"
+ "-m" source "-p" po "-l" output))
+
+ (define (make-ref-regex msgid end)
+ (make-regexp (string-append
+ "ref\\{"
+ (string-join (string-split (regexp-quote msgid) #\ )
+ "[ \n]+")
+ end)))
+
+ (define (translate-cross-references content translations)
+ "Take CONTENT, a string representing a .texi file and translate any
+cross-reference in it (@ref, @xref and @pxref) that have a translation in
+TRANSLATIONS, an alist of msgid and msgstr."
+ (fold
+ (lambda (elem content)
+ (match elem
+ ((msgid . msgstr)
+ ;; Empty translations and strings containing some special characters
+ ;; cannot be the name of a section.
+ (if (or (equal? msgstr "")
+ (string-any (lambda (chr)
+ (member chr '(#\{ #\} #\( #\) #\newline #\,)))
+ msgid))
+ content
+ ;; Otherwise, they might be the name of a section, so we
+ ;; need to translate any occurence in @(p?x?)ref{...}.
+ (let ((regexp1 (make-ref-regex msgid ","))
+ (regexp2 (make-ref-regex msgid "\\}")))
+ (regexp-substitute/global
+ #f regexp2
+ (regexp-substitute/global
+ #f regexp1 content 'pre "ref{" msgstr "," 'post)
+ 'pre "ref{" msgstr "}" 'post))))))
+ content translations))
+
+ (define (translate-texi po lang)
+ "Translate the manual for one language LANG using the PO file."
+ (let ((translations (call-with-input-file po read-po-file)))
+ (translate-tmp-texi po "guix.texi"
+ (string-append "guix." lang ".texi.tmp"))
+ (translate-tmp-texi po "contributing.texi"
+ (string-append "contributing." lang ".texi.tmp"))
+ (let* ((texi-name (string-append "guix." lang ".texi"))
+ (tmp-name (string-append texi-name ".tmp")))
+ (with-output-to-file texi-name
+ (lambda _
+ (format #t "~a"
+ (translate-cross-references
+ (call-with-input-file tmp-name get-string-all)
+ translations)))))
+ (let* ((texi-name (string-append "contributing." lang ".texi"))
+ (tmp-name (string-append texi-name ".tmp")))
+ (with-output-to-file texi-name
+ (lambda _
+ (format #t "~a"
+ (translate-cross-references
+ (call-with-input-file tmp-name get-string-all)
+ translations)))))))
+
+ (for-each (lambda (po)
+ (match (reverse (string-split po #\.))
+ ((_ lang _ ...)
+ (translate-texi po lang))))
+ (find-files "." "^guix-manual\\.[a-z]{2}(_[A-Z]{2})?\\.po$"))
+
+ (for-each
+ (lambda (file)
+ (copy-file file (string-append #$output "/" file)))
+ (append
+ (find-files "." "contributing\\..*\\.texi$")
+ (find-files "." "guix\\..*\\.texi$"))))))
+
+ (computed-file "guix-translated-texinfo" build))
+
(define (info-manual source)
"Return the Info manual built from SOURCE."
(define texinfo
(module-ref (resolve-interface '(gnu packages graphviz))
'graphviz))
+ (define glibc-utf8-locales
+ (module-ref (resolve-interface '(gnu packages base))
+ 'glibc-utf8-locales))
+
(define documentation
- (sub-directory source "doc"))
+ (file-append* source "doc"))
(define examples
- (sub-directory source "gnu/system/examples"))
+ (file-append* source "gnu/system/examples"))
(define build
(with-imported-modules '((guix build utils))
;; doesn't change at each commit?
(call-with-output-file "version.texi"
(lambda (port)
- (let ((version "0.0-git)"))
+ (let ((version "0.0-git"))
(format port "
@set UPDATED 1 January 1970
@set UPDATED-MONTH January 1970
;; see those images and produce image references in the Info output.
(copy-recursively #$documentation "."
#:log (%make-void-port "w"))
+ (copy-recursively #+(translate-texi-manuals source) "."
+ #:log (%make-void-port "w"))
(delete-file-recursively "images")
(symlink (string-append #$output "/images") "images")
+ ;; Provide UTF-8 locales needed by the 'xspara.c' code in makeinfo.
+ (setenv "GUIX_LOCPATH"
+ #+(file-append glibc-utf8-locales "/lib/locale"))
+
(for-each (lambda (texi)
(unless (string=? "guix.texi" texi)
;; Create 'version-LL.texi'.
(basename texi ".texi")
".info")))
(cons "guix.texi"
- (find-files "." "^guix\\.[a-z]{2}\\.texi$"))))))
+ (find-files "." "^guix\\.[a-z]{2}(_[A-Z]{2})?\\.texi$")))
+
+ ;; Compress Info files.
+ (setenv "PATH"
+ #+(file-append (specification->package "gzip") "/bin"))
+ (for-each (lambda (file)
+ (invoke "gzip" "-9n" file))
+ (find-files #$output "\\.info(-[0-9]+)?$")))))
(computed-file "guix-manual" build))
-(define* (guix-command modules #:optional compiled-modules
+(define* (guile-module-union things #:key (name "guix-module-union"))
+ "Return the union of the subset of THINGS (packages, computed files, etc.)
+that provide Guile modules."
+ (define build
+ (with-imported-modules '((guix build union))
+ #~(begin
+ (use-modules (guix build union))
+
+ (define (modules directory)
+ (string-append directory "/share/guile/site"))
+
+ (define (objects directory)
+ (string-append directory "/lib/guile"))
+
+ (union-build #$output
+ (filter (lambda (directory)
+ (or (file-exists? (modules directory))
+ (file-exists? (objects directory))))
+ '#$things)
+
+ #:log-port (%make-void-port "w")))))
+
+ (computed-file name build))
+
+(define* (guix-command modules
#:key source (dependencies '())
guile (guile-version (effective-version)))
"Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its
load path."
+ (define glibc-utf8-locales
+ (module-ref (resolve-interface '(gnu packages base))
+ 'glibc-utf8-locales))
+
+ (define module-directory
+ ;; To minimize the number of 'stat' calls needed to locate a module,
+ ;; create the union of all the module directories.
+ (guile-module-union (cons modules dependencies)))
+
(program-file "guix-command"
#~(begin
(set! %load-path
- (append '#$(map (lambda (package)
- (file-append package
- "/share/guile/site/"
- guile-version))
- dependencies)
- %load-path))
+ (cons (string-append #$module-directory
+ "/share/guile/site/"
+ (effective-version))
+ %load-path))
(set! %load-compiled-path
- (append '#$(map (lambda (package)
- (file-append package "/lib/guile/"
- guile-version
- "/site-ccache"))
- dependencies)
- %load-compiled-path))
-
- (set! %load-path (cons #$modules %load-path))
- (set! %load-compiled-path
- (cons (or #$compiled-modules #$modules)
+ (cons (string-append #$module-directory
+ "/lib/guile/"
+ (effective-version)
+ "/site-ccache")
%load-compiled-path))
+ ;; To maximize the chances that locales are set up right
+ ;; out-of-the-box, bundle "common" UTF-8 locales.
+ (let ((locpath (getenv "GUIX_LOCPATH")))
+ (setenv "GUIX_LOCPATH"
+ (string-append (if locpath
+ (string-append locpath ":")
+ "")
+ #$(file-append glibc-utf8-locales
+ "/lib/locale"))))
+
(let ((guix-main (module-ref (resolve-interface '(guix ui))
'guix-main)))
#$(if source
(apply guix-main (command-line))))
#:guile guile))
+(define (miscellaneous-files source)
+ "Return data files taken from SOURCE."
+ (file-mapping "guix-misc"
+ `(("etc/bash_completion.d/guix"
+ ,(file-append* source "/etc/completion/bash/guix"))
+ ("etc/bash_completion.d/guix-daemon"
+ ,(file-append* source "/etc/completion/bash/guix-daemon"))
+ ("share/zsh/site-functions/_guix"
+ ,(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"
+ ,(file-append* source
+ "/etc/substitutes/berlin.guixsd.org.pub"))
+ ("share/guix/ci.guix.gnu.org.pub" ;alias
+ ,(file-append* source "/etc/substitutes/berlin.guixsd.org.pub"))
+ ("share/guix/ci.guix.info.pub" ;alias
+ ,(file-append* source "/etc/substitutes/berlin.guixsd.org.pub")))))
+
(define* (whole-package name modules dependencies
#:key
(guile-version (effective-version))
- compiled-modules
- info daemon guile
+ info daemon miscellany
+ guile
(command (guix-command modules
#:dependencies dependencies
#:guile guile
#:guile-version guile-version)))
"Return the whole Guix package NAME that uses MODULES, a derivation of all
-the modules, and DEPENDENCIES, a list of packages depended on. COMMAND is the
-'guix' program to use; INFO is the Info manual. When COMPILED-MODULES is
-true, it is linked as 'lib/guile/X.Y/site-ccache'; otherwise, .go files are
-assumed to be part of MODULES."
+the modules (under share/guile/site and lib/guile), and DEPENDENCIES, a list
+of packages depended on. COMMAND is the 'guix' program to use; INFO is the
+Info manual."
+ (define (wrap daemon)
+ (program-file "guix-daemon"
+ #~(begin
+ ;; Refer to the right 'guix' command for 'guix
+ ;; substitute' & co.
+ (setenv "GUIX" #$command)
+
+ ;; Honor the user's settings rather than those hardcoded
+ ;; in the 'guix-daemon' package.
+ (unless (getenv "GUIX_STATE_DIRECTORY")
+ (setenv "GUIX_STATE_DIRECTORY"
+ #$(string-append %localstatedir "/guix")))
+ (unless (getenv "GUIX_CONFIGURATION_DIRECTORY")
+ (setenv "GUIX_CONFIGURATION_DIRECTORY"
+ #$(string-append %sysconfdir "/guix")))
+ (unless (getenv "NIX_STORE_DIR")
+ (setenv "NIX_STORE_DIR" #$%storedir))
+
+ (apply execl #$(file-append daemon "/bin/guix-daemon")
+ "guix-daemon" (cdr (command-line))))))
+
(computed-file name
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
+
+ (define daemon
+ #$(and daemon (wrap daemon)))
+
(mkdir-p (string-append #$output "/bin"))
(symlink #$command
(string-append #$output "/bin/guix"))
- (when #$daemon
- (symlink (string-append #$daemon "/bin/guix-daemon")
+ (when daemon
+ (symlink daemon
(string-append #$output "/bin/guix-daemon")))
- (let ((modules (string-append #$output
- "/share/guile/site/"
- (effective-version)))
- (info #$info))
- (mkdir-p (dirname modules))
- (symlink #$modules modules)
+ (let ((share (string-append #$output "/share"))
+ (lib (string-append #$output "/lib"))
+ (info #$info))
+ (mkdir-p share)
+ (symlink #$(file-append modules "/share/guile")
+ (string-append share "/guile"))
(when info
- (symlink #$info
- (string-append #$output
- "/share/info"))))
-
- ;; Object files.
- (when #$compiled-modules
- (let ((modules (string-append #$output "/lib/guile/"
- (effective-version)
- "/site-ccache")))
- (mkdir-p (dirname modules))
- (symlink #$compiled-modules modules)))))))
+ (symlink #$info (string-append share "/info")))
+
+ (mkdir-p lib)
+ (symlink #$(file-append modules "/lib/guile")
+ (string-append lib "/guile")))
+
+ (when #$miscellany
+ (copy-recursively #$miscellany #$output
+ #:log (%make-void-port "w")))))))
(define* (compiled-guix source #:key (version %guix-version)
(pull-version 1)
(name (string-append "guix-" version))
(guile-version (effective-version))
- (guile-for-build (guile-for-build guile-version))
- (libgcrypt (specification->package "libgcrypt"))
+ (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-json
- (package-for-guile guile-version
- "guile-json"
- "guile2.0-json"))
+ (specification->package "guile-json"))
(define guile-ssh
- (package-for-guile guile-version
- "guile-ssh"
- "guile2.0-ssh"))
+ (specification->package "guile-ssh"))
(define guile-git
- (package-for-guile guile-version
- "guile-git"
- "guile2.0-git"))
+ (specification->package "guile-git"))
(define guile-sqlite3
- (package-for-guile guile-version
- "guile-sqlite3"
- "guile2.0-sqlite3"))
+ (specification->package "guile-sqlite3"))
+
+ (define guile-gcrypt
+ (specification->package "guile-gcrypt"))
(define gnutls
- (package-for-guile guile-version
- "gnutls" "guile2.0-gnutls"))
+ (specification->package "gnutls"))
(define dependencies
(match (append-map (lambda (package)
(cons (list "x" package)
(package-transitive-propagated-inputs package)))
- (list gnutls guile-git guile-json
+ (list guile-gcrypt gnutls guile-git guile-json
guile-ssh guile-sqlite3))
(((labels packages _ ...) ...)
packages)))
;; rebuilt when the version changes, which in turn means we
;; can have substitutes for it.
#:extra-modules
- `(((guix config)
- => ,(make-config.scm #:libgcrypt
- (specification->package
- "libgcrypt"))))
+ `(((guix config) => ,(make-config.scm)))
;; (guix man-db) is needed at build-time by (guix profiles)
;; but we don't need to compile it; not compiling it allows
;; us to avoid an extra dependency on guile-gdbm-ffi.
#:extra-files
`(("guix/man-db.scm" ,(local-file "../guix/man-db.scm"))
+ ("guix/build/po.scm" ,(local-file "../guix/build/po.scm"))
("guix/store/schema.sql"
,(local-file "../guix/store/schema.sql")))
+ #:extensions (list guile-gcrypt)
#:guile-for-build guile-for-build))
(define *extra-modules*
(scheme-node "guix-system"
`((gnu system)
(gnu services)
+ ,@(scheme-modules* source "gnu/bootloader")
,@(scheme-modules* source "gnu/system")
- ,@(scheme-modules* source "gnu/services"))
+ ,@(scheme-modules* source "gnu/services")
+ ,@(scheme-modules* source "gnu/machine"))
(list *core-package-modules* *package-modules*
*extra-modules* *core-modules*)
#:extensions dependencies
(append (file-imports source "gnu/system/examples"
(const #t))
+ ;; All the installer code is on the build-side.
+ (file-imports source "gnu/installer/"
+ (const #t))
;; Build-side code that we don't build. Some of
;; these depend on guile-rsvg, the Shepherd, etc.
(file-imports source "gnu/build" (const #t)))
(define *cli-modules*
(scheme-node "guix-cli"
- (scheme-modules* source "/guix/scripts")
+ (append (scheme-modules* source "/guix/scripts")
+ `((gnu ci)))
(list *core-modules* *extra-modules*
*core-package-modules* *package-modules*
*system-modules*)
#:extensions dependencies
#:guile-for-build guile-for-build))
+ (define *system-test-modules*
+ ;; Ship these modules mostly so (gnu ci) can discover them.
+ (scheme-node "guix-system-tests"
+ `((gnu tests)
+ ,@(scheme-modules* source "gnu/tests"))
+ (list *core-package-modules* *package-modules*
+ *extra-modules* *system-modules* *core-modules*
+ *cli-modules*) ;for (guix scripts pack), etc.
+ #:extensions dependencies
+ #:guile-for-build guile-for-build))
+
(define *config*
(scheme-node "guix-config"
'()
#:extra-modules
`(((guix config)
- => ,(make-config.scm #:libgcrypt libgcrypt
- #:zlib zlib
+ => ,(make-config.scm #:zlib zlib
+ #:lzlib lzlib
#:gzip gzip
#:bzip2 bzip2
#:xz xz
;; comes with *CORE-MODULES*.
(list *config*
*cli-modules*
+ *system-test-modules*
*system-modules*
*package-modules*
*core-package-modules*
;; Version 1 is when we return the full package.
(cond ((= 1 pull-version)
;; The whole package, with a standard file hierarchy.
- (let* ((modules (built-modules (compose list node-source)))
- (compiled (built-modules (compose list node-compiled)))
- (command (guix-command modules compiled
+ (let* ((modules (built-modules (compose list node-source+compiled)))
+ (command (guix-command modules
#:source source
#:dependencies dependencies
#:guile guile-for-build
#:guile-version guile-version)))
(whole-package name modules dependencies
- #:compiled-modules compiled
#:command command
#:guile guile-for-build
'guix-daemon)
#:info (info-manual source)
+ #:miscellany (miscellaneous-files source)
#:guile-version guile-version)))
((= 0 pull-version)
;; Legacy 'guix pull': return the .scm and .go files as one
;;; Generating (guix config).
;;;
-(define %dependency-variables
- ;; (guix config) variables corresponding to dependencies.
- '(%libgcrypt %libz %xz %gzip %bzip2))
-
(define %persona-variables
;; (guix config) variables that define Guix's persona.
'(%guix-package-name
((_ variable rest ...)
(cons `(variable . ,variable)
(variables rest ...))))))
- (variables %localstatedir %storedir %sysconfdir %system)))
+ (variables %localstatedir %storedir %sysconfdir)))
-(define* (make-config.scm #:key libgcrypt zlib gzip xz bzip2
+(define* (make-config.scm #:key zlib lzlib gzip xz bzip2
(package-name "GNU Guix")
(package-version "0")
(bug-report-address "bug-guix@gnu.org")
- (home-page-url "https://gnu.org/s/guix"))
+ (home-page-url "https://guix.gnu.org"))
;; Hack so that Geiser is not confused.
(define defmod 'define-module)
%guix-version
%guix-bug-report-address
%guix-home-page-url
+ %system
%store-directory
%state-directory
%store-database-directory
%config-directory
- %libgcrypt
%libz
+ %liblz
%gzip
%bzip2
%xz))
+ (define %system
+ #$(%current-system))
+
#$@(map (match-lambda
((name . value)
#~(define-public #$name #$value)))
(define %state-directory
;; This must match `NIX_STATE_DIR' as defined in
;; `nix/local.mk'.
- (or (getenv "NIX_STATE_DIR")
+ (or (getenv "GUIX_STATE_DIRECTORY")
(string-append %localstatedir "/guix")))
(define %store-database-directory
- (or (getenv "NIX_DB_DIR")
+ (or (getenv "GUIX_DATABASE_DIRECTORY")
(string-append %state-directory "/db")))
(define %config-directory
(define %xz
#+(and xz (file-append xz "/bin/xz")))
- (define %libgcrypt
- #+(and libgcrypt
- (file-append libgcrypt "/lib/libgcrypt")))
(define %libz
#+(and zlib
- (file-append zlib "/lib/libz"))))
+ (file-append zlib "/lib/libz")))
+
+ (define %liblz
+ #+(and lzlib
+ (file-append lzlib "/lib/liblz"))))
;; Guile 2.0 *requires* the 'define-module' to be at the
;; top-level or the 'toplevel-ref' in the resulting .go file are
;; made relative to a nonexistent anonymous module.
#:splice? #t))
-
\f
;;;
;;; Building.
(define (report-load file total completed)
(display #\cr)
(format #t
- "loading...\t~5,1f% of ~d files" ;FIXME: i18n
+ "[~3@a/~3@a] loading...\t~5,1f% of ~d files"
+
+ ;; Note: Multiply TOTAL by two to account for the
+ ;; compilation phase that follows.
+ completed (* total 2)
+
(* 100. (/ completed total)) total)
(force-output))
(define (report-compilation file total completed)
(display #\cr)
- (format #t "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
+ (format #t "[~3@a/~3@a] compiling...\t~5,1f% of ~d files"
+
+ ;; Add TOTAL to account for the load phase that came
+ ;; before.
+ (+ total completed) (* total 2)
+
(* 100. (/ completed total)) total)
(force-output))
#:report-load report-load
#:report-compilation report-compilation)))
- (setvbuf (current-output-port) _IONBF)
- (setvbuf (current-error-port) _IONBF)
+ (setvbuf (current-output-port) 'line)
+ (setvbuf (current-error-port) 'line)
(set! %load-path (cons #+module-tree %load-path))
(set! %load-path
;;; Building.
;;;
-(define (guile-for-build version)
- "Return a derivation for Guile 2.0 or 2.2, whichever matches the currently
-running Guile."
- (define canonical-package ;soft reference
- (module-ref (resolve-interface '(gnu packages base))
- 'canonical-package))
-
- (match version
- ("2.2.2"
- ;; Gross hack to avoid ABI incompatibilities (see
- ;; <https://bugs.gnu.org/29570>.)
- (module-ref (resolve-interface '(gnu packages guile))
- 'guile-2.2.2))
- ("2.2"
- (canonical-package (module-ref (resolve-interface '(gnu packages guile))
- 'guile-2.2)))
- ("2.0"
- (module-ref (resolve-interface '(gnu packages guile))
- 'guile-2.0))))
-
(define* (guix-derivation source version
#:optional (guile-version (effective-version))
#:key (pull-version 0))
version))
(define guile
- (guile-for-build guile-version))
+ ;; When PULL-VERSION >= 1, produce a self-contained Guix and use Guile 2.2
+ ;; unconditionally.
+ (default-guile))
+
+ (when (and (< pull-version 1)
+ (not (string=? (package-version guile) guile-version)))
+ ;; Guix < 0.15.0 has PULL-VERSION = 0, where the host Guile is reused and
+ ;; can be any version. When that happens and Guile is not current (e.g.,
+ ;; it's Guile 2.0), just bail out.
+ (raise (condition
+ (&message
+ (message "Guix is too old and cannot be upgraded")))))
(mbegin %store-monad
(set-guile-for-build guile)
#:name (string-append "guix-"
(shorten version))
#:pull-version pull-version
- #:guile-version (match guile-version
- ("2.2.2" "2.2")
- (version version))
+ #:guile-version (if (>= pull-version 1)
+ "2.2" guile-version)
#:guile-for-build guile)))
(if guix
(lower-object guix)
HCoop / jackhill / guix / guix.git / blobdiff