(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) '()
	     (call-table) (call-vector #()) (call-list '())
	     (call-table seed: '((foo . 3))) (call-vector #(123)) (call-list '(456))))
  '(#t #f #f #t #f #f #t #f #f #t #t #t #t #f #f #f))
 (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)))))
     (let ((acc (call-key*)))
       (equal?
	(descend
	 ((n '(1 2 3 4)))
	 (acc (car n)) (desc (cdr n)))
	'(4 3 2 1))))
  (error "Descend is borking"))

(unless
    (and
     (equal? '(green) ((ct* 'banana 'yellow 'apple '(blue red) 'mango 'green) 'mango))
     (equal? '(blue red) ((ct* 'banana 'yellow 'apple ('blue 'red) 'mango 'green) 'apple))
     (eq? ((ctq banana yellow apple red) 'apple) 'red)
     (eq? ((ct 'banana 'yellow) 'banana) 'yellow)
     (eq? (let ((purple 'yellow))
	    ((ctq banana ,purple) 'banana))
	  'yellow))
  (error "ct, ct* etc are borking"))

(unless
  (equal?
    '(a () 1 () ())
    (map (?-> (o not null?) car) '((a b c) () (1 2 3) () ())))
  (error "(map (?-> (o not null?) car) (quote ((a b c) () (1 2 3) () ())))"))

(unless
  (equal?
    '(a #f 1 #f #f)
    (map (?-> (o not null?) car #:default #f) '((a b c) () (1 2 3) () ())))
  (error "(map (?-> (o not null?) car #:default #f) (quote ((a b c) () (1 2 3) () ())))"))

(unless
  (equal?
    '(a (w o n d e r f u l) "summer's" (d a y))
    (map (?-> list? reverse) '(a (l u f r e d n o w) "summer's" (y a d))))
  (error "(map (?-> list? reverse) (quote (a (l u f r e d n o w) \"summer's\" (y a d))))"))

(unless (equal? '(a b c) (string->read "(a b c)")) (error "string->read is messed up"))

(unless
    (equal?
     (map string->dwim '("1" "fairly" "(a b c)" "foo(bar)" "(quix)/bar"))
     '(1 fairly (a b c) "foo(bar)" "(quix)/bar"))
  (error "string->dwim is messsed up"))

(define foo (make-hash-table))

(set! (ref* foo 'bar) '((x . #(1 2 3)) (y . #(4 5 6))))

(unless
  (equal? '((x . #(1 2 3)) (y . #(4 5 6))) (ref* foo 'bar))
  (error "(ref* foo (quote bar))"))

(unless
  (equal? '#(4 5 6) (ref* foo 'bar 'y))
  (error "(ref* foo (quote bar) (quote y))"))

(unless
  (equal? '4 (ref* foo 'bar 'y 0))
  (error "(ref* foo (quote bar) (quote y) 0)"))

(set!  (ref* foo 'bar 'y 0) 5)

(unless
  (equal? '5 (ref* foo 'bar 'y 0))
  (error "setting ref*"))

(unless
  (equal? '(bar . foo) (ewhen 'foo (cons 'bar it)))
  (error "(ewhen (quote foo) (cons (quote bar) it))"))

(unless
  (equal? 'all (ewhen 'foo it 'all))
  (error "(ewhen (quote foo) it (quote all))"))

(ewhen '() (error "ewhen problem"))

(unless (equal? '#f (eor "")) (error "(eor \"\")"))

(unless (equal? 'p (eor "" 'p)) (error "(eor \"\" (quote p))"))

(unless (equal? 'p (eor "" "" 'p)) (error "(eor \"\" \"\" (quote p))"))

(unless (equal? 'p (eor "" "" 'p #f)) (error "(eor \"\" \"\" (quote p) #f)"))

(unless (equal? '3 (eand 3)) (error "(eand 3)"))

(unless (equal? '4 (eand 3 (add1 it))) (error "(eand 3 (add1 it))"))

(unless (equal? '#f (eand -1 (add1 it))) (error "(eand -1 (add1 it))"))

(unless (equal? '1 (eor 0 (add1 it))) (error "(eor 0 (add1 it))"))

(unless (equal? '1 (eor "" 0 (add1 it))) (error "(eor \"\" 0 (add1 it))"))

(unless
  (equal? 'foo (econd ("" it) (else 'foo)))
  (error "(econd (\"\" it) (else (quote foo)))"))

(unless
  (equal? '"hi" (econd ("hi" it) (else 'foo)))
  (error "(econd (\"hi\" it) (else (quote foo)))"))

(unless
  (equal? '"hi" (econd (#f 'great) ("hi" it) (else 'foo)))
  (error "(econd (#f (quote great)) (\"hi\" it) (else (quote foo)))"))


(unless
  (equal?
    '1
    (let* ((var 0) (adder (fn (set! var (add1 var)) var))) (eor '() (adder))))
  (error "(let* ((var 0) (adder (fn (set! var (add1 var)) var))) (eor (quote ()) (adder)))"))

(unless
  (equal?
    '2
    (let* ((var 0) (adder (fn (set! var (add1 var)) var)))
      (eand (adder) (adder))))
  (error "(let* ((var 0) (adder (fn (set! var (add1 var)) var))) (eand (adder) (adder)))"))