(define-module (guix-qa-frontpage patchwork patch)
  #:use-module (guix-qa-frontpage patchwork patch-name)
  #:use-module (srfi srfi-9)
  #:use-module (ice-9 exceptions)
  #:use-module (ice-9 match)
  #:use-module (web uri)
  #:export (<patch>
            patch?
            make-patch
            patch-index
            patch-name
            patch-mbox
            patch-set-name
            patch-name-metadata
            patch-set-name-metadata

            &invalid-patch-json
            invalid-patch-json?
            make-invalid-patch-json

            scm->patch
            patch->scm))

(define-record-type <patch>
  (make-patch id index name mbox)
  patch?
  (id      patch-id)
  (index   patch-index)
  (name    patch-name)
  (mbox    patch-mbox))

(define (patch-set-name patch new-name)
  (match patch
    (($ <patch> id index _ mbox)
     (make-patch id index new-name mbox))))

(define (patch-set-name-metadata patch meta)
  "Synthesize a new patch name with all the relevant information."
  (patch-set-name
   patch
   (synthesize-patch-name meta (patch-name patch))))

(define-exception-type &invalid-patch-json
  &error
  make-invalid-patch-json
  invalid-patch-json?)

(define (patch-name-metadata patch)
  (with-exception-handler
      (lambda (exn)
        (raise-exception
         (make-exception
          (make-exception-with-message
           "while parsing patch name metadata")
          (make-exception-with-origin 'patch-name-metadata)
          (make-exception-with-irritants (list patch))
          exn)))
    (lambda ()
      (parse-patch-name (patch-name patch)))))

(define (scm->patch json-data)
  "Get a patch series item from patchwork as JSON."
  (let ((id (assoc-ref json-data "id"))
        (name (assoc-ref json-data "name"))
        (mbox (assoc-ref json-data "mbox")))
    (with-exception-handler
        (lambda (exn)
          (raise-exception
           (make-exception
            (make-invalid-patch-json)
            (make-exception-with-message "while converting JSON data to a patch")
            (make-exception-with-origin 'scm->patch)
            (make-exception-with-irritants (list json-data))
            exn)))
      (lambda ()
        (unless (and (integer? id) (>= id 0))
          (error "the patch does not have an ID or it is not an integer"))
        (unless (string? name)
          (error "the patch name is missing or not a string"))
        (unless (and (string? mbox) (string->uri mbox))
          (error "the patch mbox is not an URI"))
        (let ((metadata (parse-patch-name name)))
          (make-patch id
                      (patch-name-metadata-index metadata)
                      name
                      (string->uri mbox)))))))

(define (patch->scm patch)
  "Convert a patch back to a JSON sexp, so that it can be cached in
 database."
  `(("id" . ,(patch-id patch))
    ("name" . ,(patch-name patch))
    ("mbox" . ,(uri->string (patch-mbox patch)))))