implement insert and delete

This commit is contained in:
Jeremy Penner 2022-03-27 16:23:28 -04:00
parent 82d04e0649
commit ea5da24813
3 changed files with 63 additions and 19 deletions

View file

@ -1,6 +1,6 @@
; (q X) -> q(X) ; [q X] -> q(X)
; (q :x) -> q(x) ; [q :x] -> q(x)
; (q #(+ 1 2)) -> q(3) ; [q #(+ 1 2)] -> q(3)
(fn clause [c] (fn clause [c]
(match c (match c
@ -14,15 +14,16 @@
(fn clauses [...] (fn clauses [...]
(icollect [_ c (ipairs [...]) :into `(values)] (clause c))) (icollect [_ c (ipairs [...]) :into `(values)] (clause c)))
(fn defrule [s ...] (fn defrule [s ...] `(: ,s :defrule ,(clauses ...)))
`(: ,s :defrule ,(clauses ...)))
(fn defrules [s ...] (fn defrules [s ...]
(icollect [_ rule (ipairs [...]) :into `(do)] (icollect [_ rule (ipairs [...]) :into `(do)]
(defrule s (table.unpack rule)))) (defrule s (table.unpack rule))))
(fn query [s ...] (fn query [s ...] `(: ,s :query ,(clauses ...)))
`(: ,s :query ,(clauses ...))) (fn insert [s ...] `(: ,s :insert ,(clauses ...)))
(fn delete [s ...] `(: ,s :delete ,(clauses ...)))
(fn update [s ...] `(: ,s :update ,(clauses ...)))
{: clause : clauses :$ clauses : defrule : defrules : query} {: clause : clauses :$ clauses : defrule : defrules : query : insert : delete : update}

View file

@ -54,6 +54,23 @@
; unsupported: inline comparisons ; unsupported: inline comparisons
; [p (< x 5) y] -> SELECT p.c1 AS x, p.c2 AS y FROM p WHERE p.c1 < 5 -- does this make sense? seems hard to read, hard to parse ; [p (< x 5) y] -> SELECT p.c1 AS x, p.c2 AS y FROM p WHERE p.c1 < 5 -- does this make sense? seems hard to read, hard to parse
; insert:
; [p 1 2] -> INSERT INTO p (c1, c2) VALUES (1, 2)
; [p 1 (+ 2 3)] -> INSERT INTO p (c1, c2) VALUES (1, 2 + 3)
; (!+ [p (+ x 1) 3] [q x]) -> INSERT INTO p (c1, c2) SELECT q.c1 + 1 AS c1, 3 AS c2 FROM q
; delete:
; (!- [p _ _]) -> DELETE FROM p
; (!- [p 1 _]) -> DELETE FROM p WHERE p.c1 = 1
; augh sqlite doesn't support joins on delete! The most generic solution:
; (!- [p 1 x] [q x]) -> DELETE FROM p WHERE p._rowid_ IN (SELECT p._rowid_ FROM p JOIN q WHERE p.c1 = 1 AND p.c2 = q.c1)
; update:
; (!~ [q (+ x 1)] [q x]) -> UPDATE q SET c1 = q.c1 + 1
; (!~ [p (+ x 1) _] [p x 3]) -> UPDATE p SET c1 = p.c1 + 1 WHERE p.c2 = 3
; (!~ [p (+ x 1) _] [q x]) -> UPDATE p SET c1 = q.c1 + 1 FROM q -- this is madness but might be valid sql?? if q only has one row
(fn Sqlog.new [self] (fn Sqlog.new [self]
(set self.tables {}) (set self.tables {})
(set self.rules {})) (set self.rules {}))
@ -88,10 +105,11 @@
(error (.. "Unknown table / rule " name)))) (error (.. "Unknown table / rule " name))))
(fn Sqlog.reference-variable [self analysis varname expr] (fn Sqlog.reference-variable [self analysis varname expr]
(when (not= varname :_)
(match (. analysis.variable-mapping varname) (match (. analysis.variable-mapping varname)
mapping (add-clause analysis [:= mapping expr]) mapping (add-clause analysis [:= mapping expr])
nil (do (tset analysis.variable-mapping varname expr) nil (do (tset analysis.variable-mapping varname expr)
(table.insert analysis.variables varname)))) (table.insert analysis.variables varname)))))
(local comparitors (collect [_ op (ipairs [:< :> :<= :>= := :and :or])] op true)) (local comparitors (collect [_ op (ipairs [:< :> :<= :>= := :and :or])] op true))
(fn Sqlog.analyze-literal [self analysis literal] (fn Sqlog.analyze-literal [self analysis literal]
@ -124,6 +142,7 @@
colnames (. colnames icolumn) colnames (. colnames icolumn)
_ (.. "c" icolumn))) _ (.. "c" icolumn)))
[:as subexpr name] (.. (self:gen-expr analysis subexpr) " AS " name) [:as subexpr name] (.. (self:gen-expr analysis subexpr) " AS " name)
[:rowid itable] (.. "_t" itable "._rowid_")
(where [:var name] (. analysis.variable-mapping name)) (self:gen-expr analysis (. analysis.variable-mapping name)) (where [:var name] (. analysis.variable-mapping name)) (self:gen-expr analysis (. analysis.variable-mapping name))
(where [op lhs rhs] (. infix-ops op)) (.. "(" (self:gen-expr analysis lhs) " " op " " (self:gen-expr analysis rhs) ")") (where [op lhs rhs] (. infix-ops op)) (.. "(" (self:gen-expr analysis lhs) " " op " " (self:gen-expr analysis rhs) ")")
_ (error (.. "Unrecognized expression " (fv expr))))) _ (error (.. "Unrecognized expression " (fv expr)))))
@ -162,8 +181,9 @@
(if (> (length analysis.selection) 0) (if (> (length analysis.selection) 0)
(cat analysis.selection ", " #(self:gen-expr analysis $1)) (cat analysis.selection ", " #(self:gen-expr analysis $1))
"true") "true")
" FROM " (if (> (length analysis.tables) 0)
(cat analysis.tables " JOIN " #(.. $1 " AS _t" $2)) (.. " FROM " (cat analysis.tables " JOIN " #(.. $1 " AS _t" $2)))
"")
(if (> (length analysis.clauses) 0) (if (> (length analysis.clauses) 0)
(.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1))) (.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1)))
""))) "")))
@ -174,5 +194,29 @@
(set analysis.selection (icollect [_ varname (ipairs analysis.variables)] [:as (. analysis.variable-mapping varname) varname])) (set analysis.selection (icollect [_ varname (ipairs analysis.variables)] [:as (. analysis.variable-mapping varname) varname]))
[(.. (self:gen-with-rules analysis) (self:gen-select analysis)) analysis.constants])) [(.. (self:gen-with-rules analysis) (self:gen-select analysis)) analysis.constants]))
(fn Sqlog.insert [self head ...]
(match head
[:literal name params]
(let [analysis (new-analysis)
columns (. self.tables name)]
(each [_ literal (ipairs [...])] (self:analyze-literal analysis literal))
(set analysis.selection (icollect [icolumn param (ipairs params)]
(match param
[:var :_] nil
expr [:as expr (. columns icolumn)])))
[(.. (self:gen-with-rules analysis) "INSERT INTO " name " (" (cat analysis.selection ", " #(match $1 [:as _ column] column)) ") " (self:gen-select analysis))
analysis.constants])
_ (error (.. "Expected literal, got " (fv head)))))
(fn Sqlog.delete [self head ...]
(match head
[:literal name params]
(let [analysis (new-analysis)]
(each [_ literal (ipairs [head ...])] (self:analyze-literal analysis literal))
(set analysis.selection [[:as [:rowid 1] :_rowid_]])
[(.. (self:gen-with-rules analysis) "DELETE FROM " name " WHERE _rowid_ IN (" (self:gen-select analysis) ")")
analysis.constants])
_ (error (.. "Expected literal, got " (fv head)))))
Sqlog Sqlog

View file

@ -1,5 +1,5 @@
(local Sqlog (require :waltz.sqlog)) (local Sqlog (require :waltz.sqlog))
(import-macros {: $ : query : defrules} :waltz.macros) (import-macros {: $ : query : insert : delete : update : defrules} :waltz.macros)
(local s (Sqlog)) (local s (Sqlog))
(s:deftable :parent :parent :child) (s:deftable :parent :parent :child)
@ -8,7 +8,6 @@
(defrules s (defrules s
([generation name (|| name " jr") 2] [parent name (|| name " jr")]) ([generation name (|| name " jr") 2] [parent name (|| name " jr")])
([generation name (|| name " iii") 3] [ancestor name (|| name " iii")]) ([generation name (|| name " iii") 3] [ancestor name (|| name " iii")])
([ancestor x y] [parent x y]) ([ancestor x y 1] [parent x y])
([ancestor x y] [parent x z] [ancestor z y])) ([ancestor x y (+ gen 1)] [parent x z] [ancestor z y gen]))
(pp (query s [generation "bob" descendant nth])) (pp (delete s [p 1 x] [q x]))