guix/build/gnu-dist.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (guix build gnu-dist)
  21   #:use-module (guix build utils)
  22   #:use-module (guix build gnu-build-system)
  23   #:use-module (srfi srfi-1)
  24   #:export (%dist-phases))
  25
  26 ;;; Commentary:
  27 ;;;
  28 ;;; Build phases to build a source tarball with the GNU build system, as with
  29 ;;; "make distcheck".
  30 ;;;
  31 ;;; Code:
  32
  33 (define* (copy-source #:key source #:allow-other-keys)
  34   (copy-recursively source "."))
  35
  36 (define* (autoreconf #:rest args)
  37   (letrec-syntax ((try-files (syntax-rules (else)
  38                                ((_ (else fallback ...))
  39                                 (begin fallback ...))
  40                                ((_ file files ... (else fallback ...))
  41                                 (if (file-exists? file)
  42                                     (begin
  43                                       (format #t "bootstrapping with `~a'...~%"
  44                                               file)
  45                                       (invoke (string-append "./" file)))
  46                                     (try-files files ...
  47                                                (else fallback ...)))))))
  48     (try-files "bootstrap" "bootstrap.sh" "autogen" "autogen.sh"
  49                (else
  50                 (format #t "bootstrapping with `autoreconf'...~%")
  51                 (invoke "autoreconf" "-vfi")))))
  52
  53 (define* (build #:key build-before-dist? make-flags (dist-target "distcheck")
  54                 #:allow-other-keys
  55                 #:rest args)
  56   (when build-before-dist?
  57     (let ((build (assq-ref %standard-phases 'build)))
  58       (apply build args)))
  59   (format #t "building target `~a'~%" dist-target)
  60   (apply invoke "make" dist-target make-flags))
  61
  62 (define* (install-dist #:key outputs #:allow-other-keys)
  63   (let* ((out      (assoc-ref outputs "out"))
  64          (meta     (string-append out "/nix-support")) ; Hydra meta-data
  65          (tarballs (find-files "." "\\.tar\\.")))
  66     (mkdir out)
  67     (for-each (lambda (tarball)
  68                 (copy-file tarball (string-append out "/" tarball)))
  69               out)
  70
  71     (mkdir meta)
  72     (call-with-output-file (string-append out "/hydra-build-products")
  73       (lambda (port)
  74         (for-each (lambda (tarball)
  75                     ;; This tells Hydra's what kind of build products we have,
  76                     ;; so it can represent them nicely.  See `product-list.tt'
  77                     ;; in Hydra for details.
  78                     (format port "file source-dist ~a/~a~%" out tarball))
  79                   tarballs)))
  80     #t))
  81
  82 (define %dist-phases
  83   ;; Phases for building a source tarball.
  84   (modify-phases %standard-phases
  85     (delete 'strip)
  86     (replace 'install install-dist)
  87     (replace 'build build)
  88     (add-before 'configure 'autoreconf autoreconf)
  89     (replace 'unpack copy-source)))
  90
  91 ;;; gnu-dist.scm ends here