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

(defpackage :scopes/web/server
  (:use :common-lisp)
  (:local-nicknames (:config :scopes/config)
                    (:core :scopes/core)
                    (:message :scopes/core/message)
                    (: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)
   (config:shutdown :initform #'stop)
   (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)
  (log:info "request: ~a ~a, accept: ~a" 
            (getf env :request-method) 
            (getf env :request-uri)
            (gethash "accept" (getf env :headers)))
  (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)
                     ;:server :woo
                     :silent t))
    (log:info "port: ~a." (port cfg))
    ctx))

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

(defun fileserver (ctx env &key doc-root)
  (let* ((message-head (getf env :message-head))
         (tail (last message-head)))
    (if (string= (car tail) "")
      (setf (car tail) "index.html"))
    (let* ((rel-path (str:join "/" message-head))
           (file-app (make-instance 'lack/app/file:lack-app-file 
                                    :file rel-path :root doc-root)))
      (lack/component:call file-app env))))

(defun message-handler (ctx env)
  (let* ((resp (make-response ctx))
         (msg (message:make-message (head env) :data (plist (post-data env)))))
    (log:debug "msg ~s" msg)
    (if (core:handle-message ctx msg)
      '(200 (:content-type "text/plain") ("Hello World!"))
      '(404 (:content-type "text/plain") ("Not found")))))

(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)))))))
  (message-handler ctx env))

(defun match (pattern path)
    (dolist (e pattern)
      (unless (string= e (pop path))
        (return-from match nil)))
  t)

;;;; server response - provice response body and headers

(defun make-response (ctx))

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

;;;; helper functions

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

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

(defun post-data (env)
  (if (getf env :content-length)
  (let* ((raw (getf env :raw-body))
         (str (read-line (flexi-streams:make-flexi-stream raw))))
    (quri.decode:url-decode-params str))))

(defun plist (alst)
  (let ((a2 (mapcar #'(lambda (p) (cons (as-keyword (car p)) (cdr p))) alst)))
    (alx:alist-plist a2)))