#lang at-exp scheme/base
(require scribble/manual
         scribble/struct
         scribble/decode
         scheme/string)

(provide define-cite
         make-bib 
         proceedings-location journal-location book-location
         author-name authors editor)

(define-struct auto-bib (author date entry-element key))
(define-struct bib-group (ht))

(define-struct (author-element element) (names cite))
         
(define (add-cite group bib-entry which)
  (hash-set! (bib-group-ht group) bib-entry #t)
  (make-delayed-element
   (lambda (renderer part ri)
     (let ([s (resolve-get part ri `(,which ,(auto-bib-key bib-entry)))])
       (list (make-link-element #f (list s) `(autobib ,(auto-bib-key bib-entry))))))
   (lambda () "(???)")
   (lambda () "(???)")))

(define (add-cites group bib-entries)
  (make-element
   #f
   (list 'nbsp
         "("
         (let loop ([keys bib-entries])
           (if (null? (cdr keys))
               (add-cite group (car keys) 'autobib-cite)
               (make-element
                #f
                (list (loop (list (car keys)))
                      ", "
                      (loop (cdr keys))))))
         ")")))

(define (gen-bib tag group)
  (let* ([author<? (lambda (a b)
                     (string<? (author-element-names (auto-bib-author a))
                               (author-element-names (auto-bib-author b))))]
         [bibs (sort (hash-map (bib-group-ht group)
                               (lambda (k v) k))
                     author<?)])
    (make-unnumbered-part
     #f
     `((part ,tag))
     '("Bibliography")
     '()
     null
     (make-flow
      (list
       (make-table
        "SBibliography"
        (map (lambda (k)
               (list
                (make-flow
                 (list
                  (make-paragraph
                   (list
                    (make-collect-element
                     #f
                     (list (make-target-element
                            #f
                            (list (auto-bib-entry-element k))
                            `(autobib ,(auto-bib-key k))))
                     (lambda (ci)
                       (collect-put! ci 
                                     `(autobib-cite ,(auto-bib-key k))
                                     (make-element
                                      #f
                                      (list
                                       (author-element-cite (auto-bib-author k))
                                       " "
                                       (auto-bib-date k))))
                       (collect-put! ci 
                                     `(autobib-inline ,(auto-bib-key k))
                                     (make-element
                                      #f
                                      (list
                                       (author-element-cite (auto-bib-author k))
                                       'nbsp
                                       "("
                                       (auto-bib-date k)
                                       ")")))))))))))
             bibs))))
     null)))

(define-syntax-rule (define-cite ~cite citet generate-bibliography)
  (begin
    (define group (make-bib-group (make-hasheq)))
    (define (~cite bib-entry . bib-entries)
      (add-cites group (cons bib-entry bib-entries)))
    (define (citet bib-entry)
      (add-cite group bib-entry 'autobib-inline))
    (define (generate-bibliography #:tag [tag "doc-bibliography"])
      (gen-bib tag group))))

(define (make-bib #:title title	 	 	 	 
                  #:author [author #f]
                  #:is-book? [is-book? #f]
                  #:location [location #f]
                  #:date [date #f]
                  #:url [url #f])
  (let* ([author (if (author-element? author)
                     author
                     (parse-author author))]
         [elem (make-element
                "bibentry"
                (append
                 (if author `(,@(decode-content (list author)) ", ") null)
                 (if is-book? null '(ldquo))
                 (if is-book?
                     (list (italic title))
                     (decode-content (list title)))
                 (if location '(",") '("."))
                 (if is-book? null '(rdquo))
                 (if location
                     `(" " ,@(decode-content (list location)) ,(if date "," "."))
                     null)
                 (if date `(" " ,@(decode-content (list date)) ".") null)
                 (if url `(" " ,(link url (make-element "url" (list url)))) null)))])
    (make-auto-bib
     author
     date 
     elem
     (element->string elem))))

(define (parse-author a)
  (let* ([s (element->string a)]
         [m (regexp-match #rx"^(.*) ([A-Za-z]+)$" s)])
    (make-author-element
     #f
     (list a)
     (if m
         (string-append (caddr m) " " (cadr m))
         s)
     (if m
         (caddr m)
         s))))
    
(define (proceedings-location
         location
         #:pages [pages #f]
         #:series [series #f]
         #:volume [volume #f])
  (let* ([s @italic{@elem{Proc. @|location|}}]
         [s (if series
                @elem{@|s|, @|series|}
                s)]
         [s (if volume
                @elem{@|s| volume @|volume|}
                s)]
         [s (if pages
                @elem{@|s|, pp. @(car pages)--@(cadr pages)}
                s)])
    s))

(define (journal-location
         location
         #:pages [pages #f]
         #:number [number #f]
         #:volume [volume #f])
  (let* ([s @italic{@|location|}]
         [s (if volume
                @elem{@|s| @|volume|}
                s)]
         [s (if number
                @elem{@|s|(@|number|)}
                s)]
         [s (if pages
                @elem{@|s|, pp. @(car pages)--@(cadr pages)}
                s)])
    s))

(define (book-location
         #:edition [edition #f]
         #:publisher [publisher #f])
  (let* ([s (if edition
                @elem{@|edition| edition}
                #f)]
         [s (if publisher
                (if s
                   @elem{@|s|, @|publisher|}
                   publisher)
                s)])
    (unless s
      (error 'book-location "no arguments"))
    s))

;; ----------------------------------------

(define (author-name first last #:suffix [suffix #f])
  (make-author-element
   #f
   (list
    (format "~a ~a~a" first last (if suffix
                                     (format " ~a" suffix)
                                     "")))
   (format "~a ~a~a" last first (if suffix
                                    (format " ~a" suffix)
                                    ""))
   last))

(define (authors name . names)
  (let ([names (map parse-author (cons name names))])
    (make-author-element
     #f
     (let loop ([names names])
       (if (null? (cdr names))
           (list (car names))
           (append (loop (list (car names)))
                   (list (if (null? (cddr names))
                             ", and "
                             ", "))
                   (loop (cdr names)))))
     (string-join (map author-element-names names) " / ")
     (case (length names)
       [(1) (author-element-cite (car names))]
       [(2) (format "~a and ~a" 
                    (author-element-cite (car names))
                    (author-element-cite (cadr names)))]
       [else (format "~a et al." (author-element-cite (car names)))]))))

(define (editor name)
  (let ([name (parse-author name)])
    (make-author-element
     #f
     (append (element-content name)
             '(" (Ed.)"))
     (author-element-names name)
     (author-element-cite name))))