You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

106 lines
3.8 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 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. ;;; This file defines build jobs of Guix itself for the Hydra continuation
  20. ;;; integration tool.
  21. ;;;
  22. ;; Attempt to use our very own Guix modules.
  23. (eval-when (expand load eval)
  24. ;; Ignore any available .go, and force recompilation. This is because our
  25. ;; checkout in the store has mtime set to the epoch, and thus .go files look
  26. ;; newer, even though they may not correspond.
  27. (set! %fresh-auto-compile #t)
  28. ;; Display which files are loaded.
  29. (set! %load-verbosely #t)
  30. (and=> (assoc-ref (current-source-location) 'filename)
  31. (lambda (file)
  32. (let ((dir (string-append (dirname file) "/../..")))
  33. (format (current-error-port) "prepending ~s to the load path~%"
  34. dir)
  35. (set! %load-path (cons dir %load-path))))))
  36. (use-modules (guix store)
  37. (guix packages)
  38. (guix utils)
  39. (guix grafts)
  40. (guix derivations)
  41. (guix build-system gnu)
  42. (gnu packages package-management)
  43. (srfi srfi-1)
  44. (srfi srfi-26)
  45. (ice-9 match))
  46. ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
  47. ;; port to the bit bucket, let us write to the error port instead.
  48. (setvbuf (current-error-port) _IOLBF)
  49. (set-current-output-port (current-error-port))
  50. (define* (package->alist store package system
  51. #:optional (package-derivation package-derivation))
  52. "Convert PACKAGE to an alist suitable for Hydra."
  53. `((derivation . ,(derivation-file-name
  54. (parameterize ((%graft? #f))
  55. (package-derivation store package system
  56. #:graft? #f))))
  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 . ("bug-guix@gnu.org"))))
  62. (define (hydra-jobs store arguments)
  63. "Return Hydra jobs."
  64. (define systems
  65. (match (filter-map (match-lambda
  66. (('system . value)
  67. value)
  68. (_ #f))
  69. arguments)
  70. ((lst ..1)
  71. lst)
  72. (_
  73. (list (%current-system)))))
  74. (define guix-checkout
  75. (assq-ref arguments 'guix))
  76. (let ((file (assq-ref guix-checkout 'file-name)))
  77. (format (current-error-port) "using checkout ~s (~s)~%"
  78. guix-checkout file)
  79. `((tarball . ,(cute package->alist store
  80. (dist-package guix file)
  81. (%current-system)))
  82. ,@(map (lambda (system)
  83. (let ((name (string->symbol
  84. (string-append "guix." system))))
  85. `(,name
  86. . ,(cute package->alist store
  87. (package
  88. (inherit guix)
  89. (version "latest")
  90. (source file))
  91. system))))
  92. %hydra-supported-systems))))