magpt/magpt-gpt.el at main · gnu-emacs-ru/magpt · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
;;; magpt-gpt.el --- GPT/gptel wrappers for MaGPT  -*- lexical-binding: t; -*-

;; Author: Peter
;; Package-Requires: ((emacs "28.1") (gptel "0.9"))
;; Keywords: tools, ai
;; URL: https://github.com/11111000000/magpt

;;; Commentary:
;; Centralize gptel usage, response sanitization, and safe callback wrapping.

;;; Code:

(require 'subr-x)
(require 'cl-lib)
(require 'gptel)
(require 'json)
(require 'magpt-log nil t)

;; External deps from core (magpt.el)
(declare-function magpt--log "ext:magpt" (fmt &rest args))
(declare-function magpt--backtrace-string "ext:magpt")
(declare-function magpt--i18n "ext:magpt" (key &rest args))

(defvar magpt-model)
(defvar gptel-model)
(defvar magpt-info-language)
(defvar magpt-commit-language)

(defun magpt--response->string (resp)
  "Return RESP as a string, tolerating backend variations."
  (cond
   ((stringp resp) resp)
   ((and (listp resp) (assq 'content resp))
    (let ((c (cdr (assq 'content resp))))
      (if (stringp c) c (format "%S" resp))))
   ((hash-table-p resp)
    (condition-case _ (json-encode resp) (error (format "%S" resp))))
   ((listp resp)
    (condition-case _ (json-encode resp) (error (format "%S" resp))))
   (t (format "%S" resp))))

(defun magpt--sanitize-response (s)
  "Sanitize LLM response S: strip leading Answer/Ответ labels and common Markdown fences."
  (let* ((s (string-trim (or s ""))))
    ;; Drop leading 'Answer:'/'Ответ:' lines (robust, line-by-line).
    (let* ((lines (split-string s "\n"))
           (out lines))
      (while (and out (string-match-p "\\`[ \t]*\\(Answer\\|Ответ\\)[:：]" (car out)))
        (setq out (cdr out)))
      (setq s (mapconcat #'identity out "\n")))
    ;; Strip outer Markdown fences (only = or ~~~; '=' fences are intentionally not stripped).
    (let* ((lines (split-string s "\n"))
           (first (car lines))
           (last  (car (last lines))))
      (when (and first last
                 (string-match-p "\\`[`~]\\{3,\\}" first)
                 (string-match-p "\\`[`~]\\{3,\\}[ \t]*\\'" last))
        (setq s (mapconcat #'identity (butlast (cdr lines)) "\n"))))
    s))

(defun magpt--safe-callback (cb)
  "Wrap CB to prevent hard failures; log diagnostics on error."
  (lambda (resp info)
    (when magpt-log-enabled
      (let* ((ty (type-of resp))
             (preview (condition-case _
                          (let* ((s (magpt--response->string resp))
                                 (n (min 180 (length s))))
                            (substring s 0 n))
                        (error "<unprintable>"))))
        (magpt--log "safe-callback: resp-type=%S preview=%s info=%S"
                    ty preview (and (listp info)
                                    (ignore-errors
                                      (cl-subseq info 0 (min 10 (length info))))))))
    (condition-case e
        (funcall cb resp info)
      (error
       (let* ((emsg (or (ignore-errors
                          (if (fboundp 'magpt--errstr)
                              (magpt--errstr e)
                            (error-message-string e)))
                        "<no-error-object>")))
         (magpt--log "callback exception: %s" emsg)
         (magpt--log "callback exception (raw): %S" e)
         (magpt--log "callback exception: BT:\n%s" (magpt--backtrace-string))
         (ignore-errors
           (let ((base (or (condition-case _
                               (magpt--i18n 'callback-error emsg)
                             (error (format "magpt: callback error: %s" emsg)))
                           (format "magpt: callback error: %s" emsg))))
             (message "%s — raw: %S" base e))))))))

(defun magpt--gptel-request (prompt &rest args)
  "Call `gptel-request' with PROMPT and ARGS, adding logging and safe callback."
  (let* ((plist args)
         (cb (plist-get plist :callback))
         (stream (plist-get plist :stream)))
    (when magpt-log-enabled
      (magpt--log "gptel-request: model=%S stream=%S prompt-len=%d preview=%s"
                  (or magpt-model gptel-model)
                  stream
                  (length (or prompt ""))
                  (let* ((p (or prompt "")) (n (min 180 (length p))))
                    (substring p 0 n))))
    (when cb
      (setq plist (plist-put plist :callback (magpt--safe-callback cb))))
    (apply #'gptel-request prompt plist)))

(defun magpt--system-prompt (kind)
  "Return a strict system directive based on language and KIND ('commit or 'info)."
  (let* ((lang (pcase kind
                 ('commit magpt-commit-language)
                 (_      magpt-info-language)))
         (l (and (stringp lang) (> (length lang) 0) lang)))
    (when l
      (format "Answer STRICTLY in %s. Do not use any other language." l))))

(provide 'magpt-gpt)

;;; magpt-gpt.el ends here