03/07: build: Add 'as-derivation' target.

[Ludovic Courtès]

civodul pushed a commit to branch wip-pull-multiple-derivations
in repository guix.

commit ed3bd170d36ba4492cb239cf5335a6bd6a748032
Author: Ludovic Courtès <address@hidden>
Date:   Mon Mar 26 22:17:40 2018 +0200

    build: Add 'as-derivation' target.
    
    * build-aux/compile-as-derivation.scm: New file.
    * Makefile.am (as-derivation): New target.
    (EXTRA_DIST): Add compile-as-derivation.scm.
---
 Makefile.am                         | 10 +++++++-
 build-aux/compile-as-derivation.scm | 50 +++++++++++++++++++++++++++++++++++++
 2 files changed, 59 insertions(+), 1 deletion(-)

diff --git a/Makefile.am b/Makefile.am
index e4edd05..908115e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -470,6 +470,7 @@ EXTRA_DIST =                                                
\
   build-aux/hydra/guix-modular.scm                     \
   build-aux/check-available-binaries.scm               \
   build-aux/check-final-inputs-self-contained.scm      \
+  build-aux/compile-as-derivation.scm                  \
   build-aux/generate-authors.scm                       \
   build-aux/test-driver.scm                            \
   build-aux/update-guix-package.scm                    \
@@ -535,6 +536,13 @@ $(guix_install_go_files): 
install-nobase_dist_guilemoduleDATA
 install-data-hook: set-bootstrap-executable-permissions
        touch "$(DESTDIR)$(guileobjectdir)/guix/config.go"
 
+# Assuming Guix is already installed and the daemon is up and running, this
+# rule builds from $(srcdir), creating and building derivations.
+as-derivation:
+       $(AM_V_at)echo "Building Guix in Guix..." ;             \
+       $(GUILE) --no-auto-compile                              \
+         "$(top_srcdir)/build-aux/compile-as-derivation.scm"   \
+         "$(abs_top_srcdir)"
 
 SUBDIRS = po/guix po/packages
 BUILT_SOURCES =
@@ -763,7 +771,7 @@ cuirass-jobs.scm: $(GOBJECTS)
 .PHONY: gen-ChangeLog gen-AUTHORS gen-tarball-version
 .PHONY: assert-no-store-file-names assert-binaries-available
 .PHONY: assert-final-inputs-self-contained
-.PHONY: clean-go make-go
+.PHONY: clean-go make-go as-derivation
 .PHONY: update-guix-package update-NEWS release
 
 ## -------------- ##
diff --git a/build-aux/compile-as-derivation.scm 
b/build-aux/compile-as-derivation.scm
new file mode 100644
index 0000000..383e7eb
--- /dev/null
+++ b/build-aux/compile-as-derivation.scm
@@ -0,0 +1,50 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+;; Build Guix using Guix.
+
+(use-modules (srfi srfi-26))
+
+;; Add ~/.config/guix/latest to the search path.
+(add-to-load-path
+ (and=> (or (getenv "XDG_CONFIG_HOME")
+            (and=> (getenv "HOME")
+                   (cut string-append <> "/.config")))
+        (cut string-append <> "/guix/latest")))
+
+(use-modules (guix) (guix ui)
+             (guix grafts)
+             (ice-9 match))
+
+(match (command-line)
+  ((program source)
+   (with-store store
+     (let* ((script (string-append source "/build-aux/build-self.scm"))
+            (build  (primitive-load script)))
+       (run-with-store store
+         ;; TODO: Extract #:version and #:commit using Guile-Git.
+         (mlet* %store-monad ((source (interned-file source "guix-source"
+                                                     #:recursive? #t))
+                              (drv    (build source)))
+           (mbegin %store-monad
+             (show-what-to-build* (list drv))
+             (built-derivations (list drv))
+             (with-monad %store-monad
+               (display (derivation->output-path drv))
+               (newline)
+               (return drv)))))))))