From 883b6940495692df570093165e33610597b22c33 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Thu, 9 Mar 2023 18:35:35 -0800
Subject: Add: with-env

---
 hyperquirks.lisp | 27 +++++++++++++++++++++++++++
 package.lisp     |  1 +
 2 files changed, 28 insertions(+)

diff --git a/hyperquirks.lisp b/hyperquirks.lisp
index f0e8bfc..70584a5 100644
--- a/hyperquirks.lisp
+++ b/hyperquirks.lisp
@@ -4,6 +4,21 @@
 
 ;;; MACROS
 
+(defmacro with-env ((&rest bindings) &body body)
+  (let ((bindings
+          (loop :for binding :in bindings
+                :collect (list* (gensym "VAR") (gensym "VAL") binding))))
+    `(let* ,(loop :for (oldval cacheval envvar newval) :in bindings
+                  :collect `(,oldval (uiop:getenv ,envvar))
+                  :collect `(,cacheval ,newval))
+       (setf ,@(loop :for (oldval cacheval envvar newval) :in bindings
+                     :collect `(uiop:getenv ,envvar)
+                     :collect cacheval))
+       (unwind-protect (progn ,@body)
+         ,@(loop :for (oldval cacheval envvar newval) :in (reverse bindings)
+                 :collect `(when ,oldval
+                             (setf (uiop:getenv ,envvar) ,oldval)))))))
+
 (defmacro let+ (bindings &body body)
   "General purpose binding. Normal let bindings, destructuring-binds,
 and multiple-value-binds all in the same form.
@@ -86,6 +101,16 @@ returned from.
      `(block () ,@(expander body))))
 
 
+(defmacro $> (input-form &rest functions)
+  (loop :with sub = input-form
+        :for next-form :in piped-to-forms
+        :when (symbolp next-form)
+          :do (setf sub `(funcall ,next-form ,sub))
+        :when (consp next-form)
+          :do (setf sub `(,(first next-form) ,sub ,@(rest next-form)))
+        :finally (return sub )))
+
+
 (defmacro binding-cond (&body clauses)
   "Like cond except the first form of every clause is a binding form
 alá IMPERATIVE. 
@@ -148,3 +173,5 @@ E.g.
 
 
 
+
+
diff --git a/package.lisp b/package.lisp
index f3b157c..342dbbf 100644
--- a/package.lisp
+++ b/package.lisp
@@ -4,6 +4,7 @@
   (:use #:cl)
   (:nicknames #:hq)
   (:export
+   #:with-env
    #:let+
    #:imperative
    #:binding-cond
-- 
cgit v1.2.3