Skip to content

Instantly share code, notes, and snippets.

Last active March 24, 2023 15:57
Show Gist options
  • Save noprompt/6085849 to your computer and use it in GitHub Desktop.
Save noprompt/6085849 to your computer and use it in GitHub Desktop.
A Clojure Cypher query DSL compatible with neocons.
(ns noprompt.cypher
(:require [clojure.string :as str]
[ :as cy]
[clojure.walk :as walk])
(:import java.lang.StringBuilder))
;; Example usage:
;; Query:
(start {:n (node [3 1])}
(where (or (and (< :n.age 30)
(= "Tobias"))
(not (= "Tobias"))))
(return :n))
;; Result:
;; START n=node(3, 1)
;; WHERE ((n.age < 30 and = "Tobias") or not( = "Tobias"))
;; Query:
(start {:a (node 1) :b (node [3 2])}
(match [:a "<-" [:r?] "-" :b])
(where (is r null))
(return :b))
;; Result:
;; START a = node(1), b = node(3,2)
;; MATCH a<-[r?]-b
;; WHERE r is null
;; Queries are fully composable.
(let [base (start* {:a (node 1) :b (node [3 2])})]
(-> base
(match [:a "<-" [:r?] "-" :b])
(where (is r null))
(return :b)))
;; Emacs indentation:
(start* 'defun)
(start 'defun)))
;;;; Utilities
(defn- ^String str*
([] "")
([x] (if (keyword? x)
(name x)
(str x)))
([x & more]
(let [sb (StringBuilder. ^String (str* x))]
(str (reduce #(.append % (str* %2)) sb more)))))
(defn- escape [x]
(if (or (string? x)
(instance? java.util.regex.Pattern x))
(format "\"%s\"" x)
;;;; Operators and functions
(defn- boolean-op [op & tests]
(->> tests
(str/join (format " %s " op))
(format "(%s)")))
(defn- infix-op [op lhs rhs]
(let [lhs (str* lhs)
rhs (escape rhs)]
(format "%s %s %s" lhs op rhs)))
;; Comparision operators
(def comp-= (partial infix-op "="))
(def comp-> (partial infix-op ">"))
(def comp-< (partial infix-op "<"))
(def comp-<= (partial infix-op "<="))
(def comp->= (partial infix-op ">="))
(def comp-<> (partial infix-op "<>"))
;; Boolean operators
(defn bool-not [args]
(format "not(%s)" (str* test)))
(def bool-and (partial boolean-op "and"))
(def bool-or (partial boolean-op "or"))
;; Functions
(def ^:private func-is (partial infix-op "IS"))
(defn- func [name args]
(format "%s(%s)" name (str* args)))
(def func-count (partial func "COUNT"))
(def delete (partial func "DELETE"))
(def has (partial func "HAS"))
;; Render helpers
(defn- render-array [v]
(->> (map str* v)
(str/join ", ")
(format "[%s]")))
(defn- render-value [v]
(sequential? v) (render-array v)
(or (string? v) (keyword? v)) (escape (str* v))
:else (str v)))
;;;; Symbol expansion
(def ^:private sym-map
{;; Comparision operators
'= #'comp-=
'> #'comp->
'< #'comp-<
'>= #'comp->=
'<= #'comp-<=
'<> #'comp-<>
'not= #'comp-<>
;; Boolean operators
'not #'bool-not
'and #'bool-and
'or #'bool-or
;; Functions
'is #'func-is
'count #'func-count})
(defn- expand-form [form]
(fn [val]
(if-let [f (and (seq? val) (sym-map (first val)))]
(cons f (rest val))
(def ^:private empty-query
{:start {}
:match []
:where []
:return []
:limit nil})
;; This is named `begin` instead of `start` because `start` is the
;; name of the public macro.
(defn- begin [query start-map]
{:pre [(map? start-map)]}
(update-in query [:start] merge start-map))
(defn- start-clause [query]
{:pre [(seq (:start query))]}
(->> (:start query)
(map (fn [[k v]] (str* k "=" v)))
(str/join ", ")
(format "START %s")))
(defn- where-clause [query]
(let [exprs (:where query)]
(when (seq exprs)
(str "WHERE " (str/join " and " exprs)))))
;; Pattern rendering.
(defn- render-property [[k v]]
(str* k ":" (render-value v)))
(defn- render-properties [m]
(->> (map render-property m)
(str/join ", ")
(format "{%s}")))
(defn- rel-strategy [[x y & zs]]
(if (and x y)
(if (map? y)
(defmulti ^:private render-rel rel-strategy)
;; Render patterns containing properties.
;; Examples:
;; (render-rel [:wife {:name "Gunhild"}])
;; => "(wife {name: \"Gunhild\"})"
(defmethod render-rel ::property [[ident props]]
(format "(%s %s)" (str* ident) (render-properties props)))
;; Render patterns containing an alias and one or more named
;; relationships.
;; Examples:
;; (render-rel [:r :KNOWS])
;; => "[r:KNOWS]"
;; (render-rel [:r :LIKES :DISLIKES])
;; => "[r:LIKES|DISLIKES]"
(defmethod render-rel ::alias [[alias rel & more]]
(let [[alias rel] (map str* [alias rel])
rel (format "%s:%s" alias rel)
rel (if (seq more)
(->> (map str* more)
(cons rel)
(str/join "|"))
(str "[" rel "]")))
;; Render patterns containing only a single relationship. Pattern
;; values such as :?, :?*, :*n, :*n..m (where n and m are integers),
;; and named relationships (ie. :r:REL_TYPE) are rendered as strings.
;; All other values are rendered as is.
;; Examples:
;; (render-rel [:?])
;; => "[?]"
;; (render-rel [:r:KNOWS])
;; => "[r:KNOWS]"
;; (render-rel ["r"])
;; => "[r]"
;; (render-rel [:LOVES])
;; => "[:LOVES]"
(defmethod render-rel :default [[x]]
(let [rel
(if (-> #"(?:\?\*?|\*\d+(?:\.\.[1-9]\d*)?|[a-zA-Z_]+:[a-zA-Z_]+)"
(re-matches (str* x)))
(str* x)
(str "[" rel "]")))
;; Render an individual pattern part.
(defn- render-pattern-part [p]
(vector? p) (render-rel p)
(and (list? p) (empty? p)) "()"
:else (str* p)))
;; Render a complete Cypher pattern. Patterns may be interleaved with
;; or without path symbols (ie. `-`, `->`, `-->`, etc.). When a path
;; symbol is omitted between elements of the pattern a `-`
;; relationship is inserted.
;; (render-pattern [:me "-->" :friend [:?] "->" :friend_of_friend])
;; => "me-->friend-[?]->friend_of_friend
;; (render-pattern [:me [:MARRIED_TO] [:wife {:name "Gunhild"}]])
;; => "me-[:MARRIED_TO]-(wife {name: \"Gunhild\"})
(defn- render-pattern [pat]
(loop [ps (rest pat)
sb (StringBuilder. (render-pattern-part (first pat)))]
(if-let [p (first ps)]
(let [p1 (render-pattern-part p)]
(if (#{"-" "--" "->" "-->" "<-" "<--"} p1)
(let [p2 (render-pattern-part (second ps))]
(recur (nthnext ps 2) (.. sb (append p1) (append p2))))
(recur (cons "-" ps) sb)))
(str sb))))
(defn- match-clause [query]
(when (seq (:match query))
(->> (:match query)
(map render-pattern)
(str/join ", ")
(format "MATCH %s"))))
(defn- return-clause [query]
{:pre [(seq (:return query))]}
(->> (:return query)
(map str*)
(str/join ", ")
(format "RETURN %s")))
(defn- limit-clause [query]
(when-let [n (:limit query)]
(str "LIMIT " n)))
;;;; Query rendering and executing
(defn- render-query [query]
(->> query
((juxt start-clause
(remove nil?)
(str/join "\n")))
(defn- exec-query [str]
(cy/query str))
(defn exec [query]
(-> query render-query exec-query))
;;;; API
(defn node [v]
(let [v (cond
(= * v) "*"
(sequential? v) (render-array v)
(string? v) (escape v)
:else (str* v))]
(format "node(%s)" v)))
(defn rel [v]
(let [v (cond
(= * v) "*"
(sequential? v) (render-array v)
(string? v) (escape v)
:else (str* v))]
(format "rel(%s)" v)))
(defn where [query & constraints]
(update-in query [:where] into constraints))
(defn match
([query pattern]
(update-in query [:match] conj pattern))
([query pattern & more]
(reduce #(match % %2) (match query pattern) more)))
(defn return [query & returns]
(update-in query [:return] into returns))
(defn limit [query n]
{:pre [(integer? n)]}
(assoc query :limit n))
(defmacro start* [start-map & body]
(let [init (partial begin empty-query)]
`(-> ~(init start-map) ~@(expand-form body))))
(defmacro start [start-map & body]
`(exec (start* ~start-map ~@body)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment