test/test-nrepl-tools.sgl

1(clear-module-cache! '(sigil mcp nrepl))

2(clear-module-cache! '(sigil nrepl))

3(clear-module-cache! '(sigil nrepl client))

5(import (sigil test)

6 (sigil string)

7 (sigil json)

8 (sigil fs)

9 (sigil process)

10 (sigil time)

11 (sigil mcp nrepl)

12 (sigil mcp server))

14(define *test-port* 57989)

15(define *lock-file* "/tmp/sigil-mcp-nrepl-57989.lock")

17(define (tool-names)

18 (let ((server (mcp-server name: "test" version: "0.1.0"))

19 (tools '()))

20 (register-nrepl-tools! server

21 (lambda (srv name desc schema handler)

22 (set! tools (cons name tools))))

23 tools))

25(define (register-tools server)

26 (register-nrepl-tools! server mcp-server-register-tool!))

28(define (nrepl-private name)

29 (let ((saved-module (current-module)))

30 (set-current-module! (find-module '(sigil mcp nrepl)))

31 (let ((value (eval name)))

32 (set-current-module! saved-module)

33 value)))

35(define (call-tool server name args)

36 (let* ((msg (jsonrpc-request id: 1 method: "tools/call"

37 params: (dict name: name arguments: args)))

38 (resp (mcp-server-handle-message server msg))

39 (result (jsonrpc-response-result resp))

40 (content (assoc-ref 'content result)))

41 (assoc-ref 'text (car content))))

43(define (wait-for-lock attempts)

44 (cond

45 ((file-exists? *lock-file*) #t)

46 ((<= attempts 0) #f)

47 (else

48 (sleep 0.05)

49 (wait-for-lock (- attempts 1)))))

51(define (with-nrepl-process thunk)

52 (when (file-exists? *lock-file*)

53 (delete-file *lock-file*))

54 (let ((proc (process-spawn "sigil" "-L" "build/dev/lib"

55 "test/fixtures/nrepl-server.sgl")))

56 (dynamic-wind

57 (lambda ()

58 (unless (wait-for-lock 100)

59 (error "nREPL fixture did not write lock file")))

60 thunk

61 (lambda ()

62 (when proc

63 (process-kill! proc))

64 (when (file-exists? *lock-file*)

65 (delete-file *lock-file*))))))

67(test-group "register-nrepl-tools!"

68 (test "registers all nREPL tools"

69 (let ((tools (tool-names)))

70 (assert-true (member "sigil/nrepl-connect" tools))

71 (assert-true (member "sigil/nrepl-eval" tools))

72 (assert-true (member "sigil/nrepl-status" tools))

73 (assert-true (member "sigil/nrepl-disconnect" tools))

74 (assert-true (member "sigil/nrepl-complete" tools))

75 (assert-true (member "sigil/nrepl-doc" tools))

76 (assert-true (member "sigil/nrepl-describe" tools))

77 (assert-true (member "sigil/nrepl-macroexpand" tools))

78 (assert-equal 8 (length tools)))))

80(test-group "nREPL MCP response formatting"

81 (test "doc formatter preserves doc payloads"

82 (let ((format-doc (nrepl-private 'format-doc)))

83 (assert-equal "fixture doc"

84 (format-doc '(response :id "doc" :status ok :doc "fixture doc"))))))

86(test-group "nREPL MCP introspection tools"

87 (test "complete, doc, describe, and macroexpand round-trip against live nREPL"

88 (with-nrepl-process

89 (lambda ()

90 (let ((mcp (mcp-server name: "test" version: "0.1.0")))

91 (register-tools mcp)

92 (let ((connect-text (call-tool mcp "sigil/nrepl-connect"

93 (dict port: *test-port*))))

94 (assert-true (string-contains? connect-text "Connected")))

95 (let ((eval-text (call-tool mcp "sigil/nrepl-eval"

96 (dict code: "(define nrepl-mcp-alpha 42)"))))

97 (assert-true eval-text))

98 (let ((complete-text (call-tool mcp "sigil/nrepl-complete"

99 (dict prefix: "nrepl-mcp-a"))))

100 (assert-true (string-contains? complete-text "nrepl-mcp-alpha")))

101 (let ((doc-text (call-tool mcp "sigil/nrepl-doc"

102 (dict symbol: "car"))))

103 (assert-true (or (string-contains? doc-text "car")

104 (string-contains? doc-text "kind:"))))

105 (let ((describe-text (call-tool mcp "sigil/nrepl-describe"

106 (dict symbol: "car"))))

107 (assert-true (string-contains? describe-text "car")))

108 (let ((macro-text (call-tool mcp "sigil/nrepl-macroexpand"

109 (dict code: "(when #t 1)"))))

110 (assert-false (string-contains? macro-text "Error:"))

111 (assert-false (string=? macro-text "No expansion")))

112 (call-tool mcp "sigil/nrepl-disconnect" (dict)))))))

113

114(run-tests)