; SPDX-FileCopyrightText: 2026 Hernán Ibarra Mejia
;
; SPDX-License-Identifier: MIT

(import (scheme base)
        (srfi 280)
        (srfi 64))

(test-group "unit tests"
  ; The identity monad
  (define id (lambda (x) x))
  (define switch-apply (lambda (m f) (f m)))
  (define <identity> (make-monad id switch-apply))

  (test-group "monad objects"
    (test-eqv "monad-unit returns correct value" id (monad-unit <identity>))
    (test-eqv "monad-bind returns correct value"
              switch-apply (monad-bind <identity))
    (test-assert "monad? identifies monads" (monad? <identity>))
    (test-assert "monad? identifies non-monads" (not (monad? 42))))

  (test-group "do/m syntax"
    (define (test-syntax-error name str)
      (test-error name (test-read-eval-string str)))
    (define (test-syntax-eqv name expected str)
      (test-eqv name expected (test-read-eval-string str)))
    (test-syntax-error "Empty do/m errors" "(do/m)")
    (test-syntax-error "do/m with no actions errors" "(do/m <identity>)")
    (test-syntax-eqv "do/m handles one action"
                     0
                     "(do/m <identity> 0)")
    (test-syntax-eqv "do/m handles many actions"
                     0
                     "(do/m <identity> 2 1 0)")
    (test-syntax-eqv "do/m handles one return/m"
                     0
                     "(do/m <identity> (return/m 0))")
    (test-syntax-error "return/m not at end errors"
                       "(do/m <identity> (return/m 0) 0)")
    (test-syntax-eqv "do/m handles define/m"
                     0
                     "(do/m <identity> (define/m x 0) x)")
    (test-syntax-error "define/m at end errors"
                       "(do/m <identity> 0 (define/m x 0))")))

(test-group "system test"
  (define (@unit x) (lambda (counter) (cons counter x)))
  (define (@bind $ @)
    (lambda (counter)
      (let* ((wrapped ($ counter))
             (updated-counter (car wrapped))
             (new-val (cdr wrapped)))
        ((@ new-val) updated-counter))))

  (define <numbered> (make-monad @unit @bind))

  (define $inc (lambda (counter) (cons (+ 1 counter) counter)))
  (define (run-<numbered> $ initial-counter) ($ initial-counter))

  (define (@make-node val kids)
    (do/m <numbered>
          (define/m counter $inc)
          (return/m (cons (cons counter val) kids))))

  (define (@build-tree depth)
    (if (zero? depth)
      (@make-node depth '())
      (do/m <numbered>
            (define/m left-branch (@build-tree (- depth 1)))
            (define/m right-branch (@build-tree (- depth 1)))
            (@make-node depth (list left-branch right-branch)))))

  (define expected
    '(115
      (114 . 3)
      ((106 . 2)
       ((102 . 1) ((100 . 0)) ((101 . 0)))
       ((105 . 1) ((103 . 0)) ((104 . 0))))
      ((113 . 2)
       ((109 . 1) ((107 . 0)) ((108 . 0)))
       ((112 . 1) ((110 . 0)) ((111 . 0))))))

  (test-equal "system test"
              expected
              (run-<numbered> (@build-tree 3) 100)))