[db] split query, just for parsing sql
It's really not that ugly right now I promise
This commit is contained in:
parent
8311a8eaab
commit
df11a7f334
96
private/db/query.rkt
Normal file
96
private/db/query.rkt
Normal file
|
@ -0,0 +1,96 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
;; Parsing SQL queries
|
||||||
|
|
||||||
|
|
||||||
|
(provide
|
||||||
|
query/expand
|
||||||
|
)
|
||||||
|
|
||||||
|
(require
|
||||||
|
trivial/private/common
|
||||||
|
trivial/private/db/schema
|
||||||
|
(only-in racket/port with-input-from-string)
|
||||||
|
(only-in racket/format ~a)
|
||||||
|
(only-in racket/string string-replace)
|
||||||
|
racket/match
|
||||||
|
(for-syntax syntax/parse racket/syntax typed/racket/base)
|
||||||
|
)
|
||||||
|
|
||||||
|
;; =============================================================================
|
||||||
|
|
||||||
|
(define (query-parser stx)
|
||||||
|
(define str (if (string? (syntax-e stx)) (syntax-e stx) (quoted-stx-value? stx)))
|
||||||
|
(and
|
||||||
|
(string? str)
|
||||||
|
(match (with-input-from-string
|
||||||
|
(string-append "(" (sanitize-for-read str) ")")
|
||||||
|
read)
|
||||||
|
[(list (? select?) sel* ... (? from?) database rest* ...)
|
||||||
|
(define flat-sel*
|
||||||
|
(if (and (not (null? sel*))
|
||||||
|
(list? (car sel*)))
|
||||||
|
(if (null? (cdr sel*))
|
||||||
|
(car sel*)
|
||||||
|
(error 'internal-error "Failed to parse query '~a'" str))
|
||||||
|
sel*))
|
||||||
|
(define condition* (condition-parser rest*))
|
||||||
|
(list flat-sel* database condition*)]
|
||||||
|
[_ #f])))
|
||||||
|
|
||||||
|
(define (sanitize-for-read str)
|
||||||
|
(string-replace
|
||||||
|
(string-replace str "," " ")
|
||||||
|
"'" "\""))
|
||||||
|
|
||||||
|
(define (condition-parser v*)
|
||||||
|
(let loop ([v* v*])
|
||||||
|
(match v*
|
||||||
|
['()
|
||||||
|
'()]
|
||||||
|
[(list (or (? where?) (? and?)) db+row '= v rest* ...)
|
||||||
|
(cons (cons (~a db+row) (~a v)) ;; ~a is a little confusing
|
||||||
|
(loop rest*))]
|
||||||
|
[(cons _ rest*)
|
||||||
|
(loop rest*)])))
|
||||||
|
|
||||||
|
(define-values (query-key query? query-def query-let)
|
||||||
|
(make-value-property 'db:query query-parser))
|
||||||
|
(define-syntax-class/predicate query/expand query?)
|
||||||
|
|
||||||
|
;; =============================================================================
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require rackunit rackunit-abbrevs)
|
||||||
|
|
||||||
|
(check-apply* query-parser
|
||||||
|
[#'"SELECT a FROM b"
|
||||||
|
=> '((a) b ())]
|
||||||
|
[#'"select * from c"
|
||||||
|
=> '((*) c ())]
|
||||||
|
[#'"select (a, b, c) from d"
|
||||||
|
=> '((a b c) d ())]
|
||||||
|
[#'"select a, b from d limit 10"
|
||||||
|
=> '((a b) d ())]
|
||||||
|
[#'"select a, b from d limit 10 where d.a = \"hello\""
|
||||||
|
=> '((a b) d (("d.a" . "hello")))]
|
||||||
|
[#'"select a, b from d where a = 'hi' and b = 3"
|
||||||
|
=> '((a b) d (("a" . "hi") ("b" . "3")))]
|
||||||
|
)
|
||||||
|
|
||||||
|
(check-apply* sanitize-for-read
|
||||||
|
["hello"
|
||||||
|
=> "hello"]
|
||||||
|
["what, the, 'heck'"
|
||||||
|
=> "what the \"heck\""]
|
||||||
|
)
|
||||||
|
|
||||||
|
(check-apply* condition-parser
|
||||||
|
['()
|
||||||
|
=> '()]
|
||||||
|
['(limit something = anotherthing)
|
||||||
|
=> '()]
|
||||||
|
['(limit something where a = b and y = zzz)
|
||||||
|
=> '(("a" . "b") ("y" . "zzz"))]
|
||||||
|
)
|
||||||
|
)
|
Loading…
Reference in New Issue
Block a user