made create-direct-message-room

accidentally added roshambot example to this commit

4 files changed, 96 insertions, 0 deletions

diff --git a/examples/roshambot.lisp b/examples/roshambot.lisp
new file mode 100644
index 0000000..fd6bf36
--- /dev/null
+++ b/examples/roshambot.lisp
@@ -0,0 +1,76 @@
+;;;; A bot for playing rock paper scissors.
+
+(ql:quickload :cl-ppcre)
+
+(defpackage #:roshambot
+  (:use :cl)
+  (:import-from :granolin
+                :handle-event
+                :find-contact
+                :text-message-event
+                :send-text-message
+                :let-cond))
+
+(in-package :roshambot)
+
+;;; The logic of roshambot is something like:
+
+;;; 1. A user indicates to the bot that they will to challenge another user to a
+;;; game of roshambo "hey bot, roshambo with bob"
+
+;;; 2. If bob is known to the bot then the bot will open a private with both the
+;;; initiator, say alice, and with bob and present them with a chance to make a
+;;; move or to cancel.
+
+;;; 3. The bot then waits for both users to respond with a move or for either
+;;; one of them to cancel.
+
+;;; 4. The bot then reports the outcome of the match (winner bob, winner alice,
+;;; or canceled by x) in the room in which the match was initiated.
+
+(defstruct roshambo-match
+  room
+  challenger
+  challenger-state
+  challenged
+  challenged-state)
+
+(defclass roshambot ()
+  ((match-id
+   :accessor match-id
+   :initform 0)
+   (live-matches
+   :accessor live-matches
+   :initform nil)))
+
+(defparameter +challenge-regex+
+  (ppcre:create-scanner "i challenge ([a-zA-Z0-9_.-]+) to roshambo"
+                        :case-insensitive-mode t))
+
+(defun you-wanna-piece-of-this!? (str)
+  "If the string communicates one user's intention to challenge another to
+  roshambo, returns the name of the user that has been challenged. Returns NIL otherwise."
+  (nth-value 1 (ppcre:scan-to-strings +challenge-regex+ str)))
+
+(defmethod handle-event :after ((bot roshambot) (event text-message-event) &optional room-id)
+  (let ((text (msg-body event)))
+    (let-cond
+      (challenged (you-wanna-piece-of-this!? text)
+                  (handle-new-challenge bot room-id (sender event) challenged)))))
+
+(defun handle-new-challenge (bot room-id challenger challenged)
+  (let-cond
+    (direct-chat (find-contact bot challenged :like t :get-direct-room t)
+                 
+
+    )
+
+
+  (let-if (full-challenged (granolin::find-contact bot challenged :like t))
+          (make-new-challenge bot room-id challenger full-challenged)
+          (send-text-message client room-id
+                             "Hey ~a, I don't know of anybody named ~a"
+                             challenger challenged)))
+
+
+
diff --git a/granolin.lisp b/granolin.lisp
index be252c4..3585615 100644
--- a/granolin.lisp
+++ b/granolin.lisp
@@ -424,6 +424,19 @@
                   (flexi-streams:octets-to-string *response-body*)))))
 
 
+(defun create-direct-message-room (client name)
+  "Attempt to create a direct message room with the given name. If successful
+   the room id is returned. Returns nil and prints to *error-output* if
+   unsuccessful."
+  (let ((body (list :|invite| (list (user-id client) name)
+                    :|is_direct| t)))
+    (send (client +create-room-path+ body :method :post :wrap make-basic-json)
+          (getob (basic-json-data *response-object*) :|room_id|)
+          (format *error-output*
+                  "FAILED to create private chat with ~a~%HTTP response: ~a ~a~%"
+                  name *response-status*
+                  (flexi-streams:octets-to-string *response-body)))))
+
 ;;; bot loop
 
 (defun start (client)
diff --git a/package.lisp b/package.lisp
index 1a8e50e..df94db6 100644
--- a/package.lisp
+++ b/package.lisp
@@ -66,6 +66,7 @@
    #:sync
    #:send-text-message
    #:join-room
+   #:create-direct-message-room
 
    ;; bot control
    #:start
diff --git a/utility-apps.lisp b/utility-apps.lisp
index 16df32f..01ac5b6 100644
--- a/utility-apps.lisp
+++ b/utility-apps.lisp
@@ -168,6 +168,12 @@
                      (and like (search name contact :test #'string-equal))))
                (client-contacts client))))
 
+(defun ensure-direct-room (client name &key like)
+  (let-if (room (find-contact client name :like like :get-direct-room t))
+          room
+          (create-direct-message-room client name :like like)))
+
+
 
 ;;; Basic Joiner Bot