quick-find-test.ss
#lang scheme/base

(require srfi/26/cut
         (planet untyped/unlib:3/gen)
         "quick-find.ss"
         "snooze-syntax.ss"
         "test-base.ss"
         "test-data.ss"
         "test-util.ss"
         "era/era.ss"
         "sql/sql.ss")

; Tests ----------------------------------------

; snooze% -> test-suite
(define (make-quick-find-tests snooze)
  (define-snooze-interface snooze)
  
  ; course
  (define-values (c1 c2 c3 c4 c5)
    (values (make-course 'course1 "Course 1" 1 1.1 #f (string->time-tai "2001-01-01 01:01:01"))
            (make-course 'course2 "Course 2" 2 2.2 #t (string->time-tai "2002-02-02 02:02:02"))
            (make-course 'course3 "Course 3" 3 3.3 #f (string->time-tai "2003-03-03 03:03:03"))
            (make-course 'course4 "Course 4" 4 4.4 #t (string->time-tai "2004-04-04 04:04:04"))
            (make-course 'course5 "Course 5" 5 5.5 #f (string->time-tai "2005-05-05 05:05:05"))))
  
  ; #:attr any ... -> (U course #f)
  ; #:attr any ... -> (listof course)
  ; #:attr any ... -> (gen-> course)
  (define-values (find-count-courses find-course find-courses g:courses)
    (values (custom-find-count course snooze #:order ((asc course-value)))
            (custom-find-one   course snooze #:order ((asc course-value)))
            (custom-find-all   course snooze #:order ((asc course-value)))
            (custom-g:find     course snooze #:order ((asc course-value)))))
  
  ; test-suite
  (test-suite "quick-find.ss"
    
    #:before
    (lambda ()
      (create-table entity:course)
      (create-table entity:person)
      (create-table entity:pet)
      ; Save in an odd order:
      (for-each save! (list c1 c2 c3 c4 c5)))
    
    #:after
    (lambda ()
      (drop-table entity:course)
      (drop-table entity:person)
      (drop-table entity:pet))
    
    (test-case "find-count #:active"
      (check-equal? (find-count-courses #:active #t) 2 "#t")
      (check-equal? (find-count-courses #:active #f) 3 "#f"))
    
    (test-case "find-one #:id"
      (check-equal? (find-course #:id #f) #f)
      (check-equal? (find-course #:id 1000) #f)
      (check-equal? (find-course #:id (struct-id c1)) c1)
      (check-equal? (find-course #:id (struct-id c2)) c2))
    
    (test-case "find-all #:active"
      (check-equal? (find-courses #:active #t) (list c2 c4) "#t")
      (check-equal? (find-courses #:active #f) (list c1 c3 c5) "#f"))
    
    (test-case "g:find #:active"
      (check-equal? (g:collect (g:courses #:active #t)) (list c2 c4) "#t")
      (check-equal? (g:collect (g:courses #:active #f)) (list c1 c3 c5) "#f"))
    
    (test-case "find-one #:active and #:value"
      (check-equal? (find-course #:active #f #:value 1) c1 "#f 1")
      (check-equal? (find-course #:active #f #:value 2) #f "#f 2")
      (check-equal? (find-course #:active #f #:value 3) c3 "#f 3")
      (check-equal? (find-course #:active #f #:value 4) #f "#f 4")
      (check-equal? (find-course #:active #t #:value 1) #f "#t 1")
      (check-equal? (find-course #:active #t #:value 2) c2 "#t 2")
      (check-equal? (find-course #:active #t #:value 3) #f "#t 3")
      (check-equal? (find-course #:active #t #:value 4) c4 "#t 4"))))

; Provide statements -----------------------------

(provide make-quick-find-tests)