;;;; cl-scopes/web/server - web server functionality

(defpackage :scopes/web/server
  (:use :common-lisp)
  (:local-nicknames (:config :scopes/config)
                    (:core :scopes/core)
                    (:alx :alexandria))
  (:export #:config #:address #:port #:routes
           #:*listener* #:setup #:start #:stop
           #:fileserver #:message-handler))

(in-package :scopes/web/server)

(defclass config (config:base)
  ((config:env-slots :initform '(address port))
   (config:setup :initform #'setup)
   (address :reader address :initarg :address :initform "localhost")
   (port :reader port :initarg :port :initform "8888")
   (routes :reader routes :initarg :routes :initform nil)))

;;;; listener = server process

(defun app (ctx env)
  (funcall (select-app ctx env)))

(defun start (ctx)
  (let ((cfg (core:config ctx)))
    (setf (listener ctx)
      (clack:clackup #'(lambda (env) (app ctx env))
                     :port (parse-integer (port cfg))
                     :address (address cfg)
                     :silent t))))

(defun stop (ctx)
  (clack:stop (listener ctx)))

(defun fileserver (ctx env &key doc-root)
  (let* ((message-head (getf env :message-head))
         (rel-path (str:join "/" message-head))
         (file-app (make-instance 'lack/app/file:lack-app-file 
                                  :file rel-path :root doc-root)))
    ;(format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root))
    (lack/component:call file-app env)))

(defun message-handler (ctx env)
  ;(print env)
  ;(print (read-line (getf env :raw-body)))
  (let ((head (head env))
        (data (data env)))
    (format t "~&message head ~s, data ~s~%" head data)
    '(200 (:content-type "text/plain") ("Hello World!"))))

(defun select-app (ctx env)
  (let ((path (cdr (str:split "/" (getf env :path-info)))))
    (dolist (r (routes (core:config ctx)))
      (when (match (car r) path)
        (setf (getf env :message-head) (nthcdr (length (car r)) path))
        (return-from select-app 
                     #'(lambda () 
                         (apply (cadr r) ctx env (cddr r)))))))
  #'(lambda () (message-handler ctx env)))

(defun match (pattern path)
    ;(format t "~&match: pattern ~s, path ~s" pattern path)
    (dolist (e pattern)
      (unless (string= e (pop path))
        (return-from match nil)))
  t)

;;;; server context (= service)

(defclass context (core:context) 
  ((listener :accessor listener)))

(defun setup (cfg)
  (let ((ctx (make-instance 'context :config cfg :name (config:name cfg))))
    (start ctx)
    ctx))

;;;; helper functions

(defun as-keyword (s)
  (intern (string-upcase s) :keyword))

(defun head (env)
  (let ((head (getf env :message-head)))
    (mapcar #'(lambda (e) (as-keyword e)) head)))

(defun data (env)
  (let* ((a1 (quri.decode:url-decode-params (read-line (getf env :raw-body))))
         (a2 (mapcar #'(lambda (p) (cons (as-keyword (car p)) (cdr p))) a1)))
    (alx:alist-plist a2)))