From bf5f23fb6014e05cb49a9ffa424fcfa3ac6e3fed Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Wed, 26 Aug 2026 15:36:37 +0200 Subject: [PATCH 01/17] Refine class creation and baseline tool schemas --- .../MCPClassMutationRequestTest.class.st | 4 +- .../MCPJSONSchemaValidatorTest.class.st | 4 +- .../MCPToolClassMutationTest.class.st | 13 +-- src/MCP-Tests/MCPToolContractsTest.class.st | 4 +- src/MCP/MCPClassCreateRequest.class.st | 10 +-- src/MCP/MCPCreateClassToolCommand.class.st | 2 +- src/MCP/MCPToolCreateClass.class.st | 85 ++++++++++++++++--- src/MCP/MCPToolLoadBaseline.class.st | 2 +- src/MCP/MCPToolUpdateClassComment.class.st | 3 +- 9 files changed, 90 insertions(+), 37 deletions(-) diff --git a/src/MCP-Tests/MCPClassMutationRequestTest.class.st b/src/MCP-Tests/MCPClassMutationRequestTest.class.st index c9c25a7..821ce9e 100644 --- a/src/MCP-Tests/MCPClassMutationRequestTest.class.st +++ b/src/MCP-Tests/MCPClassMutationRequestTest.class.st @@ -17,12 +17,11 @@ MCPClassMutationRequestTest >> testCreateRequestParsesDefinitionArguments [ fromRequest: (MCPToolRequest new tool: MCPToolCreateClass new; arguments: { - (#className -> 'MCPGeneratedClass'). + (#name -> 'MCPGeneratedClass'). (#superclassName -> 'Object'). (#packageName -> 'MCP-Generated'). (#tag -> 'Models'). (#comment -> 'Generated comment.'). - (#force -> true). (#slots -> #( 'firstName' 'lastName' )). (#classSlots -> #( 'defaultName' )). (#traits -> #( 'TComparable' )). @@ -37,7 +36,6 @@ MCPClassMutationRequestTest >> testCreateRequestParsesDefinitionArguments [ self assert: request packageName equals: 'MCP-Generated'. self assert: request tag equals: 'Models'. self assert: request classComment equals: 'Generated comment.'. - self assert: request force. self assert: request slotNames equals: #( 'firstName' 'lastName' ). self assert: request slots equals: #( #firstName #lastName ). self assert: request classSlotNames equals: #( 'defaultName' ). diff --git a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st index a56484a..379013c 100644 --- a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st +++ b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st @@ -113,7 +113,7 @@ MCPJSONSchemaValidatorTest >> classMutationRepresentativeArgumentsByToolClass [ ^ { (MCPToolCreateClass -> { - (#className -> 'MCPJSONSchemaValidatorTestTemporary'). + (#name -> 'MCPJSONSchemaValidatorTestTemporary'). (#superclassName -> 'Object'). (#packageName -> 'MCP-Tests') } asDictionary). (MCPToolUpdateClassName -> { @@ -285,7 +285,7 @@ MCPJSONSchemaValidatorTest >> testCurrentToolInputSchemasAdvertiseGroupedSearchS MCPJSONSchemaValidatorTest >> testCurrentToolRequestValidationRejectsOperationSpecificMissingArguments [ self - should: [ MCPToolCreateClass new requestFromToolCallArguments: { (#className -> 'MCPTool') } asDictionary ] + should: [ MCPToolCreateClass new requestFromToolCallArguments: { (#name -> 'MCPTool') } asDictionary ] raise: MCPInvalidToolInput. self should: [ MCPToolUpdateClassPackage new requestFromToolCallArguments: { (#className -> 'MCPTool') } asDictionary ] diff --git a/src/MCP-Tests/MCPToolClassMutationTest.class.st b/src/MCP-Tests/MCPToolClassMutationTest.class.st index e80710e..e013586 100644 --- a/src/MCP-Tests/MCPToolClassMutationTest.class.st +++ b/src/MCP-Tests/MCPToolClassMutationTest.class.st @@ -70,7 +70,7 @@ MCPToolClassMutationTest >> commentTargetClassName [ MCPToolClassMutationTest >> createRequestArgumentsForClassName: aClassName superclassName: aSuperclassName packageName: aPackageName [ ^ self createRequestArgumentsWith: { - (#className -> aClassName). + (#name -> aClassName). (#superclassName -> aSuperclassName). (#packageName -> aPackageName) } ] @@ -267,9 +267,10 @@ MCPToolClassMutationTest >> testClassToolSchemasDeclareExpectedInputs [ slotProperties := MCPToolAddClassSlot new inputSchema properties collect: [ :each | each name ]. self assert: createProperties asArray - equals: #( 'className' 'superclassName' 'packageName' 'tag' 'slots' 'classSlots' 'traits' 'classTraits' 'sharedVariables' - 'sharedPools' 'layout' 'comment' ). - self assert: MCPToolCreateClass new inputSchema required asSet equals: #( 'className' 'superclassName' 'packageName' ) asSet. + equals: + #( 'name' 'superclassName' 'packageName' 'tag' 'slots' 'classSlots' 'traits' 'classTraits' 'sharedVariables' 'sharedPools' + 'layout' 'comment' ). + self assert: MCPToolCreateClass new inputSchema required asSet equals: #( 'name' 'superclassName' 'packageName' ) asSet. self assert: renameProperties asArray equals: #( 'className' 'newClassName' 'force' 'packageNames' 'classNames' 'hierarchyClassNames' ). @@ -285,7 +286,7 @@ MCPToolClassMutationTest >> testCreateAcceptsClassSlots [ | createdClass data result | result := self callToolWith: (self createRequestArgumentsWith: { - (#className -> 'MCPToolClassMutationTestClassSlots'). + (#name -> 'MCPToolClassMutationTestClassSlots'). (#superclassName -> 'Object'). (#packageName -> self generatedPackageName). (#classSlots -> #( 'defaultName' )) }). @@ -329,7 +330,7 @@ MCPToolClassMutationTest >> testCreateAcceptsSlotsAndTag [ | createdClass data result | result := self callToolWith: (self createRequestArgumentsWith: { - (#className -> 'MCPToolClassMutationTestTagged'). + (#name -> 'MCPToolClassMutationTestTagged'). (#superclassName -> 'Object'). (#packageName -> self generatedPackageName). (#tag -> 'Generated'). diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index d55c638..2ab7b3a 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -288,7 +288,7 @@ MCPToolContractsTest >> classMutationToolFlowSpecs [ { (#toolClass -> MCPToolCreateClass). (#arguments -> { - (#className -> 'MCPTemporaryClass'). + (#name -> 'MCPTemporaryClass'). (#superclassName -> 'Object'). (#packageName -> 'MCP-Tests') } asDictionary). (#requestClass -> MCPClassCreateRequest). @@ -982,7 +982,7 @@ MCPToolContractsTest >> testClassMutationToolsHaveAccurateNamesAndRequiredArgume propertyNames := tool inputSchema properties collect: [ :each | each name ]. self assert: tool name equals: association value. self deny: (propertyNames includes: 'operation') ]. - self assert: MCPToolCreateClass new inputSchema required asSet equals: #( 'className' 'superclassName' 'packageName' ) asSet. + self assert: MCPToolCreateClass new inputSchema required asSet equals: #( 'name' 'superclassName' 'packageName' ) asSet. self assert: MCPToolUpdateClassName new inputSchema required asSet equals: #( 'className' 'newClassName' ) asSet. self assert: MCPToolUpdateClassComment new inputSchema required asSet equals: #( 'className' 'comment' ) asSet. self assert: MCPToolUpdateClassSlotName new inputSchema required asSet equals: #( 'className' 'slotName' 'newSlotName' ) asSet. diff --git a/src/MCP/MCPClassCreateRequest.class.st b/src/MCP/MCPClassCreateRequest.class.st index f35617e..09b6666 100644 --- a/src/MCP/MCPClassCreateRequest.class.st +++ b/src/MCP/MCPClassCreateRequest.class.st @@ -12,7 +12,6 @@ Class { 'packageName', 'tag', 'classComment', - 'force', 'slotNames', 'classSlotNames', 'traitNames', @@ -82,21 +81,14 @@ MCPClassCreateRequest >> commandForTool: aTool [ ^ MCPCreateClassToolCommand tool: aTool request: self ] -{ #category : 'accessing' } -MCPClassCreateRequest >> force [ - - ^ force ifNil: [ false ] -] - { #category : 'initialization' } MCPClassCreateRequest >> initializeFromRequest: request [ - className := request stringArgumentNamed: 'className'. + className := request stringArgumentNamed: 'name'. superclassName := request stringArgumentNamed: 'superclassName'. packageName := request stringArgumentNamed: 'packageName'. tag := request stringArgumentNamed: 'tag'. classComment := (request hasArgumentNamed: 'comment') ifTrue: [ self classCommentFromRequest: request ]. - force := request booleanArgumentNamed: 'force' default: false. slotNames := request stringCollectionArgumentNamed: 'slots'. classSlotNames := request stringCollectionArgumentNamed: 'classSlots'. traitNames := request stringCollectionArgumentNamed: 'traits'. diff --git a/src/MCP/MCPCreateClassToolCommand.class.st b/src/MCP/MCPCreateClassToolCommand.class.st index fb90c43..017eed5 100644 --- a/src/MCP/MCPCreateClassToolCommand.class.st +++ b/src/MCP/MCPCreateClassToolCommand.class.st @@ -17,7 +17,7 @@ MCPCreateClassToolCommand >> execute [ | result | ^ self tool executeMutationAction: 'create' - force: self request force + force: false requestedContext: self request requestedContext work: [ result := (MCPCreateClassCommand diff --git a/src/MCP/MCPToolCreateClass.class.st b/src/MCP/MCPToolCreateClass.class.st index 24a2586..179cde6 100644 --- a/src/MCP/MCPToolCreateClass.class.st +++ b/src/MCP/MCPToolCreateClass.class.st @@ -23,19 +23,82 @@ MCPToolCreateClass >> classToolSpec [ (#title -> 'Create Class'). (#description -> 'Create one class definition in the running image.'). (#inputProperties -> { - self classNameSchemaProperty. + self createClassNameSchemaProperty. self superclassNameSchemaProperty. - self packageNameSchemaProperty. - self tagSchemaProperty. - self slotsSchemaProperty. - self classSlotsSchemaProperty. - self traitsSchemaProperty. - self classTraitsSchemaProperty. - self sharedVariablesSchemaProperty. - self sharedPoolsSchemaProperty. + self createPackageNameSchemaProperty. + self createTagSchemaProperty. + self createSlotsSchemaProperty. + self createClassSlotsSchemaProperty. + self createTraitsSchemaProperty. + self createClassTraitsSchemaProperty. + self createSharedVariablesSchemaProperty. + self createSharedPoolsSchemaProperty. self layoutSchemaProperty. - self commentSchemaProperty }). - (#requiredProperties -> #( 'className' 'superclassName' 'packageName' )) } asDictionary + self createCommentSchemaProperty }). + (#requiredProperties -> #( 'name' 'superclassName' 'packageName' )) } asDictionary +] + +{ #category : 'private - schema' } +MCPToolCreateClass >> createClassNameSchemaProperty [ + + ^ self schemaPropertyNamed: 'name' type: 'string' description: 'Name of the class to create.' +] + +{ #category : 'private - schema' } +MCPToolCreateClass >> createClassSlotsSchemaProperty [ + + ^ self stringArraySchemaNamed: 'classSlots' description: 'Class-side slot names for the new class.' itemDescription: 'Slot name.' +] + +{ #category : 'private - schema' } +MCPToolCreateClass >> createClassTraitsSchemaProperty [ + + ^ self stringArraySchemaNamed: 'classTraits' description: 'Class-side traits for the new class.' itemDescription: 'Trait name.' +] + +{ #category : 'private - schema' } +MCPToolCreateClass >> createCommentSchemaProperty [ + + ^ self schemaPropertyNamed: 'comment' type: 'string' description: 'Class comment for the new class.' +] + +{ #category : 'private - schema' } +MCPToolCreateClass >> createPackageNameSchemaProperty [ + + ^ self schemaPropertyNamed: 'packageName' type: 'string' description: 'Package name for the new class.' +] + +{ #category : 'private - schema' } +MCPToolCreateClass >> createSharedPoolsSchemaProperty [ + + ^ self stringArraySchemaNamed: 'sharedPools' description: 'Shared pools for the new class.' itemDescription: 'Shared pool name.' +] + +{ #category : 'private - schema' } +MCPToolCreateClass >> createSharedVariablesSchemaProperty [ + + ^ self + stringArraySchemaNamed: 'sharedVariables' + description: 'Class variables for the new class.' + itemDescription: 'Variable name.' +] + +{ #category : 'private - schema' } +MCPToolCreateClass >> createSlotsSchemaProperty [ + + ^ self stringArraySchemaNamed: 'slots' description: 'Instance slot names for the new class.' itemDescription: 'Slot name.' +] + +{ #category : 'private - schema' } +MCPToolCreateClass >> createTagSchemaProperty [ + + ^ self schemaPropertyNamed: 'tag' type: 'string' description: 'Package tag for the new class.' +] + +{ #category : 'private - schema' } +MCPToolCreateClass >> createTraitsSchemaProperty [ + + ^ self stringArraySchemaNamed: 'traits' description: 'Instance traits for the new class.' itemDescription: 'Trait name.' ] { #category : 'metadata' } diff --git a/src/MCP/MCPToolLoadBaseline.class.st b/src/MCP/MCPToolLoadBaseline.class.st index 34a060a..7e64ac1 100644 --- a/src/MCP/MCPToolLoadBaseline.class.st +++ b/src/MCP/MCPToolLoadBaseline.class.st @@ -21,7 +21,7 @@ MCPToolLoadBaseline >> buildInputSchema [ ^ MCPStructureInputSchema new type: 'object'; properties: { - (self nonEmptyStringSchemaPropertyNamed: 'baseline' description: 'Baseline name without BaselineOf prefix.'). + (self schemaPropertyNamed: 'baseline' type: 'string' description: 'Baseline name without BaselineOf prefix.'). self groupsSchemaProperty } , self loadPolicyInputSchemaProperties; required: #( 'baseline' ); additionalProperties: false; diff --git a/src/MCP/MCPToolUpdateClassComment.class.st b/src/MCP/MCPToolUpdateClassComment.class.st index 67de44c..2626342 100644 --- a/src/MCP/MCPToolUpdateClassComment.class.st +++ b/src/MCP/MCPToolUpdateClassComment.class.st @@ -23,7 +23,6 @@ MCPToolUpdateClassComment >> classToolSpec [ (#description -> 'Set or clear one class comment.'). (#inputProperties -> { self classNameSchemaProperty. - self commentSchemaProperty. - self forceSchemaProperty }). + self commentSchemaProperty }). (#requiredProperties -> #( 'className' 'comment' )) } asDictionary ] From 94331489c4f20a9362aadb370a9271bd26656554 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Thu, 27 Aug 2026 14:21:09 +0200 Subject: [PATCH 02/17] Simplify class get and rename tool schemas --- .../MCPJSONSchemaValidatorTest.class.st | 10 ++-- .../MCPToolClassMutationTest.class.st | 50 +++---------------- src/MCP-Tests/MCPToolContractsTest.class.st | 40 +++++++-------- src/MCP-Tests/MCPToolGetClassTest.class.st | 26 +++++----- .../MCPToolStructuredOutputTest.class.st | 8 +-- .../MCPUpdateClassCommandTest.class.st | 7 ++- src/MCP/MCPClassUpdateRequest.class.st | 15 +++--- src/MCP/MCPGetClassRequest.class.st | 3 +- src/MCP/MCPToolClassMutation.class.st | 6 --- src/MCP/MCPToolGetClass.class.st | 15 +++--- src/MCP/MCPToolUpdateClassLayout.class.st | 3 +- src/MCP/MCPToolUpdateClassName.class.st | 24 ++++++--- src/MCP/MCPUpdateClassCommand.class.st | 25 +++------- 13 files changed, 93 insertions(+), 139 deletions(-) diff --git a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st index 379013c..802ee5e 100644 --- a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st +++ b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st @@ -15,7 +15,7 @@ MCPJSONSchemaValidatorTest >> baseRepresentativeArgumentsByToolClass [ ^ { (MCPToolEvaluate -> { (#code -> '1 + 1') } asDictionary). (MCPToolRunTests -> { (#classes -> { 'MCPToolContractsTest' }) } asDictionary). - (MCPToolGetClass -> { (#className -> 'MCPTool') } asDictionary). + (MCPToolGetClass -> { (#name -> 'MCPTool') } asDictionary). (MCPToolGetMethod -> { (#className -> 'MCPTool'). (#selector -> 'name') } asDictionary). @@ -70,8 +70,8 @@ MCPJSONSchemaValidatorTest >> baseRepresentativeArgumentsByToolClass [ (MCPToolSearchPackages -> Dictionary new). (MCPToolClassMutation -> { (#action -> 'update'). - (#className -> 'MCPTool'). - (#newClassName -> 'MCPToolRenamed') } asDictionary). + (#name -> 'MCPTool'). + (#newName -> 'MCPToolRenamed') } asDictionary). (MCPToolMethodMutation -> { (#action -> 'create'). (#className -> 'MCPTool'). @@ -117,8 +117,8 @@ MCPJSONSchemaValidatorTest >> classMutationRepresentativeArgumentsByToolClass [ (#superclassName -> 'Object'). (#packageName -> 'MCP-Tests') } asDictionary). (MCPToolUpdateClassName -> { - (#className -> 'MCPTool'). - (#newClassName -> 'MCPToolRenamed') } asDictionary). + (#name -> 'MCPTool'). + (#newName -> 'MCPToolRenamed') } asDictionary). (MCPToolUpdateClassSuperclass -> { (#className -> 'MCPTool'). (#superclassName -> 'Object') } asDictionary). diff --git a/src/MCP-Tests/MCPToolClassMutationTest.class.st b/src/MCP-Tests/MCPToolClassMutationTest.class.st index e013586..b01a8ca 100644 --- a/src/MCP-Tests/MCPToolClassMutationTest.class.st +++ b/src/MCP-Tests/MCPToolClassMutationTest.class.st @@ -47,7 +47,7 @@ MCPToolClassMutationTest >> classToolClassForArguments: arguments slotAction: sl slotAction = 'rename' ifTrue: [ ^ MCPToolUpdateClassSlotName ]. slotAction = 'pullUp' ifTrue: [ ^ MCPToolPullUpClassSlot ]. slotAction = 'pushDown' ifTrue: [ ^ MCPToolPushDownClassSlot ]. - (arguments includesKey: #newClassName) ifTrue: [ ^ MCPToolUpdateClassName ]. + (arguments includesKey: #newName) ifTrue: [ ^ MCPToolUpdateClassName ]. (arguments includesKey: #comment) ifTrue: [ ^ MCPToolUpdateClassComment ]. (arguments includesKey: #traits) ifTrue: [ ^ MCPToolUpdateClassTraits ]. (arguments includesKey: #classTraits) ifTrue: [ ^ MCPToolUpdateClassSideTraits ]. @@ -271,10 +271,8 @@ MCPToolClassMutationTest >> testClassToolSchemasDeclareExpectedInputs [ #( 'name' 'superclassName' 'packageName' 'tag' 'slots' 'classSlots' 'traits' 'classTraits' 'sharedVariables' 'sharedPools' 'layout' 'comment' ). self assert: MCPToolCreateClass new inputSchema required asSet equals: #( 'name' 'superclassName' 'packageName' ) asSet. - self - assert: renameProperties asArray - equals: #( 'className' 'newClassName' 'force' 'packageNames' 'classNames' 'hierarchyClassNames' ). - self assert: MCPToolUpdateClassName new inputSchema required asSet equals: #( 'className' 'newClassName' ) asSet. + self assert: renameProperties asArray equals: #( 'name' 'newName' ). + self assert: MCPToolUpdateClassName new inputSchema required asSet equals: #( 'name' 'newName' ) asSet. self assert: packageProperties asArray equals: #( 'className' 'packageName' 'tag' 'force' ). self assert: MCPToolUpdateClassPackage new inputSchema required asSet equals: #( 'className' ) asSet. self assert: slotProperties asArray equals: #( 'className' 'slotName' 'classSide' 'force' ). @@ -982,40 +980,6 @@ MCPToolClassMutationTest >> testUpdateRemovesTraitsWithEmptyArray [ self deny: (result at: #isError ifAbsent: [ false ]) ] -{ #category : 'tests - update' } -MCPToolClassMutationTest >> testUpdateRenameCanLimitRefactoringToClassHierarchy [ - - | hierarchyArguments referenceClass referenceSource result subclass | - hierarchyArguments := self updateRequestArgumentsForRename copy - at: #hierarchyClassNames put: { self originalClassName }; - yourself. - result := self callToolWith: hierarchyArguments. - referenceClass := self classNamed: self referenceClassName. - subclass := self classNamed: self subclassName. - referenceSource := (referenceClass >> #referencedClass) sourceCode. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: subclass superclass name asString equals: self renamedClassName. - self assert: (referenceSource includesSubstring: self originalClassName). - self deny: (referenceSource includesSubstring: self renamedClassName). - self assert: ((referenceClass >> #newReferencedInstance) sourceCode includesSubstring: self originalClassName) -] - -{ #category : 'tests - update' } -MCPToolClassMutationTest >> testUpdateRenameCanLimitRefactoringToNamedClasses [ - - | classesArguments referenceClass result | - classesArguments := self updateRequestArgumentsForRename copy - at: #classNames put: { - self originalClassName. - self referenceClassName }; - yourself. - result := self callToolWith: classesArguments. - referenceClass := self classNamed: self referenceClassName. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: ((referenceClass >> #referencedClass) sourceCode includesSubstring: self renamedClassName). - self assert: ((referenceClass >> #newReferencedInstance) sourceCode includesSubstring: self renamedClassName) -] - { #category : 'tests - update' } MCPToolClassMutationTest >> testUpdateRenameUpdatesMethodReferences [ @@ -1393,8 +1357,8 @@ MCPToolClassMutationTest >> testUpdateReturnsStructuredErrorWhenRenameClassIsMis | error result suggestions | result := self callToolWith: { (#action -> 'update'). - (#className -> 'MCPToolClassMutationTestMissing'). - (#newClassName -> self renamedClassName) } asDictionary. + (#name -> 'MCPToolClassMutationTestMissing'). + (#newName -> self renamedClassName) } asDictionary. error := self errorFrom: result. suggestions := error at: #suggestions. self assert: (result at: #isError). @@ -1648,8 +1612,8 @@ MCPToolClassMutationTest >> updateRequestArgumentsForRename [ ^ { (#action -> 'update'). - (#className -> self originalClassName). - (#newClassName -> self renamedClassName) } asDictionary + (#name -> self originalClassName). + (#newName -> self renamedClassName) } asDictionary ] { #category : 'private - update' } diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 2ab7b3a..e9956ca 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -128,7 +128,7 @@ MCPToolContractsTest >> baseToolFlowSpecs [ (#commandClass -> MCPSearchToolCommand) } asDictionary. { (#toolClass -> MCPToolGetClass). - (#arguments -> { (#className -> 'Object') } asDictionary). + (#arguments -> { (#name -> 'Object') } asDictionary). (#requestClass -> MCPGetClassRequest). (#commandClass -> MCPGetClassCommand) } asDictionary. { @@ -296,8 +296,8 @@ MCPToolContractsTest >> classMutationToolFlowSpecs [ { (#toolClass -> MCPToolUpdateClassName). (#arguments -> { - (#className -> 'Object'). - (#newClassName -> 'MCPObject') } asDictionary). + (#name -> 'Object'). + (#newName -> 'MCPObject') } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { @@ -983,7 +983,7 @@ MCPToolContractsTest >> testClassMutationToolsHaveAccurateNamesAndRequiredArgume self assert: tool name equals: association value. self deny: (propertyNames includes: 'operation') ]. self assert: MCPToolCreateClass new inputSchema required asSet equals: #( 'name' 'superclassName' 'packageName' ) asSet. - self assert: MCPToolUpdateClassName new inputSchema required asSet equals: #( 'className' 'newClassName' ) asSet. + self assert: MCPToolUpdateClassName new inputSchema required asSet equals: #( 'name' 'newName' ) asSet. self assert: MCPToolUpdateClassComment new inputSchema required asSet equals: #( 'className' 'comment' ) asSet. self assert: MCPToolUpdateClassSlotName new inputSchema required asSet equals: #( 'className' 'slotName' 'newSlotName' ) asSet. packagePropertyNames := MCPToolUpdateClassPackage new inputSchema properties collect: [ :each | each name ]. @@ -1314,7 +1314,7 @@ MCPToolContractsTest >> testGetClassHasAccurateNameAndRequiredArguments [ outputDataProperty := tool outputSchema properties detect: [ :each | each name = 'data' ]. outputPropertyNames := (outputDataProperty extraProperties at: #properties) collect: [ :each | each name ]. self assert: tool name equals: 'class_get'. - self assert: tool inputSchema required asSet equals: #( 'className' ) asSet. + self assert: tool inputSchema required asSet equals: #( 'name' ) asSet. self assert: (inputPropertyNames includes: 'includeComment'). self assert: (outputPropertyNames includes: 'traitComposition'). self assert: (outputPropertyNames includes: 'classTraitComposition') @@ -1699,14 +1699,10 @@ MCPToolContractsTest >> testMutatingToolsRequestImageSaveAfterSuccessfulExecutio { #category : 'tests' } MCPToolContractsTest >> testMutationDescriptionsExplainForceWarningBehavior [ - | classForceDescription methodForceDescription | - classForceDescription := (self inputPropertyNamed: 'force' inTool: MCPToolUpdateClassName new) description. + | methodForceDescription | methodForceDescription := (self inputPropertyNamed: 'force' inTool: MCPToolUpdateMethodSelector new) description. - { - classForceDescription. - methodForceDescription } do: [ :each | - self assert: (each includesSubstring: 'refactoring warnings'). - self assert: (each includesSubstring: 'stopping') ] + self assert: (methodForceDescription includesSubstring: 'refactoring warnings'). + self assert: (methodForceDescription includesSubstring: 'stopping') ] { #category : 'tests' } @@ -1717,13 +1713,15 @@ MCPToolContractsTest >> testMutationToolSchemasAdvertiseRenameScopeConditions [ selectorInputSchema := MCPToolUpdateMethodSelector new inputSchema. classRenamePropertyNames := classRenameInputSchema properties collect: [ :each | each name ]. selectorPropertyNames := selectorInputSchema properties collect: [ :each | each name ]. - { - classRenamePropertyNames. - selectorPropertyNames } do: [ :propertyNames | - self deny: (propertyNames includes: 'scope'). - self assert: (propertyNames includes: 'packageNames'). - self assert: (propertyNames includes: 'classNames'). - self assert: (propertyNames includes: 'hierarchyClassNames') ]. + self deny: (classRenamePropertyNames includes: 'scope'). + self deny: (classRenamePropertyNames includes: 'force'). + self deny: (classRenamePropertyNames includes: 'packageNames'). + self deny: (classRenamePropertyNames includes: 'classNames'). + self deny: (classRenamePropertyNames includes: 'hierarchyClassNames'). + self deny: (selectorPropertyNames includes: 'scope'). + self assert: (selectorPropertyNames includes: 'packageNames'). + self assert: (selectorPropertyNames includes: 'classNames'). + self assert: (selectorPropertyNames includes: 'hierarchyClassNames'). self assert: (classRenameInputSchema asJRPCJSON at: #additionalProperties) equals: false. self assert: (selectorInputSchema asJRPCJSON at: #additionalProperties) equals: false ] @@ -1731,8 +1729,7 @@ MCPToolContractsTest >> testMutationToolSchemasAdvertiseRenameScopeConditions [ { #category : 'tests' } MCPToolContractsTest >> testOptionalToolArgumentsAdvertiseDefaultsWhenAvailable [ - | classSlotTool classUpdateTool searchClassesTool methodMetadataTool searchPackagesTool getClassTool getMethodTool removeClassesTool removeMethodsTool rewriteMethodsTool updateMethodTool | - classUpdateTool := MCPToolUpdateClassName new. + | classSlotTool searchClassesTool methodMetadataTool searchPackagesTool getClassTool getMethodTool removeClassesTool removeMethodsTool rewriteMethodsTool updateMethodTool | classSlotTool := MCPToolAddClassSlot new. getClassTool := MCPToolGetClass new. getMethodTool := MCPToolGetMethod new. @@ -1743,7 +1740,6 @@ MCPToolContractsTest >> testOptionalToolArgumentsAdvertiseDefaultsWhenAvailable searchPackagesTool := MCPToolSearchPackages new. removeClassesTool := MCPToolRemoveClasses new. removeMethodsTool := MCPToolRemoveMethods new. - self assert: ((self inputPropertyNamed: 'force' inTool: classUpdateTool) extraProperties at: #default) equals: false. self assert: ((self inputPropertyNamed: 'classSide' inTool: classSlotTool) extraProperties at: #default) equals: false. self assert: ((self inputPropertyNamed: 'includeComment' inTool: getClassTool) extraProperties at: #default) equals: false. self assert: ((self inputPropertyNamed: 'subclassDepth' inTool: getClassTool) extraProperties at: #default) equals: 0. diff --git a/src/MCP-Tests/MCPToolGetClassTest.class.st b/src/MCP-Tests/MCPToolGetClassTest.class.st index 406c58f..05f47a3 100644 --- a/src/MCP-Tests/MCPToolGetClassTest.class.st +++ b/src/MCP-Tests/MCPToolGetClassTest.class.st @@ -133,7 +133,7 @@ MCPToolGetClassTest >> tearDown [ MCPToolGetClassTest >> testGetsClassMetadata [ | data expectedLayoutClassName result | - result := self callToolWith: { (#className -> self baseClassName) } asDictionary. + result := self callToolWith: { (#name -> self baseClassName) } asDictionary. data := self dataFrom: result. expectedLayoutClassName := (self classNamed: self baseClassName) classLayout class name asString. self deny: (result at: #isError ifAbsent: [ false ]). @@ -163,7 +163,7 @@ MCPToolGetClassTest >> testIncludesClassCommentsWhenRequested [ | data result subclasses | result := self callToolWith: { - (#className -> self childZClassName). + (#name -> self childZClassName). (#includeComment -> true). (#upToSuperclassName -> self baseClassName). (#subclassDepth -> 1) } asDictionary. @@ -183,7 +183,7 @@ MCPToolGetClassTest >> testIncludesDirectSubclasses [ | data result subclasses | result := self callToolWith: { - (#className -> self baseClassName). + (#name -> self baseClassName). (#subclassDepth -> 1) } asDictionary. data := self dataFrom: result. subclasses := data at: #subclasses. @@ -199,7 +199,7 @@ MCPToolGetClassTest >> testIncludesNamedSuperclassChain [ | data result superclasses | result := self callToolWith: { - (#className -> self grandchildClassName). + (#name -> self grandchildClassName). (#upToSuperclassName -> 'Object') } asDictionary. data := self dataFrom: result. superclasses := data at: #superclasses. @@ -214,7 +214,7 @@ MCPToolGetClassTest >> testIncludesNamedSuperclassChain [ MCPToolGetClassTest >> testIncludesSharedPoolNamesForSharedPoolUsingClass [ | data result | - result := self callToolWith: { (#className -> 'AbstractTimeZone') } asDictionary. + result := self callToolWith: { (#name -> 'AbstractTimeZone') } asDictionary. data := self dataFrom: result. self deny: (result at: #isError ifAbsent: [ false ]). self assert: ((data at: #sharedPoolNames) includes: 'ChronologyConstants') @@ -225,7 +225,7 @@ MCPToolGetClassTest >> testIncludesSubclassesUpToRequestedDepth [ | data result subclasses | result := self callToolWith: { - (#className -> self baseClassName). + (#name -> self baseClassName). (#subclassDepth -> 2) } asDictionary. data := self dataFrom: result. subclasses := data at: #subclasses. @@ -241,7 +241,7 @@ MCPToolGetClassTest >> testIncludesSubclassesUpToRequestedDepth [ MCPToolGetClassTest >> testIncludesTraitNamesForTraitUsingClass [ | data result | - result := self callToolWith: { (#className -> 'AlignmentMorph') } asDictionary. + result := self callToolWith: { (#name -> 'AlignmentMorph') } asDictionary. data := self dataFrom: result. self deny: (result at: #isError ifAbsent: [ false ]). self assert: ((data at: #traitNames) anySatisfy: [ :each | each includesSubstring: 'TAbleToRotate' ]). @@ -256,7 +256,7 @@ MCPToolGetClassTest >> testRejectsNegativeSubclassDepth [ self should: [ self callToolWith: { - (#className -> self baseClassName). + (#name -> self baseClassName). (#subclassDepth -> -1) } asDictionary ] raise: MCPInvalidToolInput ] @@ -267,8 +267,8 @@ MCPToolGetClassTest >> testRejectsSubclassDepthAboveMaximum [ self should: [ self callToolWith: { - (#className -> self baseClassName). - (#subclassDepth -> 4) } asDictionary ] + (#name -> self baseClassName). + (#subclassDepth -> 11) } asDictionary ] raise: MCPInvalidToolInput ] @@ -276,7 +276,7 @@ MCPToolGetClassTest >> testRejectsSubclassDepthAboveMaximum [ MCPToolGetClassTest >> testReturnsStructuredErrorWhenClassIsMissing [ | error result structured | - result := self callToolWith: { (#className -> self missingClassName) } asDictionary. + result := self callToolWith: { (#name -> self missingClassName) } asDictionary. structured := self structuredContentFrom: result. error := self errorFrom: result. self assert: (result at: #isError). @@ -287,9 +287,9 @@ MCPToolGetClassTest >> testReturnsStructuredErrorWhenClassIsMissing [ ] { #category : 'tests' } -MCPToolGetClassTest >> testToolRequiresClassNameInSchema [ +MCPToolGetClassTest >> testToolRequiresNameInSchema [ - self assert: MCPToolGetClass new inputSchema required asSet equals: #( 'className' ) asSet + self assert: MCPToolGetClass new inputSchema required asSet equals: #( 'name' ) asSet ] { #category : 'private - calling' } diff --git a/src/MCP-Tests/MCPToolStructuredOutputTest.class.st b/src/MCP-Tests/MCPToolStructuredOutputTest.class.st index 85b0d7c..bd33fdd 100644 --- a/src/MCP-Tests/MCPToolStructuredOutputTest.class.st +++ b/src/MCP-Tests/MCPToolStructuredOutputTest.class.st @@ -55,21 +55,21 @@ MCPToolStructuredOutputTest >> testEvaluateReturnsStructuredSuccess [ MCPToolStructuredOutputTest >> testGetClassParseErrorReturnsStructuredToolError [ | error result structured | - result := self callToolNamed: 'class_get' withArguments: { (#className -> '') } asDictionary. + result := self callToolNamed: 'class_get' withArguments: { (#name -> '') } asDictionary. structured := self structuredContentFrom: result. error := self errorFrom: result. self assert: (result at: #isError). self assert: (structured at: #status) equals: 'error'. self assert: (error at: #errorClass) equals: #Error. self assert: (error at: #className) equals: ''. - self assert: ((error at: #message) includesSubstring: 'className must be a non-empty string') + self assert: ((error at: #message) includesSubstring: 'name must be a non-empty string') ] { #category : 'tests' } MCPToolStructuredOutputTest >> testGetClassReturnsStructuredError [ | contentText error result structured | - result := self callToolNamed: 'class_get' withArguments: { (#className -> 'MCPToolGetClassDefinitelyMissing') } asDictionary. + result := self callToolNamed: 'class_get' withArguments: { (#name -> 'MCPToolGetClassDefinitelyMissing') } asDictionary. structured := self structuredContentFrom: result. error := self errorFrom: result. contentText := (result at: #content) first at: #text. @@ -89,7 +89,7 @@ MCPToolStructuredOutputTest >> testGetClassReturnsStructuredError [ MCPToolStructuredOutputTest >> testGetClassReturnsStructuredSuccess [ | contentText data expectedSharedVariableNames result structured | - result := self callToolNamed: 'class_get' withArguments: { (#className -> 'MCPToolGetMethodTestTarget') } asDictionary. + result := self callToolNamed: 'class_get' withArguments: { (#name -> 'MCPToolGetMethodTestTarget') } asDictionary. structured := self structuredContentFrom: result. data := self dataFrom: result. contentText := (result at: #content) first at: #text. diff --git a/src/MCP-Tests/MCPUpdateClassCommandTest.class.st b/src/MCP-Tests/MCPUpdateClassCommandTest.class.st index 127ca3c..7794be6 100644 --- a/src/MCP-Tests/MCPUpdateClassCommandTest.class.st +++ b/src/MCP-Tests/MCPUpdateClassCommandTest.class.st @@ -18,7 +18,7 @@ MCPUpdateClassCommandTest >> classToolClassForArguments: arguments slotAction: s slotAction = 'rename' ifTrue: [ ^ MCPToolUpdateClassSlotName ]. slotAction = 'pullUp' ifTrue: [ ^ MCPToolPullUpClassSlot ]. slotAction = 'pushDown' ifTrue: [ ^ MCPToolPushDownClassSlot ]. - (arguments includesKey: #newClassName) ifTrue: [ ^ MCPToolUpdateClassName ]. + (arguments includesKey: #newName) ifTrue: [ ^ MCPToolUpdateClassName ]. (arguments includesKey: #comment) ifTrue: [ ^ MCPToolUpdateClassComment ]. (arguments includesKey: #traits) ifTrue: [ ^ MCPToolUpdateClassTraits ]. (arguments includesKey: #classTraits) ifTrue: [ ^ MCPToolUpdateClassSideTraits ]. @@ -152,7 +152,10 @@ MCPUpdateClassCommandTest >> testBuildsUpdatePlan [ MCPUpdateClassCommandTest >> testMapsClassPatchFieldsToUpdateActions [ self - assert: (self commandForArguments: (self updateArgumentsWith: { (#newClassName -> 'ObjectRenamed') })) updateAction + assert: (self commandForArguments: { + (#action -> 'update'). + (#name -> 'Object'). + (#newName -> 'ObjectRenamed') } asDictionary) updateAction equals: 'rename'. self assert: (self commandForArguments: (self updateArgumentsWith: { (#superclassName -> 'ProtoObject') })) updateAction diff --git a/src/MCP/MCPClassUpdateRequest.class.st b/src/MCP/MCPClassUpdateRequest.class.st index 26f2359..c9feb0e 100644 --- a/src/MCP/MCPClassUpdateRequest.class.st +++ b/src/MCP/MCPClassUpdateRequest.class.st @@ -101,7 +101,7 @@ MCPClassUpdateRequest >> commandForTool: aTool [ { #category : 'converting' } MCPClassUpdateRequest >> contextValueForPropertyNamed: propertyName [ - propertyName = 'newClassName' ifTrue: [ ^ self newClassName ]. + propertyName = 'newName' ifTrue: [ ^ self newClassName ]. propertyName = 'superclassName' ifTrue: [ ^ self superclassName ]. propertyName = 'packageName' ifTrue: [ ^ self packageName ]. propertyName = 'tag' ifTrue: [ ^ self tag ifNil: [ '' ] ]. @@ -165,8 +165,10 @@ MCPClassUpdateRequest >> hasUpdates [ MCPClassUpdateRequest >> initializeFromRequest: request [ suppliedProperties := self updatePropertyNames select: [ :each | request hasArgumentNamed: each ]. - className := request stringArgumentNamed: 'className'. - newClassName := request stringArgumentNamed: 'newClassName'. + className := request stringArgumentNamed: ((request hasArgumentNamed: 'name') + ifTrue: [ 'name' ] + ifFalse: [ 'className' ]). + newClassName := request stringArgumentNamed: 'newName'. superclassName := request stringArgumentNamed: 'superclassName'. packageName := request stringArgumentNamed: 'packageName'. tag := request stringArgumentNamed: 'tag'. @@ -241,7 +243,7 @@ MCPClassUpdateRequest >> requestedClassUpdateActions [ | actions | actions := OrderedCollection new. - (self hasSuppliedPropertyNamed: 'newClassName') ifTrue: [ actions add: 'rename' ]. + (self hasSuppliedPropertyNamed: 'newName') ifTrue: [ actions add: 'rename' ]. (self hasSuppliedPropertyNamed: 'superclassName') ifTrue: [ actions add: 'reparent' ]. ((self hasSuppliedPropertyNamed: 'packageName') or: [ self hasSuppliedPropertyNamed: 'tag' ]) ifTrue: [ actions add: 'move' ]. (self hasSuppliedPropertyNamed: 'comment') ifTrue: [ actions add: 'setComment' ]. @@ -382,7 +384,7 @@ MCPClassUpdateRequest >> traits [ { #category : 'private - request' } MCPClassUpdateRequest >> updatePropertyNames [ - ^ #( 'newClassName' 'superclassName' 'packageName' 'tag' 'comment' 'slots' 'classSlots' 'traits' 'classTraits' 'sharedVariables' + ^ #( 'newName' 'superclassName' 'packageName' 'tag' 'comment' 'slots' 'classSlots' 'traits' 'classTraits' 'sharedVariables' 'sharedPools' 'layout' 'slotAction' 'slotName' 'newSlotName' ) ] @@ -412,8 +414,7 @@ MCPClassUpdateRequest >> validateSlotUpdate [ MCPCommandError signalErrorCode: #UnexpectedNewSlotName message: 'newSlotName is only accepted when slotAction=rename.' - details: self slotRequestedContext ]. - ^ self + details: self slotRequestedContext ] ] { #category : 'converting' } diff --git a/src/MCP/MCPGetClassRequest.class.st b/src/MCP/MCPGetClassRequest.class.st index b8a23dd..409061c 100644 --- a/src/MCP/MCPGetClassRequest.class.st +++ b/src/MCP/MCPGetClassRequest.class.st @@ -43,8 +43,7 @@ MCPGetClassRequest >> initializeClassName: aClassName includeComment: aBoolean u className := aClassName. includeComment := aBoolean. upToSuperclassName := aSuperclassName. - subclassDepth := anInteger. - ^ self + subclassDepth := anInteger ] { #category : 'accessing' } diff --git a/src/MCP/MCPToolClassMutation.class.st b/src/MCP/MCPToolClassMutation.class.st index daa392d..bed064d 100644 --- a/src/MCP/MCPToolClassMutation.class.st +++ b/src/MCP/MCPToolClassMutation.class.st @@ -297,12 +297,6 @@ MCPToolClassMutation >> mutationActionForErrorFromParsedRequest: mutationRequest ^ self mutationAction ] -{ #category : 'private - schema' } -MCPToolClassMutation >> newClassNameSchemaProperty [ - - ^ self schemaPropertyNamed: 'newClassName' type: 'string' description: 'The new class name.' -] - { #category : 'private - schema' } MCPToolClassMutation >> newSlotNameSchemaProperty [ diff --git a/src/MCP/MCPToolGetClass.class.st b/src/MCP/MCPToolGetClass.class.st index ea80b22..89d60bc 100644 --- a/src/MCP/MCPToolGetClass.class.st +++ b/src/MCP/MCPToolGetClass.class.st @@ -42,7 +42,8 @@ MCPToolGetClass >> buildInputSchema [ upToSuperclassNameProperty := MCPStructureProperties new name: 'upToSuperclassName'; type: 'string'; - description: 'Ancestor superclass stop.'; + description: + 'Optional ancestor where the returned superclass chain stops. The named class is used as the exclusive upper bound and is not included.'; yourself. subclassDepthProperty := MCPStructureProperties new name: 'subclassDepth'; @@ -56,14 +57,14 @@ MCPToolGetClass >> buildInputSchema [ type: 'object'; properties: { (MCPStructureProperties new - name: 'className'; + name: 'name'; type: 'string'; description: 'Class name.'; yourself). includeCommentProperty. upToSuperclassNameProperty. subclassDepthProperty }; - required: #( 'className' ); + required: #( 'name' ); yourself ] @@ -161,15 +162,15 @@ MCPToolGetClass >> classDescriptionRequiredFields [ MCPToolGetClass >> classNameForErrorFromParsedRequest: getRequest rawRequest: rawRequest [ getRequest ifNotNil: [ ^ getRequest className ]. - ^ (rawRequest stringArgumentNamed: 'className') ifNil: [ '' ] + ^ (rawRequest stringArgumentNamed: 'name') ifNil: [ '' ] ] { #category : 'private - request' } MCPToolGetClass >> classNameFromRequest: request [ | className | - className := request stringArgumentNamed: 'className'. - className ifNil: [ Error signal: 'className must be a non-empty string.' ]. + className := request stringArgumentNamed: 'name'. + className ifNil: [ Error signal: 'name must be a non-empty string.' ]. ^ className ] @@ -252,7 +253,7 @@ MCPToolGetClass >> failureMessageForClassName: className error: anError [ { #category : 'defaults' } MCPToolGetClass >> maximumSubclassDepth [ - ^ 3 + ^ 10 ] { #category : 'private - request' } diff --git a/src/MCP/MCPToolUpdateClassLayout.class.st b/src/MCP/MCPToolUpdateClassLayout.class.st index 7c13be9..088e177 100644 --- a/src/MCP/MCPToolUpdateClassLayout.class.st +++ b/src/MCP/MCPToolUpdateClassLayout.class.st @@ -29,7 +29,6 @@ MCPToolUpdateClassLayout >> classToolSpec [ (#description -> 'Replace the layout class used by one class.'). (#inputProperties -> { self classNameSchemaProperty. - self layoutSchemaProperty. - self forceSchemaProperty }). + self layoutSchemaProperty }). (#requiredProperties -> #( 'className' 'layout' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassName.class.st b/src/MCP/MCPToolUpdateClassName.class.st index 8663e26..3300fdd 100644 --- a/src/MCP/MCPToolUpdateClassName.class.st +++ b/src/MCP/MCPToolUpdateClassName.class.st @@ -20,13 +20,21 @@ MCPToolUpdateClassName >> classToolSpec [ ^ { (#title -> 'Update Class Name'). - (#description -> 'Rename one class through the Pharo refactoring engine.'). + (#description -> 'Rename one class through the Pharo refactoring engine across the whole image.'). (#inputProperties -> { - self classNameSchemaProperty. - self newClassNameSchemaProperty. - self forceSchemaProperty. - self refactoringScopePackageNamesSchemaProperty. - self refactoringScopeClassNamesSchemaProperty. - self refactoringScopeHierarchyClassNamesSchemaProperty }). - (#requiredProperties -> #( 'className' 'newClassName' )) } asDictionary + self renameClassNameSchemaProperty. + self renameNewClassNameSchemaProperty }). + (#requiredProperties -> #( 'name' 'newName' )) } asDictionary +] + +{ #category : 'private - schema' } +MCPToolUpdateClassName >> renameClassNameSchemaProperty [ + + ^ self schemaPropertyNamed: 'name' type: 'string' description: 'Class to rename.' +] + +{ #category : 'private - schema' } +MCPToolUpdateClassName >> renameNewClassNameSchemaProperty [ + + ^ self schemaPropertyNamed: 'newName' type: 'string' description: 'New class name.' ] diff --git a/src/MCP/MCPUpdateClassCommand.class.st b/src/MCP/MCPUpdateClassCommand.class.st index 324ca38..1a3551e 100644 --- a/src/MCP/MCPUpdateClassCommand.class.st +++ b/src/MCP/MCPUpdateClassCommand.class.st @@ -234,20 +234,15 @@ MCPUpdateClassCommand >> executeRenameSlotWithPlan: plan [ { #category : 'executing - class' } MCPUpdateClassCommand >> executeRenameWithPlan: plan [ - | refactoringModel result targetClass | + | result | ^ self tool executeMutationAction: 'rename' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ - targetClass := MCPImageLookup classNamed: self classRequest className. - refactoringModel := self tool - refactoringModelForScopeSpec: self classRequest refactoringScopeSpec - anchoredAtBehavior: targetClass. - result := (MCPRenameClassCommand - className: self classRequest className - newClassName: self classRequest newClassName - model: refactoringModel) execute ] + MCPImageLookup classNamed: self classRequest className. + result := (MCPRenameClassCommand className: self classRequest className newClassName: self classRequest newClassName) + execute ] successResult: [ :warningMessages | self tool successResultText: 'Renamed class ' , self classRequest className , ' to ' , self classRequest newClassName , '.' @@ -427,8 +422,7 @@ MCPUpdateClassCommand >> executeSetCommentWithPlan: plan [ MCPUpdateClassCommand >> initializeTool: aTool request: aClassRequest [ tool := aTool. - classRequest := aClassRequest. - ^ self + classRequest := aClassRequest ] { #category : 'private - move' } @@ -449,12 +443,7 @@ MCPUpdateClassCommand >> moveRequestedContext [ { #category : 'private - planning' } MCPUpdateClassCommand >> requestedContextForAction: action [ - | context | action = 'move' ifTrue: [ ^ self moveRequestedContext ]. - action = 'rename' ifTrue: [ - context := self classRequest requestedContext. - self tool addRefactoringScopeContextFromSpec: self classRequest refactoringScopeSpec toRequestedContext: context. - ^ context ]. action = 'renameSlot' ifTrue: [ ^ self classRequest renameSlotRequestedContext ]. (#( 'addSlot' 'removeSlot' 'pullUpSlot' 'pushDownSlot' ) includes: action) ifTrue: [ ^ self classRequest slotRequestedContext ]. ^ self classRequest requestedContext @@ -477,7 +466,7 @@ MCPUpdateClassCommand >> signalNoUpdateRequested [ ^ MCPCommandError signalErrorCode: #NoClassUpdateRequested message: - 'Class update requires one update field such as newClassName, superclassName, packageName, tag, classComment, slots, classSlots, traits, classTraits, sharedVariables, sharedPools, layout, or slotAction.' + 'Class update requires one update field such as newName, superclassName, packageName, tag, classComment, slots, classSlots, traits, classTraits, sharedVariables, sharedPools, layout, or slotAction.' details: self validationContext ] From 371480beb231b73ae1f79da39adb2e75cdd7eae5 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Thu, 27 Aug 2026 15:15:31 +0200 Subject: [PATCH 03/17] Omit false read-only tool annotations --- src/MCP-Tests/MCPToolContractsTest.class.st | 9 ++++----- src/MCP/MCPStructureToolAnnotations.class.st | 4 +--- src/MCP/MCPToolGetTool.class.st | 1 - 3 files changed, 5 insertions(+), 9 deletions(-) diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index e9956ca..1709d6d 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -873,7 +873,7 @@ MCPToolContractsTest >> testBuiltInToolsProvideCatalogMetadata [ self assert: (MCPTool builtInGroupNames includes: tool groupName). self assert: tool groupName equals: tool class groupName. self assert: (validExposures includes: tool defaultExposure). - self assert: (#( true false ) includes: tool annotations readOnlyHint). + self assert: (#( true nil ) includes: tool annotations readOnlyHint). self assert: tool keywords notEmpty ] ] @@ -1217,7 +1217,7 @@ MCPToolContractsTest >> testDiscoveryUsesConfiguredStaticToolNames [ self assert: (searchContract at: #exposure) equals: 'static'. self assert: ((searchContract at: #annotations) at: #readOnlyHint). self assert: (createContract at: #exposure) equals: 'discoverable'. - self deny: ((createContract at: #annotations) at: #readOnlyHint) + self deny: ((createContract at: #annotations) includesKey: #readOnlyHint) ] { #category : 'tests - evaluate' } @@ -1348,7 +1348,7 @@ MCPToolContractsTest >> testGetToolReturnsSchemaForCatalogTool [ self assert: contract keys asSet equals: #( name description group exposure annotations keywords inputSchema ) asSet. self assert: (contract at: #group) equals: 'repositories'. self assert: (contract at: #exposure) equals: 'discoverable'. - self deny: ((contract at: #annotations) at: #readOnlyHint). + self deny: ((contract at: #annotations) includesKey: #readOnlyHint). self assert: ((contract at: #keywords) includes: 'repo'). inputProperties := ((contract at: #inputSchema) at: #properties) keys. self assert: inputProperties asSet equals: #( 'name' 'location' 'packageNames' 'subdirectory' ) asSet. @@ -2626,7 +2626,6 @@ MCPToolContractsTest >> testToolAnnotationsSerializeStandardHints [ yourself. self assert: annotations asJRPCJSON equals: { (#title -> 'Safe Update'). - (#readOnlyHint -> false). (#destructiveHint -> false). (#idempotentHint -> true). (#openWorldHint -> false) } asDictionary @@ -2847,7 +2846,7 @@ MCPToolContractsTest >> testToolsOwnRegistryMetadata [ tool := MCPToolEvaluate new. self assert: tool groupName equals: 'runtime'. self assert: tool defaultExposure equals: 'static'. - self deny: tool annotations readOnlyHint. + self assert: tool annotations readOnlyHint equals: nil. self assert: (tool keywords includes: 'smalltalk') ] diff --git a/src/MCP/MCPStructureToolAnnotations.class.st b/src/MCP/MCPStructureToolAnnotations.class.st index 9b9166c..4d0084c 100644 --- a/src/MCP/MCPStructureToolAnnotations.class.st +++ b/src/MCP/MCPStructureToolAnnotations.class.st @@ -20,8 +20,6 @@ Class { MCPStructureToolAnnotations class >> mayModify [ ^ self new - readOnlyHint: false; - yourself ] { #category : 'instance creation' } @@ -38,7 +36,7 @@ MCPStructureToolAnnotations >> asJRPCJSON [ | dictionary | dictionary := Dictionary new. self title ifNotNil: [ :annotationTitle | dictionary at: #title put: annotationTitle ]. - self readOnlyHint ifNotNil: [ :hint | dictionary at: #readOnlyHint put: hint ]. + self readOnlyHint = true ifTrue: [ dictionary at: #readOnlyHint put: true ]. self destructiveHint ifNotNil: [ :hint | dictionary at: #destructiveHint put: hint ]. self idempotentHint ifNotNil: [ :hint | dictionary at: #idempotentHint put: hint ]. self openWorldHint ifNotNil: [ :hint | dictionary at: #openWorldHint put: hint ]. diff --git a/src/MCP/MCPToolGetTool.class.st b/src/MCP/MCPToolGetTool.class.st index 0310ad7..ebb5eb7 100644 --- a/src/MCP/MCPToolGetTool.class.st +++ b/src/MCP/MCPToolGetTool.class.st @@ -58,7 +58,6 @@ MCPToolGetTool >> annotationsSchemaProperty [ schemaPropertyNamed: 'openWorldHint' type: 'boolean' description: 'Whether the tool may interact with external entities.') }; - required: #( 'readOnlyHint' ); additionalProperties: false. ^ property ] From a5cc9b568e5093324e6f6e9e3871f9abeb614cf8 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Thu, 27 Aug 2026 15:41:59 +0200 Subject: [PATCH 04/17] Remove unused force schema arguments --- .../MCPToolClassMutationTest.class.st | 4 ++-- src/MCP-Tests/MCPToolContractsTest.class.st | 12 ++++------- .../MCPToolMethodMutationTest.class.st | 2 +- src/MCP/MCPToolAddClassSlot.class.st | 3 +-- src/MCP/MCPToolUpdateClassPackage.class.st | 3 +-- .../MCPToolUpdateClassSharedPools.class.st | 3 +-- ...MCPToolUpdateClassSharedVariables.class.st | 3 +-- src/MCP/MCPToolUpdateClassSideTraits.class.st | 3 +-- src/MCP/MCPToolUpdateClassSlotName.class.st | 3 +-- src/MCP/MCPToolUpdateClassSlots.class.st | 3 +-- src/MCP/MCPToolUpdateClassSuperclass.class.st | 3 +-- src/MCP/MCPToolUpdateClassTraits.class.st | 3 +-- src/MCP/MCPToolUpdateMethodProtocol.class.st | 1 - src/MCP/MCPUpdateClassCommand.class.st | 20 +++++++++---------- src/MCP/MCPUpdateMethodCommand.class.st | 2 +- 15 files changed, 27 insertions(+), 41 deletions(-) diff --git a/src/MCP-Tests/MCPToolClassMutationTest.class.st b/src/MCP-Tests/MCPToolClassMutationTest.class.st index b01a8ca..1d3c1d0 100644 --- a/src/MCP-Tests/MCPToolClassMutationTest.class.st +++ b/src/MCP-Tests/MCPToolClassMutationTest.class.st @@ -273,9 +273,9 @@ MCPToolClassMutationTest >> testClassToolSchemasDeclareExpectedInputs [ self assert: MCPToolCreateClass new inputSchema required asSet equals: #( 'name' 'superclassName' 'packageName' ) asSet. self assert: renameProperties asArray equals: #( 'name' 'newName' ). self assert: MCPToolUpdateClassName new inputSchema required asSet equals: #( 'name' 'newName' ) asSet. - self assert: packageProperties asArray equals: #( 'className' 'packageName' 'tag' 'force' ). + self assert: packageProperties asArray equals: #( 'className' 'packageName' 'tag' ). self assert: MCPToolUpdateClassPackage new inputSchema required asSet equals: #( 'className' ) asSet. - self assert: slotProperties asArray equals: #( 'className' 'slotName' 'classSide' 'force' ). + self assert: slotProperties asArray equals: #( 'className' 'slotName' 'classSide' ). self assert: MCPToolAddClassSlot new inputSchema required asSet equals: #( 'className' 'slotName' ) asSet ] diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 1709d6d..90ebfb5 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -994,8 +994,7 @@ MCPToolContractsTest >> testClassMutationToolsHaveAccurateNamesAndRequiredArgume self assert: (slotsPropertyNames includes: 'slots'). self assert: (slotsPropertyNames includes: 'classSlots'). self deny: (slotToolPropertyNames includes: 'slotAction'). - self assert: (slotToolPropertyNames includes: 'classSide'). - self assert: (slotToolPropertyNames includes: 'force') + self assert: (slotToolPropertyNames includes: 'classSide') ] { #category : 'tests' } @@ -1010,12 +1009,11 @@ MCPToolContractsTest >> testClassPackageUpdateDescriptionMentionsRecategorizatio ] { #category : 'tests' } -MCPToolContractsTest >> testClassToolSchemaDescriptionsExplainRecategorizationForceAndReplacementSemantics [ +MCPToolContractsTest >> testClassToolSchemaDescriptionsExplainRecategorizationAndReplacementSemantics [ - | classSlotsDescription classTraitsDescription forceDescription layoutDescription packageDescription sharedPoolsDescription sharedVariablesDescription slotsDescription tagDescription traitsDescription | + | classSlotsDescription classTraitsDescription layoutDescription packageDescription sharedPoolsDescription sharedVariablesDescription slotsDescription tagDescription traitsDescription | packageDescription := (self inputPropertyNamed: 'packageName' inTool: MCPToolUpdateClassPackage new) description. tagDescription := (self inputPropertyNamed: 'tag' inTool: MCPToolUpdateClassPackage new) description. - forceDescription := (self inputPropertyNamed: 'force' inTool: MCPToolUpdateClassPackage new) description. slotsDescription := (self inputPropertyNamed: 'slots' inTool: MCPToolUpdateClassSlots new) description. classSlotsDescription := (self inputPropertyNamed: 'classSlots' inTool: MCPToolUpdateClassSlots new) description. traitsDescription := (self inputPropertyNamed: 'traits' inTool: MCPToolUpdateClassTraits new) description. @@ -1028,8 +1026,6 @@ MCPToolContractsTest >> testClassToolSchemaDescriptionsExplainRecategorizationFo self assert: (packageDescription includesSubstring: 'omit packageName'). self assert: (packageDescription includesSubstring: 'current package'). self assert: (tagDescription includesSubstring: 'recategorizes'). - self assert: (forceDescription includesSubstring: 'refactoring warnings'). - self assert: (forceDescription includesSubstring: 'stopping'). self assert: (slotsDescription includesSubstring: 'empty array'). self assert: (slotsDescription includesSubstring: 'classSlots'). self assert: (classSlotsDescription includesSubstring: 'empty array'). @@ -1656,7 +1652,7 @@ MCPToolContractsTest >> testMethodMutationToolsHaveAccurateNamesAndRequiredArgum assert: selectorPropertyNames asSet equals: #( 'argumentNames' 'argumentValueExpressions' 'className' 'classNames' 'classSide' 'force' 'hierarchyClassNames' 'newSelector' 'packageNames' 'permutation' 'selector' ) asSet. - self assert: protocolPropertyNames asSet equals: #( 'className' 'classSide' 'force' 'protocol' 'selector' ) asSet + self assert: protocolPropertyNames asSet equals: #( 'className' 'classSide' 'protocol' 'selector' ) asSet ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPToolMethodMutationTest.class.st b/src/MCP-Tests/MCPToolMethodMutationTest.class.st index be6465f..08a02e5 100644 --- a/src/MCP-Tests/MCPToolMethodMutationTest.class.st +++ b/src/MCP-Tests/MCPToolMethodMutationTest.class.st @@ -1015,7 +1015,7 @@ MCPToolMethodMutationTest >> testMethodToolSchemasDeclareExpectedInputs [ assert: selectorPropertyNames asArray equals: #( 'className' 'classSide' 'force' 'selector' 'newSelector' 'permutation' 'argumentNames' 'argumentValueExpressions' 'packageNames' 'classNames' 'hierarchyClassNames' ). - self assert: protocolPropertyNames asArray equals: #( 'className' 'classSide' 'force' 'selector' 'protocol' ). + self assert: protocolPropertyNames asArray equals: #( 'className' 'classSide' 'selector' 'protocol' ). self assert: MCPToolCompileMethod new inputSchema required asSet equals: #( 'className' 'source' 'protocol' ) asSet. self assert: MCPToolUpdateMethodSelector new inputSchema required asSet equals: #( 'className' 'selector' 'newSelector' ) asSet. self assert: MCPToolUpdateMethodProtocol new inputSchema required asSet equals: #( 'className' 'selector' 'protocol' ) asSet. diff --git a/src/MCP/MCPToolAddClassSlot.class.st b/src/MCP/MCPToolAddClassSlot.class.st index 39650f3..c344007 100644 --- a/src/MCP/MCPToolAddClassSlot.class.st +++ b/src/MCP/MCPToolAddClassSlot.class.st @@ -25,7 +25,6 @@ MCPToolAddClassSlot >> classToolSpec [ (#inputProperties -> { self classNameSchemaProperty. self slotNameSchemaProperty. - self classSideSlotSchemaProperty. - self forceSchemaProperty }). + self classSideSlotSchemaProperty }). (#requiredProperties -> #( 'className' 'slotName' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassPackage.class.st b/src/MCP/MCPToolUpdateClassPackage.class.st index 5cfb6d8..f6b0d89 100644 --- a/src/MCP/MCPToolUpdateClassPackage.class.st +++ b/src/MCP/MCPToolUpdateClassPackage.class.st @@ -26,8 +26,7 @@ MCPToolUpdateClassPackage >> classToolSpec [ (#inputProperties -> { self classNameSchemaProperty. self packageNameSchemaProperty. - self tagSchemaProperty. - self forceSchemaProperty }). + self tagSchemaProperty }). (#requiredProperties -> #( 'className' )). (#atLeastOneProperties -> #( 'packageName' 'tag' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSharedPools.class.st b/src/MCP/MCPToolUpdateClassSharedPools.class.st index 633a909..b386206 100644 --- a/src/MCP/MCPToolUpdateClassSharedPools.class.st +++ b/src/MCP/MCPToolUpdateClassSharedPools.class.st @@ -29,7 +29,6 @@ MCPToolUpdateClassSharedPools >> classToolSpec [ (#description -> 'Replace the shared pools referenced by one class.'). (#inputProperties -> { self classNameSchemaProperty. - self sharedPoolsSchemaProperty. - self forceSchemaProperty }). + self sharedPoolsSchemaProperty }). (#requiredProperties -> #( 'className' 'sharedPools' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSharedVariables.class.st b/src/MCP/MCPToolUpdateClassSharedVariables.class.st index eb00043..2dfe934 100644 --- a/src/MCP/MCPToolUpdateClassSharedVariables.class.st +++ b/src/MCP/MCPToolUpdateClassSharedVariables.class.st @@ -29,7 +29,6 @@ MCPToolUpdateClassSharedVariables >> classToolSpec [ (#description -> 'Replace the class variables of one class.'). (#inputProperties -> { self classNameSchemaProperty. - self sharedVariablesSchemaProperty. - self forceSchemaProperty }). + self sharedVariablesSchemaProperty }). (#requiredProperties -> #( 'className' 'sharedVariables' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSideTraits.class.st b/src/MCP/MCPToolUpdateClassSideTraits.class.st index fcde8e3..20b6370 100644 --- a/src/MCP/MCPToolUpdateClassSideTraits.class.st +++ b/src/MCP/MCPToolUpdateClassSideTraits.class.st @@ -29,7 +29,6 @@ MCPToolUpdateClassSideTraits >> classToolSpec [ (#description -> 'Replace the class-side trait composition of one class.'). (#inputProperties -> { self classNameSchemaProperty. - self classTraitsSchemaProperty. - self forceSchemaProperty }). + self classTraitsSchemaProperty }). (#requiredProperties -> #( 'className' 'classTraits' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSlotName.class.st b/src/MCP/MCPToolUpdateClassSlotName.class.st index 2527e01..ea9eb1b 100644 --- a/src/MCP/MCPToolUpdateClassSlotName.class.st +++ b/src/MCP/MCPToolUpdateClassSlotName.class.st @@ -26,7 +26,6 @@ MCPToolUpdateClassSlotName >> classToolSpec [ self classNameSchemaProperty. self slotNameSchemaProperty. self newSlotNameSchemaProperty. - self classSideSlotSchemaProperty. - self forceSchemaProperty }). + self classSideSlotSchemaProperty }). (#requiredProperties -> #( 'className' 'slotName' 'newSlotName' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSlots.class.st b/src/MCP/MCPToolUpdateClassSlots.class.st index 7fc5bb6..6d2bd17 100644 --- a/src/MCP/MCPToolUpdateClassSlots.class.st +++ b/src/MCP/MCPToolUpdateClassSlots.class.st @@ -24,8 +24,7 @@ MCPToolUpdateClassSlots >> classToolSpec [ (#inputProperties -> { self classNameSchemaProperty. self slotsSchemaProperty. - self classSlotsSchemaProperty. - self forceSchemaProperty }). + self classSlotsSchemaProperty }). (#requiredProperties -> #( 'className' )). (#atLeastOneProperties -> #( 'slots' 'classSlots' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSuperclass.class.st b/src/MCP/MCPToolUpdateClassSuperclass.class.st index a9cea7f..9deb4dc 100644 --- a/src/MCP/MCPToolUpdateClassSuperclass.class.st +++ b/src/MCP/MCPToolUpdateClassSuperclass.class.st @@ -23,7 +23,6 @@ MCPToolUpdateClassSuperclass >> classToolSpec [ (#description -> 'Change the superclass of one class.'). (#inputProperties -> { self classNameSchemaProperty. - self superclassNameSchemaProperty. - self forceSchemaProperty }). + self superclassNameSchemaProperty }). (#requiredProperties -> #( 'className' 'superclassName' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassTraits.class.st b/src/MCP/MCPToolUpdateClassTraits.class.st index be6a268..fb1bb5b 100644 --- a/src/MCP/MCPToolUpdateClassTraits.class.st +++ b/src/MCP/MCPToolUpdateClassTraits.class.st @@ -29,7 +29,6 @@ MCPToolUpdateClassTraits >> classToolSpec [ (#description -> 'Replace the instance-side trait composition of one class.'). (#inputProperties -> { self classNameSchemaProperty. - self traitsSchemaProperty. - self forceSchemaProperty }). + self traitsSchemaProperty }). (#requiredProperties -> #( 'className' 'traits' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateMethodProtocol.class.st b/src/MCP/MCPToolUpdateMethodProtocol.class.st index 7d8fa0c..e3a436d 100644 --- a/src/MCP/MCPToolUpdateMethodProtocol.class.st +++ b/src/MCP/MCPToolUpdateMethodProtocol.class.st @@ -34,7 +34,6 @@ MCPToolUpdateMethodProtocol >> methodToolSpec [ description: 'Whether the target method is on the class side.'; default: false; yourself). - self forceSchemaProperty. (MCPStructureProperties new name: 'selector'; type: 'string'; diff --git a/src/MCP/MCPUpdateClassCommand.class.st b/src/MCP/MCPUpdateClassCommand.class.st index 1a3551e..f2e637b 100644 --- a/src/MCP/MCPUpdateClassCommand.class.st +++ b/src/MCP/MCPUpdateClassCommand.class.st @@ -49,7 +49,7 @@ MCPUpdateClassCommand >> executeAddSlotWithPlan: plan [ | result | ^ self tool executeMutationAction: 'addSlot' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ result := (MCPAddSlotCommand @@ -127,7 +127,7 @@ MCPUpdateClassCommand >> executeMoveWithPlan: plan [ packageName := self movePackageName. ^ self tool executeMutationAction: 'move' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ result := (MCPMoveClassCommand className: self classRequest className packageName: packageName tag: self classRequest tag) @@ -207,7 +207,7 @@ MCPUpdateClassCommand >> executeRenameSlotWithPlan: plan [ | result | ^ self tool executeMutationAction: 'renameSlot' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ result := (MCPRenameSlotCommand @@ -258,7 +258,7 @@ MCPUpdateClassCommand >> executeReparentWithPlan: plan [ | result | ^ self tool executeMutationAction: 'reparent' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ result := (MCPReparentClassCommand className: self classRequest className superclassName: self classRequest superclassName) @@ -282,7 +282,7 @@ MCPUpdateClassCommand >> executeReplaceClassTraitsWithPlan: plan [ | result | ^ self tool executeMutationAction: 'replaceClassTraits' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ result := (MCPReplaceClassSideTraitsCommand @@ -310,7 +310,7 @@ MCPUpdateClassCommand >> executeReplaceDefinitionWithPlan: plan [ replaceClassSlots: (self classRequest hasSuppliedPropertyNamed: 'classSlots'). ^ self tool executeMutationAction: 'replaceDefinition' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ result := command execute ] successResult: [ :warningMessages | @@ -327,7 +327,7 @@ MCPUpdateClassCommand >> executeReplaceLayoutWithPlan: plan [ | result | ^ self tool executeMutationAction: 'replaceLayout' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ result := (MCPReplaceClassLayoutCommand className: self classRequest className layout: self classRequest layout) execute ] @@ -345,7 +345,7 @@ MCPUpdateClassCommand >> executeReplaceSharedPoolsWithPlan: plan [ | result | ^ self tool executeMutationAction: 'replaceSharedPools' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ result := (MCPReplaceClassSharedPoolsCommand @@ -366,7 +366,7 @@ MCPUpdateClassCommand >> executeReplaceSharedVariablesWithPlan: plan [ | result | ^ self tool executeMutationAction: 'replaceSharedVariables' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ result := (MCPReplaceClassSharedVariablesCommand @@ -387,7 +387,7 @@ MCPUpdateClassCommand >> executeReplaceTraitsWithPlan: plan [ | result | ^ self tool executeMutationAction: 'replaceTraits' - force: self classRequest force + force: false requestedContext: plan requestedContext work: [ result := (MCPReplaceClassTraitsCommand className: self classRequest className traitNames: self classRequest traits) execute ] diff --git a/src/MCP/MCPUpdateMethodCommand.class.st b/src/MCP/MCPUpdateMethodCommand.class.st index b6b2ff2..4889921 100644 --- a/src/MCP/MCPUpdateMethodCommand.class.st +++ b/src/MCP/MCPUpdateMethodCommand.class.st @@ -93,7 +93,7 @@ MCPUpdateMethodCommand >> executeChangeProtocolWithPlan: plan [ selectorSymbol := self request selector asSymbol. ^ self tool executeMutationAction: 'changeProtocol' - force: self request force + force: false requestedContext: plan requestedContext work: [ behavior := self tool behaviorNamed: self request className classSide: self request classSide. From 63cd137cd6a1652e6f4966dda0d36e60741ca616 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Fri, 28 Aug 2026 21:29:03 +0200 Subject: [PATCH 05/17] Guide class create when class exists --- src/MCP-Tests/MCPCommandErrorTest.class.st | 4 +++- src/MCP-Tests/MCPCreateClassCommandTest.class.st | 3 ++- src/MCP-Tests/MCPToolClassMutationTest.class.st | 4 +++- src/MCP/MCPCommandError.class.st | 10 ++++++++-- 4 files changed, 16 insertions(+), 5 deletions(-) diff --git a/src/MCP-Tests/MCPCommandErrorTest.class.st b/src/MCP-Tests/MCPCommandErrorTest.class.st index d885a85..2dc19f3 100644 --- a/src/MCP-Tests/MCPCommandErrorTest.class.st +++ b/src/MCP-Tests/MCPCommandErrorTest.class.st @@ -27,7 +27,9 @@ MCPCommandErrorTest >> testClassAlreadyExistsErrorCarriesClassName [ details := error structuredDetails. self assert: error errorCode equals: #ClassAlreadyExists. self assert: (details at: #className) equals: 'MCPCommandErrorTestExisting'. - self assert: (details at: #message) equals: 'Class MCPCommandErrorTestExisting already exists.' + self assert: (details at: #message) equals: 'Class MCPCommandErrorTestExisting already exists.'. + self assert: ((details at: #guidance) includesSubstring: 'Use class_get'). + self assert: ((details at: #guidance) includesSubstring: 'Do not use class_create') ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPCreateClassCommandTest.class.st b/src/MCP-Tests/MCPCreateClassCommandTest.class.st index 2a1bd72..870c363 100644 --- a/src/MCP-Tests/MCPCreateClassCommandTest.class.st +++ b/src/MCP-Tests/MCPCreateClassCommandTest.class.st @@ -133,7 +133,8 @@ MCPCreateClassCommandTest >> testExistingClassSignalsCommandError [ slots: nil classSlots: nil) execute ]. self assert: error errorCode equals: #ClassAlreadyExists. - self assert: (error structuredDetails at: #className) equals: 'MCPCreateClassCommandTestGenerated' + self assert: (error structuredDetails at: #className) equals: 'MCPCreateClassCommandTestGenerated'. + self assert: ((error structuredDetails at: #guidance) includesSubstring: 'Use class_get') ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPToolClassMutationTest.class.st b/src/MCP-Tests/MCPToolClassMutationTest.class.st index 1d3c1d0..932554c 100644 --- a/src/MCP-Tests/MCPToolClassMutationTest.class.st +++ b/src/MCP-Tests/MCPToolClassMutationTest.class.st @@ -385,7 +385,9 @@ MCPToolClassMutationTest >> testCreateReturnsStructuredErrorWhenClassAlreadyExis self assert: (error at: #action) equals: 'create'. self assert: (error at: #errorClass) equals: 'MCPCommandError'. self assert: (error at: #errorCode) equals: 'ClassAlreadyExists'. - self assert: (error at: #message) equals: 'Class MCPToolClassMutationTestGenerated already exists.' + self assert: (error at: #message) equals: 'Class MCPToolClassMutationTestGenerated already exists.'. + self assert: ((error at: #guidance) includesSubstring: 'Use class_get'). + self assert: ((error at: #guidance) includesSubstring: 'Do not use class_create') ] { #category : 'tests - create' } diff --git a/src/MCP/MCPCommandError.class.st b/src/MCP/MCPCommandError.class.st index c0bf7bd..45991da 100644 --- a/src/MCP/MCPCommandError.class.st +++ b/src/MCP/MCPCommandError.class.st @@ -65,9 +65,15 @@ MCPCommandError class >> messageForMissingKind: kind name: missingName scopeName { #category : 'signaling' } MCPCommandError class >> signalClassAlreadyExistsNamed: aClassName [ - | message | + | details message | message := 'Class ' , aClassName , ' already exists.'. - ^ self signalErrorCode: #ClassAlreadyExists message: message details: { (#className -> aClassName) } asDictionary + details := { + (#className -> aClassName). + (#guidance + -> + 'Use class_get to inspect the existing class, or use the class update tools to modify it. Do not use class_create for existing classes.') } + asDictionary. + ^ self signalErrorCode: #ClassAlreadyExists message: message details: details ] { #category : 'signaling' } From 8efce243d1430d309667482352b90428cfe86dd0 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Fri, 28 Aug 2026 21:36:59 +0200 Subject: [PATCH 06/17] Clarify search pagination output --- .../MCPToolMethodSearchTest.class.st | 7 ++- .../MCPToolSearchClassesTest.class.st | 9 ++- .../MCPToolSearchPackagesTest.class.st | 10 +++- src/MCP/MCPPaginationResult.class.st | 55 ++++++++++++++++++- src/MCP/MCPToolSearch.class.st | 39 +++++++++++-- src/MCP/MCPToolSearchClasses.class.st | 1 + 6 files changed, 111 insertions(+), 10 deletions(-) diff --git a/src/MCP-Tests/MCPToolMethodSearchTest.class.st b/src/MCP-Tests/MCPToolMethodSearchTest.class.st index ad694fd..312265f 100644 --- a/src/MCP-Tests/MCPToolMethodSearchTest.class.st +++ b/src/MCP-Tests/MCPToolMethodSearchTest.class.st @@ -49,7 +49,7 @@ MCPToolMethodSearchTest >> testCanFilterAcrossExplicitProtocolTarget [ { #category : 'tests' } MCPToolMethodSearchTest >> testCanFilterPaginateAndIncludeSource [ - | data result | + | data pagination result summary | result := self callToolWith: { (self searchScope: { (#classes -> { self targetClassName }) }). (#side -> 'class'). @@ -58,9 +58,14 @@ MCPToolMethodSearchTest >> testCanFilterPaginateAndIncludeSource [ (#includeSource -> true). (#limit -> 1) } asDictionary. data := self dataFrom: result. + pagination := data at: #pagination. + summary := self summaryFrom: result. self deny: (result at: #isError ifAbsent: [ false ]). self assert: (data at: #methods) size equals: 1. self assert: (data at: #nextOffset) equals: 1. + self assert: (pagination at: #returnedCount) equals: 1. + self assert: (pagination at: #truncated). + self assert: (summary includesSubstring: 'use offset 1 and limit 1'). self assert: ((data at: #methods) allSatisfy: [ :each | each at: #classSide ]). self assert: ((data at: #methods) allSatisfy: [ :each | (each at: #protocol) includesSubstring: 'meta' ]). self assert: ((data at: #methods) allSatisfy: [ :each | each includesKey: #source ]). diff --git a/src/MCP-Tests/MCPToolSearchClassesTest.class.st b/src/MCP-Tests/MCPToolSearchClassesTest.class.st index b2acf41..4fc64e2 100644 --- a/src/MCP-Tests/MCPToolSearchClassesTest.class.st +++ b/src/MCP-Tests/MCPToolSearchClassesTest.class.st @@ -218,17 +218,24 @@ MCPToolSearchClassesTest >> testHierarchyClassNamesSelectHierarchyScope [ { #category : 'tests' } MCPToolSearchClassesTest >> testImageScopeCanFilterAndPaginate [ - | classNames data result | + | classNames data pagination result summary | result := self callToolWith: { (#className -> self fixturePrefix). (#filterMode -> 'prefix'). (#limit -> 2). (#offset -> 1) } asDictionary. data := self dataFrom: result. + pagination := data at: #pagination. + summary := self summaryFrom: result. classNames := (data at: #classes) collect: [ :each | each at: #className ]. self deny: (result at: #isError ifAbsent: [ false ]). self assert: classNames size equals: 2. self deny: (data includesKey: #nextOffset). + self assert: (pagination at: #returnedCount) equals: 2. + self assert: (pagination at: #totalCount) equals: 3. + self deny: (pagination at: #truncated). + self deny: (pagination includesKey: #nextOffset). + self assert: (summary includesSubstring: 'Showing 2 of 3 classes'). self assert: classNames equals: { self childClassName. self grandchildClassName } asArray diff --git a/src/MCP-Tests/MCPToolSearchPackagesTest.class.st b/src/MCP-Tests/MCPToolSearchPackagesTest.class.st index deff740..3b1f808 100644 --- a/src/MCP-Tests/MCPToolSearchPackagesTest.class.st +++ b/src/MCP-Tests/MCPToolSearchPackagesTest.class.st @@ -66,13 +66,15 @@ MCPToolSearchPackagesTest >> testImageScopeCanFilterPackagesByTagTarget [ { #category : 'tests' } MCPToolSearchPackagesTest >> testImageScopeCanPaginateFilteredPackages [ - | data expected packageNames result | + | data expected packageNames pagination result summary | result := self callToolWith: { (#packageName -> 'MCP-'). (#filterMode -> 'prefix'). (#limit -> 2). (#offset -> 1) } asDictionary. data := self dataFrom: result. + pagination := data at: #pagination. + summary := self summaryFrom: result. packageNames := (data at: #packages) collect: [ :each | each at: #packageName ]. expected := (PackageOrganizer default packages select: [ :each | each name asString beginsWith: 'MCP-' ] @@ -80,6 +82,12 @@ MCPToolSearchPackagesTest >> testImageScopeCanPaginateFilteredPackages [ self deny: (result at: #isError ifAbsent: [ false ]). self assert: packageNames size equals: 2. self assert: (data at: #nextOffset) equals: 3. + self assert: (pagination at: #returnedCount) equals: 2. + self assert: (pagination at: #totalCount) equals: expected size. + self assert: (pagination at: #truncated). + self assert: (pagination at: #nextOffset) equals: 3. + self assert: (summary includesSubstring: 'Showing 2 of '). + self assert: (summary includesSubstring: 'use offset 3 and limit 2'). self assert: packageNames equals: (expected copyFrom: 2 to: 3) asArray ] diff --git a/src/MCP/MCPPaginationResult.class.st b/src/MCP/MCPPaginationResult.class.st index b5fc8a3..896dd83 100644 --- a/src/MCP/MCPPaginationResult.class.st +++ b/src/MCP/MCPPaginationResult.class.st @@ -6,7 +6,8 @@ Class { #superclass : 'MCPResult', #instVars : [ 'entries', - 'nextOffset' + 'nextOffset', + 'totalCount' ], #category : 'MCP-Results', #package : 'MCP', @@ -16,9 +17,16 @@ Class { { #category : 'instance creation' } MCPPaginationResult class >> entries: entryCollection nextOffset: anIntegerOrNil [ + ^ self entries: entryCollection nextOffset: anIntegerOrNil totalCount: entryCollection size +] + +{ #category : 'instance creation' } +MCPPaginationResult class >> entries: entryCollection nextOffset: anIntegerOrNil totalCount: totalCountInteger [ + ^ self new entries: entryCollection; nextOffset: anIntegerOrNil; + totalCount: totalCountInteger; yourself ] @@ -26,11 +34,15 @@ MCPPaginationResult class >> entries: entryCollection nextOffset: anIntegerOrNil MCPPaginationResult class >> fromEntries: entryCollection limit: limit offset: offset [ | endIndex pageEntries startIndex | - (limit = 0 or: [ offset >= entryCollection size ]) ifTrue: [ ^ self entries: #( ) nextOffset: nil ]. + (limit = 0 or: [ offset >= entryCollection size ]) ifTrue: [ + ^ self entries: #( ) nextOffset: nil totalCount: entryCollection size ]. startIndex := offset + 1. endIndex := entryCollection size min: offset + limit. pageEntries := (entryCollection copyFrom: startIndex to: endIndex) asArray. - ^ self entries: pageEntries nextOffset: (offset + pageEntries size < entryCollection size ifTrue: [ offset + pageEntries size ]) + ^ self + entries: pageEntries + nextOffset: (offset + pageEntries size < entryCollection size ifTrue: [ offset + pageEntries size ]) + totalCount: entryCollection size ] { #category : 'converting' } @@ -45,6 +57,7 @@ MCPPaginationResult >> asDictionaryWithEntriesKey: entriesKey [ | data | data := Dictionary new. data at: entriesKey put: self entries. + data at: #pagination put: self paginationDictionary. self nextOffset ifNotNil: [ :offset | data at: #nextOffset put: offset ]. ^ data ] @@ -61,6 +74,12 @@ MCPPaginationResult >> entries: aCollection [ entries := aCollection ifNil: [ #( ) ] ] +{ #category : 'testing' } +MCPPaginationResult >> hasMore [ + + ^ self nextOffset notNil +] + { #category : 'accessing' } MCPPaginationResult >> nextOffset [ @@ -73,8 +92,38 @@ MCPPaginationResult >> nextOffset: anIntegerOrNil [ nextOffset := anIntegerOrNil ] +{ #category : 'converting' } +MCPPaginationResult >> paginationDictionary [ + + | data | + data := Dictionary new. + data at: #returnedCount put: self returnedCount. + data at: #totalCount put: self totalCount. + data at: #truncated put: self truncated. + self nextOffset ifNotNil: [ :offset | data at: #nextOffset put: offset ]. + ^ data +] + { #category : 'accessing' } MCPPaginationResult >> returnedCount [ ^ self entries size ] + +{ #category : 'accessing' } +MCPPaginationResult >> totalCount [ + + ^ totalCount ifNil: [ self returnedCount ] +] + +{ #category : 'accessing' } +MCPPaginationResult >> totalCount: anInteger [ + + totalCount := anInteger +] + +{ #category : 'accessing' } +MCPPaginationResult >> truncated [ + + ^ self hasMore +] diff --git a/src/MCP/MCPToolSearch.class.st b/src/MCP/MCPToolSearch.class.st index 8fc13f9..0f15179 100644 --- a/src/MCP/MCPToolSearch.class.st +++ b/src/MCP/MCPToolSearch.class.st @@ -277,10 +277,13 @@ MCPToolSearch >> minimalPagedQueryOutputSchemaForEntriesPropertyNamed: entriesPr ^ self standardOutputSchemaForDataProperties: { entriesProperty. + self paginationOutputSchemaProperty. (self integerSchemaPropertyNamed: 'nextOffset' description: 'Zero-based offset for the next page. Omitted when this is the final page.') } - required: { entriesPropertyName } + required: { + entriesPropertyName. + 'pagination' } ] { #category : 'private - filtering' } @@ -347,6 +350,28 @@ MCPToolSearch >> paginationInputPropertiesWithLimitDescription: limitDescription offsetProperty } ] +{ #category : 'private - schema' } +MCPToolSearch >> paginationOutputSchemaProperty [ + + | nextOffsetProperty property returnedCountProperty totalCountProperty truncatedProperty | + returnedCountProperty := self integerSchemaPropertyNamed: 'returnedCount' description: 'Entries returned in this page.'. + totalCountProperty := self integerSchemaPropertyNamed: 'totalCount' description: 'Total matching entries before pagination.'. + truncatedProperty := self booleanSchemaPropertyNamed: 'truncated' description: 'Whether more entries are available.'. + nextOffsetProperty := self + integerSchemaPropertyNamed: 'nextOffset' + description: 'Zero-based offset for the next page. Omitted when this is the final page.'. + property := self schemaPropertyNamed: 'pagination' type: 'object' description: 'Pagination metadata for this result page.'. + property + properties: { + returnedCountProperty. + totalCountProperty. + truncatedProperty. + nextOffsetProperty }; + required: #( 'returnedCount' 'totalCount' 'truncated' ); + additionalProperties: false. + ^ property +] + { #category : 'private - request' } MCPToolSearch >> parsedRequestFromToolRequest: request [ @@ -452,16 +477,22 @@ MCPToolSearch >> scopeQuerySuccessSummaryFor: resultKind scope: scopeSummary pag ^ String streamContents: [ :stream | stream + nextPutAll: 'Showing '; print: page returnedCount; + nextPutAll: ' of '; + print: page totalCount; space; nextPutAll: resultKind; - nextPutAll: ' found [scope='; + nextPutAll: ' [scope='; nextPutAll: scopeSummary; nextPutAll: ']'. page nextOffset ifNotNil: [ :offset | stream - nextPutAll: ' More available at offset '; - print: offset ]. + nextPutAll: '. More available: use offset '; + print: offset; + nextPutAll: ' and limit '; + print: page returnedCount; + nextPutAll: ', or narrow the scope/filter' ]. stream nextPut: $. ] ] diff --git a/src/MCP/MCPToolSearchClasses.class.st b/src/MCP/MCPToolSearchClasses.class.st index 7d8dcb1..f13aef3 100644 --- a/src/MCP/MCPToolSearchClasses.class.st +++ b/src/MCP/MCPToolSearchClasses.class.st @@ -151,6 +151,7 @@ MCPToolSearchClasses >> queryResultDataForQueryRequest: queryRequest page: page | data | data := Dictionary new. data at: #classes put: (page entries collect: [ :each | self queryResultEntryFromClassEntry: each ] as: Array). + data at: #pagination put: page paginationDictionary. page nextOffset ifNotNil: [ :offset | data at: #nextOffset put: offset ]. ^ data ] From 79fc5e59776b72d4883bd420f9aff86b6a854ad1 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Sat, 29 Aug 2026 09:23:51 +0200 Subject: [PATCH 07/17] Suggest exact matches for missing methods --- src/MCP-Tests/MCPCommandErrorTest.class.st | 55 ++++++++++++- src/MCP-Tests/MCPToolGetMethodTest.class.st | 33 ++++++++ src/MCP/MCPCommandError.class.st | 91 +++++++++++++++++++-- src/MCP/TMCPMethodTool.trait.st | 10 ++- 4 files changed, 176 insertions(+), 13 deletions(-) diff --git a/src/MCP-Tests/MCPCommandErrorTest.class.st b/src/MCP-Tests/MCPCommandErrorTest.class.st index 2dc19f3..338a2a3 100644 --- a/src/MCP-Tests/MCPCommandErrorTest.class.st +++ b/src/MCP-Tests/MCPCommandErrorTest.class.st @@ -54,17 +54,66 @@ MCPCommandErrorTest >> testMissingMethodErrorCarriesClassSideAndSelector [ | details error | error := self capture: [ - MCPCommandError signalMissingMethodInClassName: 'MCPCommandErrorTestTarget' classSide: true selector: 'value' ]. + MCPCommandError + signalMissingMethodInClassName: 'MCPToolGetMethodTestTarget' + classSide: true + selector: 'mcpDefinitelyMissingSelectorForErrorTest' ]. details := error structuredDetails. self assert: error errorCode equals: #MethodNotFound. self assert: (details at: #errorClass) equals: 'MCPCommandError'. self assert: (details at: #errorCode) equals: 'MethodNotFound'. - self assert: (details at: #className) equals: 'MCPCommandErrorTestTarget'. + self assert: (details at: #className) equals: 'MCPToolGetMethodTestTarget'. self assert: (details at: #classSide). - self assert: (details at: #selector) equals: 'value'. + self assert: (details at: #selector) equals: 'mcpDefinitelyMissingSelectorForErrorTest'. self assert: details keys asSet equals: #( errorClass errorCode message className classSide selector ) asSet ] +{ #category : 'tests' } +MCPCommandErrorTest >> testMissingMethodErrorForMissingClassHasNoSuggestions [ + + | details error | + error := self capture: [ + MCPCommandError signalMissingMethodInClassName: 'MCPCommandErrorTestMissingClass' classSide: false selector: 'value' ]. + details := error structuredDetails. + self assert: error errorCode equals: #ClassNotFound. + self assert: (details at: #className) equals: 'MCPCommandErrorTestMissingClass'. + self assert: (details at: #selector) equals: 'value'. + self deny: (details includesKey: #suggestions). + self assert: ((details at: #message) includesSubstring: 'Class MCPCommandErrorTestMissingClass does not exist') +] + +{ #category : 'tests' } +MCPCommandErrorTest >> testMissingMethodErrorSuggestsFirstExactSuperclassMatch [ + + | details error suggestions | + error := self capture: [ + MCPCommandError signalMissingMethodInClassName: 'MCPToolGetMethodTestTarget' classSide: false selector: 'yourself' ]. + details := error structuredDetails. + suggestions := details at: #suggestions. + self assert: error errorCode equals: #MethodNotFound. + self assert: suggestions size equals: 1. + self assert: (suggestions first at: #className) equals: 'Object'. + self deny: (suggestions first at: #classSide). + self assert: (suggestions first at: #selector) equals: 'yourself'. + self assert: ((details at: #message) includesSubstring: 'Exact matches: Object>>yourself') +] + +{ #category : 'tests' } +MCPCommandErrorTest >> testMissingMethodErrorSuggestsOnlyExactOppositeSideAndSuperclassMatches [ + + | details error suggestions | + error := self capture: [ + MCPCommandError signalMissingMethodInClassName: 'MCPToolGetMethodTestTarget' classSide: false selector: 'readClassSide' ]. + details := error structuredDetails. + suggestions := details at: #suggestions. + self assert: error errorCode equals: #MethodNotFound. + self assert: suggestions size equals: 1. + self assert: (suggestions first at: #className) equals: 'MCPToolGetMethodTestTarget'. + self assert: (suggestions first at: #classSide). + self assert: (suggestions first at: #selector) equals: 'readClassSide'. + self assert: ((details at: #message) includesSubstring: 'Exact matches: MCPToolGetMethodTestTarget class>>readClassSide') +] + { #category : 'tests' } MCPCommandErrorTest >> testMissingPackageErrorCarriesPackageName [ diff --git a/src/MCP-Tests/MCPToolGetMethodTest.class.st b/src/MCP-Tests/MCPToolGetMethodTest.class.st index 7ac9d52..a6830d0 100644 --- a/src/MCP-Tests/MCPToolGetMethodTest.class.st +++ b/src/MCP-Tests/MCPToolGetMethodTest.class.st @@ -9,6 +9,22 @@ Class { #tag : 'Tools' } +{ #category : 'tests' } +MCPToolGetMethodTest >> testGetMethodMissingClassHasNoMethodSuggestions [ + + | error result | + result := self callToolWith: { + (#className -> 'MCPToolGetMethodTestMissingClass'). + (#selector -> 'value') } asDictionary. + error := self errorFrom: result. + self assert: (result at: #isError). + self assert: (error at: #errorCode) equals: 'ClassNotFound'. + self assert: (error at: #className) equals: 'MCPToolGetMethodTestMissingClass'. + self assert: (error at: #selector) equals: 'value'. + self deny: (error includesKey: #suggestions). + self assert: ((error at: #message) includesSubstring: 'Class MCPToolGetMethodTestMissingClass does not exist') +] + { #category : 'tests' } MCPToolGetMethodTest >> testGetMethodReturnsInstanceSideVariableContext [ @@ -68,6 +84,23 @@ MCPToolGetMethodTest >> testGetMethodReturnsStructuredErrorForMissingSelector [ self assert: ((error at: #message) includesSubstring: 'Method MCPToolGetMethodTestTarget>>doesNotExist does not exist.') ] +{ #category : 'tests' } +MCPToolGetMethodTest >> testGetMethodSuggestsExactOppositeSideSelector [ + + | error result suggestions | + result := self callToolWith: { + (#className -> 'MCPToolGetMethodTestTarget'). + (#selector -> 'readClassSide') } asDictionary. + error := self errorFrom: result. + suggestions := error at: #suggestions. + self assert: (result at: #isError). + self assert: (error at: #errorCode) equals: 'MethodNotFound'. + self assert: suggestions size equals: 1. + self assert: (suggestions first at: #className) equals: 'MCPToolGetMethodTestTarget'. + self assert: (suggestions first at: #classSide). + self assert: (suggestions first at: #selector) equals: 'readClassSide' +] + { #category : 'tests' } MCPToolGetMethodTest >> testGetMethodSupportsClassSideContext [ diff --git a/src/MCP/MCPCommandError.class.st b/src/MCP/MCPCommandError.class.st index 45991da..9f096e8 100644 --- a/src/MCP/MCPCommandError.class.st +++ b/src/MCP/MCPCommandError.class.st @@ -62,6 +62,52 @@ MCPCommandError class >> messageForMissingKind: kind name: missingName scopeName stream nextPut: $. ] ] ] +{ #category : 'private - suggestions' } +MCPCommandError class >> methodReferenceForClassName: className selector: selectorString classSide: classSide [ + + ^ String streamContents: [ :stream | + stream nextPutAll: className. + classSide ifTrue: [ stream nextPutAll: ' class' ]. + stream + nextPutAll: '>>'; + nextPutAll: selectorString ] +] + +{ #category : 'private - suggestions' } +MCPCommandError class >> methodSuggestionForBehavior: aBehavior selector: aSelectorSymbol [ + + | protocolName | + protocolName := (aBehavior compiledMethodAt: aSelectorSymbol) protocol + ifNil: [ '' ] + ifNotNil: [ :protocol | protocol name asString ]. + ^ { + (#className -> aBehavior instanceSide name asString). + (#classSide -> aBehavior isClassSide). + (#selector -> aSelectorSymbol asString). + (#protocol -> protocolName) } asDictionary +] + +{ #category : 'private - suggestions' } +MCPCommandError class >> methodSuggestionsForClass: targetClass classSide: classSide selector: selectorSymbol [ + + ^ Array streamContents: [ :stream | + (self oppositeSideMethodSuggestionForClass: targetClass classSide: classSide selector: selectorSymbol) ifNotNil: [ + :suggestion | stream nextPut: suggestion ]. + (self superclassMethodSuggestionForClass: targetClass classSide: classSide selector: selectorSymbol) ifNotNil: [ :suggestion | + stream nextPut: suggestion ] ] +] + +{ #category : 'private - suggestions' } +MCPCommandError class >> oppositeSideMethodSuggestionForClass: targetClass classSide: classSide selector: selectorSymbol [ + + | oppositeBehavior | + oppositeBehavior := classSide + ifTrue: [ targetClass ] + ifFalse: [ targetClass classSide ]. + (oppositeBehavior includesSelector: selectorSymbol) ifFalse: [ ^ nil ]. + ^ self methodSuggestionForBehavior: oppositeBehavior selector: selectorSymbol +] + { #category : 'signaling' } MCPCommandError class >> signalClassAlreadyExistsNamed: aClassName [ @@ -121,14 +167,30 @@ MCPCommandError class >> signalMissingClassNamed: aClassName scopeName: scopeNam { #category : 'signaling' } MCPCommandError class >> signalMissingMethodInClassName: aClassName classSide: aBoolean selector: aSelectorString [ - | message | - message := 'Method ' , (aBoolean - ifTrue: [ aClassName , ' class>>' , aSelectorString ] - ifFalse: [ aClassName , '>>' , aSelectorString ]) , ' does not exist.'. - ^ self signalErrorCode: #MethodNotFound message: message details: { - (#className -> aClassName). - (#classSide -> aBoolean). - (#selector -> aSelectorString) } asDictionary + | details message selectorSymbol suggestions targetClass | + selectorSymbol := aSelectorString asSymbol. + targetClass := Smalltalk globals at: aClassName asSymbol ifAbsent: [ + message := 'Class ' , aClassName , ' does not exist; cannot look up method ' + , (self methodReferenceForClassName: aClassName selector: aSelectorString classSide: aBoolean) , '.'. + ^ self signalErrorCode: #ClassNotFound message: message details: { + (#className -> aClassName). + (#classSide -> aBoolean). + (#selector -> aSelectorString) } asDictionary ]. + suggestions := self methodSuggestionsForClass: targetClass classSide: aBoolean selector: selectorSymbol. + message := 'Method ' , (self methodReferenceForClassName: aClassName selector: aSelectorString classSide: aBoolean) + , ' does not exist.'. + suggestions ifNotEmpty: [ + message := message , ' Exact matches: ' , (', ' join: (suggestions collect: [ :each | + self + methodReferenceForClassName: (each at: #className) + selector: (each at: #selector) + classSide: (each at: #classSide) ])) , '.' ]. + details := { + (#className -> aClassName). + (#classSide -> aBoolean). + (#selector -> aSelectorString) } asDictionary. + suggestions ifNotEmpty: [ :matches | details at: #suggestions put: matches ]. + ^ self signalErrorCode: #MethodNotFound message: message details: details ] { #category : 'signaling' } @@ -218,6 +280,19 @@ MCPCommandError class >> signalMissingTag: aTag packageName: aPackageName forCla (#tag -> aTag) } asDictionary ] +{ #category : 'private - suggestions' } +MCPCommandError class >> superclassMethodSuggestionForClass: targetClass classSide: classSide selector: selectorSymbol [ + + | behavior | + behavior := classSide + ifTrue: [ targetClass classSide superclass ] + ifFalse: [ targetClass superclass ]. + [ behavior notNil ] whileTrue: [ + (behavior includesSelector: selectorSymbol) ifTrue: [ ^ self methodSuggestionForBehavior: behavior selector: selectorSymbol ]. + behavior := behavior superclass ]. + ^ nil +] + { #category : 'accessing' } MCPCommandError >> details [ diff --git a/src/MCP/TMCPMethodTool.trait.st b/src/MCP/TMCPMethodTool.trait.st index 459a873..168574e 100644 --- a/src/MCP/TMCPMethodTool.trait.st +++ b/src/MCP/TMCPMethodTool.trait.st @@ -32,9 +32,15 @@ TMCPMethodTool >> methodEntryLabel: anEntry [ { #category : 'private - methods' } TMCPMethodTool >> methodForClassNamed: className selector: selectorString classSide: classSide [ - | behavior selectorSymbol | - behavior := self behaviorNamed: className classSide: classSide. + | behavior selectorSymbol targetClass | selectorSymbol := selectorString asSymbol. + targetClass := self class environment + at: className asSymbol + ifAbsent: [ + MCPCommandError signalMissingMethodInClassName: className classSide: classSide selector: selectorString ]. + behavior := classSide + ifTrue: [ targetClass classSide ] + ifFalse: [ targetClass ]. (behavior includesSelector: selectorSymbol) ifFalse: [ MCPCommandError signalMissingMethodInClassName: className classSide: classSide selector: selectorString ]. ^ behavior compiledMethodAt: selectorSymbol From e2af1d61ad1f7bbee447d41db56c6d2a033668f1 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Sat, 29 Aug 2026 10:55:56 +0200 Subject: [PATCH 08/17] Clarify method metadata search schema --- src/MCP-Tests/MCPToolContractsTest.class.st | 21 +++-- src/MCP/MCPNoopObservabilityBackend.class.st | 87 ------------------- src/MCP/MCPToolMethodLookupOperation.class.st | 6 -- src/MCP/MCPToolSearch.class.st | 4 +- src/MCP/MCPToolSearchMethodMetadata.class.st | 14 ++- .../OCUndeclaredVariableWarning.extension.st | 6 -- src/MCP/TMCPMethodTool.trait.st | 2 +- 7 files changed, 21 insertions(+), 119 deletions(-) diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 90ebfb5..acb0a1c 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -1530,10 +1530,11 @@ MCPToolContractsTest >> testMethodMetadataSearchDescriptionPointsToSpecializedRe | description filterModeDescription filterModeProperty protocolDescription selectorDescription tool | tool := MCPToolSearchMethodMetadata new. description := tool description. - self assert: (description includesSubstring: 'source'). - self assert: (description includesSubstring: 'senders'). - self assert: (description includesSubstring: 'implementors'). - self assert: (description includesSubstring: 'references'). + self assert: (description includesSubstring: 'method_source_search'). + self assert: (description includesSubstring: 'method_sender_search'). + self assert: (description includesSubstring: 'method_implementor_search'). + self assert: (description includesSubstring: 'method_class_reference_search'). + self assert: (description includesSubstring: 'method_variable_reference_search'). selectorDescription := (self inputPropertyNamed: 'selector' inTool: tool) description. protocolDescription := (self inputPropertyNamed: 'protocol' inTool: tool) description. filterModeProperty := self inputPropertyNamed: 'filterMode' inTool: tool. @@ -1547,10 +1548,11 @@ MCPToolContractsTest >> testMethodMetadataSearchDescriptionPointsToSpecializedRe { #category : 'tests' } MCPToolContractsTest >> testMethodMetadataSearchHasAccurateNameAndSchema [ - | filterModeProperty propertyNames schema scopeProperty scopePropertyNames | + | filterModeProperty limitProperty propertyNames schema scopeProperty scopePropertyNames | schema := MCPToolSearchMethodMetadata new inputSchema. propertyNames := schema properties collect: [ :each | each name ]. filterModeProperty := schema properties detect: [ :each | each name = 'filterMode' ]. + limitProperty := schema properties detect: [ :each | each name = 'limit' ]. scopeProperty := schema properties detect: [ :each | each name = 'scope' ]. scopePropertyNames := (scopeProperty extraProperties at: #properties) collect: [ :each | each name ]. self assert: MCPToolSearchMethodMetadata new name equals: 'method_metadata_search'. @@ -1558,7 +1560,10 @@ MCPToolContractsTest >> testMethodMetadataSearchHasAccurateNameAndSchema [ self assert: propertyNames asSet equals: #( 'scope' 'selector' 'protocol' 'filterMode' 'side' 'includeSource' 'limit' 'offset' 'caseSensitive' ) asSet. - self assert: scopeProperty description equals: 'Optional search scope. If omitted, searches all matching entities.'. + self assert: scopeProperty description equals: 'Search scope. If omitted, searches all matching entities.'. + self + assert: limitProperty description + equals: 'Maximum matching methods to return. Use 0 to count matches without returning entries.'. self assert: (scopeProperty extraProperties at: #additionalProperties) equals: false. self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' 'hierarchies' ) asSet. self assert: (filterModeProperty extraProperties at: #enum) asArray equals: #( 'substring' 'prefix' 'exact' 'regex' ) @@ -1826,7 +1831,7 @@ MCPToolContractsTest >> testQueryScopeDescriptionsExplainScopeSemantics [ classScope := self inputPropertyNamed: 'scope' inTool: MCPToolSearchClasses new. methodScope := self inputPropertyNamed: 'scope' inTool: MCPToolSearchMethodMetadata new. scopePropertyNames := (classScope extraProperties at: #properties) collect: [ :each | each name ]. - self assert: classScope description equals: 'Optional search scope. If omitted, searches all matching entities.'. + self assert: classScope description equals: 'Search scope. If omitted, searches all matching entities.'. self assert: methodScope description equals: classScope description. self assert: (classScope extraProperties at: #additionalProperties) equals: false. self assert: (methodScope extraProperties at: #additionalProperties) equals: false. @@ -2243,7 +2248,7 @@ MCPToolContractsTest >> testSearchClassesHasAccurateNameAndSchema [ self assert: propertyNames asSet equals: #( 'scope' 'className' 'tag' 'instanceSlot' 'classSlot' 'filterMode' 'caseSensitive' 'limit' 'offset' ) asSet. - self assert: scopeProperty description equals: 'Optional search scope. If omitted, searches all matching entities.'. + self assert: scopeProperty description equals: 'Search scope. If omitted, searches all matching entities.'. self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' 'hierarchies' ) asSet ] diff --git a/src/MCP/MCPNoopObservabilityBackend.class.st b/src/MCP/MCPNoopObservabilityBackend.class.st index 15287b9..4ce4725 100644 --- a/src/MCP/MCPNoopObservabilityBackend.class.st +++ b/src/MCP/MCPNoopObservabilityBackend.class.st @@ -11,13 +11,6 @@ Class { #tag : 'Observability' } -{ #category : 'clearing' } -MCPNoopObservabilityBackend >> clear [ - "No-op backend has no state to clear." - - -] - { #category : 'activation' } MCPNoopObservabilityBackend >> disable [ "No-op backend stays disabled." @@ -45,31 +38,6 @@ MCPNoopObservabilityBackend >> enabled: aBoolean [ ] -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> exportDirectory [ - - ^ nil -] - -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> exportDirectory: aPath [ - "No-op backend does not export." - - -] - -{ #category : 'testing' } -MCPNoopObservabilityBackend >> exportEnabled [ - - ^ false -] - -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> exportInstanceDirectory [ - - ^ nil -] - { #category : 'actions' } MCPNoopObservabilityBackend >> forceFlush [ "No-op backend has nothing to flush." @@ -83,24 +51,6 @@ MCPNoopObservabilityBackend >> isNoop [ ^ true ] -{ #category : 'logging' } -MCPNoopObservabilityBackend >> logs [ - - ^ #( ) -] - -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> metrics [ - - ^ #( ) -] - -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> recentCallRecords [ - - ^ #( ) -] - { #category : 'recording' } MCPNoopObservabilityBackend >> recordSessionEndFor: anMCP [ "No-op backend has no session state." @@ -127,19 +77,6 @@ MCPNoopObservabilityBackend >> recordToolCallStart: aToolName input: inputObject ^ nil ] -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> resourceMetadata [ - - ^ Dictionary new -] - -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> resourceMetadata: aDictionary [ - "No-op backend does not keep resource metadata." - - -] - { #category : 'actions' } MCPNoopObservabilityBackend >> shutdown [ "No-op backend has nothing to shut down." @@ -152,27 +89,3 @@ MCPNoopObservabilityBackend >> statusText [ ^ 'Observability disabled' ] - -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> totalCallCount [ - - ^ 0 -] - -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> totalErrorCount [ - - ^ 0 -] - -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> totalOutputBudgetExceededCount [ - - ^ 0 -] - -{ #category : 'accessing' } -MCPNoopObservabilityBackend >> traceRecords [ - - ^ #( ) -] diff --git a/src/MCP/MCPToolMethodLookupOperation.class.st b/src/MCP/MCPToolMethodLookupOperation.class.st index 604457e..90cbf42 100644 --- a/src/MCP/MCPToolMethodLookupOperation.class.st +++ b/src/MCP/MCPToolMethodLookupOperation.class.st @@ -9,12 +9,6 @@ Class { #tag : 'Tools' } -{ #category : 'metadata' } -MCPToolMethodLookupOperation class >> groupName [ - - ^ self methodsGroupName -] - { #category : 'testing' } MCPToolMethodLookupOperation class >> isAbstract [ diff --git a/src/MCP/MCPToolSearch.class.st b/src/MCP/MCPToolSearch.class.st index 0f15179..42d2ae4 100644 --- a/src/MCP/MCPToolSearch.class.st +++ b/src/MCP/MCPToolSearch.class.st @@ -339,7 +339,7 @@ MCPToolSearch >> packageScopeSummaryForProjectNames: projectNames packageNames: MCPToolSearch >> paginationInputPropertiesWithLimitDescription: limitDescription [ | limitProperty offsetProperty | - limitProperty := self integerSchemaPropertyNamed: 'limit' description: 'Maximum results.' default: self defaultPageLimit. + limitProperty := self integerSchemaPropertyNamed: 'limit' description: limitDescription default: self defaultPageLimit. limitProperty minimum: 0; maximum: 100. @@ -535,7 +535,7 @@ MCPToolSearch >> searchScopeSchemaProperty [ ^ MCPStructureProperties new name: 'scope'; type: 'object'; - description: 'Optional search scope. If omitted, searches all matching entities.'; + description: 'Search scope. If omitted, searches all matching entities.'; properties: self searchScopeSchemaProperties; additionalProperties: false; yourself diff --git a/src/MCP/MCPToolSearchMethodMetadata.class.st b/src/MCP/MCPToolSearchMethodMetadata.class.st index 05cb52b..55c15ae 100644 --- a/src/MCP/MCPToolSearchMethodMetadata.class.st +++ b/src/MCP/MCPToolSearchMethodMetadata.class.st @@ -27,9 +27,8 @@ MCPToolSearchMethodMetadata >> buildInputSchema [ values: self supportedFilterModes). (self caseSensitiveSchemaPropertyWithDescription: 'Whether selector and protocol matching is case-sensitive.'). (self includeSourceSchemaPropertyWithDescription: 'Whether to include method source code in each result entry.') } - , - (self paginationInputPropertiesWithLimitDescription: - 'Maximum number of matching methods to return. Use 0 to return no entries.'). + , (self paginationInputPropertiesWithLimitDescription: + 'Maximum matching methods to return. Use 0 to count matches without returning entries.'). ^ self queryInputSchemaWithProperties: properties ] @@ -42,7 +41,7 @@ MCPToolSearchMethodMetadata >> defaultExposure [ { #category : 'metadata' } MCPToolSearchMethodMetadata >> description [ - ^ 'Search method metadata by selector, protocol, class, package, or scope. Use specialized method search tools for source, senders, implementors, and references.' + ^ 'Search methods by selector, protocol, class, package, or scope. Specialized method search tools are method_source_search, method_sender_search, method_implementor_search, method_class_reference_search, and method_variable_reference_search.' ] { #category : 'private - filtering' } @@ -63,11 +62,8 @@ MCPToolSearchMethodMetadata >> metadataFilterFieldNames [ MCPToolSearchMethodMetadata >> metadataFilterInputProperties [ ^ { - (self schemaPropertyNamed: 'selector' type: 'string' description: 'Optional selector text matched against method selectors.'). - (self - schemaPropertyNamed: 'protocol' - type: 'string' - description: 'Optional protocol/category text matched against method protocols.') } + (self schemaPropertyNamed: 'selector' type: 'string' description: 'Match method selectors.'). + (self schemaPropertyNamed: 'protocol' type: 'string' description: 'Match method protocols.') } ] { #category : 'private - template' } diff --git a/src/MCP/OCUndeclaredVariableWarning.extension.st b/src/MCP/OCUndeclaredVariableWarning.extension.st index b1138c2..7d5a67d 100644 --- a/src/MCP/OCUndeclaredVariableWarning.extension.st +++ b/src/MCP/OCUndeclaredVariableWarning.extension.st @@ -11,9 +11,3 @@ OCUndeclaredVariableWarning >> mcpMethodNode [ ^ self methodNode ] - -{ #category : '*MCP' } -OCUndeclaredVariableWarning >> mcpNoticeNode [ - - ^ PharoCompatibility undeclaredVariableNodeFromException: self -] diff --git a/src/MCP/TMCPMethodTool.trait.st b/src/MCP/TMCPMethodTool.trait.st index 168574e..d2a2b29 100644 --- a/src/MCP/TMCPMethodTool.trait.st +++ b/src/MCP/TMCPMethodTool.trait.st @@ -162,7 +162,7 @@ TMCPMethodTool >> searchScopeSchemaProperty [ ^ MCPStructureProperties new name: 'scope'; type: 'object'; - description: 'Optional search scope. If omitted, searches all matching entities.'; + description: 'Search scope. If omitted, searches all matching entities.'; properties: self searchScopeSchemaProperties; additionalProperties: false; yourself From f09111f70cfc4320aa288fdcbfe4055e6aaf0dfb Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Sat, 29 Aug 2026 19:22:23 +0200 Subject: [PATCH 09/17] Simplify search tool schemas --- .../MCPJSONSchemaValidatorTest.class.st | 2 +- src/MCP-Tests/MCPToolContractsTest.class.st | 8 +- .../MCPToolMethodLookupTest.class.st | 4 +- .../MCPToolMethodSearchTest.class.st | 94 ++++++++++--------- .../MCPToolRewriteMethodsTest.class.st | 2 +- .../MCPToolSearchClassesTest.class.st | 85 +++++++++-------- src/MCP/MCPTestCoverageRequest.class.st | 3 +- src/MCP/MCPToolRunCritiques.class.st | 1 - src/MCP/MCPToolSearch.class.st | 6 +- src/MCP/MCPToolSearchClasses.class.st | 13 +-- src/MCP/MCPToolSearchMethodSource.class.st | 6 ++ src/MCP/MCPToolSearchPackages.class.st | 12 +-- src/MCP/MCPToolSearchTools.class.st | 4 +- src/MCP/TMCPMethodTool.trait.st | 4 +- 14 files changed, 125 insertions(+), 119 deletions(-) diff --git a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st index 802ee5e..339f968 100644 --- a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st +++ b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st @@ -277,7 +277,7 @@ MCPJSONSchemaValidatorTest >> testCurrentToolInputSchemasAdvertiseGroupedSearchS self assert: (methodProperties collect: [ :each | each name ]) asSet equals: #( 'scope' 'selector' 'protocol' 'filterMode' 'side' 'includeSource' 'limit' 'offset' 'caseSensitive' ) asSet. - self assert: classScopeProperties asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' 'hierarchies' ) asSet. + self assert: classScopeProperties asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' ) asSet. self assert: methodScopeProperties asSet equals: classScopeProperties asSet ] diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index acb0a1c..ffc576e 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -1565,7 +1565,7 @@ MCPToolContractsTest >> testMethodMetadataSearchHasAccurateNameAndSchema [ assert: limitProperty description equals: 'Maximum matching methods to return. Use 0 to count matches without returning entries.'. self assert: (scopeProperty extraProperties at: #additionalProperties) equals: false. - self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' 'hierarchies' ) asSet. + self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' ) asSet. self assert: (filterModeProperty extraProperties at: #enum) asArray equals: #( 'substring' 'prefix' 'exact' 'regex' ) ] @@ -1835,7 +1835,7 @@ MCPToolContractsTest >> testQueryScopeDescriptionsExplainScopeSemantics [ self assert: methodScope description equals: classScope description. self assert: (classScope extraProperties at: #additionalProperties) equals: false. self assert: (methodScope extraProperties at: #additionalProperties) equals: false. - self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' 'hierarchies' ) asSet. + self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' ) asSet. self assert: ((classScope extraProperties at: #properties) allSatisfy: [ :each | each description isNil ]) ] @@ -2249,7 +2249,7 @@ MCPToolContractsTest >> testSearchClassesHasAccurateNameAndSchema [ assert: propertyNames asSet equals: #( 'scope' 'className' 'tag' 'instanceSlot' 'classSlot' 'filterMode' 'caseSensitive' 'limit' 'offset' ) asSet. self assert: scopeProperty description equals: 'Search scope. If omitted, searches all matching entities.'. - self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' 'hierarchies' ) asSet + self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' ) asSet ] { #category : 'tests' } @@ -2373,7 +2373,7 @@ MCPToolContractsTest >> testSearchToolSchemasAdvertiseGroupedScopeProperties [ scopePropertyNames := (scopeProperty extraProperties at: #properties) collect: [ :each | each name ]. self assert: (propertyNames includes: 'scope'). oldScopePropertyNames do: [ :each | self deny: (propertyNames includes: each) ]. - self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' 'hierarchies' ) asSet ] + self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' ) asSet ] ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPToolMethodLookupTest.class.st b/src/MCP-Tests/MCPToolMethodLookupTest.class.st index d4aa8dc..ad69612 100644 --- a/src/MCP-Tests/MCPToolMethodLookupTest.class.st +++ b/src/MCP-Tests/MCPToolMethodLookupTest.class.st @@ -163,14 +163,16 @@ MCPToolMethodLookupTest >> testSearchVariableReferencesReturnsVariableReferences { #category : 'tests' } MCPToolMethodLookupTest >> testSourceAndEquivalentSearchSchemasUseDedicatedInputs [ - | equivalentPropertyNames equivalentRequired equivalentSchema sourcePropertyNames sourceRequired sourceSchema | + | equivalentPropertyNames equivalentRequired equivalentSchema filterModeProperty sourcePropertyNames sourceRequired sourceSchema | sourceSchema := MCPToolSearchMethodSource new inputSchema. sourceRequired := sourceSchema required asArray. sourcePropertyNames := sourceSchema properties collect: [ :each | each name ]. + filterModeProperty := sourceSchema properties detect: [ :each | each name = 'filterMode' ]. self assert: sourceRequired equals: #( 'filter' ). self assert: sourcePropertyNames asSet equals: #( 'caseSensitive' 'scope' 'side' 'includeSource' 'filter' 'filterMode' 'limit' 'offset' ) asSet. + self assert: (filterModeProperty extraProperties at: #enum) asArray equals: #( 'substring' 'regex' ). equivalentSchema := MCPToolSearchEquivalentMethods new inputSchema. equivalentRequired := equivalentSchema required asArray. equivalentPropertyNames := equivalentSchema properties collect: [ :each | each name ]. diff --git a/src/MCP-Tests/MCPToolMethodSearchTest.class.st b/src/MCP-Tests/MCPToolMethodSearchTest.class.st index 312265f..9059fa5 100644 --- a/src/MCP-Tests/MCPToolMethodSearchTest.class.st +++ b/src/MCP-Tests/MCPToolMethodSearchTest.class.st @@ -428,36 +428,6 @@ MCPToolMethodSearchTest >> testExactEmptyFilterIsApplied [ self assert: (error at: #errorClass) equals: 'MCPInvalidToolInput' ] -{ #category : 'tests' } -MCPToolMethodSearchTest >> testHierarchyClassNamesReturnWholeHierarchy [ - - | data result | - result := self callToolWith: { - (self searchScope: { (#hierarchies -> #( 'MCPToolHierarchyTestMid' )) }). - (#side -> 'instance'). - (#selector -> 'hierarchyProbe') } asDictionary. - data := self dataFrom: result. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (data at: #methods) size equals: 2. - self entryForReference: 'MCPToolHierarchyTestBase>>hierarchyProbe' in: (data at: #methods). - self entryForReference: 'MCPToolHierarchyTestChild>>hierarchyProbe' in: (data at: #methods) -] - -{ #category : 'tests' } -MCPToolMethodSearchTest >> testHierarchyClassNamesSelectHierarchyScope [ - - | data result | - result := self callToolWith: { - (self searchScope: { (#hierarchies -> #( 'MCPToolHierarchyTestMid' )) }). - (#side -> 'instance'). - (#selector -> 'hierarchyProbe') } asDictionary. - data := self dataFrom: result. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (data at: #methods) size equals: 2. - self entryForReference: 'MCPToolHierarchyTestBase>>hierarchyProbe' in: (data at: #methods). - self entryForReference: 'MCPToolHierarchyTestChild>>hierarchyProbe' in: (data at: #methods) -] - { #category : 'tests' } MCPToolMethodSearchTest >> testImageScopeReturnsInstanceAndClassImplementors [ @@ -662,20 +632,6 @@ MCPToolMethodSearchTest >> testSelectorReferenceClassNamesLimitToExactClasses [ self entryForReference: 'MCPToolHierarchyTestChild>>childHierarchySender' in: (data at: #methods) ] -{ #category : 'tests' } -MCPToolMethodSearchTest >> testSelectorReferenceHierarchyClassNamesSearchWholeHierarchy [ - - | data result | - result := self callToolNamed: 'method_sender_search' withArguments: { - (#selector -> 'hierarchyTarget'). - (self searchScope: { (#hierarchies -> #( 'MCPToolHierarchyTestMid' )) }) } asDictionary. - data := self dataFrom: result. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (data at: #methods) size equals: 2. - self entryForReference: 'MCPToolHierarchyTestBase>>baseHierarchySender' in: (data at: #methods). - self entryForReference: 'MCPToolHierarchyTestChild>>childHierarchySender' in: (data at: #methods) -] - { #category : 'tests' } MCPToolMethodSearchTest >> testSelectorReferencePackageNamesIncludeExtensionMethods [ @@ -755,6 +711,22 @@ MCPToolMethodSearchTest >> testSelectorReferenceSubclassClassNamesSearchSubclass self entryForReference: 'MCPToolHierarchyTestChild>>childHierarchySender' in: (data at: #methods) ] +{ #category : 'tests' } +MCPToolMethodSearchTest >> testSelectorReferenceSuperclassAndSubclassScopesSearchRelatedMethods [ + + | data result | + result := self callToolNamed: 'method_sender_search' withArguments: { + (#selector -> 'hierarchyTarget'). + (self searchScope: { + (#superclassesOf -> #( 'MCPToolHierarchyTestMid' )). + (#subclassesOf -> #( 'MCPToolHierarchyTestMid' )) }) } asDictionary. + data := self dataFrom: result. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #methods) size equals: 2. + self entryForReference: 'MCPToolHierarchyTestBase>>baseHierarchySender' in: (data at: #methods). + self entryForReference: 'MCPToolHierarchyTestChild>>childHierarchySender' in: (data at: #methods) +] + { #category : 'tests' } MCPToolMethodSearchTest >> testSubclassClassNamesReturnSubclassMethods [ @@ -769,6 +741,40 @@ MCPToolMethodSearchTest >> testSubclassClassNamesReturnSubclassMethods [ self entryForReference: 'MCPToolHierarchyTestChild>>hierarchyProbe' in: (data at: #methods) ] +{ #category : 'tests' } +MCPToolMethodSearchTest >> testSuperclassAndSubclassScopesReturnRelatedMethods [ + + | data result | + result := self callToolWith: { + (self searchScope: { + (#superclassesOf -> #( 'MCPToolHierarchyTestMid' )). + (#subclassesOf -> #( 'MCPToolHierarchyTestMid' )) }). + (#side -> 'instance'). + (#selector -> 'hierarchyProbe') } asDictionary. + data := self dataFrom: result. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #methods) size equals: 2. + self entryForReference: 'MCPToolHierarchyTestBase>>hierarchyProbe' in: (data at: #methods). + self entryForReference: 'MCPToolHierarchyTestChild>>hierarchyProbe' in: (data at: #methods) +] + +{ #category : 'tests' } +MCPToolMethodSearchTest >> testSuperclassAndSubclassScopesSelectRelatedScope [ + + | data result | + result := self callToolWith: { + (self searchScope: { + (#superclassesOf -> #( 'MCPToolHierarchyTestMid' )). + (#subclassesOf -> #( 'MCPToolHierarchyTestMid' )) }). + (#side -> 'instance'). + (#selector -> 'hierarchyProbe') } asDictionary. + data := self dataFrom: result. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #methods) size equals: 2. + self entryForReference: 'MCPToolHierarchyTestBase>>hierarchyProbe' in: (data at: #methods). + self entryForReference: 'MCPToolHierarchyTestChild>>hierarchyProbe' in: (data at: #methods) +] + { #category : 'tests' } MCPToolMethodSearchTest >> testToolDoesNotRequireArgumentsInSchema [ diff --git a/src/MCP-Tests/MCPToolRewriteMethodsTest.class.st b/src/MCP-Tests/MCPToolRewriteMethodsTest.class.st index 60c77bf..ddc9a6e 100644 --- a/src/MCP-Tests/MCPToolRewriteMethodsTest.class.st +++ b/src/MCP-Tests/MCPToolRewriteMethodsTest.class.st @@ -380,7 +380,7 @@ MCPToolRewriteMethodsTest >> testSchemaAdvertisesRewriteContract [ self assert: propertyNames asSet equals: #( 'rules' 'apply' 'expectedChangeSetHash' 'force' 'includeSource' 'scope' 'side' ) asSet. - self assert: scopePropertyNames asSet equals: #( 'packages' 'classes' 'hierarchies' 'subclassesOf' 'superclassesOf' ) asSet. + self assert: scopePropertyNames asSet equals: #( 'packages' 'classes' 'subclassesOf' 'superclassesOf' ) asSet. self assert: (ruleProperties includes: 'lhs'). self assert: (ruleProperties includes: 'rhs'). self assert: (ruleProperties includes: 'isForMethod') diff --git a/src/MCP-Tests/MCPToolSearchClassesTest.class.st b/src/MCP-Tests/MCPToolSearchClassesTest.class.st index 4fc64e2..0153aa4 100644 --- a/src/MCP-Tests/MCPToolSearchClassesTest.class.st +++ b/src/MCP-Tests/MCPToolSearchClassesTest.class.st @@ -179,42 +179,6 @@ MCPToolSearchClassesTest >> testFilterCanMatchSlotNames [ self entryNamed: self baseClassName in: (data at: #classes) ] -{ #category : 'tests' } -MCPToolSearchClassesTest >> testHierarchyClassNamesReturnRelatedClasses [ - - | classNames data result | - result := self callToolWith: { - (self searchScope: { (#hierarchies -> { self childClassName }) }). - (#className -> self fixturePrefix). - (#filterMode -> 'prefix') } asDictionary. - data := self dataFrom: result. - classNames := (data at: #classes) collect: [ :each | each at: #className ]. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (data at: #classes) size equals: 3. - self assert: classNames equals: { - self baseClassName. - self childClassName. - self grandchildClassName } asArray -] - -{ #category : 'tests' } -MCPToolSearchClassesTest >> testHierarchyClassNamesSelectHierarchyScope [ - - | classNames data result | - result := self callToolWith: { - (self searchScope: { (#hierarchies -> { self childClassName }) }). - (#className -> self fixturePrefix). - (#filterMode -> 'prefix') } asDictionary. - data := self dataFrom: result. - classNames := (data at: #classes) collect: [ :each | each at: #className ]. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (data at: #classes) size equals: 3. - self assert: classNames equals: { - self baseClassName. - self childClassName. - self grandchildClassName } asArray -] - { #category : 'tests' } MCPToolSearchClassesTest >> testImageScopeCanFilterAndPaginate [ @@ -264,8 +228,11 @@ MCPToolSearchClassesTest >> testMultipleScopesAreUnioned [ | classNames data result | result := self callToolWith: { (self searchScope: { - (#classes -> { self class name asString }). - (#hierarchies -> { self childClassName }) }). + (#classes -> { + self class name asString. + self childClassName }). + (#superclassesOf -> { self childClassName }). + (#subclassesOf -> { self childClassName }) }). (#className -> 'MCPToolSearchClasses'). (#filterMode -> 'prefix') } asDictionary. data := self dataFrom: result. @@ -372,6 +339,48 @@ MCPToolSearchClassesTest >> testSubclassClassNamesReturnSubclassesOnly [ self assert: classNames equals: { self grandchildClassName } asArray ] +{ #category : 'tests' } +MCPToolSearchClassesTest >> testSuperclassAndSubclassScopesReturnRelatedClasses [ + + | classNames data result | + result := self callToolWith: { + (self searchScope: { + (#classes -> { self childClassName }). + (#superclassesOf -> { self childClassName }). + (#subclassesOf -> { self childClassName }) }). + (#className -> self fixturePrefix). + (#filterMode -> 'prefix') } asDictionary. + data := self dataFrom: result. + classNames := (data at: #classes) collect: [ :each | each at: #className ]. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #classes) size equals: 3. + self assert: classNames equals: { + self baseClassName. + self childClassName. + self grandchildClassName } asArray +] + +{ #category : 'tests' } +MCPToolSearchClassesTest >> testSuperclassAndSubclassScopesSelectRelatedScope [ + + | classNames data result | + result := self callToolWith: { + (self searchScope: { + (#classes -> { self childClassName }). + (#superclassesOf -> { self childClassName }). + (#subclassesOf -> { self childClassName }) }). + (#className -> self fixturePrefix). + (#filterMode -> 'prefix') } asDictionary. + data := self dataFrom: result. + classNames := (data at: #classes) collect: [ :each | each at: #className ]. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #classes) size equals: 3. + self assert: classNames equals: { + self baseClassName. + self childClassName. + self grandchildClassName } asArray +] + { #category : 'tests' } MCPToolSearchClassesTest >> testToolDoesNotRequireArgumentsInSchema [ diff --git a/src/MCP/MCPTestCoverageRequest.class.st b/src/MCP/MCPTestCoverageRequest.class.st index bcbe120..3f598e3 100644 --- a/src/MCP/MCPTestCoverageRequest.class.st +++ b/src/MCP/MCPTestCoverageRequest.class.st @@ -50,7 +50,6 @@ MCPTestCoverageRequest class >> scopeQueryFromValue: rawValue usingToolRequest: ^ MCPCompiledMethodScopeQuery new packageNames: (toolRequest stringCollectionArgumentNamed: 'packages' in: scopeValue); classNames: (toolRequest stringCollectionArgumentNamed: 'classes' in: scopeValue); - hierarchyClassNames: (toolRequest stringCollectionArgumentNamed: 'hierarchies' in: scopeValue); subclassClassNames: (toolRequest stringCollectionArgumentNamed: 'subclassesOf' in: scopeValue); parentClassNames: (toolRequest stringCollectionArgumentNamed: 'superclassesOf' in: scopeValue); side: (toolRequest stringArgumentNamed: 'side' in: rawValue default: 'both'); @@ -72,7 +71,7 @@ MCPTestCoverageRequest class >> signalMissingCoverageScope [ ^ MCPCommandError signalErrorCode: #CoverageScopeRequired message: - 'coverage requires at least one explicit method scope: scope.packages, scope.classes, scope.hierarchies, scope.subclassesOf, or scope.superclassesOf.' + 'coverage requires at least one explicit method scope: scope.packages, scope.classes, scope.subclassesOf, or scope.superclassesOf.' details: { (#tool -> 'test_coverage_run') } asDictionary ] diff --git a/src/MCP/MCPToolRunCritiques.class.st b/src/MCP/MCPToolRunCritiques.class.st index ee8a16f..70ce441 100644 --- a/src/MCP/MCPToolRunCritiques.class.st +++ b/src/MCP/MCPToolRunCritiques.class.st @@ -335,7 +335,6 @@ MCPToolRunCritiques >> methodScopeQueryFromRequest: request [ ^ MCPCompiledMethodScopeQuery new packageNames: (self searchScopeStringCollectionNamed: 'packages' fromRequest: request); classNames: (self searchScopeStringCollectionNamed: 'classes' fromRequest: request); - hierarchyClassNames: (self searchScopeStringCollectionNamed: 'hierarchies' fromRequest: request); subclassClassNames: (self searchScopeStringCollectionNamed: 'subclassesOf' fromRequest: request); parentClassNames: (self searchScopeStringCollectionNamed: 'superclassesOf' fromRequest: request); side: (request stringArgumentNamed: 'side' default: 'both'); diff --git a/src/MCP/MCPToolSearch.class.st b/src/MCP/MCPToolSearch.class.st index 42d2ae4..98d1d92 100644 --- a/src/MCP/MCPToolSearch.class.st +++ b/src/MCP/MCPToolSearch.class.st @@ -55,7 +55,6 @@ MCPToolSearch >> classAndMethodScopeSummaryForScopeQuery: scopeQuery [ ^ self classAndMethodScopeSummaryFromAssociations: { ('packages' -> scopeQuery packageNames). ('classes' -> scopeQuery classNames). - ('hierarchies' -> scopeQuery hierarchyClassNames). ('subclasses' -> scopeQuery subclassClassNames). ('superclasses' -> scopeQuery parentClassNames) } ] @@ -76,7 +75,6 @@ MCPToolSearch >> classAndMethodScopeSummaryFromRequest: request [ ^ self classAndMethodScopeSummaryFromAssociations: { ('packages' -> (self searchScopeStringCollectionNamed: 'packages' fromRequest: request)). ('classes' -> (self searchScopeStringCollectionNamed: 'classes' fromRequest: request)). - ('hierarchies' -> (self searchScopeStringCollectionNamed: 'hierarchies' fromRequest: request)). ('subclasses' -> (self searchScopeStringCollectionNamed: 'subclassesOf' fromRequest: request)). ('superclasses' -> (self searchScopeStringCollectionNamed: 'superclassesOf' fromRequest: request)) } ] @@ -93,7 +91,6 @@ MCPToolSearch >> classScopeQueryFromRequest: request [ ^ MCPClassScopeQuery new packageNames: (self searchScopeStringCollectionNamed: 'packages' fromRequest: request); classNames: (self searchScopeStringCollectionNamed: 'classes' fromRequest: request); - hierarchyClassNames: (self searchScopeStringCollectionNamed: 'hierarchies' fromRequest: request); subclassClassNames: (self searchScopeStringCollectionNamed: 'subclassesOf' fromRequest: request); parentClassNames: (self searchScopeStringCollectionNamed: 'superclassesOf' fromRequest: request); yourself @@ -525,8 +522,7 @@ MCPToolSearch >> searchScopeSchemaProperties [ (self stringArraySchemaNamed: 'classes'). (self stringArraySchemaNamed: 'packages'). (self stringArraySchemaNamed: 'superclassesOf'). - (self stringArraySchemaNamed: 'subclassesOf'). - (self stringArraySchemaNamed: 'hierarchies') } + (self stringArraySchemaNamed: 'subclassesOf') } ] { #category : 'private - schema' } diff --git a/src/MCP/MCPToolSearchClasses.class.st b/src/MCP/MCPToolSearchClasses.class.st index f13aef3..446f86e 100644 --- a/src/MCP/MCPToolSearchClasses.class.st +++ b/src/MCP/MCPToolSearchClasses.class.st @@ -83,13 +83,10 @@ MCPToolSearchClasses >> classFilterFieldNames [ MCPToolSearchClasses >> classFilterInputProperties [ ^ { - (self schemaPropertyNamed: 'className' type: 'string' description: 'Optional class-name text matched against class names.'). - (self schemaPropertyNamed: 'tag' type: 'string' description: 'Optional package-tag text matched against class tags.'). - (self - schemaPropertyNamed: 'instanceSlot' - type: 'string' - description: 'Optional slot-name text matched against instance-side slots.'). - (self schemaPropertyNamed: 'classSlot' type: 'string' description: 'Optional slot-name text matched against class-side slots.') } + (self schemaPropertyNamed: 'className' type: 'string' description: 'Match class names.'). + (self schemaPropertyNamed: 'tag' type: 'string' description: 'Match package tags.'). + (self schemaPropertyNamed: 'instanceSlot' type: 'string' description: 'Match instance-side slots.'). + (self schemaPropertyNamed: 'classSlot' type: 'string' description: 'Match class-side slots.') } ] { #category : 'private - schema' } @@ -110,7 +107,7 @@ MCPToolSearchClasses >> defaultExposure [ { #category : 'metadata' } MCPToolSearchClasses >> description [ - ^ 'Search classes by name, package, tag, hierarchy, or slot. Use class_get when you already know the class name.' + ^ 'Search classes by name, package, tag, superclass/subclass scope, or slot. Use class_get when you already know the class name.' ] { #category : 'private - results' } diff --git a/src/MCP/MCPToolSearchMethodSource.class.st b/src/MCP/MCPToolSearchMethodSource.class.st index e603005..4fe8fb6 100644 --- a/src/MCP/MCPToolSearchMethodSource.class.st +++ b/src/MCP/MCPToolSearchMethodSource.class.st @@ -79,6 +79,12 @@ MCPToolSearchMethodSource >> searchRequestFromToolRequest: request [ ^ MCPMethodSearchRequest fromRequest: request tool: self ] +{ #category : 'private - schema' } +MCPToolSearchMethodSource >> supportedFilterModes [ + + ^ #( 'substring' 'regex' ) +] + { #category : 'metadata' } MCPToolSearchMethodSource >> title [ diff --git a/src/MCP/MCPToolSearchPackages.class.st b/src/MCP/MCPToolSearchPackages.class.st index 339f2e3..2567796 100644 --- a/src/MCP/MCPToolSearchPackages.class.st +++ b/src/MCP/MCPToolSearchPackages.class.st @@ -128,15 +128,9 @@ MCPToolSearchPackages >> packageFilterFieldNames [ MCPToolSearchPackages >> packageFilterInputProperties [ ^ { - (self - schemaPropertyNamed: 'packageName' - type: 'string' - description: 'Optional package-name text matched against package names.'). - (self - schemaPropertyNamed: 'projectName' - type: 'string' - description: 'Optional project-name text matched against owning projects.'). - (self schemaPropertyNamed: 'tag' type: 'string' description: 'Optional tag-name text matched against package tags.') } + (self schemaPropertyNamed: 'packageName' type: 'string' description: 'Match package names.'). + (self schemaPropertyNamed: 'projectName' type: 'string' description: 'Match owning projects.'). + (self schemaPropertyNamed: 'tag' type: 'string' description: 'Match package tags.') } ] { #category : 'private - schema' } diff --git a/src/MCP/MCPToolSearchTools.class.st b/src/MCP/MCPToolSearchTools.class.st index 9cc25f4..3bcd603 100644 --- a/src/MCP/MCPToolSearchTools.class.st +++ b/src/MCP/MCPToolSearchTools.class.st @@ -46,8 +46,8 @@ MCPToolSearchTools >> buildInputSchema [ ^ MCPStructureInputSchema new type: 'object'; properties: { - (self schemaPropertyNamed: 'query' type: 'string' description: 'Search text tool names, descriptions, groups.'). - (self schemaPropertyNamed: 'group' type: 'string' description: 'Optional tool group filter.'). + (self schemaPropertyNamed: 'query' type: 'string' description: 'Search tool names, descriptions, and groups.'). + (self schemaPropertyNamed: 'group' type: 'string' description: 'Tool group filter.'). (self schemaPropertyNamed: 'cursor' type: 'string' description: 'Continuation cursor.') }; required: #( ); additionalProperties: false; diff --git a/src/MCP/TMCPMethodTool.trait.st b/src/MCP/TMCPMethodTool.trait.st index d2a2b29..2f8a54d 100644 --- a/src/MCP/TMCPMethodTool.trait.st +++ b/src/MCP/TMCPMethodTool.trait.st @@ -113,7 +113,6 @@ TMCPMethodTool >> methodScopeQueryFromRequest: request [ ^ MCPCompiledMethodScopeQuery new packageNames: (self searchScopeStringCollectionNamed: 'packages' fromRequest: request); classNames: (self searchScopeStringCollectionNamed: 'classes' fromRequest: request); - hierarchyClassNames: (self searchScopeStringCollectionNamed: 'hierarchies' fromRequest: request); subclassClassNames: (self searchScopeStringCollectionNamed: 'subclassesOf' fromRequest: request); parentClassNames: (self searchScopeStringCollectionNamed: 'superclassesOf' fromRequest: request); side: (request stringArgumentNamed: 'side' default: 'both'); @@ -152,8 +151,7 @@ TMCPMethodTool >> searchScopeSchemaProperties [ (self stringArraySchemaNamed: 'classes'). (self stringArraySchemaNamed: 'packages'). (self stringArraySchemaNamed: 'superclassesOf'). - (self stringArraySchemaNamed: 'subclassesOf'). - (self stringArraySchemaNamed: 'hierarchies') } + (self stringArraySchemaNamed: 'subclassesOf') } ] { #category : 'private - schema' } From 3ea7ea480f99394507fdab4b1f65ca967e97cbe6 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Sat, 29 Aug 2026 19:30:00 +0200 Subject: [PATCH 10/17] Simplify class search inputs --- .../MCPJSONSchemaValidatorTest.class.st | 2 +- src/MCP-Tests/MCPToolContractsTest.class.st | 11 ++-- src/MCP-Tests/MCPToolRequestTest.class.st | 12 ++--- .../MCPToolSearchClassesTest.class.st | 50 ++++++++++--------- src/MCP/MCPSearchClassesRequest.class.st | 2 +- src/MCP/MCPToolSearchClasses.class.st | 24 ++++----- 6 files changed, 47 insertions(+), 54 deletions(-) diff --git a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st index 339f968..d88f96b 100644 --- a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st +++ b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st @@ -273,7 +273,7 @@ MCPJSONSchemaValidatorTest >> testCurrentToolInputSchemasAdvertiseGroupedSearchS :each | each name ]. self assert: (classProperties collect: [ :each | each name ]) asSet - equals: #( 'scope' 'className' 'tag' 'instanceSlot' 'classSlot' 'filterMode' 'caseSensitive' 'limit' 'offset' ) asSet. + equals: #( 'scope' 'name' 'tag' 'filterMode' 'limit' 'offset' ) asSet. self assert: (methodProperties collect: [ :each | each name ]) asSet equals: #( 'scope' 'selector' 'protocol' 'filterMode' 'side' 'includeSource' 'limit' 'offset' 'caseSensitive' ) asSet. diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index ffc576e..16807e9 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -1755,7 +1755,6 @@ MCPToolContractsTest >> testOptionalToolArgumentsAdvertiseDefaultsWhenAvailable self assert: ((self inputPropertyNamed: 'includeSource' inTool: rewriteMethodsTool) extraProperties at: #default) equals: false. self assert: ((self inputPropertyNamed: 'side' inTool: rewriteMethodsTool) extraProperties at: #default) equals: 'both'. self assert: ((self inputPropertyNamed: 'filterMode' inTool: searchClassesTool) extraProperties at: #default) equals: 'substring'. - self assert: ((self inputPropertyNamed: 'caseSensitive' inTool: searchClassesTool) extraProperties at: #default) equals: true. self assert: ((self inputPropertyNamed: 'limit' inTool: searchClassesTool) extraProperties at: #default) equals: 25. self assert: ((self inputPropertyNamed: 'filterMode' inTool: methodMetadataTool) extraProperties at: #default) equals: 'exact'. self assert: ((self inputPropertyNamed: 'caseSensitive' inTool: methodMetadataTool) extraProperties at: #default) equals: true. @@ -1867,9 +1866,7 @@ MCPToolContractsTest >> testRPCRefreshesCachedToolMetadata [ toolDefinitions := mcp rpcToolsList at: #tools. toolDefinition := toolDefinitions detect: [ :each | (each at: #name) = 'class_search' ]. propertyNames := ((toolDefinition at: #inputSchema) at: #properties) keys asSet. - self - assert: propertyNames - equals: #( 'scope' 'className' 'tag' 'instanceSlot' 'classSlot' 'filterMode' 'caseSensitive' 'limit' 'offset' ) asSet. + self assert: propertyNames equals: #( 'scope' 'name' 'tag' 'filterMode' 'limit' 'offset' ) asSet. result := mcp rpcToolCall: 'class_search' withParams: { (self searchScope: { (#classes -> #( 'MCPToolContractsTest' )). @@ -2067,7 +2064,7 @@ MCPToolContractsTest >> testRpcToolCallSignalsInvalidParametersForUnexpectedArgu MCPToolContractsTest >> testRpcToolCallSignalsInvalidParametersForWrongArgumentType [ self - should: [ self callToolNamed: 'class_search' withArguments: { (#caseSensitive -> 'true') } asDictionary ] + should: [ self callToolNamed: 'package_search' withArguments: { (#caseSensitive -> 'true') } asDictionary ] raise: JRPCInvalidParameters ] @@ -2245,9 +2242,7 @@ MCPToolContractsTest >> testSearchClassesHasAccurateNameAndSchema [ scopePropertyNames := (scopeProperty extraProperties at: #properties) collect: [ :each | each name ]. self assert: MCPToolSearchClasses new name equals: 'class_search'. self assert: schema required equals: #( ). - self - assert: propertyNames asSet - equals: #( 'scope' 'className' 'tag' 'instanceSlot' 'classSlot' 'filterMode' 'caseSensitive' 'limit' 'offset' ) asSet. + self assert: propertyNames asSet equals: #( 'scope' 'name' 'tag' 'filterMode' 'limit' 'offset' ) asSet. self assert: scopeProperty description equals: 'Search scope. If omitted, searches all matching entities.'. self assert: scopePropertyNames asSet equals: #( 'classes' 'packages' 'superclassesOf' 'subclassesOf' ) asSet ] diff --git a/src/MCP-Tests/MCPToolRequestTest.class.st b/src/MCP-Tests/MCPToolRequestTest.class.st index 6f4ae4e..b831081 100644 --- a/src/MCP-Tests/MCPToolRequestTest.class.st +++ b/src/MCP-Tests/MCPToolRequestTest.class.st @@ -23,7 +23,7 @@ MCPToolRequestTest >> testHasArgumentNamedHandlesSymbolAndStringKeys [ MCPToolRequestTest >> testInvalidRequestRaisesInvalidParameters [ self - should: [ MCPToolRequest tool: MCPToolSearchClasses new arguments: { (#caseSensitive -> 'true') } asDictionary ] + should: [ MCPToolRequest tool: MCPToolSearchPackages new arguments: { (#caseSensitive -> 'true') } asDictionary ] raise: JRPCInvalidParameters ] @@ -31,11 +31,11 @@ MCPToolRequestTest >> testInvalidRequestRaisesInvalidParameters [ MCPToolRequestTest >> testInvalidRequestRaisesToolInputErrorWithViolations [ | error violation | - [ MCPToolRequest tool: MCPToolSearchClasses new arguments: { (#caseSensitive -> 'true') } asDictionary ] + [ MCPToolRequest tool: MCPToolSearchPackages new arguments: { (#caseSensitive -> 'true') } asDictionary ] on: MCPInvalidToolInput do: [ :signalledError | error := signalledError ]. self assert: error isNotNil. - self assert: error toolName equals: 'class_search'. + self assert: error toolName equals: 'package_search'. self assert: error violations size equals: 1. violation := error violations first. self assert: violation path equals: #( 'caseSensitive' ). @@ -48,7 +48,7 @@ MCPToolRequestTest >> testInvalidRequestRaisesToolInputErrorWithViolations [ MCPToolRequestTest >> testInvalidToolInputErrorResponseIncludesViolations [ | data error errorJson firstViolation response violations | - [ MCPToolRequest tool: MCPToolSearchClasses new arguments: { (#caseSensitive -> 'true') } asDictionary ] + [ MCPToolRequest tool: MCPToolSearchPackages new arguments: { (#caseSensitive -> 'true') } asDictionary ] on: MCPInvalidToolInput do: [ :signalledError | error := signalledError ]. response := (error asJRPCResponseWithId: 7) asJRPCJSON. @@ -57,7 +57,7 @@ MCPToolRequestTest >> testInvalidToolInputErrorResponseIncludesViolations [ violations := data at: 'violations'. firstViolation := violations first. self assert: (errorJson at: 'code') equals: -32602. - self assert: (data at: 'toolName') equals: 'class_search'. + self assert: (data at: 'toolName') equals: 'package_search'. self assert: (firstViolation at: #path) equals: #( 'caseSensitive' ). self assert: (firstViolation at: #keyword) equals: 'type'. self assert: (firstViolation at: #message) equals: 'Value has the wrong JSON type.' @@ -105,9 +105,7 @@ MCPToolRequestTest >> testValidRequestProvidesTypedAccessors [ scope := { (#packages -> #( 'MCP' )) } asDictionary. request := MCPToolRequest tool: MCPToolSearchClasses new arguments: { (#scope -> scope). - (#caseSensitive -> true). (#limit -> 3) } asDictionary. - self assert: (request booleanArgumentNamed: 'caseSensitive' default: false). self assert: (request nonNegativeIntegerArgumentNamed: 'limit' default: 100) equals: 3. self assert: (request stringCollectionArgumentNamed: 'packages' in: scope) equals: #( 'MCP' ). self assert: (request stringArgumentNamed: 'missing') isNil. diff --git a/src/MCP-Tests/MCPToolSearchClassesTest.class.st b/src/MCP-Tests/MCPToolSearchClassesTest.class.st index 0153aa4..4d44f75 100644 --- a/src/MCP-Tests/MCPToolSearchClassesTest.class.st +++ b/src/MCP-Tests/MCPToolSearchClassesTest.class.st @@ -136,7 +136,7 @@ MCPToolSearchClassesTest >> testDefaultFilterAppliesToClassOnly [ | classNames data result | result := self callToolWith: { (self searchScope: { (#packages -> #( 'MCP-Tests' )) }). - (#className -> self baseClassName). + (#name -> self baseClassName). (#filterMode -> 'exact') } asDictionary. self deny: (result at: #isError ifAbsent: [ false ]). data := self dataFrom: result. @@ -154,7 +154,7 @@ MCPToolSearchClassesTest >> testDirectionalScopesAreUnionedWithExactClassNames [ (#classes -> { self childClassName }). (#subclassesOf -> { self childClassName }). (#superclassesOf -> { self childClassName }) }). - (#className -> self fixturePrefix). + (#name -> self fixturePrefix). (#filterMode -> 'prefix') } asDictionary. data := self dataFrom: result. classNames := (data at: #classes) collect: [ :each | each at: #className ]. @@ -166,25 +166,12 @@ MCPToolSearchClassesTest >> testDirectionalScopesAreUnionedWithExactClassNames [ self grandchildClassName } asArray ] -{ #category : 'tests' } -MCPToolSearchClassesTest >> testFilterCanMatchSlotNames [ - - | data result | - result := self callToolWith: { - (self searchScope: { (#packages -> #( 'MCP-Tests' )) }). - (#instanceSlot -> 'alphaSlot') } asDictionary. - data := self dataFrom: result. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (data at: #classes) size equals: 1. - self entryNamed: self baseClassName in: (data at: #classes) -] - { #category : 'tests' } MCPToolSearchClassesTest >> testImageScopeCanFilterAndPaginate [ | classNames data pagination result summary | result := self callToolWith: { - (#className -> self fixturePrefix). + (#name -> self fixturePrefix). (#filterMode -> 'prefix'). (#limit -> 2). (#offset -> 1) } asDictionary. @@ -233,7 +220,7 @@ MCPToolSearchClassesTest >> testMultipleScopesAreUnioned [ self childClassName }). (#superclassesOf -> { self childClassName }). (#subclassesOf -> { self childClassName }) }). - (#className -> 'MCPToolSearchClasses'). + (#name -> 'MCPToolSearchClasses'). (#filterMode -> 'prefix') } asDictionary. data := self dataFrom: result. classNames := (data at: #classes) collect: [ :each | each at: #className ]. @@ -246,13 +233,30 @@ MCPToolSearchClassesTest >> testMultipleScopesAreUnioned [ self grandchildClassName } asArray ] +{ #category : 'tests' } +MCPToolSearchClassesTest >> testNameFilterIgnoresCase [ + + | classNames data result | + result := self callToolWith: { + (self searchScope: { (#packages -> #( 'MCP-Tests' )) }). + (#name -> self fixturePrefix asLowercase) } asDictionary. + data := self dataFrom: result. + classNames := (data at: #classes) collect: [ :each | each at: #className ]. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #classes) size equals: 3. + self assert: classNames equals: { + self baseClassName. + self childClassName. + self grandchildClassName } asArray +] + { #category : 'tests' } MCPToolSearchClassesTest >> testPackageNamesReturnPackageClasses [ | classNames data result | result := self callToolWith: { (self searchScope: { (#packages -> #( 'MCP-Tests' )) }). - (#className -> self fixturePrefix) } asDictionary. + (#name -> self fixturePrefix) } asDictionary. data := self dataFrom: result. classNames := (data at: #classes) collect: [ :each | each at: #className ]. self deny: (result at: #isError ifAbsent: [ false ]). @@ -269,7 +273,7 @@ MCPToolSearchClassesTest >> testPackageNamesSelectPackageScope [ | classNames data result | result := self callToolWith: { (self searchScope: { (#packages -> #( 'MCP-Tests' )) }). - (#className -> self fixturePrefix) } asDictionary. + (#name -> self fixturePrefix) } asDictionary. data := self dataFrom: result. classNames := (data at: #classes) collect: [ :each | each at: #className ]. self deny: (result at: #isError ifAbsent: [ false ]). @@ -286,7 +290,7 @@ MCPToolSearchClassesTest >> testParentClassNamesReturnParentsOnly [ | classNames data result | result := self callToolWith: { (self searchScope: { (#superclassesOf -> { self childClassName }) }). - (#className -> self fixturePrefix). + (#name -> self fixturePrefix). (#filterMode -> 'prefix') } asDictionary. data := self dataFrom: result. classNames := (data at: #classes) collect: [ :each | each at: #className ]. @@ -330,7 +334,7 @@ MCPToolSearchClassesTest >> testSubclassClassNamesReturnSubclassesOnly [ | classNames data result | result := self callToolWith: { (self searchScope: { (#subclassesOf -> { self childClassName }) }). - (#className -> self fixturePrefix). + (#name -> self fixturePrefix). (#filterMode -> 'prefix') } asDictionary. data := self dataFrom: result. classNames := (data at: #classes) collect: [ :each | each at: #className ]. @@ -348,7 +352,7 @@ MCPToolSearchClassesTest >> testSuperclassAndSubclassScopesReturnRelatedClasses (#classes -> { self childClassName }). (#superclassesOf -> { self childClassName }). (#subclassesOf -> { self childClassName }) }). - (#className -> self fixturePrefix). + (#name -> self fixturePrefix). (#filterMode -> 'prefix') } asDictionary. data := self dataFrom: result. classNames := (data at: #classes) collect: [ :each | each at: #className ]. @@ -369,7 +373,7 @@ MCPToolSearchClassesTest >> testSuperclassAndSubclassScopesSelectRelatedScope [ (#classes -> { self childClassName }). (#superclassesOf -> { self childClassName }). (#subclassesOf -> { self childClassName }) }). - (#className -> self fixturePrefix). + (#name -> self fixturePrefix). (#filterMode -> 'prefix') } asDictionary. data := self dataFrom: result. classNames := (data at: #classes) collect: [ :each | each at: #className ]. diff --git a/src/MCP/MCPSearchClassesRequest.class.st b/src/MCP/MCPSearchClassesRequest.class.st index f4651da..6701fe2 100644 --- a/src/MCP/MCPSearchClassesRequest.class.st +++ b/src/MCP/MCPSearchClassesRequest.class.st @@ -24,7 +24,7 @@ MCPSearchClassesRequest class >> fromRequest: request tool: aTool [ scopeQuery: (aTool classScopeQueryFromRequest: request); filterMode: (aTool filterModeFromRequest: request); fieldFilters: (aTool fieldFiltersFromRequest: request fieldNames: aTool classFilterFieldNames); - caseSensitive: (request booleanArgumentNamed: 'caseSensitive' default: true); + caseSensitive: false; limit: (request nonNegativeIntegerArgumentNamed: 'limit' default: aTool defaultPageLimit); offset: (request nonNegativeIntegerArgumentNamed: 'offset' default: 0); yourself diff --git a/src/MCP/MCPToolSearchClasses.class.st b/src/MCP/MCPToolSearchClasses.class.st index 446f86e..70cdb92 100644 --- a/src/MCP/MCPToolSearchClasses.class.st +++ b/src/MCP/MCPToolSearchClasses.class.st @@ -27,11 +27,11 @@ MCPToolSearchClasses class >> toolName [ MCPToolSearchClasses >> buildInputSchema [ | properties | - properties := self classQueryScopeInputProperties , self classFilterInputProperties , { - (self - filterModeSchemaPropertyWithDescription: 'How class metadata filters are matched.' - values: self basicFilterModes). - (self caseSensitiveSchemaPropertyWithDescription: 'Whether class metadata matching is case-sensitive.') } + properties := self classQueryScopeInputProperties , self classFilterInputProperties + , + { (self + filterModeSchemaPropertyWithDescription: 'How class metadata filters are matched.' + values: self basicFilterModes) } , (self paginationInputPropertiesWithLimitDescription: 'Maximum number of matching classes to return. Use 0 to return no entries.'). @@ -76,17 +76,15 @@ MCPToolSearchClasses >> classEntrySchema [ { #category : 'private - request' } MCPToolSearchClasses >> classFilterFieldNames [ - ^ #( 'className' 'tag' 'instanceSlot' 'classSlot' ) + ^ #( 'name' 'tag' ) ] { #category : 'private - schema' } MCPToolSearchClasses >> classFilterInputProperties [ ^ { - (self schemaPropertyNamed: 'className' type: 'string' description: 'Match class names.'). - (self schemaPropertyNamed: 'tag' type: 'string' description: 'Match package tags.'). - (self schemaPropertyNamed: 'instanceSlot' type: 'string' description: 'Match instance-side slots.'). - (self schemaPropertyNamed: 'classSlot' type: 'string' description: 'Match class-side slots.') } + (self schemaPropertyNamed: 'name' type: 'string' description: 'Match class names case-insensitively.'). + (self schemaPropertyNamed: 'tag' type: 'string' description: 'Match package tags case-insensitively.') } ] { #category : 'private - schema' } @@ -107,7 +105,7 @@ MCPToolSearchClasses >> defaultExposure [ { #category : 'metadata' } MCPToolSearchClasses >> description [ - ^ 'Search classes by name, package, tag, superclass/subclass scope, or slot. Use class_get when you already know the class name.' + ^ 'Search classes by name, package, tag, or superclass/subclass scope. Use class_get when you already know the class name.' ] { #category : 'private - results' } @@ -119,10 +117,8 @@ MCPToolSearchClasses >> failureMessageForScope: scopeSummary error: anError [ { #category : 'private - filtering' } MCPToolSearchClasses >> fieldTextsForClassEntry: anEntry fieldName: fieldName [ - fieldName = 'className' ifTrue: [ ^ { (anEntry at: #className) } ]. + fieldName = 'name' ifTrue: [ ^ { (anEntry at: #className) } ]. fieldName = 'tag' ifTrue: [ ^ { (anEntry at: #tag) } ]. - fieldName = 'instanceSlot' ifTrue: [ ^ anEntry at: #instanceSlotNames ]. - fieldName = 'classSlot' ifTrue: [ ^ anEntry at: #classSlotNames ]. ^ #( ) ] From 7b57fb17c610de7e26af90d99e23a28ceb1d99f5 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Sat, 29 Aug 2026 19:47:43 +0200 Subject: [PATCH 11/17] Simplify tool search inputs --- .../MCPToolChangeHistoryToolsTest.class.st | 2 +- src/MCP-Tests/MCPToolContractsTest.class.st | 4 ++-- .../MCPToolRepositoryToolsTest.class.st | 2 +- src/MCP/MCPSearchToolsCommand.class.st | 4 ++-- src/MCP/MCPSearchToolsRequest.class.st | 16 +--------------- src/MCP/MCPToolSearchTools.class.st | 9 ++++++--- 6 files changed, 13 insertions(+), 24 deletions(-) diff --git a/src/MCP-Tests/MCPToolChangeHistoryToolsTest.class.st b/src/MCP-Tests/MCPToolChangeHistoryToolsTest.class.st index c0501ad..b35e0ff 100644 --- a/src/MCP-Tests/MCPToolChangeHistoryToolsTest.class.st +++ b/src/MCP-Tests/MCPToolChangeHistoryToolsTest.class.st @@ -19,7 +19,7 @@ MCPToolChangeHistoryToolsTest >> inputPropertyNamesFor: aTool [ MCPToolChangeHistoryToolsTest >> testChangeHistoryToolsAreDiscoverableWithExpectedMetadata [ | metadataByName result toolNames | - result := self callToolNamed: 'tool_search' withArguments: { (#group -> 'history') } asDictionary. + result := self callToolNamed: 'tool_search' withArguments: { (#query -> 'history') } asDictionary. metadataByName := (((self dataFrom: result) at: #tools) collect: [ :each | (each at: #name) -> each ]) asDictionary. toolNames := metadataByName keys. #( 'history_file_list' 'history_entry_list' 'history_entry_apply' 'history_entry_revert' ) do: [ :toolName | diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 16807e9..1fea939 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -1156,7 +1156,7 @@ MCPToolContractsTest >> testDebuggerToolsAreDiscoverableOnly [ 'debug_capture' 'debug_test_run' 'debug_method_update' ). staticToolNames := self toolRegistry staticToolNames. debugNames do: [ :each | self deny: (staticToolNames includes: each) ]. - result := self callToolNamed: 'tool_search' withArguments: { (#group -> 'debugging') } asDictionary. + result := self callToolNamed: 'tool_search' withArguments: { (#query -> 'debug') } asDictionary. metadataByName := (((self dataFrom: result) at: #tools) collect: [ :each | (each at: #name) -> each ]) asDictionary. debugNames do: [ :each | self assert: (metadataByName includesKey: each) ] ] @@ -2528,7 +2528,7 @@ MCPToolContractsTest >> testSearchToolsUsesCursorPaginationContract [ | propertyNames searchTool | searchTool := MCPToolSearchTools new. propertyNames := searchTool inputSchema properties collect: [ :each | each name ]. - self assert: propertyNames asSet equals: #( 'query' 'group' 'cursor' ) asSet. + self assert: propertyNames asSet equals: #( 'query' 'cursor' ) asSet. self assert: (self inputPropertyNamed: 'cursor' inTool: searchTool) type equals: 'string' ] diff --git a/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st b/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st index 3b0510a..b0c0f1b 100644 --- a/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st +++ b/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st @@ -19,7 +19,7 @@ MCPToolRepositoryToolsTest >> inputPropertyNamesFor: aTool [ MCPToolRepositoryToolsTest >> metadataByNameForRepositoryTools [ | result | - result := self callToolNamed: 'tool_search' withArguments: { (#group -> 'repositories') } asDictionary. + result := self callToolNamed: 'tool_search' withArguments: { (#query -> 'repository') } asDictionary. ^ (((self dataFrom: result) at: #tools) collect: [ :each | (each at: #name) -> each ]) asDictionary ] diff --git a/src/MCP/MCPSearchToolsCommand.class.st b/src/MCP/MCPSearchToolsCommand.class.st index b1dc014..376724a 100644 --- a/src/MCP/MCPSearchToolsCommand.class.st +++ b/src/MCP/MCPSearchToolsCommand.class.st @@ -1,7 +1,7 @@ " Searches the tool catalog and returns compact metadata for matching tools. -This command supports the discoverable-tool workflow: agents can search by text or group, then read a selected tool contract before invoking it. +This command supports the discoverable-tool workflow: agents can search by text, then read a selected tool contract before invoking it. " Class { #name : 'MCPSearchToolsCommand', @@ -22,7 +22,7 @@ MCPSearchToolsCommand >> execute [ | data matchingTools pageSize visibleTools | pageSize := self pageSize. - matchingTools := self toolRegistry toolsMatchingQuery: request query group: request group. + matchingTools := self toolRegistry toolsMatchingQuery: request query group: nil. visibleTools := self visibleToolsFrom: matchingTools. data := Dictionary new. data at: #tools put: (visibleTools collect: [ :each | each searchMetadata ]) asArray. diff --git a/src/MCP/MCPSearchToolsRequest.class.st b/src/MCP/MCPSearchToolsRequest.class.st index 0dc1eca..888110f 100644 --- a/src/MCP/MCPSearchToolsRequest.class.st +++ b/src/MCP/MCPSearchToolsRequest.class.st @@ -1,12 +1,11 @@ " -Request object for tool catalog searches. Captures optional search text, group filter, and continuation cursor used by tool_search. +Request object for tool catalog searches. Captures optional search text and continuation cursor used by tool_search. " Class { #name : 'MCPSearchToolsRequest', #superclass : 'Object', #instVars : [ 'query', - 'group', 'cursor' ], #category : 'MCP-Requests', @@ -29,7 +28,6 @@ MCPSearchToolsRequest class >> fromToolRequest: aToolRequest [ ^ self new query: (aToolRequest stringArgumentNamed: 'query'); - group: (aToolRequest stringArgumentNamed: 'group'); cursor: (self cursorFromToolRequest: aToolRequest); yourself ] @@ -46,18 +44,6 @@ MCPSearchToolsRequest >> cursor: anInteger [ cursor := anInteger ] -{ #category : 'accessing' } -MCPSearchToolsRequest >> group [ - - ^ group -] - -{ #category : 'accessing' } -MCPSearchToolsRequest >> group: anObject [ - - group := anObject -] - { #category : 'accessing' } MCPSearchToolsRequest >> query [ diff --git a/src/MCP/MCPToolSearchTools.class.st b/src/MCP/MCPToolSearchTools.class.st index 3bcd603..27f85be 100644 --- a/src/MCP/MCPToolSearchTools.class.st +++ b/src/MCP/MCPToolSearchTools.class.st @@ -46,8 +46,11 @@ MCPToolSearchTools >> buildInputSchema [ ^ MCPStructureInputSchema new type: 'object'; properties: { - (self schemaPropertyNamed: 'query' type: 'string' description: 'Search tool names, descriptions, and groups.'). - (self schemaPropertyNamed: 'group' type: 'string' description: 'Tool group filter.'). + (self + schemaPropertyNamed: 'query' + type: 'string' + description: + 'Space-separated search words matched against tool names, descriptions, groups, and keywords. Returns tools matching any word.'). (self schemaPropertyNamed: 'cursor' type: 'string' description: 'Continuation cursor.') }; required: #( ); additionalProperties: false; @@ -79,7 +82,7 @@ MCPToolSearchTools >> defaultExposure [ { #category : 'metadata' } MCPToolSearchTools >> description [ - ^ 'Search all MCP-Pharo tools. Use to discover tool names before tool_get or tool_call.' + ^ 'Search available tools. Use to discover tool names before tool_get or tool_call.' ] { #category : 'executing' } From b090b6cdcd2f4654ffc9f8da57d95d2cd38cd6a8 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Sat, 29 Aug 2026 19:48:16 +0200 Subject: [PATCH 12/17] Clean tool search metadata wording --- src/MCP/MCPToolSearchTools.class.st | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/MCP/MCPToolSearchTools.class.st b/src/MCP/MCPToolSearchTools.class.st index 27f85be..5f9c237 100644 --- a/src/MCP/MCPToolSearchTools.class.st +++ b/src/MCP/MCPToolSearchTools.class.st @@ -114,9 +114,9 @@ MCPToolSearchTools >> toolMetadataObjectSchema [ ^ MCPStructureProperties new type: 'object'; - description: 'Compact metadata for one MCP-Pharo tool.'; + description: 'Compact metadata for one tool.'; properties: { - (self schemaPropertyNamed: 'name' type: 'string' description: 'MCP tool name.'). + (self schemaPropertyNamed: 'name' type: 'string' description: 'Tool name.'). (self schemaPropertyNamed: 'description' type: 'string' description: 'Short description.') }; required: #( 'name' 'description' ); additionalProperties: false; From 443077fc17e69452941121ea96064aae3c19a9f3 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Mon, 31 Aug 2026 09:27:57 +0200 Subject: [PATCH 13/17] Simplify repository search inputs --- src/MCP-Tests/MCPRepositorySpecTest.class.st | 4 +- src/MCP-Tests/MCPToolContractsTest.class.st | 5 +- .../MCPToolRepositoryOperationTest.class.st | 18 ++--- .../MCPToolSearchRepositoriesTest.class.st | 77 ++++++++----------- src/MCP/MCPRepositoryInfo.class.st | 40 ++-------- src/MCP/MCPRepositoryQuerySpec.class.st | 30 +------- src/MCP/MCPToolSearchRepositories.class.st | 69 ++++++++--------- 7 files changed, 82 insertions(+), 161 deletions(-) diff --git a/src/MCP-Tests/MCPRepositorySpecTest.class.st b/src/MCP-Tests/MCPRepositorySpecTest.class.st index b1e5374..c63f132 100644 --- a/src/MCP-Tests/MCPRepositorySpecTest.class.st +++ b/src/MCP-Tests/MCPRepositorySpecTest.class.st @@ -226,13 +226,13 @@ MCPRepositorySpecTest >> testRepositoryQuerySpecParsesOptionalBooleanFilters [ tool := MCPToolSearchRepositories new. request := MCPToolRequest tool: tool arguments: { (#isModified -> false). - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#limit -> 5) } asDictionary. spec := tool searchRequestFromToolRequest: request. self assert: spec class equals: MCPRepositoryQuerySpec. self assert: spec isModified equals: false. self assert: spec isMissing isNil. - self assert: (spec fieldFilters at: 'repositoryName') equals: 'MCP'. + self assert: (spec fieldFilters at: 'name') equals: 'MCP'. self assert: spec limit equals: 5. self assert: spec offset equals: 0 ] diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 1fea939..d082fdb 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -2326,9 +2326,8 @@ MCPToolContractsTest >> testSearchRepositoriesHasAccurateNameAndSchema [ self assert: propertyNames asSet equals: - #( 'isModified' 'isMissing' 'repositoryName' 'repositoryClassName' 'location' 'subdirectory' 'branchName' 'headDescription' - 'headClassName' 'headCommitId' 'packageName' 'modifiedPackageName' 'remoteName' 'remoteUrl' 'upstreamRemoteName' - 'upstreamBranchName' 'upstreamRemoteUrl' 'filterMode' 'caseSensitive' 'includeDetails' 'limit' 'offset' ) asSet + #( 'isModified' 'isMissing' 'name' 'location' 'subdirectory' 'packageName' 'className' 'modifiedPackageName' + 'filterMode' 'limit' 'offset' ) asSet ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st b/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st index 4ff199e..dd700bf 100644 --- a/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st +++ b/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st @@ -843,9 +843,9 @@ MCPToolRepositoryOperationTest >> testGitCommandFailureSignalsStructuredCommandE ] { #category : 'tests' } -MCPToolRepositoryOperationTest >> testLinkedWorktreeAttachReportsGitMetadataAndExportsOnLinkedBranch [ +MCPToolRepositoryOperationTest >> testLinkedWorktreeAttachExportsOnLinkedBranch [ - | repositoryName packageName initialClassName exportedClassName location linkedLocation branchName createResult exportResult commitResult repository headCommitId attachResult searchResult searchData entry exportedClassFile | + | repositoryName packageName initialClassName exportedClassName location linkedLocation branchName createResult exportResult commitResult attachResult searchResult searchData entry exportedClassFile | repositoryName := 'MCP Repository Command Linked Worktree Contract Test'. packageName := 'MCPToolRepositoryOperationLinkedWorktreePackage'. initialClassName := 'MCPToolRepositoryOperationLinkedWorktreeClass'. @@ -873,8 +873,6 @@ MCPToolRepositoryOperationTest >> testLinkedWorktreeAttachReportsGitMetadataAndE (#repositoryName -> repositoryName). (#message -> 'Prepare linked checkout contract test') } asDictionary. self deny: (self resultIndicatesError: commitResult) description: (self summaryFrom: commitResult). - repository := IceRepository registry detect: [ :each | each name = repositoryName ]. - headCommitId := MCPIcebergCommitInfo idStringFrom: repository headCommit. self shellCommand: 'git -C ' , (self shellQuote: location pathString) , ' remote add origin https://example.com/worktree.git'. self shellCommand: 'git -C ' , (self shellQuote: location pathString) , ' worktree add -b ' , branchName , ' ' , (self shellQuote: linkedLocation pathString). @@ -893,18 +891,14 @@ MCPToolRepositoryOperationTest >> testLinkedWorktreeAttachReportsGitMetadataAndE (#packageNames -> { packageName }) } asDictionary. self deny: (self resultIndicatesError: attachResult) description: (self summaryFrom: attachResult). searchResult := self searchRepositoriesWith: { - (#repositoryName -> repositoryName). - (#filterMode -> 'exact'). - (#includeDetails -> true) } asDictionary. + (#name -> repositoryName). + (#filterMode -> 'exact') } asDictionary. self deny: (self resultIndicatesError: searchResult) description: (self summaryFrom: searchResult). searchData := self dataFrom: searchResult. entry := (searchData at: #repositories) anyOne. self assert: (entry at: #location) equals: linkedLocation pathString. - self assert: (entry at: #branchName) equals: branchName. - self assert: (entry at: #headCommitId) equals: headCommitId. - self assert: (entry at: #upstreamRemoteName) equals: 'origin'. - self assert: (entry at: #upstreamBranchName) equals: branchName. - self assert: (entry at: #upstreamRemoteUrl) equals: 'https://example.com/worktree.git'. + self assert: (entry at: #subdirectory) equals: 'src'. + self assert: (entry at: #packageNames) equals: { packageName }. self createClassNamed: exportedClassName inPackageNamed: packageName. exportResult := self callToolWith: { (#action -> 'export'). diff --git a/src/MCP-Tests/MCPToolSearchRepositoriesTest.class.st b/src/MCP-Tests/MCPToolSearchRepositoriesTest.class.st index 9e6956f..e15e9b5 100644 --- a/src/MCP-Tests/MCPToolSearchRepositoriesTest.class.st +++ b/src/MCP-Tests/MCPToolSearchRepositoriesTest.class.st @@ -28,6 +28,27 @@ MCPToolSearchRepositoriesTest >> newRepositoryNamed: aRepositoryName location: a ^ repository ] +{ #category : 'tests' } +MCPToolSearchRepositoriesTest >> testCanFilterByClassName [ + + | alpha beta data repositoryNames result | + alpha := self newRepositoryNamed: 'MCP Alpha Repository' location: FileLocator imageDirectory packageNames: #( 'MCP-Tests' ). + beta := self newRepositoryNamed: 'MCP Beta Repository' location: FileLocator imageDirectory packageNames: #( 'MCP' ). + self + withRepositories: { + alpha. + beta } + do: [ + result := self callToolWith: { + (#className -> self class name asString). + (#filterMode -> 'exact') } asDictionary. + data := self dataFrom: result. + repositoryNames := (data at: #repositories) collect: [ :each | each at: #name ]. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #repositories) size equals: 1. + self assert: repositoryNames equals: #( 'MCP Alpha Repository' ) ] +] + { #category : 'tests' } MCPToolSearchRepositoriesTest >> testCanFilterByMissingStateAndDirectory [ @@ -73,33 +94,6 @@ MCPToolSearchRepositoriesTest >> testCanFilterByPackageNameAndModifiedState [ self assert: repositoryNames equals: #( 'MCP Alpha Repository' ) ] ] -{ #category : 'tests' } -MCPToolSearchRepositoriesTest >> testCanFilterByRemoteUrlAndHeadCommit [ - - MCPTestGitRepositoryFixture withConfig: MCPTestGitRepositoryFixture standardConfig do: [ :alphaDirectory | - MCPTestGitRepositoryFixture withConfig: MCPTestGitRepositoryFixture backupConfig do: [ :betaDirectory | - | alpha beta data repositoryNames result | - alpha := MCPTestIceRepository named: 'MCP Alpha Repository' location: alphaDirectory pathString. - alpha headCommitId: 'abc123'. - beta := MCPTestIceRepository named: 'MCP Beta Repository' location: betaDirectory pathString. - beta headCommitId: 'def456'. - self - withRepositories: { - alpha. - beta } - do: [ - result := self callToolWith: { (#headCommitId -> 'abc123') } asDictionary. - data := self dataFrom: result. - repositoryNames := (data at: #repositories) collect: [ :each | each at: #name ]. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: repositoryNames equals: #( 'MCP Alpha Repository' ). - result := self callToolWith: { (#remoteUrl -> 'memory://backup') } asDictionary. - data := self dataFrom: result. - repositoryNames := (data at: #repositories) collect: [ :each | each at: #name ]. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: repositoryNames equals: #( 'MCP Beta Repository' ) ] ] ] -] - { #category : 'tests' } MCPToolSearchRepositoriesTest >> testListsRegisteredRepositoriesWithStructuredData [ @@ -119,19 +113,15 @@ MCPToolSearchRepositoriesTest >> testListsRegisteredRepositoriesWithStructuredDa self deny: (result at: #isError ifAbsent: [ false ]). self assert: (data at: #repositories) size equals: 2. entry := self entryNamed: 'MCP Alpha Repository' in: (data at: #repositories). - self assert: (entry at: #isModified) equals: true. - self assert: (entry at: #modifiedPackageNames) equals: #( 'MCP' 'MCP-Tests' ). - self deny: (entry includesKey: #location). - self deny: (entry includesKey: #isMissing). - self deny: (entry includesKey: #packageNames). - self deny: (entry includesKey: #className). - self deny: (entry includesKey: #headClassName). - self deny: (entry includesKey: #remotes). - self deny: (entry includesKey: #remoteNames) ] + self assert: (entry at: #location) equals: FileLocator imageDirectory pathString. + self assert: (entry at: #isModified). + self deny: (entry at: #isMissing). + self assert: (entry at: #packageNames) equals: #( 'MCP' 'MCP-Tests' ). + self assert: (entry at: #modifiedPackageNames) equals: #( 'MCP' 'MCP-Tests' ) ] ] { #category : 'tests' } -MCPToolSearchRepositoriesTest >> testListsRichRepositoryMetadata [ +MCPToolSearchRepositoriesTest >> testListsRepositoryPackageMetadata [ MCPTestGitRepositoryFixture withConfig: MCPTestGitRepositoryFixture richConfig do: [ :repositoryDirectory | | entry repository result | @@ -142,18 +132,13 @@ MCPToolSearchRepositoriesTest >> testListsRichRepositoryMetadata [ repository isDetachedHead: false. self withRepositories: { repository } do: [ | data | - result := self callToolWith: { (#includeDetails -> true) } asDictionary. + result := self callToolWith: Dictionary new. data := self dataFrom: result. self deny: (result at: #isError ifAbsent: [ false ]). entry := self entryNamed: 'MCP Rich Repository' in: (data at: #repositories). - self assert: (entry at: #headDescription) equals: 'rich head'. - self assert: (entry at: #headCommitId) equals: 'abc123'. - self assert: (entry at: #upstreamRemoteName) equals: 'origin'. - self assert: (entry at: #upstreamBranchName) equals: 'main'. - self assert: (entry at: #upstreamRemoteUrl) equals: 'memory://origin'. - self deny: (entry includesKey: #isDetachedHead). - self deny: (entry includesKey: #headClassName). - self deny: (entry includesKey: #remotes) ] ] + self assert: entry keys asSet equals: #( name location isModified isMissing packageNames ) asSet. + self assert: (entry at: #location) equals: repositoryDirectory pathString. + self assert: (entry at: #packageNames) equals: #( 'MCP' ) ] ] ] { #category : 'tests' } diff --git a/src/MCP/MCPRepositoryInfo.class.st b/src/MCP/MCPRepositoryInfo.class.st index ce51230..14757be 100644 --- a/src/MCP/MCPRepositoryInfo.class.st +++ b/src/MCP/MCPRepositoryInfo.class.st @@ -49,29 +49,6 @@ MCPRepositoryInfo class >> fromRepository: aRepository [ do: [ :ignored | self new initializeStaleRepository: aRepository ] ] -{ #category : 'converting' } -MCPRepositoryInfo >> asDetailedSearchDictionary [ - - | data | - data := Dictionary new. - data - at: #name put: self name; - at: #location put: self location; - at: #isModified put: self isModified; - at: #isMissing put: self isMissing. - self subdirectory ifNotNil: [ :value | value ifNotEmpty: [ data at: #subdirectory put: value ] ]. - self branchName ifNotNil: [ :value | value ifNotEmpty: [ data at: #branchName put: value ] ]. - self headDescription ifNotNil: [ :value | value ifNotEmpty: [ data at: #headDescription put: value ] ]. - self headCommitId ifNotEmpty: [ :value | data at: #headCommitId put: value ]. - self packageNames ifNotEmpty: [ :names | data at: #packageNames put: names ]. - self modifiedPackageNames ifNotEmpty: [ :names | data at: #modifiedPackageNames put: names ]. - self upstreamRemoteName ifNotEmpty: [ :value | data at: #upstreamRemoteName put: value ]. - self upstreamBranchName ifNotEmpty: [ :value | data at: #upstreamBranchName put: value ]. - self upstreamRemoteUrl ifNotEmpty: [ :value | data at: #upstreamRemoteUrl put: value ]. - self isDetachedHead ifTrue: [ data at: #isDetachedHead put: true ]. - ^ data -] - { #category : 'converting' } MCPRepositoryInfo >> asDictionary [ @@ -106,17 +83,14 @@ MCPRepositoryInfo >> asSearchDictionary [ | data | data := Dictionary new. - data at: #name put: self name. - self branchName ifNotNil: [ :value | value ifNotEmpty: [ data at: #branchName put: value ] ]. + data + at: #name put: self name; + at: #location put: self location; + at: #isModified put: self isModified; + at: #isMissing put: self isMissing. self subdirectory ifNotNil: [ :value | value ifNotEmpty: [ data at: #subdirectory put: value ] ]. - self isMissing ifTrue: [ - data at: #isMissing put: true. - self location ifNotNil: [ :value | data at: #location put: value ] ]. - self isModified ifTrue: [ - data at: #isModified put: true. - self modifiedPackageNames ifNotEmpty: [ :names | data at: #modifiedPackageNames put: names ] ]. - self isDetachedHead ifFalse: [ ^ data ]. - data at: #isDetachedHead put: true. + self packageNames ifNotEmpty: [ :names | data at: #packageNames put: names ]. + self modifiedPackageNames ifNotEmpty: [ :names | data at: #modifiedPackageNames put: names ]. ^ data ] diff --git a/src/MCP/MCPRepositoryQuerySpec.class.st b/src/MCP/MCPRepositoryQuerySpec.class.st index 3e74ca1..839d235 100644 --- a/src/MCP/MCPRepositoryQuerySpec.class.st +++ b/src/MCP/MCPRepositoryQuerySpec.class.st @@ -11,10 +11,8 @@ Class { 'isMissing', 'fieldFilters', 'filterMode', - 'caseSensitive', 'limit', - 'offset', - 'includeDetails' + 'offset' ], #category : 'MCP-Requests', #package : 'MCP', @@ -29,8 +27,6 @@ MCPRepositoryQuerySpec class >> fromRequest: request tool: aTool [ isMissing: (self optionalBooleanArgumentNamed: 'isMissing' fromRequest: request); fieldFilters: (aTool fieldFiltersFromRequest: request fieldNames: aTool repositoryFilterFieldNames); filterMode: (aTool filterModeFromRequest: request); - caseSensitive: (request booleanArgumentNamed: 'caseSensitive' default: true); - includeDetails: (request booleanArgumentNamed: 'includeDetails' default: false); limit: (request nonNegativeIntegerArgumentNamed: 'limit' default: aTool defaultPageLimit); offset: (request nonNegativeIntegerArgumentNamed: 'offset' default: 0); yourself @@ -43,18 +39,6 @@ MCPRepositoryQuerySpec class >> optionalBooleanArgumentNamed: anArgumentName fro ^ request booleanArgumentNamed: anArgumentName default: false ] -{ #category : 'accessing' } -MCPRepositoryQuerySpec >> caseSensitive [ - - ^ caseSensitive -] - -{ #category : 'accessing' } -MCPRepositoryQuerySpec >> caseSensitive: aBoolean [ - - caseSensitive := aBoolean -] - { #category : 'accessing' } MCPRepositoryQuerySpec >> fieldFilters [ @@ -85,18 +69,6 @@ MCPRepositoryQuerySpec >> hasFieldFilters [ ^ self fieldFilters notEmpty ] -{ #category : 'accessing' } -MCPRepositoryQuerySpec >> includeDetails [ - - ^ includeDetails -] - -{ #category : 'accessing' } -MCPRepositoryQuerySpec >> includeDetails: aBoolean [ - - includeDetails := aBoolean -] - { #category : 'accessing' } MCPRepositoryQuerySpec >> isMissing [ diff --git a/src/MCP/MCPToolSearchRepositories.class.st b/src/MCP/MCPToolSearchRepositories.class.st index 183212d..604c3ad 100644 --- a/src/MCP/MCPToolSearchRepositories.class.st +++ b/src/MCP/MCPToolSearchRepositories.class.st @@ -26,7 +26,7 @@ MCPToolSearchRepositories class >> toolName [ { #category : 'metadata' } MCPToolSearchRepositories >> additionalKeywords [ - ^ #( 'repository' 'repo' 'iceberg' 'git' 'branch' 'commit' 'remote' 'head' ) + ^ #( 'repository' 'repositories' 'repo' 'iceberg' 'package' 'packages' 'class' 'classes' ) ] { #category : 'metadata' } @@ -34,12 +34,10 @@ MCPToolSearchRepositories >> buildInputSchema [ | properties | properties := self repositoryFieldFilterInputProperties , { - (self booleanSchemaPropertyNamed: 'isModified' description: 'Filter by modified state.'). - (self booleanSchemaPropertyNamed: 'isMissing' description: 'Filter by missing state.'). - (self filterModeSchemaPropertyWithDescription: 'Filter match mode.' values: self basicFilterModes). - (self caseSensitiveSchemaPropertyWithDescription: 'Case-sensitive matching.'). - (self booleanSchemaPropertyNamed: 'includeDetails' description: 'Include detailed metadata.' default: false) } - , (self paginationInputPropertiesWithLimitDescription: 'Maximum results.'). + (self booleanSchemaPropertyNamed: 'isModified' description: 'Filter by image-side modified state.'). + (self booleanSchemaPropertyNamed: 'isMissing' description: 'Filter by missing repository directory state.'). + (self filterModeSchemaPropertyWithDescription: 'Filter match mode.' values: self basicFilterModes) } + , (self paginationInputPropertiesWithLimitDescription: 'Maximum number of matching repositories to return.'). ^ self queryInputSchemaWithProperties: properties ] @@ -53,10 +51,22 @@ MCPToolSearchRepositories >> buildOutputSchema [ itemNounPhrase: 'repository entries' ] +{ #category : 'private - filtering' } +MCPToolSearchRepositories >> classNamesForRepositoryEntry: anEntry [ + + | classNames | + classNames := OrderedCollection new. + (anEntry at: #packageNames) do: [ :packageName | + PackageOrganizer default + packageNamed: packageName asSymbol + ifPresent: [ :package | package definedClasses do: [ :class | classNames add: class name asString ] ] ]. + ^ classNames asArray +] + { #category : 'metadata' } MCPToolSearchRepositories >> description [ - ^ 'Search registered Iceberg repositories.' + ^ 'Search registered repositories by image-side repository, package, class, and modification state.' ] { #category : 'private - results' } @@ -68,21 +78,12 @@ MCPToolSearchRepositories >> failureMessageForScope: scopeSummary error: anError { #category : 'private - filtering' } MCPToolSearchRepositories >> fieldTextsForRepositoryEntry: anEntry fieldName: fieldName [ - fieldName = 'repositoryName' ifTrue: [ ^ { (anEntry at: #name) } ]. - fieldName = 'repositoryClassName' ifTrue: [ ^ { (anEntry at: #className) } ]. + fieldName = 'name' ifTrue: [ ^ { (anEntry at: #name) } ]. fieldName = 'location' ifTrue: [ ^ { (anEntry at: #location) } ]. fieldName = 'subdirectory' ifTrue: [ ^ { (anEntry at: #subdirectory) } ]. - fieldName = 'branchName' ifTrue: [ ^ { (anEntry at: #branchName) } ]. - fieldName = 'headDescription' ifTrue: [ ^ { (anEntry at: #headDescription) } ]. - fieldName = 'headClassName' ifTrue: [ ^ { (anEntry at: #headClassName) } ]. - fieldName = 'headCommitId' ifTrue: [ ^ { (anEntry at: #headCommitId) } ]. fieldName = 'packageName' ifTrue: [ ^ anEntry at: #packageNames ]. + fieldName = 'className' ifTrue: [ ^ self classNamesForRepositoryEntry: anEntry ]. fieldName = 'modifiedPackageName' ifTrue: [ ^ anEntry at: #modifiedPackageNames ]. - fieldName = 'remoteName' ifTrue: [ ^ (anEntry at: #remotes) collect: [ :remote | remote at: #name ] ]. - fieldName = 'remoteUrl' ifTrue: [ ^ (anEntry at: #remotes) collect: [ :remote | remote at: #url ] ]. - fieldName = 'upstreamRemoteName' ifTrue: [ ^ { (anEntry at: #upstreamRemoteName) } ]. - fieldName = 'upstreamBranchName' ifTrue: [ ^ { (anEntry at: #upstreamBranchName) } ]. - fieldName = 'upstreamRemoteUrl' ifTrue: [ ^ { (anEntry at: #upstreamRemoteUrl) } ]. ^ #( ) ] @@ -93,7 +94,7 @@ MCPToolSearchRepositories >> matchesFieldFiltersOnRepositoryEntry: anEntry query fieldFilters: queryRequest fieldFilters matchUsing: [ :fieldName | self fieldTextsForRepositoryEntry: anEntry fieldName: fieldName ] mode: queryRequest filterMode - caseSensitive: queryRequest caseSensitive + caseSensitive: false ] { #category : 'private - template' } @@ -117,10 +118,7 @@ MCPToolSearchRepositories >> repositoryEntriesForRequest: queryRequest [ | repositoryInfo queryEntry | repositoryInfo := MCPRepositoryInfo fromRepository: eachRepository. queryEntry := repositoryInfo asQueryDictionary. - (self repositoryEntry: queryEntry matchesRequest: queryRequest) ifTrue: [ - entries add: (queryRequest includeDetails - ifTrue: [ repositoryInfo asDetailedSearchDictionary ] - ifFalse: [ repositoryInfo asSearchDictionary ]) ] ]. + (self repositoryEntry: queryEntry matchesRequest: queryRequest) ifTrue: [ entries add: repositoryInfo asSearchDictionary ] ]. sortedEntries := entries asArray sort: [ :left :right | (left at: #name) <= (right at: #name) ]. ^ sortedEntries ] @@ -149,15 +147,21 @@ MCPToolSearchRepositories >> repositoryEntrySchema [ { #category : 'private - schema' } MCPToolSearchRepositories >> repositoryFieldFilterInputProperties [ - ^ self repositoryFilterFieldNames collect: [ :fieldName | self repositoryTextFilterPropertyNamed: fieldName description: nil ] + ^ { + (self repositoryTextFilterPropertyNamed: 'name' description: 'Match repository names case-insensitively.'). + (self repositoryTextFilterPropertyNamed: 'location' description: 'Match repository directory paths case-insensitively.'). + (self repositoryTextFilterPropertyNamed: 'subdirectory' description: 'Match source subdirectories case-insensitively.'). + (self repositoryTextFilterPropertyNamed: 'packageName' description: 'Match managed package names case-insensitively.'). + (self + repositoryTextFilterPropertyNamed: 'className' + description: 'Match loaded class names in managed packages case-insensitively.'). + (self repositoryTextFilterPropertyNamed: 'modifiedPackageName' description: 'Match modified package names case-insensitively.') } ] { #category : 'private - request' } MCPToolSearchRepositories >> repositoryFilterFieldNames [ - ^ #( 'repositoryName' 'repositoryClassName' 'location' 'subdirectory' 'branchName' 'headDescription' 'headClassName' - 'headCommitId' 'packageName' 'modifiedPackageName' 'remoteName' 'remoteUrl' 'upstreamRemoteName' 'upstreamBranchName' - 'upstreamRemoteUrl' ) + ^ #( 'name' 'location' 'subdirectory' 'packageName' 'className' 'modifiedPackageName' ) ] { #category : 'private - schema' } @@ -167,17 +171,10 @@ MCPToolSearchRepositories >> repositoryInfoDataProperties [ (self schemaPropertyNamed: 'name' type: 'string' description: 'Repository name.'). (self schemaPropertyNamed: 'location' type: 'string' description: 'Repository directory.'). (self schemaPropertyNamed: 'subdirectory' type: 'string' description: 'Repository source subdirectory.'). - (self schemaPropertyNamed: 'branchName' type: 'string' description: 'Current branch.'). - (self schemaPropertyNamed: 'headDescription' type: 'string' description: 'Current HEAD description.'). - (self schemaPropertyNamed: 'headCommitId' type: 'string' description: 'Current HEAD commit id.'). (self booleanSchemaPropertyNamed: 'isModified' description: 'Whether repository has image-side modifications.'). (self booleanSchemaPropertyNamed: 'isMissing' description: 'Whether repository directory is missing.'). - (self booleanSchemaPropertyNamed: 'isDetachedHead' description: 'Whether repository is detached.'). (self stringArraySchemaNamed: 'packageNames' description: 'Managed packages.' itemDescription: 'Package name.'). - (self stringArraySchemaNamed: 'modifiedPackageNames' description: 'Modified packages.' itemDescription: 'Package name.'). - (self schemaPropertyNamed: 'upstreamRemoteName' type: 'string' description: 'Upstream remote name when configured.'). - (self schemaPropertyNamed: 'upstreamBranchName' type: 'string' description: 'Upstream branch when configured.'). - (self schemaPropertyNamed: 'upstreamRemoteUrl' type: 'string' description: 'Upstream remote URL when configured.') } + (self stringArraySchemaNamed: 'modifiedPackageNames' description: 'Modified packages.' itemDescription: 'Package name.') } ] { #category : 'private - schema' } From da9bba6cbcf23c0dba161b6b9e2075bcbfa232b2 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Mon, 31 Aug 2026 11:40:13 +0200 Subject: [PATCH 14/17] Rename repository tool selector input --- .../MCPJSONSchemaValidatorTest.class.st | 36 ++--- src/MCP-Tests/MCPRepositorySpecTest.class.st | 24 +-- src/MCP-Tests/MCPToolContractsTest.class.st | 36 ++--- .../MCPToolLoadRepositoryTest.class.st | 2 +- .../MCPToolRepositoryOperationTest.class.st | 146 +++++++++--------- .../MCPToolRepositoryToolsTest.class.st | 90 +++++------ .../MCPAdoptRepositoryHeadCommand.class.st | 2 +- src/MCP/MCPLoadRepositoryRequest.class.st | 4 +- src/MCP/MCPRepositoryCommand.class.st | 2 +- src/MCP/MCPRepositoryReferenceSpec.class.st | 6 +- ...CPRepositoryVerifyIdentityCommand.class.st | 2 +- src/MCP/MCPToolAddRepositoryRemote.class.st | 2 +- .../MCPToolCheckoutRepositoryBranch.class.st | 2 +- src/MCP/MCPToolCommitRepository.class.st | 2 +- .../MCPToolCreateRepositoryBranch.class.st | 2 +- src/MCP/MCPToolLoadRepository.class.st | 2 +- .../MCPToolRemoveRepositoryRemote.class.st | 2 +- src/MCP/MCPToolRepositoryOperation.class.st | 4 +- .../MCPToolSwitchRepositoryBranch.class.st | 2 +- .../MCPToolUpdateRepositoryRemote.class.st | 2 +- 20 files changed, 185 insertions(+), 185 deletions(-) diff --git a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st index d88f96b..924819c 100644 --- a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st +++ b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st @@ -25,42 +25,42 @@ MCPJSONSchemaValidatorTest >> baseRepresentativeArgumentsByToolClass [ (#selectors -> #( 'temporarySelector' )) } asDictionary). (MCPToolSearchRepositories -> Dictionary new). (MCPToolVerifyRepositoryIdentity -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary). - (MCPToolListRepositoryChanges -> { (#repositoryName -> 'MCP') } asDictionary). - (MCPToolDiscardRepositoryChanges -> { (#repositoryName -> 'MCP') } asDictionary). + (MCPToolListRepositoryChanges -> { (#name -> 'MCP') } asDictionary). + (MCPToolDiscardRepositoryChanges -> { (#name -> 'MCP') } asDictionary). (MCPToolRepositoryOperation -> { (#action -> 'update'). - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#addPackageNames -> #( 'MCP' )) } asDictionary). (MCPToolAddRepositoryRemote -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#remoteName -> 'origin'). (#remoteUrl -> 'git@example.com:mcp.git') } asDictionary). (MCPToolRemoveRepositoryRemote -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#remoteName -> 'origin') } asDictionary). (MCPToolUpdateRepositoryRemote -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#remoteName -> 'origin'). (#remoteUrl -> 'git@example.com:mcp.git') } asDictionary). - (MCPToolExportRepository -> { (#repositoryName -> 'MCP') } asDictionary). + (MCPToolExportRepository -> { (#name -> 'MCP') } asDictionary). (MCPToolCommitRepository -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#message -> 'Example commit') } asDictionary). - (MCPToolFetchRepository -> { (#repositoryName -> 'MCP') } asDictionary). - (MCPToolPullRepository -> { (#repositoryName -> 'MCP') } asDictionary). - (MCPToolPushRepository -> { (#repositoryName -> 'MCP') } asDictionary). + (MCPToolFetchRepository -> { (#name -> 'MCP') } asDictionary). + (MCPToolPullRepository -> { (#name -> 'MCP') } asDictionary). + (MCPToolPushRepository -> { (#name -> 'MCP') } asDictionary). (MCPToolCreateRepositoryBranch -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'example-branch') } asDictionary). (MCPToolSwitchRepositoryBranch -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary). (MCPToolCheckoutRepositoryBranch -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary). - (MCPToolAdoptRepositoryHead -> { (#repositoryName -> 'MCP') } asDictionary). + (MCPToolAdoptRepositoryHead -> { (#name -> 'MCP') } asDictionary). (MCPToolLoadRepository -> { (#owner -> 'ExampleOwner'). (#project -> 'ExampleProject'). @@ -211,7 +211,7 @@ MCPJSONSchemaValidatorTest >> representativeArgumentsByToolClass [ at: MCPToolAttachRepository put: { (#name -> 'MCP Test Repository'). (#location -> '/tmp/mcp-test-repository') } asDictionary; - at: MCPToolUpdateRepository put: { (#repositoryName -> 'MCP') } asDictionary; + at: MCPToolUpdateRepository put: { (#name -> 'MCP') } asDictionary; at: MCPToolLoadBaseline put: { (#baseline -> 'ExampleBaseline') } asDictionary; at: MCPToolRunTestCoverage put: { (#classes -> { 'MCPToolContractsTest' }). @@ -291,7 +291,7 @@ MCPJSONSchemaValidatorTest >> testCurrentToolRequestValidationRejectsOperationSp should: [ MCPToolUpdateClassPackage new requestFromToolCallArguments: { (#className -> 'MCPTool') } asDictionary ] raise: MCPInvalidToolInput. self - should: [ MCPToolCommitRepository new requestFromToolCallArguments: { (#repositoryName -> 'MCP') } asDictionary ] + should: [ MCPToolCommitRepository new requestFromToolCallArguments: { (#name -> 'MCP') } asDictionary ] raise: MCPInvalidToolInput. self should: [ MCPToolRunTestCoverage new requestFromToolCallArguments: { (#classes -> { 'MCPToolContractsTest' }) } asDictionary ] diff --git a/src/MCP-Tests/MCPRepositorySpecTest.class.st b/src/MCP-Tests/MCPRepositorySpecTest.class.st index c63f132..c337e12 100644 --- a/src/MCP-Tests/MCPRepositorySpecTest.class.st +++ b/src/MCP-Tests/MCPRepositorySpecTest.class.st @@ -34,7 +34,7 @@ MCPRepositorySpecTest >> testRepositoryAdoptHeadRequestParsesTypedInput [ | adoptHeadRequest | adoptHeadRequest := MCPRepositoryAdoptHeadRequest fromRequest: (self requestWithArguments: { - (#repositoryName -> 'MCP Repo'). + (#name -> 'MCP Repo'). (#branchName -> 'main') } asDictionary) tool: nil. self assert: adoptHeadRequest operation equals: 'adoptHead'. @@ -118,7 +118,7 @@ MCPRepositorySpecTest >> testRepositoryCreateUpdateExportRequestsParseTypedInput self assert: createRequest packageNames equals: #( 'MCP' 'MCP-Tests' ). updateRequest := MCPRepositoryUpdateRequest fromRequest: (self requestWithArguments: { - (#repositoryName -> 'MCP Repo'). + (#name -> 'MCP Repo'). (#subdirectory -> 'src'). (#addPackageNames -> #( 'New-Package' )). (#removePackageNames -> #( 'Old-Package' )) } asDictionary) @@ -128,44 +128,44 @@ MCPRepositorySpecTest >> testRepositoryCreateUpdateExportRequestsParseTypedInput self assert: updateRequest hasUpdates. self assert: updateRequest requestedRepositoryUpdateActions equals: #( 'setSubdirectory' 'addPackages' 'removePackages' ). exportRequest := MCPRepositoryExportRequest - fromRequest: (self requestWithArguments: { (#repositoryName -> 'MCP Repo') } asDictionary) + fromRequest: (self requestWithArguments: { (#name -> 'MCP Repo') } asDictionary) tool: nil. self assert: exportRequest operation equals: 'export'. self assert: exportRequest repositoryReference name equals: 'MCP Repo'. diffRequest := MCPRepositoryDiffRequest - fromRequest: (self requestWithArguments: { (#repositoryName -> 'MCP Repo') } asDictionary) + fromRequest: (self requestWithArguments: { (#name -> 'MCP Repo') } asDictionary) tool: nil. self assert: diffRequest operation equals: 'diff'. self assert: diffRequest repositoryReference name equals: 'MCP Repo'. commitRequest := MCPRepositoryCommitRequest fromRequest: (self requestWithArguments: { - (#repositoryName -> 'MCP Repo'). + (#name -> 'MCP Repo'). (#message -> 'Commit from test') } asDictionary) tool: nil. self assert: commitRequest operation equals: 'commit'. self assert: commitRequest message equals: 'Commit from test'. fetchRequest := MCPRepositoryFetchRequest - fromRequest: (self requestWithArguments: { (#repositoryName -> 'MCP Repo') } asDictionary) + fromRequest: (self requestWithArguments: { (#name -> 'MCP Repo') } asDictionary) tool: nil. self assert: fetchRequest operation equals: 'fetch'. pullRequest := MCPRepositoryPullRequest - fromRequest: (self requestWithArguments: { (#repositoryName -> 'MCP Repo') } asDictionary) + fromRequest: (self requestWithArguments: { (#name -> 'MCP Repo') } asDictionary) tool: nil. self assert: pullRequest operation equals: 'pull'. pushRequest := MCPRepositoryPushRequest - fromRequest: (self requestWithArguments: { (#repositoryName -> 'MCP Repo') } asDictionary) + fromRequest: (self requestWithArguments: { (#name -> 'MCP Repo') } asDictionary) tool: nil. self assert: pushRequest operation equals: 'push'. createBranchRequest := MCPRepositoryCreateBranchRequest fromRequest: (self requestWithArguments: { - (#repositoryName -> 'MCP Repo'). + (#name -> 'MCP Repo'). (#branchName -> 'feature') } asDictionary) tool: nil. self assert: createBranchRequest operation equals: 'createBranch'. self assert: createBranchRequest branchName equals: 'feature'. switchBranchRequest := MCPRepositorySwitchBranchRequest fromRequest: (self requestWithArguments: { - (#repositoryName -> 'MCP Repo'). + (#name -> 'MCP Repo'). (#branchName -> 'main') } asDictionary) tool: nil. self assert: switchBranchRequest operation equals: 'switchBranch'. @@ -245,7 +245,7 @@ MCPRepositorySpecTest >> testRepositoryReferenceResolvesByNameAndLocation [ self withRepositories: { repository } do: [ reference := MCPRepositoryReferenceSpec name: 'MCP Reference Repository' location: FileLocator imageDirectory pathString. self assert: reference repository identicalTo: repository. - self assert: (reference requestedContext at: #repositoryName) equals: 'MCP Reference Repository'. + self assert: (reference requestedContext at: #name) equals: 'MCP Reference Repository'. self assert: (reference requestedContext at: #location) equals: FileLocator imageDirectory pathString ] ] @@ -289,7 +289,7 @@ MCPRepositorySpecTest >> testRepositoryVerifyIdentityRequestParsesTypedInput [ | context verifyIdentityRequest | verifyIdentityRequest := MCPRepositoryVerifyIdentityRequest fromRequest: (self requestWithArguments: { - (#repositoryName -> 'MCP Repo'). + (#name -> 'MCP Repo'). (#location -> '/tmp/MCP'). (#branchName -> 'main'). (#subdirectory -> 'src'). diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index d082fdb..f58e67a 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -648,18 +648,18 @@ MCPToolContractsTest >> repositoryToolFlowSpecs [ { (#toolClass -> MCPToolVerifyRepositoryIdentity). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary). (#requestClass -> MCPRepositoryVerifyIdentityRequest). (#commandClass -> MCPRepositoryVerifyIdentityCommand) } asDictionary. { (#toolClass -> MCPToolListRepositoryChanges). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#requestClass -> MCPRepositoryDiffRequest). (#commandClass -> MCPRepositoryDiffCommand) } asDictionary. { (#toolClass -> MCPToolDiscardRepositoryChanges). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#requestClass -> MCPRepositoryDiscardRequest). (#commandClass -> MCPDiscardRepositoryChangesCommand) } asDictionary. { @@ -679,32 +679,32 @@ MCPToolContractsTest >> repositoryToolFlowSpecs [ { (#toolClass -> MCPToolUpdateRepository). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#addPackageNames -> #( 'MCP' )) } asDictionary). (#requestClass -> MCPRepositoryUpdateRequest). (#commandClass -> MCPUpdateRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolExportRepository). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#requestClass -> MCPRepositoryExportRequest). (#commandClass -> MCPExportRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolCommitRepository). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#message -> 'Commit from test') } asDictionary). (#requestClass -> MCPRepositoryCommitRequest). (#commandClass -> MCPCommitRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolFetchRepository). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#requestClass -> MCPRepositoryFetchRequest). (#commandClass -> MCPFetchRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolAddRepositoryRemote). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#remoteName -> 'origin'). (#remoteUrl -> 'git@example.com:mcp.git') } asDictionary). (#requestClass -> MCPRepositoryRemoteRequest). @@ -713,7 +713,7 @@ MCPToolContractsTest >> repositoryToolFlowSpecs [ { (#toolClass -> MCPToolRemoveRepositoryRemote). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#remoteName -> 'origin') } asDictionary). (#requestClass -> MCPRepositoryRemoteRequest). (#commandClass -> MCPRemoveRepositoryRemoteCommand) } asDictionary. @@ -721,7 +721,7 @@ MCPToolContractsTest >> repositoryToolFlowSpecs [ { (#toolClass -> MCPToolUpdateRepositoryRemote). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#remoteName -> 'origin'). (#remoteUrl -> 'git@example.com:mcp.git') } asDictionary). (#requestClass -> MCPRepositoryRemoteRequest). @@ -731,38 +731,38 @@ MCPToolContractsTest >> repositoryToolFlowSpecs [ { (#toolClass -> MCPToolPullRepository). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#requestClass -> MCPRepositoryPullRequest). (#commandClass -> MCPPullRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolPushRepository). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#requestClass -> MCPRepositoryPushRequest). (#commandClass -> MCPPushRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolCreateRepositoryBranch). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'feature') } asDictionary). (#requestClass -> MCPRepositoryCreateBranchRequest). (#commandClass -> MCPCreateRepositoryBranchCommand) } asDictionary. { (#toolClass -> MCPToolSwitchRepositoryBranch). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary). (#requestClass -> MCPRepositorySwitchBranchRequest). (#commandClass -> MCPSwitchRepositoryBranchCommand) } asDictionary. { (#toolClass -> MCPToolCheckoutRepositoryBranch). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary). (#requestClass -> MCPRepositoryCheckoutBranchRequest). (#commandClass -> MCPCheckoutRepositoryBranchCommand) } asDictionary. { (#toolClass -> MCPToolAdoptRepositoryHead). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#requestClass -> MCPRepositoryAdoptHeadRequest). (#commandClass -> MCPAdoptRepositoryHeadCommand) } asDictionary } ] @@ -1914,9 +1914,9 @@ MCPToolContractsTest >> testRepositoryCreateAndUpdateRequiredArguments [ self assert: MCPToolUpdateRepository new name equals: 'repository_update'. self assert: MCPToolCreateRepository new inputSchema required asArray equals: #( 'name' 'location' ). self assert: MCPToolAttachRepository new inputSchema required asArray equals: #( 'name' 'location' ). - self assert: MCPToolUpdateRepository new inputSchema required asArray equals: #( 'repositoryName' ). + self assert: MCPToolUpdateRepository new inputSchema required asArray equals: #( 'name' ). #( 'name' 'location' 'subdirectory' 'packageNames' ) do: [ :each | self assert: (createPropertyNames includes: each) ]. - #( 'repositoryName' 'location' 'subdirectory' 'packageNames' 'addPackageNames' 'removePackageNames' ) do: [ :each | + #( 'name' 'location' 'subdirectory' 'packageNames' 'addPackageNames' 'removePackageNames' ) do: [ :each | self assert: (updatePropertyNames includes: each) ]. self deny: (createPropertyNames includes: 'operation'). self deny: (updatePropertyNames includes: 'operation') diff --git a/src/MCP-Tests/MCPToolLoadRepositoryTest.class.st b/src/MCP-Tests/MCPToolLoadRepositoryTest.class.st index 2be2992..82459d9 100644 --- a/src/MCP-Tests/MCPToolLoadRepositoryTest.class.st +++ b/src/MCP-Tests/MCPToolLoadRepositoryTest.class.st @@ -150,7 +150,7 @@ MCPToolLoadRepositoryTest >> testRepositoryLoadAcceptsRegisteredIcebergRepositor repository := MCPTestIceRepository named: 'MCP Load Registered Repository' location: FileLocator imageDirectory pathString. self withRegisteredRepository: repository do: [ request := self loadRepositoryRequestFromArguments: { - (#repositoryName -> repository name). + (#name -> repository name). (#baseline -> 'MCP'). (#sourceDirectory -> 'src') }. self assert: request mode equals: 'iceberg'. diff --git a/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st b/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st index dd700bf..4421b21 100644 --- a/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st +++ b/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st @@ -195,7 +195,7 @@ MCPToolRepositoryOperationTest >> testAdoptHeadAdoptsRepositoryHeadAndReportsBef self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'adoptHead'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'main') } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -226,7 +226,7 @@ MCPToolRepositoryOperationTest >> testAdoptHeadClearsModifiedPackagesWhenReferen self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'adoptHead'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'main') } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -242,7 +242,7 @@ MCPToolRepositoryOperationTest >> testAdoptHeadOperationRequiresRepositoryAndPar | command parsedRequest rawRequest tool | tool := MCPToolAdoptRepositoryHead new. rawRequest := tool requestFromToolCallArguments: { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary. parsedRequest := tool parsedRequestFromToolRequest: rawRequest. command := tool commandForRequest: parsedRequest. @@ -262,7 +262,7 @@ MCPToolRepositoryOperationTest >> testAdoptHeadValidatesExpectedBranch [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'adoptHead'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'feature') } asDictionary. self assert: (self resultIndicatesError: result). self assert: ((self summaryFrom: result) includesSubstring: 'branch mismatch'). @@ -307,10 +307,10 @@ MCPToolRepositoryOperationTest >> testAttachRegistersExistingGitCheckout [ (#packageNames -> { packageName }) } asDictionary. self callToolWith: { (#action -> 'export'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. self callToolWith: { (#action -> 'commit'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#message -> 'Prepare existing checkout attach test') } asDictionary. self removeRegisteredRepositoriesNamed: repositoryName. result := self callToolWith: { @@ -346,10 +346,10 @@ MCPToolRepositoryOperationTest >> testAttachRegistersLinkedGitWorktreeCheckout [ (#packageNames -> { packageName }) } asDictionary. self callToolWith: { (#action -> 'export'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. self callToolWith: { (#action -> 'commit'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#message -> 'Prepare linked checkout for attach test') } asDictionary. self shellCommand: 'git -C ' , (self shellQuote: location pathString) , ' worktree add -b attach-linked-test ' , (self shellQuote: linkedLocation pathString). @@ -428,7 +428,7 @@ MCPToolRepositoryOperationTest >> testCheckoutBranchLoadsTargetBranchSnapshot [ (#packageNames -> { packageName }) } asDictionary. self callToolWith: { (#action -> 'export'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. self commitAllIn: location message: 'Prepare checkout base branch'. repository := IceRepository repositories detect: [ :each | each name asString = repositoryName ]. baseBranch := repository branchName. @@ -436,7 +436,7 @@ MCPToolRepositoryOperationTest >> testCheckoutBranchLoadsTargetBranchSnapshot [ (Smalltalk at: className asSymbol) compile: 'staleBranchOnlyValue ^ 42' classified: 'tests'. self callToolWith: { (#action -> 'export'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. self commitAllIn: location message: 'Add branch-only method'. self removeRegisteredRepositoriesNamed: repositoryName. self callToolWith: { @@ -446,7 +446,7 @@ MCPToolRepositoryOperationTest >> testCheckoutBranchLoadsTargetBranchSnapshot [ (#packageNames -> { packageName }) } asDictionary. self assert: ((Smalltalk at: className asSymbol) includesSelector: extraSelector). checkoutResult := self callToolNamed: 'repository_branch_checkout' with: { - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#branchName -> baseBranch) } asDictionary. self deny: (self resultIndicatesError: checkoutResult) description: (self summaryFrom: checkoutResult). self deny: ((Smalltalk at: className asSymbol) includesSelector: extraSelector) ] ] @@ -468,7 +468,7 @@ MCPToolRepositoryOperationTest >> testCommitCreatesCommitAndReturnsResult [ (#packageNames -> { packageName }) } asDictionary. result := self callToolWith: { (#action -> 'commit'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#message -> 'Initial commit MCP test') } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -485,7 +485,7 @@ MCPToolRepositoryOperationTest >> testCommitParsesAndDispatchesToCommitCommand [ | command parsedRequest rawRequest tool | tool := MCPToolCommitRepository new. rawRequest := tool requestFromToolCallArguments: { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#message -> 'Commit from test') } asDictionary. parsedRequest := tool parsedRequestFromToolRequest: rawRequest. command := tool commandForRequest: parsedRequest. @@ -512,11 +512,11 @@ MCPToolRepositoryOperationTest >> testCommitReportsIcebergRefusalErrors [ (#packageNames -> { packageName }) } asDictionary. self callToolWith: { (#action -> 'commit'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#message -> 'Initial commit from MCP test') } asDictionary. result := self callToolWith: { (#action -> 'commit'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#message -> 'Second commit from MCP test') } asDictionary. self assert: (self resultIndicatesError: result). self assert: ((self summaryFrom: result) includesSubstring: 'Failed to commit repository') ] ] @@ -539,7 +539,7 @@ MCPToolRepositoryOperationTest >> testCommitRequestsImageSaveAfterSuccessfulExec server := MCPSaveImageRecordingServer new. self deny: server didSaveImageSession. result := server rpcToolCall: 'repository_commit' withParams: { - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#message -> 'Commit and save from MCP test') } asDictionary. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). self assert: server didSaveImageSession ] ] @@ -564,7 +564,7 @@ MCPToolRepositoryOperationTest >> testCommitUsesFallbackGitIdentityWhenGitSignat self shellCommand: 'git -C ' , (self shellQuote: location pathString) , ' config user.email ' , (self shellQuote: ''). result := self callToolWith: { (#action -> 'commit'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#message -> message) } asDictionary. data := self dataFrom: result. self assert: (data at: #commitDescription) equals: message. @@ -582,7 +582,7 @@ MCPToolRepositoryOperationTest >> testCreateBranchReturnsResultReportsErrorsAndR server := MCPSaveImageRecordingServer new. result := self callToolWith: { (#action -> 'createBranch'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'feature') } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -593,13 +593,13 @@ MCPToolRepositoryOperationTest >> testCreateBranchReturnsResultReportsErrorsAndR self assert: (data at: #previousHeadDescription) equals: 'initial'. self assert: (data at: #headDescription) equals: 'branch feature'. saveResult := server rpcToolCall: 'repository_branch_create' withParams: { - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'feature-save') } asDictionary. self deny: (self resultIndicatesError: saveResult) description: (self summaryFrom: saveResult). self assert: server didSaveImageSession. duplicateResult := self callToolWith: { (#action -> 'createBranch'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'feature') } asDictionary. self assert: (self resultIndicatesError: duplicateResult). self assert: ((self summaryFrom: duplicateResult) includesSubstring: 'Failed to create repository branch'). @@ -609,7 +609,7 @@ MCPToolRepositoryOperationTest >> testCreateBranchReturnsResultReportsErrorsAndR self withRegisteredRepository: repository do: [ failureResult := self callToolWith: { (#action -> 'createBranch'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'bad branch') } asDictionary. self assert: (self resultIndicatesError: failureResult). self assert: ((self summaryFrom: failureResult) includesSubstring: 'Failed to create repository branch'). @@ -645,7 +645,7 @@ MCPToolRepositoryOperationTest >> testDiffCanReportImageModifiedPackagesWithoutW self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'diff'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. data := self dataFrom: result. self deny: (result at: #isError ifAbsent: false). self assert: (data at: #isEmpty) equals: false. @@ -669,7 +669,7 @@ MCPToolRepositoryOperationTest >> testDiffDoesNotRequestImageSaveAfterSuccessful (#location -> location pathString). (#packageNames -> { packageName }) } asDictionary. server := MCPSaveImageRecordingServer new. - result := server rpcToolCall: 'repository_change_list' withParams: { (#repositoryName -> repositoryName) } asDictionary. + result := server rpcToolCall: 'repository_change_list' withParams: { (#name -> repositoryName) } asDictionary. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). self deny: server didSaveImageSession ] ] ] @@ -679,7 +679,7 @@ MCPToolRepositoryOperationTest >> testDiffParsesAndDispatchesToDiffCommand [ | command parsedRequest rawRequest tool | tool := MCPToolListRepositoryChanges new. - rawRequest := tool requestFromToolCallArguments: { (#repositoryName -> 'MCP') } asDictionary. + rawRequest := tool requestFromToolCallArguments: { (#name -> 'MCP') } asDictionary. parsedRequest := tool parsedRequestFromToolRequest: rawRequest. command := tool commandForRequest: parsedRequest. @@ -706,7 +706,7 @@ MCPToolRepositoryOperationTest >> testDiffReportsWorkingCopyDiffWithoutWriting [ self assert: repository index isEmpty. result := self callToolWith: { (#action -> 'diff'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. data := self dataFrom: result. childNames := self directChildNamesOf: location. self deny: (result at: #isError ifAbsent: false). @@ -726,7 +726,7 @@ MCPToolRepositoryOperationTest >> testDiscardCleanRepositoryDoesNothing [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'discard'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. data := self dataFrom: result. self deny: (result at: #isError ifAbsent: [ false ]). self assert: (data at: #isEmpty) equals: true. @@ -745,7 +745,7 @@ MCPToolRepositoryOperationTest >> testDiscardClearsImageModifiedPackages [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'discard'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. data := self dataFrom: result. self deny: (result at: #isError ifAbsent: [ false ]). self assert: (data at: #isEmpty) equals: false. @@ -761,7 +761,7 @@ MCPToolRepositoryOperationTest >> testDiscardParsesAndDispatchesToDiscardCommand | command parsedRequest rawRequest tool | tool := MCPToolDiscardRepositoryChanges new. - rawRequest := tool requestFromToolCallArguments: { (#repositoryName -> 'MCP') } asDictionary. + rawRequest := tool requestFromToolCallArguments: { (#name -> 'MCP') } asDictionary. parsedRequest := tool parsedRequestFromToolRequest: rawRequest. command := tool commandForRequest: parsedRequest. @@ -786,7 +786,7 @@ MCPToolRepositoryOperationTest >> testExportUpdatesDiskAndIndexWithoutCommitting (#packageNames -> { packageName }) } asDictionary. result := self callToolWith: { (#action -> 'export'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. data := self dataFrom: result. childNames := self directChildNamesOf: location. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -805,7 +805,7 @@ MCPToolRepositoryOperationTest >> testFetchReturnsResultShapeAndReportsErrors [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'fetch'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). self assert: repository actionLog asArray equals: #( 'fetch:origin' ). @@ -817,7 +817,7 @@ MCPToolRepositoryOperationTest >> testFetchReturnsResultShapeAndReportsErrors [ self withRegisteredRepository: repository do: [ errorResult := self callToolWith: { (#action -> 'fetch'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. self assert: (self resultIndicatesError: errorResult). self assert: ((self summaryFrom: errorResult) includesSubstring: 'Failed to fetch repository') ] ] @@ -866,11 +866,11 @@ MCPToolRepositoryOperationTest >> testLinkedWorktreeAttachExportsOnLinkedBranch self deny: (self resultIndicatesError: createResult) description: (self summaryFrom: createResult). exportResult := self callToolWith: { (#action -> 'export'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. self deny: (self resultIndicatesError: exportResult) description: (self summaryFrom: exportResult). commitResult := self callToolWith: { (#action -> 'commit'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#message -> 'Prepare linked checkout contract test') } asDictionary. self deny: (self resultIndicatesError: commitResult) description: (self summaryFrom: commitResult). self shellCommand: 'git -C ' , (self shellQuote: location pathString) , ' remote add origin https://example.com/worktree.git'. @@ -902,7 +902,7 @@ MCPToolRepositoryOperationTest >> testLinkedWorktreeAttachExportsOnLinkedBranch self createClassNamed: exportedClassName inPackageNamed: packageName. exportResult := self callToolWith: { (#action -> 'export'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. self deny: (self resultIndicatesError: exportResult) description: (self summaryFrom: exportResult). self assert: exportedClassFile exists ] ensure: [ self removeClassNamed: exportedClassName. @@ -921,7 +921,7 @@ MCPToolRepositoryOperationTest >> testPullReportsIcebergMergeAndLoadErrors [ self withRegisteredRepository: repository do: [ mergeErrorResult := self callToolWith: { (#action -> 'pull'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. self assert: (self resultIndicatesError: mergeErrorResult). self assert: ((self summaryFrom: mergeErrorResult) includesSubstring: 'Failed to pull repository'). self assert: ((self summaryFrom: mergeErrorResult) includesSubstring: 'Iceberg merge failed') ]. @@ -930,7 +930,7 @@ MCPToolRepositoryOperationTest >> testPullReportsIcebergMergeAndLoadErrors [ self withRegisteredRepository: repository do: [ loadErrorResult := self callToolWith: { (#action -> 'pull'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. self assert: (self resultIndicatesError: loadErrorResult). self assert: ((self summaryFrom: loadErrorResult) includesSubstring: 'Failed to pull repository'). self assert: ((self summaryFrom: loadErrorResult) includesSubstring: 'Iceberg load failed') ] @@ -945,14 +945,14 @@ MCPToolRepositoryOperationTest >> testPullReturnsResultReportsErrorsAndRequestsI server := MCPSaveImageRecordingServer new. result := self callToolWith: { (#action -> 'pull'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). self assert: repository actionLog asArray equals: #( 'pull' ). self assert: data keys asSet equals: #( branchName headDescription modifiedPackageNames ) asSet. self assert: (data at: #headDescription) equals: 'after pull'. self assert: (data at: #modifiedPackageNames) equals: #( 'MCP-Test-Pulled' ). - saveResult := server rpcToolCall: 'repository_pull' withParams: { (#repositoryName -> repository name) } asDictionary. + saveResult := server rpcToolCall: 'repository_pull' withParams: { (#name -> repository name) } asDictionary. self deny: (self resultIndicatesError: saveResult) description: (self summaryFrom: saveResult). self assert: server didSaveImageSession ]. repository := self newTestRepositoryNamed: 'MCP Pull Error Test Repository'. @@ -960,7 +960,7 @@ MCPToolRepositoryOperationTest >> testPullReturnsResultReportsErrorsAndRequestsI self withRegisteredRepository: repository do: [ errorResult := self callToolWith: { (#action -> 'pull'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. self assert: (self resultIndicatesError: errorResult). self assert: ((self summaryFrom: errorResult) includesSubstring: 'Failed to pull repository') ] ] @@ -991,7 +991,7 @@ MCPToolRepositoryOperationTest >> testPushPublishesCurrentBranchUsingRequestedRe self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'push'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#remoteName -> 'backup') } asDictionary. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). remoteHead := (LibC resultOfCommand: @@ -1032,7 +1032,7 @@ MCPToolRepositoryOperationTest >> testPushPublishesCurrentBranchWhenUpstreamIsMi self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'push'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). self assert: repository actionLog asArray equals: #( ). remoteHead := (LibC resultOfCommand: @@ -1056,7 +1056,7 @@ MCPToolRepositoryOperationTest >> testPushReportsRemoteAndAuthenticationErrors [ self withRegisteredRepository: repository do: [ remoteErrorResult := self callToolWith: { (#action -> 'push'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. self assert: (self resultIndicatesError: remoteErrorResult). self assert: ((self summaryFrom: remoteErrorResult) includesSubstring: 'Failed to push repository'). self assert: ((self summaryFrom: remoteErrorResult) includesSubstring: 'Iceberg remote not found') ]. @@ -1065,7 +1065,7 @@ MCPToolRepositoryOperationTest >> testPushReportsRemoteAndAuthenticationErrors [ self withRegisteredRepository: repository do: [ authErrorResult := self callToolWith: { (#action -> 'push'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. self assert: (self resultIndicatesError: authErrorResult). self assert: ((self summaryFrom: authErrorResult) includesSubstring: 'Failed to push repository'). self assert: ((self summaryFrom: authErrorResult) includesSubstring: 'Iceberg authentication failed') ] @@ -1101,7 +1101,7 @@ MCPToolRepositoryOperationTest >> testPushRequiresRemoteNameWhenMultipleNonOrigi self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'push'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. self assert: (self resultIndicatesError: result). self assert: ((self errorFrom: result) at: #errorCode) equals: 'RepositoryRemoteRequired' ] ] ensure: [ self deleteDirectoryIfExists: location. @@ -1118,13 +1118,13 @@ MCPToolRepositoryOperationTest >> testPushReturnsResultReportsErrorsAndRequestsI server := MCPSaveImageRecordingServer new. result := self callToolWith: { (#action -> 'push'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). self assert: repository actionLog asArray equals: #( 'push' ). self assert: data keys asSet equals: #( branchName headDescription ) asSet. self assert: (data at: #headDescription) equals: 'after push'. - saveResult := server rpcToolCall: 'repository_push' withParams: { (#repositoryName -> repository name) } asDictionary. + saveResult := server rpcToolCall: 'repository_push' withParams: { (#name -> repository name) } asDictionary. self deny: (self resultIndicatesError: saveResult) description: (self summaryFrom: saveResult). self assert: server didSaveImageSession ]. repository := self newTestRepositoryNamed: 'MCP Push Error Test Repository'. @@ -1132,7 +1132,7 @@ MCPToolRepositoryOperationTest >> testPushReturnsResultReportsErrorsAndRequestsI self withRegisteredRepository: repository do: [ errorResult := self callToolWith: { (#action -> 'push'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. self assert: (self resultIndicatesError: errorResult). self assert: ((self summaryFrom: errorResult) includesSubstring: 'Failed to push repository') ] ] @@ -1162,7 +1162,7 @@ MCPToolRepositoryOperationTest >> testPushUsesGitCommandForRealWorktree [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'push'). - (#repositoryName -> repositoryName) } asDictionary. + (#name -> repositoryName) } asDictionary. self deny: (result at: #isError ifAbsent: false). self assert: repository actionLog asArray equals: #( ). remoteHead := (LibC resultOfCommand: 'git --git-dir ' , (self shellQuote: bareLocation pathString) , ' rev-parse main') @@ -1182,26 +1182,26 @@ MCPToolRepositoryOperationTest >> testRemoteAndBranchOperationsParseAndDispatch (#action -> 'fetch'). (#requestClass -> MCPRepositoryFetchRequest). (#commandClass -> MCPFetchRepositoryCommand). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary) } asDictionary. + (#arguments -> { (#name -> 'MCP') } asDictionary) } asDictionary. { (#toolClass -> MCPToolPullRepository). (#action -> 'pull'). (#requestClass -> MCPRepositoryPullRequest). (#commandClass -> MCPPullRepositoryCommand). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary) } asDictionary. + (#arguments -> { (#name -> 'MCP') } asDictionary) } asDictionary. { (#toolClass -> MCPToolPushRepository). (#action -> 'push'). (#requestClass -> MCPRepositoryPushRequest). (#commandClass -> MCPPushRepositoryCommand). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary) } asDictionary. + (#arguments -> { (#name -> 'MCP') } asDictionary) } asDictionary. { (#toolClass -> MCPToolCreateRepositoryBranch). (#action -> 'createBranch'). (#requestClass -> MCPRepositoryCreateBranchRequest). (#commandClass -> MCPCreateRepositoryBranchCommand). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'feature') } asDictionary) } asDictionary. { (#toolClass -> MCPToolSwitchRepositoryBranch). @@ -1209,7 +1209,7 @@ MCPToolRepositoryOperationTest >> testRemoteAndBranchOperationsParseAndDispatch (#requestClass -> MCPRepositorySwitchBranchRequest). (#commandClass -> MCPSwitchRepositoryBranchCommand). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary) } asDictionary. { (#toolClass -> MCPToolCheckoutRepositoryBranch). @@ -1217,7 +1217,7 @@ MCPToolRepositoryOperationTest >> testRemoteAndBranchOperationsParseAndDispatch (#requestClass -> MCPRepositoryCheckoutBranchRequest). (#commandClass -> MCPCheckoutRepositoryBranchCommand). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary) } asDictionary }. cases do: [ :each | | command parsedRequest rawRequest tool | @@ -1244,7 +1244,7 @@ MCPToolRepositoryOperationTest >> testRemoteToolsManageGitRemotes [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'remoteAdd'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#remoteName -> 'origin'). (#remoteUrl -> 'git@example.com:one.git') } asDictionary. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -1253,7 +1253,7 @@ MCPToolRepositoryOperationTest >> testRemoteToolsManageGitRemotes [ result := self callToolWith: { (#action -> 'remoteUpdate'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#remoteName -> 'origin'). (#remoteUrl -> 'git@example.com:two.git') } asDictionary. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -1262,7 +1262,7 @@ MCPToolRepositoryOperationTest >> testRemoteToolsManageGitRemotes [ result := self callToolWith: { (#action -> 'remoteRemove'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#remoteName -> 'origin') } asDictionary. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). self assert: ((self dataFrom: result) at: #remotes) equals: #( ) ] ] ensure: [ self deleteDirectoryIfExists: location ] @@ -1277,7 +1277,7 @@ MCPToolRepositoryOperationTest >> testRepositoryErrorDetailsIncludeAction [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'push'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. self assert: (self resultIndicatesError: result). errorDetails := self errorFrom: result. self assert: (errorDetails at: #action) equals: 'push' ] @@ -1315,7 +1315,7 @@ MCPToolRepositoryOperationTest >> testSwitchBranchReturnsResultReportsErrorsAndR server := MCPSaveImageRecordingServer new. result := self callToolWith: { (#action -> 'switchBranch'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'feature') } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -1325,13 +1325,13 @@ MCPToolRepositoryOperationTest >> testSwitchBranchReturnsResultReportsErrorsAndR self assert: (data at: #previousHeadDescription) equals: 'branch main'. self assert: (data at: #headDescription) equals: 'branch feature'. saveResult := server rpcToolCall: 'repository_branch_switch' withParams: { - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'main') } asDictionary. self deny: (self resultIndicatesError: saveResult) description: (self summaryFrom: saveResult). self assert: server didSaveImageSession. missingResult := self callToolWith: { (#action -> 'switchBranch'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'missing') } asDictionary. self assert: (self resultIndicatesError: missingResult). self assert: ((self summaryFrom: missingResult) includesSubstring: 'Failed to switch repository branch'). @@ -1342,7 +1342,7 @@ MCPToolRepositoryOperationTest >> testSwitchBranchReturnsResultReportsErrorsAndR self withRegisteredRepository: repository do: [ conflictResult := self callToolWith: { (#action -> 'switchBranch'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'feature') } asDictionary. self assert: (self resultIndicatesError: conflictResult). self assert: ((self summaryFrom: conflictResult) includesSubstring: 'Failed to switch repository branch'). @@ -1353,7 +1353,7 @@ MCPToolRepositoryOperationTest >> testSwitchBranchReturnsResultReportsErrorsAndR self withRegisteredRepository: repository do: [ loadResult := self callToolWith: { (#action -> 'switchBranch'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'feature') } asDictionary. self assert: (self resultIndicatesError: loadResult). self assert: ((self summaryFrom: loadResult) includesSubstring: 'Failed to switch repository branch'). @@ -1389,7 +1389,7 @@ MCPToolRepositoryOperationTest >> testUpdateAddsPackageToWorkingCopy [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'update'). - (#repositoryName -> repository name). + (#name -> repository name). (#addPackageNames -> { packageName }) } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -1410,7 +1410,7 @@ MCPToolRepositoryOperationTest >> testUpdateCanReplacePackageMembership [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'update'). - (#repositoryName -> repository name). + (#name -> repository name). (#packageNames -> #( 'MCPToolRepositoryOperationNewC' 'MCPToolRepositoryOperationOldB' )) } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -1436,7 +1436,7 @@ MCPToolRepositoryOperationTest >> testUpdateRejectsSubdirectoryForUnbornReposito self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). result := self callToolWith: { (#action -> 'update'). - (#repositoryName -> repositoryName). + (#name -> repositoryName). (#subdirectory -> 'src') } asDictionary. self assert: (self resultIndicatesError: result). error := self errorFrom: result. @@ -1458,7 +1458,7 @@ MCPToolRepositoryOperationTest >> testUpdateRemovesPackageWithoutUnloading [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'update'). - (#repositoryName -> repository name). + (#name -> repository name). (#removePackageNames -> { packageName }) } asDictionary. data := self dataFrom: result. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). @@ -1477,7 +1477,7 @@ MCPToolRepositoryOperationTest >> testVerifyIdentityDoesNotRequestImageSaveAfter self withRegisteredRepository: repository do: [ server := MCPSaveImageRecordingServer new. result := server rpcToolCall: 'repository_identity_verify' withParams: { - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'main') } asDictionary. self deny: (self resultIndicatesError: result) description: (self summaryFrom: result). self deny: server didSaveImageSession ] @@ -1489,7 +1489,7 @@ MCPToolRepositoryOperationTest >> testVerifyIdentityOperationRequiresRepositoryA | command parsedRequest rawRequest tool | tool := MCPToolVerifyRepositoryIdentity new. rawRequest := tool requestFromToolCallArguments: { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main'). (#packageNames -> #( 'MCP' )). (#isModified -> false) } asDictionary. @@ -1513,7 +1513,7 @@ MCPToolRepositoryOperationTest >> testVerifyIdentityPassesWhenExpectedIdentityMa self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'verifyIdentity'). - (#repositoryName -> repository name). + (#name -> repository name). (#location -> repository location). (#branchName -> 'main'). (#subdirectory -> ''). @@ -1536,7 +1536,7 @@ MCPToolRepositoryOperationTest >> testVerifyIdentityReportsStructuredMismatch [ self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'verifyIdentity'). - (#repositoryName -> repository name). + (#name -> repository name). (#branchName -> 'feature'). (#packageNames -> #( 'MCP' 'MCP-Tests' )). (#isModified -> true) } asDictionary. @@ -1561,7 +1561,7 @@ MCPToolRepositoryOperationTest >> testVerifyIdentityReportsWrongLocationAsIdenti self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'verifyIdentity'). - (#repositoryName -> repository name). + (#name -> repository name). (#location -> 'memory://different-location') } asDictionary. self assert: (self resultIndicatesError: result). errorDetails := self errorFrom: result. @@ -1579,7 +1579,7 @@ MCPToolRepositoryOperationTest >> testVerifyIdentityRequiresExpectedIdentityFiel self withRegisteredRepository: repository do: [ result := self callToolWith: { (#action -> 'verifyIdentity'). - (#repositoryName -> repository name) } asDictionary. + (#name -> repository name) } asDictionary. self assert: (self resultIndicatesError: result). errorDetails := self errorFrom: result. self assert: (errorDetails at: #errorCode) equals: 'RepositoryIdentityExpectationRequired'. diff --git a/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st b/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st index b0c0f1b..41adae3 100644 --- a/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st +++ b/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st @@ -30,14 +30,14 @@ MCPToolRepositoryToolsTest >> repositoryToolSpecifications [ { (#toolClass -> MCPToolVerifyRepositoryIdentity). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary). (#action -> 'verifyIdentity'). (#requestClass -> MCPRepositoryVerifyIdentityRequest). (#commandClass -> MCPRepositoryVerifyIdentityCommand) } asDictionary. { (#toolClass -> MCPToolListRepositoryChanges). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#action -> 'diff'). (#requestClass -> MCPRepositoryDiffRequest). (#commandClass -> MCPRepositoryDiffCommand) } asDictionary. @@ -60,28 +60,28 @@ MCPToolRepositoryToolsTest >> repositoryToolSpecifications [ { (#toolClass -> MCPToolUpdateRepository). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#addPackageNames -> #( 'MCP' )) } asDictionary). (#action -> 'update'). (#requestClass -> MCPRepositoryUpdateRequest). (#commandClass -> MCPUpdateRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolExportRepository). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#action -> 'export'). (#requestClass -> MCPRepositoryExportRequest). (#commandClass -> MCPExportRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolCommitRepository). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#message -> 'Commit from test') } asDictionary). (#action -> 'commit'). (#requestClass -> MCPRepositoryCommitRequest). (#commandClass -> MCPCommitRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolFetchRepository). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#action -> 'fetch'). (#requestClass -> MCPRepositoryFetchRequest). (#commandClass -> MCPFetchRepositoryCommand) } asDictionary. @@ -89,7 +89,7 @@ MCPToolRepositoryToolsTest >> repositoryToolSpecifications [ { (#toolClass -> MCPToolAddRepositoryRemote). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#remoteName -> 'origin'). (#remoteUrl -> 'git@example.com:mcp.git') } asDictionary). (#action -> 'remoteAdd'). @@ -99,7 +99,7 @@ MCPToolRepositoryToolsTest >> repositoryToolSpecifications [ { (#toolClass -> MCPToolRemoveRepositoryRemote). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#remoteName -> 'origin') } asDictionary). (#action -> 'remoteRemove'). (#requestClass -> MCPRepositoryRemoteRequest). @@ -108,7 +108,7 @@ MCPToolRepositoryToolsTest >> repositoryToolSpecifications [ { (#toolClass -> MCPToolUpdateRepositoryRemote). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#remoteName -> 'origin'). (#remoteUrl -> 'git@example.com:mcp.git') } asDictionary). (#action -> 'remoteUpdate'). @@ -119,20 +119,20 @@ MCPToolRepositoryToolsTest >> repositoryToolSpecifications [ { (#toolClass -> MCPToolPullRepository). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#action -> 'pull'). (#requestClass -> MCPRepositoryPullRequest). (#commandClass -> MCPPullRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolPushRepository). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#action -> 'push'). (#requestClass -> MCPRepositoryPushRequest). (#commandClass -> MCPPushRepositoryCommand) } asDictionary. { (#toolClass -> MCPToolCreateRepositoryBranch). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'feature') } asDictionary). (#action -> 'createBranch'). (#requestClass -> MCPRepositoryCreateBranchRequest). @@ -140,7 +140,7 @@ MCPToolRepositoryToolsTest >> repositoryToolSpecifications [ { (#toolClass -> MCPToolSwitchRepositoryBranch). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary). (#action -> 'switchBranch'). (#requestClass -> MCPRepositorySwitchBranchRequest). @@ -148,14 +148,14 @@ MCPToolRepositoryToolsTest >> repositoryToolSpecifications [ { (#toolClass -> MCPToolCheckoutRepositoryBranch). (#arguments -> { - (#repositoryName -> 'MCP'). + (#name -> 'MCP'). (#branchName -> 'main') } asDictionary). (#action -> 'checkoutBranch'). (#requestClass -> MCPRepositoryCheckoutBranchRequest). (#commandClass -> MCPCheckoutRepositoryBranchCommand) } asDictionary. { (#toolClass -> MCPToolAdoptRepositoryHead). - (#arguments -> { (#repositoryName -> 'MCP') } asDictionary). + (#arguments -> { (#name -> 'MCP') } asDictionary). (#action -> 'adoptHead'). (#requestClass -> MCPRepositoryAdoptHeadRequest). (#commandClass -> MCPAdoptRepositoryHeadCommand) } asDictionary } @@ -183,23 +183,23 @@ MCPToolRepositoryToolsTest >> testRepositoryToolsRequiredInputs [ | expectations | expectations := { - (MCPToolVerifyRepositoryIdentity -> #( 'repositoryName' )). - (MCPToolListRepositoryChanges -> #( 'repositoryName' )). + (MCPToolVerifyRepositoryIdentity -> #( 'name' )). + (MCPToolListRepositoryChanges -> #( 'name' )). (MCPToolCreateRepository -> #( 'name' 'location' )). (MCPToolAttachRepository -> #( 'name' 'location' )). - (MCPToolUpdateRepository -> #( 'repositoryName' )). - (MCPToolAddRepositoryRemote -> #( 'repositoryName' 'remoteName' 'remoteUrl' )). - (MCPToolRemoveRepositoryRemote -> #( 'repositoryName' 'remoteName' )). - (MCPToolUpdateRepositoryRemote -> #( 'repositoryName' 'remoteName' 'remoteUrl' )). - (MCPToolExportRepository -> #( 'repositoryName' )). - (MCPToolCommitRepository -> #( 'repositoryName' 'message' )). - (MCPToolFetchRepository -> #( 'repositoryName' )). - (MCPToolPullRepository -> #( 'repositoryName' )). - (MCPToolPushRepository -> #( 'repositoryName' )). - (MCPToolCreateRepositoryBranch -> #( 'repositoryName' 'branchName' )). - (MCPToolSwitchRepositoryBranch -> #( 'repositoryName' 'branchName' )). - (MCPToolCheckoutRepositoryBranch -> #( 'repositoryName' 'branchName' )). - (MCPToolAdoptRepositoryHead -> #( 'repositoryName' )) }. + (MCPToolUpdateRepository -> #( 'name' )). + (MCPToolAddRepositoryRemote -> #( 'name' 'remoteName' 'remoteUrl' )). + (MCPToolRemoveRepositoryRemote -> #( 'name' 'remoteName' )). + (MCPToolUpdateRepositoryRemote -> #( 'name' 'remoteName' 'remoteUrl' )). + (MCPToolExportRepository -> #( 'name' )). + (MCPToolCommitRepository -> #( 'name' 'message' )). + (MCPToolFetchRepository -> #( 'name' )). + (MCPToolPullRepository -> #( 'name' )). + (MCPToolPushRepository -> #( 'name' )). + (MCPToolCreateRepositoryBranch -> #( 'name' 'branchName' )). + (MCPToolSwitchRepositoryBranch -> #( 'name' 'branchName' )). + (MCPToolCheckoutRepositoryBranch -> #( 'name' 'branchName' )). + (MCPToolAdoptRepositoryHead -> #( 'name' )) }. expectations do: [ :association | self assert: association key new inputSchema required asArray equals: association value ] ] @@ -224,25 +224,25 @@ MCPToolRepositoryToolsTest >> testRepositoryToolsUseDedicatedInputs [ expectations := { (MCPToolVerifyRepositoryIdentity -> - #( 'repositoryName' 'location' 'branchName' 'subdirectory' 'packageNames' 'modifiedPackageNames' + #( 'name' 'location' 'branchName' 'subdirectory' 'packageNames' 'modifiedPackageNames' 'isModified' )). - (MCPToolListRepositoryChanges -> #( 'repositoryName' 'location' )). + (MCPToolListRepositoryChanges -> #( 'name' 'location' )). (MCPToolCreateRepository -> #( 'name' 'location' 'subdirectory' 'packageNames' )). (MCPToolAttachRepository -> #( 'name' 'location' 'subdirectory' 'packageNames' )). (MCPToolUpdateRepository - -> #( 'repositoryName' 'location' 'subdirectory' 'packageNames' 'addPackageNames' 'removePackageNames' )). - (MCPToolAddRepositoryRemote -> #( 'repositoryName' 'location' 'remoteName' 'remoteUrl' )). - (MCPToolRemoveRepositoryRemote -> #( 'repositoryName' 'location' 'remoteName' )). - (MCPToolUpdateRepositoryRemote -> #( 'repositoryName' 'location' 'remoteName' 'remoteUrl' )). - (MCPToolExportRepository -> #( 'repositoryName' 'location' )). - (MCPToolCommitRepository -> #( 'repositoryName' 'location' 'message' )). - (MCPToolFetchRepository -> #( 'repositoryName' 'location' )). - (MCPToolPullRepository -> #( 'repositoryName' 'location' )). - (MCPToolPushRepository -> #( 'repositoryName' 'location' 'remoteName' )). - (MCPToolCreateRepositoryBranch -> #( 'repositoryName' 'location' 'branchName' )). - (MCPToolSwitchRepositoryBranch -> #( 'repositoryName' 'location' 'branchName' )). - (MCPToolCheckoutRepositoryBranch -> #( 'repositoryName' 'location' 'branchName' )). - (MCPToolAdoptRepositoryHead -> #( 'repositoryName' 'location' 'branchName' )) }. + -> #( 'name' 'location' 'subdirectory' 'packageNames' 'addPackageNames' 'removePackageNames' )). + (MCPToolAddRepositoryRemote -> #( 'name' 'location' 'remoteName' 'remoteUrl' )). + (MCPToolRemoveRepositoryRemote -> #( 'name' 'location' 'remoteName' )). + (MCPToolUpdateRepositoryRemote -> #( 'name' 'location' 'remoteName' 'remoteUrl' )). + (MCPToolExportRepository -> #( 'name' 'location' )). + (MCPToolCommitRepository -> #( 'name' 'location' 'message' )). + (MCPToolFetchRepository -> #( 'name' 'location' )). + (MCPToolPullRepository -> #( 'name' 'location' )). + (MCPToolPushRepository -> #( 'name' 'location' 'remoteName' )). + (MCPToolCreateRepositoryBranch -> #( 'name' 'location' 'branchName' )). + (MCPToolSwitchRepositoryBranch -> #( 'name' 'location' 'branchName' )). + (MCPToolCheckoutRepositoryBranch -> #( 'name' 'location' 'branchName' )). + (MCPToolAdoptRepositoryHead -> #( 'name' 'location' 'branchName' )) }. expectations do: [ :association | | propertyNames | propertyNames := self inputPropertyNamesFor: association key new. diff --git a/src/MCP/MCPAdoptRepositoryHeadCommand.class.st b/src/MCP/MCPAdoptRepositoryHeadCommand.class.st index cfe3715..b5beefd 100644 --- a/src/MCP/MCPAdoptRepositoryHeadCommand.class.st +++ b/src/MCP/MCPAdoptRepositoryHeadCommand.class.st @@ -45,7 +45,7 @@ MCPAdoptRepositoryHeadCommand >> signalMissingHeadCommitFor: aRepository [ signalErrorCode: #RepositoryHeadCommitRequired message: 'Cannot adopt repository HEAD because the repository has no head commit.' details: (self request requestedContext copy - at: #repositoryName put: aRepository name asString; + at: #name put: aRepository name asString; yourself) ] diff --git a/src/MCP/MCPLoadRepositoryRequest.class.st b/src/MCP/MCPLoadRepositoryRequest.class.st index a257359..17787e0 100644 --- a/src/MCP/MCPLoadRepositoryRequest.class.st +++ b/src/MCP/MCPLoadRepositoryRequest.class.st @@ -69,7 +69,7 @@ MCPLoadRepositoryRequest >> ensureSingleRepositorySource [ self repositorySourceCount <= 1 ifTrue: [ ^ self ]. MCPCommandError signalErrorCode: #AmbiguousLoadRepositorySource - message: 'repository_load accepts one source: remote owner/project, repositoryUrl, checkoutPath, or repositoryName/location.' + message: 'repository_load accepts one source: remote owner/project, repositoryUrl, checkoutPath, or name/location.' details: self requestedContext ] @@ -388,7 +388,7 @@ MCPLoadRepositoryRequest >> requestedContext [ sourceDirectory ifNotNil: [ context at: #sourceDirectory put: self sourceDirectory ]. repositoryUrl ifNotNil: [ context at: #repositoryUrl put: repositoryUrl ]. checkoutPath ifNotNil: [ context at: #checkoutPath put: self checkoutPath ]. - self repositoryName ifNotNil: [ :name | context at: #repositoryName put: name ]. + self repositoryName ifNotNil: [ :name | context at: #name put: name ]. self location ifNotNil: [ :repositoryLocation | context at: #location put: repositoryLocation ]. self canResolveRepositoryUrl ifTrue: [ context at: #resolvedRepositoryUrl put: self repositoryUrl ]. ^ context diff --git a/src/MCP/MCPRepositoryCommand.class.st b/src/MCP/MCPRepositoryCommand.class.st index 09351f1..1180b1b 100644 --- a/src/MCP/MCPRepositoryCommand.class.st +++ b/src/MCP/MCPRepositoryCommand.class.st @@ -261,7 +261,7 @@ MCPRepositoryCommand >> signalSubdirectoryRequiresHeadFor: aRepository [ message: 'Repository subdirectory is not supported before the repository has an initial commit. Attach without subdirectory, commit or adopt the initial head, then update the repository subdirectory.' details: { - (#repositoryName -> aRepository name asString). + (#name -> aRepository name asString). (#subdirectory -> self request subdirectory) } asDictionary ] diff --git a/src/MCP/MCPRepositoryReferenceSpec.class.st b/src/MCP/MCPRepositoryReferenceSpec.class.st index 4aca9a9..1d15e22 100644 --- a/src/MCP/MCPRepositoryReferenceSpec.class.st +++ b/src/MCP/MCPRepositoryReferenceSpec.class.st @@ -18,7 +18,7 @@ Class { { #category : 'instance creation' } MCPRepositoryReferenceSpec class >> fromRequest: request [ - ^ self name: (request stringArgumentNamed: 'repositoryName') location: (request stringArgumentNamed: 'location') + ^ self name: (request stringArgumentNamed: 'name') location: (request stringArgumentNamed: 'location') ] { #category : 'instance creation' } @@ -33,7 +33,7 @@ MCPRepositoryReferenceSpec class >> name: aName location: aLocation [ MCPRepositoryReferenceSpec >> asDictionary [ ^ { - (#repositoryName -> self name). + (#name -> self name). (#location -> self location) } asDictionary ] @@ -132,7 +132,7 @@ MCPRepositoryReferenceSpec >> signalMissingRepositoryReference [ MCPCommandError signalErrorCode: #RepositoryReferenceRequired - message: 'Repository tools require repositoryName, location, or both.' + message: 'Repository tools require name, location, or both.' details: self requestedContext ] diff --git a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st index 538de04..acf1d95 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st @@ -164,7 +164,7 @@ MCPRepositoryVerifyIdentityCommand >> signalMissingExpectedIdentityFields [ MCPCommandError signalErrorCode: #RepositoryIdentityExpectationRequired - message: 'repository_identity_verify requires at least one expected identity field besides repositoryName.' + message: 'repository_identity_verify requires at least one expected identity field besides name.' details: (self request requestedContext copy at: #expectedFields put: #( 'location' 'branchName' 'subdirectory' 'packageNames' 'modifiedPackageNames' 'isModified' ); diff --git a/src/MCP/MCPToolAddRepositoryRemote.class.st b/src/MCP/MCPToolAddRepositoryRemote.class.st index 2091959..9ca662e 100644 --- a/src/MCP/MCPToolAddRepositoryRemote.class.st +++ b/src/MCP/MCPToolAddRepositoryRemote.class.st @@ -27,5 +27,5 @@ MCPToolAddRepositoryRemote >> repositoryToolSpec [ (#inputProperties -> { self remoteNameSchemaProperty. self remoteUrlSchemaProperty }). - (#requiredProperties -> #( 'repositoryName' 'remoteName' 'remoteUrl' )) } asDictionary + (#requiredProperties -> #( 'name' 'remoteName' 'remoteUrl' )) } asDictionary ] diff --git a/src/MCP/MCPToolCheckoutRepositoryBranch.class.st b/src/MCP/MCPToolCheckoutRepositoryBranch.class.st index 4d35020..a2d5910 100644 --- a/src/MCP/MCPToolCheckoutRepositoryBranch.class.st +++ b/src/MCP/MCPToolCheckoutRepositoryBranch.class.st @@ -33,5 +33,5 @@ MCPToolCheckoutRepositoryBranch >> repositoryToolSpec [ (#requestClass -> MCPRepositoryCheckoutBranchRequest). (#commandClass -> MCPCheckoutRepositoryBranchCommand). (#inputProperties -> { self branchNameSchemaProperty }). - (#requiredProperties -> #( 'repositoryName' 'branchName' )) } asDictionary + (#requiredProperties -> #( 'name' 'branchName' )) } asDictionary ] diff --git a/src/MCP/MCPToolCommitRepository.class.st b/src/MCP/MCPToolCommitRepository.class.st index 053fbc4..b699537 100644 --- a/src/MCP/MCPToolCommitRepository.class.st +++ b/src/MCP/MCPToolCommitRepository.class.st @@ -25,5 +25,5 @@ MCPToolCommitRepository >> repositoryToolSpec [ (#requestClass -> MCPRepositoryCommitRequest). (#commandClass -> MCPCommitRepositoryCommand). (#inputProperties -> { self messageSchemaProperty }). - (#requiredProperties -> #( 'repositoryName' 'message' )) } asDictionary + (#requiredProperties -> #( 'name' 'message' )) } asDictionary ] diff --git a/src/MCP/MCPToolCreateRepositoryBranch.class.st b/src/MCP/MCPToolCreateRepositoryBranch.class.st index 23a445c..80e21ec 100644 --- a/src/MCP/MCPToolCreateRepositoryBranch.class.st +++ b/src/MCP/MCPToolCreateRepositoryBranch.class.st @@ -25,5 +25,5 @@ MCPToolCreateRepositoryBranch >> repositoryToolSpec [ (#requestClass -> MCPRepositoryCreateBranchRequest). (#commandClass -> MCPCreateRepositoryBranchCommand). (#inputProperties -> { self branchNameSchemaProperty }). - (#requiredProperties -> #( 'repositoryName' 'branchName' )) } asDictionary + (#requiredProperties -> #( 'name' 'branchName' )) } asDictionary ] diff --git a/src/MCP/MCPToolLoadRepository.class.st b/src/MCP/MCPToolLoadRepository.class.st index 87cfde1..afc5f25 100644 --- a/src/MCP/MCPToolLoadRepository.class.st +++ b/src/MCP/MCPToolLoadRepository.class.st @@ -166,7 +166,7 @@ MCPToolLoadRepository >> repositoryDataProperties [ { #category : 'private - schema' } MCPToolLoadRepository >> repositoryNameSchemaProperty [ - ^ (self schemaPropertyNamed: 'repositoryName' type: 'string' description: 'Registered Iceberg repository name.') + ^ (self schemaPropertyNamed: 'name' type: 'string' description: 'Registered Iceberg repository name.') minLength: 1; yourself ] diff --git a/src/MCP/MCPToolRemoveRepositoryRemote.class.st b/src/MCP/MCPToolRemoveRepositoryRemote.class.st index 80544f0..a64f778 100644 --- a/src/MCP/MCPToolRemoveRepositoryRemote.class.st +++ b/src/MCP/MCPToolRemoveRepositoryRemote.class.st @@ -25,5 +25,5 @@ MCPToolRemoveRepositoryRemote >> repositoryToolSpec [ (#requestClass -> MCPRepositoryRemoteRequest). (#commandClass -> MCPRemoveRepositoryRemoteCommand). (#inputProperties -> { self remoteNameSchemaProperty }). - (#requiredProperties -> #( 'repositoryName' 'remoteName' )) } asDictionary + (#requiredProperties -> #( 'name' 'remoteName' )) } asDictionary ] diff --git a/src/MCP/MCPToolRepositoryOperation.class.st b/src/MCP/MCPToolRepositoryOperation.class.st index 16551b4..2e4a229 100644 --- a/src/MCP/MCPToolRepositoryOperation.class.st +++ b/src/MCP/MCPToolRepositoryOperation.class.st @@ -230,7 +230,7 @@ MCPToolRepositoryOperation >> repositoryPackagesOutputSchemaProperty [ MCPToolRepositoryOperation >> repositoryReferenceInputProperties [ ^ { - (self schemaPropertyNamed: 'repositoryName' type: 'string' description: 'Registered repository name.'). + (self schemaPropertyNamed: 'name' type: 'string' description: 'Registered repository name.'). (self schemaPropertyNamed: 'location' type: 'string' description: 'Repository location disambiguator.') } ] @@ -249,7 +249,7 @@ MCPToolRepositoryOperation >> requestClass [ { #category : 'private - schema' } MCPToolRepositoryOperation >> requiredInputProperties [ - ^ self repositoryToolSpec at: #requiredProperties ifAbsent: [ #( 'repositoryName' ) ] + ^ self repositoryToolSpec at: #requiredProperties ifAbsent: [ #( 'name' ) ] ] { #category : 'testing' } diff --git a/src/MCP/MCPToolSwitchRepositoryBranch.class.st b/src/MCP/MCPToolSwitchRepositoryBranch.class.st index 2bfde87..3f19366 100644 --- a/src/MCP/MCPToolSwitchRepositoryBranch.class.st +++ b/src/MCP/MCPToolSwitchRepositoryBranch.class.st @@ -25,5 +25,5 @@ MCPToolSwitchRepositoryBranch >> repositoryToolSpec [ (#requestClass -> MCPRepositorySwitchBranchRequest). (#commandClass -> MCPSwitchRepositoryBranchCommand). (#inputProperties -> { self branchNameSchemaProperty }). - (#requiredProperties -> #( 'repositoryName' 'branchName' )) } asDictionary + (#requiredProperties -> #( 'name' 'branchName' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateRepositoryRemote.class.st b/src/MCP/MCPToolUpdateRepositoryRemote.class.st index 94bc2e2..30e0363 100644 --- a/src/MCP/MCPToolUpdateRepositoryRemote.class.st +++ b/src/MCP/MCPToolUpdateRepositoryRemote.class.st @@ -27,5 +27,5 @@ MCPToolUpdateRepositoryRemote >> repositoryToolSpec [ (#inputProperties -> { self remoteNameSchemaProperty. self remoteUrlSchemaProperty }). - (#requiredProperties -> #( 'repositoryName' 'remoteName' 'remoteUrl' )) } asDictionary + (#requiredProperties -> #( 'name' 'remoteName' 'remoteUrl' )) } asDictionary ] From e1f43b4aa6dbc9f3e6926e26b93781a6d810a96a Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Mon, 31 Aug 2026 12:20:38 +0200 Subject: [PATCH 15/17] Simplify primary name inputs --- .../MCPSaveImageRecordingServer.class.st | 2 +- .../MCPClassMutationRequestTest.class.st | 12 ++-- .../MCPJSONSchemaValidatorTest.class.st | 34 +++++------ src/MCP-Tests/MCPToolAPITestCase.class.st | 2 +- .../MCPToolClassMutationTest.class.st | 44 +++++++-------- src/MCP-Tests/MCPToolContractsTest.class.st | 56 +++++++++---------- .../MCPToolSearchPackagesTest.class.st | 6 +- .../MCPToolStructuredOutputTest.class.st | 2 +- .../MCPUpdateClassCommandTest.class.st | 18 +++--- .../MCPLocalObservabilityBackendTest.class.st | 2 +- src/MCP/MCPCallToolRequest.class.st | 2 +- src/MCP/MCPClassUpdateRequest.class.st | 6 +- src/MCP/MCPGetToolRequest.class.st | 2 +- src/MCP/MCPToolAddClassSlot.class.st | 2 +- src/MCP/MCPToolCallTool.class.st | 14 ++--- src/MCP/MCPToolClassMutation.class.st | 2 +- src/MCP/MCPToolGetTool.class.st | 10 ++-- src/MCP/MCPToolPullUpClassSlot.class.st | 2 +- src/MCP/MCPToolPushDownClassSlot.class.st | 2 +- src/MCP/MCPToolRemoveClassSlot.class.st | 2 +- src/MCP/MCPToolSearchPackages.class.st | 6 +- src/MCP/MCPToolUpdateClassComment.class.st | 4 +- src/MCP/MCPToolUpdateClassLayout.class.st | 4 +- src/MCP/MCPToolUpdateClassPackage.class.st | 4 +- .../MCPToolUpdateClassSharedPools.class.st | 4 +- ...MCPToolUpdateClassSharedVariables.class.st | 4 +- src/MCP/MCPToolUpdateClassSideTraits.class.st | 4 +- src/MCP/MCPToolUpdateClassSlotName.class.st | 2 +- src/MCP/MCPToolUpdateClassSlots.class.st | 4 +- src/MCP/MCPToolUpdateClassSuperclass.class.st | 4 +- src/MCP/MCPToolUpdateClassTraits.class.st | 4 +- 31 files changed, 131 insertions(+), 135 deletions(-) diff --git a/src/MCP-Tests-Resources/MCPSaveImageRecordingServer.class.st b/src/MCP-Tests-Resources/MCPSaveImageRecordingServer.class.st index 17d55b5..932eec4 100644 --- a/src/MCP-Tests-Resources/MCPSaveImageRecordingServer.class.st +++ b/src/MCP-Tests-Resources/MCPSaveImageRecordingServer.class.st @@ -37,7 +37,7 @@ MCPSaveImageRecordingServer >> rpcToolCall: aToolName withParams: someArguments (self toolRegistry isStaticToolNamed: aToolName) ifTrue: [ ^ super rpcToolCall: aToolName withParams: someArguments ]. ^ super rpcToolCall: 'tool_call' withParams: { - (#toolName -> aToolName). + (#name -> aToolName). (#arguments -> someArguments) } asDictionary ] diff --git a/src/MCP-Tests/MCPClassMutationRequestTest.class.st b/src/MCP-Tests/MCPClassMutationRequestTest.class.st index 821ce9e..a221bef 100644 --- a/src/MCP-Tests/MCPClassMutationRequestTest.class.st +++ b/src/MCP-Tests/MCPClassMutationRequestTest.class.st @@ -59,7 +59,7 @@ MCPClassMutationRequestTest >> testUpdateCommandResolvesOmittedMovePackageName [ request := MCPToolRequest new tool: tool; arguments: { - (#className -> self class name asString). + (#name -> self class name asString). (#tag -> 'Requests') } asDictionary; yourself. mutationRequest := tool parsedRequestFromToolRequest: request. @@ -78,7 +78,7 @@ MCPClassMutationRequestTest >> testUpdateRequestParsesSlotArguments [ tool := MCPToolUpdateClassSlotName new. request := MCPClassUpdateRequest fromRequest: (self toolRequestWithArguments: { - (#className -> 'ExistingClass'). + (#name -> 'ExistingClass'). (#slotAction -> 'rename'). (#slotName -> 'oldName'). (#newSlotName -> 'newName'). @@ -106,7 +106,7 @@ MCPClassMutationRequestTest >> testUpdateRequestTracksSuppliedProperties [ tool := MCPToolUpdateClassSlots new. request := MCPClassUpdateRequest fromRequest: (self toolRequestWithArguments: { - (#className -> 'ExistingClass'). + (#name -> 'ExistingClass'). (#tag -> 'Models'). (#comment -> ''). (#force -> true). @@ -123,7 +123,7 @@ MCPClassMutationRequestTest >> testUpdateRequestTracksSuppliedProperties [ self deny: (request hasSuppliedPropertyNamed: 'classSlots'). self assert: request slotNames isEmpty. context := request requestedContext. - self assert: (context at: #className) equals: 'ExistingClass'. + self assert: (context at: #name) equals: 'ExistingClass'. self assert: (context at: #tag) equals: 'Models'. self assert: (context at: #comment) equals: ''. self assert: (context at: #slots) equals: #( ). @@ -136,14 +136,14 @@ MCPClassMutationRequestTest >> testUpdateRequestWithNoPatchArgumentsHasNoUpdates | context request tool | tool := MCPToolUpdateClassSlots new. request := MCPClassUpdateRequest - fromRequest: (self toolRequestWithArguments: { (#className -> 'ExistingClass') } asDictionary) + fromRequest: (self toolRequestWithArguments: { (#name -> 'ExistingClass') } asDictionary) tool: tool. self assert: request className equals: 'ExistingClass'. self deny: request hasUpdates. self assert: request suppliedProperties isEmpty. context := request requestedContext. self assert: context size equals: 1. - self assert: (context at: #className) equals: 'ExistingClass' + self assert: (context at: #name) equals: 'ExistingClass' ] { #category : 'private' } diff --git a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st index 924819c..e5bfd17 100644 --- a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st +++ b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st @@ -102,9 +102,9 @@ MCPJSONSchemaValidatorTest >> baseRepresentativeArgumentsByToolClass [ (MCPToolUpdateDebugMethod -> { (#sessionId -> 'debug-session-1') } asDictionary). (MCPToolSearchMethodMetadata -> Dictionary new). (MCPToolSearchTools -> Dictionary new). - (MCPToolGetTool -> { (#toolName -> 'class_search') } asDictionary). + (MCPToolGetTool -> { (#name -> 'class_search') } asDictionary). (MCPToolCallTool -> { - (#toolName -> 'package_search'). + (#name -> 'package_search'). (#arguments -> Dictionary new) } asDictionary) } asDictionary ] @@ -120,47 +120,47 @@ MCPJSONSchemaValidatorTest >> classMutationRepresentativeArgumentsByToolClass [ (#name -> 'MCPTool'). (#newName -> 'MCPToolRenamed') } asDictionary). (MCPToolUpdateClassSuperclass -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#superclassName -> 'Object') } asDictionary). (MCPToolUpdateClassPackage -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#tag -> 'Tools') } asDictionary). (MCPToolUpdateClassComment -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#comment -> '') } asDictionary). (MCPToolUpdateClassSlots -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#slots -> #( )) } asDictionary). (MCPToolUpdateClassTraits -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#traits -> #( )) } asDictionary). (MCPToolUpdateClassSideTraits -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#classTraits -> #( )) } asDictionary). (MCPToolUpdateClassSharedVariables -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#sharedVariables -> #( )) } asDictionary). (MCPToolUpdateClassSharedPools -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#sharedPools -> #( )) } asDictionary). (MCPToolUpdateClassLayout -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#layout -> 'FixedLayout') } asDictionary). (MCPToolAddClassSlot -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#slotName -> 'temporarySlot') } asDictionary). (MCPToolRemoveClassSlot -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#slotName -> 'temporarySlot') } asDictionary). (MCPToolUpdateClassSlotName -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#slotName -> 'temporarySlot'). (#newSlotName -> 'renamedTemporarySlot') } asDictionary). (MCPToolPullUpClassSlot -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#slotName -> 'temporarySlot') } asDictionary). (MCPToolPushDownClassSlot -> { - (#className -> 'MCPTool'). + (#name -> 'MCPTool'). (#slotName -> 'temporarySlot') } asDictionary) } asDictionary ] @@ -288,7 +288,7 @@ MCPJSONSchemaValidatorTest >> testCurrentToolRequestValidationRejectsOperationSp should: [ MCPToolCreateClass new requestFromToolCallArguments: { (#name -> 'MCPTool') } asDictionary ] raise: MCPInvalidToolInput. self - should: [ MCPToolUpdateClassPackage new requestFromToolCallArguments: { (#className -> 'MCPTool') } asDictionary ] + should: [ MCPToolUpdateClassPackage new requestFromToolCallArguments: { (#name -> 'MCPTool') } asDictionary ] raise: MCPInvalidToolInput. self should: [ MCPToolCommitRepository new requestFromToolCallArguments: { (#name -> 'MCP') } asDictionary ] diff --git a/src/MCP-Tests/MCPToolAPITestCase.class.st b/src/MCP-Tests/MCPToolAPITestCase.class.st index 1f44e70..cf51c59 100644 --- a/src/MCP-Tests/MCPToolAPITestCase.class.st +++ b/src/MCP-Tests/MCPToolAPITestCase.class.st @@ -32,7 +32,7 @@ MCPToolAPITestCase >> aroundToolCall: aBlock [ MCPToolAPITestCase >> callDiscoveredToolNamed: aToolName withArguments: someArguments [ ^ self callRawToolNamed: 'tool_call' withArguments: { - (#toolName -> aToolName). + (#name -> aToolName). (#arguments -> someArguments) } asDictionary ] diff --git a/src/MCP-Tests/MCPToolClassMutationTest.class.st b/src/MCP-Tests/MCPToolClassMutationTest.class.st index 932554c..84aa907 100644 --- a/src/MCP-Tests/MCPToolClassMutationTest.class.st +++ b/src/MCP-Tests/MCPToolClassMutationTest.class.st @@ -273,10 +273,10 @@ MCPToolClassMutationTest >> testClassToolSchemasDeclareExpectedInputs [ self assert: MCPToolCreateClass new inputSchema required asSet equals: #( 'name' 'superclassName' 'packageName' ) asSet. self assert: renameProperties asArray equals: #( 'name' 'newName' ). self assert: MCPToolUpdateClassName new inputSchema required asSet equals: #( 'name' 'newName' ) asSet. - self assert: packageProperties asArray equals: #( 'className' 'packageName' 'tag' ). - self assert: MCPToolUpdateClassPackage new inputSchema required asSet equals: #( 'className' ) asSet. - self assert: slotProperties asArray equals: #( 'className' 'slotName' 'classSide' ). - self assert: MCPToolAddClassSlot new inputSchema required asSet equals: #( 'className' 'slotName' ) asSet + self assert: packageProperties asArray equals: #( 'name' 'packageName' 'tag' ). + self assert: MCPToolUpdateClassPackage new inputSchema required asSet equals: #( 'name' ) asSet. + self assert: slotProperties asArray equals: #( 'name' 'slotName' 'classSide' ). + self assert: MCPToolAddClassSlot new inputSchema required asSet equals: #( 'name' 'slotName' ) asSet ] { #category : 'tests - create' } @@ -530,7 +530,7 @@ MCPToolClassMutationTest >> testUpdateForcePullUpSlotContinuesPastRefactoringWar protocol: 'testing' on: (self classNamed: 'MCPToolClassMutationTestWarningPullUpChildOne'). result := self callToolWith: (self updateRequestArgumentsWith: { - (#className -> 'MCPToolClassMutationTestWarningPullUpTarget'). + (#name -> 'MCPToolClassMutationTestWarningPullUpTarget'). (#slotAction -> 'pullUp'). (#slotName -> 'sharedSlot'). (#classSide -> false). @@ -565,7 +565,7 @@ MCPToolClassMutationTest >> testUpdateForceRemoveSlotContinuesPastRefactoringWar protocol: 'testing' on: (self classNamed: 'MCPToolClassMutationTestWarningRemoveSlotTarget'). result := self callToolWith: (self updateRequestArgumentsWith: { - (#className -> 'MCPToolClassMutationTestWarningRemoveSlotTarget'). + (#name -> 'MCPToolClassMutationTestWarningRemoveSlotTarget'). (#slotAction -> 'remove'). (#slotName -> 'referencedSlot'). (#classSide -> false). @@ -1207,7 +1207,7 @@ MCPToolClassMutationTest >> testUpdateReplacesSlotDefinitionAndPreservesMatching instance instVarNamed: 'keptSlot' put: 13. target instVarNamed: 'keptClassSlot' put: 17. result := self callToolWith: (self updateRequestArgumentsWith: { - (#className -> 'MCPToolClassMutationTestDefinitionTarget'). + (#name -> 'MCPToolClassMutationTestDefinitionTarget'). (#slots -> #( 'keptSlot' 'newSlot' )). (#classSlots -> #( 'keptClassSlot' 'newClassSlot' )) }). data := self dataFrom: result. @@ -1269,7 +1269,7 @@ MCPToolClassMutationTest >> testUpdateReturnsStructuredErrorWhenCommentClassIsMi | error result suggestions | result := self callToolWith: { (#action -> 'update'). - (#className -> 'MCPToolClassMutationTestMissing'). + (#name -> 'MCPToolClassMutationTestMissing'). (#comment -> 'ignored') } asDictionary. error := self errorFrom: result. suggestions := error at: #suggestions. @@ -1296,7 +1296,7 @@ MCPToolClassMutationTest >> testUpdateReturnsStructuredErrorWhenMoveClassIsMissi | error result structured | result := self callToolWith: { (#action -> 'update'). - (#className -> 'MCPToolClassMutationTestMissing'). + (#name -> 'MCPToolClassMutationTestMissing'). (#packageName -> self destinationPackageName) } asDictionary. structured := self structuredContentFrom: result. error := self errorFrom: result. @@ -1408,7 +1408,7 @@ MCPToolClassMutationTest >> testUpdateReturnsStructuredErrorWhenReparentSupercla classSlots: #( ). result := self callToolWith: { (#action -> 'update'). - (#className -> self reparentTargetClassName). + (#name -> self reparentTargetClassName). (#superclassName -> 'DefinitelyMissingSuperclass') } asDictionary. error := self errorFrom: result. self assert: (result at: #isError). @@ -1561,7 +1561,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForClassComment: aClassComment ^ { (#action -> 'update'). - (#className -> self commentTargetClassName). + (#name -> self commentTargetClassName). (#comment -> aClassComment) } asDictionary ] @@ -1569,7 +1569,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForClassComment: aClassComment MCPToolClassMutationTest >> updateRequestArgumentsForClassTraitsInClassNamed: aClassName classTraits: someClassTraitNames [ ^ self updateRequestArgumentsWith: { - (#className -> aClassName). + (#name -> aClassName). (#classTraits -> someClassTraitNames) } ] @@ -1577,7 +1577,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForClassTraitsInClassNamed: aC MCPToolClassMutationTest >> updateRequestArgumentsForLayoutInClassNamed: aClassName layout: aLayoutName [ ^ self updateRequestArgumentsWith: { - (#className -> aClassName). + (#name -> aClassName). (#layout -> aLayoutName) } ] @@ -1586,7 +1586,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForMoveToPackage [ ^ { (#action -> 'update'). - (#className -> self moveTargetClassName). + (#name -> self moveTargetClassName). (#packageName -> self destinationPackageName) } asDictionary ] @@ -1595,7 +1595,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForMoveToPackageAndTag [ ^ { (#action -> 'update'). - (#className -> self moveTargetClassName). + (#name -> self moveTargetClassName). (#packageName -> self destinationPackageName). (#tag -> self destinationTagName) } asDictionary ] @@ -1605,7 +1605,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForRecategorization [ ^ { (#action -> 'update'). - (#className -> self moveTargetClassName). + (#name -> self moveTargetClassName). (#tag -> self destinationTagName) } asDictionary ] @@ -1623,7 +1623,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForReparent [ ^ { (#action -> 'update'). - (#className -> self reparentTargetClassName). + (#name -> self reparentTargetClassName). (#superclassName -> self reparentSuperclassName) } asDictionary ] @@ -1631,7 +1631,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForReparent [ MCPToolClassMutationTest >> updateRequestArgumentsForSharedPoolsInClassNamed: aClassName sharedPools: someNames [ ^ self updateRequestArgumentsWith: { - (#className -> aClassName). + (#name -> aClassName). (#sharedPools -> someNames) } ] @@ -1639,7 +1639,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForSharedPoolsInClassNamed: aC MCPToolClassMutationTest >> updateRequestArgumentsForSharedVariablesInClassNamed: aClassName sharedVariables: someNames [ ^ self updateRequestArgumentsWith: { - (#className -> aClassName). + (#name -> aClassName). (#sharedVariables -> someNames) } ] @@ -1647,7 +1647,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForSharedVariablesInClassNamed MCPToolClassMutationTest >> updateRequestArgumentsForSlotAction: slotAction className: aClassName slotName: aSlotName classSide: aBoolean [ ^ self updateRequestArgumentsWith: { - (#className -> aClassName). + (#name -> aClassName). (#slotAction -> slotAction). (#slotName -> aSlotName). (#classSide -> aBoolean) } @@ -1657,7 +1657,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForSlotAction: slotAction clas MCPToolClassMutationTest >> updateRequestArgumentsForSlotRenameInClassNamed: aClassName slotName: aSlotName newSlotName: aNewSlotName classSide: aBoolean [ ^ self updateRequestArgumentsWith: { - (#className -> aClassName). + (#name -> aClassName). (#slotAction -> 'rename'). (#slotName -> aSlotName). (#newSlotName -> aNewSlotName). @@ -1668,7 +1668,7 @@ MCPToolClassMutationTest >> updateRequestArgumentsForSlotRenameInClassNamed: aCl MCPToolClassMutationTest >> updateRequestArgumentsForTraitsInClassNamed: aClassName traits: someTraitNames [ ^ self updateRequestArgumentsWith: { - (#className -> aClassName). + (#name -> aClassName). (#traits -> someTraitNames) } ] diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index f58e67a..21a17ee 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -211,13 +211,13 @@ MCPToolContractsTest >> baseToolFlowSpecs [ (#commandClass -> MCPSearchToolsCommand) } asDictionary. { (#toolClass -> MCPToolGetTool). - (#arguments -> { (#toolName -> 'class_search') } asDictionary). + (#arguments -> { (#name -> 'class_search') } asDictionary). (#requestClass -> MCPGetToolRequest). (#commandClass -> MCPGetToolCommand) } asDictionary. { (#toolClass -> MCPToolCallTool). (#arguments -> { - (#toolName -> 'package_search'). + (#name -> 'package_search'). (#arguments -> Dictionary new) } asDictionary). (#requestClass -> MCPCallToolRequest). (#commandClass -> MCPCallToolCommand) } asDictionary } @@ -303,84 +303,84 @@ MCPToolContractsTest >> classMutationToolFlowSpecs [ { (#toolClass -> MCPToolUpdateClassSuperclass). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#superclassName -> 'ProtoObject') } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolUpdateClassPackage). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#tag -> 'Kernel') } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolUpdateClassComment). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#comment -> '') } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolUpdateClassSlots). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#slots -> #( )) } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolUpdateClassTraits). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#traits -> #( )) } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolUpdateClassSideTraits). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#classTraits -> #( )) } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolUpdateClassSharedVariables). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#sharedVariables -> #( )) } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolUpdateClassSharedPools). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#sharedPools -> #( )) } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolUpdateClassLayout). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#layout -> 'FixedLayout') } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolAddClassSlot). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#slotName -> 'temporarySlot') } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolRemoveClassSlot). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#slotName -> 'temporarySlot') } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolUpdateClassSlotName). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#slotName -> 'temporarySlot'). (#newSlotName -> 'renamedTemporarySlot') } asDictionary). (#requestClass -> MCPClassUpdateRequest). @@ -388,14 +388,14 @@ MCPToolContractsTest >> classMutationToolFlowSpecs [ { (#toolClass -> MCPToolPullUpClassSlot). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#slotName -> 'temporarySlot') } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary. { (#toolClass -> MCPToolPushDownClassSlot). (#arguments -> { - (#className -> 'Object'). + (#name -> 'Object'). (#slotName -> 'temporarySlot') } asDictionary). (#requestClass -> MCPClassUpdateRequest). (#commandClass -> MCPUpdateClassCommand) } asDictionary } @@ -884,9 +884,9 @@ MCPToolContractsTest >> testCallToolInvokesDiscoverableToolAfterStaticConfigurat server := self mcpWithoutObservabilityExport. server staticToolNames: #( 'tool_search' 'tool_get' 'tool_call' ). result := server rpcToolCall: 'tool_call' withParams: { - (#toolName -> 'package_search'). + (#name -> 'package_search'). (#arguments -> { - (#packageName -> 'MCP'). + (#name -> 'MCP'). (#filterMode -> 'substring'). (#limit -> 1) } asDictionary) } asDictionary. data := self dataFrom: result. @@ -899,9 +899,9 @@ MCPToolContractsTest >> testCallToolInvokesTargetToolThroughServerPath [ | data result | result := self callToolNamed: 'tool_call' withArguments: { - (#toolName -> 'package_search'). + (#name -> 'package_search'). (#arguments -> { - (#packageName -> 'MCP'). + (#name -> 'MCP'). (#filterMode -> 'substring'). (#limit -> 1) } asDictionary) } asDictionary. data := self dataFrom: result. @@ -914,7 +914,7 @@ MCPToolContractsTest >> testCallToolPreservesNestedValidationViolations [ | error result violations | result := self callToolNamed: 'tool_call' withArguments: { - (#toolName -> 'method_sender_search'). + (#name -> 'method_sender_search'). (#arguments -> { (#selector -> '') } asDictionary) } asDictionary. error := self errorFrom: result. violations := error at: #violations. @@ -984,8 +984,8 @@ MCPToolContractsTest >> testClassMutationToolsHaveAccurateNamesAndRequiredArgume self deny: (propertyNames includes: 'operation') ]. self assert: MCPToolCreateClass new inputSchema required asSet equals: #( 'name' 'superclassName' 'packageName' ) asSet. self assert: MCPToolUpdateClassName new inputSchema required asSet equals: #( 'name' 'newName' ) asSet. - self assert: MCPToolUpdateClassComment new inputSchema required asSet equals: #( 'className' 'comment' ) asSet. - self assert: MCPToolUpdateClassSlotName new inputSchema required asSet equals: #( 'className' 'slotName' 'newSlotName' ) asSet. + self assert: MCPToolUpdateClassComment new inputSchema required asSet equals: #( 'name' 'comment' ) asSet. + self assert: MCPToolUpdateClassSlotName new inputSchema required asSet equals: #( 'name' 'slotName' 'newSlotName' ) asSet. packagePropertyNames := MCPToolUpdateClassPackage new inputSchema properties collect: [ :each | each name ]. slotsPropertyNames := MCPToolUpdateClassSlots new inputSchema properties collect: [ :each | each name ]. slotToolPropertyNames := MCPToolAddClassSlot new inputSchema properties collect: [ :each | each name ]. @@ -1205,9 +1205,9 @@ MCPToolContractsTest >> testDiscoveryUsesConfiguredStaticToolNames [ self assert: (metadataByName includesKey: 'repository_search'). self assert: (metadataByName includesKey: 'repository_create'). searchContract := (self dataFrom: - (server rpcToolCall: 'tool_get' withParams: { (#toolName -> 'repository_search') } asDictionary)) at: #tool. + (server rpcToolCall: 'tool_get' withParams: { (#name -> 'repository_search') } asDictionary)) at: #tool. createContract := (self dataFrom: - (server rpcToolCall: 'tool_get' withParams: { (#toolName -> 'repository_create') } asDictionary)) at: #tool. + (server rpcToolCall: 'tool_get' withParams: { (#name -> 'repository_create') } asDictionary)) at: #tool. self assert: searchContract keys asSet equals: #( name description group exposure annotations keywords inputSchema ) asSet. self assert: createContract keys asSet equals: #( name description group exposure annotations keywords inputSchema ) asSet. self assert: (searchContract at: #exposure) equals: 'static'. @@ -1338,7 +1338,7 @@ MCPToolContractsTest >> testGetMethodHasAccurateNameAndRequiredArguments [ MCPToolContractsTest >> testGetToolReturnsSchemaForCatalogTool [ | contract getToolPropertyNames inputProperties result | - result := self callToolNamed: 'tool_get' withArguments: { (#toolName -> 'repository_create') } asDictionary. + result := self callToolNamed: 'tool_get' withArguments: { (#name -> 'repository_create') } asDictionary. contract := (self dataFrom: result) at: #tool. self assert: (contract at: #name) equals: 'repository_create'. self assert: contract keys asSet equals: #( name description group exposure annotations keywords inputSchema ) asSet. @@ -1350,7 +1350,7 @@ MCPToolContractsTest >> testGetToolReturnsSchemaForCatalogTool [ self assert: inputProperties asSet equals: #( 'name' 'location' 'packageNames' 'subdirectory' ) asSet. self assert: ((contract at: #inputSchema) at: #required) asArray equals: #( 'name' 'location' ). getToolPropertyNames := MCPToolGetTool new inputSchema properties collect: [ :each | each name ]. - self assert: getToolPropertyNames equals: #( 'toolName' ) + self assert: getToolPropertyNames equals: #( 'name' ) ] { #category : 'tests' } @@ -2290,7 +2290,7 @@ MCPToolContractsTest >> testSearchPackagesHasAccurateNameAndSchema [ self assert: schema required equals: #( ). self assert: propertyNames asSet - equals: #( 'projectNames' 'packageNames' 'packageName' 'projectName' 'tag' 'filterMode' 'caseSensitive' 'limit' 'offset' ) asSet + equals: #( 'projectNames' 'packageNames' 'name' 'projectName' 'tag' 'filterMode' 'caseSensitive' 'limit' 'offset' ) asSet ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPToolSearchPackagesTest.class.st b/src/MCP-Tests/MCPToolSearchPackagesTest.class.st index 3b1f808..1b26825 100644 --- a/src/MCP-Tests/MCPToolSearchPackagesTest.class.st +++ b/src/MCP-Tests/MCPToolSearchPackagesTest.class.st @@ -68,7 +68,7 @@ MCPToolSearchPackagesTest >> testImageScopeCanPaginateFilteredPackages [ | data expected packageNames pagination result summary | result := self callToolWith: { - (#packageName -> 'MCP-'). + (#name -> 'MCP-'). (#filterMode -> 'prefix'). (#limit -> 2). (#offset -> 1) } asDictionary. @@ -96,7 +96,7 @@ MCPToolSearchPackagesTest >> testImageScopeReturnsExactPackageNameMatch [ | data packageNames result | result := self callToolWith: { - (#packageName -> 'MCP-Tests'). + (#name -> 'MCP-Tests'). (#filterMode -> 'exact') } asDictionary. data := self dataFrom: result. packageNames := (data at: #packages) collect: [ :each | each at: #packageName ]. @@ -111,7 +111,7 @@ MCPToolSearchPackagesTest >> testImageScopeReturnsStructuredPackages [ | data entry packages result | result := self callToolWith: { - (#packageName -> 'MCP-Tests-Resources'). + (#name -> 'MCP-Tests-Resources'). (#filterMode -> 'exact') } asDictionary. data := self dataFrom: result. packages := data at: #packages. diff --git a/src/MCP-Tests/MCPToolStructuredOutputTest.class.st b/src/MCP-Tests/MCPToolStructuredOutputTest.class.st index bd33fdd..6f46746 100644 --- a/src/MCP-Tests/MCPToolStructuredOutputTest.class.st +++ b/src/MCP-Tests/MCPToolStructuredOutputTest.class.st @@ -498,7 +498,7 @@ MCPToolStructuredOutputTest >> testSearchPackagesDefaultsToImageScopeWhenScopePr | data packageNames packages result | result := self callToolNamed: 'package_search' withArguments: { - (#packageName -> 'MCP-Tests-Resources'). + (#name -> 'MCP-Tests-Resources'). (#filterMode -> 'exact') } asDictionary. data := self dataFrom: result. packages := data at: #packages. diff --git a/src/MCP-Tests/MCPUpdateClassCommandTest.class.st b/src/MCP-Tests/MCPUpdateClassCommandTest.class.st index 7794be6..503366e 100644 --- a/src/MCP-Tests/MCPUpdateClassCommandTest.class.st +++ b/src/MCP-Tests/MCPUpdateClassCommandTest.class.st @@ -51,7 +51,7 @@ MCPUpdateClassCommandTest >> commandForArguments: arguments [ MCPUpdateClassCommandTest >> testAppliedChangeResultWrapsPlanAndResult [ | appliedChange changeResult data plan | - plan := MCPClassUpdatePlanInfo updateAction: 'setComment' requestedContext: { (#className -> 'Object') } asDictionary. + plan := MCPClassUpdatePlanInfo updateAction: 'setComment' requestedContext: { (#name -> 'Object') } asDictionary. changeResult := MCPChangeClassCommentResult classInfo: (MCPClassInfo fromClass: Object) oldClassComment: 'old' @@ -69,7 +69,7 @@ MCPUpdateClassCommandTest >> testBuildsClassTraitReplacementUpdatePlan [ plan := command updatePlan. context := plan requestedContext. self assert: plan updateAction equals: 'replaceClassTraits'. - self assert: (context at: #className) equals: 'Object'. + self assert: (context at: #name) equals: 'Object'. self assert: (context at: #classTraits) equals: #( 'TAbleToRotate classTrait' ) ] @@ -83,7 +83,7 @@ MCPUpdateClassCommandTest >> testBuildsDefinitionReplacementUpdatePlan [ plan := command updatePlan. context := plan requestedContext. self assert: plan updateAction equals: 'replaceDefinition'. - self assert: (context at: #className) equals: 'Object'. + self assert: (context at: #name) equals: 'Object'. self assert: (context at: #slots) equals: #( 'first' 'second' ). self assert: (context at: #classSlots) equals: #( 'Current' ) ] @@ -96,7 +96,7 @@ MCPUpdateClassCommandTest >> testBuildsLayoutReplacementUpdatePlan [ plan := command updatePlan. context := plan requestedContext. self assert: plan updateAction equals: 'replaceLayout'. - self assert: (context at: #className) equals: 'Object'. + self assert: (context at: #name) equals: 'Object'. self assert: (context at: #layout) equals: 'WeakLayout' ] @@ -108,7 +108,7 @@ MCPUpdateClassCommandTest >> testBuildsSharedPoolReplacementUpdatePlan [ plan := command updatePlan. context := plan requestedContext. self assert: plan updateAction equals: 'replaceSharedPools'. - self assert: (context at: #className) equals: 'Object'. + self assert: (context at: #name) equals: 'Object'. self assert: (context at: #sharedPools) equals: #( 'ChronologyConstants' ) ] @@ -120,7 +120,7 @@ MCPUpdateClassCommandTest >> testBuildsSharedVariableReplacementUpdatePlan [ plan := command updatePlan. context := plan requestedContext. self assert: plan updateAction equals: 'replaceSharedVariables'. - self assert: (context at: #className) equals: 'Object'. + self assert: (context at: #name) equals: 'Object'. self assert: (context at: #sharedVariables) equals: #( 'Current' ) ] @@ -132,7 +132,7 @@ MCPUpdateClassCommandTest >> testBuildsTraitReplacementUpdatePlan [ plan := command updatePlan. context := plan requestedContext. self assert: plan updateAction equals: 'replaceTraits'. - self assert: (context at: #className) equals: 'Object'. + self assert: (context at: #name) equals: 'Object'. self assert: (context at: #traits) equals: #( 'TAbleToRotate' ) ] @@ -224,7 +224,7 @@ MCPUpdateClassCommandTest >> testToolBuildsUpdateClassCommand [ | command mutationRequest tool toolRequest | tool := MCPToolUpdateClassComment new. toolRequest := tool requestFromToolCallArguments: { - (#className -> 'Object'). + (#name -> 'Object'). (#comment -> 'updated') } asDictionary. mutationRequest := tool parsedRequestFromToolRequest: toolRequest. command := tool commandForRequest: mutationRequest. @@ -242,7 +242,7 @@ MCPUpdateClassCommandTest >> updateArgumentsWith: associations [ | arguments | arguments := { (#action -> 'update'). - (#className -> 'Object') } asDictionary. + (#name -> 'Object') } asDictionary. associations do: [ :each | arguments at: each key put: each value ]. ^ arguments ] diff --git a/src/MCP-UI-Tests/MCPLocalObservabilityBackendTest.class.st b/src/MCP-UI-Tests/MCPLocalObservabilityBackendTest.class.st index abe7a36..373a1a6 100644 --- a/src/MCP-UI-Tests/MCPLocalObservabilityBackendTest.class.st +++ b/src/MCP-UI-Tests/MCPLocalObservabilityBackendTest.class.st @@ -116,7 +116,7 @@ MCPLocalObservabilityBackendTest >> testMCPRecordsToolCallDispatchPath [ mcp observabilityEnabled: true. mcp rpcToolCall: 'tool_call' withParams: { - (#toolName -> 'package_search'). + (#name -> 'package_search'). (#arguments -> { (#limit -> 0) } asDictionary) } asDictionary. records := mcp observability recentCallRecords. diff --git a/src/MCP/MCPCallToolRequest.class.st b/src/MCP/MCPCallToolRequest.class.st index ac3495d..469b958 100644 --- a/src/MCP/MCPCallToolRequest.class.st +++ b/src/MCP/MCPCallToolRequest.class.st @@ -19,7 +19,7 @@ Class { MCPCallToolRequest class >> fromToolRequest: aToolRequest [ ^ self new - toolName: (aToolRequest stringArgumentNamed: 'toolName'); + toolName: (aToolRequest stringArgumentNamed: 'name'); arguments: (aToolRequest argumentNamed: 'arguments' ifAbsent: [ Dictionary new ]); yourself ] diff --git a/src/MCP/MCPClassUpdateRequest.class.st b/src/MCP/MCPClassUpdateRequest.class.st index c9feb0e..052d72d 100644 --- a/src/MCP/MCPClassUpdateRequest.class.st +++ b/src/MCP/MCPClassUpdateRequest.class.st @@ -165,9 +165,7 @@ MCPClassUpdateRequest >> hasUpdates [ MCPClassUpdateRequest >> initializeFromRequest: request [ suppliedProperties := self updatePropertyNames select: [ :each | request hasArgumentNamed: each ]. - className := request stringArgumentNamed: ((request hasArgumentNamed: 'name') - ifTrue: [ 'name' ] - ifFalse: [ 'className' ]). + className := request stringArgumentNamed: 'name'. newClassName := request stringArgumentNamed: 'newName'. superclassName := request stringArgumentNamed: 'superclassName'. packageName := request stringArgumentNamed: 'packageName'. @@ -261,7 +259,7 @@ MCPClassUpdateRequest >> requestedContext [ | context | context := Dictionary new. - context at: #className put: self className. + context at: #name put: self className. self suppliedProperties do: [ :propertyName | context at: propertyName asSymbol put: (self contextValueForPropertyNamed: propertyName) ]. ^ context diff --git a/src/MCP/MCPGetToolRequest.class.st b/src/MCP/MCPGetToolRequest.class.st index 55fc58e..c3f780a 100644 --- a/src/MCP/MCPGetToolRequest.class.st +++ b/src/MCP/MCPGetToolRequest.class.st @@ -18,7 +18,7 @@ Class { MCPGetToolRequest class >> fromToolRequest: aToolRequest [ ^ self new - toolName: (aToolRequest stringArgumentNamed: 'toolName'); + toolName: (aToolRequest stringArgumentNamed: 'name'); yourself ] diff --git a/src/MCP/MCPToolAddClassSlot.class.st b/src/MCP/MCPToolAddClassSlot.class.st index c344007..f544e99 100644 --- a/src/MCP/MCPToolAddClassSlot.class.st +++ b/src/MCP/MCPToolAddClassSlot.class.st @@ -26,5 +26,5 @@ MCPToolAddClassSlot >> classToolSpec [ self classNameSchemaProperty. self slotNameSchemaProperty. self classSideSlotSchemaProperty }). - (#requiredProperties -> #( 'className' 'slotName' )) } asDictionary + (#requiredProperties -> #( 'name' 'slotName' )) } asDictionary ] diff --git a/src/MCP/MCPToolCallTool.class.st b/src/MCP/MCPToolCallTool.class.st index 9c9a12a..64c4660 100644 --- a/src/MCP/MCPToolCallTool.class.st +++ b/src/MCP/MCPToolCallTool.class.st @@ -26,17 +26,17 @@ MCPToolCallTool class >> toolName [ { #category : 'metadata' } MCPToolCallTool >> buildInputSchema [ - | argumentsProperty toolNameProperty | - toolNameProperty := self schemaPropertyNamed: 'toolName' type: 'string' description: 'The MCP tool name to invoke.'. - toolNameProperty minLength: 1. + | argumentsProperty nameProperty | + nameProperty := self schemaPropertyNamed: 'name' type: 'string' description: 'Tool name to invoke.'. + nameProperty minLength: 1. argumentsProperty := self schemaPropertyNamed: 'arguments' type: 'object' description: 'Arguments passed to the selected tool.'. argumentsProperty additionalProperties: true. ^ MCPStructureInputSchema new type: 'object'; properties: { - toolNameProperty. + nameProperty. argumentsProperty }; - required: #( 'toolName' ); + required: #( 'name' ); additionalProperties: false; yourself ] @@ -81,9 +81,7 @@ MCPToolCallTool >> executeWithRequest: request [ ^ self executeParsedRequestFrom: request do: [ :callRequest | - self - errorResultText: 'tool_call requires MCP server call context.' - details: { (#toolName -> callRequest toolName) } asDictionary ] + self errorResultText: 'tool_call requires MCP server call context.' details: { (#name -> callRequest toolName) } asDictionary ] onError: [ :error :parsedRequest | self errorResultFor: error ] ] diff --git a/src/MCP/MCPToolClassMutation.class.st b/src/MCP/MCPToolClassMutation.class.st index bed064d..cb40f50 100644 --- a/src/MCP/MCPToolClassMutation.class.st +++ b/src/MCP/MCPToolClassMutation.class.st @@ -46,7 +46,7 @@ MCPToolClassMutation >> buildOutputSchema [ { #category : 'private - schema' } MCPToolClassMutation >> classNameSchemaProperty [ - ^ self schemaPropertyNamed: 'className' type: 'string' description: 'Class name.' + ^ self schemaPropertyNamed: 'name' type: 'string' description: 'Class name.' ] { #category : 'private - schema' } diff --git a/src/MCP/MCPToolGetTool.class.st b/src/MCP/MCPToolGetTool.class.st index ebb5eb7..fd75adf 100644 --- a/src/MCP/MCPToolGetTool.class.st +++ b/src/MCP/MCPToolGetTool.class.st @@ -65,13 +65,13 @@ MCPToolGetTool >> annotationsSchemaProperty [ { #category : 'metadata' } MCPToolGetTool >> buildInputSchema [ - | toolNameProperty | - toolNameProperty := self schemaPropertyNamed: 'toolName' type: 'string' description: 'Tool name.'. - toolNameProperty minLength: 1. + | nameProperty | + nameProperty := self schemaPropertyNamed: 'name' type: 'string' description: 'Tool name.'. + nameProperty minLength: 1. ^ MCPStructureInputSchema new type: 'object'; - properties: { toolNameProperty }; - required: #( 'toolName' ); + properties: { nameProperty }; + required: #( 'name' ); additionalProperties: false; yourself ] diff --git a/src/MCP/MCPToolPullUpClassSlot.class.st b/src/MCP/MCPToolPullUpClassSlot.class.st index 70283b7..2d050f3 100644 --- a/src/MCP/MCPToolPullUpClassSlot.class.st +++ b/src/MCP/MCPToolPullUpClassSlot.class.st @@ -27,5 +27,5 @@ MCPToolPullUpClassSlot >> classToolSpec [ self slotNameSchemaProperty. self classSideSlotSchemaProperty. self forceSchemaProperty }). - (#requiredProperties -> #( 'className' 'slotName' )) } asDictionary + (#requiredProperties -> #( 'name' 'slotName' )) } asDictionary ] diff --git a/src/MCP/MCPToolPushDownClassSlot.class.st b/src/MCP/MCPToolPushDownClassSlot.class.st index e86fceb..05e7db1 100644 --- a/src/MCP/MCPToolPushDownClassSlot.class.st +++ b/src/MCP/MCPToolPushDownClassSlot.class.st @@ -27,5 +27,5 @@ MCPToolPushDownClassSlot >> classToolSpec [ self slotNameSchemaProperty. self classSideSlotSchemaProperty. self forceSchemaProperty }). - (#requiredProperties -> #( 'className' 'slotName' )) } asDictionary + (#requiredProperties -> #( 'name' 'slotName' )) } asDictionary ] diff --git a/src/MCP/MCPToolRemoveClassSlot.class.st b/src/MCP/MCPToolRemoveClassSlot.class.st index 730342a..128011b 100644 --- a/src/MCP/MCPToolRemoveClassSlot.class.st +++ b/src/MCP/MCPToolRemoveClassSlot.class.st @@ -27,5 +27,5 @@ MCPToolRemoveClassSlot >> classToolSpec [ self slotNameSchemaProperty. self classSideSlotSchemaProperty. self forceSchemaProperty }). - (#requiredProperties -> #( 'className' 'slotName' )) } asDictionary + (#requiredProperties -> #( 'name' 'slotName' )) } asDictionary ] diff --git a/src/MCP/MCPToolSearchPackages.class.st b/src/MCP/MCPToolSearchPackages.class.st index 2567796..5f61200 100644 --- a/src/MCP/MCPToolSearchPackages.class.st +++ b/src/MCP/MCPToolSearchPackages.class.st @@ -67,7 +67,7 @@ MCPToolSearchPackages >> failureMessageForScope: scopeSummary error: anError [ { #category : 'private - filtering' } MCPToolSearchPackages >> fieldTextsForPackageEntry: anEntry fieldName: fieldName [ - fieldName = 'packageName' ifTrue: [ ^ { (anEntry at: #packageName) } ]. + fieldName = 'name' ifTrue: [ ^ { (anEntry at: #packageName) } ]. fieldName = 'projectName' ifTrue: [ ^ anEntry at: #projectNames ]. fieldName = 'tag' ifTrue: [ ^ anEntry at: #tagNames ]. ^ #( ) @@ -121,14 +121,14 @@ MCPToolSearchPackages >> packageEntrySchema [ { #category : 'private - request' } MCPToolSearchPackages >> packageFilterFieldNames [ - ^ #( 'packageName' 'projectName' 'tag' ) + ^ #( 'name' 'projectName' 'tag' ) ] { #category : 'private - schema' } MCPToolSearchPackages >> packageFilterInputProperties [ ^ { - (self schemaPropertyNamed: 'packageName' type: 'string' description: 'Match package names.'). + (self schemaPropertyNamed: 'name' type: 'string' description: 'Match package names.'). (self schemaPropertyNamed: 'projectName' type: 'string' description: 'Match owning projects.'). (self schemaPropertyNamed: 'tag' type: 'string' description: 'Match package tags.') } ] diff --git a/src/MCP/MCPToolUpdateClassComment.class.st b/src/MCP/MCPToolUpdateClassComment.class.st index 2626342..6b48a0e 100644 --- a/src/MCP/MCPToolUpdateClassComment.class.st +++ b/src/MCP/MCPToolUpdateClassComment.class.st @@ -22,7 +22,7 @@ MCPToolUpdateClassComment >> classToolSpec [ (#title -> 'Update Class Comment'). (#description -> 'Set or clear one class comment.'). (#inputProperties -> { - self classNameSchemaProperty. + (self schemaPropertyNamed: 'name' type: 'string' description: 'Class name.'). self commentSchemaProperty }). - (#requiredProperties -> #( 'className' 'comment' )) } asDictionary + (#requiredProperties -> #( 'name' 'comment' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassLayout.class.st b/src/MCP/MCPToolUpdateClassLayout.class.st index 088e177..1907a1b 100644 --- a/src/MCP/MCPToolUpdateClassLayout.class.st +++ b/src/MCP/MCPToolUpdateClassLayout.class.st @@ -28,7 +28,7 @@ MCPToolUpdateClassLayout >> classToolSpec [ (#title -> 'Update Class Layout'). (#description -> 'Replace the layout class used by one class.'). (#inputProperties -> { - self classNameSchemaProperty. + (self schemaPropertyNamed: 'name' type: 'string' description: 'Class name.'). self layoutSchemaProperty }). - (#requiredProperties -> #( 'className' 'layout' )) } asDictionary + (#requiredProperties -> #( 'name' 'layout' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassPackage.class.st b/src/MCP/MCPToolUpdateClassPackage.class.st index f6b0d89..1a2e455 100644 --- a/src/MCP/MCPToolUpdateClassPackage.class.st +++ b/src/MCP/MCPToolUpdateClassPackage.class.st @@ -24,9 +24,9 @@ MCPToolUpdateClassPackage >> classToolSpec [ -> 'Move one class to a package and/or recategorize it under a package tag. Omit packageName when only changing tag inside the current package.'). (#inputProperties -> { - self classNameSchemaProperty. + (self schemaPropertyNamed: 'name' type: 'string' description: 'Class name.'). self packageNameSchemaProperty. self tagSchemaProperty }). - (#requiredProperties -> #( 'className' )). + (#requiredProperties -> #( 'name' )). (#atLeastOneProperties -> #( 'packageName' 'tag' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSharedPools.class.st b/src/MCP/MCPToolUpdateClassSharedPools.class.st index b386206..97a96c1 100644 --- a/src/MCP/MCPToolUpdateClassSharedPools.class.st +++ b/src/MCP/MCPToolUpdateClassSharedPools.class.st @@ -28,7 +28,7 @@ MCPToolUpdateClassSharedPools >> classToolSpec [ (#title -> 'Update Class Shared Pools'). (#description -> 'Replace the shared pools referenced by one class.'). (#inputProperties -> { - self classNameSchemaProperty. + (self schemaPropertyNamed: 'name' type: 'string' description: 'Class name.'). self sharedPoolsSchemaProperty }). - (#requiredProperties -> #( 'className' 'sharedPools' )) } asDictionary + (#requiredProperties -> #( 'name' 'sharedPools' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSharedVariables.class.st b/src/MCP/MCPToolUpdateClassSharedVariables.class.st index 2dfe934..cf12c1a 100644 --- a/src/MCP/MCPToolUpdateClassSharedVariables.class.st +++ b/src/MCP/MCPToolUpdateClassSharedVariables.class.st @@ -28,7 +28,7 @@ MCPToolUpdateClassSharedVariables >> classToolSpec [ (#title -> 'Update Class Shared Variables'). (#description -> 'Replace the class variables of one class.'). (#inputProperties -> { - self classNameSchemaProperty. + (self schemaPropertyNamed: 'name' type: 'string' description: 'Class name.'). self sharedVariablesSchemaProperty }). - (#requiredProperties -> #( 'className' 'sharedVariables' )) } asDictionary + (#requiredProperties -> #( 'name' 'sharedVariables' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSideTraits.class.st b/src/MCP/MCPToolUpdateClassSideTraits.class.st index 20b6370..ab55cd4 100644 --- a/src/MCP/MCPToolUpdateClassSideTraits.class.st +++ b/src/MCP/MCPToolUpdateClassSideTraits.class.st @@ -28,7 +28,7 @@ MCPToolUpdateClassSideTraits >> classToolSpec [ (#title -> 'Update Class-Side Traits'). (#description -> 'Replace the class-side trait composition of one class.'). (#inputProperties -> { - self classNameSchemaProperty. + (self schemaPropertyNamed: 'name' type: 'string' description: 'Class name.'). self classTraitsSchemaProperty }). - (#requiredProperties -> #( 'className' 'classTraits' )) } asDictionary + (#requiredProperties -> #( 'name' 'classTraits' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSlotName.class.st b/src/MCP/MCPToolUpdateClassSlotName.class.st index ea9eb1b..52c0fbf 100644 --- a/src/MCP/MCPToolUpdateClassSlotName.class.st +++ b/src/MCP/MCPToolUpdateClassSlotName.class.st @@ -27,5 +27,5 @@ MCPToolUpdateClassSlotName >> classToolSpec [ self slotNameSchemaProperty. self newSlotNameSchemaProperty. self classSideSlotSchemaProperty }). - (#requiredProperties -> #( 'className' 'slotName' 'newSlotName' )) } asDictionary + (#requiredProperties -> #( 'name' 'slotName' 'newSlotName' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSlots.class.st b/src/MCP/MCPToolUpdateClassSlots.class.st index 6d2bd17..c94e42e 100644 --- a/src/MCP/MCPToolUpdateClassSlots.class.st +++ b/src/MCP/MCPToolUpdateClassSlots.class.st @@ -22,9 +22,9 @@ MCPToolUpdateClassSlots >> classToolSpec [ (#title -> 'Update Class Slots'). (#description -> 'Replace the instance-side and/or class-side slot definition of one class.'). (#inputProperties -> { - self classNameSchemaProperty. + (self schemaPropertyNamed: 'name' type: 'string' description: 'Class name.'). self slotsSchemaProperty. self classSlotsSchemaProperty }). - (#requiredProperties -> #( 'className' )). + (#requiredProperties -> #( 'name' )). (#atLeastOneProperties -> #( 'slots' 'classSlots' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassSuperclass.class.st b/src/MCP/MCPToolUpdateClassSuperclass.class.st index 9deb4dc..642a59b 100644 --- a/src/MCP/MCPToolUpdateClassSuperclass.class.st +++ b/src/MCP/MCPToolUpdateClassSuperclass.class.st @@ -22,7 +22,7 @@ MCPToolUpdateClassSuperclass >> classToolSpec [ (#title -> 'Update Class Superclass'). (#description -> 'Change the superclass of one class.'). (#inputProperties -> { - self classNameSchemaProperty. + (self schemaPropertyNamed: 'name' type: 'string' description: 'Class name.'). self superclassNameSchemaProperty }). - (#requiredProperties -> #( 'className' 'superclassName' )) } asDictionary + (#requiredProperties -> #( 'name' 'superclassName' )) } asDictionary ] diff --git a/src/MCP/MCPToolUpdateClassTraits.class.st b/src/MCP/MCPToolUpdateClassTraits.class.st index fb1bb5b..ece64b4 100644 --- a/src/MCP/MCPToolUpdateClassTraits.class.st +++ b/src/MCP/MCPToolUpdateClassTraits.class.st @@ -28,7 +28,7 @@ MCPToolUpdateClassTraits >> classToolSpec [ (#title -> 'Update Class Traits'). (#description -> 'Replace the instance-side trait composition of one class.'). (#inputProperties -> { - self classNameSchemaProperty. + (self schemaPropertyNamed: 'name' type: 'string' description: 'Class name.'). self traitsSchemaProperty }). - (#requiredProperties -> #( 'className' 'traits' )) } asDictionary + (#requiredProperties -> #( 'name' 'traits' )) } asDictionary ] From 20c0a7e22a01c3a284ed3427c1da8be7d45c472b Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Mon, 31 Aug 2026 12:25:51 +0200 Subject: [PATCH 16/17] Clamp tool arguments above schema maximums --- src/MCP-Tests/MCPToolGetClassTest.class.st | 28 ++++++++------ src/MCP-Tests/MCPToolRequestTest.class.st | 15 +++++--- src/MCP/MCPToolRequest.class.st | 43 +++++++++++++++++++--- 3 files changed, 64 insertions(+), 22 deletions(-) diff --git a/src/MCP-Tests/MCPToolGetClassTest.class.st b/src/MCP-Tests/MCPToolGetClassTest.class.st index 05f47a3..5940278 100644 --- a/src/MCP-Tests/MCPToolGetClassTest.class.st +++ b/src/MCP-Tests/MCPToolGetClassTest.class.st @@ -129,6 +129,23 @@ MCPToolGetClassTest >> tearDown [ super tearDown ] +{ #category : 'tests' } +MCPToolGetClassTest >> testClampsSubclassDepthAboveMaximum [ + + | data result subclasses | + result := self callToolWith: { + (#name -> self baseClassName). + (#subclassDepth -> 1000) } asDictionary. + data := self dataFrom: result. + subclasses := data at: #subclasses. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. + self assert: (subclasses collect: [ :each | each at: #className ]) equals: { + self childAClassName. + self childZClassName. + self grandchildClassName } asArray +] + { #category : 'tests' } MCPToolGetClassTest >> testGetsClassMetadata [ @@ -261,17 +278,6 @@ MCPToolGetClassTest >> testRejectsNegativeSubclassDepth [ raise: MCPInvalidToolInput ] -{ #category : 'tests' } -MCPToolGetClassTest >> testRejectsSubclassDepthAboveMaximum [ - - self - should: [ - self callToolWith: { - (#name -> self baseClassName). - (#subclassDepth -> 11) } asDictionary ] - raise: MCPInvalidToolInput -] - { #category : 'tests' } MCPToolGetClassTest >> testReturnsStructuredErrorWhenClassIsMissing [ diff --git a/src/MCP-Tests/MCPToolRequestTest.class.st b/src/MCP-Tests/MCPToolRequestTest.class.st index b831081..7486ab3 100644 --- a/src/MCP-Tests/MCPToolRequestTest.class.st +++ b/src/MCP-Tests/MCPToolRequestTest.class.st @@ -64,17 +64,14 @@ MCPToolRequestTest >> testInvalidToolInputErrorResponseIncludesViolations [ ] { #category : 'tests' } -MCPToolRequestTest >> testNonNegativeIntegerArgumentRejectsValuesAboveMaximum [ +MCPToolRequestTest >> testNonNegativeIntegerArgumentClampsValuesAboveMaximum [ | request | request := MCPToolRequest new tool: MCPToolDebugState new; arguments: { (#stackLimit -> 51) } asDictionary; yourself. - self - should: [ request nonNegativeIntegerArgumentNamed: 'stackLimit' default: 5 maximum: 50 ] - raise: Error - withExceptionDo: [ :error | self assert: error messageText equals: 'stackLimit must be no greater than 50.' ] + self assert: (request nonNegativeIntegerArgumentNamed: 'stackLimit' default: 5 maximum: 50) equals: 50 ] { #category : 'tests' } @@ -98,6 +95,14 @@ MCPToolRequestTest >> testRequestAccessorsProvideDefaultsUniqueCollectionsSymbol equals: 'testRequestAccessorsProvideDefaultsUniqueCollectionsSymbolsAndNestedStrings' ] +{ #category : 'tests' } +MCPToolRequestTest >> testToolRequestClampsArgumentsAboveSchemaMaximumBeforeValidation [ + + | request | + request := MCPToolSearchPackages new requestFromToolCallArguments: { (#limit -> 1000) } asDictionary. + self assert: (request argumentNamed: 'limit' ifAbsent: [ self fail: 'Expected normalized limit.' ]) equals: 100 +] + { #category : 'tests' } MCPToolRequestTest >> testValidRequestProvidesTypedAccessors [ diff --git a/src/MCP/MCPToolRequest.class.st b/src/MCP/MCPToolRequest.class.st index fa989ed..9c04f25 100644 --- a/src/MCP/MCPToolRequest.class.st +++ b/src/MCP/MCPToolRequest.class.st @@ -81,6 +81,15 @@ MCPToolRequest >> booleanArgumentNamed: anArgumentName in: aDictionary default: ^ value ] +{ #category : 'private - validating' } +MCPToolRequest >> clampArgumentNamed: anArgumentName maximum: maximumValue in: normalizedArguments [ + + | key value | + key := self keyForArgumentNamed: anArgumentName in: normalizedArguments ifAbsent: [ ^ self ]. + value := normalizedArguments at: key. + (value isNumber and: [ value > maximumValue ]) ifTrue: [ normalizedArguments at: key put: maximumValue ] +] + { #category : 'accessing' } MCPToolRequest >> hasArgumentNamed: anArgumentName [ @@ -95,6 +104,16 @@ MCPToolRequest >> initialize [ violations := #( ) ] +{ #category : 'private - validating' } +MCPToolRequest >> keyForArgumentNamed: anArgumentName in: aDictionary ifAbsent: absentBlock [ + + aDictionary ifNil: [ ^ absentBlock value ]. + (aDictionary includesKey: anArgumentName) ifTrue: [ ^ anArgumentName ]. + (aDictionary includesKey: anArgumentName asString) ifTrue: [ ^ anArgumentName asString ]. + (aDictionary includesKey: anArgumentName asSymbol) ifTrue: [ ^ anArgumentName asSymbol ]. + ^ absentBlock value +] + { #category : 'accessing' } MCPToolRequest >> nonNegativeIntegerArgumentNamed: anArgumentName default: anInteger [ @@ -110,8 +129,19 @@ MCPToolRequest >> nonNegativeIntegerArgumentNamed: anArgumentName default: defau | value | value := self nonNegativeIntegerArgumentNamed: anArgumentName default: defaultInteger. - value <= maximumInteger ifTrue: [ ^ value ]. - Error signal: anArgumentName asString , ' must be no greater than ' , maximumInteger asString , '.' + ^ value min: maximumInteger +] + +{ #category : 'private - validating' } +MCPToolRequest >> normalizeArgumentsForInputSchema: anInputSchema [ + + | normalizedArguments | + normalizedArguments := self arguments copy. + anInputSchema properties do: [ :property | + | maximum | + maximum := property extraProperties at: #maximum ifAbsent: [ nil ]. + maximum ifNotNil: [ self clampArgumentNamed: property name maximum: maximum in: normalizedArguments ] ]. + arguments := normalizedArguments ] { #category : 'accessing' } @@ -226,11 +256,12 @@ MCPToolRequest >> uniqueStringCollectionFrom: strings [ { #category : 'validating' } MCPToolRequest >> validate [ - self tool inputSchema ifNil: [ ^ self ]. - violations := MCPJSONSchemaValidator violationsFor: self arguments schema: self tool inputSchema. + | inputSchema | + inputSchema := self tool inputSchema ifNil: [ ^ self ]. + self normalizeArgumentsForInputSchema: inputSchema. + violations := MCPJSONSchemaValidator violationsFor: self arguments schema: inputSchema. violations ifNotEmpty: [ MCPInvalidToolInput signalForTool: self tool violations: violations ]. - self tool validateRequest: self. - ^ self + self tool validateRequest: self ] { #category : 'private - accessing' } From 6867e18161e1aec4650586d4407f04f70bafec92 Mon Sep 17 00:00:00 2001 From: Gabriel Darbord <78592838+Gabriel-Darbord@users.noreply.github.com> Date: Mon, 31 Aug 2026 15:24:42 +0200 Subject: [PATCH 17/17] Format methods after schema revisions --- src/MCP-Tests/MCPToolContractsTest.class.st | 8 ++++---- src/MCP-Tests/MCPToolRepositoryToolsTest.class.st | 3 +-- src/MCP/MCPObservabilityBackend.class.st | 6 +++--- 3 files changed, 8 insertions(+), 9 deletions(-) diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 21a17ee..b744d77 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -1204,10 +1204,10 @@ MCPToolContractsTest >> testDiscoveryUsesConfiguredStaticToolNames [ metadataByName := (((self dataFrom: result) at: #tools) collect: [ :each | (each at: #name) -> each ]) asDictionary. self assert: (metadataByName includesKey: 'repository_search'). self assert: (metadataByName includesKey: 'repository_create'). - searchContract := (self dataFrom: - (server rpcToolCall: 'tool_get' withParams: { (#name -> 'repository_search') } asDictionary)) at: #tool. - createContract := (self dataFrom: - (server rpcToolCall: 'tool_get' withParams: { (#name -> 'repository_create') } asDictionary)) at: #tool. + searchContract := (self dataFrom: (server rpcToolCall: 'tool_get' withParams: { (#name -> 'repository_search') } asDictionary)) + at: #tool. + createContract := (self dataFrom: (server rpcToolCall: 'tool_get' withParams: { (#name -> 'repository_create') } asDictionary)) + at: #tool. self assert: searchContract keys asSet equals: #( name description group exposure annotations keywords inputSchema ) asSet. self assert: createContract keys asSet equals: #( name description group exposure annotations keywords inputSchema ) asSet. self assert: (searchContract at: #exposure) equals: 'static'. diff --git a/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st b/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st index 41adae3..1c3036f 100644 --- a/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st +++ b/src/MCP-Tests/MCPToolRepositoryToolsTest.class.st @@ -223,8 +223,7 @@ MCPToolRepositoryToolsTest >> testRepositoryToolsUseDedicatedInputs [ | expectations | expectations := { (MCPToolVerifyRepositoryIdentity - -> - #( 'name' 'location' 'branchName' 'subdirectory' 'packageNames' 'modifiedPackageNames' + -> #( 'name' 'location' 'branchName' 'subdirectory' 'packageNames' 'modifiedPackageNames' 'isModified' )). (MCPToolListRepositoryChanges -> #( 'name' 'location' )). (MCPToolCreateRepository -> #( 'name' 'location' 'subdirectory' 'packageNames' )). diff --git a/src/MCP/MCPObservabilityBackend.class.st b/src/MCP/MCPObservabilityBackend.class.st index 08ab198..61a0a74 100644 --- a/src/MCP/MCPObservabilityBackend.class.st +++ b/src/MCP/MCPObservabilityBackend.class.st @@ -20,7 +20,7 @@ MCPObservabilityBackend class >> isAbstract [ { #category : 'clearing' } MCPObservabilityBackend >> clear [ - + ^ self ] { #category : 'activation' } @@ -94,7 +94,7 @@ MCPObservabilityBackend >> exportDirectory [ { #category : 'accessing' } MCPObservabilityBackend >> exportDirectory: aPath [ - + ^ self ] { #category : 'testing' } @@ -203,7 +203,7 @@ MCPObservabilityBackend >> resourceMetadata [ { #category : 'accessing' } MCPObservabilityBackend >> resourceMetadata: aDictionary [ - + ^ self ] { #category : 'actions' }