diff options
| -rw-r--r-- | build-aux/build-self.scm | 19 | ||||
| -rw-r--r-- | build-aux/compile-as-derivation.scm | 2 | ||||
| -rw-r--r-- | guix/self.scm | 153 |
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))))) |