aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--build-aux/build-self.scm19
-rw-r--r--build-aux/compile-as-derivation.scm2
-rw-r--r--guix/self.scm153
3 files changed, 132 insertions, 42 deletions
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index bccb7a959e..5898b6515c 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -184,7 +184,8 @@ person's version identifier."
(date->string (current-date 0) "~Y~m~d.~H"))
(define* (build-program source version
- #:optional (guile-version (effective-version)))
+ #:optional (guile-version (effective-version))
+ #:key (pull-version 0))
"Return a program that computes the derivation to build Guix from SOURCE."
(define select?
;; Select every module but (guix config) and non-Guix modules.
@@ -253,11 +254,14 @@ person's version identifier."
(spin system)))
(display
- (derivation-file-name
+ (and=>
(run-with-store store
(guix-derivation #$source #$version
- #$guile-version)
- #:system system)))))))
+ #$guile-version
+ #:pull-version
+ #$pull-version)
+ #:system system)
+ derivation-file-name))))))
#:module-path (list source))))
;; The procedure below is our return value.
@@ -266,13 +270,15 @@ person's version identifier."
(guile-version (match ((@ (guile) version))
("2.2.2" "2.2.2")
(_ (effective-version))))
+ (pull-version 0)
#:allow-other-keys
#:rest rest)
"Return a derivation that unpacks SOURCE into STORE and compiles Scheme
files."
;; Build the build program and then use it as a trampoline to build from
;; SOURCE.
- (mlet %store-monad ((build (build-program source version guile-version))
+ (mlet %store-monad ((build (build-program source version guile-version
+ #:pull-version pull-version))
(system (if system (return system) (current-system))))
(mbegin %store-monad
(show-what-to-build* (list build))
@@ -292,6 +298,9 @@ files."
(return (newline (current-output-port)))
((store-lift add-temp-root) drv)
(return (read-derivation-from-file drv))))
+ ("#f"
+ ;; Unsupported PULL-VERSION.
+ (return #f))
((? string? str)
(error "invalid build result" (list build str))))))))
diff --git a/build-aux/compile-as-derivation.scm b/build-aux/compile-as-derivation.scm
index afb134a92a..2a45e71bb9 100644
--- a/build-aux/compile-as-derivation.scm
+++ b/build-aux/compile-as-derivation.scm
@@ -43,7 +43,7 @@
(mlet* %store-monad ((source (interned-file source "guix-source"
#:select? git?
#:recursive? #t))
- (drv (build source)))
+ (drv (build source #:pull-version 1)))
(mbegin %store-monad
(show-what-to-build* (list drv))
(built-derivations (list drv))
diff --git a/guix/self.scm b/guix/self.scm
index 3acfac6f80..28faeaab0c 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -34,6 +34,7 @@
#:use-module (srfi srfi-9)
#:use-module (ice-9 match)
#:export (make-config.scm
+ whole-package ;for internal use in 'guix pull'
compiled-guix
guix-derivation
reload-guix))
@@ -192,7 +193,66 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'."
(file-name->module-name (string-drop file prefix)))
(scheme-files (string-append directory "/" sub-directory)))))
+(define* (guix-command modules #:key (dependencies '())
+ (guile-version (effective-version)))
+ "Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its
+load path."
+ (program-file "guix-command"
+ #~(begin
+ (set! %load-path
+ (append '#$(map (lambda (package)
+ (file-append package
+ "/share/guile/site/"
+ guile-version))
+ dependencies)
+ %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 #$modules %load-compiled-path))
+
+ (let ((guix-main (module-ref (resolve-interface '(guix ui))
+ 'guix-main)))
+ ;; TODO: Compute locale data.
+ ;; (bindtextdomain "guix" "@localedir@")
+ ;; (bindtextdomain "guix-packages" "@localedir@")
+
+ ;; XXX: It would be more convenient to change it to:
+ ;; (exit (apply guix-main (command-line)))
+ (apply guix-main (command-line))))))
+
+(define* (whole-package name modules dependencies
+ #:key (guile-version (effective-version)))
+ "Return the whole Guix package NAME that uses MODULES, a derivation of all
+the modules, and DEPENDENCIES, a list of packages depended on."
+ (let ((command (guix-command modules
+ #:dependencies dependencies
+ #:guile-version guile-version)))
+ ;; TODO: Move compiled modules to 'lib/guile' instead of 'share/guile'.
+ (computed-file name
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (mkdir-p (string-append #$output "/bin"))
+ (symlink #$command
+ (string-append #$output "/bin/guix"))
+
+ (let ((modules (string-append #$output
+ "/share/guile/site/"
+ (effective-version))))
+ (mkdir-p (dirname modules))
+ (symlink #$modules modules)))))))
+
(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))
@@ -351,32 +411,46 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'."
%guix-home-page-url)))
#:guile-for-build guile-for-build))
- (directory-union name
- (append-map (lambda (node)
- (list (node-source node)
- (node-compiled node)))
-
- ;; Note: *CONFIG* comes first so that it
- ;; overrides the (guix config) module that
- ;; comes with *CORE-MODULES*.
- (list *config*
- *cli-modules*
- *system-modules*
- *package-modules*
- *core-package-modules*
- *extra-modules*
- *core-modules*))
-
- ;; Silently choose the first entry upon collision so that
- ;; we choose *CONFIG*.
- #:resolve-collision 'first
-
- ;; When we do (add-to-store "utils.scm"), "utils.scm" must
- ;; be a regular file, not a symlink. Thus, arrange so that
- ;; regular files appear as regular files in the final
- ;; output.
- #:copy? #t
- #:quiet? #t))
+ (define built-modules
+ (directory-union (string-append name "-modules")
+ (append-map (lambda (node)
+ (list (node-source node)
+ (node-compiled node)))
+
+ ;; Note: *CONFIG* comes first so that it
+ ;; overrides the (guix config) module that
+ ;; comes with *CORE-MODULES*.
+ (list *config*
+ *cli-modules*
+ *system-modules*
+ *package-modules*
+ *core-package-modules*
+ *extra-modules*
+ *core-modules*))
+
+ ;; Silently choose the first entry upon collision so that
+ ;; we choose *CONFIG*.
+ #:resolve-collision 'first
+
+ ;; When we do (add-to-store "utils.scm"), "utils.scm" must
+ ;; be a regular file, not a symlink. Thus, arrange so that
+ ;; regular files appear as regular files in the final
+ ;; output.
+ #:copy? #t
+ #:quiet? #t))
+
+ ;; Version 0 of 'guix pull' meant we'd just return Scheme modules.
+ ;; Version 1 is when we return the full package.
+ (cond ((= 1 pull-version)
+ ;; The whole package, with a standard file hierarchy.
+ (whole-package name built-modules dependencies
+ #:guile-version guile-version))
+ ((= 0 pull-version)
+ ;; Legacy 'guix pull': just return the compiled modules.
+ built-modules)
+ (else
+ ;; Unsupported 'guix pull' version.
+ #f)))
;;;
@@ -630,9 +704,12 @@ running Guile."
'guile-2.0))))
(define* (guix-derivation source version
- #:optional (guile-version (effective-version)))
+ #:optional (guile-version (effective-version))
+ #:key (pull-version 0))
"Return, as a monadic value, the derivation to build the Guix from SOURCE
-for GUILE-VERSION. Use VERSION as the version string."
+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."
(define (shorten version)
(if (and (string-every char-set:hex-digit version)
(> (string-length version) 9))
@@ -644,11 +721,15 @@ for GUILE-VERSION. Use VERSION as the version string."
(mbegin %store-monad
(set-guile-for-build guile)
- (lower-object (compiled-guix source
- #:version version
- #:name (string-append "guix-"
- (shorten version))
- #:guile-version (match guile-version
- ("2.2.2" "2.2")
- (version version))
- #:guile-for-build guile))))
+ (let ((guix (compiled-guix source
+ #:version version
+ #:name (string-append "guix-"
+ (shorten version))
+ #:pull-version pull-version
+ #:guile-version (match guile-version
+ ("2.2.2" "2.2")
+ (version version))
+ #:guile-for-build guile)))
+ (if guix
+ (lower-object guix)
+ (return #f)))))