;; SPDX-License-Identifier: EUPL-1.2
;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
(defpackage :ukkoclot/main
  (:nicknames :ukkoclot)
  (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/log :ukkoclot/tg-types)
  (:import-from :anaphora :acond :awhen :it)
  (:import-from :ukkoclot/bot :make-bot :bot-power-on :fixup-value)
  (:import-from :ukkoclot/db :with-db)
  (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace-str :starts-with :starts-with-ignore-case)
  (:local-nicknames
   (:jzon :com.inuoe.jzon))
  (:export :main))
(in-package :ukkoclot/main)

(defvar *in-prod* t)

(defmacro reporty ((evt) &body body)
  `(if *in-prod*
       (handler-case (progn ,@body)
         (error (err) (report-error bot ,evt err)))
       (progn ,@body)))

(defun main ()
  (unwind-protect
       (let ((config (config-load #P"config.default.lisp")))
         (config-merge config #P"config.lisp")
         (log-info "Starting up ~A" (config-bot-name config))
         (with-db (db (config-db-path config))
           (let ((bot (make-bot config db)))
             ;; TODO: Catch fatal errors & report them
             (wrapped-main bot config))))
    (log-info "We're done!")))

(defun wrapped-main (bot config)
  (when *in-prod*
    (send-message bot :chat-id (config-dev-group config) :text "Initializing..."))
  (set-my-name bot :name (config-bot-name config))
  (let ((gup-offset 0))
    (loop while (bot-power-on bot) do
      (let ((updates (get-updates bot :timeout 60 :offset gup-offset)))
        (loop for update across updates do
          (unwind-protect
               (progn
                 (awhen (update-message update)
                   (reporty (it)
                     (on-message bot it)))
                 (awhen (update-callback-query update)
                   (reporty (it)
                     (on-callback-query bot it))))
            (setf gup-offset (1+ (update-update-id update)))))))
    ;; One last getUpdates to make sure offset is stored on server
    (get-updates bot :timeout 0 :limit 1 :offset gup-offset))
  (send-message bot :chat-id (config-dev-group config) :text "Shutting down..."))

(defun on-callback-query (bot cb)
  (let ((data (callback-query-data cb)))
    (cond ((and data
                (starts-with data "bbl:")
                (= (user-id (callback-query-from cb))
                   (config-owner (bot-config bot))))
           (let ((bot-id (read-from-string data t nil :start 4)))
             (blacklist-inline-bot bot bot-id))
           (awhen (callback-query-message cb)
             (delete-message bot
                                 :chat-id (message-chat-id it)
                                 :message-id (message-id it)))
           (answer-callback-query bot
                                  :callback-query-id (callback-query-id cb)
                                  :text "OK"))
          ((and data
                (starts-with data "bwl:")
                (= (user-id (callback-query-from cb))
                   (config-owner (bot-config bot))))
           (let ((bot-id (read-from-string data t nil :start 4)))
             (whitelist-inline-bot bot bot-id))
           (awhen (callback-query-message cb)
             (delete-message bot
                             :chat-id (message-chat-id it)
                             :message-id (message-id it)))
           (answer-callback-query bot
                                  :callback-query-id (callback-query-id cb)
                                  :text "OK"))
          (t
           (log-info "Unrecognised callback query data: ~A" data)
           (answer-callback-query bot
                                  :callback-query-id (callback-query-id cb)
                                  :text "Unallowed callback query, don't press the button again"
                                  :show-alert t)))))


(defun on-message (bot msg)
  (block nil
    (awhen (message-via-bot msg)
      (unless (on-inline-bot bot msg it)
        (return)))

    (awhen (message-text msg)
      (on-text-message bot msg it))

    (awhen (message-new-chat-members msg)
      (loop for new-chat-member across it do
        (on-new-member bot msg new-chat-member)))))

(defun on-new-member (bot msg new-member)
  (if (= (user-id new-member) (bot-id bot))
      (reply-animation bot msg #P"blob/rule-11.mp4"
                       :allow-sending-without-reply t)
      (reply-animation bot msg #P"blob/rule-10.mp4"
                       :text (concatenate 'string "Hello there, "
                                          (user-format-name new-member)
                                          "!  Be on your bestest behaviour now!!")
                       :parse-mode html
                       :caption-above t
                       :allow-sending-without-reply t)))

(defun is-bad-text (text)
  ;; TODO:
  nil)

(defun on-text-message (bot msg text)
  (block nil
    (when (is-bad-text text)
      ;; TODO: Delete message, mute & warn user
      ;; 0 current warns: 5 minute mute, +1 warn
      ;; 1 current warn : 10 minute mute, +1 warn
      ;; 2 current warns: 30 minute mute, +1 warn
      ;; 3 current warns: 1 hour mute, +1 warn
      ;; 4 current warns: 1 day mute, +1 warn
      ;; 5 current warns: Ban
      ;;
      ;; warn gets removed after a month of no warns
      (return))

    (awhen (message-entities msg)
      (loop for entity across it
            when (and (equal (message-entity-type entity) bot-command)
                      (= (message-entity-offset entity) 0))
              do (on-text-command bot msg text (message-entity-extract entity text))))

    ;; TODO: Replace this cond with a nicer dispatch.  Something like string-case?
    (cond ((equal text ":3")
           (reply-message bot msg ">:3"))

          ((equal text ">:3")
           (reply-message bot msg "<b>&gt;:3</b>" :parse-mode html))

          ((starts-with-ignore-case text "big ")
           (let ((the-text (subseq text 4)))
             (unless (is-tg-whitespace-str the-text)
               (reply-message bot msg
                              (concatenate 'string
                                           "<b>"
                                           (escape-xml (string-upcase the-text))
                                           "</b>")
                              :parse-mode html))))

          ((string-equal text "dio cane")
           (reply-message bot
                          (or (message-reply-to-message msg) msg)
                          "porco dio"))

          ((string-equal text "forgor")
           (reply-message bot msg "💀"))

          ((string-equal text "huh")
           (reply-message bot msg "idgi"))

          ((string= text "H")
           (reply-message bot msg "<code>Randomly selected reminder that h &gt; H.</code>" :parse-mode html))

          ((string-equal text "porco dio")
           (reply-message bot
                          (or (message-reply-to-message msg) msg)
                          "dio cane"))

          ((starts-with-ignore-case text "say ")
           (let ((the-text (subseq text 4)))
             (unless (is-tg-whitespace-str the-text)
               (reply-message bot msg the-text))))

          ((string-equal text "uwu")
           (reply-message bot msg "OwO"))

          ((string-equal text "waow")
           (reply-message bot
                          (or (message-reply-to-message msg) msg)
                          "BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED"))

          ((string-equal text "what")
           (reply-message bot msg
                          (with-output-to-string (s)
                            (if (char= (elt text 0) #\w)
                                (write-char #\g s)
                                (write-char #\G s))
                            (if (char= (elt text 1) #\h)
                                (write-string "ood " s)
                                (write-string "OOD " s))
                            (if (char= (elt text 2) #\a)
                                (write-string "gir" s)
                                (write-string "GIR" s))
                            (if (char= (elt text 3) #\t)
                                (write-char #\l s)
                                (write-char #\L s)))))
          )))

(defun simplify-cmd (bot cmd)
  (let ((at-idx (position #\@ cmd)))
    (if (null at-idx)
        (subseq cmd 1)
        (let ((username (subseq cmd (1+ at-idx)))
              (my-username (bot-username bot)))
          (if (equal username my-username)
              (subseq cmd 1 at-idx)
              nil)))))

(defun on-text-command (bot msg text cmd)
  (let ((simple-cmd (simplify-cmd bot cmd)))
    (log-debug "text-command: ~A AKA ~A" cmd simple-cmd)
    ;; TODO: Replace this cond with a nicer dispatch.  Something like string-case?
    (acond
      ((equal simple-cmd "chatid")
       (reply-message bot msg (format nil "<code>~A</code>" (message-chat-id msg)) :parse-mode html))

      ((and (equal simple-cmd "msginfo")
            (message-reply-to-message msg))
       (reply-message bot it (let ((*print-pretty* t)) (fixup-value it))))

      ((equal simple-cmd "ping")
       (let* ((start-time (get-internal-real-time))
              (reply (reply-message bot msg "Pong!
Send time: ..."))
              (end-time (get-internal-real-time))
              (time-elapsed (* (/ (- end-time start-time) internal-time-units-per-second)
                               1000)))
         (edit-message-text bot
                            :chat-id (message-chat-id reply)
                            :message-id (message-id reply)
                            :text (format nil "Pong!~2%Send time: ~Gms" time-elapsed))))

      ((and (equal simple-cmd "shutdown")
            (message-from msg)
            (= (user-id (message-from msg)) (config-owner (bot-config bot))))
       (setf (bot-power-on bot) nil)
       (reply-message bot msg "Initialising shutdown..." :allow-sending-without-reply t))

          )))

(defun report-error (bot evt err)
  (log-error "While handling ~A: ~A" evt err)
  (let ((msg (format nil "<code>~A</code> while handling ~&<pre>~A</pre>"
                     (escape-xml (format nil "~A" err))
                     (escape-xml (format nil "~A" evt)))))
    (send-message bot
                      :chat-id (config-dev-group (bot-config bot))
                      :text msg
                      :parse-mode html)))