let with conforming bindings

conform-let.clj

(ns conform-let
  (:require
    [clojure.spec :as s]
    [clojure.core.specs :as core-specs]))

(s/def ::conform-bindings
  (s/and vector?
         (s/spec (s/* (s/cat :binding ::core-specs/binding-form
                             :spec some?
                             :init-expr any?)))))

(s/fdef conform-let
  :args (s/cat :bindings ::conform-bindings
               :body (s/* any?)))

(s/fdef if-conform-let
  :args (s/cat :bindings ::conform-bindings
               :then any?
               :else (s/? any?)))

(s/fdef when-conform-let
  :args (s/cat :bindings ::conform-bindings
               :body (s/* any?)))

(defmacro conform-let
  "Like let, but takes triples of [binding-form spec expression].
  The expressions are conformed with the spec before being bound to binding-form."
  {:style/indent 1}
  [bindings & body]
  (let [bindings* (into []
                        (mapcat (fn [[binding-form spec init-expr]]
                                  `[~binding-form (s/conform ~spec ~init-expr)]))
                        (partition 3 bindings))]
    `(let ~bindings* ~@body)))

(defmacro if-conform-let
  "Like if-let, but takes triples of [binding-form spec expression],
  like conform-let, and will take the else branch
  if any binding conforms to ::s/invalid
  It can also take any number of bindings and will short-circuit evaluation
  on the first ::s/invalid."
  {:style/indent 1}
  ([bindings then]
   `(if-conform-let ~bindings ~then nil))
  ([bindings then else]
   (if (empty? bindings)
     then
     (let [[binding-form spec init-expr & more] bindings]
       `(conform-let [x# ~spec ~init-expr]
          (if (= ::s/invalid x#)
            ~else
            (let [~binding-form x#]
              ~(if (seq more)
                 `(if-conform-let ~(vec more) ~then ~else)
                 then))))))))

(defmacro when-conform-let
  "Like if-conform-let, but with a nil then argument, and an implicit do."
  {:stlye/indent 1}
  [bindings & body]
  `(if-conform-let ~bindings (do ~@body)))