harpoons - clojure threading macros

harpoons.core.cljc

;; from https://github.com/codebrutale/harpoons

(ns harpoons.core
  #?(:cljs (:require-macros harpoons.core)))

(defmacro non-nil
  "Return the leftmost non-nil value.

  The evaluation is short-circuiting and each form is evaluated at most once.

  Examples:

  ```clojure
  (non-nil)            ; => nil
  (non-nil nil true)   ; => true
  (non-nil false true) ; => false
  ```"
  {:added "0.1"
   :doc/format :markdown}
  ([] nil)
  ([x] x)
  ([x & xs]
   `(let [v# ~x]
      (if (some? v#) v# (non-nil ~@xs)))))

;;;
;;; Diamond threading
;;;

(declare needs-<>)

(defn put-first [form]
  (cond
    (list? form)
    (if (needs-<> form) `(~(first form) ~'<> ~@(next form)) form)

    (vector? form)
    (if (needs-<> form) `[~'<> ~@form] form)

    true
    (list form '<>)))

(defn put-last [form]
  (cond
    (list? form)
    (if (needs-<> form) `(~@form ~'<>) form)

    (vector? form)
    (if (needs-<> form) `(conj ~form ~'<>) form)

    true
    (list form '<>)))

(defmacro -<>
  "Thread the results into `forms` in a thread-first manner.

  Threads the results of successive evaluations through the `forms` by placing
  the result from the preceding form into the next form at locations marked by
  the diamond symbol `<>`.  Initially the value of `expr` is bound to `<>`
  before the first form is evaluated."
  {:added "0.1"
   :forms ['(-<> expr forms*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & forms]
  (let [forms (map put-first forms)]
    `(as-> ~expr ~'<> ~@forms)))

(defmacro -<>>
  "Thread the results into `forms` in a thead-last manner.

  Threads the results of successive evaluations through the `forms` by placing
  the result from the preceding form into the next form at locations marked by
  the diamond symbol `<>`.  Initially the value of `expr` is bound to `<>`
  before the first form is evaluated."
  {:added "0.1"
   :forms ['(-<>> expr forms*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & forms]
  (let [forms (map put-last forms)]
    `(as-> ~expr ~'<> ~@forms)))

(let [this-ns *ns*]
  (defn expands [form]
    (->> form flatten (filter (conj (-> this-ns ns-publics keys set) '<>)) seq)))

;; if a form has a toplevel <> - noop
;; else:
;;   if it has a <> somehwere deeper but not in another harpoon invocation - noop
;; if it is a harpoon invocation it doesn't count

(defmacro when-<>
  "Thread the results into `forms` in a thread-first manner, short-circuiting at a non-truthy value.

  ```clojure
  (when-<> 0 inc zero? [])
  ; => nil
  ```"
  {:added "0.1"
   :forms ['(when-<> expr forms*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & forms]
  (if (seq forms)
    (let [[form & forms] forms
          form (put-first form)]
      `(let [~'<> ~expr]
         (when ~'<>
           (when-<> ~form ~@forms))))
    expr))

(defmacro when-<>>
  "Thread the results into `forms` in a thread-last manner, short-circuiting at a non-truthy value.

  ```clojure
  (when-<>> 0 inc zero? [])
  ; => nil
  ```"
  {:added "0.1"
   :forms ['(when-<> expr forms*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & forms]
  (if (seq forms)
    (let [[form & forms] forms
          form (put-last form)]
      `(let [~'<> ~expr]
         (when ~'<>
           (when-<>> ~form ~@forms))))
    expr))

(defmacro some-<>
  "Thread the results into `forms` in a thread-first manner, short-circuiting at nil.

  ```clojure
  (some-<> 0 inc zero? [])
  ; => [false]
  ```"
  {:added "0.1"
   :forms ['(some-<> expr forms*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & forms]
  (if (seq forms)
    (let [[form & forms] forms
          form (put-first form)]
      `(let [~'<> ~expr]
         (when (some? ~'<>)
           (some-<> ~form ~@forms))))
    expr))

(defmacro some-<>>
  "Thread the results into `forms` in a thread-last manner, short-circuiting at nil.

  ```clojure
  (some-<>> 0 inc zero? [])
  ; => [false]
  ```"
  {:added "0.1"
   :forms ['(some-<>> expr forms*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & forms]
  (if (seq forms)
    (let [[form & forms] forms
          form (put-last form)]
      `(let [~'<> ~expr]
         (when (some? ~'<>)
           (some-<>> ~form ~@forms))))
    expr))

(defmacro cond-<>
  "Evaluate `clauses` conditionally threading the results through the diamonds.

  Runs in a thread-first manner.

  Like `cond->` the threaded value is *not* auto-inserted into the tests.
  The result of the previous test is available as `<>` though.

  ```clojure
  (cond-<> 9
    false (+ 1)
    true inc
    (= <> 10) (* <> <>))
  ; => 100
  ```"
  {:added "0.1"
   :forms ['(cond-<> expr clauses*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & clauses]
  (if (seq clauses)
    (let [[test body & clauses] clauses
          body (put-first body)]
      `(let [~'<> ~expr]
         (cond-<> (if ~test ~body ~'<>) ~@clauses)))
    expr))

(defmacro cond-<>>
  "Evaluate `clauses` conditionally threading the results through the diamonds.

  Runs in a thread-last manner.

  Like `cond->` the threaded value is *not* auto-inserted into the tests.
  The result of the previous test is available as `<>` though.

  ```clojure
  (cond-<>> 9
    false (+ 1)
    true inc
    (= <> 10) (* <> <>))
  ; => 100
  ```"
  {:added "0.1"
   :forms ['(cond-<>> expr clauses*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & clauses]
  (if (seq clauses)
    (let [[test body & clauses] clauses
          body (put-first body)]
      `(let [~'<> ~expr]
         (cond-<>> (if ~test ~body ~'<>) ~@clauses)))
    expr))

(defmacro non-nil-<>
  "Returns the first non-nil evaluation of `forms` with `expr` bound to `<>`.

  Runs in a thread-first manner.

  ```clojure
  (non-nil-<> {:a 1 :b 2} :c :d :a :b)
  ; => 1
  ```"
  {:added "0.1"
   :forms ['(non-nil-<> expr form*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & forms]
  `(let [~'<> ~expr]
     (non-nil ~@(map put-first forms))))

(defmacro non-nil-<>>
  "Returns the first non-nil evaluation of `forms` with `expr` bound to `<>`.

  Runs in a thread-last manner.

  ```clojure
  (non-nil-<>> {:a 1 :b 2} :c :d :a :b)
  ; => 1
  ```"
  {:added "0.1"
   :forms ['(non-nil-<>> expr form*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & forms]
  `(let [~'<> ~expr]
     (non-nil ~@(map put-last forms))))

(defmacro <>-some
  "Shorthand for `(some-<> <> ...)`"
  {:added "0.1"
   :forms ['(<>-some threaded-form*)]
   :doc/format :markdown
   :style/indent 0}
  [& clauses]
  `(some-<> ~'<> ~@clauses))

(defmacro <>>-some
  "Shorthand for `(some-<>> <> ...)`"
  {:added "0.1"
   :forms ['(<>>-some threaded-form*)]
   :doc/format :markdown
   :style/indent 0}
  [& clauses]
  `(some-<>> ~'<> ~@clauses))

(defmacro <>-non-nil
  "Shorthand for `(non-nil-<> <> ...)`"
  {:added "0.1"
   :forms ['(<>-non-nil threaded-form*)]
   :doc/format :markdown
   :style/indent 0}
  [& clauses]
  `(non-nil-<> ~'<> ~@clauses))

(defmacro <>>-non-nil
  "Shorthand for `(non-nil-<>> <> ...)`"
  {:added "0.1"
   :forms ['(<>>-non-nil threaded-form*)]
   :doc/format :markdown
   :style/indent 0}
  [& clauses]
  `(non-nil-<>> ~'<> ~@clauses))

(defmacro <>-cond
  "Shorthand for `(cond-<> <> ...)`"
  {:added "0.1"
   :forms ['(cond-<> clause*)]
   :doc/format :markdown
   :style/indent 0}
  [& clauses]
  `(cond-<> ~'<> ~@clauses))

(defmacro <>>-cond
  "Shorthand for `(cond-<>> <> ...)`"
  {:added "0.1"
   :forms ['(cond-<>> clause*)]
   :doc/format :markdown
   :style/indent 0}
  [& clauses]
  `(cond-<>> ~'<> ~@clauses))

(defmacro <>-bind
  "Bind the threaded value in a thread-first manner.

  Binds the value threaded in the outer diamond-threading scope to the symbols
  in `binding-form` destructuring the value as necessary.  Continues the
  diamond-threading scope by evaluating the `forms` successively
  threading the result of the previous evaluation into the next form at
  locations marked by the diamond symbol `<>`.

  ```clojure
  (-<>> 5 range (map inc) (<>-bind [a b c] [a b c]))
  ; => [(1 2 3 4 5) 1 2 3]
  ```"
  {:added "0.1"
   :forms '[(<>-bind binding-form forms*)]
   :doc/format :markdown
   :style/indent 1}
  [binding-form & forms]
  `(let [~binding-form ~'<>]
     (-<> ~'<> ~@forms)))

(defmacro <>>-bind
  "Bind the threaded value in a thread-last manner.

  Binds the value threaded in the outer diamond-threading scope to the symbols
  in `binding-form` destructuring the value as necessary.  Continues the
  diamond-threading scope by evaluating the `forms` successively
  threading the result of the previous evaluation into the next form at
  locations marked by the diamond symbol `<>`.

  ```clojure
  (-<>> 5 range (map inc) (<>>-bind [a b c] [a b c]))
  ; => [1 2 3 (1 2 3 4 5)]
  ```"
  {:added "0.1"
   :forms '[(<>>-bind binding-form forms*)]
   :doc/format :markdown
   :style/indent 1}
  [binding-form & forms]
  `(let [~binding-form ~'<>]
     (-<>> ~'<> ~@forms)))

(defmacro <>-let
  "Binds the value from the diamond-threading scode and evaluate the body forms.

  Binds the value threaded in the outer diamond-threading scope to the symbols
  in `binding-form` destructuring the value as necessary.  Evaluates the forms
  in `body` returning the value of the last.

  Note that the value threaded in the outer diamond threading scope remain
  bound to the symbol `<>`.

  ```clojure
  (-<> 2 (* 2) inc range (<>-let [a b c & d] [a b c d]))
  ; => [0 1 2 (3 4)]
  ```"
  {:added "0.1"
   :forms '[(<>-bind binding-form body-forms*)]
   :doc/format :markdown
   :style/indent 1}
  [binding-form & body]
  `(let [~binding-form ~'<>]
     ~@body))

(defmacro <>!
  "Runs a side-effect in a thread-first manner.

  Evaluates `body-forms` for their side effects and returns the value bound to
  the simple symbol `<>`.

  ```clojure
  (-<> (range 2 4)
    (<>! (prn :before <>)) ; \":before (2 3)\"
    (for [x <> y <>] (* x y))
    (<>! (prn :after <>))  ; \":after (4 6 6 9)\"
    (= <> '(4 6 6 9)))
  ; => true
  ```"
  {:added "0.1"
   :forms '[(<>! body-forms*)]
   :doc/format :markdown
   :style/indent 0}
  [& body-forms]
  `(do ~@(map put-first body-forms) ~'<>))

(defmacro <>>!
  "Runs a side-effect in a thread-last manner.

  Evaluates `body-forms` for their side effects and returns the value bound to
  the simple symbol `<>`.

  ```clojure
  (-<> (range 2 4)
    (<>>! (prn :before)) ; \":before (2 3)\"
    (for [x <> y <>] (* x y))
    (<>>! (prn :after))  ; \":after (4 6 6 9)\"
    (= <> '(4 6 6 9)))
  ; => true
  ```"
  {:added "0.1"
   :forms '[(<>>! body-forms*)]
   :doc/format :markdown
   :style/indent 0}
  [& body-forms]
  `(do ~@(map put-last body-forms) ~'<>))

(defmacro +<>
  "Branches `expr` to all `forms` in a thread-first manner and returns a vector of the results.

  ```clojure
  (+<> 10 (* 2) (- 5))
  ; => [20 5]
  ```"
  {:added "0.1"
   :forms '[(+<> expr forms*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & forms]
  `(let [~'<> ~expr]
     (vector ~@(map put-first forms))))

(defmacro +<>>
  "Branches `expr` to all `forms` in a thread-last and returns a vector of the results.

  ```clojure
  (+<>> 10 (* 2) (- 5))
  ; => [20 -5]
  ```"
  {:added "0.1"
   :forms '[(+<>> expr forms*)]
   :doc/format :markdown
   :style/indent 1}
  [expr & forms]
  `(let [~'<> ~expr]
     (vector ~@(map put-last forms))))

(def this-ns *ns*)

(def skippers
  (->> *ns* ns-publics keys (map #(symbol (str this-ns) (name %))) set))

(def skippers '#{-<> -<>>
                 when-<> when-<>>
                 some-<> some-<>>
                 cond-<> cond-<>>
                 non-nil-<> non-nil-<>>
                 <>-some <>>-some
                 <>-non-nil <>>-non-nil
                 <>-cond <>>-cond
                 <>-bind <>>-bind
                 <>-let
                 <>! <>>!
                 +<> +<>>})

(defn needs-<> [form]
  (cond
    (list? form)
    (let [head (first form)]
      (or (and (symbol? head)
               (skippers (symbol (str this-ns) (str head))))
          (every? needs-<> form)))

    (vector? form)
    (every? needs-<> form)

    (map? form)
    (every? needs-<> (mapcat identity form))

    (symbol? form)
    (not= '<> (-> form name symbol))

    :else
    true))

(needs-<> '(<>-some seq first))

(comment
  [(not (needs-<> '(inc (inc <>))))
   (needs-<> '(inc (inc 1)))
   (boolean (needs-<> '(<>-some inc)))
   (needs-<> [1 2 3])
   (needs-<> '(1 2 3))
   (needs-<> '(inc (-<> 1 inc (+ <> 1)) inc))]
  )