diff --git a/waltz/macros.fnl b/waltz/macros.fnl index 3a30794..2a72493 100644 --- a/waltz/macros.fnl +++ b/waltz/macros.fnl @@ -1,6 +1,6 @@ -; (q X) -> q(X) -; (q :x) -> q(x) -; (q #(+ 1 2)) -> q(3) +; [q X] -> q(X) +; [q :x] -> q(x) +; [q #(+ 1 2)] -> q(3) (fn clause [c] (match c @@ -14,15 +14,16 @@ (fn clauses [...] (icollect [_ c (ipairs [...]) :into `(values)] (clause c))) -(fn defrule [s ...] - `(: ,s :defrule ,(clauses ...))) +(fn defrule [s ...] `(: ,s :defrule ,(clauses ...))) (fn defrules [s ...] (icollect [_ rule (ipairs [...]) :into `(do)] (defrule s (table.unpack rule)))) -(fn query [s ...] - `(: ,s :query ,(clauses ...))) +(fn query [s ...] `(: ,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} diff --git a/waltz/sqlog.fnl b/waltz/sqlog.fnl index eb2eaad..1918ed8 100644 --- a/waltz/sqlog.fnl +++ b/waltz/sqlog.fnl @@ -54,6 +54,23 @@ ; 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 +; 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] (set self.tables {}) (set self.rules {})) @@ -88,10 +105,11 @@ (error (.. "Unknown table / rule " name)))) (fn Sqlog.reference-variable [self analysis varname expr] - (match (. analysis.variable-mapping varname) - mapping (add-clause analysis [:= mapping expr]) - nil (do (tset analysis.variable-mapping varname expr) - (table.insert analysis.variables varname)))) + (when (not= varname :_) + (match (. analysis.variable-mapping varname) + mapping (add-clause analysis [:= mapping expr]) + nil (do (tset analysis.variable-mapping varname expr) + (table.insert analysis.variables varname))))) (local comparitors (collect [_ op (ipairs [:< :> :<= :>= := :and :or])] op true)) (fn Sqlog.analyze-literal [self analysis literal] @@ -124,6 +142,7 @@ colnames (. colnames icolumn) _ (.. "c" icolumn))) [: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 [op lhs rhs] (. infix-ops op)) (.. "(" (self:gen-expr analysis lhs) " " op " " (self:gen-expr analysis rhs) ")") _ (error (.. "Unrecognized expression " (fv expr))))) @@ -162,8 +181,9 @@ (if (> (length analysis.selection) 0) (cat analysis.selection ", " #(self:gen-expr analysis $1)) "true") - " FROM " - (cat analysis.tables " JOIN " #(.. $1 " AS _t" $2)) + (if (> (length analysis.tables) 0) + (.. " FROM " (cat analysis.tables " JOIN " #(.. $1 " AS _t" $2))) + "") (if (> (length analysis.clauses) 0) (.. " 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])) [(.. (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 diff --git a/waltz/sqltest.fnl b/waltz/sqltest.fnl index d037bf4..e81b591 100644 --- a/waltz/sqltest.fnl +++ b/waltz/sqltest.fnl @@ -1,5 +1,5 @@ (local Sqlog (require :waltz.sqlog)) -(import-macros {: $ : query : defrules} :waltz.macros) +(import-macros {: $ : query : insert : delete : update : defrules} :waltz.macros) (local s (Sqlog)) (s:deftable :parent :parent :child) @@ -8,7 +8,6 @@ (defrules s ([generation name (|| name " jr") 2] [parent name (|| name " jr")]) ([generation name (|| name " iii") 3] [ancestor name (|| name " iii")]) - ([ancestor x y] [parent x y]) - ([ancestor x y] [parent x z] [ancestor z y])) -(pp (query s [generation "bob" descendant nth])) - + ([ancestor x y 1] [parent x y]) + ([ancestor x y (+ gen 1)] [parent x z] [ancestor z y gen])) +(pp (delete s [p 1 x] [q x]))