projects/guix·blob master · refs

68 lines · 2.7 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018 Ludovic Courtès <[email protected]>
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;; Avoid lots of readlink calls
24(fluid-set! %file-port-name-canonicalization #f)
25
26;; Add ~/.config/guix/current to the search path.
27(eval-when (expand load eval)
28 (and=> (or (getenv "XDG_CONFIG_HOME")
29 (and=> (getenv "HOME")
30 (cut string-append <> "/.config/guix/current")))
31 (lambda (current)
32 (set! %load-path
33 (cons (string-append current "/share/guile/site/"
34 (effective-version))
35 %load-path))
36 (set! %load-compiled-path
37 (cons (string-append current "/lib/guile/" (effective-version)
38 "/site-ccache")
39 %load-compiled-path)))))
40
41(use-modules (guix) (guix ui)
42 (guix git-download)
43 (ice-9 match))
44
45(match (command-line)
46 ((program source)
47 ;; The build procedure outputs to this port, so setup buffering to avoid
48 ;; one char per syscall.
49 (setvbuf (current-error-port) 'line)
50
51 (with-error-handling
52 (with-store store
53 (let* ((script (string-append source "/build-aux/build-self.scm"))
54 (build (primitive-load script))
55 (git? (git-predicate source)))
56 (run-with-store store
57 ;; TODO: Extract #:version and #:commit using Guile-Git.
58 (mlet* %store-monad ((source (interned-file source "guix-source"
59 #:select? git?
60 #:recursive? #t))
61 (drv (build source #:pull-version 1)))
62 (mbegin %store-monad
63 (show-what-to-build* (list drv))
64 (built-derivations (list drv))
65 (with-monad %store-monad
66 (display (derivation->output-path drv))
67 (newline)
68 (return drv))))))))))