datomic-helpers.clj

(ns datomic-helpers
  (:require [clojure.java.io :as io]
            [clojure.walk    :as walk]
            [datomic.api     :as d :refer (db)]))

;;; Expose Datomic vars here, for convenience

(def tempid  d/tempid)
(def connect d/connect)
(def create-database d/create-database)

;;; Ring middleware

(def ^{:dynamic true :doc "A Datomic database value used over the life of a Ring request."} *db*)
(def ^{:dynamic true :doc "A Datomic connection bound for the life of a Ring request."} *connection*)

(defn transact
  "Run a transaction with a request-consistent connection."
  [tx]
  (d/transact *connection* tx))

(defn q
  "Runs the given query over a request-consistent database as well as
  the other given sources."
  [query & sources]
  (apply d/q query *db* sources))

(defn wrap-datomic
  "A Ring middleware that provides a request-consistent database connection and
  value for the life of a request."
  [handler uri]
  (fn [request]
    (let [conn (d/connect uri)]
      (binding [*connection* conn
                *db*         (db conn)]
        (handler request)))))

(defmacro with-latest-database
  "Runs the body with the latest version of that database bound to
  *db*, rather than the request-consistent database."
  [& body]
  `(binding [*db* (d/db *connection*)]
     ~@body))

;;; Map => Transaction Helpers

(defn- entity?
  [entity]
  (boolean (:db/id entity)))

(defn- entity-collection?
  [coll]
  (and
   (coll? coll)
   (not (map? coll))
   (every? :db/id coll)))

(defn- children
  [entity]
  (filter entity? (vals entity)))

(defn- unpack-ids
  [entity]
  (into {}
        (map (fn [[k v]]
               [k (cond
                   (entity? v)            (:db/id v)
                   (entity-collection? v) (map :db/id v)
                   :default               v)])
             entity)))

(defn map->tx
  "Flattens a tree-like structure of nested maps into a Datomic
  transaction"
  [entity]
  (->> entity
       (tree-seq #(or (entity? %)
                      (entity-collection? %))
                 #(cond
                   (entity? %) (children %)
                   (entity-collection? %) (map children %)
                   :default nil))
       reverse
       (map unpack-ids)
       (into [])))

(defn entity->map
  "Recursively converts entities to tree-like structures of nested
  maps."
  [entity]
  (walk/prewalk
   (fn [e]
     (if (:db/id e)
       (select-keys e
                    (conj (keys e)
                          :db/id))
       e))
   entity))

;;; Rules-based predicates

(defn predicate-from-rules
  "Returns a predicate fn that will return true when the predicate-rules (a subset of
  the source-rules) are satisfied, and false otherwise."
  [source-rules predicate-rules]
  (fn [entity]
    (when entity
      (boolean
       (ffirst
        (q (concat '[:find ?e
                     :in $ $id %
                     :where [(= ?e $id)]]
                   predicate-rules)
           (:db/id entity)
           source-rules))))))

;;; Query

(defn entity
  "Returns the entity if passed an id that is not false-y."
  [id]
  (when id
    (d/entity *db* id)))

(defn entities
  "Returns a set of entities from a [:find ?e ...] query."
  [query-results]
  (into #{}
        (map (comp entity first)
             query-results)))

(defn find-all
  "Returns the set of all results of query over sources."
  [query & sources]
  (entities
   (apply q query sources)))

(defn find-first
  "Returns the first result from query over sources."
  [query & sources]
  (first (apply find-all query sources)))

;;; Enum => HTML <select> options

(def dropdown-schema
  [{:db/id          (tempid :db.part/db)
    :db/ident       :option/text
    :db/valueType   :db.type/string
    :db/index       true
    :db/cardinality :db.cardinality/one
    :db/doc         "The user-facing text content of an option tag"
    :db.install/_attribute :db.part/db}

   {:db/id          (tempid :db.part/db)
    :db/ident       :option/value
    :db/valueType   :db.type/string
    :db/index       true
    :db/cardinality :db.cardinality/one
    :db/doc         "The user-facing value attribute of an option tag"
    :db.install/_attribute :db.part/db}

   {:db/id          (tempid :db.part/db)
    :db/ident       :option/attribute
    :db/valueType   :db.type/ref
    :db/cardinality :db.cardinality/one
    :db/doc         "The attribute to which this option corresponds"
    :db.install/_attribute :db.part/db}])

(defn option-value->ident
  "Given an attribute and an option value, returns the correpsonding datomic entity ident."
  [attribute value]
  (ffirst
   (q '[:find  ?ident
        :in    $ ?attribute ?value
        :where
        [?e :option/value ?value]
        [?e :option/attribute ?a]
        [?e :db/ident ?ident]
        [?a :db/ident ?attribute]]
      attribute
      value)))

(defn attribute->options
  "Returns all the valid options for the given attribute."
  [attribute]
  (find-all
   '[:find  ?e
     :in    $ ?attr
     :where
     [?e :option/attribute ?a]
     [?a :db/ident ?attr]]
   attribute))