aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bot.scm20
-rw-r--r--telebot.scm74
2 files changed, 73 insertions, 21 deletions
diff --git a/bot.scm b/bot.scm
index 62b45a8..1bc357b 100644
--- a/bot.scm
+++ b/bot.scm
@@ -1,6 +1,8 @@
(include "telebot.scm")
(import (prefix telebot telebot:))
+(use vector-lib)
+
(define (assure-list value)
(if (list? value)
value
@@ -15,10 +17,18 @@
tree
(reverse query)))
-(define token (car (command-line-arguments)))
+(define (updates-for-each func updates)
+ (vector-for-each (lambda (i u) (func u))
+ (cdr updates)))
-(print (resolve-query (list 'result 'username)
- (telebot:get-me token)))
+(define token (car (command-line-arguments)))
-(pretty-print (resolve-query (list 'result)
- (telebot:get-updates token)))
+(updates-for-each (lambda (u)
+ (print (cdr (resolve-query (list 'message 'from 'first_name) u))
+ ": "
+ (cdr (resolve-query (list 'message 'text) u))
+ " ("
+ (cdr (resolve-query (list 'update_id) u))
+ ")"))
+ (resolve-query (list 'result)
+ (telebot:get-updates token)))
diff --git a/telebot.scm b/telebot.scm
index 0a24973..8d30013 100644
--- a/telebot.scm
+++ b/telebot.scm
@@ -1,34 +1,76 @@
-(module telebot (get-me get-updates send-message)
+(module telebot (get-me
+ get-updates
+ send-message
+ forward-message)
(import chicken scheme)
+ (use srfi-1)
(use openssl)
(use http-client)
(use medea)
(define api-base "https://api.telegram.org/bot")
+ ;;; helper functions
+
(define (get-query-url token method)
(string-append api-base token "/" method))
+ (define (clean-query-parameters parameters)
+ (let ((cleaned-parameters (remove (lambda (p) (equal? #f (cdr p)))
+ parameters)))
+ (if (null-list? cleaned-parameters)
+ #f
+ cleaned-parameters)))
+
+ ;;; plain API wrappers, returning deserialized JSON
+
(define (get-me token)
(with-input-from-request (get-query-url token "getMe")
#f
read-json))
- (define (get-updates token)
- (with-input-from-request (get-query-url token "getUpdates")
- #f
- read-json))
+ (define (get-updates token
+ #!key offset
+ limit
+ timeout)
+ (with-input-from-request
+ (get-query-url token "getUpdates")
+ (clean-query-parameters
+ (list (cons 'offset offset)
+ (cons 'limit limit)
+ (cons 'timeout timeout)))
+ read-json))
- (define (send-message token chat-id text)
- (with-input-from-request (get-query-url token "sendMessage")
- (list (cons 'chat_id chat-id)
- (cons 'text text))
- read-json))
+ (define (send-message token
+ #!key chat-id
+ text
+ parse-mode
+ disable-web-page-preview
+ disable-notification
+ reply-to-message-id
+ reply-markup)
+ (with-input-from-request
+ (get-query-url token "sendMessage")
+ (clean-query-parameters
+ (list (cons 'chat_id chat-id)
+ (cons 'text text)
+ (cons 'parse_mode parse-mode)
+ (cons 'disable_web_page_preview disable-web-page-preview)
+ (cons 'disable_notification disable-notification)
+ (cons 'reply_to_message_id reply-to-message-id)
+ (cons 'reply_markup reply-markup)))
+ read-json))
- (define (forward-message token chat-id from-chat-id message-id)
- (with-input-from-request (get-query-url token "forwardMessage")
- (list (cons 'chat_id chat-id)
- (cons 'from_chat_id from-chat-id)
- (cons 'message_id message-id))
- read-json))
+ (define (forward-message token
+ #!key chat-id
+ from-chat-id
+ message-id
+ disable-notification)
+ (with-input-from-request
+ (get-query-url token "forwardMessage")
+ (list (cons 'chat_id chat-id)
+ (cons 'from_chat_id from-chat-id)
+ (cons 'message_id message-id)
+ (cons 'disable_notification disable-notification))
+ read-json))
)