chatikbot/plugins/checkins.lisp

(in-package :cl-user)
(ql:quickload :address-formatting)

(defpackage chatikbot.plugins.checkins
  (:use :cl :chatikbot.common :address-formatting))
(in-package :chatikbot.plugins.checkins)


(def-db-init
  (db-execute "create table if not exists checkins_chats (from_id, chat_id, primary key (from_id, chat_id)) without rowid")
  (db-execute "create table if not exists checkins_history (ts, from_id, lat, lon, place_id, place_name)"))

(defun db/get-chats (from-id)
  (mapcar #'car (db-select "select chat_id from checkins_chats where from_id = ?" from-id)))
(defun db/add-chat (from-id chat-id)
  (db-execute "insert into checkins_chats (from_id, chat_id) values (?, ?)" from-id chat-id))
(defun db/del-chat (from-id chat-id)
  (db-execute "delete from checkins_chats where from_id = ? and chat_id = ?" from-id chat-id))
(defun db/add-checkin (from-id lat lon place-id place-name)
  (db-execute "insert into checkins_history (ts, from_id, lat, lon, place_id, place_name) values (?, ?, ?, ?, ?, ?)"
              (local-time:timestamp-to-unix (local-time:now))
              from-id lat lon place-id place-name))

(defun get-icon (res)
  (let ((cat (keyify (aget "category" res)))
        (type (keyify (aget "type" res)))
        (sport (keyify (aget "sport" res))))
    (case sport
      (:soccer "⚽️")
      (:tennis "🎾")
      (:basketball "🏀")
      (:baseball "⚾️")
      (:multi "🏆")
      (:swimming "🏊")
      (:golf "🏌️")
      (:equestrian "🏇")
      (:billiards "🎱")
      (:running "🏃")
      (:fitnes  "🤸")
      (:athletics "🏋️")
      (:table-tennis "🏓")
      (:beachvolleyball "🏐")
      (:climbing "🧗")
      (:volleyball "🏐")
      (:skateboard "🛹")
      (:boules "🎳")
      (:american-football "🏈")
      (:motor "🏎")
      (:bowls "🎳")
      (:shooting "🎯")
      (:cricket "🏏")
      (:netball "🥍")
      (:horse-racing "🏇")
      (:cycling "🚴")
      (:motocross "🏍")
      (:rugby-union "🏉")
      (:skiing "⛷")
      (:gymnastics  "🤸")
      (:karting "🏎")
      (:handball "🏉")
      (:badminton "🏸")
      (:ice-hockey "🏒")
      (:field-hockey "🏑")      
      (t (case cat
           (:amenity (case type
                       (:atm "🏧")
                       (:bank "🏦")
                       (:restaurant "🍽")
                       (:cafe "☕️")
                       (:fast-food "🌯")
                       (:pharmacy "💊")
                       (:kindergarten "🧸")
                       (:bar "🍸")
                       (:hospital "🏥")
                       (:post-office "📯")
                       (:pub "🍺")
                       (:library "📚")
                       ))
           
           (:leisure (case type
                       (:pitch)))
           )))))

(defvar *revgeo-format* "http://osmnames-search/r/~,6f/~,6f.js?count=10")
(defun get-places (lat lon)
  (handler-case
      (loop for res in (agets (json-request (format nil *revgeo-format* lon lat))
                              "results")
            collect (list (cons :id (agets res "id"))
                          (cons :name (agets res "name"))
                          (cons :icon (get-icon res))
                          (cons :address (format-address res :one-line t))))
    (error (e)
      (log:error e)
      `(((:id . 0) (:name . "Не нашлось"))))))

(defun add-place (name lat lon from-id)
  `((:name . ,name) (:id . ,from-id) (:lat . ,lat) (:lon . ,lon)))

(defun get-name (from)
  (let ((username (agets from "username"))
        (first-name (agets from "first_name"))
        (last-name (agets from "last_name")))
    (if username
        (format nil "@~a" username)
        (format nil "~a ~a" first-name last-name))))

(defun checkin (from place lat lon)
  (let* ((from-id (agets from "id"))
         (place-id (agets place :id))
         (place-name (agets place :name))
         (place-icon (agets place :icon))
         (place-address (agets place :address))
         (message (format nil "~a ~@[~A~]~@[ в ~A~]~@[ (~A)~]"
                          (or place-icon "📍")
                          (get-name from) place-name place-address)))
    (db/add-checkin from-id lat lon place-id place-name)
    (loop for chat-id in (db/get-chats from-id)
          do (telegram-send-venue chat-id lat lon
                                  (format nil "~a ~@[~A~]~@[ в ~A~]"
                                          (or place-icon "📍")
                                          (get-name from) place-name)
                                  place-address)
          ;;do (bot-send-message message :chat-id chat-id :parse-mode "markdown")
          )
    (telegram-edit-message-reply-markup nil
                                        :chat-id *source-chat-id*
                                        :message-id *source-message-id*)))

(defparameter +button-columns+ 2)
(def-message-handler handle-location (10)
  (alexandria:when-let ((location (aget "location" *message*)))
    (alexandria:when-let ((chats (db/get-chats *from-id*))
                          (lat (agets location "latitude"))
                          (lon (agets location "longitude")))
      (log:info "handler-location" *from-id* location)
      (let ((places (get-places lat lon)))
        (log:info places)
        (bot-send-message
         (if places "Выбери место" "Не нашлось ничего :(")
         :reply-markup
         (get-inline-keyboard
          (append
           (let* ((buttons (loop for place in places
                                 for idx from 0
                                 collect (cons idx (let ((this-place place))
                                                     (inline-button ((format nil "~@[~a ~]~a"
                                                                             (agets place :icon)
                                                                             (agets place :name)))
                                                       (checkin *from* this-place lat lon))))))
                  (groups (group-by buttons (lambda (p) (truncate (car p) +button-columns+)))))
             (loop for (i . pairs) in (reverse groups)
                   collect (mapcar #'cdr pairs)))           
           (list (list (inline-button ("+")
                         (bot-send-message "Введи название")
                         (let ((source-chat-id *source-chat-id*)
                               (source-message-id *source-message-id*))
                           (on-next-message
                             (let ((*source-chat-id* source-chat-id)
                                   (*source-message-id* source-message-id))
                               (checkin *from*
                                        (add-place *text* lat lon *from-id*)
                                        lat lon)))))))))))
      t)))

(def-message-cmd-handler handler-checkins (:checkins)
  (let ((chats (db/get-chats *from-id*)))
    (if (member *chat-id* chats)
        (progn
          (db/del-chat *from-id* *chat-id*)
          (bot-send-message (format nil "Больше сюда не шлём чекины ~a" (get-name *from*))))
        (progn
          (db/add-chat *from-id* *chat-id*)
          (bot-send-message (format nil "Теперь шлём сюда чекины ~a" (get-name *from*)))))))

(def-message-cmd-handler handler-checkin (:checkin)
  (if (equal "private" (agets *message* "chat" "type"))
      (bot-send-message "Отправь локейшн"
                        :reply-markup (telegram-reply-keyboard-markup
                                       '(((:request-location t :text "Послать координаты")))
                                       :resize-keyboard t
                                       :one-time-keyboard t))
      (bot-send-message "Нужно в личку"
                        :reply-markup (telegram-inline-keyboard-markup
                                       `(((:text "Перейти"
                                           :url ,(format nil "tg://user?id=~a" *bot-user-id*))))))))