Skip to content

Instantly share code, notes, and snippets.

@isaksky
Last active August 3, 2021 22:30
Show Gist options
  • Save isaksky/2ff85a8efc24063b3a458fc8a04d5ff0 to your computer and use it in GitHub Desktop.
Save isaksky/2ff85a8efc24063b3a458fc8a04d5ff0 to your computer and use it in GitHub Desktop.
tbd.step macro
(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)))))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment