From 71ab563b2b0f4763ac266d6359fba492514bda65 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Sat, 24 Aug 2024 10:31:37 -0700
Subject: Add: slot-value-mapper

---
 src/endpoint.lisp | 12 ++++++++++--
 src/package.lisp  |  1 +
 src/protocol.lisp | 25 +++++++++++++++++++++++++
 3 files changed, 36 insertions(+), 2 deletions(-)

diff --git a/src/endpoint.lisp b/src/endpoint.lisp
index 00f681f..4ec68b6 100644
--- a/src/endpoint.lisp
+++ b/src/endpoint.lisp
@@ -356,6 +356,12 @@ the ;."
                               :note "Error during the parsing of the body.")))))))
 
 
+
+(defun apply-slot-value-mappers (class initargs)
+  (loop :for (arg value) :on initargs :by #'cddr
+        :collect arg
+        :collect (slot-value-mapper class arg value)))
+
 (defun instantiate-endpoint (class args)
   "This attempts to instantiate CLASS, filling slots found in ARGS by
    searching for their values in the hunchentoot:*request*.
@@ -371,8 +377,10 @@ the ;."
         (body-args
           (extract-initargs args (collect-body class)))) 
     (apply #'make-instance class
-           (reduce #'merge-plists
-                   (list extracted-args params-args body-args)))))
+           (apply-slot-value-mappers
+            class
+            (reduce #'merge-plists
+                    (list extracted-args params-args body-args))))))
 
 (defun build-handler (class)
   "Create a hunchentoot dispatch function that instantiates and handles
diff --git a/src/package.lisp b/src/package.lisp
index 1563c07..094295b 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -14,6 +14,7 @@
   (:export
    ;; HANDLER PROTOCOL
    #:check-request-compliance
+   #:slot-value-mapper
    #:authenticate                       
    #:authorize
    #:handle
diff --git a/src/protocol.lisp b/src/protocol.lisp
index 74019b1..6951077 100644
--- a/src/protocol.lisp
+++ b/src/protocol.lisp
@@ -112,6 +112,31 @@ on the size of request bodies.")
     (check-request-compliance (find-class epclass)))
   (:method ((epclass t))))
 
+(defgeneric slot-value-mapper (endpoint-class initarg slot-value)
+  (:documentation "Values arrive from clients in all manner of ways: in a JSON body, in
+query arguments, as form body posts. Weekend allows users to register
+body parsers, which transform post bodies according to the request's
+mimetype.  However, sometimes this isn't good enough.
+
+A value may require additional alteration before it fills an endpoint
+slot.  
+
+SLOT-VALUE-MAPPER is specialized on endpoints, initarg names, and slot
+value types to parse or transform values to be what they out to be for
+a slot's declared type.  
+
+ENDPOINT-CLASS values MUST BE AN ENDPOINT CLASS.
+INITARG values MUST BE A KEYWORD.")
+
+  (:method :around (endpoint (initarg t) value)
+    (assert (keywordp initarg) (initarg) "Initarg is not a keyword ~a"
+            initarg)
+    (call-next-method))
+
+  (:method (endpoint initarg value)
+    value))
+
+
 (defgeneric authenticate (endpoint)
   (:documentation "Returns a boolean. Any protected endpoint should implement
 this. Called before handling, should be used to supply
-- 
cgit v1.2.3