build-aux/hydra/guix-modular.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017, 2018, 2020 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 ;;;
  20 ;;; This file defines a continuous integration job to build the same modular
  21 ;;; Guix as 'guix pull', which is defined in (guix self).
  22 ;;;
  23
  24 (use-modules (guix store)
  25              (guix config)
  26              (guix utils)
  27              ((guix packages) #:select (%hydra-supported-systems))
  28              (guix derivations)
  29              (guix monads)
  30              ((guix licenses) #:prefix license:)
  31              (srfi srfi-1)
  32              (ice-9 match))
  33
  34 ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
  35 ;; port to the bit bucket, let us write to the error port instead.
  36 (setvbuf (current-error-port) 'line)
  37 (set-current-output-port (current-error-port))
  38
  39 (define* (build-job store source version system)
  40   "Return a Hydra job a list building the modular Guix derivation from SOURCE
  41 for SYSTEM.  Use VERSION as the version identifier."
  42   (lambda ()
  43     (define build
  44       (primitive-load (string-append source "/build-aux/build-self.scm")))
  45
  46     `((derivation . ,(derivation-file-name
  47                       (run-with-store store
  48                         (build source #:version version #:system system
  49                                #:pull-version 1
  50                                #:guile-version "2.2")))) ;the latest 2.2.x
  51       (description . "Modular Guix")
  52       (long-description
  53        . "This is the modular Guix package as produced by 'guix pull'.")
  54       (license . ,license:gpl3+)
  55       (home-page . ,%guix-home-page-url)
  56       (maintainers . (,%guix-bug-report-address)))))
  57
  58 (define (hydra-jobs store arguments)
  59   "Return Hydra jobs."
  60   (define systems
  61     (match (assoc-ref arguments 'systems)
  62       (#f              %hydra-supported-systems)
  63       ((lst ...)       lst)
  64       ((? string? str) (call-with-input-string str read))))
  65
  66   (define guix-checkout
  67     (or (assq-ref arguments 'guix)                ;Hydra on hydra
  68         (assq-ref arguments 'guix-modular)))      ;Cuirass on berlin
  69
  70   (define version
  71     (or (assq-ref guix-checkout 'revision)
  72         "0.unknown"))
  73
  74   (let ((file (assq-ref guix-checkout 'file-name)))
  75     (format (current-error-port) "using checkout ~s (~s; arguments: ~s)~%"
  76             guix-checkout file arguments)
  77
  78     (map (lambda (system)
  79            (let ((name (string->symbol
  80                         (string-append "guix." system))))
  81              `(,name
  82                . ,(build-job store file version system))))
  83          systems)))