Lem intelligence

extensions/intelligence/claude-code.lisp

@@ -0,0 +1,46 @@
+(uiop:define-package :lem-intelligence/claude-code
+  (:use :cl
+        :lem)
+  (:local-nicknames (:claude-code :lem-intelligence/lib/claude-code)))
+(in-package :lem-intelligence/claude-code)
+
+(define-major-mode claude-code-mode nil
+    (:name "Claude Code"
+     :keymap *claude-code-keymap*
+     :mode-hook *claude-code-mode-hook*)
+  (setf (variable-value 'lem/listener-mode:listener-set-prompt-function :buffer (current-buffer))
+        'set-prompt
+        (variable-value 'lem/listener-mode:listener-check-input-function :buffer (current-buffer))
+        (constantly t)
+        (variable-value 'lem/listener-mode:listener-execute-function :buffer (current-buffer))
+        'execute-query)
+  (lem/listener-mode:start-listener-mode))
+
+(defun handle-kill-buffer (buffer)
+  (declare (ignore buffer))
+  ;; TODO
+  )
+
+(defun set-prompt (point)
+  (insert-string point "Claude> "))
+
+(defun execute-query (point prompt)
+  (let ((buffer (point-buffer point)))
+    (setf (buffer-value buffer 'session)
+          (claude-code:query prompt
+                             :callback (lambda (response)
+                                         (send-event (lambda ()
+                                                       (with-point ((point (buffer-point buffer) :left-inserting))
+                                                         (buffer-end point)
+                                                         (insert-string point 
+                                                                        (with-output-to-string (out)
+                                                                          (yason:encode response out))))
+                                                       (when (equal "result" (gethash "type" response))
+                                                         (lem/listener-mode:refresh-prompt buffer))
+                                                       (when (get-buffer-windows buffer)
+                                                         (redraw-display)))))))))
+
+(define-command claude-code () ()
+  (let ((buffer (make-buffer "*Claude Code*")))
+    (add-hook (variable-value 'kill-buffer-hook :buffer buffer) 'handle-kill-buffer)
+    (lem/listener-mode:listener-start buffer 'claude-code-mode)))

extensions/intelligence/lem-intelligence.asd

@@ -0,0 +1,9 @@
+(defsystem "lem-intelligence"
+  :depends-on ("yason"
+               "dexador"
+               "babel"
+               "lem/core")
+  :serial t
+  :components ((:module "lib"
+                :components ((:file "ollama")
+                             (:file "claude-code")))))

extensions/intelligence/lib/claude-code.lisp

@@ -0,0 +1,119 @@
+;; https://docs.anthropic.com/ja/docs/claude-code/sdk
+
+(uiop:define-package :lem-intelligence/lib/claude-code
+  (:use :cl
+        :alexandria)
+  (:export :make-options
+           :query
+           :receive))
+(in-package :lem-intelligence/lib/claude-code)
+
+(defstruct (claude-code-options (:constructor make-options))
+  allowed-tools
+  max-thinking-tokens
+  system-prompt
+  append-system-prompt
+  mcp-servers
+  permission-mode
+  continue-conversation
+  resume
+  max-turns
+  disallowed-tools
+  model
+  permission-prompt-tool-name
+  cwd
+  settings
+  add-dirs)
+
+(defun json-encode (object &key (encode #'yason:encode))
+  (with-output-to-string (out) (funcall encode object out)))
+
+(defun construct-command (prompt options)
+  `("claude"
+    "--output-format" "stream-json"
+    "--verbose"
+    "--print" ,prompt
+    ,@(when (claude-code-options-system-prompt options)
+        (list "--system-prompt" (claude-code-options-system-prompt options)))
+    ,@(when (claude-code-options-append-system-prompt options)
+        (list "--append-system-prompt" (claude-code-options-append-system-prompt options)))
+    ,@(when (claude-code-options-allowed-tools options)
+        (list "--allowedTools" (format nil "~{~A~^,~}" (claude-code-options-allowed-tools options))))
+    ,@(when (claude-code-options-max-turns options)
+        (list "--max-turns" (write-to-string (claude-code-options-max-turns options))))
+    ,@(when (claude-code-options-disallowed-tools options)
+        (list "--disallowedTools"
+              (format nil "~{~A~^,~}" (claude-code-options-disallowed-tools options))))
+    ,@(when (claude-code-options-model options)
+        (list "--model" (claude-code-options-model options)))
+    ,@(when (claude-code-options-permission-prompt-tool-name options)
+        (list "--permission-prompt-tool" (claude-code-options-permission-prompt-tool-name options)))
+    ,@(when (claude-code-options-permission-mode options)
+        (list "--permission-mode" (claude-code-options-permission-mode options)))
+    ,@(when (claude-code-options-continue-conversation options)
+        (list "--continue"))
+    ,@(when (claude-code-options-resume options)
+        (list "--resume" (claude-code-options-resume options)))
+    ,@(when (claude-code-options-settings options)
+        (list "--settings" (claude-code-options-settings options)))
+    ,@(when (claude-code-options-add-dirs options)
+        (mapcan (lambda (dir) (list "--add-dir" (princ-to-string dir)))
+                (claude-code-options-add-dirs options)))
+    ,@(when (claude-code-options-mcp-servers options)
+        (cond
+          ((consp (claude-code-options-mcp-servers options))
+           (list "--mcp-config"
+                 (let ((yason:*parse-object-as-alist* t))
+                   (json-encode
+                    (acons "mcpServers"
+                           (claude-code-options-mcp-servers options)
+                           nil)
+                    :encode #'yason:encode-alist))))
+          (t
+           (list "--mcp-config" (princ-to-string (claude-code-options-mcp-servers options))))))))
+
+(defstruct session
+  process
+  thread)
+
+(defun receive-message (process)
+  (check-type process async-process::process)
+  (loop :with buffer := ""
+        :do (let ((data (async-process:process-receive-output process)))
+              (unless data
+                (return))
+              (setf buffer (concatenate 'string buffer data))
+              (handler-case (yason:parse buffer)
+                (error ()
+                  ;; If there is a parse error, the input is incomplete.
+                  )
+                (:no-error (value &rest *)
+                  (return value))))
+            (sleep 0.1)
+        :while (async-process:process-alive-p process)))
+
+(defun query (prompt &key (options (make-options)) callback)
+  (let* ((process
+           (async-process:create-process
+            (construct-command prompt options))))
+    (make-session
+     :process process
+     :thread (bt2:make-thread
+              (lambda ()
+                (loop
+                  :do (when-let ((value (receive-message process)))
+                        (funcall callback value))
+                  :while (async-process:process-alive-p process)))
+              :name "Claude Code thread"))))
+
+;; example
+(eval-when ()
+  (let ((session (query "hello")))
+    (loop :for message := (receive session)
+          :until (equal "result" (gethash "type" message))
+          :do (print message))))
+
+#+(or)
+(defmethod print-object ((object hash-table) stream)
+  (print-unreadable-object (object stream :type t)
+    (prin1 (alexandria:hash-table-alist object) stream)))

extensions/intelligence/lib/ollama.lisp

@@ -0,0 +1,81 @@
+(uiop:define-package :lem-intelligence/lib/ollama
+  (:use :cl)
+  (:export :slurp
+           :generate
+           :chat))
+(in-package :lem-intelligence/lib/ollama)
+
+(defun hash (&rest plist)
+  (alexandria:plist-hash-table plist :test 'equal))
+
+(defun to-json (object)
+  (yason:with-output-to-string* ()
+    (yason:encode object)))
+
+(defun pretty-json (object)
+  (yason:with-output-to-string* (:indent t)
+    (yason:encode object)))
+
+(defun read-byte-line (stream)
+  (let ((acc '()))
+    (loop :for byte := (read-byte stream nil)
+          :do (cond ((null byte)
+                     (return (values (nreverse acc) nil)))
+                    ((= byte (char-code #\newline))
+                     (return (values (nreverse acc) t)))
+                    (t
+                     (push byte acc))))))
+
+(defun bytes-to-string (bytes)
+  (babel:octets-to-string
+   (make-array (length bytes)
+               :initial-contents bytes
+               :element-type '(unsigned-byte 8))))
+
+(defun slurp (result)
+  (string-trim '(#\newline #\space #\")
+               (with-output-to-string (out)
+                 (loop :for ht :in result
+                       :do (alexandria:when-let ((response (gethash "response" ht)))
+                             (write-string response out))))))
+
+(defun url (path)
+  (quri:make-uri :defaults "http://localhost:11434"
+                 :path path))
+
+(defun generate (prompt &key (model (alexandria:required-argument :model)))
+  (let ((response (babel:octets-to-string
+                   (dex:post (url "/api/generate")
+                             :headers '(("content-type" . "application/json"))
+                             :content (to-json (hash "model" model "prompt" prompt))
+                             :read-timeout nil
+                             :connect-timeout nil))))
+    (with-input-from-string (input-stream response)
+      (loop :for object := (handler-case (yason:parse input-stream)
+                             (end-of-file () nil))
+            :while object
+            :collect object))))
+
+(defun chat (&key (role nil role-p)
+                  (content (alexandria:required-argument :content))
+                  (model (alexandria:required-argument :model))
+                  (callback (alexandria:required-argument :callback)))
+  (let ((stream
+          (dex:post (url "/api/chat")
+                    :headers '(("content-type" . "application/json"))
+                    :content (to-json (hash "model" model
+                                            "messages" (list
+                                                        (if role-p
+                                                            (hash "role" role
+                                                                  "content" content)
+                                                            (hash "content" content)))))
+                    :want-stream t
+                    :read-timeout nil
+                    :connect-timeout nil)))
+    (loop
+      (multiple-value-bind (bytes continue)
+          (read-byte-line stream)
+        (when bytes
+          (funcall callback (yason:parse (bytes-to-string bytes))))
+        (unless continue
+          (return))))))

lem.asd

@@ -279,7 +279,8 @@
                #-os-windows "lem-terminal"
                "lem-legit"
                "lem-dashboard"
-               "lem-copilot"))
+               "lem-copilot"
+               "lem-intelligence"))
 
 (defsystem "lem"
   :version "2.3.0"