;; Work through the examples in the Gruber Markdown spec.
;; https://daringfireball.net/projects/markdown/syntax
;;
;; Read in markdown files gruber-*.md, which are derived from the spec,
;; but which have tests embedded within them.
;;
;; This is intended to stimulate other tests, rather than be a good
;; source of tests itself, partly because the 'spec' is frequently
;; rather vague, so it's not always completely clear just what
;; constitutes 'correct'.  Thus most of the tests here are redundant
;; with the tests in test-markdown.scm.
;;
;; The input files are Gruber's text, with test blocks in
;;
;;    ??label
;;    blah blah
;;
;;        =>
;;        (...)
;;
;; The result must be indented four spaces, and preceded by `=>`
;;
;; If a line is instead started with `?Xlabel`, then it is skipped as
;; a known-bad test, and a message is output.
;;
;; 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

(module "s7unit.scm" 'markdown)

;(print-warning 'push #f)

;; return #t if actual and expected are equal?
;; return #f, with a message, otherwise
(define (inc x)
  (+ x 1))

(define (extract-test-cases fn)
  (with-input-from-file fn
    (λ ()
      (let loop ((line (read-line))
                 (test-input #f)
                 (label #f)
                 (tests '())
                 (line-number 1))
        ;(eprintf "loop: line=~s  test-input=~s  label=~s  tests=~s~%" line test-input label tests)
        (cond ((eof-object? line)
               `(test-suite ,fn . ,(reverse tests)))
              ((string-prefix? "??" line)
               (let ((label (substring line 2)))
                 (loop (read-line)
                       '()
                       (if (string=? label "")
                           (sprintf "line-~a" line-number)
                           label)
                       tests
                       (inc line-number))))
              ((string-prefix? "?X" line)
               (eprintf "  (Skipping known-bad test in ~a: ~a)~%" fn (substring line 2))
               (loop (read-line) 'skipped #f tests (inc line-number)))
              ((string=? line "    =>")
               (cond ((not test-input)
                      (eprintf "Warning: expected marker on line ~a without corresponding starter~%"
                               line-number)
                      (loop (read-line) #f #f tests (inc line-number)))
                     ((eqv? test-input 'skipped)
                      ;; ignore this
                      (loop (read-line) #f #f tests (inc line-number)))
                     ((list? test-input)
                      (let ((expected (read)))
                        (loop (read-line) #f #f
                              (cons `(assert-equal
                                      ,label
                                      (parse-markdown-string
                                       ,(string-join (reverse test-input) "\n"))
                                      (quote ,expected))
                                    tests)
                              (inc line-number))))
                     (else
                      (print-warning "Mangled testcase (test-input=~s) skipping" test-input)
                      (loop (read-line) #f #f tests (inc line-number)))))
              (test-input               ;accumulating input
               (loop (read-line)
                     (if (list? test-input)
                         (cons line test-input)
                         test-input)
                     label tests (inc line-number)))
              (else ;; discard this line
               (loop (read-line) test-input label tests (inc line-number))))))))

(define (is-gruber-test-file? fn)
  (and (string-prefix? "gruber-" fn)
       (string-suffix? ".md" fn)))
(for-each (λ (fn)
            (let ((testcases (extract-test-cases fn)))
                                        ;(printf "from file ~a~%~s~%" fn testcases)
              (eval testcases)))
          (sort!
           (filter is-gruber-test-file? (directory->list "."))
           string<?))
#;(catch #t
  (λ ()
    (define (is-gruber-test-file? fn)
      (and (string-prefix? "gruber-" fn)
           (string-suffix? ".md" fn)))
    (for-each (λ (fn)
                (let ((testcases (extract-test-cases fn)))
                  ;(printf "from file ~a~%~s~%" fn testcases)
                  (eval testcases)))
              (sort!
               (filter is-gruber-test-file? (directory->list "."))
               string<?)))
  (λ (tag fmt . rest)
    ;(eprintf "tag=~s  fmt=~s  rest=~s~%" tag fmt rest)
    ;(eprintf "apply: ~s~%" (apply format #f fmt))
    (let ((msg ((apply format #f fmt))))
      (format (current-error-port) "Unexpected error (~a) processing md file: ~a~%~a~%"
              tag msg (stacktrace)))
    #f))

;; An alternative, which doesn't use test-suite
;; (the above is probably better, but this shows a way of
;; repurposing the functionality in s7unit.scm
;;
;; (define (test-equal-md label actual expected)
;;   (print-info "equal? ~s" label)
;;   (let ((ok? (equal? actual expected)))
;;     (unless ok?
;;       (format #t "  ~a\t-> ~a~%  ~a:   ~s~%  ~a: ~s~%"
;;               label
;;               (red-text "failed")
;;               (red-text "actual") actual
;;               (green-text "expected") expected)
;;       (when (and (list? actual) (list? expected))
;;         (format #t "Difference:~%~s~%" (list-first-diff actual expected))))
;;     ok?))
;;
;; (define (read-test-file fn)
;;   (with-input-from-file fn
;;     (λ ()
;;       (let loop ((line (read-line))
;;                  (test-input #f)
;;                  (label #f)
;;                  (ngood 0)
;;                  (nbad 0))
;;         (cond ((eof-object? line)
;;                (signal-failures nbad)
;;                (list fn ngood nbad))
;;               ((string-prefix? "??" line)
;;                (let ((label (string-trim (substring line 2))))
;;                  (loop (read-line) '()
;;                        (if (string=? label "")
;;                            (sprintf "test ~a" fn (+ ngood nbad 1))
;;                            label)
;;                        ngood nbad)))
;;               ((string=? line "    =>")
;;                (let ((expected (read))
;;                      (actual (parse-markdown-string (string-join (reverse test-input) "\n"))))
;;                  (if (assert-equal* fn label (λ () #t) report-failure actual expected)
;;                      (loop (read-line) #f #f (inc ngood) nbad)
;;                      (loop (read-line) #f #f ngood (inc nbad)))))
;;               (test-input
;;                (loop (read-line) (cons line test-input) label ngood nbad))
;;               (else ;; discard this line
;;                (loop (read-line) test-input label ngood nbad)))))))

;; (let ((results (map read-test-file (cdr *command-line*))))
;;   (eprintf "~s~%" results))

(exit/failures)