AtlatestRepositorysigil-mcp

sigil-mcp / tree / testtest-nrepl-tools.sgl

1(clear-module-cache! '(sigil mcp nrepl))
2(clear-module-cache! '(sigil nrepl))
3(clear-module-cache! '(sigil nrepl client))
4
5(import (sigil test)
6 (sigil string)
7 (sigil json)
8 (sigil fs)
9 (sigil process)
10 (sigil time)
11 (sigil mcp protocol)
12 (sigil mcp nrepl)
13 (sigil mcp server))
15(define *test-port* 57989)
16(define *lock-file* "/tmp/sigil-mcp-nrepl-57989.lock")
18(define (tool-names)
19 (let ((server (mcp-server name: "test" version: "0.1.0"))
20 (tools '()))
21 (register-nrepl-tools! server
22 (lambda (srv name desc schema handler)
23 (set! tools (cons name tools))))
24 tools))
26(define (register-tools server)
27 (register-nrepl-tools! server mcp-server-register-tool!))
29(define (nrepl-private name)
30 (let ((saved-module (current-module)))
31 (set-current-module! (find-module '(sigil mcp nrepl)))
32 (let ((value (eval name)))
33 (set-current-module! saved-module)
34 value)))
36(define (call-tool server name args)
37 (let* ((msg (jsonrpc-request id: 1 method: "tools/call"
38 params: (dict name: name arguments: args)))
39 (resp (mcp-server-handle-message server msg))
40 (result (jsonrpc-response-result resp))
41 (content (assoc-ref 'content result)))
42 (assoc-ref 'text (car content))))
44(define (wait-for-lock attempts)
45 (cond
46 ((file-exists? *lock-file*) #t)
47 ((<= attempts 0) #f)
48 (else
49 (sleep 0.05)
50 (wait-for-lock (- attempts 1)))))
52(define (with-nrepl-process thunk)
53 (when (file-exists? *lock-file*)
54 (delete-file *lock-file*))
55 (let ((proc (process-spawn "sigil" "-L" "build/dev/lib"
56 "test/fixtures/nrepl-server.sgl")))
57 (dynamic-wind
58 (lambda ()
59 (unless (wait-for-lock 100)
60 (error "nREPL fixture did not write lock file")))
61 thunk
62 (lambda ()
63 (when proc
64 (process-kill! proc))
65 (when (file-exists? *lock-file*)
66 (delete-file *lock-file*))))))
68(test-group "register-nrepl-tools!"
69 (test "registers all nREPL tools"
70 (let ((tools (tool-names)))
71 (assert-true (member "sigil/nrepl-connect" tools))
72 (assert-true (member "sigil/nrepl-eval" tools))
73 (assert-true (member "sigil/nrepl-status" tools))
74 (assert-true (member "sigil/nrepl-disconnect" tools))
75 (assert-true (member "sigil/nrepl-complete" tools))
76 (assert-true (member "sigil/nrepl-doc" tools))
77 (assert-true (member "sigil/nrepl-describe" tools))
78 (assert-true (member "sigil/nrepl-macroexpand" tools))
79 (assert-equal 8 (length tools)))))
81(test-group "nREPL MCP response formatting"
82 (test "doc formatter preserves doc payloads"
83 (let ((format-doc (nrepl-private 'format-doc)))
84 (assert-equal "fixture doc"
85 (format-doc '(response :id "doc" :status ok :doc "fixture doc"))))))
87(test-group "nREPL MCP introspection tools"
88 (test "complete, doc, describe, and macroexpand round-trip against live nREPL"
89 (with-nrepl-process
90 (lambda ()
91 (let ((mcp (mcp-server name: "test" version: "0.1.0")))
92 (register-tools mcp)
93 (let ((connect-text (call-tool mcp "sigil/nrepl-connect"
94 (dict port: *test-port*))))
95 (assert-true (string-contains? connect-text "Connected")))
96 (let ((eval-text (call-tool mcp "sigil/nrepl-eval"
97 (dict code: "(define nrepl-mcp-alpha 42)"))))
98 (assert-true eval-text))
99 (let ((complete-text (call-tool mcp "sigil/nrepl-complete"
100 (dict prefix: "nrepl-mcp-a"))))
101 (assert-true (string-contains? complete-text "nrepl-mcp-alpha")))
102 (let ((doc-text (call-tool mcp "sigil/nrepl-doc"
103 (dict symbol: "car"))))
104 (assert-true (or (string-contains? doc-text "car")
105 (string-contains? doc-text "kind:"))))
106 (let ((describe-text (call-tool mcp "sigil/nrepl-describe"
107 (dict symbol: "car"))))
108 (assert-true (string-contains? describe-text "car")))
109 (let ((macro-text (call-tool mcp "sigil/nrepl-macroexpand"
110 (dict code: "(when #t 1)"))))
111 (assert-false (string-contains? macro-text "Error:"))
112 (assert-false (string=? macro-text "No expansion")))
113 (call-tool mcp "sigil/nrepl-disconnect" (dict)))))))
115(run-tests)