threading-macro.lisp

(defmacro -> (prev &rest rest)
  (if (null rest)         
      prev         
      `(-> ,(cons (caar rest) (cons prev (cdar rest))) ,@(cdr rest))))          

(defmacro ->> (prev &rest rest)
  (if (null rest)
      prev       
      `(->> ,(append (car rest) (list prev)) ,@(cdr rest))))                

(defmacro as-> (prev var &body body)
  `(%as-> ,var ,prev ,@body))

(defmacro %as-> (var prev &rest rest)
  (if (null rest)
      prev
      `(%as-> ,var ,(substitute prev var (car rest)) ,@(cdr rest))))

(defmacro escape-if-nil (sexp label)
  (let ((val (gensym)))
    `(let ((,val ,sexp))
       (if ,val
           ,val
           (return-from ,label)))))
     
(defmacro some-> (prev &rest rest)
  (let ((label (gensym)))
    `(block ,label (%some-> ,label ,prev ,@rest))))

(defmacro %some-> (label prev &rest rest)
  (if (or (null rest))
      `(escape-if-nil ,prev ,label)
      `(%some-> ,label ,(cons (caar rest) (cons `(escape-if-nil ,prev ,label) (cdar rest))) ,@(cdr rest))))          

(defmacro some->> (prev &rest rest)
  (let ((label (gensym)))
    `(block ,label (%some-> ,label ,prev ,@rest))))

(defmacro %some->> (label prev &rest rest)
  (if (or (null rest))
      `(escape-if-nil ,prev ,label)
      `(some->> ,(append (car rest) (list `(escape-if-nil ,prev ,label))) ,@(cdr rest))))

(defmacro cond-> (prev &rest rest)
  (let ((condition (car rest))
        (sexp (cadr rest)))
    (if (null rest)   
        prev
        `(cond-> (if ,condition ,(cons (car sexp) (cons prev (cdr sexp))) ,prev) ,@(cddr rest)))))

(defmacro cond->> (prev &rest rest)
  (let ((condition (car rest))
        (sexp (cadr rest)))
    (if (null rest)
        prev       
        `(cond->> (if ,condition ,(append sexp (list prev)) ,prev) ,@(cddr rest)))))