(export list-test)

(import
  :std/error
  :std/misc/list
  :std/sort
  :std/sugar
  :std/test)

(def (copy-list lst) (foldr cons '() lst))

(def list-test
  (test-suite "test :std/misc/list"
    (test-case "test same length"
      (for-each (lambda (a b)
                  (for-each (lambda (f) (check-equal? (f a b) #t))
                            [length=? length<=? length>=?])
                  (for-each (lambda (f) (check-equal? (f a b) #f))
                            [length<? length>?]))
                '((1 2 3) (1 2 3 . 4) () (1))
                '((a b c) (a b c)     () (a))))
    (test-case "test left shorter"
      (for-each (lambda (a b)
                  (for-each (lambda (f) (check-equal? (f a b) #t))
                            [length<=? length<?])
                  (for-each (lambda (f) (check-equal? (f a b) #f))
                            [length=? length>=? length>?]))
                '((1 2 3)   (1 2 3 . 4) ()  (1))
                '((a b c d) (a b c d)   (a) (a b))))
    (test-case "test left longer"
      (for-each (lambda (a b)
                  (for-each (lambda (f) (check-equal? (f a b) #t))
                            [length>=? length>?])
                  (for-each (lambda (f) (check-equal? (f a b) #f))
                            [length=? length<=? length<?]))
                '((1 2 3 4) (1 2 3 4)   (1) (1 2))
                '((a b c)   (a b c . d) ()  (a))))
    (test-case "test given length"
      (for-each (lambda (a n)
                  (for-each (lambda (f) (check-equal? (f a n) #t))
                            [length=n? length<=n? length>=n?])
                  (for-each (lambda (f) (check-equal? (f a n) #f))
                            [length<n? length>n?]))
                '((1 2 3) (1 2 3 . 4) () (1) (1 2))
                '(3.0     3           0  1   2)))
    (test-case "test under given length"
      (for-each (lambda (a n)
                  (for-each (lambda (f) (check-equal? (f a n) #t))
                            [length<=n? length<n?])
                  (for-each (lambda (f) (check-equal? (f a n) #f))
                            [length=n? length>=n? length>n?]))
                '((1 2 3)   (1 2 3 . 4) ()  (1) (1 2) (1 2 3 4) (1 2 3))
                '(3.14159   4           1   2   2.5   +inf.0    6.022e23)))
    (test-case "test over given length"
      (for-each (lambda (a n)
                  (for-each (lambda (f) (check-equal? (f a n) #t))
                            [length>=n? length>n?])
                  (for-each (lambda (f) (check-equal? (f a n) #f))
                            [length=n? length<=n? length<n?]))
                '((a b c d) (a b c d . e) (a) (a b) ())
                '(3         3.14159       0   1     -4)))
    (test-case "weird length?n? cases"
      (check-equal? (length=n? '(1 2 3) 2+3i) #f)
      (check-exception (length=n? '(1 2 3) 'foo) contract-violation-error?)
      (for-each (lambda (n)
                  (for-each (lambda (f) (check-exception (f '(1 2 3) n) contract-violation-error?))
                            [length>=n? length>n? length<=n? length<n?]))
                '(foo 2+3i)))
    (test-case "test snoc"
      (check-equal? (snoc 3 []) [3])
      (check-equal? (snoc 1 [3 2]) [3 2 1]))
    (test-case "test append1"
      (check-equal? (append1 [] 3) [3])
      (check-equal? (append1 [3 2] 1) [3 2 1]))
    (test-case "test flatten"
      (check-equal? (flatten '()) '())
      (check-equal? (flatten '(1)) '(1))
      (check-equal? (flatten '(1 2 3)) '(1 2 3))
      (check-equal? (flatten '(1 (2) (3))) '(1 2 3))
      (check-equal? (flatten '(1 ((2)) 3)) '(1 2 3))
      (check-equal? (flatten '((1 2) 3)) '(1 2 3))
      (check-equal? (flatten '(1 2 ())) '(1 2))
      (check-equal? (flatten '(1 2 (()))) '(1 2))
      (check-equal? (flatten '(1 (2) ((3) ()) (((4 5))))) '(1 2 3 4 5))
      (check-equal? (flatten '((a 1 . b) (2 c . 3) d . 4)) '(a 1 b 2 c 3 d 4)))
    (test-case "test flatten1"
      (check-equal? (flatten1 '()) '())
      (check-equal? (flatten1 '(1)) '(1))
      (check-equal? (flatten1 '(1 2 3)) '(1 2 3))
      (check-equal? (flatten1 '(1 (2) (3))) '(1 2 3))
      (check-equal? (flatten1 '(1 (2) (3) ((4)))) '(1 2 3 (4)))
      (check-equal? (flatten1 '((1) ((2)) 3)) '(1 (2) 3))
      (check-equal? (flatten1 '(1 2 ())) '(1 2))
      (check-equal? (flatten1 '(1 2 (()))) '(1 2 ()))
      (check-exception (flatten1 '((a 1 . b) (2 c . 3) d . 4)) true))
    (test-case "test rassoc"
      (check-equal? (rassoc 2 '((a . 1) (b . 2) (c . 3))) '(b . 2))
      (check-equal? (rassoc "a" '((1 . "a") (2 . "b"))) #f)
      (check-equal? (rassoc "a" '((1 . "a") (2 . "b")) equal?) '(1 . "a"))
      (check-equal? (rassoc 2 '(1 2 3)) #f)
      (check-equal? (rassoc 2 '()) #f)
      (check-equal? (rassoc 3 '((a . 1) (b . 2))) #f)
      (check-equal? (rassoc 2 '((a . 1) 2 (b . 2))) #f)
      (check-equal? (rassoc 2 '((a . 1) '() (b . 2))) '(b . 2))
      (check-equal? (rassoc '() '((a . 1) (b . 2))) #f))
    (test-case "test when/list"
      (check-equal? (when/list #t [mykw: 42]) [mykw: 42])
      (check-equal? (when/list #f [mykw: 42]) [])
      (check-equal? (when/list #f (error "foo")) []))
    (test-case "test when-list-or-empty"
      (check-equal? (when-list-or-empty 1 "a") [])
      (check-equal? (when-list-or-empty [1] "a") "a")
      (check-equal? (when-list-or-empty [] "a") []))
    (test-case "test listify"
      (check-equal? (listify 42) [])
      (check-equal? (listify []) [])
      (check-equal? (listify ["proper" "list"]) ["proper" "list"])
      (check-equal? (listify ["improper" . "list"]) ["improper" . "list"]))
    (test-case "test keyword-when"
      (check-equal? (keyword-when mykw: #t 42) '(mykw: 42))
      (check-equal? (keyword-when mykw: #f 42) '())
      (check-equal? (keyword-when mykw: "true") '(mykw: "true"))
      (check-equal? (keyword-when mykw: #f) '())
      (check-equal? (keyword-when mykw: #f (error "foo")) '())
      (check-equal? (keyword-when "not a keyword" #t 42) '("not a keyword" 42)))
    (test-case "test slice"
      (check-equal? (slice [1 2 3 4] 2) [3 4])
      (check-equal? (slice [1 2 3 4] 2 1) [3])
      (check-equal? (slice [1 2 3 4] 0) [1 2 3 4])
      (check-equal? (slice [1 2 3 4] 1 0) [])
      (check-equal? (slice [1 2 3 4] 3) [4]))
    (test-case "test slice-right"
      (check-equal? (slice-right [1 2 3 4] 2) [1 2])
      (check-equal? (slice-right [1 2 3 4] 2 1) [2])
      (check-equal? (slice-right [1 2 3 4] 0) [1 2 3 4])
      (check-equal? (slice-right [1 2 3 4] 1 0) [])
      (check-equal? (slice-right [1 2 3 4] 3) [1]))
    (test-case "test slice!"
      (check-equal? (slice! [1 2 3 4] 2) [3 4])
      (check-equal? (slice! [1 2 3 4] 2 1) [3])
      (check-equal? (slice! [1 2 3 4] 0) [1 2 3 4])
      (check-equal? (slice! [1 2 3 4] 1 0) [])
      (check-equal? (slice! [1 2 3 4] 3) [4]))
    (test-case "test slice-right!"
      (check-equal? (slice-right! [1 2 3 4] 2) [1 2])
      (check-equal? (slice-right! [1 2 3 4] 2 1) [2])
      (check-equal? (slice-right! [1 2 3 4] 0) [1 2 3 4])
      (check-equal? (slice-right! [1 2 3 4] 1 0) [])
      (check-equal? (slice-right! [1 2 3 4] 3) [1]))
    (test-case "test butlast"
      (check-equal? (butlast [1 2 3]) [1 2])
      (check-equal? (butlast []) []))
    (test-case "test split"
      (check-equal? (split '(1 2 a 3 4) (cut equal? <> 'a)) [[1 2] [3 4]])
      (check-equal? (split '(1 2 a 3 4) 'a)            [[1 2] [3 4]])
      (check-equal? (split '(1 2 "hi") string?)        [[1 2]])
      (check-equal? (split '(_) '_)                    [[]])
      (check-equal? (split '() '_)                     [])
      (check-equal? (split [] number?)                 [])
      (check-equal? (split [] number? 1)               [])
      (check-equal? (split [1] number?)                [[]])
      (check-equal? (split [1] number? 1)              [[]])
      (check-equal? (split [1 2] number? 0)            [1 2])
      (check-equal? (split [1 2 0 3 4 0 5 6] zero?)    [[1 2] [3 4] [5 6]])
      (check-equal? (split [1 2 0 3 4 0 5 6] zero? 1)  [[1 2] [3 4 0 5 6]])
      (check-equal? (split [1 2 0 3 4 0 5 6] zero? 2)  [[1 2] [3 4] [5 6]])
      (check-equal? (split [1 2 0 3 4 0 5 6] zero? 10) [[1 2] [3 4] [5 6]]))
    (test-case "test group-consecutive"
      (check-equal? (group-consecutive [1 2 2 3 1]) [[1] [2 2] [3] [1]])
      (check-equal? (group-consecutive (sort [1 2 2 3 1 1] <) eqv?) [[1 1 1] [2 2] [3]])
      (check-equal? (group-consecutive [1 2 3 2 2 3 4 0 3 5] <) [[1 2 3] [2] [2 3 4] [0 3 5]])
      (check-equal? (group-consecutive []) [])
      (check-equal? (group-consecutive [1]) [[1]])
      (check-equal? (group-consecutive [1 []]) [[1] [[]]])
      (check-equal? (group-consecutive ["aa" "aa" "b"]) [["aa" "aa"] ["b"]]))
    (test-case "test group-n-consecutive"
      (check-equal? (group-n-consecutive 1 [1 2 3 4 5 6]) [[1] [2] [3] [4] [5] [6]])
      (check-equal? (group-n-consecutive 2 [1 2 3 4 5 6]) [[1 2] [3 4] [5 6]])
      (check-equal? (group-n-consecutive 2 [1 2 3 4 5 6 7]) [[1 2] [3 4] [5 6] [7]])
      (check-equal? (group-n-consecutive 3 [1 2 3 4 5 6 7]) [[1 2 3] [4 5 6] [7]])
      (check-equal? (group-n-consecutive 3 [1 2 3 4 5 6 . 7]) [[1 2 3] [4 5 6 . 7]]))
    (test-case "group-same"
      (check-equal? (group-same [1 2 2 3 1]) [[1 1] [2 2] [3]])
      (check-equal? (group-same '("abc" "b" "c" "ef" "gh" "ijk") key: string-length)
                    '(("abc" "ijk") ("b" "c") ("ef" "gh"))))
    (test-case "map/car"
      (check-equal? (map/car (cut * 10 <>) (cons 3 4)) '(30 . 4)))
    (test-case "test every-consecutive?"
      (check-equal? (every-consecutive? < [1 2 3 4 5]) #t)
      (check-equal? (every-consecutive? < [1 2 5 4 3]) #f)
      (check-equal? (every-consecutive? (lambda (x y) (not (= x y))) [1 2 3 4 5]) #t)
      (check-equal? (every-consecutive? error [1]) #t)
      (check-equal? (every-consecutive? error []) #t))
    (test-case "test separate-keyword-arguments"
      (check-equal? (values->list (separate-keyword-arguments
                                   '(x a: 1 y b: 2 c: 3 z)))
                    '((x y z) (a: 1 b: 2 c: 3)))
      (check-equal? (values->list (separate-keyword-arguments
                                   '(x a: 1 y #!key b: 2 c: 3 z #!rest t d: 4) #t))
                    '((x y b: 2 z t d: 4) (a: 1 c: 3)))
      (check-equal? (values->list (separate-keyword-arguments
                                   '(x a: 1 y #!key b: 2 c: 3 z #!rest t d: 4) #f))
                    '((x y #!key b: 2 z #!rest t d: 4) (a: 1 c: 3))))
    (test-case "test delete-duplicates/hash"
      (check (delete-duplicates/hash '(a b c d a e f c)) => '(b d a e f c))
      (check (delete-duplicates/hash '(a b c d a e f c) from-end?: #t) => '(a b c d e f))
      (check (delete-duplicates/hash '(a b c d a e f c) table: (hash (a #f))) => '(b d e f c))
      (check (delete-duplicates/hash '((a 1) (b 2) (c 3) (a 4) (d 5) (c 6))
                                     from-end?: #t key: car) => '((a 1) (b 2) (c 3) (d 5))))
    (test-case "test duplicates"
      (check (duplicates []) => [])
      (check (duplicates ['a 'b]) => [])
      (check (duplicates ['a 1 'a 2]) => ['(a . 2)])
      (check (duplicates ['a 'b 'a 'a] eq?) => ['(a . 3)])
      (check (duplicates '((a . 10) (b . 10)) key: cdr) => ['(10 . 2)]))
    (test-case "test push! pop!"
      (def l [])
      (check (pop! l) => #f)
      (check l => [])
      (check (push! 10 l) => (void))
      (check l => [10])
      (check (push! 20 l) => (void))
      (check l => [20 10])
      (check (pop! l) => 20)
      (check l => [10])
      (check (pop! l) => 10)
      (check l => [])
      (check (pop! l) => #f)
      (check l => []))

    (test-case "test first-and-only"
      (check (first-and-only '(foo)) => 'foo)
      (check-exception (first-and-only '()) true)
      (check-exception (first-and-only #f) true)
      (check-exception (first-and-only '(a b)) true))
    ))
