(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))))))