(module config mzscheme
(require "../spgsql.ss"
(lib "class.ss")
(lib "match.ss"))
(provide HOST PORT USER DATABASE PASSWORD
connect-for-test
connect-and-setup
call-with-connection
set-equal?
pg-error?
spgsql-error?
)
(define-values (HOST PORT USER DATABASE PASSWORD)
(values "localhost" 5432 "ryan" "ryan" "secret"))
(define (connect-for-test)
(connect HOST PORT DATABASE USER PASSWORD))
(define (connect-and-setup)
(let [(cx (connect-for-test))]
(send* cx
(set-notice-handler void)
(set-notification-handler void)
(exec "create temporary table the_numbers
(N integer primary key, description varchar(80))")
(exec "insert into the_numbers values (1, 'unity')")
(exec "insert into the_numbers (description, N)
values ('the loneliest number since the number one', 2)")
(exec "insert into the_numbers values (0, 'naught')")
(exec "insert into the_numbers values (4, 'four');
insert into the_numbers values (5, 'five');
insert into the_numbers values (6, 'seven less 1')"))
cx))
(define (set-equal? a b)
(and (andmap (lambda (xa) (member xa b)) a)
(andmap (lambda (xb) (member xb a)) b)
#t))
(define (pg-error? str)
(lambda (exn)
(and (exn:spgsql? exn)
(regexp-match str (exn-message exn))
#t)))
(define-syntax (spgsql-error? stx)
(define (get-predicate type)
(list-ref (syntax-local-value type) 2))
(define (get-accessor type n)
(list-ref (list-ref (syntax-local-value type) 3) n))
(syntax-case stx ()
[(_ exn-type sym)
#`(lambda (x)
(and (#,(get-predicate #'exn-type) x)
(eq? sym (#,(get-accessor #'exn-type 0) x))))]
[(_ exn-type)
#`(lambda (x)
(#,(get-predicate #'exn-type) x))]))
(define-syntax spgsql-error?
(syntax-rules ()
[(_ exn-type sym)
(lambda (exn)
(match exn
[($ exn-type _ _ sym-2)
(eq? sym sym-2)]
[_ #f]))]
[(_ exn-type)
(lambda (exn)
(match exn
[($ exn-type _ _)
#t]
[_ #f]))]))
(define (call-with-connection f)
(let [(c (connect-and-setup))]
(dynamic-wind void
(lambda () (f c))
(lambda () (send c disconnect)))))
)