8e62a213 |
(in-package :araneus.routes)
(defgeneric resolve-route (url method content-type &key headers)
(:documentation "The most generic method for resolving a route.
Specialize with a keyword eql-specializer for method or content-type
to define a particular understanding of either"))
(defgeneric match-token (url token)
(:documentation "Match a url against a given token."))
(defclass match-tree ()
((-token :initarg :token :accessor token)
(-children :accessor children :initform (make-array 5 :adjustable t :fill-pointer 0))
(-name :initarg :name :accessor name :initform nil)))
(defun token= (tok1 tok2)
(if (typep tok1 'match-tree)
(setf tok1 (token tok1)))
(if (typep tok2 'match-tree)
(setf tok2 (token tok2)))
(equal tok1 tok2))
(defgeneric add-to-tree (match-tree token)
(:method ((match-tree match-tree) (tokens list))
(loop with current = match-tree
for token in tokens
do (setf current (add-to-tree current token))))
(:method ((match-tree match-tree) (token integer))
(with-accessors ((children children)) match-tree
(if (eql (token match-tree) token)
match-tree
(prog1 (elt children
(or (position token (children match-tree) :test #'token=)
(vector-push-extend (make-instance 'match-tree :token token)
children)))
(setf children (stable-sort children #'< :key #'token)))))))
(define-modify-macro orf (it) or)
(defgeneric match-match-tree (match-tree item)
(:method ((match-tree match-tree) (tokens list))
(let ((current match-tree))
(dolist (token tokens current)
(let ((next (match-match-tree current token)))
(setf current next)))
))
(:method ((match-tree match-tree) (token integer))
(find token
(children match-tree)
:test #'token=)))
(defun random-match-tree (&optional (iters 10))
(flet ((random-list (len lim) (loop repeat len collect (1+ (random lim)))))
(let ((result (make-instance 'match-tree :token nil)))
(loop repeat iters
do (add-to-tree result
(random-list (1+ (random 5)) (1+ (random 10))))
finally (return result)))))
(defun print-match-tree (match-tree &optional (level 0))
(format t "~&~v,2,1,'-<~>~a~%" level (token match-tree))
(loop for child across (children match-tree)
do (print-match-tree child (1+ level))))
(coalesce-lists
(coalesce-lists '(1 2 3) '(1 2 3 4))
(coalesce-lists '(1 2 4) '(1 3 4)))
; => '(1 (2 3) (3 4))
(defun match-url)
|