From 0cdcd865c57f382856897f307d835c46cd43ef42 Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Sun, 27 Mar 2022 16:49:22 -0400
Subject: [PATCH] Implement update

---
 waltz/sqlog.fnl   | 29 ++++++++++++++++++++++++++---
 waltz/sqltest.fnl |  2 +-
 2 files changed, 27 insertions(+), 4 deletions(-)

diff --git a/waltz/sqlog.fnl b/waltz/sqlog.fnl
index 1918ed8..64e48d8 100644
--- a/waltz/sqlog.fnl
+++ b/waltz/sqlog.fnl
@@ -68,8 +68,8 @@
 ; 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
-
+; invalid update:
+; (!~ [p (+ x 1) _] [q x]) -> UPDATE p SET c1 = q.c1 + 1 FROM q -- this is valid sql, but it's madness - enforce the first query clause matches table
 
 (fn Sqlog.new [self]
   (set self.tables {})
@@ -141,8 +141,9 @@
                                  (match (. self.tables (. analysis.tables itable))
                                    colnames (. colnames icolumn)
                                    _        (.. "c" icolumn)))
-    [:as subexpr name] (.. (self:gen-expr analysis subexpr) " AS " name)
     [:rowid itable] (.. "_t" itable "._rowid_")
+    [:as subexpr name] (.. (self:gen-expr analysis subexpr) " AS " name)
+    [:set column subexpr] (.. column " = " (self:gen-expr analysis subexpr))
     (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)))))
@@ -188,6 +189,16 @@
         (.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1)))
       "")))
 
+(fn Sqlog.gen-update [self analysis]
+  (.. "UPDATE " (. analysis.tables 1) " AS _t1 SET "
+    (cat analysis.selection ", " #(self:gen-expr analysis $1))
+    (if (>= (length analysis.tables) 2)
+        (.. " FROM " (cat (lume.slice analysis.tables 2) " JOIN " #(.. $1 " AS _t" (+ $2 1))))
+      "")
+    (if (> (length analysis.clauses) 0)
+        (.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1)))
+      "")))
+
 (fn Sqlog.query [self ...]
   (let [analysis (new-analysis)]
     (each [_ literal (ipairs [...])] (self:analyze-literal analysis literal))
@@ -218,5 +229,17 @@
        analysis.constants])
     _ (error (.. "Expected literal, got " (fv head)))))
 
+(fn Sqlog.update [self newhead head ...]
+  (match [newhead head]
+    [[:literal name params] [:literal name]]
+    (let [analysis (new-analysis)
+          columns (. self.tables name)]
+      (each [_ literal (ipairs [head ...])] (self:analyze-literal analysis literal))
+      (set analysis.selection (icollect [icolumn param (ipairs params)]
+                                (match param
+                                  [:var :_] nil
+                                  expr [:set (. columns icolumn) expr])))
+      [(.. (self:gen-with-rules analysis) (self:gen-update analysis)) analysis.constants])))
+
 Sqlog
 
diff --git a/waltz/sqltest.fnl b/waltz/sqltest.fnl
index e81b591..5d16974 100644
--- a/waltz/sqltest.fnl
+++ b/waltz/sqltest.fnl
@@ -10,4 +10,4 @@
   ([generation name (|| name " iii") 3] [ancestor name (|| name " iii")])
   ([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]))
+(pp (update s [p _ (+ y 1)] [p x y] [q x]))