ckscm-trait/tests/run.scm

(import test)
(import trait)

(test-group "an Eq trait"
  (define-trait Eq
    (==)
    (/= (lambda (a b) (not (== a b)))))

  (define-trait-impl (Eq number?)
    (== =))
  (define-trait-impl (Eq symbol?)
    (== eq?))

  (test-assert (== 'a 'a))
  (test-assert (not (/= 'a 'a)))

  (test-assert (/= 'a 'b))
  (test-assert (not (== 'a 'b)))

  (test-assert (== 1 1))
  (test-assert (not (/= 1 1)))

  (test-assert (/= 1 2))
  (test-assert (not (== 1 2))))

(test-group "a Monad"
  (define-trait Monad
    (>>=)
    (return))

  (define-record nullable is-null value)
  (define (make-some value)
    (make-nullable #f value))
  (define (make-null)
    (make-nullable #t '()))
  (define (nullable-type x)
    (if (nullable-is-null x)
        'null
        'some))

  (define-trait-impl (Monad nullable?)
    (>>= (lambda (m f)
           (let ((type (nullable-type m)))
             (cond ((eq? type 'null)
                    (make-null))
                   ((eq? type 'some)
                    (f (nullable-value m)))))))
    (return make-some))
  
  (define (*2 a)
    (make-some (* 2 a)))
  
  (test-assert (= 6 (nullable-value (>>= (make-some 3) *2))))
  
  (define x (make-some 42))
  (let ((return (with-type-of x Monad return)))
    (test-assert (= 99 (nullable-value (return 99))))))