src/routes.lisp

   1 (uiop:define-package #:lw2.routes
   2   (:use #:cl #:lw2.utils)
   3   (:export #:route #:route-name #:standard-route #:execute-route
   4            #:function-route #:no-match
   5            #:regex-route))
   6
   7 (in-package #:lw2.routes)
   8
   9 (defclass route ()
  10   ((name :initarg :name :accessor route-name :type symbol)
  11    (handler :initarg :handler :type function)))
  12
  13 (defclass standard-route (route)
  14   ((uri :initarg :uri :type string)))
  15
  16 (defmethod execute-route ((r standard-route) request-uri)
  17   (with-slots (uri handler) r
  18     (if (string= uri request-uri)
  19         (progn
  20           (funcall handler)
  21           t)
  22         nil)))
  23
  24 (defclass function-route (route)
  25   ((function :initarg :function :type function)))
  26
  27 (define-condition no-match () ())
  28
  29 (defmethod execute-route ((r function-route) request-uri)
  30   (with-slots (function handler) r
  31     (handler-case
  32         (progn
  33           (multiple-value-call handler (funcall function request-uri))
  34           t)
  35       (no-match () nil))))
  36
  37 (defclass regex-route (function-route) ())
  38
  39 (defmethod initialize-instance :around ((r regex-route) &rest args &key regex &allow-other-keys)
  40   (let* ((scanner (ppcre:create-scanner regex))
  41          (function
  42           (lambda (request-uri)
  43            (multiple-value-bind (match? strings)
  44                (ppcre:scan-to-strings scanner request-uri)
  45              (if match?
  46                  (values-list (coerce strings 'list))
  47                  (signal (load-time-value (make-condition 'no-match))))))))
  48     (apply #'call-next-method
  49            r
  50            :function function
  51            (map-plist
  52             (lambda (k v) (unless (eq k :regex) (list k v)))
  53             args))))