(define-module (guix-qa-frontpage view patches)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:use-module (ice-9 string-fun)
  #:use-module (guix-qa-frontpage manage-patch-branches)
  #:use-module (guix-qa-frontpage issue)
  #:use-module (guix-qa-frontpage view util)
  #:export (patches-view))

(define (patches-view latest-series
                      filtered-statuses
                      branch-options
                      filtered-branches
                      systems-with-low-substitute-availability)

  (define (status->issue-status-span status)
    (cond
     ((eq? status 'reviewed-looks-good)
      `(span (@ (aria-label "status: darkgreen")
                (class "darkgreen-dot"))
             (*ENTITY* "#10004")))
     ((eq? status 'important-checks-passing)
      '(span (@ (aria-label "status: green")
                (class "green-dot"))
             (*ENTITY* "#10004")))
     ((eq? status 'important-checks-failing)
      '(span (@ (aria-label "status: red")
                (class "red-dot"))
             (*ENTITY* "#10005")))
     ((eq? status 'failed-to-apply-patches)
      '(span (@ (aria-label "status: darkred")
                (class "darkred-dot"))
             (*ENTITY* "#10005")))
     ((eq? status 'large-number-of-builds)
      '(span (@ (aria-label "status: purple")
                (class "purple-dot"))
             (*ENTITY* "#10005")))
     ((eq? status 'waiting-for-build-results)
      '(span (@ (aria-label "status: lightblue")
                (class "lightblue-dot"))
             (*ENTITY* "#127959")))
     ((eq? status 'patches-missing)
      '(span (@ (aria-label "status: pink")
                (class "pink-dot"))
             "?"))
     ((eq? status 'guix-data-service-failed)
      '(span (@ (aria-label "status: yellow")
                (class "yellow-dot"))
             (*ENTITY* "#10005")))
     ((eq? status 'needs-looking-at)
      '(span (@ (aria-label "status: orange")
                (class "orange-dot"))
             (*ENTITY* "#9888")))
     (else
      `(span (@ (aria-label "status: grey")
                (class "grey-dot"))
             "?"))))

  (layout
   #:title "Patches"
   #:body
   `((main
      (p "The aim with this page is that the patches to look at should be towards the
top.")
      (p "For issues with the green status (reviewed or important checks passing), the oldest ones
will appear first.")
      ,@(if (or (eq? #f systems-with-low-substitute-availability)
                (null? systems-with-low-substitute-availability))
            '()
            `((p (@ (style "text-align: center; font-weight: bold;"))
                 "Builds for new patch series suspended as "
                 (a (@ (href "/branch/master"))
                    "master branch substitute availability")
                 " is low for: "
                 ,@(append-map
                    (lambda (system)
                      `((span (@ (style "font-family: monospace;"))
                              ,system
                              " ")))
                    systems-with-low-substitute-availability))))
      (details
       ,@(if (null? filtered-statuses)
             '()
             '((@ (open ""))))
       (summary "Filter issues")
       (form
        (@ (style "text-align: left;"))
        (label "By status")
        ,@(map
           (lambda (status)
             `(div
               (input (@ (type "checkbox")
                         (id ,status)
                         (name ,status)
                         ,@(if (member status filtered-statuses)
                               '((checked ""))
                               '())))
               (label (@ (for ,status))
                      ,(status->issue-status-span status)
                      " "
                      ,(string-replace-substring
                        (symbol->string status)
                        "-"
                        " "))))
           %overall-statuses)
        (label (@ (for "branch-filter"))
               "By branch")
        (select (@ (name "branch")
                   (id "branch-filter")
                   (multiple "true"))
                ,@(map
                   (lambda (branch)
                     `(option (@ (value ,branch)
                                 ,@(if (member branch filtered-branches)
                                       '((selected ""))
                                       '()))
                              ,branch))
                   branch-options))
        (button (@ (type "submit")) "Update")))
      (table
       (tbody
        ,@(map (match-lambda
                 ((id . details)
                  (let ((status (assq-ref details 'overall-status)))
                    `(tr
                      (td (a (@ (href ,(simple-format #f "/issue/~A" id)))
                             ,id))
                      (td
                       (@ (style "vertical-align: middle;"))
                       ,(status->issue-status-span status))
                      (td (@ (style "text-align: left;"))
                          ,(assoc-ref details "name"))))))
               latest-series)))))))