Skip to content

Instantly share code, notes, and snippets.

@TristeFigure
Last active Sep 17, 2019
Embed
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 ...]
(with-debugs
(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
"Walking")
: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
(insert|
: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 "... "
(cl-format
nil "(masking ~d subform~:p)"
(count form)))))))))
;; No walk
(insert|
: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)
binds)))))
(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*)
my-predicate)))
;; 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)
(newline)
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