implement insert and delete
This commit is contained in:
parent
82d04e0649
commit
ea5da24813
|
@ -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}
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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]))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue