#| Copyright 2024 Peter McGoron
 |
 | Licensed under the Apache License, Version 2.0 (the "License");
 | you may not use this file except in compliance with the License.
 | You may obtain a copy of the License at
 |
 |     http://www.apache.org/licenses/LICENSE-2.0
 |
 | Unless required by applicable law or agreed to in writing, software
 | distributed under the License is distributed on an "AS IS" BASIS,
 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 | See the License for the specific language governing permissions and
 | limitations under the License.
 |#

(import (mcgoron weight-balanced-trees srfi 113 sets)
        (srfi 252)
        (srfi 64))

(define (orderable-generator)
  ;; Return a value that can be ordered in an obvious way.
  (gsampling #;(boolean-generator)
             (real-generator)
             #;(char-generator)
             #;(string-generator)
             #;(bytevector-generator)))

(test-group "multiple element set using `set` procedure"
  (define (multiple-element-set lst)
    (let* ((new-set (apply set (make-default-comparator) lst))
           (set-as-list (set->list new-set)))
      (test-assert "set?" (set? new-set))
      (test-assert "empty?" (if (null? lst)
                                (set-empty? new-set)
                                (not (set-empty? new-set))))
      ;; The new-set will remove duplicates.
      (test-assert "length?" (<= (set-size new-set) (length lst)))
      (test-assert "subset of inserted" (lset<= equal? set-as-list lst))))
  (test-property multiple-element-set
                 (list (list-generator-of (orderable-generator)))))

(define (remove-duplicates generator)
  (gmap (lambda (lst)
          (let ((cmp (make-default-comparator)))
            (let loop ((seen '())
                       (lst lst))
              (cond
                ((null? lst) seen)
                ((member (car lst)
                         seen
                         (cut =? cmp <> <>))
                 (loop seen (cdr lst)))
                (else (loop (cons (car lst) seen) (cdr lst)))))))
        generator))

(test-group "multiple element set using `set` procedure, unique elements"
  (define (multiple-element-set lst)
    (let* ((new-set (apply set (make-default-comparator) lst))
           (set-as-list (set->list new-set)))
      (test-assert "set?" (set? new-set))
      (test-assert "empty?" (if (null? lst)
                                (set-empty? new-set)
                                (not (set-empty? new-set))))
      (dynamic-property-set! 'set set-as-list)
      (dynamic-property-set! 'list lst)
      (test-equal "length?" (set-size new-set) (length lst))
      (test-assert "exactly inserted" (lset= equal? set-as-list lst))))
  (test-property multiple-element-set
                 (list (remove-duplicates
                        (list-generator-of
                         (orderable-generator))))))