(defpackage :fwoar.myway-acceptor
   (:use :cl)
   (:export
    #:*current-route*
    #:define-route-group
    #:resolve-request
    #:myway-acceptor
    #:route-group))
 (in-package :fwoar.myway-acceptor)
 
 (defclass myway-acceptor (hunchentoot:acceptor)
   ((%mapper :initform (myway:make-mapper) :reader mapper)))
 
 (defvar *current-route*)
 (define-method-combination route-group
     ()
   ((routes (:route . *)))
   (:arguments server)
   `(progn
      ,@(mapcar (lambda (method)
                  (destructuring-bind (_ path . rest) (method-qualifiers method)
                    (declare (ignore _))
                    (let ((http-verb (when rest
                                       (etypecase (car rest)
                                         (keyword (list :method (car rest)))))))
                      `(let ((*current-route* ,path))
                         (myway:connect (mapper ,server) ,path
                                        (call-method ,method)
                                        ,@http-verb)))))
                (stable-sort routes #'<
                             :key (alexandria:compose #'length
                                                      #'cadr
                                                      #'method-qualifiers)))))
 
 (defmacro define-route-group (name (server &rest args) &body body)
   (let* ((docstring (when (and body (stringp (car body)))
                       (car body)))
          (body (if docstring
                    (cdr body)
                    body)))
     `(defgeneric ,name (,server ,@args)
        (:method-combination route-group)
        (:documentation ,docstring)
        ,@(mapcar (serapeum:op `(:method
                                    ,@(subseq _1 0 2)
                                  (,@(elt _1 2))
                                  ,@(subseq _1 3)))
                  body))))
 
 (defgeneric resolve-request (acceptor request)
   (:method-combination or :most-specific-first)
   (:method or ((acceptor myway-acceptor) request)
            (setf (hunchentoot:return-code*) 404)
            (format nil "~s not found" (hunchentoot:script-name*))))
 
 (defmethod hunchentoot:acceptor-dispatch-request ((acceptor myway-acceptor) request)
   (let ((router (mapper acceptor)))
     (multiple-value-bind (result matched) (myway:dispatch router (hunchentoot:script-name*)
                                                           :method (hunchentoot:request-method*))
       (if matched
           result
           (or (resolve-request acceptor request)
               (call-next-method))))))