;;; Guix QA Frontpage
;;;
;;; Copyright © 2022 Christopher Baines <mail@cbaines.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program 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
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (guix-qa-frontpage issue)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:use-module (guix-qa-frontpage manage-builds)
  #:use-module (guix-qa-frontpage derivation-changes)
  #:export (%overall-statuses
            status-index

            issue-patches-overall-status))

(define good-status 'important-checks-passing)
(define bad-status 'important-checks-failing)
(define needs-looking-at-status 'needs-looking-at)
(define unknown-status 'unknown)

(define %overall-statuses
  (list good-status
        unknown-status
        needs-looking-at-status
        bad-status))

(define (status-index status)
  (list-index (lambda (s)
                (eq? s status))
              %overall-statuses))

(define (worst-status statuses)
  (list-ref %overall-statuses
            (apply max (map status-index statuses))))

(define (issue-patches-overall-status derivation-changes-counts builds-missing? mumi-tags)
  (define %systems-to-consider
    '("x86_64-linux"
      ;; "i686-linux" disabled while resolving bordeaux build issues
      "aarch64-linux"
      "armhf-linux"))

  (define builds-status
    (if builds-missing?
        unknown-status
        (if (null? derivation-changes-counts)
            good-status
            (worst-status
             (map
              (match-lambda
                ((system . counts)
                 (define (count side status)
                   (assoc-ref (assoc-ref
                               counts
                               side)
                              status))

                 (let ((base-failure-count (count 'base 'failing))
                       (target-failure-count (count 'target 'failing)))
                   (if (and (<= target-failure-count
                                base-failure-count)
                            (= (count 'target 'unknown) 0))
                       good-status
                       (if (= (count 'target 'unknown) 0)
                           (let ((unblocked-builds
                                  (- (count 'base 'blocked)
                                     (count 'target 'blocked)))
                                 (new-failures
                                  (- target-failure-count
                                     base-failure-count)))
                             (if (>= unblocked-builds
                                     new-failures)
                                 needs-looking-at-status
                                 bad-status))
                           unknown-status)))))
              (filter
               (lambda (builds-by-system)
                 (member (car builds-by-system)
                         %systems-to-consider))
               derivation-changes-counts))))))

  (define tags-status
    (if (member "moreinfo" mumi-tags)
        needs-looking-at-status
        good-status))

  (let ((overall-status
         (worst-status (list builds-status
                             tags-status))))
    overall-status))