#lang racket/base

(require racket/file
         racket/format
         racket/list
         racket/port
         racket/runtime-path
         racket/string)

(provide check-true
         check-equal
         check-matches
         check-not-matches
         check-contains
         check-not-contains
         check-public-api
         run-js-if-available
         note-dropped
         test-summary)

(define checks-run 0)
(define checks-skipped 0)

(define (bump!) (set! checks-run (add1 checks-run)))
(define (skip!) (set! checks-skipped (add1 checks-skipped)))

(define (fail name fmt . args)
  (error name (apply format fmt args)))

(define (check-true name value)
  (bump!)
  (unless value (fail name "check failed")))

(define (check-equal name actual expected)
  (bump!)
  (unless (equal? actual expected)
    (fail name "expected ~s, got ~s" expected actual)))

(define (check-matches name rx text)
  (bump!)
  (unless (regexp-match? rx text)
    (fail name "expected generated text to match ~s, got:\n~a" rx text)))

(define (check-not-matches name rx text)
  (bump!)
  (when (regexp-match? rx text)
    (fail name "expected generated text not to match ~s, got:\n~a" rx text)))

(define (check-contains name needle text)
  (bump!)
  (unless (string-contains? text needle)
    (fail name "expected generated text to contain ~s, got:\n~a" needle text)))

(define (check-not-contains name needle text)
  (bump!)
  (when (string-contains? text needle)
    (fail name "expected generated text not to contain ~s, got:\n~a" needle text)))

(define-runtime-path main-path "../main.rkt")

(define (all-symbols v)
  (cond [(symbol? v) (list v)]
        [(pair? v) (append (all-symbols (car v)) (all-symbols (cdr v)))]
        [else null]))

(define (check-public-api)
  (define mp `(file ,(path->string main-path)))
  (dynamic-require mp #f)
  (define-values (value-exports syntax-exports) (module->exports mp))
  (define exports (remove-duplicates (append (all-symbols value-exports)
                                             (all-symbols syntax-exports))))
  (check-true 'public-api-js (memq 'js exports))
  (check-true 'public-api-no-js1 (not (memq 'js1 exports)))
  (check-true 'public-api-no-js-ref (not (memq 'js-ref exports)))
  (check-true 'public-api-no-js/expression (not (memq 'js/expression exports))))

(define (candidate-node)
  (define env-node (getenv "JSMAKER_NODE"))
  (cond [(and env-node (not (string=? env-node ""))) env-node]
        [else (find-executable-path "node")]))

(define (subprocess-output executable file)
  (define-values (proc stdout stdin stderr)
    (subprocess #f #f #f executable file))
  (close-output-port stdin)
  (define out (port->string stdout))
  (define err (port->string stderr))
  (subprocess-wait proc)
  (values (subprocess-status proc) out err))

(define (run-js-if-available name program expected-stdout)
  (define node (candidate-node))
  (cond
    [node
     (bump!)
     (define file (make-temporary-file "jsmaker-~a.js"))
     (call-with-output-file file #:exists 'replace
       (lambda (out) (display program out)))
     (define-values (status stdout stderr) (subprocess-output node file))
     (delete-file file)
     (unless (and (zero? status) (string=? (string-trim stdout) expected-stdout))
       (fail name "JavaScript execution failed; status=~a stdout=~s stderr=~s program:\n~a"
             status stdout stderr program))]
    [else
     (skip!)
     (printf "NOTE: ~a skipped because node was not found.\n" name)]))

(define (note-dropped topic reason)
  (printf "NOTE: dropped old ~a tests: ~a\n" topic reason))

(define (test-summary who)
  (printf "~a: ~a checks passed" who checks-run)
  (unless (zero? checks-skipped)
    (printf ", ~a JavaScript execution checks skipped" checks-skipped))
  (newline))