(defpackage :fwoar.web-test
  (:import-from :fwoar.myway-acceptor :define-route-group)
  (:local-nicknames
   (:db :fwoar.web-test.db))
  (:use :cl )
  (:export ))
(in-package :fwoar.web-test)

(defclass my-server (fwoar.websocket-acceptor:websocket-acceptor
                     fwoar.myway-acceptor:myway-acceptor)
  ((%models :initarg :models :reader models)))

(defgeneric register-model (server model)
  (:method (server model)
    (error "~s is not a class or a class name" model))
  (:method (server (model standard-class))
    (error "can only register server-aware classes, got ~s!" model))
  (:method ((server my-server) (model fwoar.server-aware-class:server-aware-class))
    (setf (fwoar.server-aware-class:server model) server))
  (:method ((server my-server) (model symbol))
    (register-model server (find-class model))))

(defclass console-publisher ()
  ())

(defmethod register-model ((publisher console-publisher)
                           (model fwoar.server-aware-class:server-aware-class))
  (setf (fwoar.server-aware-class:server model)
        publisher))

(defmethod update-instance-for-redefined-class ((instance my-server) added-slots discarded-slots property-list &key models)
  (when (member '%models added-slots)
    (setf (slot-value instance '%models) models)))

(defclass user (hunchensocket:websocket-client)
  ((name :initarg :user-agent :reader name :initform (error "Name this user!"))))

(defclass chat-room (hunchensocket:websocket-resource)
  ((name :initarg :name :initform (error "Name this room!") :reader name))
  (:default-initargs :client-class 'user))

(defvar *chat-rooms*
  (list (make-instance 'chat-room :name "/bongo")
        (make-instance 'chat-room :name "/fury")))

(defmethod fwoar.websocket-acceptor:find-websocket-resource ((acceptor my-server) request)
  (find (hunchentoot:script-name request)
        *chat-rooms* :test #'string= :key #'name))

(defun broadcast (room message &rest args)
  (loop for peer in (hunchensocket:clients room)
     do (hunchensocket:send-text-message peer (apply #'format nil message args))))

(defmethod hunchensocket:client-connected ((room chat-room) user)
  )

(defmethod hunchensocket:client-disconnected ((room chat-room) user)
  )

(defmethod hunchensocket:text-message-received ((room chat-room) user message)
  )  

(defun render-post (post)
  (spinneret:with-html
    (:section
     (:header
      (:h* (db:title post))
      (:div.author (db:author post)))
     (:section (db:content post)))))

(defun summarize (post)
  (spinneret:with-html
    (:li
     (:a :href (format nil "/post/~a" (db:id post))
         (db:title post)))))



(defmethod fwoar.server-aware-class:publish-value ((server my-server)
                                                   (object db:blog-post)
                                                   (slot (eql 'posts))
                                                   (old-value fset:map) (new-value fset:map))
  (unless (fset:equal? old-value new-value)
    (broadcast (car *chat-rooms*)
               (yason:with-output-to-string* (:indent t)
                 (yason:with-object ()
                   (yason:encode-object-elements
                    "slot" (string-downcase slot)
                    "type" (string-downcase (class-name (class-of object))))
                   (yason:with-object-element ("value")
                     (yason:with-array ()
                       (mapcar (lambda (it)
                                 (let ((val (fset:lookup new-value it)))
                                   (yason:with-object ()
                                     (yason:encode-object-elements
                                      "id" (id val)
                                      "title" (title val)))))
                               (fset:convert 'list (fset:domain (fset:map-difference-2 new-value old-value)))))))))))

(defmethod fwoar.server-aware-class:publish-value ((server console-publisher)
                                                   (object db:blog-post)
                                                   slot
                                                   (old-value string)
                                                   (new-value string))
  (unless (equal old-value new-value)
    (format t "~&SLOT: ~s~%FROM: ~s~&TO: ~s~&"
            slot
            old-value
            new-value)))


(defgeneric m-index (thing)
  )

(defclass blog ()
  ((%montezuma-index :initarg :montezuma :reader m-index)))

(defun posts (blog)
  (declare (ignorable blog))
  (list (db:make-blog-post "First Post" "Ed L" "This is the first post")
        (db:make-blog-post "Second Post" "Ed L" "This is the second post")
        (db:make-blog-post "Third Post" "Ed L" "This is the third post")
        (db:make-blog-post "Fourth Post" "Ed L" "This is the fourth post")))

(defun connect-script ()
  (ps:ps
    (defun summarize (post)
      (spinneret:with-html
        (:li
         (:a :href (ps:chain "/post/"
                             (concat (ps:@ post id)))
             (ps:@ post title)))))
    (setf (ps:@ (ps:new (-web-socket "ws://localhost:12345/bongo")) onmessage)
          (lambda (e)
            (let ((data (ps:chain -j-s-o-n (parse (ps:@ e data)))))
              (ps:chain data value
                        (map (lambda (x)
                               (ps:chain document
                                         (query-selector "#posts")
                                         (append-child (summarize x)))))))))))

(defun page ()
  (spinneret:with-html-string
    (:doctype)
    (:html
     (:body
      (:main
       (:section
        (:h* "My Blog")
        (:ul#posts
         (loop for post
            in (fset:convert 'list (fset:range (posts blog)))
            do (summarize post)))
        (:script
         (connect-script))))))))

(define-route-group blog-methods (server blog)
  (:route "/" ((server my-server) (blog blog))
          (lambda (params)
            (declare (ignore params))
            ))
  (:route "/post/:id" ((server my-server) (blog blog))
          (lambda (params)
            (spinneret:with-html-string
                (:doctype)
              (:html
               (:body
                (:main
                 (:section
                  (:h* "My Blog")
                  (render-post
                   (fset:lookup (posts blog) (getf params :id)))))))))))