[db] fail tests, things are looking ok

private/db.rkt

@@ -3,12 +3,16 @@
 ;; TODO do not use this library, it's just for demonstration
 
 (provide
-  (all-from-out db)
+  start-transaction
+  rollback-transaction
+  query-exec
   Connection
 
   ;(rename-out [quasiquote DB]) ;; TODO try using struct types
 
+  let-schema:
   define-schema:
+  let-connection:
   define-connection:
   postgresql-connect:
 
@@ -41,6 +45,10 @@
   (postgresql-connect (->* [#:user String #:database String] [] Connection))
   (query-row (-> Connection String Any * (Vectorof Any)))
   (query-maybe-row (-> Connection String Any * (Option (Vectorof Any))))
+  ;; ---
+  (start-transaction (-> Connection Void))
+  (rollback-transaction (-> Connection Void))
+  (query-exec (-> Connection String Any * Void))
 )
 
 ;; =============================================================================

test/db-fail.rkt

@@ -0,0 +1,147 @@
+#lang racket/base
+(require trivial/private/test-common
+  (only-in typed/racket/base
+    with-handlers raise lambda : -> Any List String Natural Integer Vector))
+
+;; === HOLY BOILERPLATE BATMAN
+
+(module+ test (test-compile-error
+  #:require trivial/private/db
+  #:exn #rx"query-row::|Type Checker"
+
+  ;; ===========================================================================
+  ;; === TEST reference missing table
+  (let ([fish-sql "CREATE TABLE fish ( id serial PRIMARY KEY, name text UNIQUE NOT NULL, weight int NOT NULL);"]
+        [cube-sql "CREATE TABLE cube ( id serial PRIMARY KEY, length smallint NOT NULL, width integer NOT NULL, height bigint NOT NULL);"])
+    (let-schema: ([schema '((fish ((id . Natural) (name . String) (weight . Integer))) (cube ((id . Natural) (length . Integer) (width . Integer) (height . Integer))))])
+      (let-connection: ([conn (postgresql-connect: schema #:user "postgres" #:database "travis_ci_test")])
+        (let ([with-transaction (lambda ([thunk : (-> Any)])
+                                  (define maybe-exn
+                                    (with-handlers ([exn? (lambda ([e : exn]) e)])
+                                      (start-transaction conn)
+                                      (thunk)
+                                      #f))
+                                  (rollback-transaction conn)
+                                  (if maybe-exn (raise maybe-exn) (void)))]
+              [insert-fish (lambda ([x : (List String Natural)])
+                             (query-exec conn "INSERT INTO fish (name, weight) VALUES ($1, $2);" (car x) (cadr x)))]
+              [insert-cube (lambda ([x : (List Integer Integer Integer)])
+                             (query-exec conn "INSERT INTO cube (length, width, height) VALUES ($1, $2, $3);" (car x) (cadr x) (caddr x)))])
+          (query-exec conn fish-sql)
+          (query-exec conn cube-sql)
+          (define f1 '("Marlin" 8))
+          (define c1 '(2 4 8))
+          (insert-fish f1)
+          (insert-cube c1)
+          ;; -------------------------------------------------------------------
+          (query-row: conn "SELECT * FROM fake_table")))))
+
+  ;; ===========================================================================
+  ;; === TEST missing row
+  (let ([fish-sql "CREATE TABLE fish ( id serial PRIMARY KEY, name text UNIQUE NOT NULL, weight int NOT NULL);"]
+        [cube-sql "CREATE TABLE cube ( id serial PRIMARY KEY, length smallint NOT NULL, width integer NOT NULL, height bigint NOT NULL);"])
+    (let-schema: ([schema '((fish ((id . Natural) (name . String) (weight . Integer))) (cube ((id . Natural) (length . Integer) (width . Integer) (height . Integer))))])
+      (let-connection: ([conn (postgresql-connect: schema #:user "postgres" #:database "travis_ci_test")])
+        (let ([with-transaction (lambda ([thunk : (-> Any)])
+                                  (define maybe-exn
+                                    (with-handlers ([exn? (lambda ([e : exn]) e)])
+                                      (start-transaction conn)
+                                      (thunk)
+                                      #f))
+                                  (rollback-transaction conn)
+                                  (if maybe-exn (raise maybe-exn) (void)))]
+              [insert-fish (lambda ([x : (List String Natural)])
+                             (query-exec conn "INSERT INTO fish (name, weight) VALUES ($1, $2);" (car x) (cadr x)))]
+              [insert-cube (lambda ([x : (List Integer Integer Integer)])
+                             (query-exec conn "INSERT INTO cube (length, width, height) VALUES ($1, $2, $3);" (car x) (cadr x) (caddr x)))])
+          (query-exec conn fish-sql)
+          (query-exec conn cube-sql)
+          (define f1 '("Marlin" 8))
+          (define c1 '(2 4 8))
+          (insert-fish f1)
+          (insert-cube c1)
+          ;; -------------------------------------------------------------------
+          (query-row: conn "SELECT * FROM fish where fish.fry = 1")))))
+
+  ;; ===========================================================================
+  ;; === TEST missing actual parameter
+  (let ([fish-sql "CREATE TABLE fish ( id serial PRIMARY KEY, name text UNIQUE NOT NULL, weight int NOT NULL);"]
+        [cube-sql "CREATE TABLE cube ( id serial PRIMARY KEY, length smallint NOT NULL, width integer NOT NULL, height bigint NOT NULL);"])
+    (let-schema: ([schema '((fish ((id . Natural) (name . String) (weight . Integer))) (cube ((id . Natural) (length . Integer) (width . Integer) (height . Integer))))])
+      (let-connection: ([conn (postgresql-connect: schema #:user "postgres" #:database "travis_ci_test")])
+        (let ([with-transaction (lambda ([thunk : (-> Any)])
+                                  (define maybe-exn
+                                    (with-handlers ([exn? (lambda ([e : exn]) e)])
+                                      (start-transaction conn)
+                                      (thunk)
+                                      #f))
+                                  (rollback-transaction conn)
+                                  (if maybe-exn (raise maybe-exn) (void)))]
+              [insert-fish (lambda ([x : (List String Natural)])
+                             (query-exec conn "INSERT INTO fish (name, weight) VALUES ($1, $2);" (car x) (cadr x)))]
+              [insert-cube (lambda ([x : (List Integer Integer Integer)])
+                             (query-exec conn "INSERT INTO cube (length, width, height) VALUES ($1, $2, $3);" (car x) (cadr x) (caddr x)))])
+          (query-exec conn fish-sql)
+          (query-exec conn cube-sql)
+          (define f1 '("Marlin" 8))
+          (define c1 '(2 4 8))
+          (insert-fish f1)
+          (insert-cube c1)
+          ;; -------------------------------------------------------------------
+          (query-row: conn "SELECT * FROM fish where fish.name = $1")))))
+
+  ;; ===========================================================================
+  ;; === TEST wrong type for actual parameter
+  (let ([fish-sql "CREATE TABLE fish ( id serial PRIMARY KEY, name text UNIQUE NOT NULL, weight int NOT NULL);"]
+        [cube-sql "CREATE TABLE cube ( id serial PRIMARY KEY, length smallint NOT NULL, width integer NOT NULL, height bigint NOT NULL);"])
+    (let-schema: ([schema '((fish ((id . Natural) (name . String) (weight . Integer))) (cube ((id . Natural) (length . Integer) (width . Integer) (height . Integer))))])
+      (let-connection: ([conn (postgresql-connect: schema #:user "postgres" #:database "travis_ci_test")])
+        (let ([with-transaction (lambda ([thunk : (-> Any)])
+                                  (define maybe-exn
+                                    (with-handlers ([exn? (lambda ([e : exn]) e)])
+                                      (start-transaction conn)
+                                      (thunk)
+                                      #f))
+                                  (rollback-transaction conn)
+                                  (if maybe-exn (raise maybe-exn) (void)))]
+              [insert-fish (lambda ([x : (List String Natural)])
+                             (query-exec conn "INSERT INTO fish (name, weight) VALUES ($1, $2);" (car x) (cadr x)))]
+              [insert-cube (lambda ([x : (List Integer Integer Integer)])
+                             (query-exec conn "INSERT INTO cube (length, width, height) VALUES ($1, $2, $3);" (car x) (cadr x) (caddr x)))])
+          (query-exec conn fish-sql)
+          (query-exec conn cube-sql)
+          (define f1 '("Marlin" 8))
+          (define c1 '(2 4 8))
+          (insert-fish f1)
+          (insert-cube c1)
+          ;; -------------------------------------------------------------------
+          (query-row: conn "SELECT * FROM fish where fish.name = $1" 666)))))
+
+  ;; ===========================================================================
+  ;; === TEST skipping query parameter
+  (let ([fish-sql "CREATE TABLE fish ( id serial PRIMARY KEY, name text UNIQUE NOT NULL, weight int NOT NULL);"]
+        [cube-sql "CREATE TABLE cube ( id serial PRIMARY KEY, length smallint NOT NULL, width integer NOT NULL, height bigint NOT NULL);"])
+    (let-schema: ([schema '((fish ((id . Natural) (name . String) (weight . Integer))) (cube ((id . Natural) (length . Integer) (width . Integer) (height . Integer))))])
+      (let-connection: ([conn (postgresql-connect: schema #:user "postgres" #:database "travis_ci_test")])
+        (let ([with-transaction (lambda ([thunk : (-> Any)])
+                                  (define maybe-exn
+                                    (with-handlers ([exn? (lambda ([e : exn]) e)])
+                                      (start-transaction conn)
+                                      (thunk)
+                                      #f))
+                                  (rollback-transaction conn)
+                                  (if maybe-exn (raise maybe-exn) (void)))]
+              [insert-fish (lambda ([x : (List String Natural)])
+                             (query-exec conn "INSERT INTO fish (name, weight) VALUES ($1, $2);" (car x) (cadr x)))]
+              [insert-cube (lambda ([x : (List Integer Integer Integer)])
+                             (query-exec conn "INSERT INTO cube (length, width, height) VALUES ($1, $2, $3);" (car x) (cadr x) (caddr x)))])
+          (query-exec conn fish-sql)
+          (query-exec conn cube-sql)
+          (define f1 '("Marlin" 8))
+          (define c1 '(2 4 8))
+          (insert-fish f1)
+          (insert-cube c1)
+          ;; -------------------------------------------------------------------
+          (query-row: conn "SELECT * FROM fish where fish.name = $3" "Marlin")))))
+
+))

test/db-pass.rkt

@@ -12,11 +12,6 @@
     trivial/vector
     trivial/private/db)
 
-  (require/typed db
-    (start-transaction (-> Connection Void))
-    (rollback-transaction (-> Connection Void))
-    (query-exec (-> Connection String Any * Void)))
-
   (define-type Id Natural)
 
   ;; -- create fake database
@@ -111,6 +106,9 @@
         (ann (vector-length: v) One)
         1))
 
-  ;(query-row: c "SELECT * FROM word WHERE word.word = $1 word.id = $2" "blossom")
+    (let-vector: ([v (query-row: conn "SELECT id, weight FROM fish WHERE fish.name = 'Dorado'")])
-  ;(query-row: c "SELECT * FROM word WHERE word.word = $1 word.id = $4" "blossom" 2)
+      (check-equal? (vector-ref: v 0) 3)
+      (check-equal? (vector-ref: v 1) (fish-weight f3))
+      (check-equal? (vector-length: v) 2))
+
 )))