;; This performs the tests on files set up by the Makefile.
;; The makefile (qv) should have generated "build/bibdemo.xexpr" and "build/extract.bib"
;;
;; This file is part of Beastie <https://purl.org/nxg/dist/beastie>
;; SPDX-FileCopyrightText: 2024 Norman Gray <https://nxg.me.uk>
;; SPDX-License-Identifier: BSD-2-Clause

;; The scripts in this directory are supposed to be illustrative of
;; what beastie can do.
;;
;; The main thing about the tests in this directory is to confirm that
;; the scripts run without throwing errors.  There are a few tests of
;; functionality below, but these are basic sanity checks that the
;; scripts _probably_ produced the expected output, rather than tests
;; that exercise beastie itself.

(module 'xexpr 'bibtex)

(test-suite
 "bibdemo"
 (let ((bibdemo
        ;; build/bibdemo.xexpr is the output after converting bibdemo.md to xexpr
        (with-input-from-file "build/bibdemo.xexpr"
          (λ ()                    ; read in all xexprs to a (div ...)
            (let loop ((expr (read))
                       (res '()))
              (if (eof-object? expr)
                  (cons 'div (reverse res))
                  (loop (read) (cons expr res))))))))
   (assert-equal (xexpr-path-search '(cite) bibdemo)
                 '((cite (a ((href "#t1-1")) "{Author} and Last (1999)"))
                   (cite (a ((href "#T1-2:UPPERCASE")) "Author (January 2000)"))))
   (assert-equal (xexpr-path-search '(li a) bibdemo)
                 '((a ((name #"t1-1")) #"Author, Sample and First Last")
                   (a ((name #"T1-2:UPPERCASE")) #"Author, Another"))))
 ;; we don't do any tests on build/bibdemo-alt.xhtml

 ;; basic sanity-check test
 (let* ((bib (parse-bibtex-file "build/extract.bib"))
        (e0 (bib 't1-1)))
   (assert-equal (entry-type e0) 'article)
   (assert-equal (entry-key e0) 't1-1)
     (assert-equal (entry-field e0 'uri2) #"http://example.org/%31")))

(define (grep file re)
  (with-input-from-file file
    (λ ()
      (let loop ((res '()))
        (let ((l (read-line)))
          (cond ((eof-object? l) res)
                ((regexp-match re l)
                 => (λ (m)
                      (loop (cons (cadr m) res))))
                (else
                 (loop res))))))))

;; The following depends on build/extract.{yaml,crossref} and build/extract2.bbl existing.
;; If there is no bibtex binary, then the makefile writes
;; "\bibitem{nobibtex}" to build/extract2.bbl, as a flag to this test program.
(test-suite
 "extractions"
 (let ((keys-from-yaml (regexp "^-[^:]*: *(.*)"))
       (keys-from-bbl  (regexp "^\\\\bibitem\\{([^}]*)\\}"))
       (keys-from-xref (regexp "key=\"([^\"]*)"))) ;yuk!
   (let ((yaml-keys (sort! (grep "build/extract.yaml" keys-from-yaml) string<?))
         (bbl-keys  (sort! (grep "build/extract2.bbl" keys-from-bbl) string<?))
         (xref-keys (sort! (grep "build/extract.crossref" keys-from-xref) string<?)))
     (if (string=? (car bbl-keys) "nobibtex")
         (begin
           (eprintf "  (No bibtex binary: yaml/bbl test skipped)~%")
           (assert-true #t))            ;so we count 1
         (assert-equal yaml-keys bbl-keys))
     (assert-equal yaml-keys xref-keys)))

 ;; Find the line "- Charles Louis...",
 ;; and confirm this has no-break spaces, rather than ~ ties.
 ;;
 ;; Yes, this is very crude.
 (let ((charles (regexp "- (Charles.*)")))
   (let ((charles-line
          (with-input-from-file "build/extract.yaml"
            (λ ()
              (let loop ()
                (let ((line (read-line)))
                  (cond ((eof-object? line) #f)
                        ((regexp-match charles line)
                         => cadr)
                        (else (loop)))))))))
     (assert-equal charles-line "Charles Louis Xavier Joseph de la Vallée Poussin")))
 ;; No: the following is pointlessly complicated: the following isn't
 ;; far off a YAML reader, but it can't deal with multi-line strings,
 ;; and I really must resist the urge to do this properly.  YAML – ugh.
 #;(define (read-yaml fn)
   (let ((key-line  (regexp "^- *([^:]+): *(.*)"))
         (key+sym   (regexp "^ +([^:]+): *([^\"]+)$"))
         (key+str   (regexp "^ +([^:]+): *\"([^\"]+)\"$"))
         (key+list  (regexp "^ +([^:]+): *"))
         (list-item (regexp "^ +([^:]+)$")))
     (with-input-from-file fn
       (λ ()
         (let loop ((result '())
                    (current-item '())
                    (sublist '()))
           (let ((line (read-line)))
             (cond ((eof-object? line)
                    (cons current-item result))
                   ((regexp-match key-line line)
                    => (λ (m)
                         (if (null? current-item)
                             (loop result
                                   (list (cons (car m) (cadr m)))
                                   '())
                             (loop (cons current-item result)
                                   (list (cons (string->symbol (car m))
                                               (string->symbol (cadr m))))
                                   '()))))
                   ((regexp-match key+sym line)
                    => (λ (m)
                         (loop result
                               (cons (cons (string->symbol (car m))
                                           (string->symbol (cadr m)))
                                     current-item)
                               '())))
                   ((regexp-match key+str line)
                    => (λ (m)
                         (loop result
                               (cons (cons (string->symbol (car m))
                                           (cadr m))
                                     current-item)
                               '())))
                   ((regexp-match key+list line)
                    => (λ (m)
                         (loop result current-item (list (string->symbol (car m))))))
                   ((regexp-match list-item line)
                    => (λ (m)
                         (loop result current-item (cons (car m) sublist))))
                   (else
                    (eprintf "unexpected line reading YAML: ~s~%" line))))))))))

(test-suite
 "plain.scm"
 (let ((doi "10.1234/5678")
       (doi-url "http://dx.doi.org/10.1234/5678")
       (url "http://example.org"))
   (load "plain.scm")
   (assert-equal `(li ,@(format-links #f #f))
                 '(li))
   (assert-equal `(li ,@(format-links doi #f))
                 '(li (span "DOI" nbsp
                            (a ((href "https://doi.org/10.1234/5678")) "10.1234/5678"))
                      ". "))
   (assert-equal `(li ,@(format-links #f url))
                 '(li (span "URL" nbsp
                            (a ((href "http://example.org")) (code "http://example.org")))
                      ". "))
   (assert-equal `(li ,@(format-links doi-url url))
                 '(li (span "DOI" nbsp
                            (a ((href "https://doi.org/10.1234/5678")) "10.1234/5678"))
                      ", "
                      (span "URL" nbsp
                            (a ((href "http://example.org")) (code "http://example.org")))
                      ". "))
   ;; Same again, but with :prefer-doi?
   ;; The first three should have the same result as above
   (assert-equal `(li ,@(format-links #f #f :prefer-doi? #t))
                 '(li))
   (assert-equal `(li ,@(format-links doi #f :prefer-doi? #t))
                 '(li (span "DOI" nbsp
                            (a ((href "https://doi.org/10.1234/5678")) "10.1234/5678"))
                      ". "))
   (assert-equal `(li ,@(format-links #f url :prefer-doi? #t))
                 '(li (span "URL" nbsp
                            (a ((href "http://example.org")) (code "http://example.org")))
                      ". "))
   ;; But the last should suppress the URL
   (assert-equal `(li ,@(format-links doi-url url :prefer-doi? #t))
                 '(li (span "DOI" nbsp
                            (a ((href "https://doi.org/10.1234/5678")) "10.1234/5678"))
                      ". "))))