@@ -7,6 +7,17 @@

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

@@ -21,9 +32,10 @@

    (%conversations :initform (make-hash-table :test 'equal))))

-(defclass hhgbot-event-pump (slacker:event-pump slacker.montezuma-store:montezuma-store logging-slackbot)

+(defclass hhgbot-event-pump (slacker:event-pump #+(or)slacker.montezuma-store:montezuma-store logging-slackbot

+			     slacker.postmodern-store:postmodern-store)

   ()

-  (:default-initargs :index-path "/tmp/slack-idx/"))

+  #+(or)(:default-initargs :index-path "/tmp/slack-idx/"))

 (defun start-in-repl (&optional (start-bot t) (team-id :atomampd))

   (ubiquitous:restore :hhgbot-augmented-assistant)

@@ -44,7 +56,8 @@

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

+    (values (slacker:coordinate-threads *queue-pair* 'hhgbot-event-pump

+					'(:postgres-connection-spec ("edwlan" "edwlan" nil :unix)))

             slacker::*api-token*)))

 (defun ensure-unescaped (src)

@@ -90,10 +103,13 @@

 (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 ref source-h (concat "Can't find " source " " ref))

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

@@ -130,27 +146,30 @@

   (values-list args))

 (define-message-command "arc" (event-pump message channel &rest args)

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

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

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

+								       "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

@@ -266,7 +285,9 @@ Return a string with the generated JSON output."

 (define-controller quote (params)

   (let* ((text (cdr (assoc :text params)))

          (ref (cdr (assoc :ref params))))

-    (cons (cons text ref) (gethash ref (gethash text hhgbot-2::*refs*)))))

+    (cons (cons text ref)

+	  (gethash (hhgbot-2::normalize-ref ref)

+		   (gethash text hhgbot-2::*refs*)))))

 (define-controller random-quote (params)

   (declare (ignore params))

@@ -281,15 +302,15 @@ Return a string with the generated JSON output."

 (define-view random-quote (model)

   (destructuring-bind ((book . ref) . text) model

     `(302

-      ("Location"  ,(format nil "http://hhgbot.edw.ai:5000/q/~a/~a"

+      ("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 "http://hhgbot.edw.ai:5000/q/~a/~a"

+        (permalink (format nil "/q/~a/~a"

                            (caar quote)

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

@@ -2,30 +2,45 @@

   (:use :cl :alexandria :serapeum :fw.lu)

   (:export

    #:montezuma-store

-   #:search-index))

+   #:search-index

+   #:retire-open-indices))

 (in-package :slacker.montezuma-store)

 (defclass montezuma-store ()

-  ((%indexes :reader indexes :initform (make-hash-table :test #'equal))

-   (%montezuma-index-path :reader index-path :initarg :index-path))

+  ((%indexes :reader indexes

+	     :initform (make-hash-table :test #'equal :synchronized t))

+   (%montezuma-index-path :reader index-path

+			  :initarg :index-path))

   (:default-initargs :index-path nil))

+(defun retire-open-indices (client)

+  (sb-ext:with-locked-hash-table ((indexes client))

+    (let ((old-indexes (indexes client)))

+      (setf (slot-value client '%indexes) 

+	    (make-hash-table :test #'equal :synchronized t))

+      (alexandria:maphash-values (lambda (v) (montezuma:close v)) 

+				 old-indexes))))

+

 (defun search-index (store index text)

-  (let* ((indexes (indexes store))

-	 (index (gethash index indexes)))

-    (values (montezuma:search index (format nil "!text:\";arc\" text:~a" text) :num-docs 3)

-	    index)))

+  (let* ((index (ensure-index-for-type store index)))

+    (values

+     (montezuma:search index

+		       (format nil "!text:\";arc\" text:~a" text)

+		       :num-docs 3)

+     index)))

 (defun ensure-index-for-type (store type)

-  (ensure-gethash type (indexes store)

-                  (if (index-path store)

-                      (make-instance 'montezuma:index :path (ensure-directories-exist

-                                                             (format nil "~a/~a/"

-                                                                     (index-path store)

-                                                                     type))

-                                                      :create-p nil

-                                                      :create-if-missing-p t)

-                      (make-instance 'montezuma:index))))

+  (sb-ext:with-locked-hash-table ((indexes store))

+    (ensure-gethash type (indexes store)

+		   (if (index-path store)

+		       (make-instance 'montezuma:index

+				      :path (ensure-directories-exist

+					     (format nil "~a/~a/"

+						     (index-path store)

+						     type))

+				      :create-p nil

+				      :create-if-missing-p t)

+		       (make-instance 'montezuma:index)))))

 (defgeneric combine-child (parent key value)

   (:method (parent k child)

@@ -51,15 +66,16 @@

     (do-hash-table (k v hash-table new)

       (combine-child new k v))))

-

 (defgeneric store-message (store message)

   (:method ((store montezuma-store) message)

     (let* ((type (gethash "type" message))

            (index (ensure-index-for-type store type)))

-      (montezuma:add-document-to-index index (flatten-hash-table message))

+      (montezuma:add-document-to-index index

+				       (flatten-hash-table message))

       (montezuma:flush index))))

-(defmethod slacker:handle-message :before (type (event-pump montezuma-store) ts channel message)

+(defmethod slacker:handle-message :before

+    (type (event-pump montezuma-store) ts channel message)

   (declare (ignore type ts channel))

   (store-message event-pump message)

   (values))

new file mode 100644

@@ -0,0 +1,25 @@

+(defpackage :slacker.postmodern-store

+  (:use :cl :alexandria :serapeum :fw.lu)

+  (:export #:postmodern-store))

+(in-package :slacker.postmodern-store)

+

+(defclass postmodern-store ()

+  ((%connection :reader connection)

+   (%connection-spec :reader connection-spec :initarg :postgres-connection-spec)))

+

+(defmethod shared-initialize :after ((instance postmodern-store) slot-names &key postgres-connection-spec)

+  (setf (slot-value instance '%connection)

+	(apply 'postmodern:connect postgres-connection-spec)))

+

+(defun save-slack-message (value)

+  (pomo:query "INSERT INTO slack_messages_raw (message) VALUES ($1) RETURNING id,slack_ts,message_text;"

+              value :rows))

+

+(defmethod slacker:handle-message :before

+    (type (event-pump postmodern-store) ts channel message)

+  (declare (ignore type ts channel))

+  (let ((pomo:*database* (connection event-pump)))

+    (save-slack-message

+     (with-output-to-string (s)

+       (yason:encode message s))))

+  (values))

new file mode 100644

@@ -0,0 +1,8 @@

+(defpackage :slacker.postgres-store

+  (:use :cl :alexandria :serapeum :fw.lu)

+  (:export #:postgres-store))

+(in-package :slacker.postgres-store)

+

+(defclass postgres-store ()

+  ((%connection-string :reader connection-string :initarg :postgres-connection-string))

+  (:default-initargs :index-path nil))

@@ -105,10 +105,11 @@

   (bt:make-thread (op (fwoar.event-loop:run-loop event-pump))))

-(defun start-client (implementation &key (queue-pair (make-instance 'queue-pair)) modules)

-  (let* ((event-pump (make-instance implementation

-                                    :queue-pair queue-pair

-                                    :client-factory (op (make-client _)))))

+(defun start-client (implementation &key (queue-pair (make-instance 'queue-pair)) modules impl-args)

+  (let* ((event-pump (apply #'make-instance implementation

+			    :queue-pair queue-pair

+			    :client-factory (op (make-client _))

+			    impl-args)))

     (setf (running event-pump) t)

     (values event-pump

             (bt:make-thread (lambda ()

@@ -186,10 +187,11 @@

               (reply )))

     do (sleep 0.01)))

-(defun coordinate-threads (&optional queue-pair (implementation 'event-pump))

+(defun coordinate-threads (&optional queue-pair (implementation 'event-pump) args)

   (let* ((event-pump (start-client implementation

                                    :queue-pair queue-pair

-                                   :modules '((hhgbot-augmented-assistant::js-executor)))))

+                                   :modules '((hhgbot-augmented-assistant::js-executor))

+				   :impl-args args)))

     (bt:make-thread (lambda () (loop until (running event-pump)

                                      finally (event-loop event-pump)))

                     :name "Event Loop") 

@@ -2,9 +2,11 @@

 (in-package :asdf-user)

 (asdf:defsystem #:slacker

-  :description "Describe hhgbot here"

-  :author "Your Name <your.name@example.com>"

-  :license "Specify license here"

+  :description #.(concatenate 'string

+			      "A Client for Slack's RTM API"

+			      " and wrappers for its REST API")

+  :author "Ed L <edward@elangley.org>"

+  :license "Apache/v2"

   :depends-on (#:alexandria

                #:blackbird

                #:chanl

@@ -40,3 +42,12 @@

                #:montezuma)

   :serial t

   :components ((:file "montezuma-store")))

+

+(defsystem :slacker/postmodern-store 

+  :description ""

+  :author "Ed L <edward@elangley.org>"

+  :license "MIT"

+  :depends-on (#:slacker

+               #:postmodern)

+  :serial t

+  :components ((:file "postmodern-store")))

new file mode 100644

@@ -0,0 +1,20 @@

+BEGIN;

+	ALTER TABLE slack_messages_raw

+	ADD COLUMN slack_channel text,

+	ADD COLUMN slack_user text;

+

+	UPDATE slack_messages_raw SET slack_channel = message->>'channel';

+	UPDATE slack_messages_raw SET slack_user = message->>'user';

+

+	CREATE OR REPLACE FUNCTION insert_messages_slack_ts() RETURNS TRIGGER AS $$

+	BEGIN

+		NEW.slack_ts := NEW.message->>'ts';

+		NEW.slack_channel := NEW.message->>'channel';

+		NEW.slack_user := NEW.message->>'user';

+

+		IF not NEW.message ? 'hidden' OR NEW.message->'hidden' <> to_jsonb(true) THEN

+			NEW.message_text := NEW.message #>> '{text}';

+		END IF;

+		RETURN NEW;

+	END;

+	$$ LANGUAGE PLPGSQL;

new file mode 100644

@@ -0,0 +1,28 @@

+BEGIN;

+

+	CREATE EXTENSION IF NOT EXISTS "uuid-ossp";

+

+	DROP TABLE IF EXISTS slack_messages_raw CASCADE;

+	CREATE TABLE slack_messages_raw

+	(

+		id UUID PRIMARY KEY DEFAULT uuid_generate_v1(),

+		message JSONB,

+		message_text text,

+		slack_ts NUMERIC(32, 6)

+	);

+

+	CREATE OR REPLACE FUNCTION insert_messages_slack_ts() RETURNS TRIGGER AS $$

+	BEGIN

+		NEW.slack_ts := NEW.message->>'ts';

+		IF not NEW.message ? 'hidden' OR NEW.message->'hidden' <> to_jsonb(true) THEN

+			NEW.message_text := NEW.message #>> '{text}';

+		END IF;

+		RETURN NEW;

+	END;

+	$$ LANGUAGE PLPGSQL;

+

+	CREATE TRIGGER trig_insert_messages_slack_ts

+	BEFORE INSERT ON slack_messages_raw

+	FOR EACH ROW EXECUTE PROCEDURE insert_messages_slack_ts();

+

+COMMIT;

new file mode 100644

@@ -0,0 +1,31 @@

+(in-package :cl-user)

+(defpackage :foobar-baz (:use :cl))

+(in-package :foobar-baz)

+

+(defmacro eval-always (() &body body)

+  `(eval-when (:compile-toplevel :load-toplevel :execute)

+     ,@body))

+

+

+(eval-always ()

+  (ql:quickload :slacker)

+  (ql:quickload :slacker/montezuma-store)

+  (ql:quickload :slacker/postmodern-store)

+  (ql:quickload :data-lens)

+  (ql:quickload :osicat)

+  (ql:quickload :trivial-shell)

+  (ql:quickload :clack)

+  (ql:quickload :ningle)

+  (ql:quickload :araneus))

+

+(eval-always ()

+  (load (compile-file "/home/edwlan/words_coprocess-work/words-coprocess.lisp")))

+

+(eval-always ()

+  (load (compile-file (asdf:system-relative-pathname :slacker "hhgbot-2.lisp"))))

+

+#+(or)(eval-always ()

+  (load (compile-file "/home/edwlan/words_coprocess-work/words-coprocess.lisp")))

+  

+

+