(use simple-tests simple-contracts)
(contract-check-level 1)

(define-test (helpers?)
  (check
    "FLIP"
    (null? ((%% list)))
    (equal? ((%% list) 1) '(1))
    (equal? ((%% list) 1 2) '(2 1))
    (equal? ((%% list) 1 2 3 4) '(2 3 4 1))
    (equal? ((%% map) '(0 1 2) add1) '(1 2 3))
  
    "PIPE"
    (= ((pipe) 5) 5)
    (= ((pipe (+ 1)) 5) 6)
    (not ((pipe (- 10) (positive?)) 5))
    ((pipe (- 10) (negative?)) 5)
    (equal? ((pipe ((%% list) 1 2 3 4)) 10)
            '(1 2 3 4 10))
    (equal? ((pipe (list 1 2 3 4)) 10)
            '(10 1 2 3 4))
    (equal? ((pipe ((%% map) add1))
             '(0 1 2)) '(1 2 3))
    (equal? ((pipe (list 1 2 3)) 0)
            '(0 1 2 3)) 
    (equal? ((pipe ((%% list) 1 2 3)) 0)
            '(1 2 3 0)) 
    ))
    
(define-test (contracts?)
  (check
    "STATE"
    (define-values (counter! counter)
      (let ((state 0))
        (values
          (xlambda 1 ((old (pipe (+ 1) (= state))))
            (let ((o state))
              (set! state (add1 state))
              o))
          (xlambda 1 ((result (pipe (= state))))
            state))))
    (zero? (counter))
    (counter!)
    (= (counter) 1)
    (counter!)
    (= (counter) 2)
  
    (define-values (add add-pre add-post)
      ;(xlambda 1 ((result integer? odd? (pipe (= (apply + x y ys))))
      (xlambda ((result integer? odd? (pipe (= (apply + x y ys))))
                (x integer? odd?) (y integer? even?) ys integer? even?)
        (apply + x y ys)))
    (= (add 1 2 4 6) 13)
    (equal? add-pre
            '((x (conjoin integer? odd?))
              (y (conjoin integer? even?))
              ys (conjoin integer?  even?)))
    (equal? add-post
            '(result (conjoin integer? odd? (pipe (= (apply + x y ys))))))
    (not (condition-case (add 1 2 3) ((exn arguments) #f)))

    (define wrong-add
      ;(xlambda 1 ((result integer? even?)
      (xlambda ((result integer? even?)
                (x integer? odd?) xs integer?  even?)
        (apply + x xs)))
    (not (condition-case (wrong-add 1 2 4) ((exn results) #f)))
  
    (define-values (euclid euclid-pre euclid-post)
      (xlambda 2 ((q integer?)
                  (r (pipe (+ (* n q))
                           (= m)))
                  (m integer? (pipe (>= 0)))
                  (n integer? positive?))
        (let loop ((q 0) (r m))
          (if (< r n)
            (values q r)
            (loop (+ q 1) (- r n))))))
    (equal?
      (call-with-values
        (lambda () (euclid 385 25))
        list)
      '(15 10))
    (equal? euclid-pre
            '((m (conjoin integer? (pipe (>= 0))))
              (n (conjoin integer? positive?))))
    (equal? euclid-post
            '((q integer?)
              (r (pipe (+ (* n q)) (= m)))))
  
    "XDEFINE"
    (xdefine ((result integer?) sum (a integer?) as integer?)
      (apply + a as))
    (= (sum 1 2 3) 6)
    (not (condition-case (sum 1 2 #f) ((exn arguments) #f)))
    (xdefine ((result list?) wrong-sum (a integer?) as integer?)
      (apply + a as))
    (not (condition-case (wrong-sum 1 2 3) ((exn results) #f)))
    ))
  
(compound-test (SIMPLE-CONTRACTS)
  (helpers?)
  (contracts?)
  )