(import brev-separate srfi-69 srfi-1 srfi-13 (chicken sort))

(match-define-closure
 (ht (make-hash-table))
 ((arity proc) (hash-table-ref ht proc))
 ((arity proc a) (hash-table-set! ht proc a)))

(arity third 1)


(unless (= 1 (arity third))
  (error "Fancy defines are borking"))

(define color (call-table))

(color cons 'blue)

(unless (eq? 'blue (color cons))
  (error "call-table is dysfunctional"))

(unless
    (equal? (list
	     (map (fn (apply + args)) '(1 2 3 4) '(20 30 40 50))
	     (map (fn (+ x 12)) '(1 2 3 4))
	     (map (fn (+ x y 12)) '(1 2 3 4) '(20 30 40 50)))
	    '((21 32 43 54) (13 14 15 16) (33 44 55 66)))
  (error "fn is so very borked up"))

(unless
    (equal?
     (map (fn ((fn (list x y)) 10 x)) '(a b c))
     '((10 a) (10 b) (10 c)))
  (error "Nested fn seems wrong"))

(unless
    (equal? '(12 22 32 42 52)
	    ((over (+ 2 (car x))) '((10) (20) ( 30) ( 40) (50))))
  (error "Over is borking"))

(define (vowel? l) ((as-list (c member l)) "aeiou"))

(unless
    (equal?
     '(1375 1122 "aeiouaio" "FLeeT FoXeS" 5311332)
     (list
      ((as-list (c filter odd?)) 13075)
      ((as-list append) 11 22)
      ((as-list (c filter vowel?)) "magnetic mountaintop")
      ((as-list (c map (lambda (l) (if (vowel? l) l (char-upcase l))))) "fleet foxes")
      ((as-list cdr reverse) 23311358)))
  (error "as-list is borking"))

(unless
 (equal?
  (map empty? (list #f #t 3 0 -4 "hej" "" '(a b c) '(a) '()))
  '(#t #f #f #t #f #f #t #f #f #t))
 (error "empty? is borking"))

(define-some (aaas num)
  (cons #\a (aaas (sub1 num))))

(unless
    (equal?
     (list->string (aaas 5))
     "aaaaa")
  (error "define-some is borking"))

(make-tree-accessor caaaaar)

(unless (eq? 'pizza (caaaaar '(((((pizza)))))))
  (error "make-tree-accessor isn't working anymore"))


(define-curry (foo bar baz bax)
  (+ bar baz bax))

(unless (=
	 (foo 100 20 3)
	 ((foo 100) 20 3)
	 ((foo 100 20) 3)
	 ((foo) 100 20 3)
	 (((foo) 100) 20 3)
	 (((foo 100) 20) 3)
	 ((((foo) 100) 20) 3))
  error "define-curry isn't working any more")

(unless
    (= 54321
       ((🍛 + 1 20 300) 4000 50000)
       ((🍛 (🍛 + 1 20 300) 4000) 50000))
  (error "the 🍛 combinator isn't working anymore"))

(unless
    ((like? "aaa")
     ((as-list (🍛 filter (is? #\a))) "a basic friendly advice"))
  (error "like? or is? is borked up"))

(unless
    (eq? 3
	 (with-result
	  (list 1 2 (save 3) 4 5 6)
	  (list 7 8)))
  (error "something's wrong with with-result"))

(unless
  (equal?
    '#(hello my darling you are)
    (let ((horse #(hello now there you are)))
      (set! (slice horse 1 3) #(my darling))
      horse))
  (error "(let ((horse #(hello my darling you are))) (set! (slice horse 1 3) #(my darling)) horse)"))
(unless
  (equal?
    '(hello my darling you are)
    (let ((horse '(hello now there you are)))
      (set! (slice horse 1 3) '(my darling))
      horse))
  (error "(let ((horse (quote (hello now there you are)))) (set! (slice horse 1 3) (quote (my darling))) horse)"))
(unless
  (equal? '12345 (let ((horse 12345)) (set! (slice horse 1 3) 77) horse))
  (error "(let ((horse 12345)) (set! (slice horse 1 3) 77) horse)"))
(set! (slice 12345 1 3) 77)
(unless
  (equal? '(now there) ((call-list '(hello now there you are)) #:slice 1 3))
  (error "((call-list (quote (hello now there you are))) #:slice 1 3)"))

(define foo1 (call-table))
(foo1 'x 3)
(foo1 'y 4)
(define foo2 (call-table))
(foo2 'z 7)

(unless (and (eq? #f (foo2 'x)) (eq? #f (foo1 'z))) (print "The call tables need to be separate"))

(define expected-letters
  '((#\a . 52)
    (#\b . 15)
    (#\c . 28)
    (#\d . 44)
    (#\e . 78)
    (#\f . 21)
    (#\g . 16)
    (#\h . 22)
    (#\i . 98)
    (#\l . 33)
    (#\m . 19)
    (#\n . 61)
    (#\o . 71)
    (#\p . 16)
    (#\q . 1)
    (#\r . 61)
    (#\s . 55)
    (#\t . 78)
    (#\u . 25)
    (#\v . 9)
    (#\w . 12)
    (#\x . 2)
    (#\y . 14)))

(define (counter) (call-table* proc: add1 initial: 0 unary: #t))

(define (cars . args) (apply values (map car args)))

(let ((letter-count (counter))
       (char-key-<? (compose char<? cars)))
  (for-each-line "../COPYING"
    ((as-list (c for-each (compose letter-count char-downcase)))
      (string-filter char-alphabetic? line)))
  (unless
    (equal?
      expected-letters
      (sort (hash-table->alist (letter-count)) char-key-<?))
    (error
     "for-each-line or call-table* are borking (incorrect letter count)")))

(unless (equal? 'hi (eif "" 'hello 'hi))
  (error "some sorta problem with eif"))

(define horses (call-key*))

(horses 'ruby)
(horses 'kind-girl)
(horses 'tornado)


(define ghost-count (call-key* unary: #t proc: add1 initial: 0))

(ghost-count)
(ghost-count)
(ghost-count)

(ghost-count get:)


(unless (and
	 (equal? (horses) '(tornado kind-girl ruby))
	 (eq? (ghost-count get:) 3))
  (error "call-key* is busted"))

(unless
    (= 3 (aif-with-result (+ (save 3) 4) it 'hi)
       (aif-with-result (odd? (save 3)) it 'hi))
  (error "aif-with-result is behaving suspiciously"))

(define-record coords (setter x) (setter y))
(define horse (make-coords 12 100))
(unless
    (equal?
     (list
      (coords-x horse)
      (coords-x ((as-list reverse) horse))
      (coords-x horse))
     '(12 100 12))
  (error "as-list is supposed to be able to handle records now"))

(unless (equal? '(100) (slice horse 1 2))
  (error "slice should understand records"))

(define-record alien bathroom bedroom nighttable and then gun)
(define et (make-alien 1 2 3 4 5 6))
(set! (slice et 3 5) '(hoho oh))
(unless
    (equal? (list (alien-bathroom et) (alien-then et) (alien-and et))
	    '(1 oh hoho))
  (error "Setting to slices on records is not doing too well."))

(unless
    (and
     (equal?
      (let ((horses '(1 2 3 4 5)))
	(descend (horses)
		 (cons (+ 4 (car horses))
		       (desc (cdr horses)))))
      (descend ((dogs '(1 2 3 4 5)))
	       (cons (+ 4 (car dogs))
		     (desc (cdr dogs)))))
     (equal?
      (descend ((sum 0) (nums '(1 2 3 4)))
	       (if (null? nums) sum
		   (desc (+ sum (car nums)) (cdr nums))))
      (descend
       ((nums '(1 2 3 4)))
       (+ (car nums) (desc (cdr nums))))))
  (error "Descend is borking"))