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