(defpackage :fwoar.mc-web
  (:use :cl)
  (:export
   #:myway-server
   #:*current-route*
   #:routing
   #:define-route-group
   #:resolve-request))
(in-package :fwoar.mc-web)

(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)
                 `(let ((*method-route* ,(cadr (method-qualifiers method))))
                    (myway:connect (mapper ,server) *method-route*
                                   (call-method ,method))))
               (stable-sort routes #'<
                            :key (alexandria:compose #'length
                                                     #'cadr
                                                     #'method-qualifiers)))))

(defmacro define-route-group (name (&rest args) &body body)
  (let* ((docstring (when (and body (stringp (car body)))
                      (car body)))
         (body (if docstring
                   (cdr body)
                   body)))
    (alexandria:with-gensyms (server)
      `(defgeneric ,name (,server ,@args)
         (:method-combination routing)
         (:documentation ,docstring)
         ,@(mapcar (serapeum:op `(:method
                                     ,@(subseq _1 0 2)
                                   (,server ,@(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))))))