diff --git a/waltz/macros.fnl b/waltz/macros.fnl new file mode 100644 index 0000000..2580104 --- /dev/null +++ b/waltz/macros.fnl @@ -0,0 +1,17 @@ +; (q X) -> q(X) +; (q :x) -> q(x) +; [(q X) (p X)] -> q(X) :- p(X) + +(fn clause [c] + (match c + (where [:unquote expr] (list? c)) `[:const ,expr] + (where [name & params] (list? c)) `[:literal ,(tostring name) ,(icollect [_ param (ipairs params)] (clause param))] + (where [head & tail] (sequence? c)) `[:clause ,(clause head) ,(icollect [_ elem (ipairs tail)] (clause elem))] + (where v (sym? c)) `[:var ,(tostring v)] + _ `[:const ,c])) + +(fn clauses [...] + (icollect [_ c (ipairs [...]) :into `(values)] (clause c))) + +{: clause : clauses :$ clauses} + diff --git a/waltz/sqlog.fnl b/waltz/sqlog.fnl new file mode 100644 index 0000000..9d90f8a --- /dev/null +++ b/waltz/sqlog.fnl @@ -0,0 +1,101 @@ +; sqlog, a datalog-like system built on sqlite +; may not actually have the full power of datalog OR the full power of sqlite + +; datalog has a database of facts, and rules. facts are represented in sqlite directly as tables. +; rules are used by the sqlog engine when generating queries; typically they take the form +; of subqueries used in the WITH RECURSIVE clause. +; It would be possible to store them as views, but the view would need to be regenerated from +; its base rules anytime there is a change, so sqlog needs to know about them no matter what. +; Making sqlog manage them in-memory also allows us to use it to query arbitrary sqlite databases. + +; Ideally we would persist rules as JSON in a special table; maybe sqlog_rules? + +(local Object (require :core.object)) +(local lume (require :lib.lume)) + +(local Sqlog (Object:extend)) + +; Generating SQL from Datalog should not be too complex, but it pays to start with the simplest +; case and build up from there. + +; simple queries: +; (p x y) -> SELECT p.c1 AS x, p.c2 AS y FROM p +; (p 1 y) -> SELECT p.c2 AS y FROM p WHERE p.c1 = 1 + ; (q x) (p x 1) -> SELECT q.c1 AS x FROM q JOIN p WHERE p.c1 = q.c1 AND p.c2 = 1 +; (p 1 2) -> SELECT true FROM p WHERE p.c1 = 1 AND p.c2 = 2 +; (p 1 x) (p x 2) -> SELECT t1.c2 AS x FROM p AS t1 JOIN p AS t2 WHERE t1.c1 = 1 AND t1.c2 = t2.c1 AND t2.c2 = 2 + +; queries using rules: +; [(ancestor x y) (parent x y)] -> SELECT p.c1 AS x, p.c2 AS y FROM parent AS p +; [(ancestor x y) (parent x z) (ancestor z y)] -> SELECT p.c1 AS x, a.y AS y FROM parent AS p JOIN ancestor AS a WHERE p.c1 = a.x AND p.c2 = a.y +; (ancestor x :john) -> WITH RECURSIVE ancestor(x, y) AS (SELECT ... UNION SELECT ...) SELECT a.c1 AS x FROM ancestor AS a WHERE a.y = 'john' + +(fn Sqlog.new [self] + (set self.tables {}) + (set self.rules {})) + +(fn Sqlog.deftable [self name ...] + "Defines the column names of a table and their expected ordering" + (when (. name self.rules) (error "tables and rules must not overlap")) + (tset self.tables name [...])) + +(fn add-clause [analysis clause] (table.insert analysis.clauses clause)) +(fn append-if-missing [list value] + (when (not (lume.any list #(= $1 value))) + (table.insert list value))) + +(fn Sqlog.reference-name [self analysis name] + (if (. self.rules name) (append-if-missing analysis.referenced-rules name) + (. self.tables name) (append-if-missing analysis.tables name) + (error (.. "Unknown table / rule " name)))) + +(fn Sqlog.reference-variable [self analysis varname name icolumn] + (match (. analysis.variable-mapping varname) + mapping (add-clause analysis [:= mapping [:column name icolumn]]) + nil (do (tset analysis.variable-mapping varname [:column name icolumn]) + (table.insert analysis.variables varname)))) + +(fn Sqlog.analyze-literal [self analysis literal] + (match literal + [:literal name params] (do (self:reference-name analysis name) + (each [icolumn value (ipairs params)] + (match value + [:var varname] (self:reference-variable analysis varname name icolumn) + [:const val] (add-clause analysis [:= [:column name icolumn] [:const val]]) + _ (error (.. "expected var or const, got " (fv value)))))) + _ (error (.. "Expected literal but got " (fv literal))))) + +(fn new-analysis [] {:referenced-rules [] :variables [] :variable-mapping {} :selection [] :clauses [] :tables [] :constants []}) + +(fn Sqlog.gen-expr [self analysis expr] + (match expr + [:const val] (do (table.insert analysis.constants val) "?") + [:column name icolumn] (.. name "." (match (. self.tables name) + colnames (. colnames icolumn) + _ (.. "c" icolumn))) + [:as subexpr name] (.. (self:gen-expr analysis subexpr) " AS " name) + [:= lhs rhs] (.. (self:gen-expr analysis lhs) " = " (self:gen-expr analysis rhs)) + _ (error (.. "Unrecognized expression " (fv expr))))) + +(fn cat [list sep ?f] + (table.concat (icollect [i v (ipairs list)] ((or ?f #$1) v i)) sep)) + +(fn Sqlog.gen-select [self analysis] + (.. "SELECT " + (if (> (length analysis.selection) 0) + (cat analysis.selection ", " #(self:gen-expr analysis $1)) + "true") + " FROM " + (cat (lume.concat analysis.tables analysis.referenced-rules) " JOIN ") + (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)) + (set analysis.selection (icollect [_ varname (ipairs analysis.variables)] [:as (. analysis.variable-mapping varname) varname])) + [(self:gen-select analysis) analysis.constants])) + +Sqlog +