(use-modules (d-)
	     (rnrs base)
	     (srfi srfi-1))

;; TODO eventually these will be cool prompt thingies

(define (assert-equal a b)
  (display "... ")
  (if (equal? a b)
      (display "OK")
      (begin
	(display "expected ")
	(display b)
	(display " but instead got ")
	(display a))))

(define (assert-unspecified a)
  (display "... ")
  (if (unspecified? a)
      (display "OK")
      (begin
	(display "expected unspecifed but instead got ")
	(display a))))

(define-syntax-rule (define-unit-test (test-name body ...))
  (let ()
    (display "<  ")
    (display (symbol->string 'test-name))
    body ...
    (newline)))

(define-syntax-rule (define-test module-name tests ...)
  (begin
    (display "> ")
    (display (symbol->string 'module-name))
    (newline)
    (define-unit-test tests) ...))

(define-test ~>
  (unwrapped
   (define value (~> 1 1+ 1+))
   (assert-equal value 3))
  (wrapped
   (define value (~> 1 (/ 2) (/ 2)))
   (assert-equal value 1/4)))

(define-test ~>>
  (unwrapped
   (define value (~>> 1 1+ 1+))
   (assert-equal value 3))
  (wrapped
   (define value (~>> 1 (/ 2) (/ 2)))
   (assert-equal value 1)))

(define-test if-not
  (test
   (assert-equal (if-not #f 'a 'b) 'a)))

(define-test when-not
  (positive-case
   (assert-equal (when-not #f 'do-some-stuff 'return) 'return))
  (negative-case
   (assert-unspecified (when-not #t 'do-some-stuff 'return))))

(define-test for
  (permutation
   (define value (for ([i (iota 2)]
		       [j (iota 2)])
		      (cons i j)))
   (assert-equal value '((0 . 0) (0 . 1) (1 . 0) (1 . 1)))))

(define-test if-let
  (positive-case
   (assert-equal (if-let ([v (or #f 1)]) (+ v 1)) 2))
  (negative-case
   (assert-equal (if-let ([v (and #f 1)]) (+ v 1)) #f)))

(define-test partial
  (test
   (define value (partial / 2))
   (assert-equal (value 4) 1/2)
   (assert-equal (value 1) 2)))

(define-test argmin
  (test
   (assert-equal (argmin cdr < '(a . 5) '(b . 2) '(c . 3)) '(b . 2))))

(define-test generator
  (test
   (define number-generator
     (generator
      (let loop ([i 1])
	(yield i)
	(loop (1+ i)))))
   (assert-equal (number-generator) 1)
   (assert-equal (number-generator) 2)
   (assert-equal (number-generator) 3)
   (assert-equal (number-generator) 4)))