(in-package :slacker)

(defmethod attach-module ((event-pump event-pump) module &rest args &key)
  (setf (gethash (make-keyword module)
		 (modules event-pump))
	(apply #'make-instance
	       module
	       args)))

(defvar *api-token*) 

(defun make-client (event-pump)
  (flet ((get-ws-url (slack-response)
	   (gethash "url" slack-response)))
    (fw.lu:let-each (:be slack-data)
      (format nil "https://slack.com/api/rtm.start?token=~a" *api-token*)
      (drakma:http-request slack-data :want-stream t)
      (yason:parse slack-data)

      (let* ((url (get-ws-url slack-data))
	     (self (gethash "self" slack-data))
	     (users (gethash "users" slack-data))
	     (client (wsd:make-client url)))

	(declare (ignorable self users))
	(wsd:on :message client
		(lambda (message)
		  (chanl:send (result-queue event-pump)
			      message)))
	client))))

(defgeneric send-message (client type &key)
  (:documentation "Send a slack message")
  (:method :around ((client event-pump) _type &key)
    (declare (ignorable client _type))
    (let ((result (call-next-method)))
	(values result
		(wsd:send (ws-client client)
			(with-output-to-string (s)
			    (yason:encode result s)))))))


(defgeneric start-module (client module)
  (:documentation "start a module"))

(defun start-client (&key modules)
 (let* ((event-pump (make-instance 'event-pump))
	(client (make-client event-pump)))
   (setf (ws-client event-pump)
	 client)
   (values event-pump
	   (bt:make-thread 
	    (lambda ()
	      (loop for (module . args) in modules
		 do (start-module event-pump
				  (apply #'attach-module
					 event-pump module args)))
	      (as:with-event-loop () 
		(websocket-driver:start-connection client)

		(as:with-interval (15)
		  (send-message event-pump :ping))

		(as:with-interval (0.01)
		  (multiple-value-bind (message message-p)
		      (chanl:recv (work-queue event-pump)
				  :blockp nil)
		    (when message-p
		      (format t "Got a message")
		      (funcall message
			       event-pump)))
		  :event-cb (lambda (ev)
			      (format t "~&EVENT: ~a~%" ev)))))
	    :name "Event Server"))))

(defmethod get-event-nonblocking ((event-pump event-pump) &key (object-as :hash-table))
  (multiple-value-bind (message message-p) (chanl:recv (result-queue event-pump) :blockp nil)
    (values (when message-p
	      (yason:parse message :object-as object-as))
	    message-p)))

(defmethod get-event ((event-pump event-pump) &key (object-as :hash-table))
  (multiple-value-bind (message message-p) (chanl:recv (result-queue event-pump))
    (values (when message-p
	      (yason:parse message :object-as object-as))
	    message-p)))

(defun event-loop (event-pump)
  (loop with message with message-p
     do (multiple-value-setq (message message-p) (get-event event-pump))
     when message-p do
       (let ((type (gethash "type" message))
	     (reply (gethash "reply_to" message)))
	 (cond (type (string-case (gethash "type" message)
		       ("message" (format t "~&MSG: <~a/~a> ~a~%"
					  (gethash "channel" message)
					  (gethash "user" message)
					  (gethash "text" message))
				  (when-let* ((msg (gethash "text" message))
					      (parsed-message (tokens msg))
					      (ts (gethash "ts" message))
					      (channel (gethash "channel" message))) 
				    (when (eql #\; (elt msg 0))
				      (handle-command event-pump ts channel
						      (car parsed-message)
						      (cdr parsed-message)))))
		       (t (fresh-line)
			  (yason:encode message)
			  (terpri))))
	       (reply )))
       do (sleep 0.01)))

(defun coordinate-threads ()
  (let* ((event-pump (start-client :modules '((hhgbot-augmented-assistant::js-executor)))))
    (bt:make-thread (lambda ()  (event-loop event-pump))
		    :name "Event Loop") 
    event-pump))

(defparameter *command-table* (make-hash-table :test 'equal))

(defun quote-output (str)
  (with-output-to-string (s)
    (format s "```~%~a```~%" str)))

(defmacro in-wq ((client-sym) &body body)
  `(let ((promise (blackbird-base:make-promise)))
     (values promise
	     (chanl:send (work-queue ,client-sym)
			 (lambda (,client-sym)
			   (declare (ignorable ,client-sym))
			   (let ((result (progn ,@body)))
			     (blackbird-base:finish promise result)
			     result))))))

(define-modify-macro aconsf (key datum)
  (lambda (alist key datum)
    (acons key datum alist)))

(defmethod send-message ((client event-pump) (type (eql :ping)) &key data)
  (let* ((id (incf (latest-id client)))
         (message `(("id" . ,id)
                    ("type" . "ping"))))

    (when data
      (aconsf message "data" data))

    (incf (waiting-pings client))
    (alist-hash-table message
                      :test 'equal)))

(defmethod send-message ((client event-pump) (type (eql :message)) &key channel data)
  (let* ((id (incf (latest-id client)))
	 (message `(("id" . ,id)
		    ("type" . "message")
		    ("channel" . ,channel)
		    ("text" . ,data))))
    (alist-hash-table message
		      :test 'equal)))

(defun queue-message (event-pump channel message &key quote)
  (let ((message (if quote (quote-output message)
		     message)))
    (in-wq (event-pump)
      (send-message event-pump :message
		    :channel channel
		    :data message))))

(define-condition command-error () ())
(define-condition unsupported-args (command-error) ())

(defmacro define-command (name (event-pump ts channel &rest args) &body body)
  (let* ((command-sym (intern (string-upcase name)))
	 (has-rest (position '&rest args))
	 (rest-sym (gensym "rest"))
	 (args (if has-rest
		   args
		   (append args `(&rest ,rest-sym)))))
    `(progn
       (defun ,command-sym (,event-pump ,ts ,channel ,@args)
	 (declare (ignorable event-pump ts ,@(when (not has-rest) `(,rest-sym))))
	   ,@body)
       (setf (gethash ,name *command-table*) (function ,command-sym)))))

(defun safe-apply (func event-pump ts channel args)
  (with-simple-restart (continue "Skip command")
    (apply func event-pump ts channel args)))

(defun handle-command (event-pump ts channel command args)
  (declare (ignorable args))
  (let* ((command (subseq (plump:decode-entities command) 1))
	 (handler (gethash command *command-table*)))
    (print (hash-table-alist *command-table*))
    (terpri)
    (print command)
    (if handler
	(safe-apply handler event-pump ts channel args)
	(queue-message event-pump channel (concat "I don't understand the command `" command "`.")))))

(defun slack-api-call (method &rest args)
  (bb:with-promise (resolve reject)
    (bt:make-thread
     (lambda ()
       (handler-case
	   (let ((api-result (yason:parse
			      (babel:octets-to-string 
			       (drakma:http-request (concat "https://slack.com/api/" method "?token=" *api-token*)
						    :method :post
						    :content (quri:url-encode-params
							      (loop for (key value) on args by #'cddr
								 collect (cons (string-downcase key) value)))
						    :proxy (list "127.0.0.1" 8080))))))
	     ;todo error handling . . .
	     (resolve api-result)) 
	 (t (c) (reject c)))))))

(defgeneric api-call (name args)
  (:method ((name symbol) (args list))
    (slack-api-call ,)))

(defmacro define-api-wrapper (name required-args &rest args)
  (flet ((name-case (string)
	   (let ((parts (split-sequence #\- (string-downcase string))))
	     (apply #'concatenate 'string
		    (car parts)
		    (mapcar #'string-capitalize (cdr parts))))))
    (let* ((api-method-name (name-case name)))
      `(progn (defun ,name (,@required-args &rest r &key ,@args)
		(apply #'slack-api-call ,api-method-name
		       ,@(loop for req-arg in required-args
			    append (list (make-keyword req-arg) req-arg))
		       r))
	      (eval-when (:compile-toplevel :load-toplevel :execute)
		(let ((*package* 'slacker.api))
		  (import ',name)
		  (export ',name)))))))


(defmacro define-api-wrappers (&body body)
  `(progn ,@(loop for (name required-args . rest) in body
		 collect `(define-api-wrapper ,name ,required-args ,@rest))))

(defun edit-message (ts channel text)
  (babel:octets-to-string
   (drakma:http-request "https://slack.com/api/chat.update"
			:method :post
			:content (concat "token=" *api-token*
					 "&channel=" channel
					 "&ts=" ts
					 "&text=" text))))

(defmacro with-output-to-message ((stream event-pump channel &key quote) &body body)
  (once-only (event-pump channel quote)
    `(queue-message ,event-pump ,channel
		    (with-output-to-string (,stream)
		      ,@body)
		    :quote ,quote)))

(define-command "help" (event-pump ts channel)
  (let ((*print-right-margin* (max (or *print-right-margin* 0)
				   80)))
    (with-output-to-message (s event-pump channel)
      (format s "I understand these commands:~%~{`~a`~^ ~}"
	      (hash-table-keys *command-table*))
      :quote t)))


(defparameter *id* 0)
(defun make-message (data channel)
  (incf *id*)
  (with-output-to-string (s)
    (yason:encode
     (alist-hash-table
      `(("id" . ,*id*)
	("type" . "message")
	("channel" . ,channel)
	("text" . ,data)))
     s)))


(in-package :slacker.api)

(slacker::define-api-wrappers
  (chat.delete (ts channel) as_user)
  (chat.me-message (channel text))
  (chat.post-message (channel text) parse link_name attachments unfurl_links unfurl_media username as_user icon_uri icon_emoji)
  (chat.update (ts channel text) attachments parse link_names as_user))