; 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 Compiler {})

; 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'
; ([ancestor :bob x] [ancestor x :john]) -> SELECT 'bob' AS c1, a.c1 AS c2 FROM ancestor AS a WHERE a.c2 = 'john'

; queries with arithmetic operations (function calls?)
; [p x y] [q (+ x 1)] -> SELECT p.c1 AS x, p.c2 AS y FROM p JOIN q WHERE q.c1 = p.c1 + 1
; [p (+ x 1) y] [q x] -> SELECT q.c1 AS x, p.c2 AS y FROM p JOIN q WHERE p.c1 = q.c1 + 1
; [p (+ x 1) x] -> SELECT p.c2 AS x FROM p WHERE p.c1 = p.c2 + 1

; queries with comparisons
; [p x y] (< x 5) -> SELECT p.c1 AS x, p.c2 AS y FROM p WHERE p.c1 < 5
; [p x y] (= x y) -> unnecessary but supported, can be written (p x x)
; [p x y] (= x (+ y 1)) -> unnecessary but supported, can be written (p (+ x 1) x)?

; confusing expressions we probably won't support:
; [p (+ x 1) (* x 2)] -> SELECT p.c1 - 1 AS x FROM p WHERE p.c1 + 1 = p.c2 * 2??
; no, that's not right - this says x+1 = c1 AND x*2 = c2
; [p (+ x 1) (* x 2)] -> SELECT p.c1 - 1 AS x FROM p WHERE p.c2 = (p.c1 - 1) * 2
; [p (+ x 1) y] -> meaningless? or...
;               -> SELECT p.c1 - 1 AS x, p.c2 AS y FROM p
; is there a way to trick sql into generating x = p.c1 - 1 from p.c1 = x + 1?
; [p z y] (= z (+ x 1))

; 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
; 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 cat [list sep ?f]
  "Join all the elements in list with the string sep. If ?f is supplied, it is called to transform each value in the list into a new value first."
  (table.concat (icollect [i v (ipairs list)] ((or ?f #$1) v i)) sep))

(fn any [list pred]
  "Returns true if the supplied predicate function returns true for any values in list."
  (var found false)
  (each [_ v (ipairs list) :until found] (set found (pred v)))
  found)

(fn append-if-missing [list value]
  "Adds value to the end of list if it is not currently included."
  (when (not (any list #(= $1 value)))
    (table.insert list value)))

(fn countiter [max]
  "An iterator that counts from 1 to max, inclusive."
  (fn [_ iprev]
    (let [i (if iprev (+ iprev 1) 1)]
      (when (<= i max) i))))

(fn quoteid [name] (.. "\"" (name:gsub "\"" "\"\"") "\""))

(fn Compiler.new [self]
  (set self.tables {})
  (set self.rules {}))

(fn Compiler.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 [...])
  {:query (.. "CREATE TABLE " (quoteid name) "(" (cat [...] ", " quoteid)
              ", PRIMARY KEY (" (cat [...] ", " quoteid) "))")
   :constants []
   :selection []})

(fn Compiler.defrule [self head ...]
  "Defines a new rule or expands the definition of an existing rule."
  (match head
    [:literal name] (let [rulelist (or (. self.rules name) [])]
                      (table.insert rulelist [head ...])
                      (tset self.rules name rulelist))
    _ (error "Expected literal for head, got " (fv head))))

(fn new-analysis [?parent]
  "Creates a new empty analysis object. If ?parent is supplied, share the list of constants and referenced rules, as these are shared
   with the full SQL expression."
  {:variables [] ; list of all variable names referenced; used to determine which values to return from a query
   :variable-mapping {} ; a mapping from variable name to a SQL expr to which it is equal
   :selection [] ; list of all columns being selected, generally of the form [:as expr name]
   :clauses [] ; list of WHERE clauses, to be joined together by AND
   :tables [] ; list of tables or rules queried. (. tables 1) is generally aliased to _t1. All tables are inner joined.
   :constants (or (?. ?parent :constants) []) ; list of constant values to be bound to the prepared SQL expression
   :referenced-rules (or (?. ?parent :referenced-rules) [])}) ; list of all rules referenced by this expression, so they can be included

(fn add-clause [analysis clause] (table.insert analysis.clauses clause))

(fn Compiler.reference-name [self analysis name]
  "Called when a query references a new table. Appends the table or rule name to the end of analysis.tables
   and returns the index of the new value. Also updates analysis.referenced-rules as needed."
  (if (or (. self.rules name) (. self.tables name))
      (do (table.insert analysis.tables name)
          (when (. self.rules name)
            (append-if-missing analysis.referenced-rules name))
          (length analysis.tables))
    (error (.. "Unknown table / rule " name))))

(fn Compiler.reference-variable [self analysis varname expr]
  "Called when a query expression (expr) is known to be equal to the value of varname - usually because
   the variable appears in the position of a particular rule or column. Defines a mapping from variable
   to expression if none exists, otherwise adds a new clause testing that the original mapping is equal
   to this new mapping, implementing unification."
  (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)))))

; These are SQL functions that return boolean values and can be used as a standalone clause.
(local comparitors (collect [_ op (ipairs [:< :> :<= :>= := :and :or])] op true))
(fn Compiler.analyze-literal [self analysis literal]
  "Adds a literal of the form [table expr expr expr...] or a comparison expression of the form (op expr expr) to
   the analysis object. Typically this implies a join and some number of WHERE clauses."
  (match literal
    [:literal name params] (let [itable (self:reference-name analysis name)]
                             (each [icolumn value (ipairs params)]
                               (match value
                                 [:var varname] (self:reference-variable analysis varname [:column itable icolumn])
                                 [:const val]   (add-clause analysis [:= [:column itable icolumn] [:const val]])
                                 (where [op] (= (. comparitors op) nil)) (add-clause analysis [:= [:column itable icolumn] value])
                                 _ (error (.. "expected var, const, or function, got " (fv value))))))
    (where [op] (. comparitors op)) (add-clause analysis literal)
    _ (error (.. "Expected literal or comparison but got " (fv literal)))))

(local infix-ops (collect [_ op (ipairs [:+ :- :* :/ :< :> :<= :>= := :|| :and :or :%])] op true))
(fn Compiler.gen-expr [self analysis expr]
  "Generates SQL code for a given expression tree."
  (match expr
    [:const val] (do (table.insert analysis.constants val) "?")
    [:column itable icolumn] (.. "_t" itable "."
                                 (match (. self.tables (. analysis.tables itable))
                                   colnames (quoteid (. colnames icolumn))
                                   _        (.. "c" icolumn)))
    [:rowid itable] (.. "_t" itable "._rowid_")
    [:as subexpr name] (.. (self:gen-expr analysis subexpr) " AS " (quoteid name))
    [:set column subexpr] (.. (quoteid column) " = " (self:gen-expr analysis subexpr))
    [:case & clauses] (.. "CASE " (cat clauses " " #(self:gen-expr analysis $1)) " END")
    [:when cmp result] (.. "WHEN " (self:gen-expr analysis cmp) " THEN " (self:gen-expr analysis result))
    [:else result] (.. "ELSE " (self:gen-expr analysis result))
    (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) ")")
    [funcname & args] (.. funcname "(" (cat args ", " #(self:gen-expr analysis $1)) ")")
    _ (error (.. "Unrecognized expression " (fv expr)))))

(fn Compiler.gen-rule-clause [self analysis-parent [head & literals]]
  "Generates a SELECT statement for a given rule (potentially in a family of rules with the same name to be unioned together)"
  (let [analysis (new-analysis analysis-parent)]
    (each [_ literal (ipairs literals)] (self:analyze-literal analysis literal))
    (match head
      [:literal name params]
      (set analysis.selection (icollect [icolumn param (ipairs params)] [:as param (.. :c icolumn)]))
      _ (error (.. "Expected literal, got " (fv head))))
    (self:gen-select analysis)))

(fn Compiler.gen-rule [self analysis name]
  "Generates a full expression for a rule family with the given name, to be placed in a WITH RECURSIVE block."
  (let [rule (. self.rules name)
        column-count (match rule
                       [[[:literal _ clauses]]] (length clauses)
                       _ (error (.. "Rule should be list of list of literals, was " (fv rule))))]
    (.. (quoteid name) "(" (table.concat (icollect [i (countiter column-count)] (.. "c" i)) ", ") ") AS NOT MATERIALIZED ("
        (cat rule " UNION " #(self:gen-rule-clause analysis $1)) ")")))

(fn Compiler.gen-with-rules [self analysis]
  "Generates a WITH block containing all of the referenced rules found during analysis. Will append to the referenced-rules list
   as needed if rules depend on other rules, and only return when all requirements are satisfied."
  (let [rulequeries []]
    ; ipairs will iterate over all referenced-rules even if gen-rule causes more to be appended
    (each [_ name (ipairs analysis.referenced-rules)]
      (table.insert rulequeries (self:gen-rule analysis name)))
    (if (> (length rulequeries) 0)
        (.. "WITH RECURSIVE " (cat rulequeries ", ") " ")
      "")))

(fn Compiler.gen-select [self analysis]
  "Generates a SELECT statement for the query defined by analysis."
  (.. "SELECT "
    (if (> (length analysis.selection) 0)
        (cat analysis.selection ", " #(self:gen-expr analysis $1))
      "true")
    (if (> (length analysis.tables) 0)
        (.. " FROM " (cat analysis.tables " JOIN " #(.. (quoteid $1) " AS _t" $2)))
      "")
    (if (> (length analysis.clauses) 0)
        (.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1)))
      "")))

(fn tail [[ _ & result]] result)
(fn Compiler.gen-update [self analysis]
  "Generates an UPDATE statement for the query defined by analysis."
  (.. "UPDATE " (quoteid (. analysis.tables 1)) " AS _t1 SET "
    (cat analysis.selection ", " #(self:gen-expr analysis $1))
    (if (>= (length analysis.tables) 2)
        (.. " FROM " (cat (tail analysis.tables) " JOIN " #(.. (quoteid $1) " AS _t" (+ $2 1))))
      "")
    (if (> (length analysis.clauses) 0)
        (.. " WHERE " (cat analysis.clauses " AND " #(self:gen-expr analysis $1)))
      "")))

(fn Compiler.query [self ...]
  "Analyzes the given literals and generates an appropriate SELECT statement."
  (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]))
    (set analysis.query (.. (self:gen-with-rules analysis) (self:gen-select analysis)))
    analysis))

(fn Compiler.insert [self head ...]
  "Analyzes the given literals and generates an appropriate INSERT statement."
  (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)])))
      (set analysis.query (.. (self:gen-with-rules analysis)
                              "INSERT INTO " (quoteid name) " (" (cat analysis.selection ", " #(match $1 [:as _ column] (quoteid column))) ") "
                              (self:gen-select analysis)))
      analysis)
    _ (error (.. "Expected literal, got " (fv head)))))

(fn Compiler.delete [self head ...]
  "Analyzes the given literals and generates an appropriate DELETE statement."
  (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_]])
      (set analysis.query (.. (self:gen-with-rules analysis) "DELETE FROM " (quoteid name) " WHERE _rowid_ IN (" (self:gen-select analysis) ")"))
      analysis)
    _ (error (.. "Expected literal, got " (fv head)))))

(fn Compiler.update [self newhead head ...]
  "Analyzes the given literals and generates an appropriate UPDATE statement."
  (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])))
      (set analysis.query (.. (self:gen-with-rules analysis) (self:gen-update analysis)))
      analysis)))

(setmetatable Compiler {:__call (fn [cls ...] (doto (setmetatable {} {:__index cls} ) (: :new ...)))})