#lang scheme/base

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

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

; snooze% -> test-suite
(define (make-snooze-find-tests snooze)
  (define-snooze-interface snooze)
  
  ; course
  ; course
  ; course
  ; course
  (define-values (c1 c2 c3 c4)
    (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"))))
  
  ; sql:entity
  (define-alias a course)
  (define-alias b course)
  (define-alias c course)
  
  ; test-suite
  (test-suite "snooze-find-tests"
    
    #:before
    (lambda ()
      (create-table entity:course)
      (create-table entity:person)
      (create-table entity:pet)
      (save! c1)
      (save! c2)
      (save! c3)
      (save! c4))
    
    #:after
    (lambda ()
      (drop-table entity:course)
      (drop-table entity:person)
      (drop-table entity:pet))
    
    (test-case "find-by-id works as expected"
      (check-equal? (find-by-id entity:course 1000) #f)
      (check-equal? (find-by-id entity:course (struct-id c1)) c1)
      (check-equal? (find-by-id entity:course (struct-id c2)) c2))
    
    (test-case "g:find in multi-item mode"
      (check-equal? (g:collect (g:find (sql:select #:what  (list a)
                                                   #:from  a
                                                   #:where (sql:= a-active #t)
                                                   #:order (list (sql:asc a-value)))))
                    (list (list c2) (list c4))
                    "check 1 - active = #t")
      (check-equal? (g:collect (g:find (sql:select #:what  (list a)
                                                   #:from  a
                                                   #:where (sql:= a-active #f)
                                                   #:order (list (sql:desc a-value)))))
                    (list (list c3) (list c1))
                    "check 2 - active = #f")
      (check-equal? (g:collect (g:find (sql:select #:what  (list a)
                                                   #:from  a
                                                   #:where (sql:and (sql:= a-active #t)
                                                                    (sql:= a-active #f))
                                                   #:order (list (sql:desc a-value)))))
                    (list)
                    "check 3 - active = #t and active = #f (i.e. no results returned)"))
    
    (test-case "g:find in single-item mode"
      (check-equal? (g:collect (g:find (sql:select #:from  a
                                                   #:where (sql:= a-active #t)
                                                   #:order (list (sql:asc a-value)))))
                    (list c2 c4)
                    "check 1 - active = #t")
      (check-equal? (g:collect (g:find (sql:select #:from  a
                                                   #:where (sql:= a-active #f)
                                                   #:order (list (sql:desc a-value)))))
                    (list c3 c1)
                    "check 2 - active = #f")
      (check-equal? (g:collect (g:find (sql:select #:what  a
                                                   #:from  a
                                                   #:where (sql:and (sql:= a-active #f) (sql:= a-active #t))
                                                   #:order (list (sql:desc a-value)))))
                    (list)
                    "check 3 - active = #t and active = #f (i.e. no results returned)"))
    
    (test-case "find-all"
      (check-equal? (find-all (sql:select #:from  a
                                          #:where (sql:= a-active #t)
                                          #:order (list (sql:asc a-value))))
                    (list c2 c4)
                    "check 1 - active = #t")
      (check-equal? (find-all (sql:select #:from  a
                                          #:where (sql:= a-active #f)
                                          #:order (list (sql:desc a-value))))
                    (list c3 c1)
                    "check 2 - active = #f")
      (check-equal? (find-all (sql:select #:from  a
                                          #:where (sql:and (sql:= a-active #t)
                                                           (sql:= a-active #f))
                                          #:order (list (sql:desc a-value))))
                    (list)
                    "check 3 - active = #t and active = #f (i.e. no results returned)"))
    
    (test-case "find-one"
      (check-equal? (find-one (sql:select #:from  a
                                          #:where (sql:= a-active #t)
                                          #:order (list (sql:asc a-value))))
                    c2
                    "check 1 - active = #t")
      (check-equal? (find-one (sql:select #:from  a
                                          #:where (sql:= a-active #f)
                                          #:order (list (sql:desc a-value))))
                    c3
                    "check 2 - active = #f")
      (check-equal? (find-one (sql:select #:from  a
                                          #:where (sql:and (sql:= a-active #t)
                                                           (sql:= a-active #f))
                                          #:order (list (sql:desc a-value))))
                    #f
                    "check 3 - active = #t and active = #f (i.e. no results returned)"))
    
    (test-case "expressions in #:what clause"
      (let ([close-enough?
             (match-lambda*
               [(list (list num1 str1) (list num2 str2))
                (and (< (- num1 num2) 0.01) ; these are real numbers so they won't be exactly the same
                     (equal? str1 str2))])])
        (let-alias ([expr1 (sql:max (sql:+ a-value a-rating))]
                    [expr2 (sql:string-append a-code " " a-name)])
          (check-true (andmap close-enough?
                              (find-all (sql:select #:what  (list expr1 expr2)
                                                    #:from  a
                                                    #:order (list (sql:desc expr1))
                                                    #:group (list a-id a-revision a-code a-name)))
                              (list (list 8.4 "course4 Course 4")
                                    (list 6.3 "course3 Course 3")
                                    (list 4.2 "course2 Course 2")
                                    (list 2.1 "course1 Course 1")))))))
    
    (test-case "#:order with attributes and expressions"
      (let-alias ([expr1 (sql:max (sql:+ a-value a-rating))]
                  [expr2 (sql:string-append a-code " " a-name)])
        (check-not-exn
          (cut find-all (sql:select #:what  (list a-id expr1 expr2)
                                    #:from  (sql:outer a b)
                                    #:order (list (sql:desc expr1) (sql:asc a-id) (sql:asc b-id))
                                    #:group (list a-id a-revision a-code a-name b))))
        (check-not-exn
          (cut find-all (sql:select #:what  expr1
                                    #:from  (sql:select #:what (list a-value a-rating) #:from a)
                                    #:order (list (sql:desc expr1)))))))
    
    (test-case "order of joins (this will test the special aliasing behaviour of the SQLite back-end)"
      (check-equal? (find-all (sql (select #:from (outer a (outer b c)))))
                    (find-all (sql (select #:from (outer (outer a b) c))))
                    "attributes")
      (check-equal? (find-all (sql (select #:what (+ a-id b-id c-id) #:from (outer a (outer b c)))))
                    (find-all (sql (select #:what (+ a-id b-id c-id) #:from (outer (outer a b) c))))
                    "expressions"))))

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

(provide make-snooze-find-tests)