tbd.step macro

step.cljc

(ns tbd.step
  (:require
    [clojure.spec.alpha :as s]))

(s/def ::binding-kvp (s/cat :lhs symbol? :rhs any?))

(s/def ::bindings
  (s/and
    vector?
    (s/conformer vec vec)
    (s/+ ::binding-kvp)))

(s/def ::let
  (s/cat
    :keyword #{:let}
    :bindings ::bindings
    :body (s/& (s/* any?) ::step-ast)))

(s/def ::pred-let
  (s/cat
    :kind #{:when-some :when-let}
    :bindings ::bindings
    :do (s/? (s/cat :keyword #{:do} :body any?))
    :return (s/? (s/cat :keyword #{:return} :value any?))
    :else-or-then (s/? (s/& (s/+ any?) ::step-ast))))

(s/def ::when
  (s/cat
    :keyword #{:when}
    :test any?
    :do (s/? (s/cat :keyword #{:do} :body any?))
    :return (s/? (s/cat :keyword #{:return} :value any?))
    :else-or-then (s/? (s/& (s/+ any?) ::step-ast))))

(s/def ::do
  (s/cat
    :keyword #{:do}
    :body any?
    :then (s/? (s/& (s/* any?) ::step-ast))))

(s/def ::step-ast
  (s/or
    :let ::let
    :pred-let ::pred-let
    :when ::when
    :top-level-else (s/cat :keyword #{:else} :value any?)
    :top-level-return (s/cat :keyword #{:return} :value any?)
    :do ::do))

(defmacro when-let*
  [bindings & body]
  (if (seq bindings)
    `(when-let [~(first bindings) ~(second bindings)]
       (when-let* ~(drop 2 bindings) ~@body))
    `(do ~@body)))

(defmacro when-some*
  [bindings & body]
  (if (seq bindings)
    `(when-some [~(first bindings) ~(second bindings)]
       (when-some* ~(drop 2 bindings) ~@body))
    `(do ~@body)))

(defmacro if-let*
  [bindings then else]
  (let [[lhs rhs] (take 2 bindings)
        bindings (drop 2 bindings)]
    (cond
      (seq bindings)
      (list 'if-let [lhs rhs]
            (list 'if-let* bindings then else)
            else)

      :else
      (list 'if-let [lhs rhs]
            then
            else))))

(defmacro if-some*
  [bindings then else]
  (let [[lhs rhs] (take 2 bindings)
        bindings (drop 2 bindings)]
    (cond
      (seq bindings)
      (list 'if-some [lhs rhs]
            (list 'if-some* bindings then else)
            else)

      :else
      (list 'if-some [lhs rhs]
            then
            else))))

(defmulti step-form (fn [[tag _]] tag))

(defmethod step-form :let [[_ {:keys [bindings body] :as form}]]
  (list 'let
        (vec (mapcat (juxt :lhs :rhs) bindings))
        (step-form body)))

(defmethod step-form :pred-let [[_ {:keys [kind bindings return else-or-then] :as form}]]
  (let [do-form        (:do form)
        bindings-form  (vec (mapcat (juxt :lhs :rhs) bindings))
        if-sym         (case kind :when-let 'if-let* :when-some 'if-some*)
        when-sym       (case kind :when-let 'when-let* :when-some 'when-some*)
        wrapped-return (if (and (some? do-form) (some? return))
                         (list 'do (:body do-form) (:value return))
                         (:value return))]
    (cond
      (and (some? return) (some? else-or-then))
      (list if-sym bindings-form wrapped-return (step-form else-or-then))

      (some? return)
      (let [wrapped-return (if (and (some? do-form) (some? return))
                             (list 'do (:body do-form) (:value return))
                             (:value return))]
        (list when-sym bindings-form wrapped-return))

      (some? do-form)
      (list when-sym bindings-form (:body do-form) (step-form else-or-then))

      :else
      (list when-sym bindings-form (step-form else-or-then)))))

(defmethod step-form :when [[_ {:keys [test return else-or-then] :as form}]]
  (let [do-form (:do form)]
    (cond
      (and (some? return) (some? else-or-then))
      (let [wrapped-return (if (and (some? do-form) (some? return))
                             (list 'do (:body do-form) (:value return))
                             (:value return))]
        (list 'if test wrapped-return (step-form else-or-then)))

      (some? return)
      (let [wrapped-return (if (and (some? do-form) (some? return))
                             (list 'do (:body do-form) (:value return))
                             (:value return))]
        (list 'when test wrapped-return))

      (some? do-form)
      (list 'when test (:body do-form) (step-form else-or-then))

      :else
      (list 'when test (step-form else-or-then)))))

(defmethod step-form :top-level-else [[_ form]]
  ;; Needs more testing/thinking to see if this is all that is needed.
  (:value form))

(defmethod step-form :top-level-return [[_ form]]
  (:value form))

(defmethod step-form :do [[_ {:keys [body then] :as form}]]
  (cond
    (some? then) (list 'do body (step-form then))
    :else (list 'do body)))

(defn- step* [forms]
  (let [forms  (if (odd? (count forms))
                 (concat (butlast forms) (list :else (last forms)))
                 forms)
        valid? (s/valid? ::step-ast forms)
        _      (when-not valid?
                 (throw (ex-info
                          (str "Bad syntax:\n" (s/explain-str ::step-ast forms))
                          {:spec-error (s/explain-str ::step-ast forms)
                           :spec-data (s/explain-data ::step-ast forms)})))
        ast    (s/conform ::step-ast forms)]
    (step-form ast)))


(defmacro step [& forms]
  (step* forms))

(comment
  (macroexpand-1
    '(step
       :let [rate-limit-result (rate-limit-incr-and-check! (:user ctx))]
       :when (= ::too-many-requests rate-limit-result)
       :return {:errors [{:message "Please enhance your calm."}]}

       :let [query-complexity (calc-query-complexity query)]
       :when (or (< 10 (:max-depth query-complexity))
                 (< 10000 (:node-count query-complexity)))
       :return {:errors [{:message "Query too complex, please simplify."}]}

       :let [credit-cost (calc-credit-cost query)
             charge-result (charge (:user ctx) credit-cost)]
       :when (= ::insufficient-credits charge-results)
       :return charge-result

       (exec-query ctx query)))

  (defn handle-query [ctx query]
    (step
      :let [rate-limit-result (rate-limit-incr-and-check! (:user ctx))]
      :when (= ::too-many-requests rate-limit-result)
      :return {:errors [{:message "Please enhance your calm."}]}

      :let [query-complexity (calc-query-complexity query)]
      :when (or (< 10 (:max-depth query-complexity))
                (< 10000 (:node-count query-complexity)))
      :return {:errors [{:message "Query too complex, please simplify."}]}

      :let [credit-cost (calc-credit-cost query)
            charge-result (charge (:user ctx) credit-cost)]
      :when (= ::insufficient-credits charge-results)
      :return charge-result

      (exec-query ctx query)))

  ;; Expands to:

  (defn handle-query [ctx query]
    (let [rate-limit-result (rate-limit-incr-and-check! (:user ctx))]
      (if (= ::too-many-requests rate-limit-result)
        {:errors [{:message "Please enhance your calm."}]}
        (let [query-complexity (calc-query-complexity query)]
          (if (or (< 10 (:max-depth query-complexity))
                  (< 10000 (:node-count query-complexity)))
            {:errors [{:message "Query too complex, please simplify."}]}
            (let [credit-cost   (calc-credit-cost query)
                  charge-result (charge (:user ctx) credit-cost)]
              (if (= ::insufficient-credits charge-results)
                charge-result
                (exec-query ctx query)))))))))