Last active
June 28, 2016 00:30
-
-
Save olivergeorge/963701655779675288cd to your computer and use it in GitHub Desktop.
zipper solution for splitting nested relational query (pull spec) into flat select queries which can be stiched together
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns om-starter.relational-mapper | |
(:require [om.next.impl.parser :as parser] | |
[om.next.server :as om] | |
[clojure.zip :as zip :refer [zipper]] | |
[clojure.test :refer [deftest is]]) | |
(:use clojure.pprint)) | |
(defn make-node | |
"Build new om.next ast node making sure query and children match." | |
[old-node children] | |
(assoc old-node | |
:query (mapv parser/ast->expr children) | |
:children (vec children))) | |
(defn path | |
"Fetch path for ast node loc" | |
[loc] | |
(loop [loc loc | |
path (list (-> loc zip/node :key))] | |
(if-let [parent (zip/up loc)] | |
(recur parent (conj path (-> parent zip/node :key))) | |
(vec path)))) | |
(defn join-type | |
"Use path to work out type of relation" | |
[schema loc] | |
(if (zip/up loc) | |
(let [a (-> loc zip/up zip/node :key) | |
b (-> loc zip/node :key)] | |
(get-in schema [a b])))) | |
(defn ast-zip | |
"Build zipper from ast." | |
[ast] | |
(zipper :children :children make-node ast)) | |
(defn shred? | |
"Logic for deciding when to split query: | |
* by default split on has-many | |
* don't split if :include is present and true | |
* force split if :include is present and false | |
" | |
[schema loc] | |
(let [node (zip/node loc) | |
has-many? (= :has-many (join-type schema loc)) | |
root? (nil? (zip/up loc)) | |
params (-> node :params)] | |
(if-not root? | |
(case (get params :include :default) | |
true false | |
false true | |
:default has-many?)))) | |
(defn shred | |
"Process ast zipper. Splits nested relational query into simple select queries." | |
[schema loc] | |
(loop [loc loc ret nil] | |
(if (zip/end? loc) | |
(cons {:ast (zip/root loc)} ret) | |
(if (shred? schema loc) | |
(recur (zip/next (zip/remove loc)) | |
(concat ret (for [query-path (shred schema (ast-zip (zip/node loc)))] | |
(update query-path :path #(concat (path loc) (rest %)))))) | |
(recur (zip/next loc) ret))))) | |
(defn readf | |
[env k params] | |
(let [{:keys [schema query path parser ast]} env | |
loc (ast-zip ast) | |
queries (shred schema (zip/next loc)) | |
value (loop [queries (seq queries) ret nil] | |
(if (seq queries) | |
(let [{:keys [path ast]} (first queries) | |
{:keys [key query params]} ast | |
results (parser/ast->expr ast) | |
ret (if ret (concat ret `((q/select-in ~(vec path) ~results))) | |
`(q/-> (q/select ~results)))] | |
(recur (next queries) ret)) | |
ret))] | |
{:value value})) | |
(def parser (om/parser {:read readf})) | |
(def schema {:race {:meeting :belongs-to | |
:logged-event :has-many} | |
:meeting {:race :has-many | |
:venue :belongs-to} | |
:venue {:meeting :has-many}}) | |
(println "\nSelect meetings, then select associated races") | |
(pprint (parser {:schema schema} '[{:meeting [{:race [*]}]}])) | |
(println "\nSelect meetings and races in one query") | |
(pprint (parser {:schema schema} '[{:meeting [({:race [*]} {:include true})]}])) | |
(println "\nSelect races and join to associated meetings") | |
(pprint (parser {:schema schema} '[{:race [({:meeting [*]} {:include true})]}])) | |
(println "\nSelect races, select meetings after to avoid duplication") | |
(pprint (parser {:schema schema} '[{:race [({:meeting [*]} {:include false})]}])) | |
(println "\nSelect meetings, then select races, then select logged events") | |
(pprint (parser {:schema schema} '[{:meeting [* {:race [:number :time {:logged-event [*]}]}]}])) | |
(println "\nSelect meetings joined on races, then select logged events") | |
(pprint (parser {:schema schema} '[{:meeting [({:race [* {:logged-event [*]}]} {:include true})]}])) | |
(println "\nSelect one day's meetings joined on races, then select logged events") | |
(pprint (parser {:schema schema} '[({:meeting [*]} {:where [:date := "2016-01-01"]})])) | |
(println "\nSelect one day's meetings") | |
(pprint (parser {:schema schema} '[({:meeting [*]} {:where [[:date := "2016-01-01"]]})])) | |
(println "\nSelect one day's meetings, select non-archived races") | |
(pprint (parser {:schema schema} | |
'[({:meeting [* ({:race [*]} | |
{:where [[:is-archived := false]]})]} | |
{:where [[:date := "2016-01-01"]]})])) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Select meetings, then select associated races | |
{:meeting | |
(q/-> | |
(q/select {:meeting []}) | |
(q/select-in [:meeting :race] {:race [*]}))} | |
Select meetings and races in one query | |
{:meeting (q/-> (q/select {:meeting [({:race [*]} {:include true})]}))} | |
Select races and join to associated meetings | |
{:race (q/-> (q/select {:race [({:meeting [*]} {:include true})]}))} | |
Select races, select meetings after to avoid duplication | |
{:race | |
(q/-> | |
(q/select {:race []}) | |
(q/select-in [:race :meeting] ({:meeting [*]} {:include false})))} | |
Select meetings, then select races, then select logged events | |
{:meeting | |
(q/-> | |
(q/select {:meeting [*]}) | |
(q/select-in [:meeting :race] {:race [:number :time]}) | |
(q/select-in [:meeting :race :logged-event] {:logged-event [*]}))} | |
Select meetings joined on races, then select logged events | |
{:meeting | |
(q/-> | |
(q/select {:meeting [({:race [*]} {:include true})]}) | |
(q/select-in [:meeting :race :logged-event] {:logged-event [*]}))} | |
Select one day's meetings joined on races, then select logged events | |
{:meeting | |
(q/-> (q/select ({:meeting [*]} {:where [:date := "2016-01-01"]})))} | |
Select one day's meetings | |
{:meeting | |
(q/-> (q/select ({:meeting [*]} {:where [[:date := "2016-01-01"]]})))} | |
Select one day's meetings, select non-archived races | |
{:meeting | |
(q/-> | |
(q/select ({:meeting [*]} {:where [[:date := "2016-01-01"]]})) | |
(q/select-in | |
[:meeting :race] | |
({:race [*]} {:where [[:is-archived := false]]})))} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment