;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

;;;
;;; This file defines a continuous integration job to build the same modular
;;; Guix as 'guix pull', which is defined in (guix self).
;;;

(use-modules (guix store)
             (guix config)
             (guix utils)
             ((guix packages) #:select (%hydra-supported-systems))
             (guix derivations)
             (guix monads)
             (srfi srfi-1)
             (ice-9 match))

;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
;; port to the bit bucket, let us write to the error port instead.
(setvbuf (current-error-port) 'line)
(set-current-output-port (current-error-port))

(define* (build-job store register source version system)
  "Register a Cuirass job a list building the modular Guix derivation from
SOURCE for SYSTEM.  Use VERSION as the version identifier."
  (define build
    (primitive-load (string-append source "/build-aux/build-self.scm")))

  (let ((name (string-append "guix." system))
        (drv (run-with-store store
               (build source #:version version #:system system
                      #:pull-version 1
                      #:guile-version "2.2"))))
    (register name
              #:derivation (derivation-file-name drv)
              #:log (log-file store (derivation-file-name drv))
              #:outputs (filter-map
                         (lambda (res)
                           (match res
                             ((name . path)
                              `(,name . ,path))))
                         (derivation->output-paths drv))
              #:nix-name (derivation-name drv)
              #:system (derivation-system drv))))

(define (cuirass-jobs store arguments register)
  "Return Cuirass jobs."
  (define systems
    (match (assoc-ref arguments 'systems)
      (#f              %hydra-supported-systems)
      ((lst ...)       lst)
      ((? string? str) (call-with-input-string str read))))

  (define guix-checkout
    (assq-ref arguments 'guix-modular))

  (define version
    (or (assq-ref guix-checkout 'revision)
        "0.unknown"))

  (let ((file (assq-ref guix-checkout 'file-name)))
    (format (current-error-port) "using checkout ~s (~s; arguments: ~s)~%"
            guix-checkout file arguments)

    (for-each (lambda (system)
                (build-job store register file version system))
              systems)))