projects/guix·blob v0.2 · refs

90 lines · 3.6 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013 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;;;
20;;; This file defines build jobs for the Hydra continuation integration
21;;; tool.
22;;;
23
24;; Attempt to use our very own Guix modules.
25(eval-when (compile load eval)
26
27 ;; Ignore any available .go, and force recompilation. This is because our
28 ;; checkout in the store has mtime set to the epoch, and thus .go files look
29 ;; newer, even though they may not correspond.
30 (set! %fresh-auto-compile #t)
31
32 (and=> (assoc-ref (current-source-location) 'filename)
33 (lambda (file)
34 (let ((dir (dirname file)))
35 (format (current-error-port) "prepending ~s to the load path~%"
36 dir)
37 (set! %load-path (cons dir %load-path))))))
38
39(use-modules (guix store)
40 (guix packages)
41 ((guix utils) #:select (%current-system))
42 (gnu packages)
43 (gnu packages base)
44 (gnu packages guile)
45 (srfi srfi-1)
46 (srfi srfi-26)
47 (ice-9 match))
48
49;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
50;; port to the bit bucket, let us write to the error port instead.
51(setvbuf (current-error-port) _IOLBF)
52(set-current-output-port (current-error-port))
53
54(define (package->alist store package system)
55 "Convert PACKAGE to an alist suitable for Hydra."
56 `((derivation . ,(package-derivation store package system))
57 (description . ,(package-synopsis package))
58 (long-description . ,(package-description package))
59 (license . ,(package-license package))
60 (home-page . ,(package-home-page package))
61 (maintainers . ("[email protected]"))))
62
63(define (package-job store job-name package system)
64 "Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
65 `(,job-name . ,(cut package->alist store package system)))
66
67(define (hydra-jobs store arguments)
68 "Return Hydra jobs."
69 (define system
70 (or (assoc-ref arguments system)
71 (%current-system)))
72
73 ;; Return one job for each package, except bootstrap packages.
74 (let ((base-packages (delete-duplicates
75 (append-map (match-lambda
76 ((_ package _ ...)
77 (match (package-transitive-inputs
78 package)
79 (((_ inputs _ ...) ...)
80 inputs))))
81 %final-inputs))))
82 (fold-packages (lambda (package result)
83 (if (member package base-packages)
84 result
85 (let ((name (string->symbol
86 (package-full-name package))))
87 (cons (package-job store name package
88 system)
89 result))))
90 '())))