;; lib/minikanren/tests/rdb.sx — relational database queries.
;;
;; Demonstrates how miniKanren can serve as a Datalog-style query engine
;; over fact tables. Tables are SX lists of tuples; the relation just
;; wraps `membero` over the table.

(define
  rdb-employees
  (list
    (list "alice" "engineering" 100000)
    (list "bob" "marketing" 80000)
    (list "carol" "engineering" 90000)
    (list "dave" "engineering" 85000)
    (list "eve" "sales" 75000)))

(define
  rdb-projects
  (list
    (list "alice" "compiler")
    (list "carol" "compiler")
    (list "dave" "runtime")
    (list "alice" "runtime")
    (list "eve" "outreach")))

;; Relation views over the tables.

(define
  employees
  (fn (name dept salary) (membero (list name dept salary) rdb-employees)))

(define
  on-project
  (fn (name project) (membero (list name project) rdb-projects)))

;; --- queries ---

(mk-test
  "rdb-engineering-staff"
  (let
    ((res (run* q (fresh (n s) (employees n "engineering" s) (== q n)))))
    (and
      (= (len res) 3)
      (and
        (some (fn (n) (= n "alice")) res)
        (and
          (some (fn (n) (= n "carol")) res)
          (some (fn (n) (= n "dave")) res)))))
  true)

(mk-test
  "rdb-high-salary"
  (let
    ((res (run* q (fresh (n d s) (employees n d s) (lto-i 85000 s) (== q (list n s))))))
    (and
      (= (len res) 2)
      (and
        (some (fn (r) (= r (list "alice" 100000))) res)
        (some (fn (r) (= r (list "carol" 90000))) res))))
  true)

(mk-test
  "rdb-join-employee-project"
  (let
    ((res (run* q (fresh (n d s) (employees n d s) (on-project n "compiler") (== q n)))))
    (and
      (= (len res) 2)
      (and
        (some (fn (n) (= n "alice")) res)
        (some (fn (n) (= n "carol")) res))))
  true)

(mk-test
  "rdb-engineers-on-runtime"
  (let
    ((res (run* q (fresh (n s) (employees n "engineering" s) (on-project n "runtime") (== q n)))))
    (and
      (= (len res) 2)
      (and
        (some (fn (n) (= n "alice")) res)
        (some (fn (n) (= n "dave")) res))))
  true)

(mk-test
  "rdb-people-on-multiple-projects"
  (let
    ((res (run* q (fresh (n p1 p2) (on-project n p1) (on-project n p2) (nafc (== p1 p2)) (== q n)))))
    (some (fn (n) (= n "alice")) res))
  true)

(mk-tests-run!)