#lang racket/base ;; Copyright (c) 2018 Joel Dueck. ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. ;; A copy of the License is included with this source code, in the ;; file "LICENSE.txt". ;; You may also 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. ;; ;; Author contact information: ;; joel@jdueck.net ;; https://joeldueck.com ;; ------------------------------------------------------------------------- ;; Provides a very light set of utility functions for a SQLite database. ;; These functions are completely agnostic as to the database schema. ;; These functions are NOT SAFE for use with data provided by untrusted users! (require db/sqlite3 db/base racket/list racket/match racket/function racket/contract sugar/coerce) (module+ test (require rackunit)) (provide (all-from-out db/base db/sqlite3)) (provide sqltools:dbc sqltools:log-queries?) (provide (contract-out ;; Utility functions [log-query (string? . -> . void?)] [vector->hash (vector? (listof symbolish?) . -> . hash?)] [backtick (stringish? . -> . string?)] [list->sql-fields ((listof stringish?) . -> . string?)] [list->sql-parameters ((listof any/c) . -> . string?)] [bool->int (any/c . -> . exact-integer?)] [int->bool (exact-integer? . -> . boolean?)] ;; Simple SQL makers [make-table-schema ((string? (listof stringish?)) (#:primary-key-cols (listof stringish?)) . ->* . string?)] [make-insert/replace-query (stringish? (listof stringish?) . -> . string?)] [make-select-query (stringish? (listof stringish?) #:where string? . -> . string?)] ;; Database operations [init-db! ((pathish?) #:rest (listof string?) . ->* . void?)] [query! ((string?) #:rest (listof any/c) . ->* . void?)] [select-rows! (case-> (stringish? (listof stringish?) any/c . -> . (or/c empty? hash?)) (string? (listof stringish?) . -> . (or/c empty? hash?)))])) ;; ~~~ Private use ~~~ (define uninitialized-connection "No DB connection!") (define (weave xs ys) (for/fold [(woven null) #:result (reverse woven)] ([x (in-list xs)] [y (in-list ys)]) (cons y (cons x woven)))) ;; ~~~ Provided parameters ~~~ (define sqltools:dbc (make-parameter uninitialized-connection)) (define sqltools:log-queries? (make-parameter #f)) ;; ~~~ Provided utility functions ~~~ (define (backtick str) (format "`~a`" str)) (define (list->sql-fields fields) (apply string-append (add-between (map backtick fields) ", "))) (define (list->sql-parameters fields) (apply string-append (add-between (map (λ(x) (format "?~a" (add1 x))) (range (length fields))) ", "))) ;; For storing/reading boolean values (SQLite uses integers) (define (bool->int b?) (cond [b? 1] [else 0])) (define (int->bool i) (not (= i 0))) ;; TESTING: utility functions… (module+ test (check-equal? (backtick "field") "`field`") (check-equal? (list->sql-fields '("f1" "f2" "f3")) "`f1`, `f2`, `f3`") (check-equal? (list->sql-fields '(f1 f2 f3)) "`f1`, `f2`, `f3`") ; Can use symbols too (check-equal? (list->sql-parameters '("name" "rank" "serial")) "?1, ?2, ?3") (check-equal? (list->sql-parameters '(name rank serial)) "?1, ?2, ?3") (check-equal? (weave '(x y z) '(1 2 3)) '(x 1 y 2 z 3)) (check-equal? (bool->int #f) 0) (check-equal? (bool->int #t) 1) (check-equal? (bool->int "xblargh") 1) (check-equal? (int->bool 0) #f) (check-equal? (int->bool 1) #t) (check-equal? (int->bool -1) #t) (check-equal? (int->bool 37) #t) (check-exn exn:fail? (lambda () (int->bool "x")))) ;; ~~~ Public functions ~~~ ;; Prints to stdout if logging is on (define (log-query q) (unless (not (sqltools:log-queries?)) (println q))) ;; Using a list of field names, convert a vector into a hash that uses the ;; field names (in symbol form) for keys. ;; Racket’s db functions all return vectors; hashes are much easier to use. ;; If fields and v are not equal in length, the unpairable elements are omitted ;; from the hash! (define (vector->hash v fields) (cond [(zero? (vector-length v)) null] [else (let ([keys (map ->symbol fields)] [vals (vector->list v)]) (apply hash (weave keys vals)))])) ;; TESTING: vector->hash... (module+ test (let ([test-row '#("Joe" "PFC" 123)] [test-cols-SYMBOL '(name rank serial)] [test-cols-STRING '("name" "rank" "serial")] [desired-result '#hash((serial . 123) (rank . "PFC") (name . "Joe"))]) (check-equal? (vector->hash test-row test-cols-SYMBOL) desired-result) (check-equal? (vector->hash test-row test-cols-STRING) desired-result)) ;; Behavior when v and fields are unequal in length: (check-equal? (vector->hash '#("foo" "bar") '(a b c)) '#hash((a . "foo") (b . "bar"))) (check-equal? (vector->hash '#("foo" "bar" "baz") '(a b)) '#hash((a . "foo") (b . "bar")))) ;; Create a simple table schema from a list of fields, optionally specifying ;; primary key (define (make-table-schema tablename fields #:primary-key-cols [primary-cols '()]) (define primary-key (format "PRIMARY KEY (~a)" (list->sql-fields (if (empty? primary-cols) (list (first fields)) primary-cols)))) (format "CREATE TABLE IF NOT EXISTS `~a` (~a, ~a);" tablename (list->sql-fields fields) primary-key)) ;; Create a query that inserts a row if it doesn’t exist (based on the first ;; column only), or updates it if it does. The returned query is parameterized, ;; and must be used with a list of values equal in length to the number of ;; fields given. (define (make-insert/replace-query tablename fields) (format "INSERT OR REPLACE INTO `~a` (`rowid`, ~a) values ((SELECT `rowid` FROM `~a` WHERE `~a`= ?1), ~a)" tablename (list->sql-fields fields) tablename (first fields) (list->sql-parameters fields))) ;; Simple row selection (define (make-select-query table fields #:where where-clause) (format "SELECT ~a FROM `~a` WHERE ~a" (list->sql-fields fields) table where-clause)) ;; TESTING: SQL query makers... (module+ test (check-equal? (make-table-schema 'posts '(title date)) "CREATE TABLE IF NOT EXISTS `posts` (`title`, `date`, PRIMARY KEY (`title`));") (check-equal? (make-table-schema "posts" '("title" "date")) "CREATE TABLE IF NOT EXISTS `posts` (`title`, `date`, PRIMARY KEY (`title`));") (check-equal? (make-table-schema 'posts '(title date) #:primary-key-cols '(author date)) "CREATE TABLE IF NOT EXISTS `posts` (`title`, `date`, PRIMARY KEY (`author`, `date`));") (check-equal? (make-insert/replace-query 'posts '(author title)) (string-append "INSERT OR REPLACE INTO `posts` (`rowid`, `author`, `title`) " "values ((SELECT `rowid` FROM `posts` WHERE `author`= ?1), ?1, ?2)")) (check-equal? (make-select-query 'posts '(author title) #:where 1) "SELECT `author`, `title` FROM `posts` WHERE 1")) (define (good-connection?) (and (connection? (sqltools:dbc)) (connected? (sqltools:dbc)))) ;; Initialize the database connection, creating the database if it does not yet exist ;; and running any provided queries (e.g., "CREATE TABLE IF NOT EXISTS...") (define (init-db! filename . qs) (sqltools:dbc (sqlite3-connect #:database filename #:mode 'create)) (unless (empty? qs) (for ([q (in-list qs)]) (query! q)))) ;; Run a query with logging (if enabled) and return the result (define (query! q . parameters) (unless (good-connection?) (error "(query!) DB not connected")) (log-query q) (apply query-exec (sqltools:dbc) q parameters)) ;; Run a SELECT query, return a hash with field names as keys (define select-rows! (case-lambda ;; Use arbitrary query [(query fieldnames) (unless (good-connection?) (error "(select-rows!) DB not connected")) (log-query query) (define result (query-rows (sqltools:dbc) query)) (map (curryr vector->hash fieldnames) result)] ;; Use a simple SELECT FROM WHERE template [(table fields where-clause) (unless (good-connection?) (error "(select-rows!) DB not connected")) (define query (make-select-query table fields #:where where-clause)) (log-query query) (define result (query-rows (sqltools:dbc) query)) (map (curryr vector->hash fields) result)])) ;; TESTING: database connection state and queries (module+ test (define TESTDB "SQLITE-TOOLS-TEST.sqlite") ;; Check that things start out uninitialized and that queries don’t work (check-equal? (sqltools:dbc) uninitialized-connection) (check-false (file-exists? TESTDB)) (check-exn exn:fail? (lambda () (query! "-- nothing"))) (check-exn exn:fail? (lambda () (select-rows! 'posts '(title) 1))) ;; Initialize db connection, create file with no schema (test-begin (check-equal? (init-db! TESTDB) (void)) (check-true (file-exists? TESTDB)) (delete-file TESTDB)) ;; Initialize new db/connection, create file with schema, check that ;; simple queries return expected results (test-begin (check-equal? (init-db! TESTDB (make-table-schema 'posts '(title date))) (void)) (check-true (file-exists? TESTDB)) (check-equal? (select-rows! (make-select-query 'posts '(title date) #:where 1) '(title date)) null) (check-equal? (query! (make-insert/replace-query 'posts '(title date)) "Hello" "2018-08-10") (void)) (check-equal? (select-rows! 'posts '(title date) "`date`='2018-08-10'") '(#hash((title . "Hello") (date . "2018-08-10"))))) ;; Clean up (disconnect (sqltools:dbc)) (sqltools:dbc uninitialized-connection) (delete-file TESTDB))