From dda37d6f9f40d573776ac4bb6abe12adb8f33c47 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Fri, 29 Nov 2024 07:23:09 -0800
Subject: More complete debugging of request lifecycle

---
 src/debugging.lisp | 44 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 44 insertions(+)
 create mode 100644 src/debugging.lisp

(limited to 'src/debugging.lisp')

diff --git a/src/debugging.lisp b/src/debugging.lisp
new file mode 100644
index 0000000..73d5de1
--- /dev/null
+++ b/src/debugging.lisp
@@ -0,0 +1,44 @@
+(in-package #:weekend)
+
+(defvar *debugging* nil
+  "If T, the debugger will be evoked.")
+
+(defvar *debug-indent* nil
+  "If an integer, debug print will print this many spaces before printing the debug message. It will then increment the count. 
+
+The debug indent is bound when request handling starts.")
+
+(defvar *debug-log* nil
+  "An output stream bound when request handling begins and guaranteed to
+be written to *ERROR-OUTPUT* when the handling finishes or raises an
+error condition.")
+
+(defmacro with-debug-extent ((&key (stream '*error-output*)) &body body)
+  "When *DEBUGGING* is non NIL, calls to DEBUG-PRINT appearing anywhere
+within the runtime extent of BODY will print to this handler thread's
+debug log."
+  `(let ((*debug-log* (and *debugging* (make-debug-log)))
+         (*debug-indent* (and *debugging* 0)))
+     (unwind-protect (progn ,@body)
+       (write-debug-log :stream ,stream))))
+
+(defun make-debug-log ()
+  (make-array 512
+    :element-type 'character 
+    :fill-pointer 0
+    :adjustable t))
+
+(defun toggle-debugging ()
+  (setf *debugging* (not *debugging*)))
+
+(defun debug-print (&rest objects)
+  (when (and *debugging* *debug-log*)
+    (with-output-to-string (*standard-output* *debug-log*)
+      (write-string "DEBUG: ")
+      (loop :repeat (or *debug-indent* 0) :do (write-char #\space))
+      (format *standard-output* "~{~s ~}~%" objects)
+      (when *debug-indent* (incf *debug-indent* 2)))))
+
+(defun write-debug-log (&key (stream *error-output*))
+  (when (and *debugging* *debug-log*)
+    (write-string *debug-log* stream)))
-- 
cgit v1.2.3