(define-module (guix-qa-frontpage patchwork)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-43)
  #:use-module (srfi srfi-71)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 match)
  #:use-module (rnrs bytevectors)
  #:use-module (json)
  #:use-module (web uri)
  #:use-module (web client)
  #:use-module (web request)
  #:use-module (web response)
  #:use-module ((guix-build-coordinator utils)
                #:select (call-with-delay-logging))
  #:use-module ((guix-build-coordinator utils fibers)
                #:select (retry-on-error))
  #:use-module (guix-qa-frontpage mumi)
  #:use-module (guix-qa-frontpage debbugs)
  #:export (%patchwork-instance

            latest-patchwork-series-by-issue))

(define %patchwork-instance
  (make-parameter "https://patches.guix-patches.cbaines.net"))

(define %link-regex
  (make-regexp "<(.*?)>;?(.*)"))
(define %link-param-regex
  (make-regexp "\\s*(.*)=(.*)"))

(define (parse-link link)
  (define (strip-quotes s)
    (if (and (string-suffix? "\"" s)
             (string-prefix? "\"" s))
        (string-drop-right
         (string-drop s 1)
         1)
        s))

  (let ((link-match (regexp-exec %link-regex link)))
    `((uri    . ,(string->uri (match:substring link-match 1)))
      ,@(map
         (lambda (param)
           (let ((param-match
                  (regexp-exec %link-param-regex param)))
             (cons (string->symbol
                    (match:substring param-match 1))
                   (strip-quotes
                    (match:substring param-match 2)))))
         (string-split (match:substring link-match 2)
                       #\;)))))

(define* (patchwork-series-uri #:key patchwork
                               (per-page 200)
                               (order "-id"))
  (string->uri
   (string-append (or patchwork
                      (%patchwork-instance))
                  "/api/series/?"
                  "per_page=" (number->string per-page) "&"
                  "order=" order "&")))

(define (request-patchwork-series uri)
  (define (set-uri-scheme uri scheme)
    (string->uri
     (simple-format
      #f
      "~A:~A"
      scheme
      (string-join
       (drop (string-split (uri->string uri) #\:) 1)
       ":"))))

  (let ((response
         body
         (retry-on-error
          (lambda ()
            (http-request uri
                          #:decode-body? #f))
          #:times 2
          #:delay 3)))

    (values
     (json-string->scm (utf8->string body))
     (and=> (assq-ref (response-headers response) 'link)
            (lambda (link-header)
              (and=>
               (find (lambda (link)
                       (let ((link-details (parse-link link)))
                         (string=?
                          (assq-ref link-details 'rel)
                          "next")))
                     (string-split link-header #\,))
               (lambda (next-link)
                 (let ((link-details (parse-link next-link)))
                   (set-uri-scheme
                    (assq-ref link-details 'uri)
                    (uri-scheme uri))))))))))

(define* (latest-patchwork-series-by-issue
          #:key patchwork
          count)
  (define (string->issue-number str)
    (string->number
     (match:substring
      (string-match "\\[?bug#([0-9]*)(,|:|\\])" str)
      1)))

  (define issue-number-to-series-hash-table
    (make-hash-table))

  (let loop ((patchwork-uri
              (patchwork-series-uri
               #:patchwork patchwork
               #:per-page 200))

             (result '()))

    (if (> (length result) count)
        (let* ((rest
                count-items
                (split-at! result
                           (- (length result)
                              count)))

               (debbugs-guix-usertag-data
                (call-with-delay-logging debbugs-get-issues-with-guix-usertag))
               (usertag-lookup
                (let ((hash-table (make-hash-table)))
                  (for-each
                   (match-lambda
                     ((tag . issues)
                      (for-each
                       (lambda (issue)
                         (hash-set! hash-table
                                    issue
                                    (cons tag
                                          (or (hash-ref hash-table issue)
                                              '()))))
                       (if (pair? issues)
                           issues
                           (list issues)))))
                   debbugs-guix-usertag-data)
                  hash-table)))

          (map!
           (lambda (data)
             `(,@data
               (usertags . ,(or (hash-ref usertag-lookup
                                          (car data))
                                '()))))
           count-items))

        ;; Need more series, so keep going
        (let* ((series-batch
                next-page-uri
                (request-patchwork-series patchwork-uri))

               (batch-hash-table
                (make-hash-table)))

          (vector-for-each
           (lambda (_ series-data)
             (let* ((patches
                     (assoc-ref series-data "patches"))
                    (issue-number
                     (if (= 0 (vector-length patches))
                         (let ((cover-letter
                                (assoc-ref series-data "cover_letter")))
                           (and cover-letter
                                (not (eq? 'null cover-letter))
                                (string->issue-number
                                 (assoc-ref cover-letter "name"))))
                         (string->issue-number
                          (assoc-ref
                           (vector-ref (assoc-ref series-data "patches")
                                       0)
                           "name")))))

               (when (and issue-number
                          (not (hash-ref issue-number-to-series-hash-table
                                         issue-number)))
                 (hash-set! issue-number-to-series-hash-table
                            issue-number
                            series-data)
                 (hash-set! batch-hash-table
                            issue-number
                            series-data))))
           series-batch)

          (let* ((series-by-issue-number
                  (hash-map->list
                   cons
                   batch-hash-table))

                 (mumi-data
                  (retry-on-error
                   (lambda ()
                     (call-with-delay-logging mumi-bulk-issues
                                              #:args
                                              (list
                                               (map first series-by-issue-number))))
                   #:times 1
                   #:delay 5)))

            (loop
             next-page-uri
             (fold
              (lambda (data mumi result)
                (let ((issue-number (car data)))
                  (if (and (assq-ref mumi 'open?)
                           (every
                            (lambda (merged-issue-number)
                              (if (< merged-issue-number
                                     issue-number)
                                  (not (hash-ref
                                        issue-number-to-series-hash-table
                                        merged-issue-number))
                                  #t))
                            (assq-ref mumi 'merged-with)))
                      (cons
                       `(,@data
                         (mumi . ,mumi))
                       result)
                      result)))
              result
              series-by-issue-number
              mumi-data)))))))