;;; Arl Standard Library - Assertion Helpers

(module assert
  (export assert assert-equal assert-true assert-false assert-eq
          assert-error assert-no-error)

  (import core :refer (error))
  (import equality :refer (equal? identical?))
  (import strings :refer (string-append ->string))
  (import list :refer (call))

;;' @section Assertion Helpers
;;' These functions provide test-style assertions that signal errors on failure
;;' and return `#t` on success.

  ;;' @description Assert condition or raise error.
  ;;' @param cond Condition to test
  ;;' @param msg Error message if assertion fails (default "Assertion failed")
  ;;' @noeval
  ;;' @examples
  ;;' (assert #t)               ; => #t
  ;;' (assert (> 3 2))          ; => #t
  ;;' (assert #f "must be true")  ; signals "must be true"
  ;;' (assert #f)               ; signals "Assertion failed"
  ;;' @assert
  ;;' (assert-true (assert #t))
  ;;' (assert-true (assert (> 3 2)))
  ;;' (assert-error (assert #f "must be true"))
  ;;' (assert-error (assert #f))
  ;;' @seealso error
  (define assert
    (lambda (cond (msg "Assertion failed"))
      (if cond
        #t
        (error msg))))

  ;;' @description Assert expected and actual are equal?.
  ;;' @param expected Expected value
  ;;' @param actual Actual value to compare
  ;;' @noeval
  ;;' @examples
  ;;' (assert-equal 3 (+ 1 2))  ; => #t
  ;;' (assert-equal "a" "a")    ; => #t
  ;;' (assert-equal 1 2)        ; signals error
  ;;' @assert
  ;;' (assert-true (assert-equal 3 (+ 1 2)))
  ;;' (assert-true (assert-equal "a" "a"))
  ;;' (assert-error (assert-equal 1 2))
  ;;' @seealso assert-eq, assert-true
  (define assert-equal
    (lambda (expected actual)
      (if (not (equal? expected actual))
        (begin
          (define error-msg (string-append "Expected: " (->string expected) ", Got: " (->string actual)))
          (error error-msg))
        #t)))

  ;;' @description Assert value is truthy.
  ;;' @param value Value expected to be truthy
  ;;' @noeval
  ;;' @examples
  ;;' (assert-true #t)          ; => #t
  ;;' (assert-true 1)           ; => #t
  ;;' (assert-true #f)          ; signals error
  ;;' @assert
  ;;' (assert-true (assert-true #t))
  ;;' (assert-true (assert-true 1))
  ;;' (assert-error (assert-true #f))
  ;;' @seealso assert-false, assert
  (define assert-true
    (lambda (value)
      (if (not value)
        (begin
          (define error-msg (string-append "Expected truthy value, got: " (->string value)))
          (error error-msg))
        #t)))

  ;;' @description Assert value is falsy.
  ;;' @param value Value expected to be falsy
  ;;' @noeval
  ;;' @examples
  ;;' (assert-false #f)         ; => #t
  ;;' (assert-false #nil)       ; => #t
  ;;' (assert-false #t)         ; signals error
  ;;' @assert
  ;;' (assert-true (assert-false #f))
  ;;' (assert-true (assert-false #nil))
  ;;' (assert-error (assert-false #t))
  ;;' @seealso assert-true, assert
  (define assert-false
    (lambda (value)
      (if value
        (begin
          (define error-msg (string-append "Expected falsy value, got: " (->string value)))
          (error error-msg))
        #t)))

  ;;' @description Assert expected and actual are identical (R's `identical()`).
  ;;' @param expected Expected value
  ;;' @param actual Actual value to compare with identical?
  ;;' @noeval
  ;;' @examples
  ;;' (assert-eq 42 42)          ; => #t
  ;;' (assert-eq "abc" "abc")    ; => #t
  ;;' (assert-eq 1 1L)           ; signals error (double vs integer)
  ;;' (assert-eq 1 "1")          ; signals error (different types)
  ;;' @assert
  ;;' (assert-true (assert-eq 42 42))
  ;;' (assert-true (assert-eq "abc" "abc"))
  ;;' (assert-error (assert-eq 1 "1"))
  ;;' @note Uses R's `identical()`, which checks exact structural identity including type. `1` (double) and `1L` (integer) are not identical. Use `assert-equal` for value comparison with `equal?`.
  ;;' @seealso assert-equal, assert
  (define assert-eq
    (lambda (expected actual)
      (if (not (identical? expected actual))
        (begin
          (define error-msg (string-append "Expected (identical?): " (->string expected) ", Got: " (->string actual)))
          (error error-msg))
        #t)))

  ;;' @description Assert expression throws an error.
  ;;' @param expr Expression expected to signal an error
  ;;' @noeval
  ;;' @examples
  ;;' (assert-error (error "boom"))   ; => #t
  ;;' (assert-error (stop "fail"))    ; => #t
  ;;' (assert-error 42)               ; signals error
  ;;' @assert
  ;;' (assert-true (assert-error (error "boom")))
  ;;' (assert-true (assert-error (stop "fail")))
  ;;' (assert-error (assert-error 42))
  ;;' @seealso assert, error
  (defmacro assert-error (expr)
    `(_assert-error-impl (lambda () ,expr)))

  ;; Internal function backing assert-error macro.
  (define _assert-error-impl
    (lambda (thunk)
      ;; Use a unique sentinel value to detect if error was caught
      (define error-caught (gensym "error-caught"))
      (define thunk-expr (call (list thunk)))
      (define result
        (r-eval (call (list 'tryCatch thunk-expr
                            :error (lambda (e) error-caught)))
                (current-env)))
      (if (not (identical? result error-caught))
        (error "Expected an error to be thrown, but none was")
        #t)))

  ;;' @description Assert expression does not throw an error.
  ;;' @param expr Expression expected to complete without error
  ;;' @noeval
  ;;' @examples
  ;;' (assert-no-error 42)                ; => #t
  ;;' (assert-no-error (+ 1 2))           ; => #t
  ;;' (assert-no-error (error "boom"))    ; signals error
  ;;' @assert
  ;;' (assert-true (assert-no-error 42))
  ;;' (assert-true (assert-no-error (+ 1 2)))
  ;;' (assert-error (assert-no-error (error "boom")))
  ;;' @seealso assert-error, assert
  (defmacro assert-no-error (expr)
    `(_assert-no-error-impl (lambda () ,expr)))

  ;; Internal function backing assert-no-error macro.
  (define _assert-no-error-impl
    (lambda (thunk)
      (define error-caught (gensym "error-caught"))
      (define thunk-expr (call (list thunk)))
      (define result
        (r-eval (call (list 'tryCatch thunk-expr
                            :error (lambda (e) error-caught)))
                (current-env)))
      (if (identical? result error-caught)
        (error "Expected no error to be thrown, but one was")
        #t)))
)
