;;; ppq-status.el --- Dashboard for PayPerQ API -*- lexical-binding: t; -*-

;; Copyright (C) 2024  PayPerQ Contributors

;; Author: PayPerQ Contributors
;; Maintainer: PayPerQ Contributors
;; URL: https://github.com/ppqai/emacs
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.1") (qrencode "0.1"))
;; Keywords: convenience, api, dashboard

;; This file is not part of GNU Emacs.

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; A dashboard for the PayPerQ API showing models, balance and deposits.

;; Setup:
;;   (require 'ppq-status)
;;   M-x ppq-status
;;
;; Configure API key and credit ID in auth-sources:
;;   (add-to-list 'auth-sources '("ppq.ai.gpg" :host "ppq.ai"))

;;; Code:

(require 'url)
(require 'json)
(require 'auth-source)
(require 'org)
(require 'tabulated-list)
(require 'hl-line)

(declare-function qrencode-string "qrencode")

(defgroup ppq nil
  "Dashboard for PayPerQ API."
  :group 'convenience
  :prefix "ppq-"
  :link '(url-link :tag "GitHub" "https://github.com/ppqai/emacs"))

(defcustom ppq-api-base-url "https://api.ppq.ai"
  "Base URL for PayPerQ API."
  :type 'string
  :group 'ppq)

(defcustom ppq-models-endpoint "/v1/models"
  "Endpoint for fetching models."
  :type 'string
  :group 'ppq)

(defvar ppq--window-config nil
  "Saved window configuration before dashboard was shown.")

(defun ppq--get-api-key ()
  "Get API key from auth-source for ppq.ai."
  (let ((secret (auth-source-search :host "ppq.ai" :secret t)))
    (when secret
      (funcall (plist-get (car secret) :secret)))))

(defun ppq--get-credit-id ()
  "Get credit ID from auth-source for ppq.ai/credit-id."
  (let ((secret (auth-source-search :host "ppq.ai/credit-id" :secret t)))
    (when secret
      (funcall (plist-get (car secret) :secret)))))

;; --- Table 1: Releases ---

(defvar ppq--releases-data nil
  "Cached releases data from GitHub.")

(defvar ppq--releases-projects
  '(("Opencode" . "anomalyco/opencode"))
  "List of projects to fetch releases for.
Each element is a cons cell (DISPLAY-NAME . REPO-STRING).")

(defun ppq--releases-get-buffer-name ()
  "Get the releases buffer name."
  "*Dashboard:Releases*")

(defvar ppq--releases-active-processes nil
  "List of active release fetch processes.")

(defun ppq--releases-process-sentinel (process _event)
  "Process sentinel for gh release list.
PROCESS is the process object, _EVENT is the status change string."
  (setq ppq--releases-active-processes
        (delq process ppq--releases-active-processes))
  (when (memq (process-status process) '(exit signal))
    (let ((stdout-buf (process-buffer process))
          (stderr-buf (process-get process 'ppq-stderr-buffer))
          (exit-code (process-exit-status process))
          (project-name (process-get process 'ppq-project-name)))
       (if (zerop exit-code)
           (let ((output (with-current-buffer stdout-buf
                           (buffer-string))))
             (condition-case nil
                 (let* ((json (json-parse-string (string-trim output) :object-type 'alist))
                        (releases (if (vectorp json) (append json nil) json)))
                   (push (cons project-name releases) ppq--releases-data)
                   (ppq--releases-refresh-buffer))
               (error nil)))
         (let ((stderr-output (with-current-buffer stderr-buf
                                (buffer-string))))
           (message "ppq releases: failed for %s: %s"
                    project-name (string-trim stderr-output))))
      (when (buffer-live-p stdout-buf)
        (kill-buffer stdout-buf))
      (when (buffer-live-p stderr-buf)
        (kill-buffer stderr-buf)))))

(defun ppq--releases-fetch-async (project-name repo)
  "Fetch releases for REPO asynchronously using gh CLI.
PROJECT-NAME is the display name for the project."
  (let* ((stdout-buf (generate-new-buffer " *gh-releases-stdout*"))
         (stderr-buf (generate-new-buffer " *gh-releases-stderr*"))
         (process-environment (append '("PAGER=cat" "GH_PAGER=cat" "GIT_PAGER=cat" "NO_COLOR=1")
                                      process-environment))
         (process (make-process
                   :name "gh-releases"
                   :buffer stdout-buf
                   :command (list "gh" "api"
                                  (format "repos/%s/releases?per_page=5" repo))
                   :stderr stderr-buf
                   :sentinel #'ppq--releases-process-sentinel
                   :noquery t)))
    (process-put process 'ppq-project-name project-name)
    (process-put process 'ppq-stderr-buffer stderr-buf)
    (push process ppq--releases-active-processes)))

(defun ppq--releases-fetch-all-async ()
  "Fetch releases for all configured projects."
  (setq ppq--releases-data nil)
  (dolist (project ppq--releases-projects)
    (ppq--releases-fetch-async (car project) (cdr project))))

(defun ppq--releases-format-date (iso-date)
  "Format ISO-DATE string to human-readable date."
  (when iso-date
    (condition-case nil
        (format-time-string
         "%Y-%m-%d"
         (encode-time (parse-time-string iso-date)))
      (error iso-date))))

(defun ppq--releases-insert-content ()
  "Insert releases content into current buffer."
  (let ((inhibit-read-only t))
    (erase-buffer)
    (insert "* Software Releases\n\n")
    (if ppq--releases-data
        (dolist (project-data ppq--releases-data)
          (let ((project-name (car project-data))
                (releases (cdr project-data)))
            (insert (format "** %s\n" project-name))
            (if releases
                (dolist (release releases)
                  (let* ((tag (cdr (assq 'tag_name release)))
                         (name (cdr (assq 'name release)))
                         (published (cdr (assq 'published_at release)))
                         (body (cdr (assq 'body release)))
                         (display-name (if (and name (not (string= name "")))
                                           name
                                         tag)))
                    (insert (format "*** %s (%s)\n"
                                    display-name
                                    (ppq--releases-format-date published)))
                    ;; Insert changelog body if present
                    (when (and body (not (eq body :null)) (not (string= body "")))
                      (insert "\n#+begin_src markdown\n")
                      (insert body)
                      (insert "\n#+end_src\n"))))
              (insert "- No releases found\n"))
            (insert "\n")))
      (insert "Loading releases...\n"))
    (goto-char (point-min))
    ;; Fold to show release versions (level 3) but hide changelog content
    (org-content 3)))

(defun ppq--releases-refresh-buffer ()
  "Refresh the releases buffer if it exists."
  (when-let ((buf (get-buffer (ppq--releases-get-buffer-name))))
    (with-current-buffer buf
      (ppq--releases-insert-content))))

(defun ppq-releases-mode ()
  "Major mode for displaying GitHub releases."
  (interactive)
  (kill-all-local-variables)
  (org-mode)
  (org-indent-mode 1)
  (setq major-mode 'ppq-releases-mode
        mode-name "Releases")
  (use-local-map (let ((map (copy-keymap org-mode-map)))
                   (define-key map "q" #'ppq-quit)
                   map))
  (setq buffer-read-only t)
  (ppq--releases-insert-content))

(defvar ppq-releases-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "q" #'ppq-quit)
    map))

;; --- Table 2: Models ---

(defvar ppq--models-data nil
  "Cached models data from API.")

(defun ppq--aget (alist key)
  "Safely get value from ALIST for KEY, returns nil if null."
  (let ((val (cdr (assq key alist))))
    (unless (eq val :null) val)))

(defun ppq--format-context-length (num)
  "Format NUM as human-readable context length."
  (if (numberp num)
      (cond
       ((>= num 1000000) (format "%.1fM" (/ num 1000000.0)))
       ((>= num 1000) (format "%.0fK" (/ num 1000.0)))
       (t (number-to-string num)))
    "N/A"))

(defun ppq--format-pricing (model)
  "Format pricing info from MODEL."
  (let* ((pricing (ppq--aget model 'pricing))
         (prompt (when pricing (ppq--aget pricing 'input_per_1M_tokens)))
         (completion (when pricing (ppq--aget pricing 'output_per_1M_tokens)))
         (currency (or (when pricing (ppq--aget pricing 'currency)) "USD")))
    (if (and (numberp prompt) (numberp completion)
             (eq prompt 0) (eq completion 0))
        "Free"
      (format "$%.2f/$%.2f %s"
              (or prompt 0)
              (or completion 0)
              currency))))

(defun ppq--model-has-cheap-output-p (model)
  "Check if MODEL has output price per 1M tokens in range [0, 1)."
  (let* ((pricing (ppq--aget model 'pricing))
         (completion (when pricing (ppq--aget pricing 'output_per_1M_tokens))))
    (and (numberp completion)
         (>= completion 0)
         (< completion 1))))

(defun ppq--fetch-models-callback (status)
  "Callback for async model fetching. STATUS is the url-retrieve status."
  (unless (plist-get status :error)
    (goto-char (point-min))
    (re-search-forward "^$" nil t)
    (let* ((json-str (buffer-substring (point) (point-max)))
           (json (json-parse-string json-str :object-type 'alist))
           (models (ppq--aget json 'data)))
      (when (vectorp models)
        (setq models (append models nil)))
      (setq ppq--models-data models)
      (when (get-buffer "*Dashboard:Models*")
        (with-current-buffer "*Dashboard:Models*"
          (ppq-models-mode)))
      (message "Models loaded: %d entries" (length models)))))

(defun ppq--fetch-models-async ()
  "Fetch models from PayPerQ API asynchronously."
  (url-retrieve
   (concat ppq-api-base-url ppq-models-endpoint)
   #'ppq--fetch-models-callback
   nil t t))

;; --- Balance ---

(defun ppq--fetch-balance-callback (status)
  "Callback for async balance fetching. STATUS is the url-retrieve status."
  (unless (plist-get status :error)
    (goto-char (point-min))
    (re-search-forward "^$" nil t)
    (let* ((json-str (buffer-substring (point) (point-max)))
           (json (json-parse-string json-str :object-type 'alist))
           (balance (ppq--aget json 'balance)))
      (when (get-buffer "*Dashboard:Info*")
        (with-current-buffer "*Dashboard:Info*"
          (let ((inhibit-read-only t))
            (goto-char (point-min))
            (when (re-search-forward "^\\*\\* Balance" nil t)
              (delete-region (match-beginning 0) (progn (forward-line) (point)))
              (insert "** Balance\n")
              (insert (format "- Credits: %s\n" (or balance "N/A")))))
        (message "Balance loaded"))))))

(defun ppq--fetch-balance-async ()
  "Fetch balance from PayPerQ API asynchronously."
  (let ((credit-id (ppq--get-credit-id)))
    (when credit-id
      (let ((url-request-method "POST")
            (url-request-extra-headers (list (cons "Content-Type" "application/json")))
            (url-request-data (json-encode (list (cons 'credit_id credit-id)))))
        (url-retrieve
         (concat ppq-api-base-url "/credits/balance")
         #'ppq--fetch-balance-callback
         nil nil t)))))

;; --- Topup ---

(defun ppq--create-topup-callback (status)
  "Callback for async topup creation. STATUS is the url-retrieve status."
  (unless (plist-get status :error)
    (goto-char (point-min))
    (re-search-forward "^$" nil t)
    (let* ((json-str (buffer-substring (point) (point-max)))
           (json (json-parse-string json-str :object-type 'alist))
           (data (ppq--aget json 'data))
           (invoice (ppq--aget data 'invoice))
           (amount (ppq--aget data 'amount))
           (currency (ppq--aget data 'currency)))
      (when (get-buffer "*Dashboard:Info*")
        (with-current-buffer "*Dashboard:Info*"
          (let ((inhibit-read-only t))
            (goto-char (point-max))
            (insert (format "\n*** Topup Created\n"))
            (insert (format "- Amount: %s %s\n" (or amount "N/A") (or currency "N/A")))
            (when invoice
              (insert (format "- Invoice (raw):\n%s\n" invoice))
              (insert (format "- Invoice (BOLT-11):\n"))
              (insert (qrencode-string invoice))
              (insert "\n"))
            (insert "\n"))
          (goto-char (point-min)))
        (message "Topup created")))))

(defun ppq--create-topup-async (amount currency)
  "Create Lightning topup for AMOUNT in CURRENCY."
  (let ((api-key (ppq--get-api-key)))
    (when api-key
      (let ((url-request-method "POST")
            (url-request-extra-headers (list (cons "Authorization" (format "Bearer %s" api-key))
                                            (cons "Content-Type" "application/json")))
            (url-request-data (json-encode (list (cons 'amount amount)
                                                 (cons 'currency currency)))))
        (url-retrieve
         (concat ppq-api-base-url "/topup/create/btc-lightning")
         #'ppq--create-topup-callback
         nil nil t)))))

(defun ppq--topup-button-action (_)
  "Action for topup button."
  (let* ((satoshis (read-number "Enter amount in satoshis: "))
         (currency (if (> satoshis 0) "SATS" "USD"))
         (amount (if (string= currency "SATS") satoshis (read-number "Enter amount in USD: "))))
    (message "Creating Lightning topup for %s %s..." amount currency)
    (ppq--create-topup-async amount currency)))

(defun ppq--insert-topup-button ()
  "Insert a topup button in the current buffer."
  (insert-text-button "[Topup BTC-LN]"
                      'action #'ppq--topup-button-action
                      'follow-link t))

;; --- Models Mode ---

(defvar ppq-models-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map tabulated-list-mode-map)
    (define-key map "q" #'ppq-quit)
    (define-key map "w" #'ppq-models-copy-nix-entry)
    map))

(defun ppq-models-copy-nix-entry ()
  "Copy the current model as a Nix attribute set to clipboard."
  (interactive)
  (when tabulated-list-entries
    (let* ((id (tabulated-list-get-id))
           (model (seq-find (lambda (m) (equal (ppq--aget m 'id) id))
                            ppq--models-data))
           (name (ppq--aget model 'name))
           (pricing (ppq--aget model 'pricing))
           (input-price (or (ppq--aget pricing 'input_per_1M_tokens) 0))
           (output-price (or (ppq--aget pricing 'output_per_1M_tokens) 0))
           (nix-str (format "    \"%s\" = {\n      name = \"%s\";\n      cost = [%s %s];\n    };"
                            id name (or input-price 0) (or output-price 0))))
      (kill-new nix-str)
      (message "Copied: %s" id))))

(defun ppq--format-created-at (epoch-ms)
  "Format EPOCH-MS as human-readable date."
  (when epoch-ms
    (format-time-string "%Y-%m-%d" (/ epoch-ms 1000))))

(define-derived-mode ppq-models-mode tabulated-list-mode "Models"
  "A table of PayPerQ models."
  (hl-line-mode 1)
  (setq tabulated-list-format
        [("Name" 35 t)
         ("ID" 35 t)
         ("Created" 12 t)
         ("Ctx" 8 t :right-align t :pad-right 3)
         ("Pricing" 20 t)])
  (setq tabulated-list-sort-key (cons "Created" t))
  (setq tabulated-list-entries
        (mapcar
         (lambda (model)
           (let ((cheap-p (ppq--model-has-cheap-output-p model)))
             (list (ppq--aget model 'id)
                   (vector
                    (propertize (or (ppq--aget model 'name) "N/A") 'font-lock-face (if cheap-p '(:foreground "green") nil))
                    (propertize (or (ppq--aget model 'id) "N/A") 'font-lock-face (if cheap-p '(:foreground "green") nil))
                    (propertize (ppq--format-created-at (ppq--aget model 'created_at)) 'font-lock-face (if cheap-p '(:foreground "green") nil))
                    (propertize (ppq--format-context-length (ppq--aget model 'context_length)) 'font-lock-face (if cheap-p '(:foreground "green") nil))
                    (propertize (ppq--format-pricing model) 'font-lock-face (if cheap-p '(:foreground "green") nil))))))
         ppq--models-data))
  (tabulated-list-init-header)
  (tabulated-list-print))

;; --- Quit function ---

(defun ppq-quit ()
  "Quit the dashboard, restore previous window configuration, and kill buffers."
  (interactive)
  ;; Kill any active release fetch processes
  (dolist (proc ppq--releases-active-processes)
    (when (process-live-p proc)
      (delete-process proc)))
  (setq ppq--releases-active-processes nil)
  ;; Kill buffers
  (dolist (buf (list (get-buffer "*Dashboard:Releases*")
                     (get-buffer "*Dashboard:Models*")
                     (get-buffer "*Dashboard:Info*")))
    (when buf (kill-buffer buf)))
  (setq ppq--models-data nil)
  (setq ppq--releases-data nil)
  (when ppq--window-config
    (set-window-configuration ppq--window-config)
    (setq ppq--window-config nil)))

;; --- Main entry point ---

;;;###autoload
(defun ppq-status ()
  "Show a dashboard with PayPerQ models, balance and topup."
  (interactive)
  (setq ppq--window-config (current-window-configuration))

  (let ((releases-buf (get-buffer-create "*Dashboard:Releases*"))
        (models-buf (get-buffer-create "*Dashboard:Models*"))
        (org-buf (get-buffer-create "*Dashboard:Info*")))

    (with-current-buffer releases-buf
      (ppq-releases-mode))

    (with-current-buffer models-buf
      (ppq-models-mode))

    (with-current-buffer org-buf
      (let ((inhibit-read-only t))
        (erase-buffer)
        (org-mode)
        (org-indent-mode 1)
        (insert "* Dashboard\n\n")
        (insert "Welcome to the *PayPerQ* dashboard!\n\n")
        (insert "** Notes\n")
        (insert "- Press ~q~ in any table to quit\n")
        (insert "- Table 1 :: Recent Releases (loading...)\n")
        (insert "- Table 2 :: PayPerQ Models (loading...)\n\n")
        (insert "** Balance\n\n")
        (insert "** Topup (BTC-LN)\n")
        (ppq--insert-topup-button)
        (insert "\n"))
      (goto-char (point-min))
      (use-local-map (let ((map (copy-keymap org-mode-map)))
                       (define-key map "q" #'ppq-quit)
                       map)))

    (delete-other-windows)
    (let* ((top-left (selected-window))
           (top-right (split-window-right))
           (bottom (split-window-below (/ (window-height) 2))))
      (set-window-buffer top-left releases-buf)
      (set-window-buffer top-right models-buf)
      (set-window-buffer bottom org-buf))

    (select-window (get-buffer-window releases-buf)))

  (ppq--releases-fetch-all-async)
  (ppq--fetch-models-async)
  (ppq--fetch-balance-async))

(provide 'ppq-status)

;;; ppq-status.el ends here