Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
29760251 | 2 | ;;; Copyright © 2012, 2013, 2014, 2018 Ludovic Courtès <ludo@gnu.org> |
be13fbfa | 3 | ;;; |
233e7676 | 4 | ;;; This file is part of GNU Guix. |
be13fbfa | 5 | ;;; |
233e7676 | 6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
be13fbfa LC |
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 | ;;; | |
233e7676 | 11 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
be13fbfa LC |
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 | |
233e7676 | 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
be13fbfa LC |
18 | |
19 | (define-module (guix build-system trivial) | |
20 | #:use-module (guix store) | |
21 | #:use-module (guix utils) | |
22 | #:use-module (guix derivations) | |
12d5aa0f | 23 | #:use-module (guix packages) |
be13fbfa | 24 | #:use-module (guix build-system) |
12d5aa0f | 25 | #:use-module (ice-9 match) |
be13fbfa LC |
26 | #:export (trivial-build-system)) |
27 | ||
5dce8218 LC |
28 | (define (guile-for-build store guile system) |
29 | (match guile | |
30 | ((? package?) | |
05962f29 | 31 | (package-derivation store guile system #:graft? #f)) |
5dce8218 | 32 | (#f ; the default |
bdb36958 | 33 | (let* ((distro (resolve-interface '(gnu packages commencement))) |
5dce8218 | 34 | (guile (module-ref distro 'guile-final))) |
05962f29 | 35 | (package-derivation store guile system #:graft? #f))))) |
5dce8218 | 36 | |
0d5a559f | 37 | (define* (lower name |
d3d337d2 | 38 | #:key source inputs native-inputs outputs system target |
29760251 | 39 | guile builder modules allowed-references) |
0d5a559f LC |
40 | "Return a bag for NAME." |
41 | (bag | |
42 | (name name) | |
d3d337d2 | 43 | (system system) |
553521d2 | 44 | (target target) |
0d5a559f LC |
45 | (host-inputs `(,@(if source |
46 | `(("source" ,source)) | |
47 | '()) | |
48 | ,@inputs)) | |
49 | (build-inputs native-inputs) | |
50 | (outputs outputs) | |
51 | (build (if target trivial-cross-build trivial-build)) | |
52 | (arguments `(#:guile ,guile | |
53 | #:builder ,builder | |
29760251 LC |
54 | #:modules ,modules |
55 | #:allowed-references ,allowed-references)))) | |
0d5a559f LC |
56 | |
57 | (define* (trivial-build store name inputs | |
a18eda27 LC |
58 | #:key |
59 | outputs guile system builder (modules '()) | |
29760251 | 60 | search-paths allowed-references) |
be13fbfa LC |
61 | "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is |
62 | ignored." | |
29760251 LC |
63 | (define canonicalize-reference |
64 | (match-lambda | |
65 | ((? package? p) | |
66 | (derivation->output-path (package-derivation store p system | |
67 | #:graft? #f))) | |
68 | (((? package? p) output) | |
69 | (derivation->output-path (package-derivation store p system | |
70 | #:graft? #f) | |
71 | output)) | |
72 | ((? string? output) | |
73 | output))) | |
74 | ||
dd1a5a15 | 75 | (build-expression->derivation store name builder |
0d5a559f | 76 | #:inputs inputs |
dd1a5a15 | 77 | #:system system |
be13fbfa | 78 | #:outputs outputs |
12d5aa0f | 79 | #:modules modules |
29760251 LC |
80 | #:allowed-references |
81 | (and allowed-references | |
82 | (map canonicalize-reference | |
83 | allowed-references)) | |
5dce8218 LC |
84 | #:guile-for-build |
85 | (guile-for-build store guile system))) | |
86 | ||
0d5a559f | 87 | (define* (trivial-cross-build store name |
5dce8218 | 88 | #:key |
0d5a559f | 89 | target native-drvs target-drvs |
5dce8218 | 90 | outputs guile system builder (modules '()) |
29760251 LC |
91 | search-paths native-search-paths |
92 | allowed-references) | |
0d5a559f LC |
93 | "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is |
94 | ignored." | |
29760251 LC |
95 | (define canonicalize-reference |
96 | (match-lambda | |
97 | ((? package? p) | |
98 | (derivation->output-path (package-cross-derivation store p system))) | |
99 | (((? package? p) output) | |
100 | (derivation->output-path (package-cross-derivation store p system) | |
101 | output)) | |
102 | ((? string? output) | |
103 | output))) | |
104 | ||
dd1a5a15 | 105 | (build-expression->derivation store name builder |
0d5a559f | 106 | #:inputs (append native-drvs target-drvs) |
dd1a5a15 | 107 | #:system system |
5dce8218 LC |
108 | #:outputs outputs |
109 | #:modules modules | |
29760251 LC |
110 | #:allowed-references |
111 | (and allowed-references | |
112 | (map canonicalize-reference | |
113 | allowed-references)) | |
5dce8218 LC |
114 | #:guile-for-build |
115 | (guile-for-build store guile system))) | |
be13fbfa LC |
116 | |
117 | (define trivial-build-system | |
0d5a559f LC |
118 | (build-system |
119 | (name 'trivial) | |
120 | (description | |
121 | "Trivial build system, to run arbitrary Scheme build expressions") | |
122 | (lower lower))) |