(defpackage #:lazybones/client.parenscript
  (:use #:cl)
  (:local-nicknames (#:lzb #:lazybones)
                    (#:a #:alexandria))
  (:export #:generate))

(in-package :lazybones/client.parenscript)

(defun lispify (str)
  #+testiere
  (:tests
   (equalp (lispify "a.b") "a-b")
   (equalp (lispify "a/b") "a-b"))
  (with-output-to-string (out)
    (loop :for c :across str :do
      (write-char
       (if (find c "./") #\- c)
       out))))

(defun client-function-name (method pattern)
  "Return a symbol; the name of the parenscript function that will make
an HTTP request of type METHOD at the path implied by PATTERN. PATTERN
is the value of the endpoint's DISPATCH-PATTERN slot."
  #+testiere
  (:tests
   (string-equal
    (client-function-name
     :get '("" "session" ("doesn't" :matter) "notifications"))
    'get-session-notifications)
   (string-equal
    (client-function-name
     :post '("" "foo.bar" "moo"))
    'post-foo-bar-moo))

  (intern
   (lispify
    (string-upcase
     (format nil "~a-~{~a~^-~}"
             method
             (remove-if-not (a:conjoin #'stringp (complement #'a:emptyp))
                            pattern))))))

(defun client-function-lambda-list (variables body?)
  #+testiere
  (:tests
   (equalp
    (client-function-lambda-list '("*SESSION*") nil)
    '(*session*))

   (equalp
    (butlast (client-function-lambda-list '("a.x" "b/y" "c") t))
    '(a-x b-y c &optional)))

  (nconc (mapcar (a:compose #'intern #'string-upcase #'lispify) variables)
         (when body? (list '&optional (gensym "BODY")))))

(defun client-function-endpoint-path (prefix pattern)
  #+testiere
  (:tests
   (equalp
    (client-function-endpoint-path
     "/api" '("" "session" ("id" :blahblah) "notifications"))
    '(+ "/api" "/" "session" "/"  id "/" "notifications")))
  (list* '+ prefix
         (loop :for x :in pattern
               :unless (zerop (length x))
                 :collect "/"
                 :and :collect (if (consp x)
                                   (intern (string-upcase (first x)))
                                   x))))

(defun method-accepts-body? (m)
  (member m '(:post :put :patch)))

(defun generate-endpoint-form (app ep)
  (let* ((method
           (lzb:endpoint-method ep))

         (method-name
           (symbol-name method))

         (content-type
           (or (lzb:endpoint-content-type ep)
               (lzb::default-content-type app)))

         (pattern
           (lzb:endpoint-dispatch-pattern ep))

         (variables
           (lzb:endpoint-route-variables ep))

         (function-name
           (client-function-name method pattern))

         (body?
            (method-accepts-body? method))

         (lambda-list
           (client-function-lambda-list variables body?))

         (body
           (when body?
             (first (last lambda-list))))
         
         (fetch-path
           (client-function-endpoint-path (lzb::app-prefix app) pattern)))
    
    `(defun ,function-name ,lambda-list
       ,(if body
            `(fetch ,fetch-path
                    (ps:create
                     method ,method-name
                     headers  (ps:create "Content-Type" ,content-type)
                     redirect "follow"
                     body ,body))
            `(fetch ,fetch-path)))))

(defun generate (app)
  (let* ((module
           (gensym "MODULE"))

         (module-name
           (intern (lispify (symbol-name (lzb::app-name app)))))

         (defuns
           (loop :for ep :in (lzb:app-endpoints app)
                 :collect (generate-endpoint-form app ep)))

         (exports
           (loop :for defun :in defuns
                 :for name := (second defun)
                 :collect `(ps:@ ,module ,name)
                 :collect name)))
    
    `(defvar ,module-name
       ((lambda (,module)
          ,@defuns
          (setf ,@exports)
          ,module)
        (ps:create)))))