tweaking for arrays

This commit is contained in:
hiro98 2019-08-24 11:35:44 +02:00
parent 70c2f18c39
commit 7568220413

View file

@ -4,7 +4,7 @@
(defvar *url* "https://core.telegram.org/bots/api") (defvar *url* "https://core.telegram.org/bots/api")
(defvar *request* "") (defvar *request* "")
(defvar *parsed-content* nil) (defvar *parsed-content* nil)
(defvar *out-package* :cl-telegram-bot-api) (defvar *out-package* :cl-telegram-bot)
(defvar *out-file* "out/out.lisp") (defvar *out-file* "out/out.lisp")
;; Unimportant categories ;; Unimportant categories
@ -23,8 +23,7 @@
(defparameter *blacklist* (defparameter *blacklist*
#("Formatting options" "Inline mode objects" "Sending files" "Inline mode methods" "CallbackGame" #("Formatting options" "Inline mode objects" "Sending files" "Inline mode methods" "CallbackGame"
"InputFile" "InputFile" "InputMedia"))
"getUpdates"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Structures ; ; Structures ;
@ -68,16 +67,24 @@
(let ((types (ppcre:split " or " type-str))) (let ((types (ppcre:split " or " type-str)))
(mapcar #'(lambda (single-type) (mapcar #'(lambda (single-type)
(let* ((is-array (search "Array of " single-type)) (let* ((is-array (search "Array of " single-type))
(el-type (if is-array (el-types (if is-array
(elt (nth-value 1 (ppcre:scan-to-strings "Array of (\\S+)" single-type)) 0) (let* ((single-type (ppcre:regex-replace-all "Array of " single-type "")))
single-type)) (ppcre:split " and " single-type))
(type (assoc el-type *type-map* :test #'string=)) `(,single-type)))
(type-symbol (if type (types (mapcar #'(lambda (el)
(cdr type) (assoc el *type-map* :test #'string=))
(camel->symbol el-type)))) el-types))
(type-symbols (mapcar
#'(lambda (type el-type)
(if type
(cdr type)
(camel->symbol el-type)))
types el-types)))
(if is-array (if is-array
`(array ,type-symbol) `(array ,(if (> (length type-symbols) 1)
type-symbol))) `(or ,@type-symbols)
(car type-symbols)))
(car type-symbols))))
types))) types)))
(defun parse-parameters (param-table) (defun parse-parameters (param-table)
@ -232,7 +239,7 @@
(defun tg-object->function (name name-sym req-args opt-args docstring return-type) (defun tg-object->function (name name-sym req-args opt-args docstring return-type)
"Creates a function for use in `cl-telegram-bot` from a tg-object." "Creates a function for use in `cl-telegram-bot` from a tg-object."
`(defun ,name-sym (bot ,@(make-argument-list req-args opt-args)) `(defun ,name-sym ,(make-argument-list req-args opt-args)
,docstring ,docstring
,@(mapcar ,@(mapcar
#'(lambda (opt) #'(lambda (opt)
@ -247,10 +254,10 @@
req-args)))) req-args))))
,@(mapcar #'(lambda (param) ,@(mapcar #'(lambda (param)
`(when ,(param->arg param) `(when ,(param->arg param)
(nconc options (list (cons ,(param->keyword param) ,(param->arg param)))))) (setf options (nconc options (list (cons ,(param->keyword param) ,(param->arg param)))))))
opt-args) opt-args)
(make-request bot ,name options ,@(when return-type (list ,name options ,@(when return-type
`(:return-type (quote ,(camel->symbol return-type)))))))) `(:return-type (quote ,(camel->symbol return-type))))))))
;; (make-request bot ,name options ,@(when return-type ;; (make-request bot ,name options ,@(when return-type
;; (let ((ret-sym (camel->symbol (car return-type)))) ;; (let ((ret-sym (camel->symbol (car return-type))))
@ -274,7 +281,7 @@
(doc (tg-param-desc param))) (doc (tg-param-desc param)))
`(,pname-sym `(,pname-sym
:initarg ,pname-kw :initarg ,pname-kw
,@(when optional ,@(unless optional
'(:initform nil)) '(:initform nil))
:accessor ,(intern (concatenate 'string "TG-" (symbol-name pname-sym))) :accessor ,(intern (concatenate 'string "TG-" (symbol-name pname-sym)))
:type ,@(make-type-specifier type) :type ,@(make-type-specifier type)
@ -282,13 +289,11 @@
params)) params))
(:documentation ,docstring))) (:documentation ,docstring)))
(defun write-file-header (categories stream) (defun write-file-header (categories stream)
(format stream "; DO NOT EDIT, AUTO GENERATED~%~%") (format stream "; DO NOT EDIT, AUTO GENERATED~%~%")
(write `(defpackage ,*out-package* (write `(defpackage ,*out-package*
(:use :cl)
(:export (:export
:*API-TYPES*
,@(let ((symbols nil)) ,@(let ((symbols nil))
(dolist (item categories) (dolist (item categories)
(let ((objects (cdr item))) (let ((objects (cdr item)))
@ -296,7 +301,7 @@
(push (make-keyword (camel->symbol (tg-object-name object))) symbols)))) (push (make-keyword (camel->symbol (tg-object-name object))) symbols))))
(nreverse symbols)))) (nreverse symbols))))
:stream stream) :stream stream)
(format stream "~%")
(write `(in-package ,*out-package*) :stream stream) (write `(in-package ,*out-package*) :stream stream)
(format stream "~%") (format stream "~%")
(write `(defparameter *API-TYPES* (write `(defparameter *API-TYPES*
@ -309,6 +314,18 @@
(push (camel->symbol (tg-object-name object)) symbols))))) (push (camel->symbol (tg-object-name object)) symbols)))))
(nreverse symbols)))) (nreverse symbols))))
:stream stream) :stream stream)
(format stream "~%")
(write `(defparameter *API-METHODS*
(quote
,(let ((symbols nil))
(dolist (item categories)
(let ((objects (cdr item)))
(dolist (object objects)
(when (eq :method (tg-object-type object))
(push (camel->symbol (tg-object-name object)) symbols)))))
(nreverse symbols))))
:stream stream)
(format stream "~%")
categories) categories)
(defun print-objects (parsed-cats stream) (defun print-objects (parsed-cats stream)