--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/drivethru.lisp Tue Jun 22 11:24:13 2021 -0400
@@ -0,0 +1,115 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (ql:quickload
+ '(:adopt :with-user-abort :iterate :losh :hunchentoot :lparallel)
+ :silent t))
+
+(defpackage :drivethru
+ (:use :cl :iterate :losh)
+ (:export :toplevel :*ui*))
+
+(in-package :drivethru)
+
+;;;; State --------------------------------------------------------------------
+(defvar *acceptor* nil)
+
+;; in: (req . promise)
+;; ↑
+;; out: (status . body)
+(defvar *q* (lparallel.queue:make-queue))
+
+
+;;;; Server -------------------------------------------------------------------
+(defun prompt (message)
+ (write-string message)
+ (finish-output))
+
+(defun handle ()
+ (let ((p (lparallel:promise)))
+ (lparallel.queue:push-queue (cons hunchentoot:*request* p) *q*)
+ (destructuring-bind (status . body) (lparallel:force p)
+ (setf (hunchentoot:return-code*) status)
+ body)))
+
+(defun serve (r)
+ (destructuring-bind (request . promise) r
+ (let ((auth (multiple-value-list (hunchentoot:authorization request))))
+ (format t "~%~C[1;96m;;;; ~A ~A --------------~%~C[0m"
+ #\esc
+ (hunchentoot:request-method request)
+ (hunchentoot:request-uri request)
+ #\esc)
+ (when auth
+ (format t ";; User: ~S~%;; Pass: ~S~%" (first auth) (second auth))))
+ (let ((status (progn (prompt "Reponse code: ")
+ (parse-integer (read-line))))
+ (body (progn (prompt "Reponse body: ")
+ (read-line))))
+ (lparallel:fulfill promise (cons status body)))))
+
+(defun dispatch (request)
+ (declare (ignore request))
+ #'handle)
+
+
+;;;; Run ----------------------------------------------------------------------
+(defun run (port)
+ (setf hunchentoot:*dispatch-table* '(dispatch)
+ *acceptor* (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor
+ :port port)))
+ (unwind-protect (loop (serve (lparallel.queue:pop-queue *q*)))
+ (hunchentoot:stop *acceptor*)))
+
+
+;;;; User Interface -----------------------------------------------------------
+(defparameter *option-help*
+ (adopt:make-option 'help
+ :help "Display help and exit."
+ :long "help"
+ :short #\h
+ :reduce (constantly t)))
+
+(defparameter *option-port*
+ (adopt:make-option 'port
+ :help "Listen on port N (default 33455)."
+ :parameter "N"
+ :long "port"
+ :short #\p
+ :reduce #'adopt:last
+ :key #'parse-integer
+ :initial-value 33455))
+
+(adopt:define-string *help-text*
+ "drivethru listens for HTTP requests and lets you give responses by hand on ~
+ the fly, as a low-tech mock when testing an API.")
+
+(defparameter *examples*
+ '(("Run on port 80:" . "drivethru -p 80")))
+
+(defparameter *ui*
+ (adopt:make-interface
+ :name "drivethru"
+ :usage "[OPTIONS]"
+ :summary "serve HTTP requests by hand"
+ :help *help-text*
+ :examples *examples*
+ :contents (list *option-port*
+ *option-help*)))
+
+
+(defmacro exit-on-ctrl-c (&body body)
+ `(handler-case
+ (with-user-abort:with-user-abort (progn ,@body))
+ (with-user-abort:user-abort () (adopt:exit 130))))
+
+
+(defun toplevel ()
+ (exit-on-ctrl-c
+ (multiple-value-bind (arguments options) (adopt:parse-options-or-exit *ui*)
+ (handler-case
+ (if (gethash 'help options)
+ (adopt:print-help-and-exit *ui*)
+ (progn
+ (assert (null arguments))
+ (run (gethash 'port options))))
+ (error (e) (adopt:print-error-and-exit e))))))
+--- a/vim/custom-dictionary.utf-8.add Wed Jun 09 11:25:44 2021 -0400
+++ b/vim/custom-dictionary.utf-8.add Tue Jun 22 11:24:13 2021 -0400
@@ -314,3 +314,4 @@
reimplementations
UUIDs
metaclass
+async