git.fiddlerwoaroof.com
Raw Blame History
(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)