From 910954b4a71c45e680ed834a45d6cfecbdeb928c Mon Sep 17 00:00:00 2001 From: Adrian Kummerlaender Date: Wed, 16 Mar 2016 23:01:20 +0100 Subject: Implement conversation-manager pattern framework function The _conversation-manager_ pattern previously tested in the _guess_ example game should be useful for other kinds of use cases and as such was moved into the module. `make-conversation-manager` maintains an internal hash table of per-conversation (i.e. chat-ids) closures constructed by the provided constructor function. Thus bot implementations such as the _guess_ game example only need to instantiate a conversation-manager, call it via e.g. `poll-updates` and implement the actual conversation logic in a custom conversation closure. Telebot's framework function names are now consistently separated by minuses instead of capital letters. --- example/echo.scm | 10 ++++----- example/guess.scm | 62 +++++++++++++++++++++---------------------------------- telebot.scm | 39 ++++++++++++++++++++++++++-------- 3 files changed, 59 insertions(+), 52 deletions(-) diff --git a/example/echo.scm b/example/echo.scm index 2e190a7..90d0af5 100644 --- a/example/echo.scm +++ b/example/echo.scm @@ -25,8 +25,8 @@ chat_id: chat_id text: text))) -(telebot:pollUpdates token - (lambda (u) - (if (telebot:is-message? u) - (begin (print-message u) - (echo-message u))))) +(telebot:poll-updates token + (lambda (u) + (if (telebot:is-message? u) + (begin (print-message u) + (echo-message u))))) diff --git a/example/guess.scm b/example/guess.scm index e1b419c..fd200fa 100644 --- a/example/guess.scm +++ b/example/guess.scm @@ -1,51 +1,37 @@ (require-extension telebot (prefix telebot telebot:)) -(use srfi-69) -(use extras) -(use data-structures) - (define (resolve-query query tree) (fold (lambda (x y) (alist-ref x y)) tree query)) -(define token (car (command-line-arguments))) -(define conversations (make-hash-table)) - -(define (send chat_id text) - (print chat_id " <- \"" text "\"") - (telebot:sendMessage token - chat_id: chat_id - text: text)) +(define (make-sender token chat_id) + (lambda (text) + (print chat_id " <- \"" text "\"") + (telebot:sendMessage token + chat_id: chat_id + text: text))) -(define (make-conversation chat_id) - (let ((chat_id chat_id) - (answer (random 100))) - (send chat_id - "Hi there! I just generated a random number for you to guess!") - (lambda (text) - (let ((guess (string->number text))) +(define (make-conversation token chat_id) + (let* ((chat_id chat_id) + (send (make-sender token chat_id)) + (answer (random 100))) + (send "Hi there! I just generated a random number for you to guess!") + (lambda (update) + (let* ((text (resolve-query '(message text) update)) + (guess (string->number text))) + (print chat_id " -> \"" text "\"") (if (number? guess) (cond ((= guess answer) - (begin (send chat_id "Correct! Feel free to guess the next number.") + (begin (send "Correct! Feel free to guess the next number.") (set! answer (random 100)))) - ((< guess answer) (send chat_id "Too small. Try again.")) - ((> guess answer) (send chat_id "Too large. Try again."))) - (send chat_id - "This is not a number - please provide your guess in base 10.")))))) - -(define (handle-message m) - (let ((chat_id (resolve-query '(message from id) m)) - (text (resolve-query '(message text) m))) - (print chat_id " -> \"" text "\"") - (if (hash-table-exists? conversations chat_id) - ((hash-table-ref conversations chat_id) text) - (hash-table-set! conversations - chat_id - (make-conversation chat_id))))) + ((< guess answer) (send "Too small. Try again.")) + ((> guess answer) (send "Too large. Try again."))) + (send "This is not a number - please provide your guess in base 10.")))))) -(randomize) -(telebot:pollUpdates token - (lambda (u) (if (telebot:is-message? u) - (handle-message u)))) +(let* ((token (car (command-line-arguments))) + (converse (telebot:make-conversation-manager token + make-conversation))) + (randomize) + (telebot:poll-updates token converse)) diff --git a/telebot.scm b/telebot.scm index b1fb625..b5ca1e3 100644 --- a/telebot.scm +++ b/telebot.scm @@ -1,4 +1,5 @@ -(module telebot (getMe +(module telebot (;;; basic API wrappers + getMe getUpdates sendMessage forwardMessage @@ -13,18 +14,21 @@ getUserProfilePhotos getFile answerInlineQuery + ;;; framework is-message? is-inline_query? is-chosen_inline_result? - pollUpdates) + poll-updates + make-conversation-manager) (import chicken scheme) - (use srfi-1) - (use openssl) - (use http-client) - (use medea) + (use srfi-1 + srfi-69) + (use openssl + http-client) + (use medea + vector-lib + data-structures) (use loops) - (use vector-lib) - (use data-structures) (define-constant api-base "https://api.telegram.org/bot") @@ -40,6 +44,11 @@ #f cleaned-parameters))) + (define (resolve-query query tree) + (fold (lambda (x y) (alist-ref x y)) + tree + query)) + ;;; plain API wrappers, returning deserialized JSON (define-syntax wrap-api-method @@ -175,7 +184,7 @@ (define is-inline_query? (update-predicate 'inline_query)) (define is-chosen_inline_result? (update-predicate 'chosen_inline_result)) - (define (pollUpdates token handler) + (define (poll-updates token handler) (let ((offset 0)) (do-forever (vector-for-each (lambda (i u) @@ -185,4 +194,16 @@ (getUpdates token offset: offset timeout: 60)))))) + + (define (make-conversation-manager token make-handler) + (let ((token token) + (conversations (make-hash-table))) + (lambda (update) + (if (is-message? update) + (let ((chat_id (resolve-query '(message from id) update))) + (if (hash-table-exists? conversations chat_id) + ((hash-table-ref conversations chat_id) update) + (hash-table-set! conversations + chat_id + (make-handler token chat_id)))))))) ) -- cgit v1.2.3