Clojure macros for writing flat blocks with early returns, avoiding the let/if-pyramid

flat-block-macros.clj

(defn block-imp [exprs]
  (when-let [[expr & tail-exprs] (seq exprs)]
    (match expr

      (('let pattern init) :seq)
      (match (block-imp tail-exprs)
        (((((:or 'let `let) bindings & tail) :seq)) :seq)
        `((let [~pattern ~init ~@bindings] ~@tail))
        block-tail
        `((let [~pattern ~init] ~@block-tail)))

      (('let & _) :seq)
      (throw (new IllegalArgumentException
                  "in 'imp' root, 'let' must have the form: (let pattern init)"))

      :else
      `(~expr ~@(block-imp tail-exprs)))))

(defn list-to-expr [[expr & tail-exprs]]
  (if-not tail-exprs expr `(do ~expr ~@tail-exprs)))

(defmacro imp
  "Variant of a 'do' block where 'let' emulates imperative-style variable
  assignment. Convenient for inserting assertions and other side-effectul
  operations between bindings.

  Usage:

    (imp
      (let pattern <expr>)
      (when-not <assertion> (throw <fail>))
      (let pattern <expr>)
      (let pattern <expr>)
      <exprs>
      ...)

  Each 'let' creates a subscope. Adjacent lets are merged together.

  Examines only the let expressions at the root level that start with the
  raw 'let symbol. Ignores subforms and 'clojure.core/let."
  [& exprs]
  (list-to-expr (block-imp exprs)))



(defn err? [value]
  (and (instance? clojure.lang.ILookup value)
       (contains? value :error)))

(defn to-err [value] (if (err? value) value {:error value}))

(defn err-when [value] (when value (to-err value)))



(defmacro do?
  "Variant of a 'do' block with early interruption, in the style of
  Haskell's 'do' notation. Supports the popular Clojure pattern
  of '{:error _}' vs result.

  When a subform evaluates to '{:error _}', the block short-curcuits,
  immediately returning this value.

  See also: 'err?', 'to-err'.

  Expansion:

    (do?
      expr  |  (let [value expr] (if (err? value) value
      expr  |    (let [value expr] (if (err? value) value
      expr  |      (let [value expr] (if (err? value) value)))))))
  "
  [& exprs]
  (when-let [[expr & tail-exprs] (seq exprs)]
    (if-not tail-exprs
      expr
      `(let [value# ~expr]
         (if (err? value#) value# (do? ~@tail-exprs))))))



(defn expr-imp? [[expr & tail-exprs]]
  (if-not tail-exprs
    expr
    (match expr

      (('let pattern init) :seq)
      `(let [value# ~init]
         (if (err? value#) value# (let [~pattern value#] ~(expr-imp? tail-exprs))))

      (('let & _) :seq)
      (throw (new IllegalArgumentException
                  "in 'imp' root, 'let' must have the form: (let pattern init)"))

      :else
      `(let [value# ~expr]
         (if (err? value#) value# ~(expr-imp? tail-exprs))))))

(defmacro imp?
  "Variant of a 'do' block that emulates imperative assignment and early
  interruption. Based on 'imp' and 'do?'. See '(doc imp)' for assignment,
  and '(doc do?)' for interruption.

  Usage:

    (imp?
      (let pattern error-or-result)
      (let pattern error-or-result)
      error-or-result
      error-or-result
      (let pattern error-or-result)
      error-or-result
      ...)

  Expansion:

    (imp?
      (let pattern init)  |  (let [result init] (if (err? result) result (let [pattern result]
      (let pattern init)  |    (let [result init] (if (err? result) result (let [pattern result]
      expr                |      (let [result expr] (if (err? result) result
      (let pattern init)  |        (let [result init] (if (err? result) result (let [pattern result]
      expr                |          (let [result expr] (if (err? result) result
      expr                |            (let [result expr] (if (err? result) result
      (let pattern init)  |              (let [result init] (if (err? result) result (let [pattern result]
      (let pattern init)  |                (let [result init] (if (err? result) result (let [pattern result]
      expr                |                  (let [result expr] (if (err? result) result
      expr                |                    (let [result expr] (if (err? result) result)))))))))))))))))))))))))
  "
  [& exprs]
  (expr-imp? exprs))