Skip to content

Instantly share code, notes, and snippets.

Last active Sep 17, 2019
What would you like to do?
Constructing Clojure private DSLs on top of functions and function combinators.
;; Note: this code is not runnable and functions are presented in reverse dependency order for readability.
;; So I happened to have this rather complex function (a generalization of clojure.core/postwalk, but that's not really
;; the point)
(defn complex-fn [... args ...]
(let [[form ctx] (before form context)
[should-pre ctx] (pre? form ctx)
[form ctx] (if should-pre
(pre form ctx)
[form ctx])
[should-walk ctx] (walk? form ctx)
opts (assoc opts :context ctx)
[form ctx] (if should-walk
(walk opts form ctx)
[form ctx])
[should-post ctx] (post? form ctx)
[form ctx] (if should-post
(post form ctx)
[form ctx])
[form ctx] (after form ctx)]
[form ctx]))
;; Moreover, I needed to provide debugging/logging info to ease out the use of the function, part of a wider library.
;; Think of it as the equivalent of clojure.walk/postwalk-demo. But instead of having clojure.walk/postwalk and
;; clojure.walk/postwalk-demo as separate functions, my goal was to cram functionnalities from both fns into one.
;; So basically I had to add "inactive bindings" around all of the bindings in the 'let' from above in order to debug them.
;; Something like this:
(defn complex-fn [... args ...]
(let [[form ctx] (before form context)
_ (debug form)
_ (debug ctx)
[should-pre ctx] (pre? form ctx)
_ (debug should-pre)
_ (debug ctx)
etc ...]
;; but more complex and polished, with indentation, colors, complex logic to avoid reapeatedly printing the same thing etc ...
;; So how would I go adding these debugging aids to the code without making it unreadable, all the more so what's being done
;; by in the function per se is naturally quite complex to picture ?
;; Well, I decided to split the essential part of the code from its debugging part. I would keep the initial code as is and use
;; a macro to add these debugging aids.
(defn complex-fn [... args ...]
(let [[form ctx] (before form context)
[should-pre ctx] (pre? form ctx)
[form ctx])))
;; Here is the macro in question
(defmacro with-debugs [let-statement]
(edit-bindings debugs let-statement))
;; At first, it wasn't that quintessential, but as the complexity of the debugging aids grew, I figured out I'd better flesh
;; the code out with a DSL to express editions to a let's bindings.
;; I won't show the edit-bindings fn, but what it does is take a let statement as input and process each of its bindings against
;; a list of matcher+transformer pairs (refered in the code above as 'debugs'). If the matcher matches the binding being
;; processed (it's just a function), the transformer is applied (yet another function).
;; I will show the DSL I used to edit that specific 'let' though. Here it is (just have a cursory look at the following, and
;; read on until the next comment)
(def ^:private debugs
[;; Set up some local variables at the top of the let's bindings
(match-expr| (|| is-expr? 'before))
(insert| :before
'context '(update context :depth (fnil inc -1))
'ctx 'context
'debug '(and debug (if debug? (debug? form ctx) true))
'depth '(get ctx :depth)
'tabs (template (apply str (repeat depth ~tab))))
;; Add temp variables to see if things change
(match-sym| (?| '[form ctx]))
(insert| :before '[prev-form prev-ctx] '[form ctx])
(match-sym| (and| vector?
(->| first (not| (?| 'form)))
(->| second (?| 'ctx))))
(insert| :before 'prev-ctx 'ctx)
;; Header
(match-expr| (|| is-expr? 'before))
(insert| :before (template (debug-it
:expr form
:label (adjust :left ~adjustment
:separator "")))
;; Before
(match-expr| (|| is-expr? 'before))
(debug-step| "│ Before" {:separator "·"})
;; Pre?
(match-expr| (|| is-expr? 'pre?))
(debug-step| "│ Pre? " {:separator "·"
:debug-form false})
;; Pre
(match-expr| (and| seq? (->| (|| take 2) (?| '(if should-pre)))))
(debug-step| "│ Pre " {:separator "·"})
;; Walk?
(match-expr| (|| is-expr? 'walk?))
(debug-step| "│ Walk? " {:separator "·"
:debug-form false})
(match-expr| (and| seq? (->| (|| take 2) (?| '(if should-walk)))))
(->| ;; When limited by debug-depth
:before (template
(when (let [d (:debug-depth ctx)]
(and d
(coll? form) should-walk
(not (neg? d)) (= (:depth ctx) d)))
(println (str tabs (adjust
:left ~adjustment
(str "... "
nil "(masking ~d subform~:p)"
(count form)))))))))
;; No walk
:after (template
(when (should-debug? ctx (and debug-context
(not should-walk)
(coll? form)))
(println (str tabs (adjust :left ~adjustment
"│ No walk") "·"))))))
;; Post?
(match-expr| (|| is-expr? 'post?))
(debug-step| "│ Post? " {:separator "·"
:debug-form false})
;; Post
(match-expr| (and| seq? (->| (|| take 2) (?| '(if should-post)))))
(debug-step| "│ Post " {:separator "·"})
;; After
(match-expr| (|| is-expr? 'after))
(debug-step| "│ After " {:separator "·"})])
;; Lot of stuff and pardon me if you suddenly feel overwhelmed. My goal isn't to explain in details what this specific bit of
;; DSL does, but how I design DSLs on top of functions and what are the advantages that come with it.
;; So each pair of lines in the code from above have this semantics:
(... matcher ...)
(... transformer ...)
;; You may have noticed they all call functions whose name ends with '|'. It's a convention of mine to indicate functions
;; that return functions. Indeed, 'match-expr|' 'match-sym|', 'insert|' & 'debug-step|' are functions building functions,
;; and the returned functions constitue the DSL's building blocks.
(defn- match-sym| [fsym]
(fn [[sym _expr]] (fsym sym)))
(defn- match-expr| [fexpr]
(fn [[_sym expr]] (fexpr expr)))
(defn- insert|
([position val-expr] (insert| position '_ val-expr))
([position sym-expr val-expr] (fn [sv]
(case position
:before (concat [sym-expr val-expr] sv)
:after (concat sv [sym-expr val-expr]))))
([position s v & more-binds] (let [compose (case position
:before comp
:after ->|)
binds (->> (concat [s v] more-binds)
(partition 2))]
(apply compose
(map (|| apply insert| position)
(defn- edit| [fsym fexpr]
(fn [[s v]]
[(fsym s) (fexpr v)]))
(defn- edit-sym| [f]
(edit| f identity))
(defn- edit-expr| [f]
(edit| identity f))
;; You may also have noticed there are other shady functions here and there whose name ends with a pipe, '|'.
;; These are part of a small set of common fn combinators I use on a daily basis and that are very convenient to
;; write such DSLs.
(|| f a) means (partial f a)
(->| f g h) means (comp h g f)
(and| f g) means (fn [& args] (and (apply f args) (apply g args)))
(?| :val) means (fn [x] (= x :val))
;; To which extent are they convenient when you primarily build your DSL on top of functions ?
;; 1. Your DSL bricks are chainable by default. Like this
(match-sym| (and| vector?
(->| first (not| (?| 'form)))
(->| second (?| 'ctx))))
;; or like this
(and| (match-sym| ...)
(match-expr| ...))
;; or even like this
(->| (insert| :before (template ...))
(insert| :after (template ...)))
;; 2. Your DSL is conditionnable ad-hoc.
(match-sym| (when| (constantly *opt*)
;; 3. It also supports "decoration" and many other patterns.
(defn debug-it| [msg f]
(fn [[sym expr]]
(let [result (f [sym expr])]
(println msg)
(println result)
(debug-it| "Matches ?"
(match-sym| (and| (debug-it| "positive?" pos?)
(debug-it| "even?" even?)))
;; This is really cool when you design "private" DSL: although I reckon this is not as nice-looking as a well furnished
;; data-based DSL, you barely lose any inertia or sacrifice flexibility designing DSLs like
;; this, which is ideal for "private" uses.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment