hiro/cl-telegram-bot
1
0
Fork 0
mirror of https://github.com/vale981/cl-telegram-bot synced 2025-03-04 09:11:40 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

sync

Browse source
This commit is contained in:
hiro98 2019-09-20 15:51:55 +02:00
parent f8cafe1736
commit 3407aea2d9
17 changed files with 534 additions and 145 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
cl-telegram-bot.asd
View file

@ -3,7 +3,7 @@
:author "Rei <https://github.com/sovietspaceship>"
:license "MIT"
:depends-on (#:cl-json #:alexandria #:closer-mop #:dexador
#:lparallel #:trivial-types #:cl-arrows #:bordeaux-threads #:log4cl)
#:lparallel #:trivial-types #:cl-arrows #:bordeaux-threads #:log4cl #:cl-ppcre)
:serial t
:components ((:file "package")
(:file "API")

85
cl-telegram-bot.auto-poll.lisp Normal file
View file

@ -0,0 +1,85 @@
;; cl-telegram-bot
;;
;; MIT License
;;
;; Copyright (c) 2016 Rei <https://github.com/sovietspaceship>
;; Copyright (c) 2019 Hiro98 <https://protagon.space>
;;
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;;
;; The above copyright notice and this permission notice shall be included in all
;; copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
(in-package :cl-telegram-bot)
(defclass tg-autopoll-bot (tg-bot)
((poll-timeout
:documentation "The poll timeout for long polling. Should be greater than one."
:initform 10
:type float
:initarg poll-timeout
:accessor poll-timeout)
(poll-thread
:documentation "The the lparallel for the polling."
:reader poll-thread
:initform nil)
(break-poll
:documentation "BT lock to stop polling gracefully."
:initform nil))
(:documentation "A telegram bot with automatic threaded long polling via LPARALLEL."))
(defun make-autopoll-bot (token)
"Create a new bot instance. Takes a token string."
(make-instance 'tg-autopoll-bot :token token))
(defgeneric start-polling (bot)
(:documentation "Starts the polling of the telegram bot api. Returns the poll thrad."))
(defmethod start-polling :before (bot)
(log:info "Starting the polling."))
(defmethod start-polling ((bot tg-autopoll-bot))
(with-slots (poll-thread poll-timeout break-poll) bot
(if (and (not break-poll) poll-thread (bt:thread-alive-p poll-thread)) t
(progn
(setf break-poll nil)
(setf poll-thread
(bt:make-thread
(lambda ()
(poll-loop bot))
:name "TG-BOT-POLL-THREAD"))))))
(defun poll-loop (bot)
(with-slots (break-poll stop-lock poll-timeout) bot
(loop while (not break-poll) do
(log:debug "Polling...")
(fetch-updates bot :timeout poll-timeout))
(setf break-poll nil)
(log:info "Stopped polling.")))
(defgeneric stop-polling (bot)
(:documentation "Stops the long polling."))
(defmethod stop-polling :before (bot)
(log:info "Stopping the polling."))
(defmethod stop-polling ((bot tg-autopoll-bot))
(with-slots (break-poll poll-thread stop-lock) bot
(if (bt:thread-alive-p poll-thread)
(progn (setf break-poll t)
(bt:join-thread poll-thread)
t)
nil)))

220
cl-telegram-bot.lisp
View file

@ -65,6 +65,10 @@
(reply-queue
:type (proper-list function)
:documentation "A queue for storing reply matchers."
:initform nil)
(commands
:type (proper-list (proper-list))
:documentation "A list to store commands as (command-regex callback separator)."
:initform nil))
(:documentation "The TG-BOT type is just a basic data container to
hold various transactional data. It does not feature polling or any
@ -78,6 +82,58 @@
(setf endpoint (concatenate 'string api-uri "bot" token "/")
file-endpoint (concatenate 'string api-uri "file/" "bot" token "/"))))
(defun make-tg-bot (token &optional api-url)
"Create a new TG-BOT instance. Takes a TOKEN string and optionally an API-URL string."
(let ((args (if api-url
`(:token ,token :api-url api-url)
`(:token ,token))))
(apply #'make-instance `(tg-bot ,@args))))
(defgeneric decode (object))
(defmethod decode ((object stream))
(let ((json:*json-symbols-package* :cl-telegram-bot))
(json:with-decoder-simple-clos-semantics
(prog1
(json:decode-json object)
(close object)))))
(defmethod decode ((object string))
(let ((json:*json-symbols-package* :cl-telegram-bot))
(json:with-decoder-simple-clos-semantics
(with-input-from-string (stream object)
(json:decode-json stream)))))
(defmethod decode ((object vector))
(decode (map 'string #'code-char object)))
(define-condition request-error (error)
((what :initarg :what :reader what))
(:report (lambda (condition stream)
(format stream "Request error: ~A" (what condition)))))
(defun make-request (b name options &key (return-type nil) (timeout 10))
"Perform HTTP request to NAME API method with OPTIONS JSON-encoded object."
(let* ((results (multiple-value-list
(handler-bind ((dex:http-request-bad-request #'dex:ignore-and-continue))
(dex:request
(concatenate 'string (endpoint b) name)
:method :post
:want-stream t
:headers '(("Content-Type" . "Application/Json"))
:timeout timeout
:content (json:encode-json-alist-to-string options)))))
(message (nth 0 results)))
(with-slots (ok result description) (decode message)
(if ok
(if return-type ; wether to cast into a known custom class or not
(recursive-change-class result return-type)
result)
(error 'request-error :what description)))))
;;; Reply Matchers
(define-condition reply-matcher-timeout-error (error)
((timeout :initarg :timeout :reader timeout))
(:report (lambda (condition stream) (format stream "Timed out while
@ -92,17 +148,25 @@
seconds. Returns a PROMISE that resolves to either the return value
of MATCHER. An condition is signaled on timeout."))
(defmethod add-reply-matcher :before (bot matcher result timeout)
(log:debug "Adding reply watcher: " (list bot matcher result timeout)))
(defmethod add-reply-matcher ((bot tg-bot) matcher result timeout)
(let ((promise (lparallel:promise)))
(push `(,promise ,matcher ,result ,(when timeout (+ (get-universal-time) timeout)))
(slot-value bot 'reply-queue))
promise))
;;; Update Hooks
(defgeneric add-update-hook (bot hook &optional key)
(:documentation "Adds an update hook that will be called with an
*UPDATE object on each update, the return value is ignored. Returns
a keyword to remove that hook."))
(defmethod add-update-hook :before (bot hook &optional key)
(log:debug "Adding reply watcher: " (list bot hook key)))
(defmethod add-update-hook ((bot tg-bot) hook &optional key)
(let ((final-key (if key key (gensym))))
(with-slots (update-hooks) bot
@ -115,6 +179,9 @@
(:documentation "Removes an update hook by its key which was
returned open its registration. Returns t (success) or nil."))
(defmethod remove-update-hook :before (bot key)
(log:debug "Adding reply watcher: " (list bot key)))
(defmethod remove-update-hook ((bot tg-bot) key)
(with-slots (update-hooks) bot
(let ((pos (position key update-hooks :key #'car)))
@ -122,22 +189,25 @@
(setf update-hooks (nconc (subseq update-hooks 0 pos) (nthcdr (1+ pos) update-hooks))))
pos)))
;;; Process Updates
(defgeneric process-updates (bot updates)
(:documentation "Processes the updates fetched by FETCH-UPDATES to detect commands and replies."))
;; check types before
(defmethod process-updates :before (bot updates)
(declare (type (vector *update) updates)))
(declare (type (vector *update) updates))
(log:debug "Processing ~a update(s)." (length updates)))
(defun read-new-timeout ()
(format t "Enter a new timeout: ")
(multiple-value-list (eval (read))))
;; TODO: make slimm with functions
;; TODO: make slimer with functions
(defmethod process-updates ((bot tg-bot) updates)
(log:debug "Processing updates: " updates)
(log:debug updates)
(with-slots (reply-queue update-hooks) bot
(break)
(with-slots (reply-queue update-hooks commands) bot
(let ((unresolved nil)) ;; Process reply-matchers
(loop for update across updates do
(dolist (matcher-list reply-queue)
@ -154,17 +224,23 @@
(progn
(setf (fourth matcher-list) (+ (get-universal-time) new-timeout))
(push matcher-list unresolved))))))))
(dolist (command commands)
(when (slot-boundp update 'message)
(destructuring-bind (regex callback sep) command
(let ((message (tg-message update)))
(when (eq (elt message 0) #\\)
(let* ((space (position #\Space message))
(command (subseq message 0 space))))
(when (ppcre:scan regex command)
(let ((arg-string (subseq message (1+ space)))
(args (if sep
(ppcre:split sep arg-string)
arg-string)))
(funcall callback args message))))))))
(dolist (hook update-hooks) ; process hooks
(funcall (cdr hook) updates)))
(setf reply-queue unresolved))))
(defun make-tg-bot (token &optional api-url)
"Create a new TG-BOT instance. Takes a TOKEN string and optionally an API-URL string."
(let ((args (if api-url
`(:token ,token :api-url api-url)
`(:token ,token))))
(apply #'make-instance `(tg-bot ,@args))))
(defun recursive-change-class (object class)
"Casts and object and its members into the telegram specific classes."
(when (and (listp class) (> (length class) 1) (eq (car class) 'array))
@ -190,100 +266,9 @@
object)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; HELPERS ;
; CONVENIENCE INTERFACE ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun make-request (b name options &key (return-type nil) (timeout 10))
"Perform HTTP request to NAME API method with OPTIONS JSON-encoded object."
(let* ((results (multiple-value-list
(handler-bind ((dex:http-request-bad-request #'dex:ignore-and-continue))
(dex:request
(concatenate 'string (endpoint b) name)
:method :post
:want-stream t
:headers '(("Content-Type" . "Application/Json"))
:timeout timeout
:content (json:encode-json-alist-to-string options)))))
(message (nth 0 results)))
(with-slots (ok result description) (decode message)
(if ok
(if return-type ; wether to cast into a known custom class or not
(recursive-change-class result return-type)
result)
(error 'request-error :what description)))))
(defun access (update &rest args)
"Access update field. update.first.second. ... => (access update 'first 'second ...). Nil if unbound."
(unless update
(return-from access nil))
(let ((current update))
(dolist (r args)
(unless (slot-boundp current r)
(return-from access nil))
(setf current (slot-value current r)))
current))
(defun get-slot (update slot)
"Access slot. Since fluid classes signal error on unbound slot access, this instead returns nil."
(if (slot-boundp update slot)
(slot-value update slot)
nil))
(defmacro with-package (package &rest body)
`(let ((json:*json-symbols-package* ,package)) ,@body))
(defgeneric decode (object))
(defmethod decode ((object stream))
(let ((json:*json-symbols-package* :cl-telegram-bot))
(json:with-decoder-simple-clos-semantics
(prog1
(json:decode-json object)
(close object)))))
(defmethod decode ((object string))
(let ((json:*json-symbols-package* :cl-telegram-bot))
(json:with-decoder-simple-clos-semantics
(with-input-from-string (stream object)
(json:decode-json stream)))))
(defmethod decode ((object vector))
(decode (map 'string #'code-char object)))
(define-condition request-error (error)
((what :initarg :what :reader what))
(:report (lambda (condition stream)
(format stream "Request error: ~A" (what condition)))))
(defmacro find-json-symbol (sym)
`(find-symbol (symbol-name ,sym) json:*json-symbols-package*))
(defun download-file (b file-id)
"Get the path for a file from a file-id (see: get-file) and then
download it. Returns nil if the value of the http response code is
not success (200); otherwise it will returns three values: the
data, the http headers and the exension of the original file"
(with-package :cl-telegram-bot
(let* ((file-spec (decode (get-file b file-id))))
(with-ok-results (file-spec results)
(alexandria:when-let* ((path (access results 'file--path))
(uri (concatenate 'string (file-endpoint b) path))
(extension (cl-ppcre:scan-to-strings "\\..*$" path)))
(multiple-value-bind (body code headers)
(dex:get uri)
(when (= code +http-ok+)
(values body headers extension))))))))
;; Telegram API methods, see https://core.telegram.org/bots/api
(defmacro with-ok-results ((unserialized results) &body body)
`(let ((,results (slot-value ,unserialized (find-json-symbol :result))))
(if (slot-value ,unserialized (find-json-symbol :ok))
(progn ,@body)
nil)))
(defun get-latest-update-id (updates)
"Finds the latest update id from a sequence of updates."
(reduce #'max updates :key #'tg-update--id :from-end t))
@ -307,10 +292,6 @@
(process-updates b results))
results))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; CONVENIENCE INTERFACE ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro wrap-$ (&rest body)
"Wraps all forms following (:INLINE [$|$*] ...) into ([$|$*] ...)$."
(let* ((index
@ -358,6 +339,29 @@
`(add-reply-matcher ,bot ,matcher ,return-val-sym ,timeout)))))))
,(make-optional-body body return-var return-val-sym))))
(defgeneric add-command (bot name-regex callback &optional sep)
(:documentation "Adds a chat command and calls CALLBACK with a list
of arguments and the corresponding *MESSAGE object if NAME-REGEX (a
string) matches the command text (without /). The Arguments to the
command are split along SEP (per default no splitting)."))
(defmethod add-command :before (bot name-regex callback &optional sep)
(log:debug "Adding command: " (list bot name-regex callback sep)))
(defmethod add-command ((bot tg-bot) name-regex callback &optional sep)
(let ((name-regex (ppcre:create-scanner name-regex)))
(push (list name-regex callback sep) (slot-value bot 'commands))))
(defmacro definecommand ((bot name-regex &key error-message (sep nil))
argument-lambda-list &body body)
(let ((args (gensym))
(message (gensym)))
`(add-command ,bot ,name-regex
#'(lambda (,args ,message)
(declare (ignore ,message))
(handler-bind ((error #'(lambda (e) (log:error "Invalid args ~a" args))))
(destructuring-bind ,argument-lambda-list args ,@body)))
sep)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Convenience Wrappers ;

20
docs/Makefile Normal file
View file

@ -0,0 +1,20 @@
# Minimal makefile for Sphinx documentation
#
# You can set these variables from the command line, and also
# from the environment for the first two.
SPHINXOPTS ?=
SPHINXBUILD ?= sphinx-build
SOURCEDIR = .
BUILDDIR = _build
# Put it first so that "make" without argument is like "make help".
help:
@$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)
.PHONY: help Makefile
# Catch-all target: route all unknown targets to Sphinx using the new
# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS).
%: Makefile
@$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)

10
docs/_static/style.css vendored Normal file
View file

@ -0,0 +1,10 @@
.text-muted {
color: black;
font-style: normal;
}
.property {
font-style: normal;
font-family: 'Consolas', 'Menlo', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', monospace;
}

16
docs/basic-bot-class.rst Normal file
View file

@ -0,0 +1,16 @@
###############
API Reference
###############
Basic Types, Methods and Functions
==================================
.. cl:package:: cl-telegram-bot
.. cl:type:: TG-BOT
.. cl:function:: MAKE-TG-BOT
For example:
.. code-block:: common-lisp
(setf *bot* (make-tg-bot "secret:token" "http://my-test-endpoint"))

96
docs/conf.py Normal file
View file

@ -0,0 +1,96 @@
# Configuration file for the Sphinx documentation builder.
#
# This file only contains a selection of the most common options. For a full
# list see the documentation:
# https://www.sphinx-doc.org/en/master/usage/configuration.html
# -- Path setup --------------------------------------------------------------
# If extensions (or modules to document with autodoc) are in another directory,
# add these directories to sys.path here. If the directory is relative to the
# documentation root, use os.path.abspath to make it absolute, like shown here.
#
import os
import sys
sys.path.insert(0, os.path.abspath('./sphinxcontrib-cldomain/sphinxcontrib'))
# -- Project information -----------------------------------------------------
project = 'cl-tg-bot'
copyright = '2019, Valentin Boettcher'
author = 'Valentin Boettcher'
# -- General configuration ---------------------------------------------------
# Add any Sphinx extension module names here, as strings. They can be
# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom
# ones.
extensions = [
'sphinxcontrib.cldomain',
'sphinxcontrib.hyperspec'
]
# Add any paths that contain templates here, relative to this directory.
templates_path = ['_templates']
# List of patterns, relative to source directory, that match files and
# directories to ignore when looking for source files.
# This pattern also affects html_static_path and html_extra_path.
exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store', 'src/**']
# -- Options for HTML output -------------------------------------------------
# The theme to use for HTML and HTML Help pages. See the documentation for
# a list of builtin themes.
#
html_theme = 'alabaster'
# Add any paths that contain custom static files (such as style sheets) here,
# relative to this directory. They are copied after the builtin static files,
# so a file named "default.css" will overwrite the builtin "default.css".
html_static_path = ['_static']
html_sidebars = {
'**': [
'about.html',
'navigation.html',
'relations.html',
'searchbox.html',
'donate.html',
]
}
html_css_files = [
'style.css',
]
html_theme_options = {
}
from os.path import join, dirname, realpath, expandvars
# --- CL domain customizations:
#
# cl_systems: The systems and packages from which to extract documentation:
#
# name - The name of the system to load.
# path - The path to the system.
# packages - A list of the packages to extract symbol information from.
#
# Note: This conf.py sits in a subdirectory below ("../"), relative to where
# the "my-system.asd" system description file lives:
cl_systems = [{"name": "cl-telegram-bot",
"path": join(dirname(realpath(__file__)), "../"),
"packages": ["cl-telegram-bot"]}]
# cl_quicklisp: The default is $HOME/quicklisp. Shown here for completeness,
# and you can comment it out:
cl_quicklisp = expandvars('$HOME/.rosswell/lisp/quicklisp')
# Ensure that the default highlighting language is CL:
highlight_language = 'common-lisp'
# For developer debugging only (and the curious, although, it did kill the cat!)
# Currently ``True`` or ``False`` to output the JSON collected from cldomain.
cl_debug = False

18
docs/index.rst Normal file
View file

@ -0,0 +1,18 @@
The cl-telegram-bot's Documentation
===========================================
.. cl:package:: cl-telegram-bot
.. cl:type:: TG-BOT
.. cl:function:: MAKE-TG-BOT
.. toctree::
:maxdepth: 3
basic-bot-class
Indices and tables
==================
* :ref:`genindex`
* :ref:`modindex`
* :ref:`search`

35
docs/make.bat Normal file
View file

@ -0,0 +1,35 @@
@ECHO OFF
pushd %~dp0
REM Command file for Sphinx documentation
if "%SPHINXBUILD%" == "" (
set SPHINXBUILD=sphinx-build
)
set SOURCEDIR=.
set BUILDDIR=_build
if "%1" == "" goto help
%SPHINXBUILD% >NUL 2>NUL
if errorlevel 9009 (
echo.
echo.The 'sphinx-build' command was not found. Make sure you have Sphinx
echo.installed, then set the SPHINXBUILD environment variable to point
echo.to the full path of the 'sphinx-build' executable. Alternatively you
echo.may add the Sphinx directory to PATH.
echo.
echo.If you don't have Sphinx installed, grab it from
echo.http://sphinx-doc.org/
exit /b 1
)
%SPHINXBUILD% -M %1 %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O%
goto end
:help
%SPHINXBUILD% -M help %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O%
:end
popd

5
docs/requirements.in Normal file
View file

@ -0,0 +1,5 @@
sphinx
sphinx-bootstrap-theme
-e git+https://github.com/40ants/pygments-cl-repl.git#egg=pygments-cl-repl
-e git+https://github.com/40ants/sphinxcontrib-cldomain.git#egg=sphinxcontrib-cldomain

38
docs/requirements.txt Normal file
View file

@ -0,0 +1,38 @@
#
# This file is autogenerated by pip-compile
# To update, run:
#
# pip-compile requirements.in
#
-e git+https://github.com/40ants/pygments-cl-repl.git#egg=pygments-cl-repl
-e git+https://github.com/40ants/sphinxcontrib-cldomain.git#egg=sphinxcontrib-cldomain
alabaster==0.7.12 # via sphinx
attrs==19.1.0 # via packaging
babel==2.7.0 # via sphinx
certifi==2019.6.16 # via requests
chardet==3.0.4 # via requests
docutils==0.15.2 # via sphinx
future==0.17.1
idna==2.8 # via requests
imagesize==1.1.0 # via sphinx
jinja2==2.10.1 # via sphinx
markupsafe==1.1.1 # via jinja2
packaging==19.1 # via sphinx
pygments==2.4.2 # via sphinx
pyparsing==2.4.2 # via packaging
pytz==2019.2 # via babel
requests==2.22.0 # via sphinx
six==1.12.0 # via packaging
snowballstemmer==1.9.0 # via sphinx
sphinx-bootstrap-theme==0.7.1
sphinx==2.2.0
sphinxcontrib-applehelp==1.0.1 # via sphinx
sphinxcontrib-devhelp==1.0.1 # via sphinx
sphinxcontrib-htmlhelp==1.0.2 # via sphinx
sphinxcontrib-jsmath==1.0.1 # via sphinx
sphinxcontrib-qthelp==1.0.2 # via sphinx
sphinxcontrib-serializinghtml==1.1.3 # via sphinx
urllib3==1.25.3 # via requests
# The following packages are considered to be unsafe in a requirements file:
# setuptools==41.2.0 # via sphinx, sphinx-bootstrap-theme

5
docs/src/pip-delete-this-directory.txt Normal file
View file

@ -0,0 +1,5 @@
This file is placed here by pip to indicate the source was put
here by pip.
Once this package is successfully installed this source code will be
deleted (unless you remove this file).

1
docs/src/pygments-cl-repl Submodule

@ -0,0 +1 @@
Subproject commit 7f30f04a1841d0c7db91500fe9cba214838750df

1
docs/src/sphinxcontrib-cldomain Submodule

@ -0,0 +1 @@
Subproject commit d3d9c718fbdb295a65ba18a1ee2cafa9bc695205

36
example.lisp
View file

@ -1,36 +0,0 @@
(require 'cl-ppcre)
(require 'cl-telegram-bot)
(defpackage :example-bot
(:use #:cl-telegram-bot)
(:use #:cl))
(in-package :example-bot)
(defun match-command (regex text function)
(multiple-value-bind (msg match)
(cl-ppcre:scan-to-strings regex text)
(when match
(funcall function msg match))))
(let ((bot (make-bot "123456789:YOUR TOKEN HERE")))
(loop
(with-package :example-bot
(loop for update across (get-updates bot) do
(let* ((message (access update 'message))
(text (access message 'text))
(message-id (access message 'message--id))
(chat-id (access message 'chat 'id))
(first-name (access message 'from 'first--name)))
(format t "---~%ID: ~a~%chat: ~a~%user: ~a~%text: <<~a>>~%"
message-id
chat-id
first-name
text)
(when text
(match-command "^/echo (.*)$" text
(lambda (msg args)
(send-message bot
chat-id
(elt args 0))))))))
(sleep 1)))

36
examples/trivia-bot.lisp Normal file
View file

@ -0,0 +1,36 @@
(in-package :cl-telegram-bot)
(setf *bot* (make-bot "KEY"))
(let ((channel (lparallel:make-channel)))
(lparallel:submit-task channel #'(lambda ()
(loop
(fetch-updates *bot*)
(sleep 0.1)))))
(defun send-trivia-question ()
(let* ((question (-> (dex:get "https://opentdb.com/api.php?amount=1&type=boolean" :want-stream t)
(json:decode-json)
(second)
(getf :results))
)
(keyboard (make-inline-keyboard '(((:text "True" :callback--data "True")
(:text "False" :callback--data "False"))))))
($ (send-message 133107019 (format nil "~A<br><hr><br>~a"
(cdr (assoc :category question))
(cdr (assoc :question question)) :parse--mode "HTML" :reply--markup keyboard))
(:parallel t :with-reply (a . #'inline-keyboard-answer))
(let* ((answer (lparallel:force a))
(id (tg-id answer))
(data (tg-data answer)))
($ (answer-callback-query id) (:parallel t))
($ (send-message 133107019
(concatenate 'string
(if (string= data (cdr (assoc :correct--answer question)))
"<b>Correct!</b>"
"You're wrong.") " Play again?") :parse--mode "HTML" :reply--markup keyboard)
(:with-reply (a . #'inline-keyboard-answer))
($* (answer-callback-query (tg-id (lparallel:force a))))
(if (string= (tg-data (lparallel:force a)) "True")
(send-trivia-question)
($* (send-message 133107019 "Thanks for playing."))))))))
(send-trivia-question)

55
test.lisp Normal file
View file

@ -0,0 +1,55 @@
(ql:quickload :cl-telegram-bot)
(ql:quickload :access)
(in-package :tg-bot)
(ql:quickload :trivia)
(setf *bot* (make-autopoll-bot "355071287:AAGtP_r2UBbIKJXBWbnwy7HvHadiOEfa4D4"))
(defvar keyb (make-inline-keyboard '(((:text "test" :callback--data 1)))))
;; (let ((keybb (make-inline-keyboard '(((:text "test" :callback--data 1)
;; (:text "tust" :callback--data 2))
;; ((:text "Home" :url "https://protagon.space"))))))
;; ($ (send-message 133107019 "ho" :reply--markup keybb)
;; (:parallel t :with-reply (a . #'inline-keyboard-answer))
;; (let* ((answer (lparallel:force a))
;; (id (tg-id answer))
;; (data (tg-data answer)))
;; ($* (answer-callback-query id :text (tg-data answer)))
;; ($* (send-message 133107019 (format nil "You answered: ~A" data))))))
($ (send-message 133107019 "hi") (:parallel nil))
(defun send-trivia-question (&optional (score 0) (total 1))
(let* ((question (getf
(second
(json:decode-json
(dex:get "https://opentdb.com/api.php?amount=1&type=boolean" :want-stream t))) :results))
(keyboard (make-inline-keyboard '(((:text "✅" :callback--data "True")
(:text "❎" :callback--data "False"))))))
(trivia:match question
((alist (:question . question)
(:category . category)
(:difficulty . diff)
(:correct--answer . correct-answer))
($ (send-message 133107019 (format nil "<b>~A (~A)</b>~%~a~%<pre>Score: ~A/~A</pre>"
category diff question score total)
:parse--mode "HTML" :reply--markup keyboard)
(:parallel t :with-reply (a . #'inline-keyboard-answer))
(let* ((answer (lparallel:force a))
(id (tg-id answer))
(data (tg-data answer)))
($ (answer-callback-query id) (:parallel t))
($ (send-message 133107019
(concatenate 'string
(if (string= data correct-answer)
(progn (incf score)
"Correct!")
"You're wrong.") " Play again?") :reply--markup keyboard)
(:with-reply (a . #'inline-keyboard-answer))
($* (answer-callback-query (tg-id (lparallel:force a))))
(if (string= (tg-data (lparallel:force a)) "True")
(send-trivia-question score (1+ total))
($* (send-message 133107019 (format nil "Thanks for playing.~%Your score is: <b>~A/~A</b>" score total)
:parse--mode "HTML"))))))))))