implement insert and delete

waltz/macros.fnl

@@ -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]
   (match c
@@ -14,15 +14,16 @@
 (fn clauses [...]
   (icollect [_ c (ipairs [...]) :into `(values)] (clause c)))
 
-(fn defrule [s ...]
+(fn defrule [s ...] `(: ,s :defrule ,(clauses ...)))
-  `(: ,s :defrule ,(clauses ...)))
 
 (fn defrules [s ...]
   (icollect [_ rule (ipairs [...]) :into `(do)]
     (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}
 

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)
+  (when (not= varname :_)
-    mapping (add-clause analysis [:= mapping expr])
+    (match (. analysis.variable-mapping varname)
-    nil (do (tset analysis.variable-mapping varname expr)
+      mapping (add-clause analysis [:= mapping expr])
-            (table.insert analysis.variables varname))))
+      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 "
+    (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)
         (.. " 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
 

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 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]))
-