;; lib/prolog/tests/char_predicates.sx — char_type/2, upcase_atom/2, downcase_atom/2,
;;   string_upper/2, string_lower/2

(define pl-cp-test-count 0)
(define pl-cp-test-pass 0)
(define pl-cp-test-fail 0)
(define pl-cp-test-failures (list))

(define
  pl-cp-test!
  (fn
    (name got expected)
    (begin
      (set! pl-cp-test-count (+ pl-cp-test-count 1))
      (if
        (= got expected)
        (set! pl-cp-test-pass (+ pl-cp-test-pass 1))
        (begin
          (set! pl-cp-test-fail (+ pl-cp-test-fail 1))
          (append!
            pl-cp-test-failures
            (str name "\n    expected: " expected "\n    got:      " got)))))))

(define
  pl-cp-goal
  (fn
    (src env)
    (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))

(define pl-cp-db (pl-mk-db))

;; ─── char_type/2 — alpha ──────────────────────────────────────────

(pl-cp-test!
  "char_type(a, alpha) succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type(a, alpha)" {})
    (pl-mk-trail))
  true)

(pl-cp-test!
  "char_type('1', alpha) fails"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type('1', alpha)" {})
    (pl-mk-trail))
  false)

(pl-cp-test!
  "char_type('A', alpha) succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type('A', alpha)" {})
    (pl-mk-trail))
  true)

;; ─── char_type/2 — alnum ─────────────────────────────────────────

(pl-cp-test!
  "char_type('5', alnum) succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type('5', alnum)" {})
    (pl-mk-trail))
  true)

(pl-cp-test!
  "char_type(a, alnum) succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type(a, alnum)" {})
    (pl-mk-trail))
  true)

(pl-cp-test!
  "char_type(' ', alnum) fails"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type(' ', alnum)" {})
    (pl-mk-trail))
  false)

;; ─── char_type/2 — digit ─────────────────────────────────────────

(pl-cp-test!
  "char_type('5', digit) succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type('5', digit)" {})
    (pl-mk-trail))
  true)

(pl-cp-test!
  "char_type(a, digit) fails"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type(a, digit)" {})
    (pl-mk-trail))
  false)

;; ─── char_type/2 — digit(Weight) ─────────────────────────────────

(define pl-cp-env-dw {})
(pl-solve-once!
  pl-cp-db
  (pl-cp-goal "char_type('5', digit(N))" pl-cp-env-dw)
  (pl-mk-trail))
(pl-cp-test!
  "char_type('5', digit(N)) -> N=5"
  (pl-num-val (pl-walk-deep (dict-get pl-cp-env-dw "N")))
  5)

(define pl-cp-env-dw0 {})
(pl-solve-once!
  pl-cp-db
  (pl-cp-goal "char_type('0', digit(N))" pl-cp-env-dw0)
  (pl-mk-trail))
(pl-cp-test!
  "char_type('0', digit(N)) -> N=0"
  (pl-num-val (pl-walk-deep (dict-get pl-cp-env-dw0 "N")))
  0)

;; ─── char_type/2 — space/white ───────────────────────────────────

(pl-cp-test!
  "char_type(' ', space) succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type(' ', space)" {})
    (pl-mk-trail))
  true)

(pl-cp-test!
  "char_type(a, space) fails"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type(a, space)" {})
    (pl-mk-trail))
  false)

;; ─── char_type/2 — upper(Lower) ──────────────────────────────────

(define pl-cp-env-ul {})
(pl-solve-once!
  pl-cp-db
  (pl-cp-goal "char_type('A', upper(L))" pl-cp-env-ul)
  (pl-mk-trail))
(pl-cp-test!
  "char_type('A', upper(L)) -> L=a"
  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-ul "L")))
  "a")

(pl-cp-test!
  "char_type(a, upper(L)) fails — not uppercase"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type(a, upper(_))" {})
    (pl-mk-trail))
  false)

;; ─── char_type/2 — lower(Upper) ──────────────────────────────────

(define pl-cp-env-lu {})
(pl-solve-once!
  pl-cp-db
  (pl-cp-goal "char_type(a, lower(U))" pl-cp-env-lu)
  (pl-mk-trail))
(pl-cp-test!
  "char_type(a, lower(U)) -> U='A'"
  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-lu "U")))
  "A")

;; ─── char_type/2 — ascii(Code) ───────────────────────────────────

(define pl-cp-env-as {})
(pl-solve-once!
  pl-cp-db
  (pl-cp-goal "char_type(a, ascii(C))" pl-cp-env-as)
  (pl-mk-trail))
(pl-cp-test!
  "char_type(a, ascii(C)) -> C=97"
  (pl-num-val (pl-walk-deep (dict-get pl-cp-env-as "C")))
  97)

;; ─── char_type/2 — punct ─────────────────────────────────────────

(pl-cp-test!
  "char_type('.', punct) succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type('.', punct)" {})
    (pl-mk-trail))
  true)

(pl-cp-test!
  "char_type(a, punct) fails"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "char_type(a, punct)" {})
    (pl-mk-trail))
  false)

;; ─── upcase_atom/2 ───────────────────────────────────────────────

(define pl-cp-env-ua {})
(pl-solve-once!
  pl-cp-db
  (pl-cp-goal "upcase_atom(hello, X)" pl-cp-env-ua)
  (pl-mk-trail))
(pl-cp-test!
  "upcase_atom(hello, X) -> X='HELLO'"
  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-ua "X")))
  "HELLO")

(pl-cp-test!
  "upcase_atom(hello, 'HELLO') succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "upcase_atom(hello, 'HELLO')" {})
    (pl-mk-trail))
  true)

(pl-cp-test!
  "upcase_atom('Hello World', 'HELLO WORLD') succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "upcase_atom('Hello World', 'HELLO WORLD')" {})
    (pl-mk-trail))
  true)

(pl-cp-test!
  "upcase_atom('', '') succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "upcase_atom('', '')" {})
    (pl-mk-trail))
  true)

;; ─── downcase_atom/2 ─────────────────────────────────────────────

(define pl-cp-env-da {})
(pl-solve-once!
  pl-cp-db
  (pl-cp-goal "downcase_atom('HELLO', X)" pl-cp-env-da)
  (pl-mk-trail))
(pl-cp-test!
  "downcase_atom('HELLO', X) -> X=hello"
  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-da "X")))
  "hello")

(pl-cp-test!
  "downcase_atom('HELLO', hello) succeeds"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "downcase_atom('HELLO', hello)" {})
    (pl-mk-trail))
  true)

(pl-cp-test!
  "downcase_atom(hello, hello) succeeds — already lowercase"
  (pl-solve-once!
    pl-cp-db
    (pl-cp-goal "downcase_atom(hello, hello)" {})
    (pl-mk-trail))
  true)

;; ─── string_upper/2 + string_lower/2 (aliases) ───────────────────

(define pl-cp-env-su {})
(pl-solve-once!
  pl-cp-db
  (pl-cp-goal "string_upper(hello, X)" pl-cp-env-su)
  (pl-mk-trail))
(pl-cp-test!
  "string_upper(hello, X) -> X='HELLO'"
  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-su "X")))
  "HELLO")

(define pl-cp-env-sl {})
(pl-solve-once!
  pl-cp-db
  (pl-cp-goal "string_lower('WORLD', X)" pl-cp-env-sl)
  (pl-mk-trail))
(pl-cp-test!
  "string_lower('WORLD', X) -> X=world"
  (pl-atom-name (pl-walk-deep (dict-get pl-cp-env-sl "X")))
  "world")

(define pl-char-predicates-tests-run! (fn () {:failed pl-cp-test-fail :passed pl-cp-test-pass :total pl-cp-test-count :failures pl-cp-test-failures}))