(define-module (guix-qa-frontpage patchwork patch-name)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-9 gnu)
  #:use-module (ice-9 match)
  #:use-module (ice-9 exceptions)
  #:export (<patch-name-metadata>
            make-patch-name-metadata
            patch-name-metadata?
            patch-name-metadata-bug-number
            patch-name-metadata-feature-branch
            patch-name-metadata-revision
            patch-name-metadata-index
            patch-name-metadata-total
            patch-name-metadata-set-index

            &patch-name-parser-error
            patch-name-parser-error?
            make-patch-name-parser-error

            parse-patch-name
            synthesize-patch-name
            ))

(define-record-type <patch-name-metadata>
  (make-patch-name-metadata bug-number feature-branch revision index total)
  patch-name-metadata?
  (bug-number patch-name-metadata-bug-number)
  (feature-branch patch-name-metadata-feature-branch)
  (revision patch-name-metadata-revision)
  (index patch-name-metadata-index)
  (total patch-name-metadata-total))

(define (patch-name-metadata-set-index meta index)
  (match meta
    (($ <patch-name-metadata> bug branch rev _ total)
     (make-patch-name-metadata bug branch rev index total))))

(set-record-type-printer!
 <patch-name-metadata>
 (lambda (record port)
   (match record
     (($ <patch-name-metadata> bug feature revision index total)
      (format port
              "#<<patch-name-metadata> \
bug-number=~s feature-branch=~s revision=~s \
index=~s total=~s>"
              bug feature revision index total)))))

(define-exception-type &patch-name-parser-error
  &error
  make-patch-name-parser-error
  patch-name-parser-error?)

(define (parse-patch-name name)
  "Given a patch @var{name} obtained from Patchwork, infer the metadata
from its name."
  (define (raise-error message)
    (raise-exception
     (make-exception
      (make-error)
      (make-patch-name-parser-error)
      (make-exception-with-message message)
      (make-exception-with-irritants (list name))
      (make-exception-with-origin 'parse-patch-name))))
  (define (as-bug-number arg)
    (and (string-prefix? "bug#" arg)
         (string->number (substring arg (string-length "bug#")))))
  (define (as-revision arg)
    (and (string-prefix? "v" arg)
         (string->number (substring arg 1))))
  (define (as-patch-number arg)
    (match (string-split arg #\/)
      (((= string->number index) (= string->number total))
       (and index total (<= index total)
            (cons index total)))
      (else #f)))
  (unless (string-prefix? "[" name)
    (raise-error "the patch name does not start with '['"))
  (let ((stop (string-index name #\])))
    (unless stop
      (raise-error "the patch name does not contain ']'"))
    (let ((args (substring name 1 stop)))
      (let analyze ((bug-number #f)
                    (branch "master")
                    (revision 1)
                    (index 1)
                    (total 1)
                    (arguments
                     (string-split args #\,)))
      (match arguments
        ((or ("") ())
         (begin
           (unless bug-number
             (raise-error "the patch name does not have a bug number"))
           (make-patch-name-metadata bug-number branch revision index total)))
        (((= as-bug-number (? number? new-bug-number))
          arguments ...)
         (analyze new-bug-number branch revision index total arguments))
        (((= as-revision (? number? new-revision))
          arguments ...)
         (analyze bug-number branch new-revision index total arguments))
        (((= as-patch-number ((? number? new-index) . (? number? new-total)))
          arguments ...)
         (analyze bug-number branch revision new-index new-total arguments))
        ((feature-branch arguments ...)
         (analyze bug-number feature-branch revision index total arguments)))))))


(define (synthesize-patch-name meta name)
  "Prepend @samp{[bug#nnn,branch,v1,1/1]} to the @var{name}."
  (match meta
    (($ <patch-name-metadata>
        bug-number feature-branch revision
        index total)
     (format #f "[bug#~a,~a,v~a,~a/~a] ~a"
             bug-number feature-branch revision
             index total name))))