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