Skip to content

Instantly share code, notes, and snippets.

@olivergeorge
Last active June 28, 2016 00:30
Show Gist options
  • Save olivergeorge/963701655779675288cd to your computer and use it in GitHub Desktop.
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
(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"]]})]))
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