(defpackage :hhgbot-2
  (:use :cl :alexandria :serapeum :slacker :fw.lu))

(defpackage :quote-server
  (:use :cl :ningle :araneus :serapeum :alexandria :fw.lu)
  (:export #:start))

(cl:in-package :hhgbot-2)

(defun normalize-ref (value)
  (when (or (alexandria:ends-with-subseq "co" value)
            (alexandria:ends-with-subseq "s.c" value))
    (setf value (format nil "~a." value)))
  (when (alexandria:ends-with-subseq "sc" value)
    (setf value (format nil "~as.c." (subseq value 0 (- (length value) 2)))))
  (when (alexandria:ends-with-subseq "sc." value)
    (setf value (format nil "~as.c." (subseq value 0 (- (length value) 3)))))

  value)

;; Special Variables

(defvar *xxx* (make-synonym-stream '*standard-output*))
(defvar *client*)
(defvar *queue-pair* nil)
(defvar *slack-url* "https://~a.slack.com")
(defparameter *refs* (make-hash-table :test 'equalp))
;; Macros

(defclass logging-slackbot ()
  ((%users :initform (make-hash-table :test 'equal))
   (%conversations :initform (make-hash-table :test 'equal))))


(defclass hhgbot-event-pump (slacker:event-pump #+(or)slacker.montezuma-store:montezuma-store logging-slackbot
			     slacker.postmodern-store:postmodern-store)
  ()
  #+(or)(:default-initargs :index-path "/tmp/slack-idx/"))

(defun start-in-repl (&optional (start-bot t) (team-id :atomampd))
  (ubiquitous:restore :hhgbot-augmented-assistant)
  (setf slacker::*api-token* (ubiquitous:value :api-token :atomampd))
  (if start-bot
      (start-with-apitoken team-id)
      slacker::*api-token*))

(defun start-with-apitoken (&optional (team-id :atomampd))
  (unless *queue-pair*
    (setf *queue-pair* (make-instance 'slacker::queue-pair)))

  (ubiquitous:restore :hhgbot-augmented-assistant)
  (let ((slacker::*api-token* (ubiquitous:value :api-token team-id)))
    (unless slacker::*api-token*
      (format *terminal-io* "~&API Token? ")
      (finish-output *terminal-io*)
      (let ((value (read-line)))
        (setf (ubiquitous:value :api-token team-id) value
              slacker::*api-token* value)))
    (values (slacker:coordinate-threads *queue-pair* 'hhgbot-event-pump
					'(:postgres-connection-spec ("edwlan" "edwlan" nil :unix)))
            slacker::*api-token*)))

(defun ensure-unescaped (src)
  (if (and (starts-with #\` src)
           (ends-with #\` src))
      (cond
        ((and (>= (length src) 6)
              (starts-with-subseq "```" src)
              (ends-with-subseq "```" src))
         (subseq src 3 (- (length src) 3)))
        ((>= (length src) 2)
         (subseq src 1 (- (length src) 1)))
        (t src))
      src))

(define-command "js>" (event-pump message channel &rest args)
  (declare (ignorable message))
  (let ((hhgbot-augmented-assistant::*js-executor* (get-module :js-executor event-pump))
        (js-src (ensure-unescaped (string-join args " "))))
    (blackbird:alet ((result (hhgbot-augmented-assistant::submit-js hhgbot-augmented-assistant::*js-executor*
                                                                    js-src)))
      (let ((result (cl-js:to-string result)))
        (queue-message event-pump channel
                       (subseq result 0
                               (min 1000
                                    (length result)))
                       :quote t
                       :thread (ensure-thread message))))))

(define-command "id" (event-pump message channel &optional (for "channel"))
  (queue-message event-pump channel
                 (string-case for
                   ("channel" channel)
                   (t (concat "don't know the id for " for)))
                 :quote t
                 :thread (ensure-thread message)))

(define-command "sources" (event-pump message channel &rest args)
  (declare (ignore args))
  (queue-message event-pump channel
                 (format nil "~{~a~^, ~}" (hash-table-keys *refs*))
                 :thread (ensure-thread message)))

(define-command "ref>" (event-pump message channel &optional source ref &rest args)
  (declare (ignore args))
  (when args
    (setf ref (format nil "~a~{~a~}" ref args)))

  (if (and source ref)
      (when-let ((source-h (gethash source *refs*)))
        (queue-message event-pump channel
                       (gethash (normalize-ref ref) source-h (concat "Can't find " source " " ref))
                       :thread (keep-in-thread message)))
      (queue-message event-pump channel (concat "Must provide both a source and a reference. See ;sources")
                     :thread (keep-in-thread message))))

(defmacro define-message-command (name (&rest args) &body body)
  (let ((message-sym (cadr args)))
    `(define-command ,name (,@args)
       (queue-message event-pump channel
                      (progn ,@body)
                      :thread (keep-in-thread ,message-sym)))))

(define-command "latina" (event-pump message channel word &rest a)
  (declare (ignore a))
  (let* ((results (words-coprocess::get-word-results word))
         (json-objs (split-sequence #\newline results :remove-empty-subseqs t))
         (parsed (mapcar 'yason:parse json-objs)))
    (queue-message event-pump channel
                   (format nil "~{> ~a~2%~}"
                           (remove-if-not #'identity
                                          (mapcan (op (gethash "meanings" _))
                                                  parsed))))))

(define-message-command "random-quote" (event-pump message channel &rest args)
  args
  (let-each (:be *)
    (hash-table-keys *refs*)
    (random-elt *)
    (gethash * *refs*)
    (let ((keys (hash-table-keys *)))
      (gethash (random-elt keys) *))))

(defun trace-value (&rest args)
  (format *trace-output* "===>>> ~{~s~^ ~}" args)
  (values-list args))

(define-message-command "arc" (event-pump message channel &rest args)
  (if (equal (gethash "user" message)
	     "U0CSPP3SB")
      (let ((r (with-output-to-string (s)
		 (multiple-value-bind (results idx)
		     (slacker.montezuma-store:search-index *client* "message" (string-join args " "))
		   (montezuma:each results
				   (lambda (h)
				     (format s "> ~a: ~a~%"
					     (local-time:format-timestring
					      nil
					      (local-time:unix-to-timestamp
					       (floor 
						(parse-number
						 (montezuma:document-value (montezuma:get-document idx (montezuma:doc h))
									   "ts")))
					       )
					      :format local-time:+rfc3339-format+)
					     
					     (montezuma:document-value (montezuma:get-document idx (montezuma:doc h))
								       "text"))))))))
	(if (= 0 (length r))
	    (format nil "No results found for: `~a`" (string-join args " "))
	    r))
      (format nil "No results found for: `~a`" (string-join args " "))))

(defun extract-channel-info (channels)
  (funcall (data-lens:pick
            (compose
             (data-lens:applying (lambda (name id is-member is-private is-mpim)
                                   (list name id
                                         (plist-hash-table
                                          (list "is-member" is-member
                                                "is-private" is-private
                                                "is-mpim" is-mpim)
                                          :test 'equal))))
             (data-lens:juxt (op (gethash "name" _))
                             (op (gethash "id" _))
                             (op (gethash "is_member" _))
                             (op (gethash "is_private" _))
                             (op (gethash "is_mpim" _)))))
           (gethash "channels" channels)))

(defun find-channel (name)
  (bb:alet* ((r (slacker.api:channels.list))
             (channels (funcall (data-lens:pick
                                 (data-lens:juxt (op (gethash "name" _))
                                                 (op (gethash "id" _))))
                                (gethash "channels" r))))
    #+nil    (fw.su:log-json channels)
    (assoc name channels :test 'equal)))

(defmacro with-output-to-json-string ((s &rest args &key indent) &body body)
  "Set up a JSON streaming encoder context, then evaluate BODY.
Return a string with the generated JSON output."
  (declare (ignore indent))
  `(with-output-to-string (,s)
     (with-open-stream (,s (yason:make-json-output-stream s ,@args))
       ,@body)))

(defmacro dbind* (destructuring-expression promise-gen &body body)
  `(bb:attach ,promise-gen
              (fw.lu:destructuring-lambda (,destructuring-expression)
                ,@body)))

(defmethod slacker:handle-message :before (type (event-pump hhgbot-event-pump) ts channel message)
  (declare (ignore type ts channel))
  #+nil
  (index-message message)
  (values))

(define-command "notify-channel" (event-pump message channel
                                             &optional target
                                             &rest args)
  (format *xxx* "~&~a: ~{~a~^ ~}~%" target args)
  (dbind* (&optional target-name target-id) (find-channel target)
    (if target-name
        (progn
          (with (message (string-join args #\space))
            (when-let* ((start-link (position #\< message))
                        (stop-link (position #\> message :start start-link))
                        (_ (> stop-link (+ 4 start-link))))
              (setf message (concat (subseq message 0 start-link)
                                    (subseq message (1+ start-link) stop-link)
                                    (subseq message (1+ stop-link)))))
            (queue-message event-pump target-id
                           message))
          (queue-message event-pump target-id
                         (format nil "Notifying channel ~a" target-name)
                         :thread (ensure-thread message)))
        (queue-message event-pump target-id (format nil "Can't find channel `~a`" target)
                       :thread (ensure-thread message)))))

(defparameter *reaction-store* (make-hash-table :test 'equalp :synchronized t))

(defun format-reaction-store ()
  (format nil "~{~a~^~%~}"
          (loop for reaction in (sort (hash-table-keys *reaction-store*) #'string-lessp)
                for (count users) = (gethash reaction *reaction-store*)
                collect (format nil ":~a: `~a` ~{<@~a>~^ ~}" reaction count (remove-duplicates users :test 'equalp)))))

(define-message-command "show-reactions" (event-pump message channel &rest args)
  args
  (format-reaction-store))

(defmethod slacker:handle-message ((type (eql :reaction_added)) event-pump ts channel message)
  ;; {"type":"reaction_added","user":"U0CSPP3SB","item":{"type":"message","channel":"G1YA9SR0S","ts":"1489124136.780019"},"reaction":"+1","item_user":"U0CSPP3SB","event_ts":"1489124534.806294","ts":"1489124534.806294"}
  (let ((reaction-info (ensure-gethash (gethash "reaction" message) *reaction-store* (list 0 nil))))
    (incf (car reaction-info))
    (push (gethash "user" message) (cadr reaction-info))))

(defun read-refs (stream)
  (loop for x = (read stream nil)
        while x
        for (type source ref text) = x
        do
           (setf (gethash ref
                          (ensure-gethash (string source)
                                          *refs*
                                          (make-hash-table :test 'equalp)))
                 text)))
(defun initialize-quotes ()
  (loop for filename in '("qda.sexp" "refs.sexp" "scg.sexp" "ss.sexp")
        do
           (with-input-from-file (s filename :external-format :utf-8)
             (read-refs s))))

(defun main ()
  (initialize-quotes)
  (quote-server:start)
  (setf (values *client* slacker::*api-token*)
        (start-in-repl)))

(in-package :quote-server)

(defparameter *app* (make-instance '<app>))

(define-controller quote (params)
  (let* ((text (cdr (assoc :text params)))
         (ref (cdr (assoc :ref params))))
    (cons (cons text ref)
	  (gethash (hhgbot-2::normalize-ref ref)
		   (gethash text hhgbot-2::*refs*)))))

(define-controller random-quote (params)
  (declare (ignore params))
  (let-each (:be *)
    (hash-table-keys hhgbot-2::*refs*)
    (random-elt *)
    (let* ((text (gethash * hhgbot-2::*refs*))
           (keys (hash-table-keys text))
           (selected-elt (random-elt keys)))
      (cons (cons * selected-elt) (gethash (random-elt keys) text)))))

(define-view random-quote (model)
  (destructuring-bind ((book . ref) . text) model
    `(302
      ("Location"  ,(format nil "/q/~a/~a"
                            book ref))
      (,text))))

(define-spinneret-view quote (quote)
  (let ((title (format nil "Quote: ~a, ~a" (caar quote) (cdar quote)))
        (permalink (format nil "/q/~a/~a"
                           (caar quote)
                           (hhgbot-2::normalize-ref (cdar quote)))))
    (:html
     (:head (:title title)
            (:link :href "https://fonts.googleapis.com/css?family=Lato:400&subset=latin,latin-ext" :rel "stylesheet" :type "text/css")
            (:style "p { font-family: 'Lato', sans-serif; width: 50vw; margin-left: 25vw; } p::first-letter {color:red} p:first-child { margin-top: 10vh; }")
            (:meta :property "og:title" :content title)
            (:meta :property "fb:app_id" :content "521205154682685")
            (:meta :property "og:url" :content permalink)
            (:meta :property "og:description" :content (cdr quote)))
     (:body
      (:p (cdr quote))
      (:p (:a :href permalink permalink))
      (:p (:a :href "/" "Random quote"))))))

(defroutes *app*
  (("/" :GET) (as-route 'random-quote))
  (("/q/:text/:ref" :GET) (as-route 'quote))
  )

(defparameter *word-index* (make-array 100 :adjustable t :fill-pointer 0))

(defun index-quote (text ref)
  (let ((quote (split-sequence-if-not (op (alphanumericp _))
                                      (pick (list text ref) hhgbot-2::*refs*)
                                      :remove-empty-subseqs t)))
    quote))

(let ((handler '()))
  (defun start ()
    (push (clack:clackup *app*) handler))
  (defun stop ()
    (clack:stop (pop handler))))