Experiment to create a remote db endpoint for use with om.next

README.md

Aim was to prototype a db remote for om.next including business logic and navigation without introducing a ORM library. That is to say, can I hook up a pull api which provides fairly broad access to a database?

I had an query strategy for how this might not be hideously inefficient. A naive depth first traversal would be simpler but generate a frightening number of queries (in series). Instead I do one query per join and then package up the results.

Inner joins and derived logic are declared in a spec. That allows me to include additional fields needed for joins and connect up the data afterwards. Fun bit there is that the logic declares what data it needs like defui. I imagine logic could be optionally pushed into the db.

It kind of works but ran out of time so not well tested and has known bugs. Logic isn't integrated but should be a small addition.

I figure the schema is a great place to introduce permission tests which would control access.

db_parser.clj

(ns om-starter.db-parser
  (:refer-clojure :exclude [var? key])
  (:require [om.next.impl.parser :as parser]
            [clojure.test :refer :all]
            [korma.db :refer [defdb mssql]]
            [korma.core :as sql]
            [clojure.string :as string])
  (:use clojure.pprint clojure.walk))

(def schema
  {:Races/Meeting
   {:query       [:Races/MeetingId]
    :type        :join
    :on          :Meetings
    :where       '{:Meetings/Id ?Races/MeetingId}
    :cardinality :cardinality/one}

   :Meetings/Races
   {:query       [:Meetings/Id]
    :type        :join
    :on          :Races
    :where       '{:Races/MeetingId ?Meetings/Id}
    :cardinality :cardinality/one}

   :Races/LoggedEvents
   {:query       [:Races/Id]
    :type        :join
    :on          :LoggedEvents
    :where       {:LoggedEvents/RaceId :Races/Id}
    :cardinality :cardinality/many}

   :Races/Title
   {:type   :logic
    :query  [:Races/RaceNumber {:Races/Meeting [{:Meetings/Venue [:Venue/Name]}]}]
    :action (fn [race]
              (str "Race " (:Races/RaceNumber race)
                   " at " (-> race :Races/Meeting :Meetings/Venue :Venue/Name)))}})

(defn var? [x]
  (and (symbol? x)
       (.startsWith (str x) "?")))

(defn var->keyword [x]
  (keyword (.substring (str x) 1)))

(defn get-param [params x]
  {:pre [(coll? params) (keyword? x)]}
  (cond
    (map? params) (x params)
    (coll? params) ['in (mapv x params)]
    :else :not-found))

(defn bind-query [params form]
  (postwalk (fn [x] (if (var? x)
                      (get-param params (var->keyword x))
                      x)) form))

(deftest test-populate-params
  (is (= (var? '?asdf) true))
  (is (= (var? :asdf) false))
  (is (= (var->keyword '?asdf) :asdf))
  (is (= (var->keyword :asdf) :asdf))
  (is (= (bind-query {} {}) {}))
  (is (= (bind-query {:x 1} [:a '?x]) [:a 1]))
  (is (= (bind-query {:x 1} {:a '?x}) {:a 1}))
  (is (= (bind-query {:x 1} [{:a '?x}]) [{:a 1}]))
  (is (= (bind-query {:x 1} [{:a '?x :b ['?x '?x]}]) [{:a 1 :b [1 1]}]))
  (is (= (get-param {:a 1} :b) nil))
  (is (= (get-param {:a 1} :a) 1))
  (is (= (get-param [{:a 1}] :a) '[in [1]]))
  (is (= (bind-query [{:x 1}] [:a '?x]) '[:a [in [1]]]))
  (is (= (bind-query [{:x 1} {:x 2}] [:a '?x]) '[:a [in [1 2]]])))


(defn get-spec
  [schema key]
  (get schema key {:type :prop :key key}))

(defn inner-join-expr [spec ast]
  (let [where-fields (keys (:where spec))
        where-props (map (fn [k] {:type :prop :dispatch-key k :key k}) where-fields)
        x (-> ast
              (assoc :key (:on spec))
              (update :params :where (:where spec))
              (update :children into where-props)
              (update :query into where-fields))]
    (parser/ast->expr x)))

(deftest test-inner-join-expr
  (is (= 1 1)))

(defn join->sql
  [schema query]
  (loop [expr (seq query) props [] joins {}]
    (if-not (nil? expr)
      (let [{:keys [key] :as ast} (-> expr first parser/expr->ast)
            spec (get-spec schema key)]
        (case (:type spec)
          :prop (recur (next expr)
                       (conj props key)
                       joins)
          :join (recur (next expr)
                       (concat props (:query spec))
                       (assoc joins key (inner-join-expr spec ast)))
          (recur (next expr) props joins)))
      [(vec props) joins])))

(deftest test-join->sql
  (is (= (join->sql schema [:Meetings/Id])
         [[:Meetings/Id]
          {}]))
  (is (= (join->sql schema [{:Races/Meeting [:Meetings/MeetDate]}])
         '[[:Races/MeetingId]
           {:Races/Meeting ({:Meetings [:Meetings/MeetDate]}
                             {:Meetings/Id ?Races/MeetingId})}])))

(defn ns-keys
  "Massage results to match our keyword convention of :Table/Field "
  [ns m]
  (into (empty m)
        (for [[k v] m]
          [(keyword (name ns) (name k)) v])))

(defn sql-fields
  "Threading helper"
  [query fields]
  (apply sql/fields query fields))

(defn readf
  "Read from database with relations/logic defined in a schema"
  [{:keys [parser schema query ast] :as env} table params]
  (let [[fields joins] (join->sql schema query)

        ; Fetch table and real props first
        results (->> (sql/select
                       (cond-> (sql/select* table)
                         fields (sql-fields fields)
                         params (sql/where params)))
                     (mapv (partial ns-keys table)))

        ; Now iterate over joins, one query per join then assoc results
        ; into our result graph.
        results (loop [joins (seq joins)
                       results results]
                  (if-not (nil? joins)
                    (let [[k join] (first joins)
                          {:keys [where]} (get-spec schema k)
                          join' (bind-query results join)
                          data (-> (parser env [join']) first second)
                          where-keys (keys where)
                          groups (group-by #(select-keys % where-keys) data)
                          results (for [result results]
                                    (assoc result k (get groups (bind-query result where))))]
                      (recur (next joins) results))
                    results))]

    {:value results}))

(def test-parser (parser/parser {:read readf}))

(pprint (test-parser {:schema schema}
                     '[({:Meetings [{:Meetings/Races [:Races/Title]}]}
                         {:Meetings/Id [in [6465 6466]]})]))