# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1624375453 14400
# Node ID 86fd9633078cc54125df60b666088f4d7334d456
# Parent  01ff28d9de54877b0a16fba20ef44f9bbeebe848
More

diff -r 01ff28d9de54 -r 86fd9633078c lisp/drivethru.lisp
--- /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))))))
+
diff -r 01ff28d9de54 -r 86fd9633078c vim/custom-dictionary.utf-8.add
--- 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