| 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; |
| 4 | ;;; This file is part of GNU Guix. |
| 5 | ;;; |
| 6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
| 7 | ;;; under the terms of the GNU General Public License as published by |
| 8 | ;;; the Free Software Foundation; either version 3 of the License, or (at |
| 9 | ;;; your option) any later version. |
| 10 | ;;; |
| 11 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
| 12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU General Public License for more details. |
| 15 | ;;; |
| 16 | ;;; You should have received a copy of the GNU General Public License |
| 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
| 18 | |
| 19 | ;; Build Guix using Guix. |
| 20 | |
| 21 | (use-modules (srfi srfi-26)) |
| 22 | |
| 23 | ;; Add ~/.config/guix/current to the search path. |
| 24 | (eval-when (expand load eval) |
| 25 | (and=> (or (getenv "XDG_CONFIG_HOME") |
| 26 | (and=> (getenv "HOME") |
| 27 | (cut string-append <> "/.config/guix/current"))) |
| 28 | (lambda (current) |
| 29 | (set! %load-path |
| 30 | (cons (string-append current "/share/guile/site/" |
| 31 | (effective-version)) |
| 32 | %load-path)) |
| 33 | (set! %load-compiled-path |
| 34 | (cons (string-append current "/lib/guile/" (effective-version) |
| 35 | "/site-ccache") |
| 36 | %load-compiled-path))))) |
| 37 | |
| 38 | (use-modules (guix) (guix ui) |
| 39 | (guix git-download) |
| 40 | (ice-9 match)) |
| 41 | |
| 42 | (match (command-line) |
| 43 | ((program source) |
| 44 | (with-error-handling |
| 45 | (with-store store |
| 46 | (let* ((script (string-append source "/build-aux/build-self.scm")) |
| 47 | (build (primitive-load script)) |
| 48 | (git? (git-predicate source))) |
| 49 | (run-with-store store |
| 50 | ;; TODO: Extract #:version and #:commit using Guile-Git. |
| 51 | (mlet* %store-monad ((source (interned-file source "guix-source" |
| 52 | #:select? git? |
| 53 | #:recursive? #t)) |
| 54 | (drv (build source #:pull-version 1))) |
| 55 | (mbegin %store-monad |
| 56 | (show-what-to-build* (list drv)) |
| 57 | (built-derivations (list drv)) |
| 58 | (with-monad %store-monad |
| 59 | (display (derivation->output-path drv)) |
| 60 | (newline) |
| 61 | (return drv)))))))))) |