diff --git a/cl-telegram-bot.asd b/cl-telegram-bot.asd index a690796..1e9e27e 100644 --- a/cl-telegram-bot.asd +++ b/cl-telegram-bot.asd @@ -3,7 +3,7 @@ :author "Rei " :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") diff --git a/cl-telegram-bot.auto-poll.lisp b/cl-telegram-bot.auto-poll.lisp new file mode 100644 index 0000000..c541b94 --- /dev/null +++ b/cl-telegram-bot.auto-poll.lisp @@ -0,0 +1,85 @@ +;; cl-telegram-bot +;; +;; MIT License +;; +;; Copyright (c) 2016 Rei +;; Copyright (c) 2019 Hiro98 +;; +;; 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))) diff --git a/cl-telegram-bot.lisp b/cl-telegram-bot.lisp index 8bb3c31..60e5bc0 100644 --- a/cl-telegram-bot.lisp +++ b/cl-telegram-bot.lisp @@ -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 ; diff --git a/docs/Makefile b/docs/Makefile new file mode 100644 index 0000000..d4bb2cb --- /dev/null +++ b/docs/Makefile @@ -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) diff --git a/docs/_static/style.css b/docs/_static/style.css new file mode 100644 index 0000000..e4f2819 --- /dev/null +++ b/docs/_static/style.css @@ -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; +} diff --git a/docs/basic-bot-class.rst b/docs/basic-bot-class.rst new file mode 100644 index 0000000..9f5d4db --- /dev/null +++ b/docs/basic-bot-class.rst @@ -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")) diff --git a/docs/conf.py b/docs/conf.py new file mode 100644 index 0000000..ffcd3e2 --- /dev/null +++ b/docs/conf.py @@ -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 diff --git a/docs/index.rst b/docs/index.rst new file mode 100644 index 0000000..cb096ab --- /dev/null +++ b/docs/index.rst @@ -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` diff --git a/docs/make.bat b/docs/make.bat new file mode 100644 index 0000000..2119f51 --- /dev/null +++ b/docs/make.bat @@ -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 diff --git a/docs/requirements.in b/docs/requirements.in new file mode 100644 index 0000000..18c367c --- /dev/null +++ b/docs/requirements.in @@ -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 diff --git a/docs/requirements.txt b/docs/requirements.txt new file mode 100644 index 0000000..3ded3f5 --- /dev/null +++ b/docs/requirements.txt @@ -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 diff --git a/docs/src/pip-delete-this-directory.txt b/docs/src/pip-delete-this-directory.txt new file mode 100644 index 0000000..c8883ea --- /dev/null +++ b/docs/src/pip-delete-this-directory.txt @@ -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). diff --git a/docs/src/pygments-cl-repl b/docs/src/pygments-cl-repl new file mode 160000 index 0000000..7f30f04 --- /dev/null +++ b/docs/src/pygments-cl-repl @@ -0,0 +1 @@ +Subproject commit 7f30f04a1841d0c7db91500fe9cba214838750df diff --git a/docs/src/sphinxcontrib-cldomain b/docs/src/sphinxcontrib-cldomain new file mode 160000 index 0000000..d3d9c71 --- /dev/null +++ b/docs/src/sphinxcontrib-cldomain @@ -0,0 +1 @@ +Subproject commit d3d9c718fbdb295a65ba18a1ee2cafa9bc695205 diff --git a/example.lisp b/example.lisp deleted file mode 100644 index 081524f..0000000 --- a/example.lisp +++ /dev/null @@ -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))) diff --git a/examples/trivia-bot.lisp b/examples/trivia-bot.lisp new file mode 100644 index 0000000..f5cf023 --- /dev/null +++ b/examples/trivia-bot.lisp @@ -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

~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))) + "Correct!" + "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) diff --git a/test.lisp b/test.lisp new file mode 100644 index 0000000..4e0c3cc --- /dev/null +++ b/test.lisp @@ -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 "~A (~A)~%~a~%
Score: ~A/~A
" + 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: ~A/~A" score total) + :parse--mode "HTML"))))))))))