;; for hunchentoot


(defmacro define-handler (name (&rest lambda-args) regex &body forms)
  (let* ((keys lambda-args)
         (named (loop until (or (when (eql (car keys) '&key)
                                  (pop keys))
                                (null keys))
                   collecting (pop keys)))
         (m0 (gensym "M0-"))
         (m1 (gensym "M1-"))
         (rn0 (gensym "RN0-"))
         (rn1 (gensym "RN1-"))
         (request-path (gensym "REQUEST-PATH-"))
         (request-query (gensym "REQUEST-QUERY-"))
         (key-vals (gensym "KEY-VALS-")))
    `(defun ,name (request)
       (destructuring-bind (,request-path &optional ,request-query)
           (split-sequence:split-sequence #\? (request-uri request))
         (multiple-value-bind (,m0 ,m1 ,rn0 ,rn1) 
             (cl-ppcre:scan ,regex ,request-path)
           (declare (ignore ,m1))
           (when ,m0
             (let ((,key-vals (mapcan #'(lambda (k=v)
                                          (destructuring-bind (key &optional (val t)) 
                                              (split-sequence:split-sequence #\= k=v)
                                            (list (intern (string-upcase key) (find-package '#:keyword))
                                                  val)))
                                      (split-sequence:split-sequence #\& ,request-query))))
               (declare (ignorable ,key-vals))
               (lambda ()
                 (let (,@(loop for i from 0
                            for arg in named collecting
                            `(,arg (when (aref ,rn0 ,i)
                                     (subseq ,request-path (aref ,rn0 ,i) (aref ,rn1 ,i)))))
                       (keys ,key-vals)
                         ,@(loop for key in keys collecting 
                                `(,key (getf ,key-vals 
                                             (intern (symbol-name ',key) 
                                                     (find-package '#:keyword))))))
                   ,@forms)))))))))


;;eg. like this

(define-handler picpage (id dash title &key one three five) "/picpage/(\\d+)(-([^/?]+))?"
  (declare (optimize (debug 3)))
  (declare (ignore dash))
  (with-template (title)
    (:p (esc (format nil "If this works, i'll be shocked. id is ~a; title is ~a; one is ~a; three is ~a; five is ~a" id title one three five)))
    (:p (esc (format nil "keys ~s; key one: ~s" keys (getf keys 'one))))))