lacinia-alt-executor.clj

(ns executor)

(defrecord GraphqlResult [errors data])

(defn result
  ([v] (result nil v))
  ([e v] (->GraphqlResult e v)))

(defn result? [v] (instance? GraphqlResult v))

; Resolver is a function that takes context/query and returns a single-item channel of GraphqlResult
; (fn [ctx] (go (->GraphqlResult nil "a")))

(comment
  "Sample use"
  (defn user-resolver [user]
    (select {:name (const (:user/name user))}))
  
  (defn query-resolver [db]
    (select
      {:user (args {user-id :userId}
               (async (let [user (<! (user-by-id db user-id))]
                        (user-field-resolvers user))))
       :users (async (let [users (<! (fetch-all-users db))]
                       (collect (map user-field-resolvers users))))
      }))

(defrecord GraphqlObject [type errors fields-resolvers])
(defrecord GraphqlCollection [errors items-resolvers])

(defn gql-object [t e fr] (-> GraphqlObject t e fr))
(defn gql-object? [v] (instance? GraphqlObject v))

(defn map-val [f m] (reduce-kv #(assoc %1 %2 (f %3)) {} m))
(defmacro lazy-gql-object [t e m]
  `(gql-object ~t ~e ~(map-val (fn [v] `#(~v %)) m)))

(defn gql-collection [e ir] (->GraphqlCollection e ir))
(defn gql-collection? [v] (instance? GraphqlCollection v))

(defn assoc-result [result sub-key sub-result]
  (result (assoc (:data result) sub-key (:data sub-result))
          (concat (:errors result) (:errors sub-result)))) ; TODO: implement error path

(defn conj-result [result sub-result]
  (result (conj (:data result) (:data sub-result))
          (concat (:errors result) (:errors sub-result))))

(defn do-select [ctx {:keys [type resolvers errors]}]
  (let [selections (:selections ctx)
        blank-map (reduce #(assoc %1 (:alias %2) nil) (array-map) selections) ; Preallocate array-map to maintain alias order
        reducer #(let [sub-resolver (get resolvers (:field %2))
                       sub-result (sub-resolver %2)]
                   (assoc-result %1 (:alias %2) (<! sub-result)))
    (go (reduce reducer (result blank-map errors) selections)))))

(defn do-collect [ctx {:keys [resolvers errors]}]
  (let [reducer #(conj-result %1 (<! (%2 ctx)))]
    (go (-> (reduce reducer (result nil errors) resolvers)
            (update :data reverse))))))

; Convenience stuff

(def const (comp constantly go result))

(defmacro from-context
  "Binds (f ctx) and runs body expecting Resolver. Returns a Resolver."
  [f bindings body]
  `#(((fn [~bindings] ~body) (f %)) %))

(defmacro args
  "Binds query arguments expecting a Resolver. Returns a Resolver."
  [bindings body]
  `(from-context :arguments ~bindings ~body))

(defn async-ch
  "Will await a Resolver from the channel. Returns a Resolver."
  [resolver-ch]
  #(go ((<! resolver-ch) %)))

(defmacro async
  "Runs body in a go block and expects it to evaluate to a Resolver. Returns a resolver."
  [body]
  `#(go (~body %)))

(defmacro select
  "Given a map of Resolvers selects the requested fields. Returns a Resolver."
  ([m] `(select ~m nil))
  ([e m] `(select ~e ~m nil))
  ([t e m] `#(do-select % (lazy-gql-object ~t ~e ~m))))

(defn collect
  "Combines given collection of Resolvers. Returns a Resolver."
  ([c] (collect nil c))
  ([e c] #(do-collect % (gql-collection e c))))

; TODO: handle fragments
; TODO: add support for timeouts with partial result
; TODO: add errors path and location
; TODO: handle exceptions thrown in resolvers

(defn chan? [v] (satisfies? clojure.core.async.impl.protocols/Channel v))
(defn throwable? [v] (instance? Throwable v))
(defn throwable->result [t]
  (result nil [{:message (.getMessage t)}]))


(defn infer [v]
  (condp #(% v)
    result? (constantly (go v))
    gql-collection? #(do-collect % v)
    gql-object? #(do-select % v)
    fn? #((infer (try (v %) (catch Throwable t t))) %)
    
    map? (infer (gql-object (:graphql/type v) nil (map-val infer v)))
    sequential? (infer (gql-collection nil (map infer v)))
    chan? #(go ((infer (<! v)) %))
    delay? (infer @v)
    future? #(thread ((infer @v) %))
    promise? #(thread ((infer @v) %))
    throwable? (infer (throwable->result v))
    
    any? (infer (result v))))