(define-library (tap srfi 64)
  (import (r7rs)
          (chicken base)
          (srfi 1)
          (srfi 64)
          (srfi 152)
          (srfi 197))
  (export tap-test-runner)
  (begin

    (define (test-name runner)
      (string-append
       (string-join (test-runner-group-path runner) " - ")
       ;; " - " (test-runner-test-name runner)
       ))

    (define (al-ref alist key)
      (chain (let ((al-var (assq key alist)))
               (if al-var
                   (cdr al-var)
                   "#f"))
             (string-split _ "\n")
             (string-join _ "\n      ")))

    (define (tap-test-runner)
      (let ((runner (test-runner-null))
            (testcounter 0))
        (print "TAP version 14\n")
        (test-runner-on-test-end! runner
          (lambda (runner)
            (set! testcounter (+ testcounter 1))
            (let ((result (test-result-alist runner)))
              (case (cdr (assq 'result-kind result))
                ('pass (print
                        (string-append
                         "ok " (number->string testcounter) " - "
                         (test-name runner))))
                ('fail (print
                        (string-append
                         "not ok " (number->string testcounter) " - "
                         (test-name runner) "\n"
                         "  ---\n"
                         "  message: The test failed, but was expected to pass. \n"
                         "  severity: fail\n"
                         "  data:\n"
                         "    got: |\n      "
                         (al-ref result 'actual-value) "\n"
                         "    expect: |\n      "
                         (al-ref result 'expected-value) "\n"
                         "  at:\n"
                         "    file: " (al-ref result 'source-file) "\n"
                         "    line: " (al-ref result 'source-line) "\n"
                         "  ...")))
                ('xfail (print
                         (string-append
                          "ok " (number->string testcounter) " - "
                          (test-name runner))))
                ('xpass (print
                         (string-append
                          "not ok " (number->string testcounter) " - "
                          (test-name runner) "\n"
                          "  ---\n"
                          "  message: The test passed, but was expected to fail. \n"
                          "  severity: fail\n"
                          "  data:\n"
                          "    got: |\n      "
                          (al-ref result 'actual-error) "\n"
                          "    expect: |\n      "
                          (al-ref result 'expected-error) "\n"
                          "  at:\n"
                          "    file: " (al-ref result 'source-file) "\n"
                          "    line: " (al-ref result 'source-line) "\n"
                          "  ...\n")))
                ('skip (print
                        (string-append
                         "ok " (number->string testcounter) " - "
                         (test-name runner) " # SKIP")))))))
        (test-runner-on-final! runner
          (lambda (runner)
            (print (string-append "1.." (number->string testcounter) "\n"))))
        runner))

    ))