citeproc-test-human.el

;; citeproc-test-human.el --- support tests in CSL suite format -*- lexical-binding: t; -*-

;; Copyright (C) 2017-2021 András Simonyi

;; Author: András Simonyi <andras.simonyi@gmail.com>

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;; This file is not part of GNU Emacs.

;;; Commentary:

;; Functions to create ERT tests from tests in CSL test suite format. The
;; official tests can be found at
;; <https://github.com/citation-style-language/test-suite>.

;;; Code:

(require 'f)
(require 's)
(require 'json)
(require 'ert)
(require 'string-inflection)

(require 'citeproc)

(defvar citeproc-test-human--locale-dir "./test/locales")

(defun citeproc-test-human--parse-testfile (file)
  "Return a parsed form of CSL test FILE."
  (let (result
	(json-array-type 'list)
	(json-key-type 'symbol))
    (with-temp-buffer
      (insert-file-contents file)
      (goto-char 1)
      (setq result (list (cons 'YEAR-SUFF
			       (re-search-forward "variable=\"year-suffix\"" nil t))))
      (goto-char 1)
      (while (re-search-forward ">>=+ \\{1,2\\}\\([[:graph:]]+\\) =+>>" nil t)
	(let ((section (intern (buffer-substring (nth 2 (match-data))
						 (nth 3 (match-data)))))
	      (start (1+ (point)))
	      end)
	  (re-search-forward "<<=" nil t)
	  (setq end (- (car (match-data)) 1))
	  (push (cons section (pcase section
				('OUTPUT-FORMAT
				 (intern (buffer-substring-no-properties start end)))
				('CSL (buffer-substring-no-properties start end))
				((or 'INPUT 'CITATIONS 'CITATION-ITEMS)
				 (goto-char (- start 1)) (json-read))
				(_ (buffer-substring start end))))
		result))))
    result))

(defun citeproc-test-human--create-getter (items)
  "Return a getter function for ITEMS.
ITEMS is the parsed representation of the `INPUT' section of a
CSL test."
  (lambda (itemids)
    (let (result)
     (dolist (item items result)
       (let ((id (citeproc-s-from-num-or-s (alist-get 'id item))))
	 (when (member id itemids)
	   (push (cons id item) result)))))))

(defun citeproc-test-human--proc-from-style (style parsed-input)
  "Create a processor from STYLE and PARSED-INPUT."
  (citeproc-create style
		   (citeproc-test-human--create-getter parsed-input)
		   (citeproc-locale-getter-from-dir citeproc-test-human--locale-dir)))

(defun citeproc-test-human--proc-from-testfile (file)
  "Create an (itemless) processor from a test FILE."
  (let ((style-string (alist-get 'CSL (citeproc-test-human--parse-testfile file)))
	(locale-getter (citeproc-locale-getter-from-dir citeproc-test-human--locale-dir)))
    (citeproc-create style-string nil locale-getter)))

(defun citeproc-test-human--parse-citation (ct-desc &optional cites-only)
  "Parse test citations description CT-DESC.
Return a list of citation structures. If CITES-ONLY is non-nil
then the input is list of cites."
  (if cites-only
      (citeproc-citation-create
       :cites (-map #'citeproc-test-human--normalize-cite ct-desc))
    (let ((citation-info (car ct-desc)))
      (let-alist (alist-get 'properties citation-info)
	(citeproc-citation-create
	 :cites (-map #'citeproc-test-human--normalize-cite
		      (alist-get 'citationItems citation-info))
	 :note-index .noteIndex
	 :mode (citeproc-lib-intern .mode)
	 :capitalize-first .capitalize-first
	 :suppress-affixes .suppress-affixes
	 :ignore-et-al .ignore-et-al)))))

(defun citeproc-test-human--normalize-cite (cite)
  "Normalize a test CITE."
  (--map (let ((val (cdr it)))
	   (if (numberp val) (cons (car it) (number-to-string val)) it))
	 cite))

(defun citeproc-test-human--run-parsed (parsed)
  "Run the parsed CSL test PARSED.
Return the resulting output."
  (-let* (((&alist 'CSL style
		   'INPUT input
		   'MODE mode
		   'CITATION-ITEMS citation-items
		   'CITATIONS citations
		   'OUTPUT-FORMAT output-format)
	   parsed)
	  (output-format (or output-format 'csl-test))
	  (proc (citeproc-test-human--proc-from-style style input)))
    (--each input
      (citeproc-proc-put-item-by-id proc
				    (citeproc-s-from-num-or-s (alist-get 'id it))))
    (when (string= mode "citation")
      (cond
       (citation-items
	(citeproc-append-citations (--map (citeproc-test-human--parse-citation it t)
					  citation-items)
				   proc))
       (citations
	(citeproc-append-citations (mapcar #'citeproc-test-human--parse-citation citations)
				   proc))
       (t (citeproc-append-citations (list (citeproc-test-human--parse-citation input t))
				     proc))))
    (let ((output (if (string= mode "citation")
		      (citeproc-render-citations proc output-format
						 (when (eq 'csl-test output-format)
						   'no-links))
		    (car (citeproc-render-bib proc output-format 'no-links)))))
      (if (string= mode "citation") (s-join "\n" output) output))))

(defun citeproc-test-human--expected-from-parsed (parsed)
  "Return the expected output of parsed CSL test PARSED."
  (let ((expected (alist-get 'RESULT parsed)))
    (if (or (string= (s-left 5 expected) "..[0]")
	    (string= (s-left 5 expected) ">>[0]"))
	(s-join "\n" (--map (substring it 6)
			    (split-string expected "\n")))
      expected)))

(defun citeproc-test-human-create-from-file (file expected-fails &optional name-prefix)
  "Create an ERT test from a CSL test FILE.
If optional NAME-PREFIX is non-nil then it is added the name of
the created test after the obligatory `citeproc'."
  (let* ((parsed (citeproc-test-human--parse-testfile file))
	 (expected (citeproc-test-human--expected-from-parsed parsed))
	 (file-name (f-filename file))
	 (test-name (intern
		     (concat "citeproc-"
			     (if name-prefix  (concat name-prefix "-") "")
			     (string-inflection-kebab-case-function
			      (substring file-name 0 -4)))))
	 (expected-fail (memq test-name expected-fails)))
    (eval `(ert-deftest ,test-name ()
	     :expected-result ,(if expected-fail :failed :passed)
	     (let ((citeproc-disambiguation-cite-pos 'subsequent))
	       (should (string=
			,expected
			(citeproc-test-human--run-parsed ',parsed))))))))

(defun citeproc-test-human---read-expected-fails (expected-fails-file)
  "Read the list of tests expected to fail from EXPECTED-FAILS-FILE."
  (let* ((list-as-str (with-temp-buffer
			(insert-file-contents expected-fails-file)
			(buffer-string)))
	 (split (split-string list-as-str "\n")))
    (--map (intern it) (butlast split))))

(defun citeproc-test-human-create-from-dir (dir &optional
						expected-fails-file name-prefix)
  "Create all CSL tests from DIR.
Each file in DIR having the `txt' extension is read as a
human-readable CSL test, and a corresponding ERT test is created.
The created test's name will be constructed by prefixing the
test's filename (without the extension) with `citeproc-'. If the
optional EXPECTED-FAILS-FILE is non-nil then read that file as a
list of tests whose failure is expected. If optional NAME-PREFIX
is non-nil then it is added the names of the created tests after
the obligatory `citeproc'. The file should contain one test-name
per line (together with the `citeproc-' prefix)."
  (let ((expected-fails
	 (if expected-fails-file
	     (citeproc-test-human---read-expected-fails expected-fails-file)
	   nil)))
    (dolist (test-file (f-glob (concat dir "/*.txt")))
      (citeproc-test-human-create-from-file test-file expected-fails
					    name-prefix))))

(provide 'citeproc-test-human)

;;; citeproc-test-human.el ends here