A Clojure Cypher query DSL compatible with neocons.

cypher-dsl.clj

(ns noprompt.cypher
  (:require [clojure.string :as str]
            [clojurewerkz.neocons.rest.cypher :as cy]
            [clojure.walk :as walk])
  (:import java.lang.StringBuilder))

;; Example usage:
(comment
  ;; Query:
  (start {:n (node [3 1])}
    (where (or (and (< :n.age 30)
                    (= :n.name "Tobias"))
               (not (= :n.name "Tobias"))))
    (return :n))

  ;; Result:
  ;; START n=node(3, 1)
  ;; WHERE ((n.age < 30 and n.name = "Tobias") or not(n.name = "Tobias"))
  ;; RETURN n

  ;; 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
  ;; RETURN b

  ;; 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:
  (define-clojure-indent
    (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)
    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]
  (cond
   (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]
  (walk/prewalk
   (fn [val]
     (if-let [f (and (seq? val) (sym-map (first val)))]
       (cons f (rest val))
       val))
   form))

(def ^:private empty-query
  {:start {}
   :match []
   :where []
   :return []
   :limit nil})

;; START

;; 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")))

;; WHERE

(defn- where-clause [query]
  (let [exprs (:where query)]
    (when (seq exprs) 
      (str "WHERE " (str/join " and " exprs)))))

;; MATCH

;; 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)
      ::property
      ::alias)))

(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 "|"))
              rel)]
    (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)
          x)]
    (str "[" rel "]")))

;; Render an individual pattern part. 
(defn- render-pattern-part [p]
  (cond
   (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"))))

;; RETURN

(defn- return-clause [query]
  {:pre [(seq (:return query))]}
  (->> (:return query)
       (map str*)
       (str/join ", ")
       (format "RETURN %s")))

;; LIMIT

(defn- limit-clause [query]
  (when-let [n (:limit query)]
    (str "LIMIT " n)))

;;;; Query rendering and executing

(defn- render-query [query]
  (->> query
       ((juxt start-clause
              match-clause
              where-clause
              return-clause
              limit-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)))