(define-module (guix-qa-frontpage view branch)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:use-module (guix-qa-frontpage manage-builds)
  #:use-module (guix-qa-frontpage derivation-changes)
  #:use-module (guix-qa-frontpage view util)
  #:export (branch-view))

(define (branch-view branch change-details derivation-changes-counts)
  (define* (package-derivations-comparison-link system
                                                #:key build-change)
    (let ((revisions
           (assoc-ref change-details "revisions")))
      (string-append
       (simple-format #f "https://data.qa.guix.gnu.org/compare/package-derivations?base_commit=~A&target_commit=~A&system=~A&target=none"
                      (assoc-ref (assoc-ref revisions "base")
                                 "commit")
                      (assoc-ref (assoc-ref revisions "target")
                                 "commit")
                      system)
       (if build-change
           (simple-format #f "&build_change=~A" build-change)
           ""))))

  (layout
   #:title (simple-format #f "Branch ~A" branch)
   #:body
   `((main


      (div
       (table
        (@ (style "border-collapse: collapse;"))
        (thead
         (tr
          (th (@ (rowspan 3)) "System")
          (th (@ (colspan 8)) "Package build status")
          (th))
         (tr
          (th (@ (colspan 4)) "Base")
          (th (@ (colspan 4)
                 (style "border-left-width: 0.1em; border-left-style: solid; border-left-color: black"))
              "With branch changes")
          (th))
         (tr
          ,@(let ((header-style
                   "font-size: 80%; min-width: 3.5rem;"))
              `((th (@ (style ,header-style))
                    "Succeeding")
                (th (@ (style ,header-style))
                    "Failing")
                (th (@ (style ,header-style))
                    "Blocked")
                (th (@ (style ,header-style))
                    "Unknown")
                (th (@ (style
                           ,(string-append
                             header-style
                             " border-left-width: 0.125em; border-left-style: solid; border-left-color: black;")))
                    "Succeeding")
                (th (@ (style ,header-style))
                    "Failing")
                (th (@ (style ,header-style))
                    "Blocked")
                (th (@ (style ,header-style))
                    "Unknown")
                (th)))))
        (tbody
         ,@(if derivation-changes-counts
               (if (null? derivation-changes-counts)
                   `((tr
                      (td (@ (colspan 7))
                          "No package derivation changes")))
                   (map
                    (match-lambda
                      ((system . counts)

                       (define (count side status)
                         (assoc-ref (assoc-ref
                                     counts
                                     side)
                                    status))
                       `(tr
                         (td (@ (class "monospace")) ,system)
                         ,@(map (lambda (status)
                                  `(td ,(count 'base status)))
                                '(succeeding failing blocked unknown))
                         (td ,@(if (and (>= (count 'target 'succeeding)
                                            (count 'base 'succeeding))
                                        (> (count 'target 'succeeding)
                                           0))
                                   `((@ (class "good")))
                                   '())
                             ,(count 'target 'succeeding))
                         ,(if (> (count 'target 'failing)
                                 (count 'base 'failing))
                              `(td (@ (class "bad"))
                                   ,(count 'target 'failing))
                              `(td ,(count 'target 'failing)))
                         ,(if (> (count 'target 'blocked)
                                 (count 'base 'blocked))
                              `(td (@ (class "bad"))
                                   ,(count 'target 'blocked))
                              `(td ,(count 'target 'blocked)))
                         ,(if (> (count 'target 'unknown)
                                 (count 'base 'unknown))
                              `(td (@ (class "bad"))
                                   ,(count 'target 'unknown))
                              `(td ,(count 'target 'unknown)))
                         (td (a (@ (href
                                    ,(package-derivations-comparison-link system)))
                                "View comparison")))))
                    derivation-changes-counts))
               '((tr
                  (td (@ (colspan 7))
                      "Comparison unavailable")))))))))))