From 496532f102deee308a9896c353c1f4219dae9d1e Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Wed, 24 Jun 2026 14:02:39 +0200 Subject: [PATCH 01/21] Remove useless `self` returns Co-authored-by: Codex --- src/MCP/MCP.class.st | 3 +- .../MCPAdoptRepositoryHeadCommand.class.st | 6 +- src/MCP/MCPClassCreateRequest.class.st | 3 +- src/MCP/MCPClassDescriptionInfo.class.st | 3 +- src/MCP/MCPClassInfo.class.st | 3 +- src/MCP/MCPClassUpdateRequest.class.st | 40 +++-- src/MCP/MCPCompileMethodCommand.class.st | 3 +- src/MCP/MCPCompiledMethodInfo.class.st | 3 +- src/MCP/MCPCreateClassToolCommand.class.st | 3 +- .../MCPCreateRepositoryBranchCommand.class.st | 3 +- src/MCP/MCPCreateRepositoryCommand.class.st | 3 +- src/MCP/MCPDebugAttachedContinuation.class.st | 3 +- ...AttachedDebuggerSelectionStrategy.class.st | 3 +- src/MCP/MCPDebugBreakpointRecord.class.st | 12 +- src/MCP/MCPDebugBreakpointRegistry.class.st | 11 +- src/MCP/MCPDebugBreakpointsCommand.class.st | 3 +- src/MCP/MCPDebugCaptureContinuation.class.st | 15 +- src/MCP/MCPDebugCommand.class.st | 3 +- src/MCP/MCPDebugRepairAnalyzer.class.st | 6 +- src/MCP/MCPDebugSessionCandidate.class.st | 3 +- src/MCP/MCPDebugSessionInfo.class.st | 3 +- src/MCP/MCPDebugSessionRecord.class.st | 24 +-- src/MCP/MCPDebugSessionRegistry.class.st | 8 +- src/MCP/MCPDebugStateInfo.class.st | 3 +- src/MCP/MCPDebugToolResult.class.st | 3 +- src/MCP/MCPDebugVariableReference.class.st | 3 +- src/MCP/MCPEvaluateCommand.class.st | 3 +- src/MCP/MCPEvaluateRequest.class.st | 3 +- src/MCP/MCPEvaluateResult.class.st | 3 +- src/MCP/MCPFetchRepositoryCommand.class.st | 3 +- src/MCP/MCPGetClassCommand.class.st | 3 +- src/MCP/MCPGetClassRequest.class.st | 3 +- src/MCP/MCPGetClassResult.class.st | 3 +- src/MCP/MCPGetMethodCommand.class.st | 3 +- src/MCP/MCPGetMethodRequest.class.st | 3 +- src/MCP/MCPGetMethodResult.class.st | 3 +- src/MCP/MCPGitRepositoryMetadata.class.st | 3 +- src/MCP/MCPLoadBaselineCommand.class.st | 3 +- src/MCP/MCPLoadBaselineRequest.class.st | 3 +- src/MCP/MCPLoadBaselineResult.class.st | 3 +- src/MCP/MCPLoadRepositoryCommand.class.st | 3 +- src/MCP/MCPLoadRepositoryRequest.class.st | 9 +- src/MCP/MCPLoadRepositoryResult.class.st | 3 +- src/MCP/MCPMessageProcessor.class.st | 2 +- src/MCP/MCPMethodCompileRequest.class.st | 6 +- src/MCP/MCPMethodReferenceSpec.class.st | 3 +- src/MCP/MCPMethodRewriteChangeInfo.class.st | 17 +-- src/MCP/MCPMethodRewriteReport.class.st | 3 +- src/MCP/MCPMethodRewriteRuleSpec.class.st | 3 +- src/MCP/MCPMethodUpdateRequest.class.st | 144 +++++++++--------- src/MCP/MCPPackageInfo.class.st | 3 +- src/MCP/MCPPullRepositoryCommand.class.st | 3 +- src/MCP/MCPPushRepositoryCommand.class.st | 3 +- src/MCP/MCPRefactoringScopeSpec.class.st | 3 +- src/MCP/MCPRemoveClassesRequest.class.st | 3 +- src/MCP/MCPRemoveMethodsCommand.class.st | 3 +- src/MCP/MCPRemoveMethodsRequest.class.st | 3 +- src/MCP/MCPRemoveMethodsResult.class.st | 3 +- .../MCPRepositoryAdoptHeadRequest.class.st | 3 +- src/MCP/MCPRepositoryAdoptHeadResult.class.st | 3 +- src/MCP/MCPRepositoryBranchResult.class.st | 3 +- src/MCP/MCPRepositoryCommitRequest.class.st | 3 +- src/MCP/MCPRepositoryCommitResult.class.st | 9 +- .../MCPRepositoryCreateBranchRequest.class.st | 3 +- src/MCP/MCPRepositoryCreateRequest.class.st | 3 +- src/MCP/MCPRepositoryCreateResult.class.st | 9 +- src/MCP/MCPRepositoryDiffRequest.class.st | 3 +- src/MCP/MCPRepositoryDiffResult.class.st | 9 +- src/MCP/MCPRepositoryExportRequest.class.st | 3 +- src/MCP/MCPRepositoryExportResult.class.st | 9 +- src/MCP/MCPRepositoryFetchRequest.class.st | 3 +- src/MCP/MCPRepositoryFetchResult.class.st | 3 +- src/MCP/MCPRepositoryPullRequest.class.st | 3 +- src/MCP/MCPRepositoryPullResult.class.st | 3 +- src/MCP/MCPRepositoryPushRequest.class.st | 3 +- src/MCP/MCPRepositoryPushResult.class.st | 3 +- src/MCP/MCPRepositoryReferenceSpec.class.st | 3 +- .../MCPRepositorySwitchBranchRequest.class.st | 3 +- src/MCP/MCPRepositoryUpdateRequest.class.st | 3 +- src/MCP/MCPRepositoryUpdateResult.class.st | 9 +- ...CPRepositoryVerifyIdentityCommand.class.st | 3 +- ...CPRepositoryVerifyIdentityRequest.class.st | 23 +-- ...MCPRepositoryVerifyIdentityResult.class.st | 3 +- .../MCPRepositoryWorkingCopyCommand.class.st | 3 +- src/MCP/MCPRewriteMethodsCommand.class.st | 3 +- src/MCP/MCPRunTestsCommand.class.st | 3 +- src/MCP/MCPRunTestsRequest.class.st | 3 +- src/MCP/MCPRunTestsResult.class.st | 3 +- src/MCP/MCPScreenshotCommand.class.st | 3 +- src/MCP/MCPScreenshotRequest.class.st | 3 +- src/MCP/MCPScreenshotResult.class.st | 3 +- .../MCPSwitchRepositoryBranchCommand.class.st | 3 +- src/MCP/MCPTestCoverageRequest.class.st | 5 +- src/MCP/MCPTestCoverageResult.class.st | 3 +- src/MCP/MCPTestRunInfo.class.st | 3 +- src/MCP/MCPTestRunRequest.class.st | 3 +- src/MCP/MCPTestRunResult.class.st | 3 +- src/MCP/MCPToolRequest.class.st | 3 +- src/MCP/MCPUpdateClassCommand.class.st | 3 +- src/MCP/MCPUpdateDebugMethodRequest.class.st | 3 +- src/MCP/MCPUpdateMethodCommand.class.st | 3 +- src/MCP/MCPUpdateRepositoryCommand.class.st | 3 +- src/MCP/MCPValidatedTestRunRequest.class.st | 3 +- 103 files changed, 249 insertions(+), 373 deletions(-) diff --git a/src/MCP/MCP.class.st b/src/MCP/MCP.class.st index 57d0de3..e7043fb 100644 --- a/src/MCP/MCP.class.st +++ b/src/MCP/MCP.class.st @@ -404,8 +404,7 @@ MCP >> staticToolNames [ MCP >> staticToolNames: aCollection [ self toolExposurePolicy: - (MCPToolExposurePolicy staticToolNames: aCollection). - ^ self + (MCPToolExposurePolicy staticToolNames: aCollection) ] { #category : 'accessing' } diff --git a/src/MCP/MCPAdoptRepositoryHeadCommand.class.st b/src/MCP/MCPAdoptRepositoryHeadCommand.class.st index 6e816fe..5ca3aaa 100644 --- a/src/MCP/MCPAdoptRepositoryHeadCommand.class.st +++ b/src/MCP/MCPAdoptRepositoryHeadCommand.class.st @@ -74,8 +74,7 @@ MCPAdoptRepositoryHeadCommand >> execute [ MCPAdoptRepositoryHeadCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'private' } @@ -132,6 +131,5 @@ MCPAdoptRepositoryHeadCommand >> validateHeadCommit: headCommit for: aRepository headCommit ifNil: [ ^ self signalMissingHeadCommitFor: aRepository ]. (MCPIcebergCommitInfo isNoCommit: headCommit) ifTrue: [ - ^ self signalMissingHeadCommitFor: aRepository ]. - ^ self + ^ self signalMissingHeadCommitFor: aRepository ] ] diff --git a/src/MCP/MCPClassCreateRequest.class.st b/src/MCP/MCPClassCreateRequest.class.st index 5a374ce..c3470bc 100644 --- a/src/MCP/MCPClassCreateRequest.class.st +++ b/src/MCP/MCPClassCreateRequest.class.st @@ -107,8 +107,7 @@ MCPClassCreateRequest >> initializeFromRequest: request [ 'sharedVariables'. sharedPoolNames := request stringCollectionArgumentNamed: 'sharedPools'. - layout := request stringArgumentNamed: 'layout'. - ^ self + layout := request stringArgumentNamed: 'layout' ] { #category : 'accessing' } diff --git a/src/MCP/MCPClassDescriptionInfo.class.st b/src/MCP/MCPClassDescriptionInfo.class.st index 1c3c301..db480ab 100644 --- a/src/MCP/MCPClassDescriptionInfo.class.st +++ b/src/MCP/MCPClassDescriptionInfo.class.st @@ -91,6 +91,5 @@ MCPClassDescriptionInfo >> initializeFromClass: aClass [ each asString ]) asArray. layoutClassName := aClass classLayout class name asString. instanceMethodCount := aClass selectors size. - classMethodCount := aClass classSide selectors size. - ^ self + classMethodCount := aClass classSide selectors size ] diff --git a/src/MCP/MCPClassInfo.class.st b/src/MCP/MCPClassInfo.class.st index 8fc1434..0e431f3 100644 --- a/src/MCP/MCPClassInfo.class.st +++ b/src/MCP/MCPClassInfo.class.st @@ -111,8 +111,7 @@ MCPClassInfo >> initializeFromClass: aClass [ layoutClassName := aClass classLayout class name asString. subclassNames := (aClass subclasses collect: [ :each | each name asString ] - as: Array) sort. - ^ self + as: Array) sort ] { #category : 'accessing' } diff --git a/src/MCP/MCPClassUpdateRequest.class.st b/src/MCP/MCPClassUpdateRequest.class.st index 4a8cf22..20da9a4 100644 --- a/src/MCP/MCPClassUpdateRequest.class.st +++ b/src/MCP/MCPClassUpdateRequest.class.st @@ -191,8 +191,7 @@ MCPClassUpdateRequest >> initializeFromRequest: request [ slotName := request stringArgumentNamed: 'slotName'. newSlotName := request stringArgumentNamed: 'newSlotName'. slotAction := request stringArgumentNamed: 'slotAction'. - classSide := request booleanArgumentNamed: 'classSide' default: false. - ^ self + classSide := request booleanArgumentNamed: 'classSide' default: false ] { #category : 'accessing' } @@ -418,29 +417,28 @@ MCPClassUpdateRequest >> validateSlotUpdate [ | operation | operation := self slotOperation. operation ifNil: [ - (self hasSlotName or: [ self hasNewSlotName ]) ifTrue: [ + (self hasSlotName or: [ self hasNewSlotName ]) ifTrue: [ + MCPCommandError + signalErrorCode: #SlotActionRequired + message: + 'slotAction is required when slotName or newSlotName is provided for update.' + details: self slotRequestedContext ]. + ^ self ]. + self hasSlotName ifFalse: [ MCPCommandError - signalErrorCode: #SlotActionRequired - message: - 'slotAction is required when slotName or newSlotName is provided for update.' + signalErrorCode: #SlotNameRequired + message: 'slotName is required for slot updates.' details: self slotRequestedContext ]. - ^ self ]. - self hasSlotName ifFalse: [ - MCPCommandError - signalErrorCode: #SlotNameRequired - message: 'slotName is required for slot updates.' - details: self slotRequestedContext ]. (operation = 'renameSlot' and: [ self hasNewSlotName not ]) ifTrue: [ - MCPCommandError - signalErrorCode: #NewSlotNameRequired - message: 'newSlotName is required when slotAction=rename.' - details: self slotRequestedContext ]. + MCPCommandError + signalErrorCode: #NewSlotNameRequired + message: 'newSlotName is required when slotAction=rename.' + details: self slotRequestedContext ]. (operation ~= 'renameSlot' and: [ self hasNewSlotName ]) ifTrue: [ - MCPCommandError - signalErrorCode: #UnexpectedNewSlotName - message: 'newSlotName is only accepted when slotAction=rename.' - details: self slotRequestedContext ]. - ^ self + MCPCommandError + signalErrorCode: #UnexpectedNewSlotName + message: 'newSlotName is only accepted when slotAction=rename.' + details: self slotRequestedContext ] ] { #category : 'converting' } diff --git a/src/MCP/MCPCompileMethodCommand.class.st b/src/MCP/MCPCompileMethodCommand.class.st index 2775d5b..94d3b92 100644 --- a/src/MCP/MCPCompileMethodCommand.class.st +++ b/src/MCP/MCPCompileMethodCommand.class.st @@ -79,8 +79,7 @@ MCPCompileMethodCommand >> execute [ MCPCompileMethodCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPCompiledMethodInfo.class.st b/src/MCP/MCPCompiledMethodInfo.class.st index bc726c4..b0feac2 100644 --- a/src/MCP/MCPCompiledMethodInfo.class.st +++ b/src/MCP/MCPCompiledMethodInfo.class.st @@ -78,8 +78,7 @@ MCPCompiledMethodInfo >> initializeFromMethod: aCompiledMethod [ classPackageName := aCompiledMethod methodClass instanceSide package name asString. isExtension := packageName ~= classPackageName. - source := aCompiledMethod sourceCode ifNil: [ '' ]. - ^ self + source := aCompiledMethod sourceCode ifNil: [ '' ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPCreateClassToolCommand.class.st b/src/MCP/MCPCreateClassToolCommand.class.st index 6814773..eba0a0f 100644 --- a/src/MCP/MCPCreateClassToolCommand.class.st +++ b/src/MCP/MCPCreateClassToolCommand.class.st @@ -65,8 +65,7 @@ MCPCreateClassToolCommand >> execute [ MCPCreateClassToolCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPCreateRepositoryBranchCommand.class.st b/src/MCP/MCPCreateRepositoryBranchCommand.class.st index e05265f..1b30317 100644 --- a/src/MCP/MCPCreateRepositoryBranchCommand.class.st +++ b/src/MCP/MCPCreateRepositoryBranchCommand.class.st @@ -50,8 +50,7 @@ MCPCreateRepositoryBranchCommand >> execute [ MCPCreateRepositoryBranchCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPCreateRepositoryCommand.class.st b/src/MCP/MCPCreateRepositoryCommand.class.st index bb46031..d134de4 100644 --- a/src/MCP/MCPCreateRepositoryCommand.class.st +++ b/src/MCP/MCPCreateRepositoryCommand.class.st @@ -66,8 +66,7 @@ MCPCreateRepositoryCommand >> execute [ MCPCreateRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPDebugAttachedContinuation.class.st b/src/MCP/MCPDebugAttachedContinuation.class.st index 71c3631..5cbb7dd 100644 --- a/src/MCP/MCPDebugAttachedContinuation.class.st +++ b/src/MCP/MCPDebugAttachedContinuation.class.st @@ -85,8 +85,7 @@ MCPDebugAttachedContinuation >> debugSession [ { #category : 'accessing' } MCPDebugAttachedContinuation >> debugSession: aDebugSession [ - outcome at: #debugSession put: aDebugSession. - ^ self + outcome at: #debugSession put: aDebugSession ] { #category : 'accessing' } diff --git a/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st b/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st index ac002c7..757adc0 100644 --- a/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st +++ b/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st @@ -86,8 +86,7 @@ MCPDebugAttachedDebuggerSelectionStrategy class >> reset [ PreviousStrategy := nil. OupsDebuggerSelectionStrategy debuggerSelectionStrategy = self ifTrue: [ - OupsDebuggerSelectionStrategy debuggerSelectionStrategy: fallback ]. - ^ self + OupsDebuggerSelectionStrategy debuggerSelectionStrategy: fallback ] ] { #category : 'debuggers' } diff --git a/src/MCP/MCPDebugBreakpointRecord.class.st b/src/MCP/MCPDebugBreakpointRecord.class.st index 8cb63c3..9be9261 100644 --- a/src/MCP/MCPDebugBreakpointRecord.class.st +++ b/src/MCP/MCPDebugBreakpointRecord.class.st @@ -71,15 +71,13 @@ MCPDebugBreakpointRecord >> debugPoint [ { #category : 'controlling' } MCPDebugBreakpointRecord >> disable [ - debugPoint disable. - ^ self + debugPoint disable ] { #category : 'controlling' } MCPDebugBreakpointRecord >> enable [ - debugPoint enable. - ^ self + debugPoint enable ] { #category : 'accessing' } @@ -100,8 +98,7 @@ MCPDebugBreakpointRecord >> initializeBreakpointId: breakpointString debugPoint: sourceStart := startInteger. sourceStop := stopInteger. nodeClassName := nodeClassString. - createdAt := aDateAndTime. - ^ self + createdAt := aDateAndTime ] { #category : 'removing' } @@ -110,8 +107,7 @@ MCPDebugBreakpointRecord >> remove [ debugPoint ifNil: [ ^ self ]. [ debugPoint remove ] on: Error - do: [ :ignored | nil ]. - ^ self + do: [ :ignored | nil ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPDebugBreakpointRegistry.class.st b/src/MCP/MCPDebugBreakpointRegistry.class.st index dd49f0e..d8799ba 100644 --- a/src/MCP/MCPDebugBreakpointRegistry.class.st +++ b/src/MCP/MCPDebugBreakpointRegistry.class.st @@ -21,16 +21,14 @@ Class { { #category : 'accessing' } MCPDebugBreakpointRegistry class >> default [ - Default ifNil: [ Default := self new ]. - ^ Default + ^ Default ifNil: [ Default := self new ] ] -{ #category : 'accessing' } +{ #category : 'class initialization' } MCPDebugBreakpointRegistry class >> resetDefault [ Default ifNotNil: [ Default removeAll ]. - Default := nil. - ^ self + Default := nil ] { #category : 'accessing' } @@ -85,8 +83,7 @@ MCPDebugBreakpointRegistry >> registerDebugPoint: aDebugPoint className: aClassN MCPDebugBreakpointRegistry >> removeAll [ breakpoints valuesDo: [ :each | each remove ]. - breakpoints removeAll. - ^ self + breakpoints removeAll ] { #category : 'removing' } diff --git a/src/MCP/MCPDebugBreakpointsCommand.class.st b/src/MCP/MCPDebugBreakpointsCommand.class.st index 2afe974..4866ee2 100644 --- a/src/MCP/MCPDebugBreakpointsCommand.class.st +++ b/src/MCP/MCPDebugBreakpointsCommand.class.st @@ -102,8 +102,7 @@ MCPDebugBreakpointsCommand >> initializeTool: aTool request: aRequest registry: tool := aTool. request := aRequest. - registry := aRegistry. - ^ self + registry := aRegistry ] { #category : 'private - actions' } diff --git a/src/MCP/MCPDebugCaptureContinuation.class.st b/src/MCP/MCPDebugCaptureContinuation.class.st index 3f2c485..7c7e74e 100644 --- a/src/MCP/MCPDebugCaptureContinuation.class.st +++ b/src/MCP/MCPDebugCaptureContinuation.class.st @@ -62,8 +62,7 @@ MCPDebugCaptureContinuation >> outcome [ { #category : 'accessing' } MCPDebugCaptureContinuation >> outcome: aDictionary [ - outcome := aDictionary. - ^ self + outcome := aDictionary ] { #category : 'private' } @@ -94,8 +93,7 @@ MCPDebugCaptureContinuation >> resultPreviewCharacterLimit [ { #category : 'accessing' } MCPDebugCaptureContinuation >> resultPreviewCharacterLimit: anInteger [ - resultPreviewCharacterLimit := anInteger. - ^ self + resultPreviewCharacterLimit := anInteger ] { #category : 'accessing' } @@ -107,8 +105,7 @@ MCPDebugCaptureContinuation >> semaphore [ { #category : 'accessing' } MCPDebugCaptureContinuation >> semaphore: aSemaphore [ - semaphore := aSemaphore. - ^ self + semaphore := aSemaphore ] { #category : 'controlling' } @@ -137,8 +134,7 @@ MCPDebugCaptureContinuation >> timeoutMilliseconds [ { #category : 'accessing' } MCPDebugCaptureContinuation >> timeoutMilliseconds: anInteger [ - timeoutMilliseconds := anInteger. - ^ self + timeoutMilliseconds := anInteger ] { #category : 'controlling' } @@ -156,6 +152,5 @@ MCPDebugCaptureContinuation >> workerProcess [ { #category : 'accessing' } MCPDebugCaptureContinuation >> workerProcess: aProcess [ - workerProcess := aProcess. - ^ self + workerProcess := aProcess ] diff --git a/src/MCP/MCPDebugCommand.class.st b/src/MCP/MCPDebugCommand.class.st index 00467ef..5f3ad4a 100644 --- a/src/MCP/MCPDebugCommand.class.st +++ b/src/MCP/MCPDebugCommand.class.st @@ -36,8 +36,7 @@ MCPDebugCommand >> initializeTool: aTool request: aRequest registry: aRegistry [ tool := aTool. request := aRequest. - registry := aRegistry. - ^ self + registry := aRegistry ] { #category : 'private' } diff --git a/src/MCP/MCPDebugRepairAnalyzer.class.st b/src/MCP/MCPDebugRepairAnalyzer.class.st index a4ddc97..31f35c6 100644 --- a/src/MCP/MCPDebugRepairAnalyzer.class.st +++ b/src/MCP/MCPDebugRepairAnalyzer.class.st @@ -199,8 +199,7 @@ MCPDebugRepairAnalyzer >> record [ { #category : 'accessing' } MCPDebugRepairAnalyzer >> record: aRecord [ - record := aRecord. - ^ self + record := aRecord ] { #category : 'private - actions' } @@ -246,8 +245,7 @@ MCPDebugRepairAnalyzer >> request [ { #category : 'accessing' } MCPDebugRepairAnalyzer >> request: aRequest [ - request := aRequest. - ^ self + request := aRequest ] { #category : 'private - contexts' } diff --git a/src/MCP/MCPDebugSessionCandidate.class.st b/src/MCP/MCPDebugSessionCandidate.class.st index ba5790b..169c0a9 100644 --- a/src/MCP/MCPDebugSessionCandidate.class.st +++ b/src/MCP/MCPDebugSessionCandidate.class.st @@ -66,8 +66,7 @@ MCPDebugSessionCandidate >> debugger [ { #category : 'accessing' } MCPDebugSessionCandidate >> debugger: aDebugger [ - debugger := aDebugger. - ^ self + debugger := aDebugger ] { #category : 'private' } diff --git a/src/MCP/MCPDebugSessionInfo.class.st b/src/MCP/MCPDebugSessionInfo.class.st index 954be8d..1ef8539 100644 --- a/src/MCP/MCPDebugSessionInfo.class.st +++ b/src/MCP/MCPDebugSessionInfo.class.st @@ -46,6 +46,5 @@ MCPDebugSessionInfo >> record [ { #category : 'accessing' } MCPDebugSessionInfo >> record: aRecord [ - record := aRecord. - ^ self + record := aRecord ] diff --git a/src/MCP/MCPDebugSessionRecord.class.st b/src/MCP/MCPDebugSessionRecord.class.st index bfd7c5a..297629f 100644 --- a/src/MCP/MCPDebugSessionRecord.class.st +++ b/src/MCP/MCPDebugSessionRecord.class.st @@ -74,8 +74,7 @@ MCPDebugSessionRecord >> continuation [ { #category : 'accessing' } MCPDebugSessionRecord >> continuation: aContinuation [ - continuation := aContinuation. - ^ self + continuation := aContinuation ] { #category : 'accessing' } @@ -87,8 +86,7 @@ MCPDebugSessionRecord >> createdAt [ { #category : 'accessing' } MCPDebugSessionRecord >> createdAt: aDateAndTime [ - createdAt := aDateAndTime. - ^ self + createdAt := aDateAndTime ] { #category : 'accessing' } @@ -100,8 +98,7 @@ MCPDebugSessionRecord >> debugSession [ { #category : 'accessing' } MCPDebugSessionRecord >> debugSession: anObject [ - debugSession := anObject. - ^ self + debugSession := anObject ] { #category : 'accessing' } @@ -125,8 +122,7 @@ MCPDebugSessionRecord >> name [ { #category : 'accessing' } MCPDebugSessionRecord >> name: aString [ - name := aString. - ^ self + name := aString ] { #category : 'accessing' } @@ -138,8 +134,7 @@ MCPDebugSessionRecord >> reason [ { #category : 'accessing' } MCPDebugSessionRecord >> reason: aString [ - reason := aString. - ^ self + reason := aString ] { #category : 'accessing' } @@ -151,8 +146,7 @@ MCPDebugSessionRecord >> sessionId [ { #category : 'accessing' } MCPDebugSessionRecord >> sessionId: aString [ - sessionId := aString. - ^ self + sessionId := aString ] { #category : 'accessing' } @@ -164,8 +158,7 @@ MCPDebugSessionRecord >> stateId [ { #category : 'accessing' } MCPDebugSessionRecord >> stateId: aString [ - stateId := aString. - ^ self + stateId := aString ] { #category : 'accessing' } @@ -177,6 +170,5 @@ MCPDebugSessionRecord >> status [ { #category : 'accessing' } MCPDebugSessionRecord >> status: aString [ - status := aString. - ^ self + status := aString ] diff --git a/src/MCP/MCPDebugSessionRegistry.class.st b/src/MCP/MCPDebugSessionRegistry.class.st index 3782a3d..9ace02b 100644 --- a/src/MCP/MCPDebugSessionRegistry.class.st +++ b/src/MCP/MCPDebugSessionRegistry.class.st @@ -21,15 +21,13 @@ Class { { #category : 'accessing' } MCPDebugSessionRegistry class >> default [ - Default ifNil: [ Default := self new ]. - ^ Default + ^ Default ifNil: [ Default := self new ] ] -{ #category : 'accessing' } +{ #category : 'class initialization' } MCPDebugSessionRegistry class >> resetDefault [ - Default := nil. - ^ self + Default := nil ] { #category : 'accessing' } diff --git a/src/MCP/MCPDebugStateInfo.class.st b/src/MCP/MCPDebugStateInfo.class.st index 1a107dc..0ddeeca 100644 --- a/src/MCP/MCPDebugStateInfo.class.st +++ b/src/MCP/MCPDebugStateInfo.class.st @@ -175,8 +175,7 @@ MCPDebugStateInfo >> record [ { #category : 'accessing' } MCPDebugStateInfo >> record: aRecord [ - record := aRecord. - ^ self + record := aRecord ] { #category : 'accessing' } diff --git a/src/MCP/MCPDebugToolResult.class.st b/src/MCP/MCPDebugToolResult.class.st index d9e6173..5bbc152 100644 --- a/src/MCP/MCPDebugToolResult.class.st +++ b/src/MCP/MCPDebugToolResult.class.st @@ -65,8 +65,7 @@ MCPDebugToolResult >> initializeStatus: aStatus summary: aSummary data: aDiction summary := aSummary. data := aDictionary. warnings := warningCollection. - errorDetails := detailsDictionary. - ^ self + errorDetails := detailsDictionary ] { #category : 'testing' } diff --git a/src/MCP/MCPDebugVariableReference.class.st b/src/MCP/MCPDebugVariableReference.class.st index 9e8bd43..a4acf6c 100644 --- a/src/MCP/MCPDebugVariableReference.class.st +++ b/src/MCP/MCPDebugVariableReference.class.st @@ -83,8 +83,7 @@ MCPDebugVariableReference >> initializeRawReference: rawString sessionId: sessio frameIndex := frameInteger. scopeName := scopeString. variableName := variableString. - pathSegments := segmentArray. - ^ self + pathSegments := segmentArray ] { #category : 'testing' } diff --git a/src/MCP/MCPEvaluateCommand.class.st b/src/MCP/MCPEvaluateCommand.class.st index c80d62e..376566b 100644 --- a/src/MCP/MCPEvaluateCommand.class.st +++ b/src/MCP/MCPEvaluateCommand.class.st @@ -53,8 +53,7 @@ MCPEvaluateCommand >> initializeTool: aTool request: aRequest resultPreviewChara tool := aTool. request := aRequest. - resultPreviewCharacterLimit := anInteger. - ^ self + resultPreviewCharacterLimit := anInteger ] { #category : 'accessing' } diff --git a/src/MCP/MCPEvaluateRequest.class.st b/src/MCP/MCPEvaluateRequest.class.st index e5f9370..6e45052 100644 --- a/src/MCP/MCPEvaluateRequest.class.st +++ b/src/MCP/MCPEvaluateRequest.class.st @@ -27,6 +27,5 @@ MCPEvaluateRequest >> code [ { #category : 'initialization' } MCPEvaluateRequest >> initializeCode: aString [ - code := aString. - ^ self + code := aString ] diff --git a/src/MCP/MCPEvaluateResult.class.st b/src/MCP/MCPEvaluateResult.class.st index 91ab2cb..02d8dd2 100644 --- a/src/MCP/MCPEvaluateResult.class.st +++ b/src/MCP/MCPEvaluateResult.class.st @@ -53,8 +53,7 @@ MCPEvaluateResult >> initializeStatus: aStatus data: aDictionary summary: aStrin status := aStatus. data := aDictionary. summary := aString. - errorDetails := detailsDictionary. - ^ self + errorDetails := detailsDictionary ] { #category : 'testing' } diff --git a/src/MCP/MCPFetchRepositoryCommand.class.st b/src/MCP/MCPFetchRepositoryCommand.class.st index dd4db4d..6302dbf 100644 --- a/src/MCP/MCPFetchRepositoryCommand.class.st +++ b/src/MCP/MCPFetchRepositoryCommand.class.st @@ -49,8 +49,7 @@ MCPFetchRepositoryCommand >> execute [ MCPFetchRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetClassCommand.class.st b/src/MCP/MCPGetClassCommand.class.st index cb4ae59..7de8025 100644 --- a/src/MCP/MCPGetClassCommand.class.st +++ b/src/MCP/MCPGetClassCommand.class.st @@ -48,8 +48,7 @@ MCPGetClassCommand >> execute [ MCPGetClassCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetClassRequest.class.st b/src/MCP/MCPGetClassRequest.class.st index 495fbd5..a339243 100644 --- a/src/MCP/MCPGetClassRequest.class.st +++ b/src/MCP/MCPGetClassRequest.class.st @@ -48,8 +48,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/MCPGetClassResult.class.st b/src/MCP/MCPGetClassResult.class.st index 8d1525c..347d0f8 100644 --- a/src/MCP/MCPGetClassResult.class.st +++ b/src/MCP/MCPGetClassResult.class.st @@ -43,8 +43,7 @@ MCPGetClassResult >> initializeClassName: aClassName data: aDictionary superclas className := aClassName. data := aDictionary. superclasses := superclassCollection. - subclasses := subclassCollection. - ^ self + subclasses := subclassCollection ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetMethodCommand.class.st b/src/MCP/MCPGetMethodCommand.class.st index d81be65..da95b51 100644 --- a/src/MCP/MCPGetMethodCommand.class.st +++ b/src/MCP/MCPGetMethodCommand.class.st @@ -49,8 +49,7 @@ MCPGetMethodCommand >> execute [ MCPGetMethodCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetMethodRequest.class.st b/src/MCP/MCPGetMethodRequest.class.st index 3a9dabc..786f7cb 100644 --- a/src/MCP/MCPGetMethodRequest.class.st +++ b/src/MCP/MCPGetMethodRequest.class.st @@ -58,8 +58,7 @@ MCPGetMethodRequest >> initializeClassName: aClassName selectorString: aSelector className := aClassName. selectorString := aSelectorString. classSide := aSide. - includeVariableDetails := aBoolean. - ^ self + includeVariableDetails := aBoolean ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetMethodResult.class.st b/src/MCP/MCPGetMethodResult.class.st index 73ad4e3..2619127 100644 --- a/src/MCP/MCPGetMethodResult.class.st +++ b/src/MCP/MCPGetMethodResult.class.st @@ -37,6 +37,5 @@ MCPGetMethodResult >> externalVariableCount [ MCPGetMethodResult >> initializeData: aDictionary externalVariableCount: anIntegerOrNil [ data := aDictionary. - externalVariableCount := anIntegerOrNil. - ^ self + externalVariableCount := anIntegerOrNil ] diff --git a/src/MCP/MCPGitRepositoryMetadata.class.st b/src/MCP/MCPGitRepositoryMetadata.class.st index 9ecfe4a..0eff0a9 100644 --- a/src/MCP/MCPGitRepositoryMetadata.class.st +++ b/src/MCP/MCPGitRepositoryMetadata.class.st @@ -161,8 +161,7 @@ MCPGitRepositoryMetadata >> initializeWithLocationString: aString [ location := aString ifNil: [ '' ]. gitDirectory := self gitDirectoryForLocation: location. - configEntries := self configEntriesFromGitDirectory: gitDirectory. - ^ self + configEntries := self configEntriesFromGitDirectory: gitDirectory ] { #category : 'private - parsing' } diff --git a/src/MCP/MCPLoadBaselineCommand.class.st b/src/MCP/MCPLoadBaselineCommand.class.st index 9443feb..7f3ad43 100644 --- a/src/MCP/MCPLoadBaselineCommand.class.st +++ b/src/MCP/MCPLoadBaselineCommand.class.st @@ -85,8 +85,7 @@ MCPLoadBaselineCommand >> initializeTool: aTool request: aRequest configureMetac tool := aTool. request := aRequest. - configureMetacelloBlock := aBlock. - ^ self + configureMetacelloBlock := aBlock ] { #category : 'private - loading' } diff --git a/src/MCP/MCPLoadBaselineRequest.class.st b/src/MCP/MCPLoadBaselineRequest.class.st index e39590f..9dda4d4 100644 --- a/src/MCP/MCPLoadBaselineRequest.class.st +++ b/src/MCP/MCPLoadBaselineRequest.class.st @@ -61,8 +61,7 @@ MCPLoadBaselineRequest >> initializeBaseline: baselineName groups: groupNames lo baseline := baselineName. groups := groupNames ifNil: [ #( ) ]. - loadPolicy := aLoadPolicy. - ^ self + loadPolicy := aLoadPolicy ] { #category : 'accessing' } diff --git a/src/MCP/MCPLoadBaselineResult.class.st b/src/MCP/MCPLoadBaselineResult.class.st index f21611b..7d4f111 100644 --- a/src/MCP/MCPLoadBaselineResult.class.st +++ b/src/MCP/MCPLoadBaselineResult.class.st @@ -58,8 +58,7 @@ MCPLoadBaselineResult >> initializeRequest: aRequest newPackageNames: packageNam groups := aRequest groups. loadPolicy := aRequest loadPolicy. newPackageNames := packageNames asArray. - repositoryInfos := repositories asArray. - ^ self + repositoryInfos := repositories asArray ] { #category : 'accessing' } diff --git a/src/MCP/MCPLoadRepositoryCommand.class.st b/src/MCP/MCPLoadRepositoryCommand.class.st index 816993b..0183f73 100644 --- a/src/MCP/MCPLoadRepositoryCommand.class.st +++ b/src/MCP/MCPLoadRepositoryCommand.class.st @@ -52,8 +52,7 @@ MCPLoadRepositoryCommand >> execute [ MCPLoadRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPLoadRepositoryRequest.class.st b/src/MCP/MCPLoadRepositoryRequest.class.st index 64a7ccf..75de46d 100644 --- a/src/MCP/MCPLoadRepositoryRequest.class.st +++ b/src/MCP/MCPLoadRepositoryRequest.class.st @@ -150,8 +150,7 @@ MCPLoadRepositoryRequest >> initializeDefaultsFromTool: aTool [ self isLocalLoad ifTrue: [ sourceDirectory ifNil: [ sourceDirectory := aTool defaultSourceDirectory ] ]. - self isIcebergLoad ifTrue: [ self initializeIcebergDefaults ]. - ^ self + self isIcebergLoad ifTrue: [ self initializeIcebergDefaults ] ] { #category : 'initialization' } @@ -173,8 +172,7 @@ MCPLoadRepositoryRequest >> initializeFromRequest: request tool: aTool [ request. self ensureSingleRepositorySource. mode := self requestedMode. - self initializeDefaultsFromTool: aTool. - ^ self + self initializeDefaultsFromTool: aTool ] { #category : 'private - mode' } @@ -182,8 +180,7 @@ MCPLoadRepositoryRequest >> initializeIcebergDefaults [ sourceDirectory ifNil: [ sourceDirectory := self sourceDirectoryFromRepository: - self icebergRepository ]. - ^ self + self icebergRepository ] ] { #category : 'private - mode' } diff --git a/src/MCP/MCPLoadRepositoryResult.class.st b/src/MCP/MCPLoadRepositoryResult.class.st index 9e14258..5107c1f 100644 --- a/src/MCP/MCPLoadRepositoryResult.class.st +++ b/src/MCP/MCPLoadRepositoryResult.class.st @@ -83,8 +83,7 @@ MCPLoadRepositoryResult >> initializeRequest: aRequest repositoryUrl: aRepositor checkoutPath := aRequest checkoutPath. repositoryName := aRequest repositoryName. location := aRequest location. - loadResult := aLoadResult. - ^ self + loadResult := aLoadResult ] { #category : 'accessing' } diff --git a/src/MCP/MCPMessageProcessor.class.st b/src/MCP/MCPMessageProcessor.class.st index b3bf0ec..79d750a 100644 --- a/src/MCP/MCPMessageProcessor.class.st +++ b/src/MCP/MCPMessageProcessor.class.st @@ -14,7 +14,7 @@ Class { { #category : 'handlers management' } MCPMessageProcessor >> addHandler: aJRPCHandler [ - (self handlers includes: aJRPCHandler) ifTrue: [ "handler has been override" + (self handlers includes: aJRPCHandler) ifTrue: [ "handler has been overridden" ^ self ]. handlers add: aJRPCHandler diff --git a/src/MCP/MCPMethodCompileRequest.class.st b/src/MCP/MCPMethodCompileRequest.class.st index 410999f..e3e20fc 100644 --- a/src/MCP/MCPMethodCompileRequest.class.st +++ b/src/MCP/MCPMethodCompileRequest.class.st @@ -55,12 +55,10 @@ MCPMethodCompileRequest >> initializeFromRequest: request tool: aTool [ classSide := request booleanArgumentNamed: 'classSide' default: false. methodSource := (request argumentNamed: 'source' ifAbsent: [ MCPInvalidToolInput - signalMissingRequiredArgumentNamed: - 'source' + signalMissingRequiredArgumentNamed: 'source' forTool: aTool ]) withInternalLineEndings. protocol := request stringArgumentNamed: 'protocol'. - force := request booleanArgumentNamed: 'force' default: false. - ^ self + force := request booleanArgumentNamed: 'force' default: false ] { #category : 'accessing' } diff --git a/src/MCP/MCPMethodReferenceSpec.class.st b/src/MCP/MCPMethodReferenceSpec.class.st index 7bcd1a5..3f1c7f5 100644 --- a/src/MCP/MCPMethodReferenceSpec.class.st +++ b/src/MCP/MCPMethodReferenceSpec.class.st @@ -64,8 +64,7 @@ MCPMethodReferenceSpec >> initializeClassName: aClassName selector: aSelector cl className := aClassName. selector := aSelector. - classSide := aBoolean ifNil: [ false ]. - ^ self + classSide := aBoolean ifNil: [ false ] ] { #category : 'printing' } diff --git a/src/MCP/MCPMethodRewriteChangeInfo.class.st b/src/MCP/MCPMethodRewriteChangeInfo.class.st index aca25d9..42c582d 100644 --- a/src/MCP/MCPMethodRewriteChangeInfo.class.st +++ b/src/MCP/MCPMethodRewriteChangeInfo.class.st @@ -76,17 +76,16 @@ MCPMethodRewriteChangeInfo >> initializeFromChange: aChange includeSources: aBoo ifAbsent: [ nil ]. compiledMethod ifNil: [ - packageName := ''. - protocol := ''. - oldSource := '' ] + packageName := ''. + protocol := ''. + oldSource := '' ] ifNotNil: [ - methodInfo := MCPCompiledMethodInfo fromMethod: compiledMethod. - packageName := methodInfo packageName. - protocol := methodInfo protocol. - oldSource := compiledMethod sourceCode ifNil: [ '' ] ]. + methodInfo := MCPCompiledMethodInfo fromMethod: compiledMethod. + packageName := methodInfo packageName. + protocol := methodInfo protocol. + oldSource := compiledMethod sourceCode ifNil: [ '' ] ]. newSource := aChange source ifNil: [ '' ]. - includeSources := aBoolean. - ^ self + includeSources := aBoolean ] { #category : 'accessing' } diff --git a/src/MCP/MCPMethodRewriteReport.class.st b/src/MCP/MCPMethodRewriteReport.class.st index 880de65..76cf4ed 100644 --- a/src/MCP/MCPMethodRewriteReport.class.st +++ b/src/MCP/MCPMethodRewriteReport.class.st @@ -91,8 +91,7 @@ MCPMethodRewriteReport >> initializeFromRequest: aRequest changeInfos: changeInf changeInfos := changeInfoCollection asArray. appliedCount := appliedCountInteger. scope := aRequest scopeQuery asDictionary. - changeSetHash := changeSetHashInteger. - ^ self + changeSetHash := changeSetHashInteger ] { #category : 'accessing' } diff --git a/src/MCP/MCPMethodRewriteRuleSpec.class.st b/src/MCP/MCPMethodRewriteRuleSpec.class.st index 92ab169..4088622 100644 --- a/src/MCP/MCPMethodRewriteRuleSpec.class.st +++ b/src/MCP/MCPMethodRewriteRuleSpec.class.st @@ -74,8 +74,7 @@ MCPMethodRewriteRuleSpec >> initializeFromDictionary: aDictionary request: reque booleanArgumentNamed: 'isForMethod' in: aDictionary default: false. - self validateAtIndex: index. - ^ self + self validateAtIndex: index ] { #category : 'accessing' } diff --git a/src/MCP/MCPMethodUpdateRequest.class.st b/src/MCP/MCPMethodUpdateRequest.class.st index 163af32..8fb3151 100644 --- a/src/MCP/MCPMethodUpdateRequest.class.st +++ b/src/MCP/MCPMethodUpdateRequest.class.st @@ -200,8 +200,7 @@ MCPMethodUpdateRequest >> initializeFromRequest: request [ selector: selector asSymbol newSelector: (newSelector ifNotNil: [ newSelector asSymbol ]). - force := request booleanArgumentNamed: 'force' default: false. - ^ self + force := request booleanArgumentNamed: 'force' default: false ] { #category : 'private - request' } @@ -384,32 +383,31 @@ MCPMethodUpdateRequest >> updatePropertyNames [ MCPMethodUpdateRequest >> validateAddArgumentsUpdate [ self argumentNames isEmpty ifTrue: [ - MCPCommandError - signalErrorCode: #ArgumentNamesRequiredForAddedArguments - message: - 'argumentNames is required when newSelector adds method arguments.' - details: self requestedContext ]. + MCPCommandError + signalErrorCode: #ArgumentNamesRequiredForAddedArguments + message: + 'argumentNames is required when newSelector adds method arguments.' + details: self requestedContext ]. self argumentNames size = self newSelector asSymbol numArgs ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentNames - message: - 'argumentNames must contain one name for each target selector argument.' - details: self requestedContext ]. - (self argumentNames allSatisfy: [ :each | each isNotEmpty ]) - ifFalse: [ MCPCommandError signalErrorCode: #InvalidMethodArgumentNames - message: 'argumentNames must not contain empty names.' + message: + 'argumentNames must contain one name for each target selector argument.' details: self requestedContext ]. + (self argumentNames allSatisfy: [ :each | each isNotEmpty ]) + ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentNames + message: 'argumentNames must not contain empty names.' + details: self requestedContext ]. (self argumentValueExpressions isNotEmpty and: [ self argumentValueExpressions size ~= self addedArgumentCount ]) ifTrue: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentValueExpressions - message: - 'argumentValueExpressions must contain one expression for each newly added argument.' - details: self requestedContext ]. - ^ self + MCPCommandError + signalErrorCode: #InvalidMethodArgumentValueExpressions + message: + 'argumentValueExpressions must contain one expression for each newly added argument.' + details: self requestedContext ] ] { #category : 'validating' } @@ -417,77 +415,75 @@ MCPMethodUpdateRequest >> validateForUpdate [ | action | self hasPermutation ifTrue: [ - self hasRenameUpdate ifFalse: [ - MCPCommandError - signalErrorCode: #PermutationRequiresMethodSelectorUpdate - message: - 'permutation is only valid when update changes a method selector with newSelector.' - details: self requestedContext ] ]. + self hasRenameUpdate ifFalse: [ + MCPCommandError + signalErrorCode: #PermutationRequiresMethodSelectorUpdate + message: + 'permutation is only valid when update changes a method selector with newSelector.' + details: self requestedContext ] ]. (self hasArgumentNames or: [ self hasArgumentValueExpressions ]) ifTrue: [ - self hasRenameUpdate ifFalse: [ - MCPCommandError - signalErrorCode: #ArgumentMetadataRequiresMethodSelectorUpdate - message: - 'argumentNames and argumentValueExpressions are only valid with newSelector.' - details: self requestedContext ] ]. + self hasRenameUpdate ifFalse: [ + MCPCommandError + signalErrorCode: #ArgumentMetadataRequiresMethodSelectorUpdate + message: + 'argumentNames and argumentValueExpressions are only valid with newSelector.' + details: self requestedContext ] ]. action := self newSelectorUpdateAction. - action = 'addArguments' ifTrue: [ self validateAddArgumentsUpdate ]. - ^ self + action = 'addArguments' ifTrue: [ self validateAddArgumentsUpdate ] ] { #category : 'private - request' } -MCPMethodUpdateRequest >> validatePermutation: requestedPermutation fromSelector: oldSelector toSelector: newSelector [ +MCPMethodUpdateRequest >> validatePermutation: requestedPermutation fromSelector: oldSelector toSelector: targetSelector [ | newArgumentCount oldArgumentCount positiveIndexes | oldArgumentCount := oldSelector numArgs. - newArgumentCount := newSelector numArgs. + newArgumentCount := targetSelector numArgs. requestedPermutation size = newArgumentCount ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'permutation must contain one entry for each target selector argument.' - details: self requestedContext ]. - (requestedPermutation allSatisfy: [ :each | each isInteger ]) - ifFalse: [ MCPCommandError signalErrorCode: #InvalidMethodArgumentPermutation - message: 'permutation entries must be integers.' + message: + 'permutation must contain one entry for each target selector argument.' details: self requestedContext ]. + (requestedPermutation allSatisfy: [ :each | each isInteger ]) + ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: 'permutation entries must be integers.' + details: self requestedContext ]. positiveIndexes := requestedPermutation select: [ :each | each > 0 ]. (positiveIndexes allSatisfy: [ :each | each between: 1 and: oldArgumentCount ]) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'positive permutation entries must reference existing arguments by 1-based index.' - details: self requestedContext ]. + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'positive permutation entries must reference existing arguments by 1-based index.' + details: self requestedContext ]. positiveIndexes asSet size = positiveIndexes size ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'permutation must not reference the same old argument twice.' - details: self requestedContext ]. + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'permutation must not reference the same old argument twice.' + details: self requestedContext ]. newArgumentCount >= oldArgumentCount ifTrue: [ - positiveIndexes size = oldArgumentCount ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'adding arguments requires every old argument to appear exactly once in permutation.' - details: self requestedContext ] ] + positiveIndexes size = oldArgumentCount ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'adding arguments requires every old argument to appear exactly once in permutation.' + details: self requestedContext ] ] ifFalse: [ - positiveIndexes size = newArgumentCount ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'removing arguments requires permutation to contain only kept old argument indexes.' - details: self requestedContext ]. - (requestedPermutation allSatisfy: [ :each | each > 0 ]) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'removing arguments does not accept negative permutation entries.' - details: self requestedContext ] ]. - ^ self + positiveIndexes size = newArgumentCount ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'removing arguments requires permutation to contain only kept old argument indexes.' + details: self requestedContext ]. + (requestedPermutation allSatisfy: [ :each | each > 0 ]) ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'removing arguments does not accept negative permutation entries.' + details: self requestedContext ] ] ] diff --git a/src/MCP/MCPPackageInfo.class.st b/src/MCP/MCPPackageInfo.class.st index beff83c..927bc31 100644 --- a/src/MCP/MCPPackageInfo.class.st +++ b/src/MCP/MCPPackageInfo.class.st @@ -72,8 +72,7 @@ MCPPackageInfo >> initializeFromPackage: aPackage projectNames: someProjectNames as: Array) sort. definedClassCount := aPackage definedClasses size. extensionMethodCount := aPackage extensionMethods size. - isUndefined := aPackage isUndefined. - ^ self + isUndefined := aPackage isUndefined ] { #category : 'accessing' } diff --git a/src/MCP/MCPPullRepositoryCommand.class.st b/src/MCP/MCPPullRepositoryCommand.class.st index e0e010d..1c32786 100644 --- a/src/MCP/MCPPullRepositoryCommand.class.st +++ b/src/MCP/MCPPullRepositoryCommand.class.st @@ -49,8 +49,7 @@ MCPPullRepositoryCommand >> execute [ MCPPullRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPPushRepositoryCommand.class.st b/src/MCP/MCPPushRepositoryCommand.class.st index f1ef918..afbafc9 100644 --- a/src/MCP/MCPPushRepositoryCommand.class.st +++ b/src/MCP/MCPPushRepositoryCommand.class.st @@ -46,8 +46,7 @@ MCPPushRepositoryCommand >> execute [ MCPPushRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPRefactoringScopeSpec.class.st b/src/MCP/MCPRefactoringScopeSpec.class.st index 0d46b60..89a5354 100644 --- a/src/MCP/MCPRefactoringScopeSpec.class.st +++ b/src/MCP/MCPRefactoringScopeSpec.class.st @@ -49,8 +49,7 @@ MCPRefactoringScopeSpec >> initializePackageNames: packageNamesCollection classN packageNames := packageNamesCollection ifNil: [ #( ) ]. classNames := classNamesCollection ifNil: [ #( ) ]. - hierarchyClassNames := hierarchyClassNamesCollection ifNil: [ #( ) ]. - ^ self + hierarchyClassNames := hierarchyClassNamesCollection ifNil: [ #( ) ] ] { #category : 'testing' } diff --git a/src/MCP/MCPRemoveClassesRequest.class.st b/src/MCP/MCPRemoveClassesRequest.class.st index d4372ee..af3eb77 100644 --- a/src/MCP/MCPRemoveClassesRequest.class.st +++ b/src/MCP/MCPRemoveClassesRequest.class.st @@ -37,6 +37,5 @@ MCPRemoveClassesRequest >> force [ MCPRemoveClassesRequest >> initializeClassNames: aCollection force: aBoolean [ classNames := aCollection. - force := aBoolean. - ^ self + force := aBoolean ] diff --git a/src/MCP/MCPRemoveMethodsCommand.class.st b/src/MCP/MCPRemoveMethodsCommand.class.st index bf4663c..f1f1386 100644 --- a/src/MCP/MCPRemoveMethodsCommand.class.st +++ b/src/MCP/MCPRemoveMethodsCommand.class.st @@ -47,8 +47,7 @@ MCPRemoveMethodsCommand >> execute [ MCPRemoveMethodsCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPRemoveMethodsRequest.class.st b/src/MCP/MCPRemoveMethodsRequest.class.st index b0e2e56..a87cae6 100644 --- a/src/MCP/MCPRemoveMethodsRequest.class.st +++ b/src/MCP/MCPRemoveMethodsRequest.class.st @@ -41,8 +41,7 @@ MCPRemoveMethodsRequest >> initializeClassName: aClassName classSide: aBoolean s className := aClassName. classSide := aBoolean. - selectors := aCollection. - ^ self + selectors := aCollection ] { #category : 'accessing' } diff --git a/src/MCP/MCPRemoveMethodsResult.class.st b/src/MCP/MCPRemoveMethodsResult.class.st index beb26e1..3a0d349 100644 --- a/src/MCP/MCPRemoveMethodsResult.class.st +++ b/src/MCP/MCPRemoveMethodsResult.class.st @@ -50,8 +50,7 @@ MCPRemoveMethodsResult >> initializeFromRequest: aRequest removedMethods: method classSide := aRequest classSide. selectors := aRequest selectors asArray. removedMethods := methodCollection asArray. - warningMessages := warningCollection asArray. - ^ self + warningMessages := warningCollection asArray ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryAdoptHeadRequest.class.st b/src/MCP/MCPRepositoryAdoptHeadRequest.class.st index 350ed59..f9e2c83 100644 --- a/src/MCP/MCPRepositoryAdoptHeadRequest.class.st +++ b/src/MCP/MCPRepositoryAdoptHeadRequest.class.st @@ -36,8 +36,7 @@ MCPRepositoryAdoptHeadRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: request. - branchName := request stringArgumentNamed: 'branchName'. - ^ self + branchName := request stringArgumentNamed: 'branchName' ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryAdoptHeadResult.class.st b/src/MCP/MCPRepositoryAdoptHeadResult.class.st index 98bda0d..cdd8bfe 100644 --- a/src/MCP/MCPRepositoryAdoptHeadResult.class.st +++ b/src/MCP/MCPRepositoryAdoptHeadResult.class.st @@ -98,8 +98,7 @@ MCPRepositoryAdoptHeadResult >> initializeRepositoryBefore: beforeInfo after: aR adoptedCommitId := self commitIdFrom: headCommit. didAdopt := aBoolean. branchName := repositoryInfoAfter branchName. - headDescription := repositoryInfoAfter headDescription. - ^ self + headDescription := repositoryInfoAfter headDescription ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryBranchResult.class.st b/src/MCP/MCPRepositoryBranchResult.class.st index 34404c7..731dcdf 100644 --- a/src/MCP/MCPRepositoryBranchResult.class.st +++ b/src/MCP/MCPRepositoryBranchResult.class.st @@ -62,8 +62,7 @@ MCPRepositoryBranchResult >> initializeRepositoryBefore: beforeInfo after: aRepo previousBranchName := beforeInfo branchName. branchName := afterInfo branchName. previousHeadDescription := beforeInfo headDescription. - headDescription := afterInfo headDescription. - ^ self + headDescription := afterInfo headDescription ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryCommitRequest.class.st b/src/MCP/MCPRepositoryCommitRequest.class.st index 7d523e3..0513995 100644 --- a/src/MCP/MCPRepositoryCommitRequest.class.st +++ b/src/MCP/MCPRepositoryCommitRequest.class.st @@ -30,8 +30,7 @@ MCPRepositoryCommitRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: request. - message := request stringArgumentNamed: 'message'. - ^ self + message := request stringArgumentNamed: 'message' ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryCommitResult.class.st b/src/MCP/MCPRepositoryCommitResult.class.st index 44ade46..12635ed 100644 --- a/src/MCP/MCPRepositoryCommitResult.class.st +++ b/src/MCP/MCPRepositoryCommitResult.class.st @@ -108,9 +108,9 @@ MCPRepositoryCommitResult >> headDescription: aString [ MCPRepositoryCommitResult >> initializeRepository: aRepository changedPackageNames: packageNames commit: aCommit [ | packages repositoryPackageNames | - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages asArray sort: [ + :left + :right | left name asString <= right name asString ]. packageInfos := packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ]. repositoryPackageNames := (packages collect: [ :each | @@ -125,8 +125,7 @@ MCPRepositoryCommitResult >> initializeRepository: aRepository changedPackageNam packageNames: repositoryPackageNames modifiedPackageNames: modifiedPackageNames headCommitId: commitId - headDescription: headDescription. - ^ self + headDescription: headDescription ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryCreateBranchRequest.class.st b/src/MCP/MCPRepositoryCreateBranchRequest.class.st index 29632f8..fc97757 100644 --- a/src/MCP/MCPRepositoryCreateBranchRequest.class.st +++ b/src/MCP/MCPRepositoryCreateBranchRequest.class.st @@ -36,8 +36,7 @@ MCPRepositoryCreateBranchRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: request. - branchName := request stringArgumentNamed: 'branchName'. - ^ self + branchName := request stringArgumentNamed: 'branchName' ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryCreateRequest.class.st b/src/MCP/MCPRepositoryCreateRequest.class.st index a3caac6..f1e688e 100644 --- a/src/MCP/MCPRepositoryCreateRequest.class.st +++ b/src/MCP/MCPRepositoryCreateRequest.class.st @@ -35,8 +35,7 @@ MCPRepositoryCreateRequest >> initializeFromRequest: request [ name := request stringArgumentNamed: 'name'. location := request stringArgumentNamed: 'location'. subdirectory := request stringArgumentNamed: 'subdirectory'. - packageNames := request stringCollectionArgumentNamed: 'packageNames'. - ^ self + packageNames := request stringCollectionArgumentNamed: 'packageNames' ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryCreateResult.class.st b/src/MCP/MCPRepositoryCreateResult.class.st index 7742643..195ad64 100644 --- a/src/MCP/MCPRepositoryCreateResult.class.st +++ b/src/MCP/MCPRepositoryCreateResult.class.st @@ -30,12 +30,11 @@ MCPRepositoryCreateResult >> initializeFromRepository: aRepository [ | packages | repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages asArray sort: [ + :left + :right | left name asString <= right name asString ]. packageInfos := packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ]. - ^ self + MCPRepositoryPackageInfo fromPackage: each ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryDiffRequest.class.st b/src/MCP/MCPRepositoryDiffRequest.class.st index b456fd7..b147af0 100644 --- a/src/MCP/MCPRepositoryDiffRequest.class.st +++ b/src/MCP/MCPRepositoryDiffRequest.class.st @@ -28,8 +28,7 @@ MCPRepositoryDiffRequest >> commandForTool: aTool [ MCPRepositoryDiffRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - ^ self + request ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryDiffResult.class.st b/src/MCP/MCPRepositoryDiffResult.class.st index 7cc95e2..db00372 100644 --- a/src/MCP/MCPRepositoryDiffResult.class.st +++ b/src/MCP/MCPRepositoryDiffResult.class.st @@ -78,16 +78,15 @@ MCPRepositoryDiffResult >> initializeRepository: aRepository changedPackageNames | packages | repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages asArray sort: [ + :left + :right | left name asString <= right name asString ]. packageInfos := packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ]. changedPackageNames := packageNames ifNil: [ #( ) ]. modifiedPaths := paths ifNil: [ #( ) ]. isEmpty := aBoolean. - changeCount := self derivedChangeCount. - ^ self + changeCount := self derivedChangeCount ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryExportRequest.class.st b/src/MCP/MCPRepositoryExportRequest.class.st index 7bf0470..a5524e2 100644 --- a/src/MCP/MCPRepositoryExportRequest.class.st +++ b/src/MCP/MCPRepositoryExportRequest.class.st @@ -28,8 +28,7 @@ MCPRepositoryExportRequest >> commandForTool: aTool [ MCPRepositoryExportRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - ^ self + request ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryExportResult.class.st b/src/MCP/MCPRepositoryExportResult.class.st index 55cbd6c..f639c70 100644 --- a/src/MCP/MCPRepositoryExportResult.class.st +++ b/src/MCP/MCPRepositoryExportResult.class.st @@ -70,16 +70,15 @@ MCPRepositoryExportResult >> initializeRepository: aRepository changedPackageNam | packages | repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages asArray sort: [ + :left + :right | left name asString <= right name asString ]. packageInfos := packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ]. changedPackageNames := packageNames ifNil: [ #( ) ]. modifiedPaths := paths ifNil: [ #( ) ]. didChange := changedPackageNames notEmpty or: [ - modifiedPaths notEmpty ]. - ^ self + modifiedPaths notEmpty ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryFetchRequest.class.st b/src/MCP/MCPRepositoryFetchRequest.class.st index 1401d43..f24e1c0 100644 --- a/src/MCP/MCPRepositoryFetchRequest.class.st +++ b/src/MCP/MCPRepositoryFetchRequest.class.st @@ -28,8 +28,7 @@ MCPRepositoryFetchRequest >> commandForTool: aTool [ MCPRepositoryFetchRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - ^ self + request ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryFetchResult.class.st b/src/MCP/MCPRepositoryFetchResult.class.st index fd16a80..7da5dc1 100644 --- a/src/MCP/MCPRepositoryFetchResult.class.st +++ b/src/MCP/MCPRepositoryFetchResult.class.st @@ -54,8 +54,7 @@ MCPRepositoryFetchResult >> initializeRepositoryBefore: beforeInfo after: aRepos packageInfos := self packageInfosFromRepository: aRepository. remoteNames := repositoryInfoAfter remoteNames. branchName := repositoryInfoAfter branchName. - headDescription := repositoryInfoAfter headDescription. - ^ self + headDescription := repositoryInfoAfter headDescription ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryPullRequest.class.st b/src/MCP/MCPRepositoryPullRequest.class.st index 87afd70..59b80f1 100644 --- a/src/MCP/MCPRepositoryPullRequest.class.st +++ b/src/MCP/MCPRepositoryPullRequest.class.st @@ -28,8 +28,7 @@ MCPRepositoryPullRequest >> commandForTool: aTool [ MCPRepositoryPullRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - ^ self + request ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryPullResult.class.st b/src/MCP/MCPRepositoryPullResult.class.st index 75aa60c..6425476 100644 --- a/src/MCP/MCPRepositoryPullResult.class.st +++ b/src/MCP/MCPRepositoryPullResult.class.st @@ -56,8 +56,7 @@ MCPRepositoryPullResult >> initializeRepositoryBefore: beforeInfo after: aReposi packageInfos := self packageInfosFromRepository: aRepository. branchName := repositoryInfoAfter branchName. headDescription := repositoryInfoAfter headDescription. - modifiedPackageNames := repositoryInfoAfter modifiedPackageNames. - ^ self + modifiedPackageNames := repositoryInfoAfter modifiedPackageNames ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryPushRequest.class.st b/src/MCP/MCPRepositoryPushRequest.class.st index de4a82e..69d1f4e 100644 --- a/src/MCP/MCPRepositoryPushRequest.class.st +++ b/src/MCP/MCPRepositoryPushRequest.class.st @@ -28,8 +28,7 @@ MCPRepositoryPushRequest >> commandForTool: aTool [ MCPRepositoryPushRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - ^ self + request ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryPushResult.class.st b/src/MCP/MCPRepositoryPushResult.class.st index 2591400..39e6743 100644 --- a/src/MCP/MCPRepositoryPushResult.class.st +++ b/src/MCP/MCPRepositoryPushResult.class.st @@ -52,8 +52,7 @@ MCPRepositoryPushResult >> initializeRepository: aRepository [ packageInfos := self packageInfosFromRepository: aRepository. remoteNames := repositoryInfo remoteNames. branchName := repositoryInfo branchName. - headDescription := repositoryInfo headDescription. - ^ self + headDescription := repositoryInfo headDescription ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryReferenceSpec.class.st b/src/MCP/MCPRepositoryReferenceSpec.class.st index e34e3e8..c1874bb 100644 --- a/src/MCP/MCPRepositoryReferenceSpec.class.st +++ b/src/MCP/MCPRepositoryReferenceSpec.class.st @@ -55,8 +55,7 @@ MCPRepositoryReferenceSpec >> hasName [ MCPRepositoryReferenceSpec >> initializeName: aName location: aLocation [ name := aName. - location := aLocation. - ^ self + location := aLocation ] { #category : 'testing' } diff --git a/src/MCP/MCPRepositorySwitchBranchRequest.class.st b/src/MCP/MCPRepositorySwitchBranchRequest.class.st index 6623f02..0397c16 100644 --- a/src/MCP/MCPRepositorySwitchBranchRequest.class.st +++ b/src/MCP/MCPRepositorySwitchBranchRequest.class.st @@ -36,8 +36,7 @@ MCPRepositorySwitchBranchRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: request. - branchName := request stringArgumentNamed: 'branchName'. - ^ self + branchName := request stringArgumentNamed: 'branchName' ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryUpdateRequest.class.st b/src/MCP/MCPRepositoryUpdateRequest.class.st index 1f3ee75..1850371 100644 --- a/src/MCP/MCPRepositoryUpdateRequest.class.st +++ b/src/MCP/MCPRepositoryUpdateRequest.class.st @@ -72,8 +72,7 @@ MCPRepositoryUpdateRequest >> initializeFromRequest: request [ addPackageNames := request stringCollectionArgumentNamed: 'addPackageNames'. removePackageNames := request stringCollectionArgumentNamed: - 'removePackageNames'. - ^ self + 'removePackageNames' ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryUpdateResult.class.st b/src/MCP/MCPRepositoryUpdateResult.class.st index 3b5b26a..d54c68d 100644 --- a/src/MCP/MCPRepositoryUpdateResult.class.st +++ b/src/MCP/MCPRepositoryUpdateResult.class.st @@ -57,15 +57,14 @@ MCPRepositoryUpdateResult >> initializeRepository: aRepository updateActions: ac | packages | repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages asArray sort: [ + :left + :right | left name asString <= right name asString ]. packageInfos := packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ]. updateActions := actionNames ifNil: [ #( ) ]. addedPackageNames := addedNames ifNil: [ #( ) ]. - removedPackageNames := removedNames ifNil: [ #( ) ]. - ^ self + removedPackageNames := removedNames ifNil: [ #( ) ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st index 4dddf75..e1a71c7 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st @@ -172,8 +172,7 @@ MCPRepositoryVerifyIdentityCommand >> execute [ MCPRepositoryVerifyIdentityCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'private - resolving' } diff --git a/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st b/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st index 054b018..d8374d1 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st @@ -82,21 +82,24 @@ MCPRepositoryVerifyIdentityRequest >> initializeFromRequest: request [ branchName := request stringArgumentNamed: 'branchName'. hasSubdirectory := request hasArgumentNamed: 'subdirectory'. hasPackageNames := request hasArgumentNamed: 'packageNames'. - hasModifiedPackageNames := request hasArgumentNamed: 'modifiedPackageNames'. + hasModifiedPackageNames := request hasArgumentNamed: + 'modifiedPackageNames'. hasIsModified := request hasArgumentNamed: 'isModified'. hasSubdirectory ifTrue: [ - subdirectory := self - stringArgumentNamed: 'subdirectory' - preservingEmptyFrom: request ]. + subdirectory := self + stringArgumentNamed: 'subdirectory' + preservingEmptyFrom: request ]. hasPackageNames ifTrue: [ - packageNames := request uniqueStringCollectionArgumentNamed: - 'packageNames' ]. + packageNames := request uniqueStringCollectionArgumentNamed: + 'packageNames' ]. hasModifiedPackageNames ifTrue: [ - modifiedPackageNames := request uniqueStringCollectionArgumentNamed: - 'modifiedPackageNames' ]. + modifiedPackageNames := request + uniqueStringCollectionArgumentNamed: + 'modifiedPackageNames' ]. hasIsModified ifTrue: [ - isModified := request booleanArgumentNamed: 'isModified' default: false ]. - ^ self + isModified := request + booleanArgumentNamed: 'isModified' + default: false ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryVerifyIdentityResult.class.st b/src/MCP/MCPRepositoryVerifyIdentityResult.class.st index f56587b..7796a43 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityResult.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityResult.class.st @@ -41,8 +41,7 @@ MCPRepositoryVerifyIdentityResult >> initializeRepository: aRepository checkedFi repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. packageInfos := self packageInfosFromRepository: aRepository. checkedFields := fieldNames ifNil: [ #( ) ]. - matched := true. - ^ self + matched := true ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryWorkingCopyCommand.class.st b/src/MCP/MCPRepositoryWorkingCopyCommand.class.st index 442dde1..fd2a8b2 100644 --- a/src/MCP/MCPRepositoryWorkingCopyCommand.class.st +++ b/src/MCP/MCPRepositoryWorkingCopyCommand.class.st @@ -53,8 +53,7 @@ MCPRepositoryWorkingCopyCommand >> changedPackageNamesFromDiff: aDiff [ MCPRepositoryWorkingCopyCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'private - diff' } diff --git a/src/MCP/MCPRewriteMethodsCommand.class.st b/src/MCP/MCPRewriteMethodsCommand.class.st index 37d6c34..83d5e49 100644 --- a/src/MCP/MCPRewriteMethodsCommand.class.st +++ b/src/MCP/MCPRewriteMethodsCommand.class.st @@ -115,8 +115,7 @@ MCPRewriteMethodsCommand >> hashForChange: aChange [ MCPRewriteMethodsCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'private - rewriting' } diff --git a/src/MCP/MCPRunTestsCommand.class.st b/src/MCP/MCPRunTestsCommand.class.st index b9aa8bc..fa0ca98 100644 --- a/src/MCP/MCPRunTestsCommand.class.st +++ b/src/MCP/MCPRunTestsCommand.class.st @@ -108,8 +108,7 @@ MCPRunTestsCommand >> hasTimedOutAt: deadline [ MCPRunTestsCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'private - timeout' } diff --git a/src/MCP/MCPRunTestsRequest.class.st b/src/MCP/MCPRunTestsRequest.class.st index b4c3805..cbbd3eb 100644 --- a/src/MCP/MCPRunTestsRequest.class.st +++ b/src/MCP/MCPRunTestsRequest.class.st @@ -90,8 +90,7 @@ MCPRunTestsRequest >> initializeTestRequests: aCollection timeoutMilliseconds: a testRequests := aCollection. timeoutMilliseconds := anInteger. operation := operationString ifNil: [ 'run' ]. - coverageRequest := aCoverageRequest. - ^ self + coverageRequest := aCoverageRequest ] { #category : 'testing' } diff --git a/src/MCP/MCPRunTestsResult.class.st b/src/MCP/MCPRunTestsResult.class.st index 74080a8..c70d405 100644 --- a/src/MCP/MCPRunTestsResult.class.st +++ b/src/MCP/MCPRunTestsResult.class.st @@ -57,8 +57,7 @@ MCPRunTestsResult >> initializeResults: resultCollection timedOut: aBoolean unru results := resultCollection asArray. timedOut := aBoolean. - unrunTests := testCollection asArray. - ^ self + unrunTests := testCollection asArray ] { #category : 'converting' } diff --git a/src/MCP/MCPScreenshotCommand.class.st b/src/MCP/MCPScreenshotCommand.class.st index 4c95335..a6f41dc 100644 --- a/src/MCP/MCPScreenshotCommand.class.st +++ b/src/MCP/MCPScreenshotCommand.class.st @@ -74,8 +74,7 @@ MCPScreenshotCommand >> initializeTool: aTool request: aRequest formProvider: aB tool := aTool. request := aRequest. - formProvider := aBlock ifNil: [ [ self captureWorldForm ] ]. - ^ self + formProvider := aBlock ifNil: [ [ self captureWorldForm ] ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPScreenshotRequest.class.st b/src/MCP/MCPScreenshotRequest.class.st index e0a3968..47ee0df 100644 --- a/src/MCP/MCPScreenshotRequest.class.st +++ b/src/MCP/MCPScreenshotRequest.class.st @@ -29,8 +29,7 @@ MCPScreenshotRequest class >> fromRequest: aRequest tool: aTool [ MCPScreenshotRequest >> initializeTarget: targetString targetIdentifier: identifierString [ target := targetString ifNil: [ 'world' ]. - targetIdentifier := identifierString. - ^ self + targetIdentifier := identifierString ] { #category : 'testing' } diff --git a/src/MCP/MCPScreenshotResult.class.st b/src/MCP/MCPScreenshotResult.class.st index b8122fa..3464fda 100644 --- a/src/MCP/MCPScreenshotResult.class.st +++ b/src/MCP/MCPScreenshotResult.class.st @@ -55,8 +55,7 @@ MCPScreenshotResult >> initializeTarget: targetString width: widthInteger height target := targetString. width := widthInteger. height := heightInteger. - imageContent := anImageContent. - ^ self + imageContent := anImageContent ] { #category : 'accessing' } diff --git a/src/MCP/MCPSwitchRepositoryBranchCommand.class.st b/src/MCP/MCPSwitchRepositoryBranchCommand.class.st index 298c048..afa3cd5 100644 --- a/src/MCP/MCPSwitchRepositoryBranchCommand.class.st +++ b/src/MCP/MCPSwitchRepositoryBranchCommand.class.st @@ -50,8 +50,7 @@ MCPSwitchRepositoryBranchCommand >> execute [ MCPSwitchRepositoryBranchCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'accessing' } diff --git a/src/MCP/MCPTestCoverageRequest.class.st b/src/MCP/MCPTestCoverageRequest.class.st index c533f8f..41d6576 100644 --- a/src/MCP/MCPTestCoverageRequest.class.st +++ b/src/MCP/MCPTestCoverageRequest.class.st @@ -119,9 +119,8 @@ MCPTestCoverageRequest >> includeCoveredMethods [ MCPTestCoverageRequest >> initializeScopeQuery: aScopeQuery includeCoveredMethods: aBoolean methodLimit: anInteger [ scopeQuery := aScopeQuery. - includeCoveredMethods := aBoolean = true. - methodLimit := anInteger. - ^ self + includeCoveredMethods := aBoolean == true. + methodLimit := anInteger ] { #category : 'accessing' } diff --git a/src/MCP/MCPTestCoverageResult.class.st b/src/MCP/MCPTestCoverageResult.class.st index 7543fa1..dc3cbf1 100644 --- a/src/MCP/MCPTestCoverageResult.class.st +++ b/src/MCP/MCPTestCoverageResult.class.st @@ -109,8 +109,7 @@ MCPTestCoverageResult >> initializeCoverageResult: aCoverageResult includeCovere coverageResult := aCoverageResult. includeCoveredMethods := aBoolean = true. methodLimit := anInteger. - partiallyCoveredMethods := partialMethods ifNil: [ #( ) ]. - ^ self + partiallyCoveredMethods := partialMethods ifNil: [ #( ) ] ] { #category : 'private - methods' } diff --git a/src/MCP/MCPTestRunInfo.class.st b/src/MCP/MCPTestRunInfo.class.st index 669844e..305c4b4 100644 --- a/src/MCP/MCPTestRunInfo.class.st +++ b/src/MCP/MCPTestRunInfo.class.st @@ -80,8 +80,7 @@ MCPTestRunInfo >> initializeValidatedRequest: validatedRequest selectedTestCount skippedCount := aResult skippedCount. failureCount := aResult failureCount. errorCount := aResult errorCount. - issues := issueCollection ifNil: [ #( ) ]. - ^ self + issues := issueCollection ifNil: [ #( ) ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPTestRunRequest.class.st b/src/MCP/MCPTestRunRequest.class.st index 0c80fba..8df8174 100644 --- a/src/MCP/MCPTestRunRequest.class.st +++ b/src/MCP/MCPTestRunRequest.class.st @@ -72,8 +72,7 @@ MCPTestRunRequest >> hasTestMethod [ MCPTestRunRequest >> initializeClassName: aClassName testMethodName: aTestMethodName [ className := aClassName. - testMethodName := aTestMethodName. - ^ self + testMethodName := aTestMethodName ] { #category : 'printing' } diff --git a/src/MCP/MCPTestRunResult.class.st b/src/MCP/MCPTestRunResult.class.st index e631078..d01f0b1 100644 --- a/src/MCP/MCPTestRunResult.class.st +++ b/src/MCP/MCPTestRunResult.class.st @@ -48,8 +48,7 @@ MCPTestRunResult >> initializeResultInfo: resultInfoOrNil timedOut: aBoolean unr resultInfo := resultInfoOrNil. timedOut := aBoolean. - unrunTestRequests := testRequests ifNil: [ #( ) ]. - ^ self + unrunTestRequests := testRequests ifNil: [ #( ) ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPToolRequest.class.st b/src/MCP/MCPToolRequest.class.st index 298cd3c..6fcda85 100644 --- a/src/MCP/MCPToolRequest.class.st +++ b/src/MCP/MCPToolRequest.class.st @@ -265,8 +265,7 @@ MCPToolRequest >> validate [ schema: self tool inputSchema. violations ifNotEmpty: [ MCPInvalidToolInput signalForTool: self tool violations: violations ]. - self tool validateRequest: self. - ^ self + self tool validateRequest: self ] { #category : 'private - accessing' } diff --git a/src/MCP/MCPUpdateClassCommand.class.st b/src/MCP/MCPUpdateClassCommand.class.st index 8c5fa01..6397a3e 100644 --- a/src/MCP/MCPUpdateClassCommand.class.st +++ b/src/MCP/MCPUpdateClassCommand.class.st @@ -523,8 +523,7 @@ MCPUpdateClassCommand >> executeSetCommentWithPlan: plan [ MCPUpdateClassCommand >> initializeTool: aTool request: aClassRequest [ tool := aTool. - classRequest := aClassRequest. - ^ self + classRequest := aClassRequest ] { #category : 'private - move' } diff --git a/src/MCP/MCPUpdateDebugMethodRequest.class.st b/src/MCP/MCPUpdateDebugMethodRequest.class.st index e4da64a..14193bc 100644 --- a/src/MCP/MCPUpdateDebugMethodRequest.class.st +++ b/src/MCP/MCPUpdateDebugMethodRequest.class.st @@ -62,8 +62,7 @@ MCPUpdateDebugMethodRequest >> ignoreCritiques [ { #category : 'accessing' } MCPUpdateDebugMethodRequest >> ignoreCritiques: aBoolean [ - ignoreCritiques := aBoolean. - ^ self + ignoreCritiques := aBoolean ] { #category : 'accessing' } diff --git a/src/MCP/MCPUpdateMethodCommand.class.st b/src/MCP/MCPUpdateMethodCommand.class.st index dbc13bb..8c4239f 100644 --- a/src/MCP/MCPUpdateMethodCommand.class.st +++ b/src/MCP/MCPUpdateMethodCommand.class.st @@ -341,8 +341,7 @@ MCPUpdateMethodCommand >> executeRenameWithPlan: plan [ MCPUpdateMethodCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest. - ^ self + request := aRequest ] { #category : 'private - methods' } diff --git a/src/MCP/MCPUpdateRepositoryCommand.class.st b/src/MCP/MCPUpdateRepositoryCommand.class.st index 33586bc..ae548c7 100644 --- a/src/MCP/MCPUpdateRepositoryCommand.class.st +++ b/src/MCP/MCPUpdateRepositoryCommand.class.st @@ -89,8 +89,7 @@ MCPUpdateRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. request := aRequest. addedPackageNames := OrderedCollection new. - removedPackageNames := OrderedCollection new. - ^ self + removedPackageNames := OrderedCollection new ] { #category : 'private' } diff --git a/src/MCP/MCPValidatedTestRunRequest.class.st b/src/MCP/MCPValidatedTestRunRequest.class.st index d4f600e..6bbc568 100644 --- a/src/MCP/MCPValidatedTestRunRequest.class.st +++ b/src/MCP/MCPValidatedTestRunRequest.class.st @@ -49,8 +49,7 @@ MCPValidatedTestRunRequest >> hasTestMethod [ MCPValidatedTestRunRequest >> initializeRequest: aTestRunRequest testClass: aTestClass [ testRunRequest := aTestRunRequest. - testClass := aTestClass. - ^ self + testClass := aTestClass ] { #category : 'accessing' } From e814c1e93b1b2483a86b75a686339a3b758a0ac0 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Wed, 24 Jun 2026 14:18:36 +0200 Subject: [PATCH 02/21] Start simplifying Repository results Co-authored-by: Codex --- src/MCP/MCPClassDescriptionInfo.class.st | 27 ++++++++------- src/MCP/MCPClassInfo.class.st | 34 +++++++------------ src/MCP/MCPRepositoryAdoptHeadResult.class.st | 5 ++- src/MCP/MCPRepositoryBranchResult.class.st | 5 ++- src/MCP/MCPRepositoryCommitResult.class.st | 8 ++--- src/MCP/MCPRepositoryCreateResult.class.st | 5 ++- src/MCP/MCPRepositoryDiffResult.class.st | 5 ++- src/MCP/MCPRepositoryExportResult.class.st | 5 ++- src/MCP/MCPRepositoryFetchResult.class.st | 5 ++- src/MCP/MCPRepositoryPullResult.class.st | 5 ++- src/MCP/MCPRepositoryPushResult.class.st | 5 ++- src/MCP/MCPRepositoryUpdateResult.class.st | 5 ++- ...MCPRepositoryVerifyIdentityResult.class.st | 5 ++- 13 files changed, 50 insertions(+), 69 deletions(-) diff --git a/src/MCP/MCPClassDescriptionInfo.class.st b/src/MCP/MCPClassDescriptionInfo.class.st index db480ab..ecdb945 100644 --- a/src/MCP/MCPClassDescriptionInfo.class.st +++ b/src/MCP/MCPClassDescriptionInfo.class.st @@ -73,22 +73,23 @@ MCPClassDescriptionInfo >> initializeFromClass: aClass [ ifNil: [ '' ] ifNotNil: [ :aSuperclass | aSuperclass name asString ]. - packageName := aClass packageName asString. + packageName := aClass package + ifNil: [ '' ] + ifNotNil: [ :aPackage | aPackage name asString ]. tag := aClass packageTagName asString. - instanceSlotNames := (aClass slots collect: [ :each | - each name asString ]) asArray. - classSlotNames := (aClass classSide slots collect: [ :each | - each name asString ]) asArray. - traitNames := (aClass traits collect: [ :each | each name asString ]) - asArray. - classTraitNames := (aClass classSide traits collect: [ :each | - each name asString ]) asArray. + instanceSlotNames := aClass slots collect: [ :each | + each name asString ]. + classSlotNames := aClass classSide slots collect: [ :each | + each name asString ]. + traitNames := aClass traits collect: [ :each | each name asString ]. + classTraitNames := aClass classSide traits collect: [ :each | + each name asString ]. traitComposition := aClass traitCompositionString. classTraitComposition := aClass classSide traitCompositionString. - sharedPoolNames := (aClass sharedPools collect: [ :each | - each name asString ]) asArray. - sharedVariableNames := (aClass classVarNames collect: [ :each | - each asString ]) asArray. + sharedVariableNames := aClass classVarNames collect: [ :each | + each asString ]. + sharedPoolNames := aClass sharedPools collect: [ :each | + each name asString ]. layoutClassName := aClass classLayout class name asString. instanceMethodCount := aClass selectors size. classMethodCount := aClass classSide selectors size diff --git a/src/MCP/MCPClassInfo.class.st b/src/MCP/MCPClassInfo.class.st index 0e431f3..7d6697d 100644 --- a/src/MCP/MCPClassInfo.class.st +++ b/src/MCP/MCPClassInfo.class.st @@ -90,28 +90,20 @@ MCPClassInfo >> initializeFromClass: aClass [ ifNil: [ '' ] ifNotNil: [ :aPackage | aPackage name asString ]. tag := aClass packageTagName asString. - instanceSlotNames := aClass slots - collect: [ :each | each name asString ] - as: Array. - classSlotNames := aClass classSide slots - collect: [ :each | each name asString ] - as: Array. - traitNames := aClass traits - collect: [ :each | each name asString ] - as: Array. - classTraitNames := aClass classSide traits - collect: [ :each | each name asString ] - as: Array. - sharedVariableNames := aClass classVarNames - collect: [ :each | each asString ] - as: Array. - sharedPoolNames := aClass sharedPools - collect: [ :each | each name asString ] - as: Array. + instanceSlotNames := aClass slots collect: [ :each | + each name asString ]. + classSlotNames := aClass classSide slots collect: [ :each | + each name asString ]. + traitNames := aClass traits collect: [ :each | each name asString ]. + classTraitNames := aClass classSide traits collect: [ :each | + each name asString ]. + sharedVariableNames := aClass classVarNames collect: [ :each | + each asString ]. + sharedPoolNames := aClass sharedPools collect: [ :each | + each name asString ]. layoutClassName := aClass classLayout class name asString. - subclassNames := (aClass subclasses - collect: [ :each | each name asString ] - as: Array) sort + subclassNames := (aClass subclasses collect: [ :each | + each name asString ]) sort ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryAdoptHeadResult.class.st b/src/MCP/MCPRepositoryAdoptHeadResult.class.st index cdd8bfe..af0e47f 100644 --- a/src/MCP/MCPRepositoryAdoptHeadResult.class.st +++ b/src/MCP/MCPRepositoryAdoptHeadResult.class.st @@ -123,9 +123,8 @@ MCPRepositoryAdoptHeadResult >> packageInfos [ MCPRepositoryAdoptHeadResult >> packageInfosFromRepository: aRepository [ | packages | - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. ^ packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ] ] diff --git a/src/MCP/MCPRepositoryBranchResult.class.st b/src/MCP/MCPRepositoryBranchResult.class.st index 731dcdf..608090b 100644 --- a/src/MCP/MCPRepositoryBranchResult.class.st +++ b/src/MCP/MCPRepositoryBranchResult.class.st @@ -75,9 +75,8 @@ MCPRepositoryBranchResult >> packageInfos [ MCPRepositoryBranchResult >> packageInfosFromRepository: aRepository [ | packages | - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. ^ packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ] ] diff --git a/src/MCP/MCPRepositoryCommitResult.class.st b/src/MCP/MCPRepositoryCommitResult.class.st index 12635ed..ef907a2 100644 --- a/src/MCP/MCPRepositoryCommitResult.class.st +++ b/src/MCP/MCPRepositoryCommitResult.class.st @@ -108,13 +108,11 @@ MCPRepositoryCommitResult >> headDescription: aString [ MCPRepositoryCommitResult >> initializeRepository: aRepository changedPackageNames: packageNames commit: aCommit [ | packages repositoryPackageNames | - packages := aRepository workingCopy packages asArray sort: [ - :left - :right | left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. packageInfos := packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ]. - repositoryPackageNames := (packages collect: [ :each | - each name asString ]) asArray. + repositoryPackageNames := packages collect: [ :each | each name ]. changedPackageNames := packageNames ifNil: [ #( ) ]. modifiedPackageNames := #( ). commitId := self commitIdFrom: aCommit. diff --git a/src/MCP/MCPRepositoryCreateResult.class.st b/src/MCP/MCPRepositoryCreateResult.class.st index 195ad64..c483c4c 100644 --- a/src/MCP/MCPRepositoryCreateResult.class.st +++ b/src/MCP/MCPRepositoryCreateResult.class.st @@ -30,9 +30,8 @@ MCPRepositoryCreateResult >> initializeFromRepository: aRepository [ | packages | repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages asArray sort: [ - :left - :right | left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. packageInfos := packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ] ] diff --git a/src/MCP/MCPRepositoryDiffResult.class.st b/src/MCP/MCPRepositoryDiffResult.class.st index db00372..c670234 100644 --- a/src/MCP/MCPRepositoryDiffResult.class.st +++ b/src/MCP/MCPRepositoryDiffResult.class.st @@ -78,9 +78,8 @@ MCPRepositoryDiffResult >> initializeRepository: aRepository changedPackageNames | packages | repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages asArray sort: [ - :left - :right | left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. packageInfos := packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ]. changedPackageNames := packageNames ifNil: [ #( ) ]. diff --git a/src/MCP/MCPRepositoryExportResult.class.st b/src/MCP/MCPRepositoryExportResult.class.st index f639c70..e573227 100644 --- a/src/MCP/MCPRepositoryExportResult.class.st +++ b/src/MCP/MCPRepositoryExportResult.class.st @@ -70,9 +70,8 @@ MCPRepositoryExportResult >> initializeRepository: aRepository changedPackageNam | packages | repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages asArray sort: [ - :left - :right | left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. packageInfos := packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ]. changedPackageNames := packageNames ifNil: [ #( ) ]. diff --git a/src/MCP/MCPRepositoryFetchResult.class.st b/src/MCP/MCPRepositoryFetchResult.class.st index 7da5dc1..5176bd3 100644 --- a/src/MCP/MCPRepositoryFetchResult.class.st +++ b/src/MCP/MCPRepositoryFetchResult.class.st @@ -67,9 +67,8 @@ MCPRepositoryFetchResult >> packageInfos [ MCPRepositoryFetchResult >> packageInfosFromRepository: aRepository [ | packages | - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. ^ packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ] ] diff --git a/src/MCP/MCPRepositoryPullResult.class.st b/src/MCP/MCPRepositoryPullResult.class.st index 6425476..f05756f 100644 --- a/src/MCP/MCPRepositoryPullResult.class.st +++ b/src/MCP/MCPRepositoryPullResult.class.st @@ -75,9 +75,8 @@ MCPRepositoryPullResult >> packageInfos [ MCPRepositoryPullResult >> packageInfosFromRepository: aRepository [ | packages | - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. ^ packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ] ] diff --git a/src/MCP/MCPRepositoryPushResult.class.st b/src/MCP/MCPRepositoryPushResult.class.st index 39e6743..cc524d4 100644 --- a/src/MCP/MCPRepositoryPushResult.class.st +++ b/src/MCP/MCPRepositoryPushResult.class.st @@ -65,9 +65,8 @@ MCPRepositoryPushResult >> packageInfos [ MCPRepositoryPushResult >> packageInfosFromRepository: aRepository [ | packages | - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. ^ packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ] ] diff --git a/src/MCP/MCPRepositoryUpdateResult.class.st b/src/MCP/MCPRepositoryUpdateResult.class.st index d54c68d..9c310ee 100644 --- a/src/MCP/MCPRepositoryUpdateResult.class.st +++ b/src/MCP/MCPRepositoryUpdateResult.class.st @@ -57,9 +57,8 @@ MCPRepositoryUpdateResult >> initializeRepository: aRepository updateActions: ac | packages | repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages asArray sort: [ - :left - :right | left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. packageInfos := packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ]. updateActions := actionNames ifNil: [ #( ) ]. diff --git a/src/MCP/MCPRepositoryVerifyIdentityResult.class.st b/src/MCP/MCPRepositoryVerifyIdentityResult.class.st index 7796a43..9a74881 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityResult.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityResult.class.st @@ -60,9 +60,8 @@ MCPRepositoryVerifyIdentityResult >> packageInfos [ MCPRepositoryVerifyIdentityResult >> packageInfosFromRepository: aRepository [ | packages | - packages := aRepository workingCopy packages asArray - sort: [ :left :right | - left name asString <= right name asString ]. + packages := aRepository workingCopy packages sort: [ :left :right | + left name <= right name ]. ^ packages collect: [ :each | MCPRepositoryPackageInfo fromPackage: each ] ] From 1a16188370b7800619689f2cc4c1b59f6c03d57f Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Wed, 24 Jun 2026 17:35:29 +0200 Subject: [PATCH 03/21] Introduce repository result hierarchy Co-authored-by: Codex --- src/MCP/MCP.class.st | 3 +- .../MCPAdoptRepositoryHeadCommand.class.st | 6 +- src/MCP/MCPClassCreateRequest.class.st | 3 +- src/MCP/MCPClassDescriptionInfo.class.st | 30 ++-- src/MCP/MCPClassInfo.class.st | 35 +++-- src/MCP/MCPClassUpdateRequest.class.st | 40 ++--- src/MCP/MCPCompileMethodCommand.class.st | 3 +- src/MCP/MCPCompiledMethodInfo.class.st | 3 +- src/MCP/MCPCreateClassToolCommand.class.st | 3 +- .../MCPCreateRepositoryBranchCommand.class.st | 3 +- src/MCP/MCPCreateRepositoryCommand.class.st | 3 +- src/MCP/MCPDebugAttachedContinuation.class.st | 3 +- ...AttachedDebuggerSelectionStrategy.class.st | 3 +- src/MCP/MCPDebugBreakpointRecord.class.st | 12 +- src/MCP/MCPDebugBreakpointRegistry.class.st | 11 +- src/MCP/MCPDebugBreakpointsCommand.class.st | 3 +- src/MCP/MCPDebugCaptureContinuation.class.st | 15 +- src/MCP/MCPDebugCommand.class.st | 3 +- src/MCP/MCPDebugRepairAnalyzer.class.st | 6 +- src/MCP/MCPDebugSessionCandidate.class.st | 3 +- src/MCP/MCPDebugSessionInfo.class.st | 3 +- src/MCP/MCPDebugSessionRecord.class.st | 24 ++- src/MCP/MCPDebugSessionRegistry.class.st | 8 +- src/MCP/MCPDebugStateInfo.class.st | 3 +- src/MCP/MCPDebugToolResult.class.st | 3 +- src/MCP/MCPDebugVariableReference.class.st | 3 +- src/MCP/MCPEvaluateCommand.class.st | 3 +- src/MCP/MCPEvaluateRequest.class.st | 3 +- src/MCP/MCPEvaluateResult.class.st | 3 +- src/MCP/MCPFetchRepositoryCommand.class.st | 3 +- src/MCP/MCPGetClassCommand.class.st | 3 +- src/MCP/MCPGetClassRequest.class.st | 3 +- src/MCP/MCPGetClassResult.class.st | 3 +- src/MCP/MCPGetMethodCommand.class.st | 3 +- src/MCP/MCPGetMethodRequest.class.st | 3 +- src/MCP/MCPGetMethodResult.class.st | 3 +- src/MCP/MCPGitRepositoryMetadata.class.st | 3 +- src/MCP/MCPLoadBaselineCommand.class.st | 3 +- src/MCP/MCPLoadBaselineRequest.class.st | 3 +- src/MCP/MCPLoadBaselineResult.class.st | 3 +- src/MCP/MCPLoadRepositoryCommand.class.st | 3 +- src/MCP/MCPLoadRepositoryRequest.class.st | 9 +- src/MCP/MCPLoadRepositoryResult.class.st | 3 +- src/MCP/MCPMessageProcessor.class.st | 2 +- src/MCP/MCPMethodCompileRequest.class.st | 6 +- src/MCP/MCPMethodReferenceSpec.class.st | 3 +- src/MCP/MCPMethodRewriteChangeInfo.class.st | 17 ++- src/MCP/MCPMethodRewriteReport.class.st | 3 +- src/MCP/MCPMethodRewriteRuleSpec.class.st | 3 +- src/MCP/MCPMethodUpdateRequest.class.st | 144 +++++++++--------- src/MCP/MCPPackageInfo.class.st | 3 +- src/MCP/MCPPullRepositoryCommand.class.st | 3 +- src/MCP/MCPPushRepositoryCommand.class.st | 3 +- src/MCP/MCPRefactoringScopeSpec.class.st | 3 +- src/MCP/MCPRemoveClassesRequest.class.st | 3 +- src/MCP/MCPRemoveMethodsCommand.class.st | 3 +- src/MCP/MCPRemoveMethodsRequest.class.st | 3 +- src/MCP/MCPRemoveMethodsResult.class.st | 3 +- .../MCPRepositoryAdoptHeadRequest.class.st | 3 +- src/MCP/MCPRepositoryAdoptHeadResult.class.st | 43 +----- src/MCP/MCPRepositoryBranchResult.class.st | 49 +----- src/MCP/MCPRepositoryCommitRequest.class.st | 3 +- src/MCP/MCPRepositoryCommitResult.class.st | 37 +---- .../MCPRepositoryCreateBranchRequest.class.st | 3 +- src/MCP/MCPRepositoryCreateRequest.class.st | 3 +- src/MCP/MCPRepositoryCreateResult.class.st | 41 +---- src/MCP/MCPRepositoryDiffRequest.class.st | 3 +- src/MCP/MCPRepositoryDiffResult.class.st | 35 +---- src/MCP/MCPRepositoryExportRequest.class.st | 3 +- src/MCP/MCPRepositoryExportResult.class.st | 35 +---- src/MCP/MCPRepositoryFetchRequest.class.st | 3 +- src/MCP/MCPRepositoryFetchResult.class.st | 43 +----- src/MCP/MCPRepositoryPullRequest.class.st | 3 +- src/MCP/MCPRepositoryPullResult.class.st | 43 +----- src/MCP/MCPRepositoryPushRequest.class.st | 3 +- src/MCP/MCPRepositoryPushResult.class.st | 29 +--- src/MCP/MCPRepositoryReferenceSpec.class.st | 3 +- src/MCP/MCPRepositoryResult.class.st | 30 ++++ src/MCP/MCPRepositorySnapshotResult.class.st | 57 +++++++ .../MCPRepositorySwitchBranchRequest.class.st | 3 +- .../MCPRepositoryTransitionResult.class.st | 53 +++++++ src/MCP/MCPRepositoryUpdateRequest.class.st | 3 +- src/MCP/MCPRepositoryUpdateResult.class.st | 35 +---- ...CPRepositoryVerifyIdentityCommand.class.st | 3 +- ...CPRepositoryVerifyIdentityRequest.class.st | 23 ++- ...MCPRepositoryVerifyIdentityResult.class.st | 29 +--- .../MCPRepositoryWorkingCopyCommand.class.st | 3 +- src/MCP/MCPRewriteMethodsCommand.class.st | 3 +- src/MCP/MCPRunTestsCommand.class.st | 3 +- src/MCP/MCPRunTestsRequest.class.st | 3 +- src/MCP/MCPRunTestsResult.class.st | 3 +- src/MCP/MCPScreenshotCommand.class.st | 3 +- src/MCP/MCPScreenshotRequest.class.st | 3 +- src/MCP/MCPScreenshotResult.class.st | 3 +- .../MCPSwitchRepositoryBranchCommand.class.st | 3 +- src/MCP/MCPTestCoverageRequest.class.st | 5 +- src/MCP/MCPTestCoverageResult.class.st | 3 +- src/MCP/MCPTestRunInfo.class.st | 3 +- src/MCP/MCPTestRunRequest.class.st | 3 +- src/MCP/MCPTestRunResult.class.st | 3 +- src/MCP/MCPToolRequest.class.st | 3 +- src/MCP/MCPUpdateClassCommand.class.st | 3 +- src/MCP/MCPUpdateDebugMethodRequest.class.st | 3 +- src/MCP/MCPUpdateMethodCommand.class.st | 3 +- src/MCP/MCPUpdateRepositoryCommand.class.st | 3 +- src/MCP/MCPValidatedTestRunRequest.class.st | 3 +- 106 files changed, 534 insertions(+), 643 deletions(-) create mode 100644 src/MCP/MCPRepositoryResult.class.st create mode 100644 src/MCP/MCPRepositorySnapshotResult.class.st create mode 100644 src/MCP/MCPRepositoryTransitionResult.class.st diff --git a/src/MCP/MCP.class.st b/src/MCP/MCP.class.st index e7043fb..57d0de3 100644 --- a/src/MCP/MCP.class.st +++ b/src/MCP/MCP.class.st @@ -404,7 +404,8 @@ MCP >> staticToolNames [ MCP >> staticToolNames: aCollection [ self toolExposurePolicy: - (MCPToolExposurePolicy staticToolNames: aCollection) + (MCPToolExposurePolicy staticToolNames: aCollection). + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPAdoptRepositoryHeadCommand.class.st b/src/MCP/MCPAdoptRepositoryHeadCommand.class.st index 5ca3aaa..6e816fe 100644 --- a/src/MCP/MCPAdoptRepositoryHeadCommand.class.st +++ b/src/MCP/MCPAdoptRepositoryHeadCommand.class.st @@ -74,7 +74,8 @@ MCPAdoptRepositoryHeadCommand >> execute [ MCPAdoptRepositoryHeadCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'private' } @@ -131,5 +132,6 @@ MCPAdoptRepositoryHeadCommand >> validateHeadCommit: headCommit for: aRepository headCommit ifNil: [ ^ self signalMissingHeadCommitFor: aRepository ]. (MCPIcebergCommitInfo isNoCommit: headCommit) ifTrue: [ - ^ self signalMissingHeadCommitFor: aRepository ] + ^ self signalMissingHeadCommitFor: aRepository ]. + ^ self ] diff --git a/src/MCP/MCPClassCreateRequest.class.st b/src/MCP/MCPClassCreateRequest.class.st index c3470bc..5a374ce 100644 --- a/src/MCP/MCPClassCreateRequest.class.st +++ b/src/MCP/MCPClassCreateRequest.class.st @@ -107,7 +107,8 @@ MCPClassCreateRequest >> initializeFromRequest: request [ 'sharedVariables'. sharedPoolNames := request stringCollectionArgumentNamed: 'sharedPools'. - layout := request stringArgumentNamed: 'layout' + layout := request stringArgumentNamed: 'layout'. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPClassDescriptionInfo.class.st b/src/MCP/MCPClassDescriptionInfo.class.st index ecdb945..1c3c301 100644 --- a/src/MCP/MCPClassDescriptionInfo.class.st +++ b/src/MCP/MCPClassDescriptionInfo.class.st @@ -73,24 +73,24 @@ MCPClassDescriptionInfo >> initializeFromClass: aClass [ ifNil: [ '' ] ifNotNil: [ :aSuperclass | aSuperclass name asString ]. - packageName := aClass package - ifNil: [ '' ] - ifNotNil: [ :aPackage | aPackage name asString ]. + packageName := aClass packageName asString. tag := aClass packageTagName asString. - instanceSlotNames := aClass slots collect: [ :each | - each name asString ]. - classSlotNames := aClass classSide slots collect: [ :each | - each name asString ]. - traitNames := aClass traits collect: [ :each | each name asString ]. - classTraitNames := aClass classSide traits collect: [ :each | - each name asString ]. + instanceSlotNames := (aClass slots collect: [ :each | + each name asString ]) asArray. + classSlotNames := (aClass classSide slots collect: [ :each | + each name asString ]) asArray. + traitNames := (aClass traits collect: [ :each | each name asString ]) + asArray. + classTraitNames := (aClass classSide traits collect: [ :each | + each name asString ]) asArray. traitComposition := aClass traitCompositionString. classTraitComposition := aClass classSide traitCompositionString. - sharedVariableNames := aClass classVarNames collect: [ :each | - each asString ]. - sharedPoolNames := aClass sharedPools collect: [ :each | - each name asString ]. + sharedPoolNames := (aClass sharedPools collect: [ :each | + each name asString ]) asArray. + sharedVariableNames := (aClass classVarNames collect: [ :each | + each asString ]) asArray. layoutClassName := aClass classLayout class name asString. instanceMethodCount := aClass selectors size. - classMethodCount := aClass classSide selectors size + classMethodCount := aClass classSide selectors size. + ^ self ] diff --git a/src/MCP/MCPClassInfo.class.st b/src/MCP/MCPClassInfo.class.st index 7d6697d..8fc1434 100644 --- a/src/MCP/MCPClassInfo.class.st +++ b/src/MCP/MCPClassInfo.class.st @@ -90,20 +90,29 @@ MCPClassInfo >> initializeFromClass: aClass [ ifNil: [ '' ] ifNotNil: [ :aPackage | aPackage name asString ]. tag := aClass packageTagName asString. - instanceSlotNames := aClass slots collect: [ :each | - each name asString ]. - classSlotNames := aClass classSide slots collect: [ :each | - each name asString ]. - traitNames := aClass traits collect: [ :each | each name asString ]. - classTraitNames := aClass classSide traits collect: [ :each | - each name asString ]. - sharedVariableNames := aClass classVarNames collect: [ :each | - each asString ]. - sharedPoolNames := aClass sharedPools collect: [ :each | - each name asString ]. + instanceSlotNames := aClass slots + collect: [ :each | each name asString ] + as: Array. + classSlotNames := aClass classSide slots + collect: [ :each | each name asString ] + as: Array. + traitNames := aClass traits + collect: [ :each | each name asString ] + as: Array. + classTraitNames := aClass classSide traits + collect: [ :each | each name asString ] + as: Array. + sharedVariableNames := aClass classVarNames + collect: [ :each | each asString ] + as: Array. + sharedPoolNames := aClass sharedPools + collect: [ :each | each name asString ] + as: Array. layoutClassName := aClass classLayout class name asString. - subclassNames := (aClass subclasses collect: [ :each | - each name asString ]) sort + subclassNames := (aClass subclasses + collect: [ :each | each name asString ] + as: Array) sort. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPClassUpdateRequest.class.st b/src/MCP/MCPClassUpdateRequest.class.st index 20da9a4..4a8cf22 100644 --- a/src/MCP/MCPClassUpdateRequest.class.st +++ b/src/MCP/MCPClassUpdateRequest.class.st @@ -191,7 +191,8 @@ MCPClassUpdateRequest >> initializeFromRequest: request [ slotName := request stringArgumentNamed: 'slotName'. newSlotName := request stringArgumentNamed: 'newSlotName'. slotAction := request stringArgumentNamed: 'slotAction'. - classSide := request booleanArgumentNamed: 'classSide' default: false + classSide := request booleanArgumentNamed: 'classSide' default: false. + ^ self ] { #category : 'accessing' } @@ -417,28 +418,29 @@ MCPClassUpdateRequest >> validateSlotUpdate [ | operation | operation := self slotOperation. operation ifNil: [ - (self hasSlotName or: [ self hasNewSlotName ]) ifTrue: [ - MCPCommandError - signalErrorCode: #SlotActionRequired - message: - 'slotAction is required when slotName or newSlotName is provided for update.' - details: self slotRequestedContext ]. - ^ self ]. - self hasSlotName ifFalse: [ + (self hasSlotName or: [ self hasNewSlotName ]) ifTrue: [ MCPCommandError - signalErrorCode: #SlotNameRequired - message: 'slotName is required for slot updates.' + signalErrorCode: #SlotActionRequired + message: + 'slotAction is required when slotName or newSlotName is provided for update.' details: self slotRequestedContext ]. + ^ self ]. + self hasSlotName ifFalse: [ + MCPCommandError + signalErrorCode: #SlotNameRequired + message: 'slotName is required for slot updates.' + details: self slotRequestedContext ]. (operation = 'renameSlot' and: [ self hasNewSlotName not ]) ifTrue: [ - MCPCommandError - signalErrorCode: #NewSlotNameRequired - message: 'newSlotName is required when slotAction=rename.' - details: self slotRequestedContext ]. + MCPCommandError + signalErrorCode: #NewSlotNameRequired + message: 'newSlotName is required when slotAction=rename.' + details: self slotRequestedContext ]. (operation ~= 'renameSlot' and: [ self hasNewSlotName ]) ifTrue: [ - MCPCommandError - signalErrorCode: #UnexpectedNewSlotName - message: 'newSlotName is only accepted when slotAction=rename.' - details: self slotRequestedContext ] + MCPCommandError + signalErrorCode: #UnexpectedNewSlotName + message: 'newSlotName is only accepted when slotAction=rename.' + details: self slotRequestedContext ]. + ^ self ] { #category : 'converting' } diff --git a/src/MCP/MCPCompileMethodCommand.class.st b/src/MCP/MCPCompileMethodCommand.class.st index 94d3b92..2775d5b 100644 --- a/src/MCP/MCPCompileMethodCommand.class.st +++ b/src/MCP/MCPCompileMethodCommand.class.st @@ -79,7 +79,8 @@ MCPCompileMethodCommand >> execute [ MCPCompileMethodCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPCompiledMethodInfo.class.st b/src/MCP/MCPCompiledMethodInfo.class.st index b0feac2..bc726c4 100644 --- a/src/MCP/MCPCompiledMethodInfo.class.st +++ b/src/MCP/MCPCompiledMethodInfo.class.st @@ -78,7 +78,8 @@ MCPCompiledMethodInfo >> initializeFromMethod: aCompiledMethod [ classPackageName := aCompiledMethod methodClass instanceSide package name asString. isExtension := packageName ~= classPackageName. - source := aCompiledMethod sourceCode ifNil: [ '' ] + source := aCompiledMethod sourceCode ifNil: [ '' ]. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPCreateClassToolCommand.class.st b/src/MCP/MCPCreateClassToolCommand.class.st index eba0a0f..6814773 100644 --- a/src/MCP/MCPCreateClassToolCommand.class.st +++ b/src/MCP/MCPCreateClassToolCommand.class.st @@ -65,7 +65,8 @@ MCPCreateClassToolCommand >> execute [ MCPCreateClassToolCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPCreateRepositoryBranchCommand.class.st b/src/MCP/MCPCreateRepositoryBranchCommand.class.st index 1b30317..e05265f 100644 --- a/src/MCP/MCPCreateRepositoryBranchCommand.class.st +++ b/src/MCP/MCPCreateRepositoryBranchCommand.class.st @@ -50,7 +50,8 @@ MCPCreateRepositoryBranchCommand >> execute [ MCPCreateRepositoryBranchCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPCreateRepositoryCommand.class.st b/src/MCP/MCPCreateRepositoryCommand.class.st index d134de4..bb46031 100644 --- a/src/MCP/MCPCreateRepositoryCommand.class.st +++ b/src/MCP/MCPCreateRepositoryCommand.class.st @@ -66,7 +66,8 @@ MCPCreateRepositoryCommand >> execute [ MCPCreateRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPDebugAttachedContinuation.class.st b/src/MCP/MCPDebugAttachedContinuation.class.st index 5cbb7dd..71c3631 100644 --- a/src/MCP/MCPDebugAttachedContinuation.class.st +++ b/src/MCP/MCPDebugAttachedContinuation.class.st @@ -85,7 +85,8 @@ MCPDebugAttachedContinuation >> debugSession [ { #category : 'accessing' } MCPDebugAttachedContinuation >> debugSession: aDebugSession [ - outcome at: #debugSession put: aDebugSession + outcome at: #debugSession put: aDebugSession. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st b/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st index 757adc0..ac002c7 100644 --- a/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st +++ b/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st @@ -86,7 +86,8 @@ MCPDebugAttachedDebuggerSelectionStrategy class >> reset [ PreviousStrategy := nil. OupsDebuggerSelectionStrategy debuggerSelectionStrategy = self ifTrue: [ - OupsDebuggerSelectionStrategy debuggerSelectionStrategy: fallback ] + OupsDebuggerSelectionStrategy debuggerSelectionStrategy: fallback ]. + ^ self ] { #category : 'debuggers' } diff --git a/src/MCP/MCPDebugBreakpointRecord.class.st b/src/MCP/MCPDebugBreakpointRecord.class.st index 9be9261..8cb63c3 100644 --- a/src/MCP/MCPDebugBreakpointRecord.class.st +++ b/src/MCP/MCPDebugBreakpointRecord.class.st @@ -71,13 +71,15 @@ MCPDebugBreakpointRecord >> debugPoint [ { #category : 'controlling' } MCPDebugBreakpointRecord >> disable [ - debugPoint disable + debugPoint disable. + ^ self ] { #category : 'controlling' } MCPDebugBreakpointRecord >> enable [ - debugPoint enable + debugPoint enable. + ^ self ] { #category : 'accessing' } @@ -98,7 +100,8 @@ MCPDebugBreakpointRecord >> initializeBreakpointId: breakpointString debugPoint: sourceStart := startInteger. sourceStop := stopInteger. nodeClassName := nodeClassString. - createdAt := aDateAndTime + createdAt := aDateAndTime. + ^ self ] { #category : 'removing' } @@ -107,7 +110,8 @@ MCPDebugBreakpointRecord >> remove [ debugPoint ifNil: [ ^ self ]. [ debugPoint remove ] on: Error - do: [ :ignored | nil ] + do: [ :ignored | nil ]. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPDebugBreakpointRegistry.class.st b/src/MCP/MCPDebugBreakpointRegistry.class.st index d8799ba..dd49f0e 100644 --- a/src/MCP/MCPDebugBreakpointRegistry.class.st +++ b/src/MCP/MCPDebugBreakpointRegistry.class.st @@ -21,14 +21,16 @@ Class { { #category : 'accessing' } MCPDebugBreakpointRegistry class >> default [ - ^ Default ifNil: [ Default := self new ] + Default ifNil: [ Default := self new ]. + ^ Default ] -{ #category : 'class initialization' } +{ #category : 'accessing' } MCPDebugBreakpointRegistry class >> resetDefault [ Default ifNotNil: [ Default removeAll ]. - Default := nil + Default := nil. + ^ self ] { #category : 'accessing' } @@ -83,7 +85,8 @@ MCPDebugBreakpointRegistry >> registerDebugPoint: aDebugPoint className: aClassN MCPDebugBreakpointRegistry >> removeAll [ breakpoints valuesDo: [ :each | each remove ]. - breakpoints removeAll + breakpoints removeAll. + ^ self ] { #category : 'removing' } diff --git a/src/MCP/MCPDebugBreakpointsCommand.class.st b/src/MCP/MCPDebugBreakpointsCommand.class.st index 4866ee2..2afe974 100644 --- a/src/MCP/MCPDebugBreakpointsCommand.class.st +++ b/src/MCP/MCPDebugBreakpointsCommand.class.st @@ -102,7 +102,8 @@ MCPDebugBreakpointsCommand >> initializeTool: aTool request: aRequest registry: tool := aTool. request := aRequest. - registry := aRegistry + registry := aRegistry. + ^ self ] { #category : 'private - actions' } diff --git a/src/MCP/MCPDebugCaptureContinuation.class.st b/src/MCP/MCPDebugCaptureContinuation.class.st index 7c7e74e..3f2c485 100644 --- a/src/MCP/MCPDebugCaptureContinuation.class.st +++ b/src/MCP/MCPDebugCaptureContinuation.class.st @@ -62,7 +62,8 @@ MCPDebugCaptureContinuation >> outcome [ { #category : 'accessing' } MCPDebugCaptureContinuation >> outcome: aDictionary [ - outcome := aDictionary + outcome := aDictionary. + ^ self ] { #category : 'private' } @@ -93,7 +94,8 @@ MCPDebugCaptureContinuation >> resultPreviewCharacterLimit [ { #category : 'accessing' } MCPDebugCaptureContinuation >> resultPreviewCharacterLimit: anInteger [ - resultPreviewCharacterLimit := anInteger + resultPreviewCharacterLimit := anInteger. + ^ self ] { #category : 'accessing' } @@ -105,7 +107,8 @@ MCPDebugCaptureContinuation >> semaphore [ { #category : 'accessing' } MCPDebugCaptureContinuation >> semaphore: aSemaphore [ - semaphore := aSemaphore + semaphore := aSemaphore. + ^ self ] { #category : 'controlling' } @@ -134,7 +137,8 @@ MCPDebugCaptureContinuation >> timeoutMilliseconds [ { #category : 'accessing' } MCPDebugCaptureContinuation >> timeoutMilliseconds: anInteger [ - timeoutMilliseconds := anInteger + timeoutMilliseconds := anInteger. + ^ self ] { #category : 'controlling' } @@ -152,5 +156,6 @@ MCPDebugCaptureContinuation >> workerProcess [ { #category : 'accessing' } MCPDebugCaptureContinuation >> workerProcess: aProcess [ - workerProcess := aProcess + workerProcess := aProcess. + ^ self ] diff --git a/src/MCP/MCPDebugCommand.class.st b/src/MCP/MCPDebugCommand.class.st index 5f3ad4a..00467ef 100644 --- a/src/MCP/MCPDebugCommand.class.st +++ b/src/MCP/MCPDebugCommand.class.st @@ -36,7 +36,8 @@ MCPDebugCommand >> initializeTool: aTool request: aRequest registry: aRegistry [ tool := aTool. request := aRequest. - registry := aRegistry + registry := aRegistry. + ^ self ] { #category : 'private' } diff --git a/src/MCP/MCPDebugRepairAnalyzer.class.st b/src/MCP/MCPDebugRepairAnalyzer.class.st index 31f35c6..a4ddc97 100644 --- a/src/MCP/MCPDebugRepairAnalyzer.class.st +++ b/src/MCP/MCPDebugRepairAnalyzer.class.st @@ -199,7 +199,8 @@ MCPDebugRepairAnalyzer >> record [ { #category : 'accessing' } MCPDebugRepairAnalyzer >> record: aRecord [ - record := aRecord + record := aRecord. + ^ self ] { #category : 'private - actions' } @@ -245,7 +246,8 @@ MCPDebugRepairAnalyzer >> request [ { #category : 'accessing' } MCPDebugRepairAnalyzer >> request: aRequest [ - request := aRequest + request := aRequest. + ^ self ] { #category : 'private - contexts' } diff --git a/src/MCP/MCPDebugSessionCandidate.class.st b/src/MCP/MCPDebugSessionCandidate.class.st index 169c0a9..ba5790b 100644 --- a/src/MCP/MCPDebugSessionCandidate.class.st +++ b/src/MCP/MCPDebugSessionCandidate.class.st @@ -66,7 +66,8 @@ MCPDebugSessionCandidate >> debugger [ { #category : 'accessing' } MCPDebugSessionCandidate >> debugger: aDebugger [ - debugger := aDebugger + debugger := aDebugger. + ^ self ] { #category : 'private' } diff --git a/src/MCP/MCPDebugSessionInfo.class.st b/src/MCP/MCPDebugSessionInfo.class.st index 1ef8539..954be8d 100644 --- a/src/MCP/MCPDebugSessionInfo.class.st +++ b/src/MCP/MCPDebugSessionInfo.class.st @@ -46,5 +46,6 @@ MCPDebugSessionInfo >> record [ { #category : 'accessing' } MCPDebugSessionInfo >> record: aRecord [ - record := aRecord + record := aRecord. + ^ self ] diff --git a/src/MCP/MCPDebugSessionRecord.class.st b/src/MCP/MCPDebugSessionRecord.class.st index 297629f..bfd7c5a 100644 --- a/src/MCP/MCPDebugSessionRecord.class.st +++ b/src/MCP/MCPDebugSessionRecord.class.st @@ -74,7 +74,8 @@ MCPDebugSessionRecord >> continuation [ { #category : 'accessing' } MCPDebugSessionRecord >> continuation: aContinuation [ - continuation := aContinuation + continuation := aContinuation. + ^ self ] { #category : 'accessing' } @@ -86,7 +87,8 @@ MCPDebugSessionRecord >> createdAt [ { #category : 'accessing' } MCPDebugSessionRecord >> createdAt: aDateAndTime [ - createdAt := aDateAndTime + createdAt := aDateAndTime. + ^ self ] { #category : 'accessing' } @@ -98,7 +100,8 @@ MCPDebugSessionRecord >> debugSession [ { #category : 'accessing' } MCPDebugSessionRecord >> debugSession: anObject [ - debugSession := anObject + debugSession := anObject. + ^ self ] { #category : 'accessing' } @@ -122,7 +125,8 @@ MCPDebugSessionRecord >> name [ { #category : 'accessing' } MCPDebugSessionRecord >> name: aString [ - name := aString + name := aString. + ^ self ] { #category : 'accessing' } @@ -134,7 +138,8 @@ MCPDebugSessionRecord >> reason [ { #category : 'accessing' } MCPDebugSessionRecord >> reason: aString [ - reason := aString + reason := aString. + ^ self ] { #category : 'accessing' } @@ -146,7 +151,8 @@ MCPDebugSessionRecord >> sessionId [ { #category : 'accessing' } MCPDebugSessionRecord >> sessionId: aString [ - sessionId := aString + sessionId := aString. + ^ self ] { #category : 'accessing' } @@ -158,7 +164,8 @@ MCPDebugSessionRecord >> stateId [ { #category : 'accessing' } MCPDebugSessionRecord >> stateId: aString [ - stateId := aString + stateId := aString. + ^ self ] { #category : 'accessing' } @@ -170,5 +177,6 @@ MCPDebugSessionRecord >> status [ { #category : 'accessing' } MCPDebugSessionRecord >> status: aString [ - status := aString + status := aString. + ^ self ] diff --git a/src/MCP/MCPDebugSessionRegistry.class.st b/src/MCP/MCPDebugSessionRegistry.class.st index 9ace02b..3782a3d 100644 --- a/src/MCP/MCPDebugSessionRegistry.class.st +++ b/src/MCP/MCPDebugSessionRegistry.class.st @@ -21,13 +21,15 @@ Class { { #category : 'accessing' } MCPDebugSessionRegistry class >> default [ - ^ Default ifNil: [ Default := self new ] + Default ifNil: [ Default := self new ]. + ^ Default ] -{ #category : 'class initialization' } +{ #category : 'accessing' } MCPDebugSessionRegistry class >> resetDefault [ - Default := nil + Default := nil. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPDebugStateInfo.class.st b/src/MCP/MCPDebugStateInfo.class.st index 0ddeeca..1a107dc 100644 --- a/src/MCP/MCPDebugStateInfo.class.st +++ b/src/MCP/MCPDebugStateInfo.class.st @@ -175,7 +175,8 @@ MCPDebugStateInfo >> record [ { #category : 'accessing' } MCPDebugStateInfo >> record: aRecord [ - record := aRecord + record := aRecord. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPDebugToolResult.class.st b/src/MCP/MCPDebugToolResult.class.st index 5bbc152..d9e6173 100644 --- a/src/MCP/MCPDebugToolResult.class.st +++ b/src/MCP/MCPDebugToolResult.class.st @@ -65,7 +65,8 @@ MCPDebugToolResult >> initializeStatus: aStatus summary: aSummary data: aDiction summary := aSummary. data := aDictionary. warnings := warningCollection. - errorDetails := detailsDictionary + errorDetails := detailsDictionary. + ^ self ] { #category : 'testing' } diff --git a/src/MCP/MCPDebugVariableReference.class.st b/src/MCP/MCPDebugVariableReference.class.st index a4acf6c..9e8bd43 100644 --- a/src/MCP/MCPDebugVariableReference.class.st +++ b/src/MCP/MCPDebugVariableReference.class.st @@ -83,7 +83,8 @@ MCPDebugVariableReference >> initializeRawReference: rawString sessionId: sessio frameIndex := frameInteger. scopeName := scopeString. variableName := variableString. - pathSegments := segmentArray + pathSegments := segmentArray. + ^ self ] { #category : 'testing' } diff --git a/src/MCP/MCPEvaluateCommand.class.st b/src/MCP/MCPEvaluateCommand.class.st index 376566b..c80d62e 100644 --- a/src/MCP/MCPEvaluateCommand.class.st +++ b/src/MCP/MCPEvaluateCommand.class.st @@ -53,7 +53,8 @@ MCPEvaluateCommand >> initializeTool: aTool request: aRequest resultPreviewChara tool := aTool. request := aRequest. - resultPreviewCharacterLimit := anInteger + resultPreviewCharacterLimit := anInteger. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPEvaluateRequest.class.st b/src/MCP/MCPEvaluateRequest.class.st index 6e45052..e5f9370 100644 --- a/src/MCP/MCPEvaluateRequest.class.st +++ b/src/MCP/MCPEvaluateRequest.class.st @@ -27,5 +27,6 @@ MCPEvaluateRequest >> code [ { #category : 'initialization' } MCPEvaluateRequest >> initializeCode: aString [ - code := aString + code := aString. + ^ self ] diff --git a/src/MCP/MCPEvaluateResult.class.st b/src/MCP/MCPEvaluateResult.class.st index 02d8dd2..91ab2cb 100644 --- a/src/MCP/MCPEvaluateResult.class.st +++ b/src/MCP/MCPEvaluateResult.class.st @@ -53,7 +53,8 @@ MCPEvaluateResult >> initializeStatus: aStatus data: aDictionary summary: aStrin status := aStatus. data := aDictionary. summary := aString. - errorDetails := detailsDictionary + errorDetails := detailsDictionary. + ^ self ] { #category : 'testing' } diff --git a/src/MCP/MCPFetchRepositoryCommand.class.st b/src/MCP/MCPFetchRepositoryCommand.class.st index 6302dbf..dd4db4d 100644 --- a/src/MCP/MCPFetchRepositoryCommand.class.st +++ b/src/MCP/MCPFetchRepositoryCommand.class.st @@ -49,7 +49,8 @@ MCPFetchRepositoryCommand >> execute [ MCPFetchRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetClassCommand.class.st b/src/MCP/MCPGetClassCommand.class.st index 7de8025..cb4ae59 100644 --- a/src/MCP/MCPGetClassCommand.class.st +++ b/src/MCP/MCPGetClassCommand.class.st @@ -48,7 +48,8 @@ MCPGetClassCommand >> execute [ MCPGetClassCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetClassRequest.class.st b/src/MCP/MCPGetClassRequest.class.st index a339243..495fbd5 100644 --- a/src/MCP/MCPGetClassRequest.class.st +++ b/src/MCP/MCPGetClassRequest.class.st @@ -48,7 +48,8 @@ MCPGetClassRequest >> initializeClassName: aClassName includeComment: aBoolean u className := aClassName. includeComment := aBoolean. upToSuperclassName := aSuperclassName. - subclassDepth := anInteger + subclassDepth := anInteger. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetClassResult.class.st b/src/MCP/MCPGetClassResult.class.st index 347d0f8..8d1525c 100644 --- a/src/MCP/MCPGetClassResult.class.st +++ b/src/MCP/MCPGetClassResult.class.st @@ -43,7 +43,8 @@ MCPGetClassResult >> initializeClassName: aClassName data: aDictionary superclas className := aClassName. data := aDictionary. superclasses := superclassCollection. - subclasses := subclassCollection + subclasses := subclassCollection. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetMethodCommand.class.st b/src/MCP/MCPGetMethodCommand.class.st index da95b51..d81be65 100644 --- a/src/MCP/MCPGetMethodCommand.class.st +++ b/src/MCP/MCPGetMethodCommand.class.st @@ -49,7 +49,8 @@ MCPGetMethodCommand >> execute [ MCPGetMethodCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetMethodRequest.class.st b/src/MCP/MCPGetMethodRequest.class.st index 786f7cb..3a9dabc 100644 --- a/src/MCP/MCPGetMethodRequest.class.st +++ b/src/MCP/MCPGetMethodRequest.class.st @@ -58,7 +58,8 @@ MCPGetMethodRequest >> initializeClassName: aClassName selectorString: aSelector className := aClassName. selectorString := aSelectorString. classSide := aSide. - includeVariableDetails := aBoolean + includeVariableDetails := aBoolean. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPGetMethodResult.class.st b/src/MCP/MCPGetMethodResult.class.st index 2619127..73ad4e3 100644 --- a/src/MCP/MCPGetMethodResult.class.st +++ b/src/MCP/MCPGetMethodResult.class.st @@ -37,5 +37,6 @@ MCPGetMethodResult >> externalVariableCount [ MCPGetMethodResult >> initializeData: aDictionary externalVariableCount: anIntegerOrNil [ data := aDictionary. - externalVariableCount := anIntegerOrNil + externalVariableCount := anIntegerOrNil. + ^ self ] diff --git a/src/MCP/MCPGitRepositoryMetadata.class.st b/src/MCP/MCPGitRepositoryMetadata.class.st index 0eff0a9..9ecfe4a 100644 --- a/src/MCP/MCPGitRepositoryMetadata.class.st +++ b/src/MCP/MCPGitRepositoryMetadata.class.st @@ -161,7 +161,8 @@ MCPGitRepositoryMetadata >> initializeWithLocationString: aString [ location := aString ifNil: [ '' ]. gitDirectory := self gitDirectoryForLocation: location. - configEntries := self configEntriesFromGitDirectory: gitDirectory + configEntries := self configEntriesFromGitDirectory: gitDirectory. + ^ self ] { #category : 'private - parsing' } diff --git a/src/MCP/MCPLoadBaselineCommand.class.st b/src/MCP/MCPLoadBaselineCommand.class.st index 7f3ad43..9443feb 100644 --- a/src/MCP/MCPLoadBaselineCommand.class.st +++ b/src/MCP/MCPLoadBaselineCommand.class.st @@ -85,7 +85,8 @@ MCPLoadBaselineCommand >> initializeTool: aTool request: aRequest configureMetac tool := aTool. request := aRequest. - configureMetacelloBlock := aBlock + configureMetacelloBlock := aBlock. + ^ self ] { #category : 'private - loading' } diff --git a/src/MCP/MCPLoadBaselineRequest.class.st b/src/MCP/MCPLoadBaselineRequest.class.st index 9dda4d4..e39590f 100644 --- a/src/MCP/MCPLoadBaselineRequest.class.st +++ b/src/MCP/MCPLoadBaselineRequest.class.st @@ -61,7 +61,8 @@ MCPLoadBaselineRequest >> initializeBaseline: baselineName groups: groupNames lo baseline := baselineName. groups := groupNames ifNil: [ #( ) ]. - loadPolicy := aLoadPolicy + loadPolicy := aLoadPolicy. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPLoadBaselineResult.class.st b/src/MCP/MCPLoadBaselineResult.class.st index 7d4f111..f21611b 100644 --- a/src/MCP/MCPLoadBaselineResult.class.st +++ b/src/MCP/MCPLoadBaselineResult.class.st @@ -58,7 +58,8 @@ MCPLoadBaselineResult >> initializeRequest: aRequest newPackageNames: packageNam groups := aRequest groups. loadPolicy := aRequest loadPolicy. newPackageNames := packageNames asArray. - repositoryInfos := repositories asArray + repositoryInfos := repositories asArray. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPLoadRepositoryCommand.class.st b/src/MCP/MCPLoadRepositoryCommand.class.st index 0183f73..816993b 100644 --- a/src/MCP/MCPLoadRepositoryCommand.class.st +++ b/src/MCP/MCPLoadRepositoryCommand.class.st @@ -52,7 +52,8 @@ MCPLoadRepositoryCommand >> execute [ MCPLoadRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPLoadRepositoryRequest.class.st b/src/MCP/MCPLoadRepositoryRequest.class.st index 75de46d..64a7ccf 100644 --- a/src/MCP/MCPLoadRepositoryRequest.class.st +++ b/src/MCP/MCPLoadRepositoryRequest.class.st @@ -150,7 +150,8 @@ MCPLoadRepositoryRequest >> initializeDefaultsFromTool: aTool [ self isLocalLoad ifTrue: [ sourceDirectory ifNil: [ sourceDirectory := aTool defaultSourceDirectory ] ]. - self isIcebergLoad ifTrue: [ self initializeIcebergDefaults ] + self isIcebergLoad ifTrue: [ self initializeIcebergDefaults ]. + ^ self ] { #category : 'initialization' } @@ -172,7 +173,8 @@ MCPLoadRepositoryRequest >> initializeFromRequest: request tool: aTool [ request. self ensureSingleRepositorySource. mode := self requestedMode. - self initializeDefaultsFromTool: aTool + self initializeDefaultsFromTool: aTool. + ^ self ] { #category : 'private - mode' } @@ -180,7 +182,8 @@ MCPLoadRepositoryRequest >> initializeIcebergDefaults [ sourceDirectory ifNil: [ sourceDirectory := self sourceDirectoryFromRepository: - self icebergRepository ] + self icebergRepository ]. + ^ self ] { #category : 'private - mode' } diff --git a/src/MCP/MCPLoadRepositoryResult.class.st b/src/MCP/MCPLoadRepositoryResult.class.st index 5107c1f..9e14258 100644 --- a/src/MCP/MCPLoadRepositoryResult.class.st +++ b/src/MCP/MCPLoadRepositoryResult.class.st @@ -83,7 +83,8 @@ MCPLoadRepositoryResult >> initializeRequest: aRequest repositoryUrl: aRepositor checkoutPath := aRequest checkoutPath. repositoryName := aRequest repositoryName. location := aRequest location. - loadResult := aLoadResult + loadResult := aLoadResult. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPMessageProcessor.class.st b/src/MCP/MCPMessageProcessor.class.st index 79d750a..b3bf0ec 100644 --- a/src/MCP/MCPMessageProcessor.class.st +++ b/src/MCP/MCPMessageProcessor.class.st @@ -14,7 +14,7 @@ Class { { #category : 'handlers management' } MCPMessageProcessor >> addHandler: aJRPCHandler [ - (self handlers includes: aJRPCHandler) ifTrue: [ "handler has been overridden" + (self handlers includes: aJRPCHandler) ifTrue: [ "handler has been override" ^ self ]. handlers add: aJRPCHandler diff --git a/src/MCP/MCPMethodCompileRequest.class.st b/src/MCP/MCPMethodCompileRequest.class.st index e3e20fc..410999f 100644 --- a/src/MCP/MCPMethodCompileRequest.class.st +++ b/src/MCP/MCPMethodCompileRequest.class.st @@ -55,10 +55,12 @@ MCPMethodCompileRequest >> initializeFromRequest: request tool: aTool [ classSide := request booleanArgumentNamed: 'classSide' default: false. methodSource := (request argumentNamed: 'source' ifAbsent: [ MCPInvalidToolInput - signalMissingRequiredArgumentNamed: 'source' + signalMissingRequiredArgumentNamed: + 'source' forTool: aTool ]) withInternalLineEndings. protocol := request stringArgumentNamed: 'protocol'. - force := request booleanArgumentNamed: 'force' default: false + force := request booleanArgumentNamed: 'force' default: false. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPMethodReferenceSpec.class.st b/src/MCP/MCPMethodReferenceSpec.class.st index 3f1c7f5..7bcd1a5 100644 --- a/src/MCP/MCPMethodReferenceSpec.class.st +++ b/src/MCP/MCPMethodReferenceSpec.class.st @@ -64,7 +64,8 @@ MCPMethodReferenceSpec >> initializeClassName: aClassName selector: aSelector cl className := aClassName. selector := aSelector. - classSide := aBoolean ifNil: [ false ] + classSide := aBoolean ifNil: [ false ]. + ^ self ] { #category : 'printing' } diff --git a/src/MCP/MCPMethodRewriteChangeInfo.class.st b/src/MCP/MCPMethodRewriteChangeInfo.class.st index 42c582d..aca25d9 100644 --- a/src/MCP/MCPMethodRewriteChangeInfo.class.st +++ b/src/MCP/MCPMethodRewriteChangeInfo.class.st @@ -76,16 +76,17 @@ MCPMethodRewriteChangeInfo >> initializeFromChange: aChange includeSources: aBoo ifAbsent: [ nil ]. compiledMethod ifNil: [ - packageName := ''. - protocol := ''. - oldSource := '' ] + packageName := ''. + protocol := ''. + oldSource := '' ] ifNotNil: [ - methodInfo := MCPCompiledMethodInfo fromMethod: compiledMethod. - packageName := methodInfo packageName. - protocol := methodInfo protocol. - oldSource := compiledMethod sourceCode ifNil: [ '' ] ]. + methodInfo := MCPCompiledMethodInfo fromMethod: compiledMethod. + packageName := methodInfo packageName. + protocol := methodInfo protocol. + oldSource := compiledMethod sourceCode ifNil: [ '' ] ]. newSource := aChange source ifNil: [ '' ]. - includeSources := aBoolean + includeSources := aBoolean. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPMethodRewriteReport.class.st b/src/MCP/MCPMethodRewriteReport.class.st index 76cf4ed..880de65 100644 --- a/src/MCP/MCPMethodRewriteReport.class.st +++ b/src/MCP/MCPMethodRewriteReport.class.st @@ -91,7 +91,8 @@ MCPMethodRewriteReport >> initializeFromRequest: aRequest changeInfos: changeInf changeInfos := changeInfoCollection asArray. appliedCount := appliedCountInteger. scope := aRequest scopeQuery asDictionary. - changeSetHash := changeSetHashInteger + changeSetHash := changeSetHashInteger. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPMethodRewriteRuleSpec.class.st b/src/MCP/MCPMethodRewriteRuleSpec.class.st index 4088622..92ab169 100644 --- a/src/MCP/MCPMethodRewriteRuleSpec.class.st +++ b/src/MCP/MCPMethodRewriteRuleSpec.class.st @@ -74,7 +74,8 @@ MCPMethodRewriteRuleSpec >> initializeFromDictionary: aDictionary request: reque booleanArgumentNamed: 'isForMethod' in: aDictionary default: false. - self validateAtIndex: index + self validateAtIndex: index. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPMethodUpdateRequest.class.st b/src/MCP/MCPMethodUpdateRequest.class.st index 8fb3151..163af32 100644 --- a/src/MCP/MCPMethodUpdateRequest.class.st +++ b/src/MCP/MCPMethodUpdateRequest.class.st @@ -200,7 +200,8 @@ MCPMethodUpdateRequest >> initializeFromRequest: request [ selector: selector asSymbol newSelector: (newSelector ifNotNil: [ newSelector asSymbol ]). - force := request booleanArgumentNamed: 'force' default: false + force := request booleanArgumentNamed: 'force' default: false. + ^ self ] { #category : 'private - request' } @@ -383,31 +384,32 @@ MCPMethodUpdateRequest >> updatePropertyNames [ MCPMethodUpdateRequest >> validateAddArgumentsUpdate [ self argumentNames isEmpty ifTrue: [ - MCPCommandError - signalErrorCode: #ArgumentNamesRequiredForAddedArguments - message: - 'argumentNames is required when newSelector adds method arguments.' - details: self requestedContext ]. + MCPCommandError + signalErrorCode: #ArgumentNamesRequiredForAddedArguments + message: + 'argumentNames is required when newSelector adds method arguments.' + details: self requestedContext ]. self argumentNames size = self newSelector asSymbol numArgs ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentNames + message: + 'argumentNames must contain one name for each target selector argument.' + details: self requestedContext ]. + (self argumentNames allSatisfy: [ :each | each isNotEmpty ]) + ifFalse: [ MCPCommandError signalErrorCode: #InvalidMethodArgumentNames - message: - 'argumentNames must contain one name for each target selector argument.' + message: 'argumentNames must not contain empty names.' details: self requestedContext ]. - (self argumentNames allSatisfy: [ :each | each isNotEmpty ]) - ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentNames - message: 'argumentNames must not contain empty names.' - details: self requestedContext ]. (self argumentValueExpressions isNotEmpty and: [ self argumentValueExpressions size ~= self addedArgumentCount ]) ifTrue: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentValueExpressions - message: - 'argumentValueExpressions must contain one expression for each newly added argument.' - details: self requestedContext ] + MCPCommandError + signalErrorCode: #InvalidMethodArgumentValueExpressions + message: + 'argumentValueExpressions must contain one expression for each newly added argument.' + details: self requestedContext ]. + ^ self ] { #category : 'validating' } @@ -415,75 +417,77 @@ MCPMethodUpdateRequest >> validateForUpdate [ | action | self hasPermutation ifTrue: [ - self hasRenameUpdate ifFalse: [ - MCPCommandError - signalErrorCode: #PermutationRequiresMethodSelectorUpdate - message: - 'permutation is only valid when update changes a method selector with newSelector.' - details: self requestedContext ] ]. + self hasRenameUpdate ifFalse: [ + MCPCommandError + signalErrorCode: #PermutationRequiresMethodSelectorUpdate + message: + 'permutation is only valid when update changes a method selector with newSelector.' + details: self requestedContext ] ]. (self hasArgumentNames or: [ self hasArgumentValueExpressions ]) ifTrue: [ - self hasRenameUpdate ifFalse: [ - MCPCommandError - signalErrorCode: #ArgumentMetadataRequiresMethodSelectorUpdate - message: - 'argumentNames and argumentValueExpressions are only valid with newSelector.' - details: self requestedContext ] ]. + self hasRenameUpdate ifFalse: [ + MCPCommandError + signalErrorCode: #ArgumentMetadataRequiresMethodSelectorUpdate + message: + 'argumentNames and argumentValueExpressions are only valid with newSelector.' + details: self requestedContext ] ]. action := self newSelectorUpdateAction. - action = 'addArguments' ifTrue: [ self validateAddArgumentsUpdate ] + action = 'addArguments' ifTrue: [ self validateAddArgumentsUpdate ]. + ^ self ] { #category : 'private - request' } -MCPMethodUpdateRequest >> validatePermutation: requestedPermutation fromSelector: oldSelector toSelector: targetSelector [ +MCPMethodUpdateRequest >> validatePermutation: requestedPermutation fromSelector: oldSelector toSelector: newSelector [ | newArgumentCount oldArgumentCount positiveIndexes | oldArgumentCount := oldSelector numArgs. - newArgumentCount := targetSelector numArgs. + newArgumentCount := newSelector numArgs. requestedPermutation size = newArgumentCount ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'permutation must contain one entry for each target selector argument.' + details: self requestedContext ]. + (requestedPermutation allSatisfy: [ :each | each isInteger ]) + ifFalse: [ MCPCommandError signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'permutation must contain one entry for each target selector argument.' + message: 'permutation entries must be integers.' details: self requestedContext ]. - (requestedPermutation allSatisfy: [ :each | each isInteger ]) - ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: 'permutation entries must be integers.' - details: self requestedContext ]. positiveIndexes := requestedPermutation select: [ :each | each > 0 ]. (positiveIndexes allSatisfy: [ :each | each between: 1 and: oldArgumentCount ]) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'positive permutation entries must reference existing arguments by 1-based index.' - details: self requestedContext ]. + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'positive permutation entries must reference existing arguments by 1-based index.' + details: self requestedContext ]. positiveIndexes asSet size = positiveIndexes size ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'permutation must not reference the same old argument twice.' - details: self requestedContext ]. + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'permutation must not reference the same old argument twice.' + details: self requestedContext ]. newArgumentCount >= oldArgumentCount ifTrue: [ - positiveIndexes size = oldArgumentCount ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'adding arguments requires every old argument to appear exactly once in permutation.' - details: self requestedContext ] ] + positiveIndexes size = oldArgumentCount ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'adding arguments requires every old argument to appear exactly once in permutation.' + details: self requestedContext ] ] ifFalse: [ - positiveIndexes size = newArgumentCount ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'removing arguments requires permutation to contain only kept old argument indexes.' - details: self requestedContext ]. - (requestedPermutation allSatisfy: [ :each | each > 0 ]) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'removing arguments does not accept negative permutation entries.' - details: self requestedContext ] ] + positiveIndexes size = newArgumentCount ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'removing arguments requires permutation to contain only kept old argument indexes.' + details: self requestedContext ]. + (requestedPermutation allSatisfy: [ :each | each > 0 ]) ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'removing arguments does not accept negative permutation entries.' + details: self requestedContext ] ]. + ^ self ] diff --git a/src/MCP/MCPPackageInfo.class.st b/src/MCP/MCPPackageInfo.class.st index 927bc31..beff83c 100644 --- a/src/MCP/MCPPackageInfo.class.st +++ b/src/MCP/MCPPackageInfo.class.st @@ -72,7 +72,8 @@ MCPPackageInfo >> initializeFromPackage: aPackage projectNames: someProjectNames as: Array) sort. definedClassCount := aPackage definedClasses size. extensionMethodCount := aPackage extensionMethods size. - isUndefined := aPackage isUndefined + isUndefined := aPackage isUndefined. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPPullRepositoryCommand.class.st b/src/MCP/MCPPullRepositoryCommand.class.st index 1c32786..e0e010d 100644 --- a/src/MCP/MCPPullRepositoryCommand.class.st +++ b/src/MCP/MCPPullRepositoryCommand.class.st @@ -49,7 +49,8 @@ MCPPullRepositoryCommand >> execute [ MCPPullRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPPushRepositoryCommand.class.st b/src/MCP/MCPPushRepositoryCommand.class.st index afbafc9..f1ef918 100644 --- a/src/MCP/MCPPushRepositoryCommand.class.st +++ b/src/MCP/MCPPushRepositoryCommand.class.st @@ -46,7 +46,8 @@ MCPPushRepositoryCommand >> execute [ MCPPushRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRefactoringScopeSpec.class.st b/src/MCP/MCPRefactoringScopeSpec.class.st index 89a5354..0d46b60 100644 --- a/src/MCP/MCPRefactoringScopeSpec.class.st +++ b/src/MCP/MCPRefactoringScopeSpec.class.st @@ -49,7 +49,8 @@ MCPRefactoringScopeSpec >> initializePackageNames: packageNamesCollection classN packageNames := packageNamesCollection ifNil: [ #( ) ]. classNames := classNamesCollection ifNil: [ #( ) ]. - hierarchyClassNames := hierarchyClassNamesCollection ifNil: [ #( ) ] + hierarchyClassNames := hierarchyClassNamesCollection ifNil: [ #( ) ]. + ^ self ] { #category : 'testing' } diff --git a/src/MCP/MCPRemoveClassesRequest.class.st b/src/MCP/MCPRemoveClassesRequest.class.st index af3eb77..d4372ee 100644 --- a/src/MCP/MCPRemoveClassesRequest.class.st +++ b/src/MCP/MCPRemoveClassesRequest.class.st @@ -37,5 +37,6 @@ MCPRemoveClassesRequest >> force [ MCPRemoveClassesRequest >> initializeClassNames: aCollection force: aBoolean [ classNames := aCollection. - force := aBoolean + force := aBoolean. + ^ self ] diff --git a/src/MCP/MCPRemoveMethodsCommand.class.st b/src/MCP/MCPRemoveMethodsCommand.class.st index f1f1386..bf4663c 100644 --- a/src/MCP/MCPRemoveMethodsCommand.class.st +++ b/src/MCP/MCPRemoveMethodsCommand.class.st @@ -47,7 +47,8 @@ MCPRemoveMethodsCommand >> execute [ MCPRemoveMethodsCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRemoveMethodsRequest.class.st b/src/MCP/MCPRemoveMethodsRequest.class.st index a87cae6..b0e2e56 100644 --- a/src/MCP/MCPRemoveMethodsRequest.class.st +++ b/src/MCP/MCPRemoveMethodsRequest.class.st @@ -41,7 +41,8 @@ MCPRemoveMethodsRequest >> initializeClassName: aClassName classSide: aBoolean s className := aClassName. classSide := aBoolean. - selectors := aCollection + selectors := aCollection. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRemoveMethodsResult.class.st b/src/MCP/MCPRemoveMethodsResult.class.st index 3a0d349..beb26e1 100644 --- a/src/MCP/MCPRemoveMethodsResult.class.st +++ b/src/MCP/MCPRemoveMethodsResult.class.st @@ -50,7 +50,8 @@ MCPRemoveMethodsResult >> initializeFromRequest: aRequest removedMethods: method classSide := aRequest classSide. selectors := aRequest selectors asArray. removedMethods := methodCollection asArray. - warningMessages := warningCollection asArray + warningMessages := warningCollection asArray. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryAdoptHeadRequest.class.st b/src/MCP/MCPRepositoryAdoptHeadRequest.class.st index f9e2c83..350ed59 100644 --- a/src/MCP/MCPRepositoryAdoptHeadRequest.class.st +++ b/src/MCP/MCPRepositoryAdoptHeadRequest.class.st @@ -36,7 +36,8 @@ MCPRepositoryAdoptHeadRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: request. - branchName := request stringArgumentNamed: 'branchName' + branchName := request stringArgumentNamed: 'branchName'. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryAdoptHeadResult.class.st b/src/MCP/MCPRepositoryAdoptHeadResult.class.st index af0e47f..2f97950 100644 --- a/src/MCP/MCPRepositoryAdoptHeadResult.class.st +++ b/src/MCP/MCPRepositoryAdoptHeadResult.class.st @@ -3,11 +3,8 @@ Result DTO returned by repository_head_adopt. It reports repository metadata bef " Class { #name : 'MCPRepositoryAdoptHeadResult', - #superclass : 'Object', + #superclass : 'MCPRepositoryTransitionResult', #instVars : [ - 'repositoryInfoBefore', - 'repositoryInfoAfter', - 'packageInfos', 'modifiedPackageNamesBefore', 'modifiedPackageNamesAfter', 'previousReferenceCommitId', @@ -88,9 +85,7 @@ MCPRepositoryAdoptHeadResult >> headDescription [ { #category : 'initialization' } MCPRepositoryAdoptHeadResult >> initializeRepositoryBefore: beforeInfo after: aRepository previousReferenceCommit: previousCommit adoptedCommit: headCommit didAdopt: aBoolean [ - repositoryInfoBefore := beforeInfo. - repositoryInfoAfter := MCPRepositoryInfo fromRepository: aRepository. - packageInfos := self packageInfosFromRepository: aRepository. + super initializeRepositoryBefore: beforeInfo after: aRepository. modifiedPackageNamesBefore := beforeInfo modifiedPackageNames. modifiedPackageNamesAfter := repositoryInfoAfter modifiedPackageNames. previousReferenceCommitId := self commitIdFrom: previousCommit. @@ -113,22 +108,6 @@ MCPRepositoryAdoptHeadResult >> modifiedPackageNamesBefore [ ^ modifiedPackageNamesBefore ifNil: [ #( ) ] ] -{ #category : 'accessing' } -MCPRepositoryAdoptHeadResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'private' } -MCPRepositoryAdoptHeadResult >> packageInfosFromRepository: aRepository [ - - | packages | - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - ^ packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ] -] - { #category : 'accessing' } MCPRepositoryAdoptHeadResult >> previousReferenceCommitId [ @@ -146,21 +125,3 @@ MCPRepositoryAdoptHeadResult >> referenceCommitIdForRepository: aRepository [ ^ self commitIdFrom: aRepository workingCopy referenceCommit ] - -{ #category : 'accessing' } -MCPRepositoryAdoptHeadResult >> repositoryInfo [ - - ^ self repositoryInfoAfter -] - -{ #category : 'accessing' } -MCPRepositoryAdoptHeadResult >> repositoryInfoAfter [ - - ^ repositoryInfoAfter -] - -{ #category : 'accessing' } -MCPRepositoryAdoptHeadResult >> repositoryInfoBefore [ - - ^ repositoryInfoBefore -] diff --git a/src/MCP/MCPRepositoryBranchResult.class.st b/src/MCP/MCPRepositoryBranchResult.class.st index 608090b..d46334d 100644 --- a/src/MCP/MCPRepositoryBranchResult.class.st +++ b/src/MCP/MCPRepositoryBranchResult.class.st @@ -3,11 +3,8 @@ Result DTO returned by repository branch tools. It reports repository metadata b " Class { #name : 'MCPRepositoryBranchResult', - #superclass : 'Object', + #superclass : 'MCPRepositoryTransitionResult', #instVars : [ - 'repositoryInfoBefore', - 'repositoryInfoAfter', - 'packageInfos', 'previousBranchName', 'branchName', 'previousHeadDescription', @@ -54,31 +51,11 @@ MCPRepositoryBranchResult >> headDescription [ { #category : 'initialization' } MCPRepositoryBranchResult >> initializeRepositoryBefore: beforeInfo after: aRepository [ - | afterInfo | - repositoryInfoBefore := beforeInfo. - afterInfo := MCPRepositoryInfo fromRepository: aRepository. - repositoryInfoAfter := afterInfo. - packageInfos := self packageInfosFromRepository: aRepository. + super initializeRepositoryBefore: beforeInfo after: aRepository. previousBranchName := beforeInfo branchName. - branchName := afterInfo branchName. + branchName := repositoryInfoAfter branchName. previousHeadDescription := beforeInfo headDescription. - headDescription := afterInfo headDescription -] - -{ #category : 'accessing' } -MCPRepositoryBranchResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'private' } -MCPRepositoryBranchResult >> packageInfosFromRepository: aRepository [ - - | packages | - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - ^ packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ] + headDescription := repositoryInfoAfter headDescription ] { #category : 'accessing' } @@ -92,21 +69,3 @@ MCPRepositoryBranchResult >> previousHeadDescription [ ^ previousHeadDescription ifNil: [ '' ] ] - -{ #category : 'accessing' } -MCPRepositoryBranchResult >> repositoryInfo [ - - ^ self repositoryInfoAfter -] - -{ #category : 'accessing' } -MCPRepositoryBranchResult >> repositoryInfoAfter [ - - ^ repositoryInfoAfter -] - -{ #category : 'accessing' } -MCPRepositoryBranchResult >> repositoryInfoBefore [ - - ^ repositoryInfoBefore -] diff --git a/src/MCP/MCPRepositoryCommitRequest.class.st b/src/MCP/MCPRepositoryCommitRequest.class.st index 0513995..7d523e3 100644 --- a/src/MCP/MCPRepositoryCommitRequest.class.st +++ b/src/MCP/MCPRepositoryCommitRequest.class.st @@ -30,7 +30,8 @@ MCPRepositoryCommitRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: request. - message := request stringArgumentNamed: 'message' + message := request stringArgumentNamed: 'message'. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryCommitResult.class.st b/src/MCP/MCPRepositoryCommitResult.class.st index ef907a2..6dc4f65 100644 --- a/src/MCP/MCPRepositoryCommitResult.class.st +++ b/src/MCP/MCPRepositoryCommitResult.class.st @@ -3,10 +3,8 @@ Result DTO returned by repository_commit. It reports repository state after the " Class { #name : 'MCPRepositoryCommitResult', - #superclass : 'Object', + #superclass : 'MCPRepositorySnapshotResult', #instVars : [ - 'repositoryInfo', - 'packageInfos', 'changedPackageNames', 'modifiedPackageNames', 'commitId', @@ -107,12 +105,9 @@ MCPRepositoryCommitResult >> headDescription: aString [ { #category : 'initialization' } MCPRepositoryCommitResult >> initializeRepository: aRepository changedPackageNames: packageNames commit: aCommit [ - | packages repositoryPackageNames | - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - packageInfos := packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ]. - repositoryPackageNames := packages collect: [ :each | each name ]. + | repositoryPackageNames | + packageInfos := self packageInfosFromRepository: aRepository. + repositoryPackageNames := packageInfos collect: [ :each | each name ]. changedPackageNames := packageNames ifNil: [ #( ) ]. modifiedPackageNames := #( ). commitId := self commitIdFrom: aCommit. @@ -137,27 +132,3 @@ MCPRepositoryCommitResult >> modifiedPackageNames: aCollection [ modifiedPackageNames := aCollection ifNil: [ #( ) ] ] - -{ #category : 'accessing' } -MCPRepositoryCommitResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPRepositoryCommitResult >> packageInfos: aCollection [ - - packageInfos := aCollection ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPRepositoryCommitResult >> repositoryInfo [ - - ^ repositoryInfo -] - -{ #category : 'accessing' } -MCPRepositoryCommitResult >> repositoryInfo: aRepositoryInfo [ - - repositoryInfo := aRepositoryInfo -] diff --git a/src/MCP/MCPRepositoryCreateBranchRequest.class.st b/src/MCP/MCPRepositoryCreateBranchRequest.class.st index fc97757..29632f8 100644 --- a/src/MCP/MCPRepositoryCreateBranchRequest.class.st +++ b/src/MCP/MCPRepositoryCreateBranchRequest.class.st @@ -36,7 +36,8 @@ MCPRepositoryCreateBranchRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: request. - branchName := request stringArgumentNamed: 'branchName' + branchName := request stringArgumentNamed: 'branchName'. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryCreateRequest.class.st b/src/MCP/MCPRepositoryCreateRequest.class.st index f1e688e..a3caac6 100644 --- a/src/MCP/MCPRepositoryCreateRequest.class.st +++ b/src/MCP/MCPRepositoryCreateRequest.class.st @@ -35,7 +35,8 @@ MCPRepositoryCreateRequest >> initializeFromRequest: request [ name := request stringArgumentNamed: 'name'. location := request stringArgumentNamed: 'location'. subdirectory := request stringArgumentNamed: 'subdirectory'. - packageNames := request stringCollectionArgumentNamed: 'packageNames' + packageNames := request stringCollectionArgumentNamed: 'packageNames'. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryCreateResult.class.st b/src/MCP/MCPRepositoryCreateResult.class.st index c483c4c..b30eed8 100644 --- a/src/MCP/MCPRepositoryCreateResult.class.st +++ b/src/MCP/MCPRepositoryCreateResult.class.st @@ -3,11 +3,7 @@ Result DTO returned by repository_create or repository_attach. It reports the re " Class { #name : 'MCPRepositoryCreateResult', - #superclass : 'Object', - #instVars : [ - 'repositoryInfo', - 'packageInfos' - ], + #superclass : 'MCPRepositorySnapshotResult', #category : 'MCP-Results', #package : 'MCP', #tag : 'Results' @@ -24,38 +20,3 @@ MCPRepositoryCreateResult >> asDictionary [ ^ Dictionary new ] - -{ #category : 'initialization' } -MCPRepositoryCreateResult >> initializeFromRepository: aRepository [ - - | packages | - repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - packageInfos := packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ] -] - -{ #category : 'accessing' } -MCPRepositoryCreateResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPRepositoryCreateResult >> packageInfos: aCollection [ - - packageInfos := aCollection ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPRepositoryCreateResult >> repositoryInfo [ - - ^ repositoryInfo -] - -{ #category : 'accessing' } -MCPRepositoryCreateResult >> repositoryInfo: aRepositoryInfo [ - - repositoryInfo := aRepositoryInfo -] diff --git a/src/MCP/MCPRepositoryDiffRequest.class.st b/src/MCP/MCPRepositoryDiffRequest.class.st index b147af0..b456fd7 100644 --- a/src/MCP/MCPRepositoryDiffRequest.class.st +++ b/src/MCP/MCPRepositoryDiffRequest.class.st @@ -28,7 +28,8 @@ MCPRepositoryDiffRequest >> commandForTool: aTool [ MCPRepositoryDiffRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request + request. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryDiffResult.class.st b/src/MCP/MCPRepositoryDiffResult.class.st index c670234..f62bc69 100644 --- a/src/MCP/MCPRepositoryDiffResult.class.st +++ b/src/MCP/MCPRepositoryDiffResult.class.st @@ -3,10 +3,8 @@ Result DTO returned by repository_change_list. It reports the repository working " Class { #name : 'MCPRepositoryDiffResult', - #superclass : 'Object', + #superclass : 'MCPRepositorySnapshotResult', #instVars : [ - 'repositoryInfo', - 'packageInfos', 'changedPackageNames', 'modifiedPaths', 'changeCount', @@ -76,12 +74,7 @@ MCPRepositoryDiffResult >> derivedChangeCount [ { #category : 'initialization' } MCPRepositoryDiffResult >> initializeRepository: aRepository changedPackageNames: packageNames modifiedPaths: paths isEmpty: aBoolean [ - | packages | - repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - packageInfos := packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ]. + self initializeSnapshotFromRepository: aRepository. changedPackageNames := packageNames ifNil: [ #( ) ]. modifiedPaths := paths ifNil: [ #( ) ]. isEmpty := aBoolean. @@ -111,27 +104,3 @@ MCPRepositoryDiffResult >> modifiedPaths: aCollection [ modifiedPaths := aCollection ifNil: [ #( ) ] ] - -{ #category : 'accessing' } -MCPRepositoryDiffResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPRepositoryDiffResult >> packageInfos: aCollection [ - - packageInfos := aCollection ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPRepositoryDiffResult >> repositoryInfo [ - - ^ repositoryInfo -] - -{ #category : 'accessing' } -MCPRepositoryDiffResult >> repositoryInfo: aRepositoryInfo [ - - repositoryInfo := aRepositoryInfo -] diff --git a/src/MCP/MCPRepositoryExportRequest.class.st b/src/MCP/MCPRepositoryExportRequest.class.st index a5524e2..7bf0470 100644 --- a/src/MCP/MCPRepositoryExportRequest.class.st +++ b/src/MCP/MCPRepositoryExportRequest.class.st @@ -28,7 +28,8 @@ MCPRepositoryExportRequest >> commandForTool: aTool [ MCPRepositoryExportRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request + request. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryExportResult.class.st b/src/MCP/MCPRepositoryExportResult.class.st index e573227..c2c6bac 100644 --- a/src/MCP/MCPRepositoryExportResult.class.st +++ b/src/MCP/MCPRepositoryExportResult.class.st @@ -3,10 +3,8 @@ Result DTO returned by repository_export. It reports the repository synchronized " Class { #name : 'MCPRepositoryExportResult', - #superclass : 'Object', + #superclass : 'MCPRepositorySnapshotResult', #instVars : [ - 'repositoryInfo', - 'packageInfos', 'changedPackageNames', 'modifiedPaths', 'didChange', @@ -68,12 +66,7 @@ MCPRepositoryExportResult >> didChange: aBoolean [ { #category : 'initialization' } MCPRepositoryExportResult >> initializeRepository: aRepository changedPackageNames: packageNames modifiedPaths: paths [ - | packages | - repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - packageInfos := packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ]. + self initializeSnapshotFromRepository: aRepository. changedPackageNames := packageNames ifNil: [ #( ) ]. modifiedPaths := paths ifNil: [ #( ) ]. didChange := changedPackageNames notEmpty or: [ @@ -92,30 +85,6 @@ MCPRepositoryExportResult >> modifiedPaths: aCollection [ modifiedPaths := aCollection ifNil: [ #( ) ] ] -{ #category : 'accessing' } -MCPRepositoryExportResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPRepositoryExportResult >> packageInfos: aCollection [ - - packageInfos := aCollection ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPRepositoryExportResult >> repositoryInfo [ - - ^ repositoryInfo -] - -{ #category : 'accessing' } -MCPRepositoryExportResult >> repositoryInfo: aRepositoryInfo [ - - repositoryInfo := aRepositoryInfo -] - { #category : 'accessing' } MCPRepositoryExportResult >> restoredOrderOnlyPaths [ diff --git a/src/MCP/MCPRepositoryFetchRequest.class.st b/src/MCP/MCPRepositoryFetchRequest.class.st index f24e1c0..1401d43 100644 --- a/src/MCP/MCPRepositoryFetchRequest.class.st +++ b/src/MCP/MCPRepositoryFetchRequest.class.st @@ -28,7 +28,8 @@ MCPRepositoryFetchRequest >> commandForTool: aTool [ MCPRepositoryFetchRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request + request. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryFetchResult.class.st b/src/MCP/MCPRepositoryFetchResult.class.st index 5176bd3..399e970 100644 --- a/src/MCP/MCPRepositoryFetchResult.class.st +++ b/src/MCP/MCPRepositoryFetchResult.class.st @@ -3,11 +3,8 @@ Result DTO returned by repository_fetch. It reports repository metadata before a " Class { #name : 'MCPRepositoryFetchResult', - #superclass : 'Object', + #superclass : 'MCPRepositoryTransitionResult', #instVars : [ - 'repositoryInfoBefore', - 'repositoryInfoAfter', - 'packageInfos', 'remoteNames', 'branchName', 'headDescription' @@ -49,50 +46,14 @@ MCPRepositoryFetchResult >> headDescription [ { #category : 'initialization' } MCPRepositoryFetchResult >> initializeRepositoryBefore: beforeInfo after: aRepository [ - repositoryInfoBefore := beforeInfo. - repositoryInfoAfter := MCPRepositoryInfo fromRepository: aRepository. - packageInfos := self packageInfosFromRepository: aRepository. + super initializeRepositoryBefore: beforeInfo after: aRepository. remoteNames := repositoryInfoAfter remoteNames. branchName := repositoryInfoAfter branchName. headDescription := repositoryInfoAfter headDescription ] -{ #category : 'accessing' } -MCPRepositoryFetchResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'private' } -MCPRepositoryFetchResult >> packageInfosFromRepository: aRepository [ - - | packages | - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - ^ packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ] -] - { #category : 'accessing' } MCPRepositoryFetchResult >> remoteNames [ ^ remoteNames ifNil: [ #( ) ] ] - -{ #category : 'accessing' } -MCPRepositoryFetchResult >> repositoryInfo [ - - ^ self repositoryInfoAfter -] - -{ #category : 'accessing' } -MCPRepositoryFetchResult >> repositoryInfoAfter [ - - ^ repositoryInfoAfter -] - -{ #category : 'accessing' } -MCPRepositoryFetchResult >> repositoryInfoBefore [ - - ^ repositoryInfoBefore -] diff --git a/src/MCP/MCPRepositoryPullRequest.class.st b/src/MCP/MCPRepositoryPullRequest.class.st index 59b80f1..87afd70 100644 --- a/src/MCP/MCPRepositoryPullRequest.class.st +++ b/src/MCP/MCPRepositoryPullRequest.class.st @@ -28,7 +28,8 @@ MCPRepositoryPullRequest >> commandForTool: aTool [ MCPRepositoryPullRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request + request. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryPullResult.class.st b/src/MCP/MCPRepositoryPullResult.class.st index f05756f..60e3303 100644 --- a/src/MCP/MCPRepositoryPullResult.class.st +++ b/src/MCP/MCPRepositoryPullResult.class.st @@ -3,11 +3,8 @@ Result DTO returned by repository_pull. It reports repository metadata before an " Class { #name : 'MCPRepositoryPullResult', - #superclass : 'Object', + #superclass : 'MCPRepositoryTransitionResult', #instVars : [ - 'repositoryInfoBefore', - 'repositoryInfoAfter', - 'packageInfos', 'branchName', 'headDescription', 'modifiedPackageNames' @@ -51,9 +48,7 @@ MCPRepositoryPullResult >> headDescription [ { #category : 'initialization' } MCPRepositoryPullResult >> initializeRepositoryBefore: beforeInfo after: aRepository [ - repositoryInfoBefore := beforeInfo. - repositoryInfoAfter := MCPRepositoryInfo fromRepository: aRepository. - packageInfos := self packageInfosFromRepository: aRepository. + super initializeRepositoryBefore: beforeInfo after: aRepository. branchName := repositoryInfoAfter branchName. headDescription := repositoryInfoAfter headDescription. modifiedPackageNames := repositoryInfoAfter modifiedPackageNames @@ -64,37 +59,3 @@ MCPRepositoryPullResult >> modifiedPackageNames [ ^ modifiedPackageNames ifNil: [ #( ) ] ] - -{ #category : 'accessing' } -MCPRepositoryPullResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'private' } -MCPRepositoryPullResult >> packageInfosFromRepository: aRepository [ - - | packages | - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - ^ packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ] -] - -{ #category : 'accessing' } -MCPRepositoryPullResult >> repositoryInfo [ - - ^ self repositoryInfoAfter -] - -{ #category : 'accessing' } -MCPRepositoryPullResult >> repositoryInfoAfter [ - - ^ repositoryInfoAfter -] - -{ #category : 'accessing' } -MCPRepositoryPullResult >> repositoryInfoBefore [ - - ^ repositoryInfoBefore -] diff --git a/src/MCP/MCPRepositoryPushRequest.class.st b/src/MCP/MCPRepositoryPushRequest.class.st index 69d1f4e..de4a82e 100644 --- a/src/MCP/MCPRepositoryPushRequest.class.st +++ b/src/MCP/MCPRepositoryPushRequest.class.st @@ -28,7 +28,8 @@ MCPRepositoryPushRequest >> commandForTool: aTool [ MCPRepositoryPushRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request + request. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryPushResult.class.st b/src/MCP/MCPRepositoryPushResult.class.st index cc524d4..00ea224 100644 --- a/src/MCP/MCPRepositoryPushResult.class.st +++ b/src/MCP/MCPRepositoryPushResult.class.st @@ -3,10 +3,8 @@ Result DTO returned by repository_push. It reports repository metadata, remote n " Class { #name : 'MCPRepositoryPushResult', - #superclass : 'Object', + #superclass : 'MCPRepositorySnapshotResult', #instVars : [ - 'repositoryInfo', - 'packageInfos', 'remoteNames', 'branchName', 'headDescription' @@ -48,37 +46,14 @@ MCPRepositoryPushResult >> headDescription [ { #category : 'initialization' } MCPRepositoryPushResult >> initializeRepository: aRepository [ - repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packageInfos := self packageInfosFromRepository: aRepository. + self initializeSnapshotFromRepository: aRepository. remoteNames := repositoryInfo remoteNames. branchName := repositoryInfo branchName. headDescription := repositoryInfo headDescription ] -{ #category : 'accessing' } -MCPRepositoryPushResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'private' } -MCPRepositoryPushResult >> packageInfosFromRepository: aRepository [ - - | packages | - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - ^ packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ] -] - { #category : 'accessing' } MCPRepositoryPushResult >> remoteNames [ ^ remoteNames ifNil: [ #( ) ] ] - -{ #category : 'accessing' } -MCPRepositoryPushResult >> repositoryInfo [ - - ^ repositoryInfo -] diff --git a/src/MCP/MCPRepositoryReferenceSpec.class.st b/src/MCP/MCPRepositoryReferenceSpec.class.st index c1874bb..e34e3e8 100644 --- a/src/MCP/MCPRepositoryReferenceSpec.class.st +++ b/src/MCP/MCPRepositoryReferenceSpec.class.st @@ -55,7 +55,8 @@ MCPRepositoryReferenceSpec >> hasName [ MCPRepositoryReferenceSpec >> initializeName: aName location: aLocation [ name := aName. - location := aLocation + location := aLocation. + ^ self ] { #category : 'testing' } diff --git a/src/MCP/MCPRepositoryResult.class.st b/src/MCP/MCPRepositoryResult.class.st new file mode 100644 index 0000000..5b8d8ce --- /dev/null +++ b/src/MCP/MCPRepositoryResult.class.st @@ -0,0 +1,30 @@ +" +Abstract base for repository result DTOs. It owns shared repository snapshot helpers used by concrete repository tool results while leaving each result class responsible for its own public payload shape. +" +Class { + #name : 'MCPRepositoryResult', + #superclass : 'Object', + #category : 'MCP-Results', + #package : 'MCP', + #tag : 'Results' +} + +{ #category : 'testing' } +MCPRepositoryResult class >> isAbstract [ + + ^ self = MCPRepositoryResult +] + +{ #category : 'private' } +MCPRepositoryResult >> packageInfosFromRepository: aRepository [ + + ^ (aRepository workingCopy packages asArray sort: [ :left :right | + left name asString <= right name asString ]) collect: [ :each | + MCPRepositoryPackageInfo fromPackage: each ] +] + +{ #category : 'private' } +MCPRepositoryResult >> repositoryInfoFromRepository: aRepository [ + + ^ MCPRepositoryInfo fromRepository: aRepository +] diff --git a/src/MCP/MCPRepositorySnapshotResult.class.st b/src/MCP/MCPRepositorySnapshotResult.class.st new file mode 100644 index 0000000..8578d2a --- /dev/null +++ b/src/MCP/MCPRepositorySnapshotResult.class.st @@ -0,0 +1,57 @@ +" +Abstract base for repository result DTOs that represent one repository snapshot. Subclasses add operation-specific fields while this class owns the common repository and package summary state. +" +Class { + #name : 'MCPRepositorySnapshotResult', + #superclass : 'MCPRepositoryResult', + #instVars : [ + 'repositoryInfo', + 'packageInfos' + ], + #category : 'MCP-Results', + #package : 'MCP', + #tag : 'Results' +} + +{ #category : 'testing' } +MCPRepositorySnapshotResult class >> isAbstract [ + + ^ self = MCPRepositorySnapshotResult +] + +{ #category : 'initialization' } +MCPRepositorySnapshotResult >> initializeFromRepository: aRepository [ + + self initializeSnapshotFromRepository: aRepository +] + +{ #category : 'initialization' } +MCPRepositorySnapshotResult >> initializeSnapshotFromRepository: aRepository [ + + repositoryInfo := self repositoryInfoFromRepository: aRepository. + packageInfos := self packageInfosFromRepository: aRepository +] + +{ #category : 'accessing' } +MCPRepositorySnapshotResult >> packageInfos [ + + ^ packageInfos ifNil: [ #( ) ] +] + +{ #category : 'accessing' } +MCPRepositorySnapshotResult >> packageInfos: aCollection [ + + packageInfos := aCollection ifNil: [ #( ) ] +] + +{ #category : 'accessing' } +MCPRepositorySnapshotResult >> repositoryInfo [ + + ^ repositoryInfo +] + +{ #category : 'accessing' } +MCPRepositorySnapshotResult >> repositoryInfo: aRepositoryInfo [ + + repositoryInfo := aRepositoryInfo +] diff --git a/src/MCP/MCPRepositorySwitchBranchRequest.class.st b/src/MCP/MCPRepositorySwitchBranchRequest.class.st index 0397c16..6623f02 100644 --- a/src/MCP/MCPRepositorySwitchBranchRequest.class.st +++ b/src/MCP/MCPRepositorySwitchBranchRequest.class.st @@ -36,7 +36,8 @@ MCPRepositorySwitchBranchRequest >> initializeFromRequest: request [ repositoryReference := MCPRepositoryReferenceSpec fromRequest: request. - branchName := request stringArgumentNamed: 'branchName' + branchName := request stringArgumentNamed: 'branchName'. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryTransitionResult.class.st b/src/MCP/MCPRepositoryTransitionResult.class.st new file mode 100644 index 0000000..e90d964 --- /dev/null +++ b/src/MCP/MCPRepositoryTransitionResult.class.st @@ -0,0 +1,53 @@ +" +Abstract base for repository result DTOs that report a repository transition. It owns the before snapshot, after snapshot, and package summary shared by branch, fetch, pull, and adopt-head operations. +" +Class { + #name : 'MCPRepositoryTransitionResult', + #superclass : 'MCPRepositoryResult', + #instVars : [ + 'repositoryInfoBefore', + 'repositoryInfoAfter', + 'packageInfos' + ], + #category : 'MCP-Results', + #package : 'MCP', + #tag : 'Results' +} + +{ #category : 'testing' } +MCPRepositoryTransitionResult class >> isAbstract [ + + ^ self = MCPRepositoryTransitionResult +] + +{ #category : 'initialization' } +MCPRepositoryTransitionResult >> initializeRepositoryBefore: beforeInfo after: aRepository [ + + repositoryInfoBefore := beforeInfo. + repositoryInfoAfter := self repositoryInfoFromRepository: aRepository. + packageInfos := self packageInfosFromRepository: aRepository +] + +{ #category : 'accessing' } +MCPRepositoryTransitionResult >> packageInfos [ + + ^ packageInfos ifNil: [ #( ) ] +] + +{ #category : 'accessing' } +MCPRepositoryTransitionResult >> repositoryInfo [ + + ^ self repositoryInfoAfter +] + +{ #category : 'accessing' } +MCPRepositoryTransitionResult >> repositoryInfoAfter [ + + ^ repositoryInfoAfter +] + +{ #category : 'accessing' } +MCPRepositoryTransitionResult >> repositoryInfoBefore [ + + ^ repositoryInfoBefore +] diff --git a/src/MCP/MCPRepositoryUpdateRequest.class.st b/src/MCP/MCPRepositoryUpdateRequest.class.st index 1850371..1f3ee75 100644 --- a/src/MCP/MCPRepositoryUpdateRequest.class.st +++ b/src/MCP/MCPRepositoryUpdateRequest.class.st @@ -72,7 +72,8 @@ MCPRepositoryUpdateRequest >> initializeFromRequest: request [ addPackageNames := request stringCollectionArgumentNamed: 'addPackageNames'. removePackageNames := request stringCollectionArgumentNamed: - 'removePackageNames' + 'removePackageNames'. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryUpdateResult.class.st b/src/MCP/MCPRepositoryUpdateResult.class.st index 9c310ee..165ec9c 100644 --- a/src/MCP/MCPRepositoryUpdateResult.class.st +++ b/src/MCP/MCPRepositoryUpdateResult.class.st @@ -3,10 +3,8 @@ Result DTO returned by repository_update. It reports the repository after applyi " Class { #name : 'MCPRepositoryUpdateResult', - #superclass : 'Object', + #superclass : 'MCPRepositorySnapshotResult', #instVars : [ - 'repositoryInfo', - 'packageInfos', 'updateActions', 'addedPackageNames', 'removedPackageNames' @@ -55,29 +53,12 @@ MCPRepositoryUpdateResult >> asDictionary [ { #category : 'initialization' } MCPRepositoryUpdateResult >> initializeRepository: aRepository updateActions: actionNames addedPackageNames: addedNames removedPackageNames: removedNames [ - | packages | - repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - packageInfos := packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ]. + self initializeSnapshotFromRepository: aRepository. updateActions := actionNames ifNil: [ #( ) ]. addedPackageNames := addedNames ifNil: [ #( ) ]. removedPackageNames := removedNames ifNil: [ #( ) ] ] -{ #category : 'accessing' } -MCPRepositoryUpdateResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPRepositoryUpdateResult >> packageInfos: aCollection [ - - packageInfos := aCollection ifNil: [ #( ) ] -] - { #category : 'accessing' } MCPRepositoryUpdateResult >> removedPackageNames [ @@ -90,18 +71,6 @@ MCPRepositoryUpdateResult >> removedPackageNames: aCollection [ removedPackageNames := aCollection ifNil: [ #( ) ] ] -{ #category : 'accessing' } -MCPRepositoryUpdateResult >> repositoryInfo [ - - ^ repositoryInfo -] - -{ #category : 'accessing' } -MCPRepositoryUpdateResult >> repositoryInfo: aRepositoryInfo [ - - repositoryInfo := aRepositoryInfo -] - { #category : 'accessing' } MCPRepositoryUpdateResult >> updateActions [ diff --git a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st index e1a71c7..4dddf75 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st @@ -172,7 +172,8 @@ MCPRepositoryVerifyIdentityCommand >> execute [ MCPRepositoryVerifyIdentityCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'private - resolving' } diff --git a/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st b/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st index d8374d1..054b018 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st @@ -82,24 +82,21 @@ MCPRepositoryVerifyIdentityRequest >> initializeFromRequest: request [ branchName := request stringArgumentNamed: 'branchName'. hasSubdirectory := request hasArgumentNamed: 'subdirectory'. hasPackageNames := request hasArgumentNamed: 'packageNames'. - hasModifiedPackageNames := request hasArgumentNamed: - 'modifiedPackageNames'. + hasModifiedPackageNames := request hasArgumentNamed: 'modifiedPackageNames'. hasIsModified := request hasArgumentNamed: 'isModified'. hasSubdirectory ifTrue: [ - subdirectory := self - stringArgumentNamed: 'subdirectory' - preservingEmptyFrom: request ]. + subdirectory := self + stringArgumentNamed: 'subdirectory' + preservingEmptyFrom: request ]. hasPackageNames ifTrue: [ - packageNames := request uniqueStringCollectionArgumentNamed: - 'packageNames' ]. + packageNames := request uniqueStringCollectionArgumentNamed: + 'packageNames' ]. hasModifiedPackageNames ifTrue: [ - modifiedPackageNames := request - uniqueStringCollectionArgumentNamed: - 'modifiedPackageNames' ]. + modifiedPackageNames := request uniqueStringCollectionArgumentNamed: + 'modifiedPackageNames' ]. hasIsModified ifTrue: [ - isModified := request - booleanArgumentNamed: 'isModified' - default: false ] + isModified := request booleanArgumentNamed: 'isModified' default: false ]. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryVerifyIdentityResult.class.st b/src/MCP/MCPRepositoryVerifyIdentityResult.class.st index 9a74881..16f92da 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityResult.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityResult.class.st @@ -3,10 +3,8 @@ Result DTO returned by repository_identity_verify. It reports the repository sna " Class { #name : 'MCPRepositoryVerifyIdentityResult', - #superclass : 'Object', + #superclass : 'MCPRepositorySnapshotResult', #instVars : [ - 'repositoryInfo', - 'packageInfos', 'checkedFields', 'matched' ], @@ -38,8 +36,7 @@ MCPRepositoryVerifyIdentityResult >> checkedFields [ { #category : 'initialization' } MCPRepositoryVerifyIdentityResult >> initializeRepository: aRepository checkedFields: fieldNames [ - repositoryInfo := MCPRepositoryInfo fromRepository: aRepository. - packageInfos := self packageInfosFromRepository: aRepository. + self initializeSnapshotFromRepository: aRepository. checkedFields := fieldNames ifNil: [ #( ) ]. matched := true ] @@ -49,25 +46,3 @@ MCPRepositoryVerifyIdentityResult >> matched [ ^ matched ifNil: [ false ] ] - -{ #category : 'accessing' } -MCPRepositoryVerifyIdentityResult >> packageInfos [ - - ^ packageInfos ifNil: [ #( ) ] -] - -{ #category : 'private' } -MCPRepositoryVerifyIdentityResult >> packageInfosFromRepository: aRepository [ - - | packages | - packages := aRepository workingCopy packages sort: [ :left :right | - left name <= right name ]. - ^ packages collect: [ :each | - MCPRepositoryPackageInfo fromPackage: each ] -] - -{ #category : 'accessing' } -MCPRepositoryVerifyIdentityResult >> repositoryInfo [ - - ^ repositoryInfo -] diff --git a/src/MCP/MCPRepositoryWorkingCopyCommand.class.st b/src/MCP/MCPRepositoryWorkingCopyCommand.class.st index fd2a8b2..442dde1 100644 --- a/src/MCP/MCPRepositoryWorkingCopyCommand.class.st +++ b/src/MCP/MCPRepositoryWorkingCopyCommand.class.st @@ -53,7 +53,8 @@ MCPRepositoryWorkingCopyCommand >> changedPackageNamesFromDiff: aDiff [ MCPRepositoryWorkingCopyCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'private - diff' } diff --git a/src/MCP/MCPRewriteMethodsCommand.class.st b/src/MCP/MCPRewriteMethodsCommand.class.st index 83d5e49..37d6c34 100644 --- a/src/MCP/MCPRewriteMethodsCommand.class.st +++ b/src/MCP/MCPRewriteMethodsCommand.class.st @@ -115,7 +115,8 @@ MCPRewriteMethodsCommand >> hashForChange: aChange [ MCPRewriteMethodsCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'private - rewriting' } diff --git a/src/MCP/MCPRunTestsCommand.class.st b/src/MCP/MCPRunTestsCommand.class.st index fa0ca98..b9aa8bc 100644 --- a/src/MCP/MCPRunTestsCommand.class.st +++ b/src/MCP/MCPRunTestsCommand.class.st @@ -108,7 +108,8 @@ MCPRunTestsCommand >> hasTimedOutAt: deadline [ MCPRunTestsCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'private - timeout' } diff --git a/src/MCP/MCPRunTestsRequest.class.st b/src/MCP/MCPRunTestsRequest.class.st index cbbd3eb..b4c3805 100644 --- a/src/MCP/MCPRunTestsRequest.class.st +++ b/src/MCP/MCPRunTestsRequest.class.st @@ -90,7 +90,8 @@ MCPRunTestsRequest >> initializeTestRequests: aCollection timeoutMilliseconds: a testRequests := aCollection. timeoutMilliseconds := anInteger. operation := operationString ifNil: [ 'run' ]. - coverageRequest := aCoverageRequest + coverageRequest := aCoverageRequest. + ^ self ] { #category : 'testing' } diff --git a/src/MCP/MCPRunTestsResult.class.st b/src/MCP/MCPRunTestsResult.class.st index c70d405..74080a8 100644 --- a/src/MCP/MCPRunTestsResult.class.st +++ b/src/MCP/MCPRunTestsResult.class.st @@ -57,7 +57,8 @@ MCPRunTestsResult >> initializeResults: resultCollection timedOut: aBoolean unru results := resultCollection asArray. timedOut := aBoolean. - unrunTests := testCollection asArray + unrunTests := testCollection asArray. + ^ self ] { #category : 'converting' } diff --git a/src/MCP/MCPScreenshotCommand.class.st b/src/MCP/MCPScreenshotCommand.class.st index a6f41dc..4c95335 100644 --- a/src/MCP/MCPScreenshotCommand.class.st +++ b/src/MCP/MCPScreenshotCommand.class.st @@ -74,7 +74,8 @@ MCPScreenshotCommand >> initializeTool: aTool request: aRequest formProvider: aB tool := aTool. request := aRequest. - formProvider := aBlock ifNil: [ [ self captureWorldForm ] ] + formProvider := aBlock ifNil: [ [ self captureWorldForm ] ]. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPScreenshotRequest.class.st b/src/MCP/MCPScreenshotRequest.class.st index 47ee0df..e0a3968 100644 --- a/src/MCP/MCPScreenshotRequest.class.st +++ b/src/MCP/MCPScreenshotRequest.class.st @@ -29,7 +29,8 @@ MCPScreenshotRequest class >> fromRequest: aRequest tool: aTool [ MCPScreenshotRequest >> initializeTarget: targetString targetIdentifier: identifierString [ target := targetString ifNil: [ 'world' ]. - targetIdentifier := identifierString + targetIdentifier := identifierString. + ^ self ] { #category : 'testing' } diff --git a/src/MCP/MCPScreenshotResult.class.st b/src/MCP/MCPScreenshotResult.class.st index 3464fda..b8122fa 100644 --- a/src/MCP/MCPScreenshotResult.class.st +++ b/src/MCP/MCPScreenshotResult.class.st @@ -55,7 +55,8 @@ MCPScreenshotResult >> initializeTarget: targetString width: widthInteger height target := targetString. width := widthInteger. height := heightInteger. - imageContent := anImageContent + imageContent := anImageContent. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPSwitchRepositoryBranchCommand.class.st b/src/MCP/MCPSwitchRepositoryBranchCommand.class.st index afa3cd5..298c048 100644 --- a/src/MCP/MCPSwitchRepositoryBranchCommand.class.st +++ b/src/MCP/MCPSwitchRepositoryBranchCommand.class.st @@ -50,7 +50,8 @@ MCPSwitchRepositoryBranchCommand >> execute [ MCPSwitchRepositoryBranchCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPTestCoverageRequest.class.st b/src/MCP/MCPTestCoverageRequest.class.st index 41d6576..c533f8f 100644 --- a/src/MCP/MCPTestCoverageRequest.class.st +++ b/src/MCP/MCPTestCoverageRequest.class.st @@ -119,8 +119,9 @@ MCPTestCoverageRequest >> includeCoveredMethods [ MCPTestCoverageRequest >> initializeScopeQuery: aScopeQuery includeCoveredMethods: aBoolean methodLimit: anInteger [ scopeQuery := aScopeQuery. - includeCoveredMethods := aBoolean == true. - methodLimit := anInteger + includeCoveredMethods := aBoolean = true. + methodLimit := anInteger. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPTestCoverageResult.class.st b/src/MCP/MCPTestCoverageResult.class.st index dc3cbf1..7543fa1 100644 --- a/src/MCP/MCPTestCoverageResult.class.st +++ b/src/MCP/MCPTestCoverageResult.class.st @@ -109,7 +109,8 @@ MCPTestCoverageResult >> initializeCoverageResult: aCoverageResult includeCovere coverageResult := aCoverageResult. includeCoveredMethods := aBoolean = true. methodLimit := anInteger. - partiallyCoveredMethods := partialMethods ifNil: [ #( ) ] + partiallyCoveredMethods := partialMethods ifNil: [ #( ) ]. + ^ self ] { #category : 'private - methods' } diff --git a/src/MCP/MCPTestRunInfo.class.st b/src/MCP/MCPTestRunInfo.class.st index 305c4b4..669844e 100644 --- a/src/MCP/MCPTestRunInfo.class.st +++ b/src/MCP/MCPTestRunInfo.class.st @@ -80,7 +80,8 @@ MCPTestRunInfo >> initializeValidatedRequest: validatedRequest selectedTestCount skippedCount := aResult skippedCount. failureCount := aResult failureCount. errorCount := aResult errorCount. - issues := issueCollection ifNil: [ #( ) ] + issues := issueCollection ifNil: [ #( ) ]. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPTestRunRequest.class.st b/src/MCP/MCPTestRunRequest.class.st index 8df8174..0c80fba 100644 --- a/src/MCP/MCPTestRunRequest.class.st +++ b/src/MCP/MCPTestRunRequest.class.st @@ -72,7 +72,8 @@ MCPTestRunRequest >> hasTestMethod [ MCPTestRunRequest >> initializeClassName: aClassName testMethodName: aTestMethodName [ className := aClassName. - testMethodName := aTestMethodName + testMethodName := aTestMethodName. + ^ self ] { #category : 'printing' } diff --git a/src/MCP/MCPTestRunResult.class.st b/src/MCP/MCPTestRunResult.class.st index d01f0b1..e631078 100644 --- a/src/MCP/MCPTestRunResult.class.st +++ b/src/MCP/MCPTestRunResult.class.st @@ -48,7 +48,8 @@ MCPTestRunResult >> initializeResultInfo: resultInfoOrNil timedOut: aBoolean unr resultInfo := resultInfoOrNil. timedOut := aBoolean. - unrunTestRequests := testRequests ifNil: [ #( ) ] + unrunTestRequests := testRequests ifNil: [ #( ) ]. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPToolRequest.class.st b/src/MCP/MCPToolRequest.class.st index 6fcda85..298cd3c 100644 --- a/src/MCP/MCPToolRequest.class.st +++ b/src/MCP/MCPToolRequest.class.st @@ -265,7 +265,8 @@ MCPToolRequest >> validate [ schema: self tool inputSchema. violations ifNotEmpty: [ MCPInvalidToolInput signalForTool: self tool violations: violations ]. - self tool validateRequest: self + self tool validateRequest: self. + ^ self ] { #category : 'private - accessing' } diff --git a/src/MCP/MCPUpdateClassCommand.class.st b/src/MCP/MCPUpdateClassCommand.class.st index 6397a3e..8c5fa01 100644 --- a/src/MCP/MCPUpdateClassCommand.class.st +++ b/src/MCP/MCPUpdateClassCommand.class.st @@ -523,7 +523,8 @@ MCPUpdateClassCommand >> executeSetCommentWithPlan: plan [ MCPUpdateClassCommand >> initializeTool: aTool request: aClassRequest [ tool := aTool. - classRequest := aClassRequest + classRequest := aClassRequest. + ^ self ] { #category : 'private - move' } diff --git a/src/MCP/MCPUpdateDebugMethodRequest.class.st b/src/MCP/MCPUpdateDebugMethodRequest.class.st index 14193bc..e4da64a 100644 --- a/src/MCP/MCPUpdateDebugMethodRequest.class.st +++ b/src/MCP/MCPUpdateDebugMethodRequest.class.st @@ -62,7 +62,8 @@ MCPUpdateDebugMethodRequest >> ignoreCritiques [ { #category : 'accessing' } MCPUpdateDebugMethodRequest >> ignoreCritiques: aBoolean [ - ignoreCritiques := aBoolean + ignoreCritiques := aBoolean. + ^ self ] { #category : 'accessing' } diff --git a/src/MCP/MCPUpdateMethodCommand.class.st b/src/MCP/MCPUpdateMethodCommand.class.st index 8c4239f..dbc13bb 100644 --- a/src/MCP/MCPUpdateMethodCommand.class.st +++ b/src/MCP/MCPUpdateMethodCommand.class.st @@ -341,7 +341,8 @@ MCPUpdateMethodCommand >> executeRenameWithPlan: plan [ MCPUpdateMethodCommand >> initializeTool: aTool request: aRequest [ tool := aTool. - request := aRequest + request := aRequest. + ^ self ] { #category : 'private - methods' } diff --git a/src/MCP/MCPUpdateRepositoryCommand.class.st b/src/MCP/MCPUpdateRepositoryCommand.class.st index ae548c7..33586bc 100644 --- a/src/MCP/MCPUpdateRepositoryCommand.class.st +++ b/src/MCP/MCPUpdateRepositoryCommand.class.st @@ -89,7 +89,8 @@ MCPUpdateRepositoryCommand >> initializeTool: aTool request: aRequest [ tool := aTool. request := aRequest. addedPackageNames := OrderedCollection new. - removedPackageNames := OrderedCollection new + removedPackageNames := OrderedCollection new. + ^ self ] { #category : 'private' } diff --git a/src/MCP/MCPValidatedTestRunRequest.class.st b/src/MCP/MCPValidatedTestRunRequest.class.st index 6bbc568..d4f600e 100644 --- a/src/MCP/MCPValidatedTestRunRequest.class.st +++ b/src/MCP/MCPValidatedTestRunRequest.class.st @@ -49,7 +49,8 @@ MCPValidatedTestRunRequest >> hasTestMethod [ MCPValidatedTestRunRequest >> initializeRequest: aTestRunRequest testClass: aTestClass [ testRunRequest := aTestRunRequest. - testClass := aTestClass + testClass := aTestClass. + ^ self ] { #category : 'accessing' } From c2db082d7215d0548d99eb2ef85e3d1803ca8ad3 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Wed, 24 Jun 2026 17:56:34 +0200 Subject: [PATCH 04/21] Introduce repository command base Co-authored-by: Codex --- .../MCPAdoptRepositoryHeadCommand.class.st | 40 +--------- src/MCP/MCPAttachRepositoryCommand.class.st | 6 +- ...CPCheckoutRepositoryBranchCommand.class.st | 39 +--------- src/MCP/MCPCommitRepositoryCommand.class.st | 6 +- .../MCPCreateRepositoryBranchCommand.class.st | 66 +++++----------- src/MCP/MCPCreateRepositoryCommand.class.st | 58 ++++---------- src/MCP/MCPExportRepositoryCommand.class.st | 6 +- src/MCP/MCPFetchRepositoryCommand.class.st | 64 ++++------------ src/MCP/MCPLoadRepositoryCommand.class.st | 32 +------- src/MCP/MCPPullRepositoryCommand.class.st | 64 ++++------------ src/MCP/MCPPushRepositoryCommand.class.st | 58 ++++---------- src/MCP/MCPRepositoryCommand.class.st | 59 ++++++++++++++ src/MCP/MCPRepositoryDiffCommand.class.st | 40 +++++----- ...CPRepositoryVerifyIdentityCommand.class.st | 65 ++++------------ .../MCPRepositoryWorkingCopyCommand.class.st | 34 +-------- .../MCPSwitchRepositoryBranchCommand.class.st | 66 +++++----------- src/MCP/MCPUpdateRepositoryCommand.class.st | 76 +++++++------------ 17 files changed, 228 insertions(+), 551 deletions(-) create mode 100644 src/MCP/MCPRepositoryCommand.class.st diff --git a/src/MCP/MCPAdoptRepositoryHeadCommand.class.st b/src/MCP/MCPAdoptRepositoryHeadCommand.class.st index 6e816fe..558af11 100644 --- a/src/MCP/MCPAdoptRepositoryHeadCommand.class.st +++ b/src/MCP/MCPAdoptRepositoryHeadCommand.class.st @@ -3,22 +3,12 @@ Command wrapper for repository_head_adopt. It asks the Iceberg working copy to a " Class { #name : 'MCPAdoptRepositoryHeadCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPAdoptRepositoryHeadCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'private' } MCPAdoptRepositoryHeadCommand >> commit: leftCommit equals: rightCommit [ @@ -37,10 +27,8 @@ MCPAdoptRepositoryHeadCommand >> commitIdFrom: aCommit [ MCPAdoptRepositoryHeadCommand >> execute [ | beforeInfo didAdopt headCommit previousReferenceCommit repository result | - ^ self tool - executeMutationAction: 'adoptHead' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'adoptHead' work: [ repository := self request repository. self validateExpectedBranchFor: repository. @@ -66,30 +54,16 @@ MCPAdoptRepositoryHeadCommand >> execute [ data: (self tool dataForRepositoryAdoptHeadResult: result) warnings: warningMessages ] failureSummary: [ :error | - 'Failed to adopt repository HEAD: ' + 'Failed adopt repository HEAD: ' , (error messageText ifNil: [ error asString ]) ] ] -{ #category : 'initialization' } -MCPAdoptRepositoryHeadCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - { #category : 'private' } MCPAdoptRepositoryHeadCommand >> referenceCommitFor: aRepository [ ^ aRepository workingCopy referenceCommit ] -{ #category : 'accessing' } -MCPAdoptRepositoryHeadCommand >> request [ - - ^ request -] - { #category : 'private - validation' } MCPAdoptRepositoryHeadCommand >> signalMissingHeadCommitFor: aRepository [ @@ -102,12 +76,6 @@ MCPAdoptRepositoryHeadCommand >> signalMissingHeadCommitFor: aRepository [ yourself) ] -{ #category : 'accessing' } -MCPAdoptRepositoryHeadCommand >> tool [ - - ^ tool -] - { #category : 'private - validation' } MCPAdoptRepositoryHeadCommand >> validateExpectedBranchFor: aRepository [ diff --git a/src/MCP/MCPAttachRepositoryCommand.class.st b/src/MCP/MCPAttachRepositoryCommand.class.st index 14b9649..46bd42d 100644 --- a/src/MCP/MCPAttachRepositoryCommand.class.st +++ b/src/MCP/MCPAttachRepositoryCommand.class.st @@ -31,10 +31,8 @@ MCPAttachRepositoryCommand >> createRepository [ MCPAttachRepositoryCommand >> execute [ | repository result | - ^ self tool - executeMutationAction: 'attach' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'attach' work: [ repository := self createRepository. self addRequestedPackagesTo: repository. diff --git a/src/MCP/MCPCheckoutRepositoryBranchCommand.class.st b/src/MCP/MCPCheckoutRepositoryBranchCommand.class.st index dd60fa6..cb8b68a 100644 --- a/src/MCP/MCPCheckoutRepositoryBranchCommand.class.st +++ b/src/MCP/MCPCheckoutRepositoryBranchCommand.class.st @@ -3,30 +3,18 @@ Command wrapper for repository_branch_checkout. It asks Iceberg to check out the " Class { #name : 'MCPCheckoutRepositoryBranchCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPCheckoutRepositoryBranchCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'executing' } MCPCheckoutRepositoryBranchCommand >> execute [ | beforeInfo branch repository result | - ^ self tool - executeMutationAction: 'checkoutBranch' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'checkoutBranch' work: [ repository := self request repository. beforeInfo := MCPRepositoryInfo fromRepository: repository. @@ -39,29 +27,10 @@ MCPCheckoutRepositoryBranchCommand >> execute [ self tool successResultText: 'Checked out repository ' , result repositoryInfo name - , ' to branch ' , self request branchName , '.' + , ' branch ' , self request branchName , '.' data: (self tool dataForRepositoryCheckoutBranchResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to check out repository branch: ' , (error messageText ifNil: [ error asString ]) ] ] - -{ #category : 'initialization' } -MCPCheckoutRepositoryBranchCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest -] - -{ #category : 'accessing' } -MCPCheckoutRepositoryBranchCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPCheckoutRepositoryBranchCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPCommitRepositoryCommand.class.st b/src/MCP/MCPCommitRepositoryCommand.class.st index e394d84..1c0facc 100644 --- a/src/MCP/MCPCommitRepositoryCommand.class.st +++ b/src/MCP/MCPCommitRepositoryCommand.class.st @@ -13,10 +13,8 @@ Class { MCPCommitRepositoryCommand >> execute [ | changedPackageNames diff repository result | - ^ self tool - executeMutationAction: 'commit' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'commit' work: [ repository := self request repository. (self repositoryHasChangesToCommit: repository) ifFalse: [ diff --git a/src/MCP/MCPCreateRepositoryBranchCommand.class.st b/src/MCP/MCPCreateRepositoryBranchCommand.class.st index e05265f..006c09a 100644 --- a/src/MCP/MCPCreateRepositoryBranchCommand.class.st +++ b/src/MCP/MCPCreateRepositoryBranchCommand.class.st @@ -3,65 +3,33 @@ Command wrapper for repository_branch_create. It calls IceRepository>>createBran " Class { #name : 'MCPCreateRepositoryBranchCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPCreateRepositoryBranchCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'executing' } MCPCreateRepositoryBranchCommand >> execute [ | beforeInfo repository result | - ^ self tool - executeMutationAction: 'createBranch' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'createBranch' work: [ - repository := self request repository. - beforeInfo := MCPRepositoryInfo fromRepository: repository. - repository createBranch: self request branchName. - result := MCPRepositoryBranchResult - repositoryBefore: beforeInfo - after: repository ] + repository := self request repository. + beforeInfo := MCPRepositoryInfo fromRepository: repository. + repository createBranch: self request branchName. + result := MCPRepositoryBranchResult + repositoryBefore: beforeInfo + after: repository ] successResult: [ :warningMessages | - self tool - successResultText: - 'Created branch ' , self request branchName , ' in repository ' - , result repositoryInfo name , '.' - data: (self tool dataForRepositoryCreateBranchResult: result) - warnings: warningMessages ] + self tool + successResultText: + 'Created branch ' , self request branchName + , ' in repository ' , result repositoryInfo name , '.' + data: (self tool dataForRepositoryCreateBranchResult: result) + warnings: warningMessages ] failureSummary: [ :error | - 'Failed to create repository branch: ' - , (error messageText ifNil: [ error asString ]) ] -] - -{ #category : 'initialization' } -MCPCreateRepositoryBranchCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPCreateRepositoryBranchCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPCreateRepositoryBranchCommand >> tool [ - - ^ tool + 'Failed to create repository branch: ' + , (error messageText ifNil: [ error asString ]) ] ] diff --git a/src/MCP/MCPCreateRepositoryCommand.class.st b/src/MCP/MCPCreateRepositoryCommand.class.st index bb46031..e868448 100644 --- a/src/MCP/MCPCreateRepositoryCommand.class.st +++ b/src/MCP/MCPCreateRepositoryCommand.class.st @@ -3,22 +3,12 @@ Command wrapper for repository_create. It creates an Iceberg repository through " Class { #name : 'MCPCreateRepositoryCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPCreateRepositoryCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'private' } MCPCreateRepositoryCommand >> addRequestedPackagesTo: aRepository [ @@ -43,41 +33,19 @@ MCPCreateRepositoryCommand >> createRepository [ MCPCreateRepositoryCommand >> execute [ | repository result | - ^ self tool - executeMutationAction: 'create' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'create' work: [ - repository := self createRepository. - self addRequestedPackagesTo: repository. - result := MCPRepositoryCreateResult fromRepository: repository ] + repository := self createRepository. + self addRequestedPackagesTo: repository. + result := MCPRepositoryCreateResult fromRepository: repository ] successResult: [ :warningMessages | - self tool - successResultText: - 'Created repository ' , self request name , '.' - data: (self tool dataForRepositoryCreateResult: result) - warnings: warningMessages ] + self tool + successResultText: + 'Created repository ' , self request name , '.' + data: (self tool dataForRepositoryCreateResult: result) + warnings: warningMessages ] failureSummary: [ :error | - 'Failed to create repository ' , self request name , ': ' - , (error messageText ifNil: [ error asString ]) ] -] - -{ #category : 'initialization' } -MCPCreateRepositoryCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPCreateRepositoryCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPCreateRepositoryCommand >> tool [ - - ^ tool + 'Failed create repository ' , self request name , ': ' + , (error messageText ifNil: [ error asString ]) ] ] diff --git a/src/MCP/MCPExportRepositoryCommand.class.st b/src/MCP/MCPExportRepositoryCommand.class.st index e62e2f9..c98090b 100644 --- a/src/MCP/MCPExportRepositoryCommand.class.st +++ b/src/MCP/MCPExportRepositoryCommand.class.st @@ -13,10 +13,8 @@ Class { MCPExportRepositoryCommand >> execute [ | changedPackageNames diff modifiedPaths repository result restoredOrderOnlyPaths tonelSnapshot | - ^ self tool - executeMutationAction: 'export' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'export' work: [ repository := self request repository. diff := repository workingCopyDiff. diff --git a/src/MCP/MCPFetchRepositoryCommand.class.st b/src/MCP/MCPFetchRepositoryCommand.class.st index dd4db4d..cd62320 100644 --- a/src/MCP/MCPFetchRepositoryCommand.class.st +++ b/src/MCP/MCPFetchRepositoryCommand.class.st @@ -3,64 +3,32 @@ Command wrapper for repository_fetch. It calls IceRepository>>fetch and returns " Class { #name : 'MCPFetchRepositoryCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPFetchRepositoryCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'executing' } MCPFetchRepositoryCommand >> execute [ | beforeInfo repository result | - ^ self tool - executeMutationAction: 'fetch' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'fetch' work: [ - repository := self request repository. - beforeInfo := MCPRepositoryInfo fromRepository: repository. - repository fetch. - result := MCPRepositoryFetchResult - repositoryBefore: beforeInfo - after: repository ] + repository := self request repository. + beforeInfo := MCPRepositoryInfo fromRepository: repository. + repository fetch. + result := MCPRepositoryFetchResult + repositoryBefore: beforeInfo + after: repository ] successResult: [ :warningMessages | - self tool - successResultText: - 'Fetched repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryFetchResult: result) - warnings: warningMessages ] + self tool + successResultText: + 'Fetched repository ' , result repositoryInfo name , '.' + data: (self tool dataForRepositoryFetchResult: result) + warnings: warningMessages ] failureSummary: [ :error | - 'Failed to fetch repository: ' - , (error messageText ifNil: [ error asString ]) ] -] - -{ #category : 'initialization' } -MCPFetchRepositoryCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPFetchRepositoryCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPFetchRepositoryCommand >> tool [ - - ^ tool + 'Failed to fetch repository: ' + , (error messageText ifNil: [ error asString ]) ] ] diff --git a/src/MCP/MCPLoadRepositoryCommand.class.st b/src/MCP/MCPLoadRepositoryCommand.class.st index 816993b..54f54c4 100644 --- a/src/MCP/MCPLoadRepositoryCommand.class.st +++ b/src/MCP/MCPLoadRepositoryCommand.class.st @@ -3,22 +3,12 @@ Command for repository_load. It dispatches baseline-only loads to MCPLoadBaselin " Class { #name : 'MCPLoadRepositoryCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPLoadRepositoryCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'private - executing' } MCPLoadRepositoryCommand >> baselineCommandClass [ @@ -47,23 +37,3 @@ MCPLoadRepositoryCommand >> execute [ repositoryUrl: repositoryUrl loadResult: loadResult ] - -{ #category : 'initialization' } -MCPLoadRepositoryCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPLoadRepositoryCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPLoadRepositoryCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPPullRepositoryCommand.class.st b/src/MCP/MCPPullRepositoryCommand.class.st index e0e010d..629129b 100644 --- a/src/MCP/MCPPullRepositoryCommand.class.st +++ b/src/MCP/MCPPullRepositoryCommand.class.st @@ -3,64 +3,32 @@ Command wrapper for repository_pull. It calls IceRepository>>pull and returns an " Class { #name : 'MCPPullRepositoryCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPPullRepositoryCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'executing' } MCPPullRepositoryCommand >> execute [ | beforeInfo repository result | - ^ self tool - executeMutationAction: 'pull' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'pull' work: [ - repository := self request repository. - beforeInfo := MCPRepositoryInfo fromRepository: repository. - repository pull. - result := MCPRepositoryPullResult - repositoryBefore: beforeInfo - after: repository ] + repository := self request repository. + beforeInfo := MCPRepositoryInfo fromRepository: repository. + repository pull. + result := MCPRepositoryPullResult + repositoryBefore: beforeInfo + after: repository ] successResult: [ :warningMessages | - self tool - successResultText: - 'Pulled repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryPullResult: result) - warnings: warningMessages ] + self tool + successResultText: + 'Pulled repository ' , result repositoryInfo name , '.' + data: (self tool dataForRepositoryPullResult: result) + warnings: warningMessages ] failureSummary: [ :error | - 'Failed to pull repository: ' - , (error messageText ifNil: [ error asString ]) ] -] - -{ #category : 'initialization' } -MCPPullRepositoryCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPPullRepositoryCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPPullRepositoryCommand >> tool [ - - ^ tool + 'Failed to pull repository: ' + , (error messageText ifNil: [ error asString ]) ] ] diff --git a/src/MCP/MCPPushRepositoryCommand.class.st b/src/MCP/MCPPushRepositoryCommand.class.st index f1ef918..3db19ce 100644 --- a/src/MCP/MCPPushRepositoryCommand.class.st +++ b/src/MCP/MCPPushRepositoryCommand.class.st @@ -3,61 +3,29 @@ Command wrapper for repository_push. It calls IceRepository>>push and returns an " Class { #name : 'MCPPushRepositoryCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPPushRepositoryCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'executing' } MCPPushRepositoryCommand >> execute [ | repository result | - ^ self tool - executeMutationAction: 'push' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'push' work: [ - repository := self request repository. - repository push. - result := MCPRepositoryPushResult repository: repository ] + repository := self request repository. + repository push. + result := MCPRepositoryPushResult repository: repository ] successResult: [ :warningMessages | - self tool - successResultText: - 'Pushed repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryPushResult: result) - warnings: warningMessages ] + self tool + successResultText: + 'Pushed repository ' , result repositoryInfo name , '.' + data: (self tool dataForRepositoryPushResult: result) + warnings: warningMessages ] failureSummary: [ :error | - 'Failed to push repository: ' - , (error messageText ifNil: [ error asString ]) ] -] - -{ #category : 'initialization' } -MCPPushRepositoryCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPPushRepositoryCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPPushRepositoryCommand >> tool [ - - ^ tool + 'Failed to push repository: ' + , (error messageText ifNil: [ error asString ]) ] ] diff --git a/src/MCP/MCPRepositoryCommand.class.st b/src/MCP/MCPRepositoryCommand.class.st new file mode 100644 index 0000000..fb6a016 --- /dev/null +++ b/src/MCP/MCPRepositoryCommand.class.st @@ -0,0 +1,59 @@ +" +Abstract base for repository command objects. It owns the shared tool/request state and construction protocol used by repository tools; subclasses implement the repository operation itself. +" +Class { + #name : 'MCPRepositoryCommand', + #superclass : 'Object', + #instVars : [ + 'tool', + 'request' + ], + #category : 'MCP-Commands', + #package : 'MCP', + #tag : 'Commands' +} + +{ #category : 'testing' } +MCPRepositoryCommand class >> isAbstract [ + + ^ self = MCPRepositoryCommand +] + +{ #category : 'instance creation' } +MCPRepositoryCommand class >> tool: aTool request: aRequest [ + + ^ self new + initializeTool: aTool request: aRequest; + yourself +] + +{ #category : 'private - execution' } +MCPRepositoryCommand >> executeRepositoryAction: actionName work: workBlock successResult: successBlock failureSummary: failureBlock [ + + ^ self tool + executeMutationAction: actionName + force: false + requestedContext: self request requestedContext + work: workBlock + successResult: successBlock + failureSummary: failureBlock +] + +{ #category : 'initialization' } +MCPRepositoryCommand >> initializeTool: aTool request: aRequest [ + + tool := aTool. + request := aRequest +] + +{ #category : 'accessing' } +MCPRepositoryCommand >> request [ + + ^ request +] + +{ #category : 'accessing' } +MCPRepositoryCommand >> tool [ + + ^ tool +] diff --git a/src/MCP/MCPRepositoryDiffCommand.class.st b/src/MCP/MCPRepositoryDiffCommand.class.st index bd49120..c7d0fba 100644 --- a/src/MCP/MCPRepositoryDiffCommand.class.st +++ b/src/MCP/MCPRepositoryDiffCommand.class.st @@ -13,28 +13,26 @@ Class { MCPRepositoryDiffCommand >> execute [ | changedPackageNames diff modifiedPaths repository result | - ^ self tool - executeMutationAction: 'diff' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'diff' work: [ - repository := self request repository. - diff := repository workingCopyDiff. - changedPackageNames := self changedPackageNamesFromDiff: diff. - modifiedPaths := self modifiedPathsFromDiff: diff. - result := MCPRepositoryDiffResult - repository: repository - changedPackageNames: changedPackageNames - modifiedPaths: modifiedPaths - isEmpty: diff isEmpty ] + repository := self request repository. + diff := repository workingCopyDiff. + changedPackageNames := self changedPackageNamesFromDiff: diff. + modifiedPaths := self modifiedPathsFromDiff: diff. + result := MCPRepositoryDiffResult + repository: repository + changedPackageNames: changedPackageNames + modifiedPaths: modifiedPaths + isEmpty: diff isEmpty ] successResult: [ :warningMessages | - self tool - successResultText: - 'Computed repository diff for ' , result repositoryInfo name - , '.' - data: (self tool dataForRepositoryDiffResult: result) - warnings: warningMessages ] + self tool + successResultText: + 'Computed repository diff for ' , result repositoryInfo name + , '.' + data: (self tool dataForRepositoryDiffResult: result) + warnings: warningMessages ] failureSummary: [ :error | - 'Failed to compute repository diff: ' - , (error messageText ifNil: [ error asString ]) ] + 'Failed repository diff: ' + , (error messageText ifNil: [ error asString ]) ] ] diff --git a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st index 4dddf75..dbd3472 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st @@ -5,22 +5,12 @@ It performs a read-only identity assertion over a registered Iceberg repository " Class { #name : 'MCPRepositoryVerifyIdentityCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPRepositoryVerifyIdentityCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'private - validation' } MCPRepositoryVerifyIdentityCommand >> addMismatchIfExpected: expectedValue actual: actualValue field: fieldName checkedFields: checkedFields mismatches: mismatches [ @@ -145,35 +135,24 @@ MCPRepositoryVerifyIdentityCommand >> checkedFieldsAndMismatchesFor: repositoryI MCPRepositoryVerifyIdentityCommand >> execute [ | repository result validation | - ^ self tool - executeMutationAction: 'verifyIdentity' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'verifyIdentity' work: [ - repository := self repositoryForVerifyIdentity. - validation := self validateRepository: repository. - result := MCPRepositoryVerifyIdentityResult - repository: repository - checkedFields: - (validation at: #checkedFields) ] + repository := self repositoryForVerifyIdentity. + validation := self validateRepository: repository. + result := MCPRepositoryVerifyIdentityResult + repository: repository + checkedFields: (validation at: #checkedFields) ] successResult: [ :warningMessages | - self tool - successResultText: - 'Repository identity verification passed for ' - , result repositoryInfo name , '.' - data: (self tool dataForRepositoryVerifyIdentityResult: result) - warnings: warningMessages ] + self tool + successResultText: + 'Repository identity verification passed for ' + , result repositoryInfo name , '.' + data: (self tool dataForRepositoryVerifyIdentityResult: result) + warnings: warningMessages ] failureSummary: [ :error | - 'Failed to verify repository identity: ' - , (error messageText ifNil: [ error asString ]) ] -] - -{ #category : 'initialization' } -MCPRepositoryVerifyIdentityCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self + 'Failed verify repository identity: ' + , (error messageText ifNil: [ error asString ]) ] ] { #category : 'private - resolving' } @@ -190,12 +169,6 @@ MCPRepositoryVerifyIdentityCommand >> repositoryForVerifyIdentity [ ifFalse: [ error signal ] ] ] -{ #category : 'accessing' } -MCPRepositoryVerifyIdentityCommand >> request [ - - ^ request -] - { #category : 'private - resolving' } MCPRepositoryVerifyIdentityCommand >> shouldRetryByNameOnlyAfter: anError [ @@ -238,12 +211,6 @@ MCPRepositoryVerifyIdentityCommand >> sortedStringsFrom: aCollection [ ^ (aCollection collect: [ :each | each asString ] as: Array) sort ] -{ #category : 'accessing' } -MCPRepositoryVerifyIdentityCommand >> tool [ - - ^ tool -] - { #category : 'private - validation' } MCPRepositoryVerifyIdentityCommand >> validateRepository: aRepository [ diff --git a/src/MCP/MCPRepositoryWorkingCopyCommand.class.st b/src/MCP/MCPRepositoryWorkingCopyCommand.class.st index 442dde1..c134c73 100644 --- a/src/MCP/MCPRepositoryWorkingCopyCommand.class.st +++ b/src/MCP/MCPRepositoryWorkingCopyCommand.class.st @@ -5,11 +5,7 @@ It centralizes shared tool/request plumbing and diff summarization helpers used " Class { #name : 'MCPRepositoryWorkingCopyCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' @@ -21,14 +17,6 @@ MCPRepositoryWorkingCopyCommand class >> isAbstract [ ^ self = MCPRepositoryWorkingCopyCommand ] -{ #category : 'instance creation' } -MCPRepositoryWorkingCopyCommand class >> tool: aTool request: aRequest [ - - ^ self new - initializeTool: aTool request: aRequest; - yourself -] - { #category : 'private - diff' } MCPRepositoryWorkingCopyCommand >> addModifiedPathsFromNode: aNode to: paths [ @@ -49,14 +37,6 @@ MCPRepositoryWorkingCopyCommand >> changedPackageNamesFromDiff: aDiff [ ^ self sortedStringsFrom: names ] -{ #category : 'initialization' } -MCPRepositoryWorkingCopyCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - { #category : 'private - diff' } MCPRepositoryWorkingCopyCommand >> modifiedPathsFromDiff: aDiff [ @@ -74,24 +54,12 @@ MCPRepositoryWorkingCopyCommand >> packageNameFromDiffPackageNode: aNode [ ^ aNode mcpDiffPackageName ] -{ #category : 'accessing' } -MCPRepositoryWorkingCopyCommand >> request [ - - ^ request -] - { #category : 'private' } MCPRepositoryWorkingCopyCommand >> sortedStringsFrom: aCollection [ ^ (aCollection collect: [ :each | each asString ]) asSet asArray sort ] -{ #category : 'accessing' } -MCPRepositoryWorkingCopyCommand >> tool [ - - ^ tool -] - { #category : 'private - execution' } MCPRepositoryWorkingCopyCommand >> withNonInteractiveAuthorDuring: aBlock [ diff --git a/src/MCP/MCPSwitchRepositoryBranchCommand.class.st b/src/MCP/MCPSwitchRepositoryBranchCommand.class.st index 298c048..180ac25 100644 --- a/src/MCP/MCPSwitchRepositoryBranchCommand.class.st +++ b/src/MCP/MCPSwitchRepositoryBranchCommand.class.st @@ -3,65 +3,33 @@ Command wrapper for repository_branch_switch. It calls IceRepository>>switchToBr " Class { #name : 'MCPSwitchRepositoryBranchCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPRepositoryCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPSwitchRepositoryBranchCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'executing' } MCPSwitchRepositoryBranchCommand >> execute [ | beforeInfo repository result | - ^ self tool - executeMutationAction: 'switchBranch' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'switchBranch' work: [ - repository := self request repository. - beforeInfo := MCPRepositoryInfo fromRepository: repository. - repository switchToBranchNamed: self request branchName. - result := MCPRepositoryBranchResult - repositoryBefore: beforeInfo - after: repository ] + repository := self request repository. + beforeInfo := MCPRepositoryInfo fromRepository: repository. + repository switchToBranchNamed: self request branchName. + result := MCPRepositoryBranchResult + repositoryBefore: beforeInfo + after: repository ] successResult: [ :warningMessages | - self tool - successResultText: - 'Switched repository ' , result repositoryInfo name - , ' to branch ' , self request branchName , '.' - data: (self tool dataForRepositorySwitchBranchResult: result) - warnings: warningMessages ] + self tool + successResultText: + 'Switched repository ' , result repositoryInfo name + , ' branch ' , self request branchName , '.' + data: (self tool dataForRepositorySwitchBranchResult: result) + warnings: warningMessages ] failureSummary: [ :error | - 'Failed to switch repository branch: ' - , (error messageText ifNil: [ error asString ]) ] -] - -{ #category : 'initialization' } -MCPSwitchRepositoryBranchCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPSwitchRepositoryBranchCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPSwitchRepositoryBranchCommand >> tool [ - - ^ tool + 'Failed to switch repository branch: ' + , (error messageText ifNil: [ error asString ]) ] ] diff --git a/src/MCP/MCPUpdateRepositoryCommand.class.st b/src/MCP/MCPUpdateRepositoryCommand.class.st index 33586bc..2c4bc06 100644 --- a/src/MCP/MCPUpdateRepositoryCommand.class.st +++ b/src/MCP/MCPUpdateRepositoryCommand.class.st @@ -3,10 +3,8 @@ Command wrapper for repository_update. It applies repository package membership " Class { #name : 'MCPUpdateRepositoryCommand', - #superclass : 'Object', + #superclass : 'MCPRepositoryCommand', #instVars : [ - 'tool', - 'request', 'addedPackageNames', 'removedPackageNames' ], @@ -15,12 +13,6 @@ Class { #tag : 'Commands' } -{ #category : 'instance creation' } -MCPUpdateRepositoryCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'private - packages' } MCPUpdateRepositoryCommand >> addPackageNamed: packageName to: aRepository [ @@ -53,44 +45,40 @@ MCPUpdateRepositoryCommand >> currentPackageNamesIn: aRepository [ MCPUpdateRepositoryCommand >> execute [ | repository result | - ^ self tool - executeMutationAction: 'update' - force: false - requestedContext: self request requestedContext + ^ self + executeRepositoryAction: 'update' work: [ - self request hasUpdates ifFalse: [ self signalNoUpdateRequested ]. - repository := self request repository. - (self request hasSuppliedPropertyNamed: 'subdirectory') ifTrue: [ - self setSubdirectoryOn: repository ]. - (self request hasSuppliedPropertyNamed: 'packageNames') ifTrue: [ - self replacePackagesIn: repository ]. - self addPackagesTo: repository. - self removePackagesFrom: repository. - result := MCPRepositoryUpdateResult - repository: repository - updateActions: - self request requestedRepositoryUpdateActions - addedPackageNames: self sortedAddedPackageNames - removedPackageNames: self sortedRemovedPackageNames ] + self request hasUpdates ifFalse: [ self signalNoUpdateRequested ]. + repository := self request repository. + (self request hasSuppliedPropertyNamed: 'subdirectory') ifTrue: [ + self setSubdirectoryOn: repository ]. + (self request hasSuppliedPropertyNamed: 'packageNames') ifTrue: [ + self replacePackagesIn: repository ]. + self addPackagesTo: repository. + self removePackagesFrom: repository. + result := MCPRepositoryUpdateResult + repository: repository + updateActions: + self request requestedRepositoryUpdateActions + addedPackageNames: self sortedAddedPackageNames + removedPackageNames: self sortedRemovedPackageNames ] successResult: [ :warningMessages | - self tool - successResultText: - 'Updated repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryUpdateResult: result) - warnings: warningMessages ] + self tool + successResultText: + 'Updated repository ' , result repositoryInfo name , '.' + data: (self tool dataForRepositoryUpdateResult: result) + warnings: warningMessages ] failureSummary: [ :error | - 'Failed to update repository: ' - , (error messageText ifNil: [ error asString ]) ] + 'Failed to update repository: ' + , (error messageText ifNil: [ error asString ]) ] ] { #category : 'initialization' } MCPUpdateRepositoryCommand >> initializeTool: aTool request: aRequest [ - tool := aTool. - request := aRequest. + super initializeTool: aTool request: aRequest. addedPackageNames := OrderedCollection new. - removedPackageNames := OrderedCollection new. - ^ self + removedPackageNames := OrderedCollection new ] { #category : 'private' } @@ -139,12 +127,6 @@ MCPUpdateRepositoryCommand >> replacePackagesIn: aRepository [ thenDo: [ :each | self addPackageNamed: each to: aRepository ] ] -{ #category : 'accessing' } -MCPUpdateRepositoryCommand >> request [ - - ^ request -] - { #category : 'private - metadata' } MCPUpdateRepositoryCommand >> setSubdirectoryOn: aRepository [ @@ -172,9 +154,3 @@ MCPUpdateRepositoryCommand >> sortedRemovedPackageNames [ ^ self normalizedPackageNames: self removedPackageNames ] - -{ #category : 'accessing' } -MCPUpdateRepositoryCommand >> tool [ - - ^ tool -] From 1ce3f0594b4799c88a35cbea40ffc311d4210f19 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Wed, 24 Jun 2026 17:57:50 +0200 Subject: [PATCH 05/21] Share repository command string sorting Co-authored-by: Codex --- src/MCP/MCPRepositoryCommand.class.st | 6 ++++++ src/MCP/MCPRepositoryVerifyIdentityCommand.class.st | 6 ------ src/MCP/MCPRepositoryWorkingCopyCommand.class.st | 6 ------ src/MCP/MCPUpdateRepositoryCommand.class.st | 3 +-- 4 files changed, 7 insertions(+), 14 deletions(-) diff --git a/src/MCP/MCPRepositoryCommand.class.st b/src/MCP/MCPRepositoryCommand.class.st index fb6a016..e5c7e4e 100644 --- a/src/MCP/MCPRepositoryCommand.class.st +++ b/src/MCP/MCPRepositoryCommand.class.st @@ -52,6 +52,12 @@ MCPRepositoryCommand >> request [ ^ request ] +{ #category : 'private' } +MCPRepositoryCommand >> sortedStringsFrom: aCollection [ + + ^ (aCollection collect: [ :each | each asString ]) asSet asArray sort +] + { #category : 'accessing' } MCPRepositoryCommand >> tool [ diff --git a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st index dbd3472..b6d61ee 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st @@ -205,12 +205,6 @@ MCPRepositoryVerifyIdentityCommand >> signalMissingExpectedIdentityFields [ yourself) ] -{ #category : 'private' } -MCPRepositoryVerifyIdentityCommand >> sortedStringsFrom: aCollection [ - - ^ (aCollection collect: [ :each | each asString ] as: Array) sort -] - { #category : 'private - validation' } MCPRepositoryVerifyIdentityCommand >> validateRepository: aRepository [ diff --git a/src/MCP/MCPRepositoryWorkingCopyCommand.class.st b/src/MCP/MCPRepositoryWorkingCopyCommand.class.st index c134c73..bc27bdd 100644 --- a/src/MCP/MCPRepositoryWorkingCopyCommand.class.st +++ b/src/MCP/MCPRepositoryWorkingCopyCommand.class.st @@ -54,12 +54,6 @@ MCPRepositoryWorkingCopyCommand >> packageNameFromDiffPackageNode: aNode [ ^ aNode mcpDiffPackageName ] -{ #category : 'private' } -MCPRepositoryWorkingCopyCommand >> sortedStringsFrom: aCollection [ - - ^ (aCollection collect: [ :each | each asString ]) asSet asArray sort -] - { #category : 'private - execution' } MCPRepositoryWorkingCopyCommand >> withNonInteractiveAuthorDuring: aBlock [ diff --git a/src/MCP/MCPUpdateRepositoryCommand.class.st b/src/MCP/MCPUpdateRepositoryCommand.class.st index 2c4bc06..c6ef626 100644 --- a/src/MCP/MCPUpdateRepositoryCommand.class.st +++ b/src/MCP/MCPUpdateRepositoryCommand.class.st @@ -84,8 +84,7 @@ MCPUpdateRepositoryCommand >> initializeTool: aTool request: aRequest [ { #category : 'private' } MCPUpdateRepositoryCommand >> normalizedPackageNames: packageNames [ - ^ (packageNames collect: [ :each | each asString ]) asSet asArray - sort + ^ self sortedStringsFrom: packageNames ] { #category : 'private - packages' } From e0b894b6d75cdcbbcbe7178fc4846f6dd8c2d7c7 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Wed, 24 Jun 2026 18:00:39 +0200 Subject: [PATCH 06/21] Collapse repository result data forwarding Co-authored-by: Codex --- .../MCPAdoptRepositoryHeadCommand.class.st | 2 +- src/MCP/MCPAttachRepositoryCommand.class.st | 2 +- ...CPCheckoutRepositoryBranchCommand.class.st | 2 +- src/MCP/MCPCommitRepositoryCommand.class.st | 2 +- .../MCPCreateRepositoryBranchCommand.class.st | 2 +- src/MCP/MCPCreateRepositoryCommand.class.st | 2 +- src/MCP/MCPExportRepositoryCommand.class.st | 2 +- src/MCP/MCPFetchRepositoryCommand.class.st | 2 +- src/MCP/MCPPullRepositoryCommand.class.st | 2 +- src/MCP/MCPPushRepositoryCommand.class.st | 2 +- src/MCP/MCPRepositoryDiffCommand.class.st | 2 +- ...CPRepositoryVerifyIdentityCommand.class.st | 2 +- .../MCPSwitchRepositoryBranchCommand.class.st | 2 +- src/MCP/MCPToolRepositoryOperation.class.st | 84 ------------------- src/MCP/MCPUpdateRepositoryCommand.class.st | 2 +- 15 files changed, 14 insertions(+), 98 deletions(-) diff --git a/src/MCP/MCPAdoptRepositoryHeadCommand.class.st b/src/MCP/MCPAdoptRepositoryHeadCommand.class.st index 558af11..1934db2 100644 --- a/src/MCP/MCPAdoptRepositoryHeadCommand.class.st +++ b/src/MCP/MCPAdoptRepositoryHeadCommand.class.st @@ -51,7 +51,7 @@ MCPAdoptRepositoryHeadCommand >> execute [ successResultText: 'Adopted repository HEAD for ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryAdoptHeadResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed adopt repository HEAD: ' diff --git a/src/MCP/MCPAttachRepositoryCommand.class.st b/src/MCP/MCPAttachRepositoryCommand.class.st index 46bd42d..4dc683a 100644 --- a/src/MCP/MCPAttachRepositoryCommand.class.st +++ b/src/MCP/MCPAttachRepositoryCommand.class.st @@ -41,7 +41,7 @@ MCPAttachRepositoryCommand >> execute [ self tool successResultText: 'Attached repository ' , self request name , '.' - data: (self tool dataForRepositoryAttachResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to attach repository ' , self request name , ': ' diff --git a/src/MCP/MCPCheckoutRepositoryBranchCommand.class.st b/src/MCP/MCPCheckoutRepositoryBranchCommand.class.st index cb8b68a..e47e88c 100644 --- a/src/MCP/MCPCheckoutRepositoryBranchCommand.class.st +++ b/src/MCP/MCPCheckoutRepositoryBranchCommand.class.st @@ -28,7 +28,7 @@ MCPCheckoutRepositoryBranchCommand >> execute [ successResultText: 'Checked out repository ' , result repositoryInfo name , ' branch ' , self request branchName , '.' - data: (self tool dataForRepositoryCheckoutBranchResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to check out repository branch: ' diff --git a/src/MCP/MCPCommitRepositoryCommand.class.st b/src/MCP/MCPCommitRepositoryCommand.class.st index 1c0facc..4938628 100644 --- a/src/MCP/MCPCommitRepositoryCommand.class.st +++ b/src/MCP/MCPCommitRepositoryCommand.class.st @@ -37,7 +37,7 @@ MCPCommitRepositoryCommand >> execute [ self tool successResultText: 'Committed repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryCommitResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to commit repository: ' diff --git a/src/MCP/MCPCreateRepositoryBranchCommand.class.st b/src/MCP/MCPCreateRepositoryBranchCommand.class.st index 006c09a..45df83d 100644 --- a/src/MCP/MCPCreateRepositoryBranchCommand.class.st +++ b/src/MCP/MCPCreateRepositoryBranchCommand.class.st @@ -27,7 +27,7 @@ MCPCreateRepositoryBranchCommand >> execute [ successResultText: 'Created branch ' , self request branchName , ' in repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryCreateBranchResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to create repository branch: ' diff --git a/src/MCP/MCPCreateRepositoryCommand.class.st b/src/MCP/MCPCreateRepositoryCommand.class.st index e868448..95b3a5a 100644 --- a/src/MCP/MCPCreateRepositoryCommand.class.st +++ b/src/MCP/MCPCreateRepositoryCommand.class.st @@ -43,7 +43,7 @@ MCPCreateRepositoryCommand >> execute [ self tool successResultText: 'Created repository ' , self request name , '.' - data: (self tool dataForRepositoryCreateResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed create repository ' , self request name , ': ' diff --git a/src/MCP/MCPExportRepositoryCommand.class.st b/src/MCP/MCPExportRepositoryCommand.class.st index c98090b..888d78f 100644 --- a/src/MCP/MCPExportRepositoryCommand.class.st +++ b/src/MCP/MCPExportRepositoryCommand.class.st @@ -39,7 +39,7 @@ MCPExportRepositoryCommand >> execute [ self tool successResultText: 'Exported repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryExportResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to export repository: ' diff --git a/src/MCP/MCPFetchRepositoryCommand.class.st b/src/MCP/MCPFetchRepositoryCommand.class.st index cd62320..0632aab 100644 --- a/src/MCP/MCPFetchRepositoryCommand.class.st +++ b/src/MCP/MCPFetchRepositoryCommand.class.st @@ -26,7 +26,7 @@ MCPFetchRepositoryCommand >> execute [ self tool successResultText: 'Fetched repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryFetchResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to fetch repository: ' diff --git a/src/MCP/MCPPullRepositoryCommand.class.st b/src/MCP/MCPPullRepositoryCommand.class.st index 629129b..cd14c31 100644 --- a/src/MCP/MCPPullRepositoryCommand.class.st +++ b/src/MCP/MCPPullRepositoryCommand.class.st @@ -26,7 +26,7 @@ MCPPullRepositoryCommand >> execute [ self tool successResultText: 'Pulled repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryPullResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to pull repository: ' diff --git a/src/MCP/MCPPushRepositoryCommand.class.st b/src/MCP/MCPPushRepositoryCommand.class.st index 3db19ce..a53cf5a 100644 --- a/src/MCP/MCPPushRepositoryCommand.class.st +++ b/src/MCP/MCPPushRepositoryCommand.class.st @@ -23,7 +23,7 @@ MCPPushRepositoryCommand >> execute [ self tool successResultText: 'Pushed repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryPushResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to push repository: ' diff --git a/src/MCP/MCPRepositoryDiffCommand.class.st b/src/MCP/MCPRepositoryDiffCommand.class.st index c7d0fba..0b51cc1 100644 --- a/src/MCP/MCPRepositoryDiffCommand.class.st +++ b/src/MCP/MCPRepositoryDiffCommand.class.st @@ -30,7 +30,7 @@ MCPRepositoryDiffCommand >> execute [ successResultText: 'Computed repository diff for ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryDiffResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed repository diff: ' diff --git a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st index b6d61ee..e9cbab1 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st @@ -148,7 +148,7 @@ MCPRepositoryVerifyIdentityCommand >> execute [ successResultText: 'Repository identity verification passed for ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryVerifyIdentityResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed verify repository identity: ' diff --git a/src/MCP/MCPSwitchRepositoryBranchCommand.class.st b/src/MCP/MCPSwitchRepositoryBranchCommand.class.st index 180ac25..e6f8276 100644 --- a/src/MCP/MCPSwitchRepositoryBranchCommand.class.st +++ b/src/MCP/MCPSwitchRepositoryBranchCommand.class.st @@ -27,7 +27,7 @@ MCPSwitchRepositoryBranchCommand >> execute [ successResultText: 'Switched repository ' , result repositoryInfo name , ' branch ' , self request branchName , '.' - data: (self tool dataForRepositorySwitchBranchResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to switch repository branch: ' diff --git a/src/MCP/MCPToolRepositoryOperation.class.st b/src/MCP/MCPToolRepositoryOperation.class.st index 2d66626..be7e0e2 100644 --- a/src/MCP/MCPToolRepositoryOperation.class.st +++ b/src/MCP/MCPToolRepositoryOperation.class.st @@ -58,96 +58,12 @@ MCPToolRepositoryOperation >> commandForRequest: repositoryRequest [ ^ self commandClass tool: self request: repositoryRequest ] -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryAdoptHeadResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryAttachResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryCheckoutBranchResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryCommitResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryCreateBranchResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryCreateResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryDiffResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryExportResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryFetchResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryPullResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryPushResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - { #category : 'private - results' } MCPToolRepositoryOperation >> dataForRepositoryResult: aResult [ ^ aResult asDictionary ] -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositorySwitchBranchResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryUpdateResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - -{ #category : 'private - results' } -MCPToolRepositoryOperation >> dataForRepositoryVerifyIdentityResult: aResult [ - - ^ self dataForRepositoryResult: aResult -] - { #category : 'metadata' } MCPToolRepositoryOperation >> description [ diff --git a/src/MCP/MCPUpdateRepositoryCommand.class.st b/src/MCP/MCPUpdateRepositoryCommand.class.st index c6ef626..fcd0b7c 100644 --- a/src/MCP/MCPUpdateRepositoryCommand.class.st +++ b/src/MCP/MCPUpdateRepositoryCommand.class.st @@ -66,7 +66,7 @@ MCPUpdateRepositoryCommand >> execute [ self tool successResultText: 'Updated repository ' , result repositoryInfo name , '.' - data: (self tool dataForRepositoryUpdateResult: result) + data: (self tool dataForRepositoryResult: result) warnings: warningMessages ] failureSummary: [ :error | 'Failed to update repository: ' From de08efdf4515482db9e4cc2c259addff17f7d380 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Wed, 24 Jun 2026 19:23:38 +0200 Subject: [PATCH 07/21] Consolidate command and class result hierarchies Co-authored-by: Codex --- src/MCP/MCPAddSlotCommand.class.st | 16 +---- src/MCP/MCPAppliedChangeResult.class.st | 61 +++++++++++++++++++ src/MCP/MCPCallToolCommand.class.st | 39 +----------- src/MCP/MCPChangeClassCommentCommand.class.st | 2 +- src/MCP/MCPChangeClassCommentResult.class.st | 4 +- src/MCP/MCPChangeHistoryCommand.class.st | 33 +--------- src/MCP/MCPClassAppliedChangeResult.class.st | 45 +------------- src/MCP/MCPClassCommand.class.st | 30 +++++++++ src/MCP/MCPClassResult.class.st | 36 +++++++++++ src/MCP/MCPClassSlotCommand.class.st | 44 +++++++++++++ src/MCP/MCPCommand.class.st | 24 ++++++++ src/MCP/MCPCompileMethodCommand.class.st | 32 +--------- src/MCP/MCPCreateClassCommand.class.st | 2 +- src/MCP/MCPCreateClassResult.class.st | 8 +-- src/MCP/MCPCreateClassToolCommand.class.st | 32 +--------- src/MCP/MCPDebugBreakpointsCommand.class.st | 22 +------ src/MCP/MCPDebugCommand.class.st | 22 +------ src/MCP/MCPEvaluateCommand.class.st | 18 +----- src/MCP/MCPGetClassCommand.class.st | 32 +--------- src/MCP/MCPGetMethodCommand.class.st | 32 +--------- src/MCP/MCPGetToolCommand.class.st | 31 +--------- src/MCP/MCPLoadBaselineCommand.class.st | 22 +------ src/MCP/MCPMethodAppliedChangeResult.class.st | 45 +------------- src/MCP/MCPMoveClassCommand.class.st | 2 +- src/MCP/MCPMoveClassResult.class.st | 4 +- src/MCP/MCPMoveSlotCommand.class.st | 16 +---- src/MCP/MCPMoveSlotResult.class.st | 4 +- src/MCP/MCPRemoveClassResult.class.st | 4 +- src/MCP/MCPRemoveClassesCommand.class.st | 2 +- src/MCP/MCPRemoveMethodsCommand.class.st | 32 +--------- src/MCP/MCPRemoveSlotCommand.class.st | 16 +---- src/MCP/MCPRenameClassCommand.class.st | 2 +- src/MCP/MCPRenameClassResult.class.st | 4 +- src/MCP/MCPRenameSlotCommand.class.st | 8 +-- src/MCP/MCPRenameSlotResult.class.st | 4 +- src/MCP/MCPReparentClassCommand.class.st | 8 +-- src/MCP/MCPReparentClassResult.class.st | 4 +- .../MCPReplaceClassDefinitionCommand.class.st | 2 +- .../MCPReplaceClassDefinitionResult.class.st | 4 +- src/MCP/MCPReplaceClassLayoutCommand.class.st | 2 +- src/MCP/MCPReplaceClassLayoutResult.class.st | 4 +- ...MCPReplaceClassSharedPoolsCommand.class.st | 2 +- .../MCPReplaceClassSharedPoolsResult.class.st | 4 +- ...eplaceClassSharedVariablesCommand.class.st | 2 +- ...ReplaceClassSharedVariablesResult.class.st | 4 +- .../MCPReplaceClassSideTraitsCommand.class.st | 2 +- .../MCPReplaceClassSideTraitsResult.class.st | 4 +- src/MCP/MCPReplaceClassTraitsCommand.class.st | 2 +- src/MCP/MCPReplaceClassTraitsResult.class.st | 4 +- src/MCP/MCPRepositoryCommand.class.st | 33 +--------- src/MCP/MCPRewriteMethodsCommand.class.st | 32 +--------- src/MCP/MCPRunTestsCommand.class.st | 32 +--------- src/MCP/MCPScreenshotCommand.class.st | 22 +------ src/MCP/MCPSearchToolCommand.class.st | 39 +----------- src/MCP/MCPSearchToolsCommand.class.st | 31 +--------- src/MCP/MCPSlotResult.class.st | 4 +- src/MCP/MCPToolRequestCommand.class.st | 47 ++++++++++++++ src/MCP/MCPUpdateClassCommand.class.st | 2 +- src/MCP/MCPUpdateMethodCommand.class.st | 32 +--------- 59 files changed, 320 insertions(+), 732 deletions(-) create mode 100644 src/MCP/MCPAppliedChangeResult.class.st create mode 100644 src/MCP/MCPClassCommand.class.st create mode 100644 src/MCP/MCPClassResult.class.st create mode 100644 src/MCP/MCPClassSlotCommand.class.st create mode 100644 src/MCP/MCPCommand.class.st create mode 100644 src/MCP/MCPToolRequestCommand.class.st diff --git a/src/MCP/MCPAddSlotCommand.class.st b/src/MCP/MCPAddSlotCommand.class.st index 41bedfa..bf0eeea 100644 --- a/src/MCP/MCPAddSlotCommand.class.st +++ b/src/MCP/MCPAddSlotCommand.class.st @@ -3,7 +3,7 @@ Adds a slot to a class or metaclass through the refactoring engine. " Class { #name : 'MCPAddSlotCommand', - #superclass : 'Object', + #superclass : 'MCPClassSlotCommand', #instVars : [ 'className', 'slotName', @@ -48,12 +48,6 @@ MCPAddSlotCommand >> classSide: aBoolean [ classSide := aBoolean ] -{ #category : 'private' } -MCPAddSlotCommand >> currentClass [ - - ^ MCPImageLookup classNamed: self className -] - { #category : 'executing' } MCPAddSlotCommand >> execute [ @@ -68,14 +62,6 @@ MCPAddSlotCommand >> execute [ classSide: self classSide ] -{ #category : 'private' } -MCPAddSlotCommand >> refactoringBehaviorForClass: aClass [ - - ^ self classSide - ifTrue: [ aClass classSide ] - ifFalse: [ aClass ] -] - { #category : 'private' } MCPAddSlotCommand >> refactoringForBehavior: aBehavior [ diff --git a/src/MCP/MCPAppliedChangeResult.class.st b/src/MCP/MCPAppliedChangeResult.class.st new file mode 100644 index 0000000..7016028 --- /dev/null +++ b/src/MCP/MCPAppliedChangeResult.class.st @@ -0,0 +1,61 @@ +" +Abstract result for a planned update that has been applied. + +Subclasses decide how much of the applied change to expose in #asDictionary. +" +Class { + #name : 'MCPAppliedChangeResult', + #superclass : 'Object', + #instVars : [ + 'updatePlan', + 'changeResult' + ], + #category : 'MCP-Results', + #package : 'MCP', + #tag : 'Results' +} + +{ #category : 'testing' } +MCPAppliedChangeResult class >> isAbstract [ + + ^ self == MCPAppliedChangeResult +] + +{ #category : 'instance creation' } +MCPAppliedChangeResult class >> updatePlan: anUpdatePlan changeResult: aChangeResult [ + + ^ self new + updatePlan: anUpdatePlan; + changeResult: aChangeResult; + yourself +] + +{ #category : 'accessing' } +MCPAppliedChangeResult >> changeResult [ + + ^ changeResult +] + +{ #category : 'accessing' } +MCPAppliedChangeResult >> changeResult: aResult [ + + changeResult := aResult +] + +{ #category : 'accessing' } +MCPAppliedChangeResult >> updateAction [ + + ^ self updatePlan updateAction +] + +{ #category : 'accessing' } +MCPAppliedChangeResult >> updatePlan [ + + ^ updatePlan +] + +{ #category : 'accessing' } +MCPAppliedChangeResult >> updatePlan: anUpdatePlan [ + + updatePlan := anUpdatePlan +] diff --git a/src/MCP/MCPCallToolCommand.class.st b/src/MCP/MCPCallToolCommand.class.st index 7a0a251..cbb0417 100644 --- a/src/MCP/MCPCallToolCommand.class.st +++ b/src/MCP/MCPCallToolCommand.class.st @@ -5,51 +5,14 @@ This command is the dynamic dispatch path behind tool_call: it validates the req " Class { #name : 'MCPCallToolCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPCallToolCommand class >> tool: aTool request: aRequest [ - - ^ self new - tool: aTool; - request: aRequest; - yourself -] - { #category : 'executing' } MCPCallToolCommand >> execute [ Error signal: 'tool_call requires MCP server call context.' ] - -{ #category : 'accessing' } -MCPCallToolCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPCallToolCommand >> request: anObject [ - - request := anObject -] - -{ #category : 'accessing' } -MCPCallToolCommand >> tool [ - - ^ tool -] - -{ #category : 'accessing' } -MCPCallToolCommand >> tool: anObject [ - - tool := anObject -] diff --git a/src/MCP/MCPChangeClassCommentCommand.class.st b/src/MCP/MCPChangeClassCommentCommand.class.st index c938200..ab2814e 100644 --- a/src/MCP/MCPChangeClassCommentCommand.class.st +++ b/src/MCP/MCPChangeClassCommentCommand.class.st @@ -5,7 +5,7 @@ It records the previous comment and returns an MCPChangeClassCommentResult so cl " Class { #name : 'MCPChangeClassCommentCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'classComment' diff --git a/src/MCP/MCPChangeClassCommentResult.class.st b/src/MCP/MCPChangeClassCommentResult.class.st index ea034f5..cccd222 100644 --- a/src/MCP/MCPChangeClassCommentResult.class.st +++ b/src/MCP/MCPChangeClassCommentResult.class.st @@ -5,7 +5,7 @@ It carries the updated class info and both the old and new comments so the tool " Class { #name : 'MCPChangeClassCommentResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldClassComment', @@ -30,7 +30,7 @@ MCPChangeClassCommentResult class >> classInfo: aClassInfo oldClassComment: anOl MCPChangeClassCommentResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldClassComment put: self oldClassComment. data at: #newClassComment put: self newClassComment. ^ data diff --git a/src/MCP/MCPChangeHistoryCommand.class.st b/src/MCP/MCPChangeHistoryCommand.class.st index b00d2e0..9d302b5 100644 --- a/src/MCP/MCPChangeHistoryCommand.class.st +++ b/src/MCP/MCPChangeHistoryCommand.class.st @@ -5,11 +5,7 @@ It centralizes command construction, current Epicea log access, history-file loa " Class { #name : 'MCPChangeHistoryCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' @@ -21,14 +17,6 @@ MCPChangeHistoryCommand class >> isAbstract [ ^ self = MCPChangeHistoryCommand ] -{ #category : 'instance creation' } -MCPChangeHistoryCommand class >> tool: aTool request: aRequest [ - - ^ self new - initializeTool: aTool request: aRequest; - yourself -] - { #category : 'private - log' } MCPChangeHistoryCommand >> currentHistoryFileReference [ @@ -64,13 +52,6 @@ MCPChangeHistoryCommand >> historyDirectoryForCurrentFile: aFileReference [ do: [ :error | FileLocator localDirectory asFileReference ] ] -{ #category : 'initialization' } -MCPChangeHistoryCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest -] - { #category : 'private - entries' } MCPChangeHistoryCommand >> isCodeChangeEntry: anEntry [ @@ -150,12 +131,6 @@ MCPChangeHistoryCommand >> logAndFileNameFromFileReference: aFileReference [ aFileReference basename } ] -{ #category : 'accessing' } -MCPChangeHistoryCommand >> request [ - - ^ request -] - { #category : 'private - files' } MCPChangeHistoryCommand >> sameFileReference: firstFile as: secondFile [ @@ -163,9 +138,3 @@ MCPChangeHistoryCommand >> sameFileReference: firstFile as: secondFile [ secondFile ifNil: [ ^ false ]. ^ firstFile fullName = secondFile fullName ] - -{ #category : 'accessing' } -MCPChangeHistoryCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPClassAppliedChangeResult.class.st b/src/MCP/MCPClassAppliedChangeResult.class.st index 56ba548..f65fa7a 100644 --- a/src/MCP/MCPClassAppliedChangeResult.class.st +++ b/src/MCP/MCPClassAppliedChangeResult.class.st @@ -3,57 +3,14 @@ Compact public result for a class update selected and executed by a class mutati " Class { #name : 'MCPClassAppliedChangeResult', - #superclass : 'Object', - #instVars : [ - 'updatePlan', - 'changeResult' - ], + #superclass : 'MCPAppliedChangeResult', #category : 'MCP-Results', #package : 'MCP', #tag : 'Results' } -{ #category : 'instance creation' } -MCPClassAppliedChangeResult class >> updatePlan: anUpdatePlan changeResult: aChangeResult [ - - ^ self new - updatePlan: anUpdatePlan; - changeResult: aChangeResult; - yourself -] - { #category : 'converting' } MCPClassAppliedChangeResult >> asDictionary [ ^ Dictionary new ] - -{ #category : 'accessing' } -MCPClassAppliedChangeResult >> changeResult [ - - ^ changeResult -] - -{ #category : 'accessing' } -MCPClassAppliedChangeResult >> changeResult: aResult [ - - changeResult := aResult -] - -{ #category : 'accessing' } -MCPClassAppliedChangeResult >> updateAction [ - - ^ self updatePlan updateAction -] - -{ #category : 'accessing' } -MCPClassAppliedChangeResult >> updatePlan [ - - ^ updatePlan -] - -{ #category : 'accessing' } -MCPClassAppliedChangeResult >> updatePlan: anUpdatePlan [ - - updatePlan := anUpdatePlan -] diff --git a/src/MCP/MCPClassCommand.class.st b/src/MCP/MCPClassCommand.class.st new file mode 100644 index 0000000..b5e1421 --- /dev/null +++ b/src/MCP/MCPClassCommand.class.st @@ -0,0 +1,30 @@ +" +Abstract command for operations targeting one existing or newly defined class. + +Subclasses provide #className and implement their command-specific execution. +" +Class { + #name : 'MCPClassCommand', + #superclass : 'MCPCommand', + #category : 'MCP-Commands', + #package : 'MCP', + #tag : 'Commands' +} + +{ #category : 'testing' } +MCPClassCommand class >> isAbstract [ + + ^ self == MCPClassCommand +] + +{ #category : 'accessing' } +MCPClassCommand >> className [ + + self subclassResponsibility +] + +{ #category : 'private' } +MCPClassCommand >> currentClass [ + + ^ MCPImageLookup classNamed: self className +] diff --git a/src/MCP/MCPClassResult.class.st b/src/MCP/MCPClassResult.class.st new file mode 100644 index 0000000..e52ad89 --- /dev/null +++ b/src/MCP/MCPClassResult.class.st @@ -0,0 +1,36 @@ +" +Abstract result for operations that return a class snapshot. + +Subclasses provide #classInfo and add operation-specific fields when needed. +" +Class { + #name : 'MCPClassResult', + #superclass : 'Object', + #category : 'MCP-Results', + #package : 'MCP', + #tag : 'Results' +} + +{ #category : 'testing' } +MCPClassResult class >> isAbstract [ + + ^ self == MCPClassResult +] + +{ #category : 'converting' } +MCPClassResult >> asDictionary [ + + ^ self newClassInfoDictionary +] + +{ #category : 'accessing' } +MCPClassResult >> classInfo [ + + self subclassResponsibility +] + +{ #category : 'private' } +MCPClassResult >> newClassInfoDictionary [ + + ^ self classInfo asDictionary copy +] diff --git a/src/MCP/MCPClassSlotCommand.class.st b/src/MCP/MCPClassSlotCommand.class.st new file mode 100644 index 0000000..65b7493 --- /dev/null +++ b/src/MCP/MCPClassSlotCommand.class.st @@ -0,0 +1,44 @@ +" +Abstract command for class-slot operations. + +Subclasses provide #slotName, #classSide, and the operation-specific refactoring. +" +Class { + #name : 'MCPClassSlotCommand', + #superclass : 'MCPClassCommand', + #category : 'MCP-Commands', + #package : 'MCP', + #tag : 'Commands' +} + +{ #category : 'testing' } +MCPClassSlotCommand class >> isAbstract [ + + ^ self == MCPClassSlotCommand +] + +{ #category : 'accessing' } +MCPClassSlotCommand >> classSide [ + + self subclassResponsibility +] + +{ #category : 'private' } +MCPClassSlotCommand >> refactoringBehaviorForClass: aClass [ + + ^ self classSide + ifTrue: [ aClass classSide ] + ifFalse: [ aClass ] +] + +{ #category : 'private' } +MCPClassSlotCommand >> refactoringForBehavior: aBehavior [ + + self subclassResponsibility +] + +{ #category : 'accessing' } +MCPClassSlotCommand >> slotName [ + + self subclassResponsibility +] diff --git a/src/MCP/MCPCommand.class.st b/src/MCP/MCPCommand.class.st new file mode 100644 index 0000000..654899c --- /dev/null +++ b/src/MCP/MCPCommand.class.st @@ -0,0 +1,24 @@ +" +Abstract base for command objects that perform one image-side action through #execute. + +Subclasses keep the command-specific state and implement #execute. +" +Class { + #name : 'MCPCommand', + #superclass : 'Object', + #category : 'MCP-Commands', + #package : 'MCP', + #tag : 'Commands' +} + +{ #category : 'testing' } +MCPCommand class >> isAbstract [ + + ^ self == MCPCommand +] + +{ #category : 'executing' } +MCPCommand >> execute [ + + self subclassResponsibility +] diff --git a/src/MCP/MCPCompileMethodCommand.class.st b/src/MCP/MCPCompileMethodCommand.class.st index 2775d5b..cdc52c9 100644 --- a/src/MCP/MCPCompileMethodCommand.class.st +++ b/src/MCP/MCPCompileMethodCommand.class.st @@ -5,22 +5,12 @@ It reports whether compilation created a new method or replaced an existing meth " Class { #name : 'MCPCompileMethodCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPCompileMethodCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'private' } MCPCompileMethodCommand >> changeSummaryVerbFor: changeKindString [ @@ -75,28 +65,8 @@ MCPCompileMethodCommand >> execute [ error: error ] ] -{ #category : 'initialization' } -MCPCompileMethodCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPCompileMethodCommand >> request [ - - ^ request -] - { #category : 'private' } MCPCompileMethodCommand >> selectorForMethodSource: methodSourceString [ ^ (RBParser parseMethod: methodSourceString) selector ] - -{ #category : 'accessing' } -MCPCompileMethodCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPCreateClassCommand.class.st b/src/MCP/MCPCreateClassCommand.class.st index bb4fa74..3f03ae9 100644 --- a/src/MCP/MCPCreateClassCommand.class.st +++ b/src/MCP/MCPCreateClassCommand.class.st @@ -5,7 +5,7 @@ It owns the class-builder interaction for superclass, package, tag, slots, trait " Class { #name : 'MCPCreateClassCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'superclassName', diff --git a/src/MCP/MCPCreateClassResult.class.st b/src/MCP/MCPCreateClassResult.class.st index 6e4eb19..684c883 100644 --- a/src/MCP/MCPCreateClassResult.class.st +++ b/src/MCP/MCPCreateClassResult.class.st @@ -5,7 +5,7 @@ It wraps the MCPClassInfo for the newly created class. " Class { #name : 'MCPCreateClassResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo' ], @@ -22,12 +22,6 @@ MCPCreateClassResult class >> classInfo: aClassInfo [ yourself ] -{ #category : 'converting' } -MCPCreateClassResult >> asDictionary [ - - ^ self classInfo asDictionary copy -] - { #category : 'accessing' } MCPCreateClassResult >> classInfo [ diff --git a/src/MCP/MCPCreateClassToolCommand.class.st b/src/MCP/MCPCreateClassToolCommand.class.st index 6814773..ddca57e 100644 --- a/src/MCP/MCPCreateClassToolCommand.class.st +++ b/src/MCP/MCPCreateClassToolCommand.class.st @@ -5,22 +5,12 @@ It owns tool-level execution concerns such as warning handling, class comments, " Class { #name : 'MCPCreateClassToolCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPCreateClassToolCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'executing' } MCPCreateClassToolCommand >> execute [ @@ -60,23 +50,3 @@ MCPCreateClassToolCommand >> execute [ error: error ] ] - -{ #category : 'initialization' } -MCPCreateClassToolCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPCreateClassToolCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPCreateClassToolCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPDebugBreakpointsCommand.class.st b/src/MCP/MCPDebugBreakpointsCommand.class.st index 2afe974..ec429ea 100644 --- a/src/MCP/MCPDebugBreakpointsCommand.class.st +++ b/src/MCP/MCPDebugBreakpointsCommand.class.st @@ -5,10 +5,8 @@ It creates method-entry or source-interval DebugPoint breakpoints, lists registr " Class { #name : 'MCPDebugBreakpointsCommand', - #superclass : 'Object', + #superclass : 'MCPToolRequestCommand', #instVars : [ - 'tool', - 'request', 'registry' ], #category : 'MCP-Commands', @@ -100,10 +98,8 @@ MCPDebugBreakpointsCommand >> execute [ { #category : 'initialization' } MCPDebugBreakpointsCommand >> initializeTool: aTool request: aRequest registry: aRegistry [ - tool := aTool. - request := aRequest. - registry := aRegistry. - ^ self + super initializeTool: aTool request: aRequest. + registry := aRegistry ] { #category : 'private - actions' } @@ -152,12 +148,6 @@ MCPDebugBreakpointsCommand >> removeBreakpoint [ data: data ] -{ #category : 'accessing' } -MCPDebugBreakpointsCommand >> request [ - - ^ request -] - { #category : 'private - validation' } MCPDebugBreakpointsCommand >> requireSetArguments [ @@ -365,9 +355,3 @@ MCPDebugBreakpointsCommand >> targetNodeInMethod: aCompiledMethod [ ^ self sourceIntervalNodeInMethod: aCompiledMethod ]. ^ self signalUnsupportedTargetKind ] - -{ #category : 'accessing' } -MCPDebugBreakpointsCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPDebugCommand.class.st b/src/MCP/MCPDebugCommand.class.st index 00467ef..c7a12ad 100644 --- a/src/MCP/MCPDebugCommand.class.st +++ b/src/MCP/MCPDebugCommand.class.st @@ -5,10 +5,8 @@ It holds the tool, parsed request, and shared session registry, and provides com " Class { #name : 'MCPDebugCommand', - #superclass : 'Object', + #superclass : 'MCPToolRequestCommand', #instVars : [ - 'tool', - 'request', 'registry' ], #category : 'MCP-Commands', @@ -34,10 +32,8 @@ MCPDebugCommand >> execute [ { #category : 'initialization' } MCPDebugCommand >> initializeTool: aTool request: aRequest registry: aRegistry [ - tool := aTool. - request := aRequest. - registry := aRegistry. - ^ self + super initializeTool: aTool request: aRequest. + registry := aRegistry ] { #category : 'private' } @@ -70,12 +66,6 @@ MCPDebugCommand >> registry: aRegistry [ registry := aRegistry ] -{ #category : 'accessing' } -MCPDebugCommand >> request [ - - ^ request -] - { #category : 'private' } MCPDebugCommand >> requestedStateId [ @@ -189,12 +179,6 @@ MCPDebugCommand >> signalUnsupportedOperation: operationName [ details: { (#operation -> operationName) } asDictionary ] -{ #category : 'accessing' } -MCPDebugCommand >> tool [ - - ^ tool -] - { #category : 'private' } MCPDebugCommand >> validateFrameReferenceForRecord: aRecord [ diff --git a/src/MCP/MCPEvaluateCommand.class.st b/src/MCP/MCPEvaluateCommand.class.st index c80d62e..71ec89d 100644 --- a/src/MCP/MCPEvaluateCommand.class.st +++ b/src/MCP/MCPEvaluateCommand.class.st @@ -3,11 +3,9 @@ Command that evaluates Smalltalk code for the evaluate tool and returns a result " Class { #name : 'MCPEvaluateCommand', - #superclass : 'Object', + #superclass : 'MCPToolRequestCommand', #instVars : [ - 'request', - 'resultPreviewCharacterLimit', - 'tool' + 'resultPreviewCharacterLimit' ], #category : 'MCP-Commands', #package : 'MCP', @@ -57,12 +55,6 @@ MCPEvaluateCommand >> initializeTool: aTool request: aRequest resultPreviewChara ^ self ] -{ #category : 'accessing' } -MCPEvaluateCommand >> request [ - - ^ request -] - { #category : 'accessing' } MCPEvaluateCommand >> resultPreviewCharacterLimit [ @@ -88,9 +80,3 @@ MCPEvaluateCommand >> syntaxFailureFor: aNotice [ errorSummary: (tool syntaxFailureMessageFor: aNotice) details: details ] - -{ #category : 'accessing' } -MCPEvaluateCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPGetClassCommand.class.st b/src/MCP/MCPGetClassCommand.class.st index cb4ae59..ff4f95f 100644 --- a/src/MCP/MCPGetClassCommand.class.st +++ b/src/MCP/MCPGetClassCommand.class.st @@ -3,22 +3,12 @@ Command that returns class metadata DTO dictionaries for class_get. " Class { #name : 'MCPGetClassCommand', - #superclass : 'Object', - #instVars : [ - 'request', - 'tool' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPGetClassCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'executing' } MCPGetClassCommand >> execute [ @@ -44,20 +34,6 @@ MCPGetClassCommand >> execute [ subclasses: subclasses ] -{ #category : 'initialization' } -MCPGetClassCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPGetClassCommand >> request [ - - ^ request -] - { #category : 'private' } MCPGetClassCommand >> subclassesForClass: aClass [ @@ -87,9 +63,3 @@ MCPGetClassCommand >> superclassesForClass: aClass [ forClassNamed: aClass name asString ]. ^ aClass allSuperclasses asArray copyUpTo: targetSuperclass ] - -{ #category : 'accessing' } -MCPGetClassCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPGetMethodCommand.class.st b/src/MCP/MCPGetMethodCommand.class.st index d81be65..ee774d9 100644 --- a/src/MCP/MCPGetMethodCommand.class.st +++ b/src/MCP/MCPGetMethodCommand.class.st @@ -3,22 +3,12 @@ Command that returns method source and optional variable-reference DTOs for meth " Class { #name : 'MCPGetMethodCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPGetMethodCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'executing' } MCPGetMethodCommand >> execute [ @@ -44,23 +34,3 @@ MCPGetMethodCommand >> execute [ data at: #variableReferences put: variableReferences ]. ^ MCPGetMethodResult data: data externalVariableCount: nil ] - -{ #category : 'initialization' } -MCPGetMethodCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPGetMethodCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPGetMethodCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPGetToolCommand.class.st b/src/MCP/MCPGetToolCommand.class.st index 5c5600f..b7bc3e6 100644 --- a/src/MCP/MCPGetToolCommand.class.st +++ b/src/MCP/MCPGetToolCommand.class.st @@ -5,10 +5,8 @@ This command is the second step of the discoverable-tool flow: after discovery g " Class { #name : 'MCPGetToolCommand', - #superclass : 'Object', + #superclass : 'MCPToolRequestCommand', #instVars : [ - 'tool', - 'request', 'toolExposurePolicy' ], #category : 'MCP-Commands', @@ -29,8 +27,7 @@ MCPGetToolCommand class >> tool: aTool request: aRequest [ MCPGetToolCommand class >> tool: aTool request: aRequest toolExposurePolicy: aToolExposurePolicy [ ^ self new - tool: aTool; - request: aRequest; + initializeTool: aTool request: aRequest; toolExposurePolicy: aToolExposurePolicy; yourself ] @@ -51,30 +48,6 @@ MCPGetToolCommand >> execute [ asDictionary ] -{ #category : 'accessing' } -MCPGetToolCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPGetToolCommand >> request: anObject [ - - request := anObject -] - -{ #category : 'accessing' } -MCPGetToolCommand >> tool [ - - ^ tool -] - -{ #category : 'accessing' } -MCPGetToolCommand >> tool: anObject [ - - tool := anObject -] - { #category : 'accessing' } MCPGetToolCommand >> toolExposurePolicy [ diff --git a/src/MCP/MCPLoadBaselineCommand.class.st b/src/MCP/MCPLoadBaselineCommand.class.st index 9443feb..b9a8a5d 100644 --- a/src/MCP/MCPLoadBaselineCommand.class.st +++ b/src/MCP/MCPLoadBaselineCommand.class.st @@ -3,10 +3,8 @@ Command that performs a Metacello baseline load and reports packages and reposit " Class { #name : 'MCPLoadBaselineCommand', - #superclass : 'Object', + #superclass : 'MCPToolRequestCommand', #instVars : [ - 'tool', - 'request', 'configureMetacelloBlock' ], #category : 'MCP-Commands', @@ -83,10 +81,8 @@ MCPLoadBaselineCommand >> execute [ { #category : 'initialization' } MCPLoadBaselineCommand >> initializeTool: aTool request: aRequest configureMetacello: aBlock [ - tool := aTool. - request := aRequest. - configureMetacelloBlock := aBlock. - ^ self + super initializeTool: aTool request: aRequest. + configureMetacelloBlock := aBlock ] { #category : 'private - loading' } @@ -126,15 +122,3 @@ MCPLoadBaselineCommand >> newRepositoryInfosAfter: beforeRepositories [ thenCollect: [ :each | MCPRepositoryInfo fromRepository: each ]) asArray ] - -{ #category : 'accessing' } -MCPLoadBaselineCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPLoadBaselineCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPMethodAppliedChangeResult.class.st b/src/MCP/MCPMethodAppliedChangeResult.class.st index 8d0702b..167e97d 100644 --- a/src/MCP/MCPMethodAppliedChangeResult.class.st +++ b/src/MCP/MCPMethodAppliedChangeResult.class.st @@ -3,57 +3,14 @@ Compact public result for a method update selected and executed by a method muta " Class { #name : 'MCPMethodAppliedChangeResult', - #superclass : 'Object', - #instVars : [ - 'updatePlan', - 'changeResult' - ], + #superclass : 'MCPAppliedChangeResult', #category : 'MCP-Results', #package : 'MCP', #tag : 'Results' } -{ #category : 'instance creation' } -MCPMethodAppliedChangeResult class >> updatePlan: anUpdatePlan changeResult: aChangeResult [ - - ^ self new - updatePlan: anUpdatePlan; - changeResult: aChangeResult; - yourself -] - { #category : 'converting' } MCPMethodAppliedChangeResult >> asDictionary [ ^ self changeResult asDictionary copy ] - -{ #category : 'accessing' } -MCPMethodAppliedChangeResult >> changeResult [ - - ^ changeResult -] - -{ #category : 'accessing' } -MCPMethodAppliedChangeResult >> changeResult: aResult [ - - changeResult := aResult -] - -{ #category : 'accessing' } -MCPMethodAppliedChangeResult >> updateAction [ - - ^ self updatePlan updateAction -] - -{ #category : 'accessing' } -MCPMethodAppliedChangeResult >> updatePlan [ - - ^ updatePlan -] - -{ #category : 'accessing' } -MCPMethodAppliedChangeResult >> updatePlan: anUpdatePlan [ - - updatePlan := anUpdatePlan -] diff --git a/src/MCP/MCPMoveClassCommand.class.st b/src/MCP/MCPMoveClassCommand.class.st index 1a7a57b..b2cb5d4 100644 --- a/src/MCP/MCPMoveClassCommand.class.st +++ b/src/MCP/MCPMoveClassCommand.class.st @@ -5,7 +5,7 @@ When only a tag is supplied, it recategorizes the class inside its current packa " Class { #name : 'MCPMoveClassCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'packageName', diff --git a/src/MCP/MCPMoveClassResult.class.st b/src/MCP/MCPMoveClassResult.class.st index 0ca991f..6cb8f7b 100644 --- a/src/MCP/MCPMoveClassResult.class.st +++ b/src/MCP/MCPMoveClassResult.class.st @@ -5,7 +5,7 @@ It carries the updated class info plus the previous package and tag. " Class { #name : 'MCPMoveClassResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldPackageName', @@ -30,7 +30,7 @@ MCPMoveClassResult class >> classInfo: aClassInfo oldPackageName: anOldPackageNa MCPMoveClassResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldPackageName put: self oldPackageName. data at: #oldTag put: self oldTag. ^ data diff --git a/src/MCP/MCPMoveSlotCommand.class.st b/src/MCP/MCPMoveSlotCommand.class.st index f6009fb..fc8165b 100644 --- a/src/MCP/MCPMoveSlotCommand.class.st +++ b/src/MCP/MCPMoveSlotCommand.class.st @@ -5,7 +5,7 @@ It performs pull-up or push-down refactorings for instance-side or class-side sl " Class { #name : 'MCPMoveSlotCommand', - #superclass : 'Object', + #superclass : 'MCPClassSlotCommand', #instVars : [ 'className', 'slotName', @@ -73,12 +73,6 @@ MCPMoveSlotCommand >> classSide: aBoolean [ classSide := aBoolean ] -{ #category : 'private' } -MCPMoveSlotCommand >> currentClass [ - - ^ MCPImageLookup classNamed: self className -] - { #category : 'accessing' } MCPMoveSlotCommand >> direction [ @@ -123,14 +117,6 @@ MCPMoveSlotCommand >> normalizedAffectedClassNameFor: aBehavior [ ifFalse: [ aBehavior name ]) asString ] -{ #category : 'private' } -MCPMoveSlotCommand >> refactoringBehaviorForClass: aClass [ - - ^ self classSide - ifTrue: [ aClass classSide ] - ifFalse: [ aClass ] -] - { #category : 'private' } MCPMoveSlotCommand >> refactoringForBehavior: aBehavior [ diff --git a/src/MCP/MCPMoveSlotResult.class.st b/src/MCP/MCPMoveSlotResult.class.st index 3987dde..9967c9b 100644 --- a/src/MCP/MCPMoveSlotResult.class.st +++ b/src/MCP/MCPMoveSlotResult.class.st @@ -5,7 +5,7 @@ It includes updated class info, the moved slot identity, side, and affected clas " Class { #name : 'MCPMoveSlotResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'slotName', @@ -44,7 +44,7 @@ MCPMoveSlotResult >> affectedClassNames: someClassNames [ MCPMoveSlotResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #slotName put: self slotName. data at: #classSide put: self classSide. data at: #affectedClassNames put: self affectedClassNames. diff --git a/src/MCP/MCPRemoveClassResult.class.st b/src/MCP/MCPRemoveClassResult.class.st index afab311..45d685d 100644 --- a/src/MCP/MCPRemoveClassResult.class.st +++ b/src/MCP/MCPRemoveClassResult.class.st @@ -5,7 +5,7 @@ It records the removed class metadata and whether subclasses were reparented. " Class { #name : 'MCPRemoveClassResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'wasEmpty', @@ -32,7 +32,7 @@ MCPRemoveClassResult class >> classInfo: aClassInfo wasEmpty: aBoolean reparente MCPRemoveClassResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #wasEmpty put: self wasEmpty. data at: #reparentedToSuperclassName diff --git a/src/MCP/MCPRemoveClassesCommand.class.st b/src/MCP/MCPRemoveClassesCommand.class.st index 6e032ef..c99ecb3 100644 --- a/src/MCP/MCPRemoveClassesCommand.class.st +++ b/src/MCP/MCPRemoveClassesCommand.class.st @@ -5,7 +5,7 @@ It gathers removal warnings, removes now-empty packages when applicable, and ret " Class { #name : 'MCPRemoveClassesCommand', - #superclass : 'Object', + #superclass : 'MCPCommand', #instVars : [ 'classNames', 'force' diff --git a/src/MCP/MCPRemoveMethodsCommand.class.st b/src/MCP/MCPRemoveMethodsCommand.class.st index bf4663c..5bf2208 100644 --- a/src/MCP/MCPRemoveMethodsCommand.class.st +++ b/src/MCP/MCPRemoveMethodsCommand.class.st @@ -3,22 +3,12 @@ Command that removes methods and returns removed method DTO dictionaries. " Class { #name : 'MCPRemoveMethodsCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPRemoveMethodsCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'executing' } MCPRemoveMethodsCommand >> execute [ @@ -42,23 +32,3 @@ MCPRemoveMethodsCommand >> execute [ removedMethods: #( ) warningMessages: { warningMessage } ] - -{ #category : 'initialization' } -MCPRemoveMethodsCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - -{ #category : 'accessing' } -MCPRemoveMethodsCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPRemoveMethodsCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPRemoveSlotCommand.class.st b/src/MCP/MCPRemoveSlotCommand.class.st index ec89df5..76b0b3a 100644 --- a/src/MCP/MCPRemoveSlotCommand.class.st +++ b/src/MCP/MCPRemoveSlotCommand.class.st @@ -3,7 +3,7 @@ Removes a slot from a class or metaclass through the refactoring engine. " Class { #name : 'MCPRemoveSlotCommand', - #superclass : 'Object', + #superclass : 'MCPClassSlotCommand', #instVars : [ 'className', 'slotName', @@ -48,12 +48,6 @@ MCPRemoveSlotCommand >> classSide: aBoolean [ classSide := aBoolean ] -{ #category : 'private' } -MCPRemoveSlotCommand >> currentClass [ - - ^ MCPImageLookup classNamed: self className -] - { #category : 'private' } MCPRemoveSlotCommand >> directlyDefinesSlotNamed: aSlotName inBehavior: aBehavior [ @@ -86,14 +80,6 @@ MCPRemoveSlotCommand >> normalizedBehaviorNameFor: aBehavior [ ifFalse: [ aBehavior name ]) asString ] -{ #category : 'private' } -MCPRemoveSlotCommand >> refactoringBehaviorForClass: aClass [ - - ^ self classSide - ifTrue: [ aClass classSide ] - ifFalse: [ aClass ] -] - { #category : 'private' } MCPRemoveSlotCommand >> refactoringForBehavior: aBehavior [ diff --git a/src/MCP/MCPRenameClassCommand.class.st b/src/MCP/MCPRenameClassCommand.class.st index 7582be7..9f0decc 100644 --- a/src/MCP/MCPRenameClassCommand.class.st +++ b/src/MCP/MCPRenameClassCommand.class.st @@ -5,7 +5,7 @@ It preserves the old class name for reporting and returns the renamed class meta " Class { #name : 'MCPRenameClassCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'newClassName', diff --git a/src/MCP/MCPRenameClassResult.class.st b/src/MCP/MCPRenameClassResult.class.st index fdc4cc9..45383ae 100644 --- a/src/MCP/MCPRenameClassResult.class.st +++ b/src/MCP/MCPRenameClassResult.class.st @@ -5,7 +5,7 @@ It carries the updated class info and both old and new class names. " Class { #name : 'MCPRenameClassResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldClassName', @@ -30,7 +30,7 @@ MCPRenameClassResult class >> classInfo: aClassInfo oldClassName: anOldClassName MCPRenameClassResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldClassName put: self oldClassName. data at: #newClassName put: self newClassName. ^ data diff --git a/src/MCP/MCPRenameSlotCommand.class.st b/src/MCP/MCPRenameSlotCommand.class.st index 775e4b7..1fb9694 100644 --- a/src/MCP/MCPRenameSlotCommand.class.st +++ b/src/MCP/MCPRenameSlotCommand.class.st @@ -3,7 +3,7 @@ Renames a slot on a class. Instance-side renames use the refactoring engine. Cla " Class { #name : 'MCPRenameSlotCommand', - #superclass : 'Object', + #superclass : 'MCPClassSlotCommand', #instVars : [ 'className', 'slotName', @@ -91,12 +91,6 @@ MCPRenameSlotCommand >> classSideSlotValuesForBehavior: aBehavior [ ^ values asArray ] -{ #category : 'private' } -MCPRenameSlotCommand >> currentClass [ - - ^ MCPImageLookup classNamed: self className -] - { #category : 'executing' } MCPRenameSlotCommand >> execute [ diff --git a/src/MCP/MCPRenameSlotResult.class.st b/src/MCP/MCPRenameSlotResult.class.st index 8ef6e1a..49eb8f6 100644 --- a/src/MCP/MCPRenameSlotResult.class.st +++ b/src/MCP/MCPRenameSlotResult.class.st @@ -3,7 +3,7 @@ Captures the updated class state after renaming a slot. " Class { #name : 'MCPRenameSlotResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldSlotName', @@ -30,7 +30,7 @@ MCPRenameSlotResult class >> classInfo: aClassInfo oldSlotName: anOldSlotName ne MCPRenameSlotResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldSlotName put: self oldSlotName. data at: #newSlotName put: self newSlotName. data at: #classSide put: self classSide. diff --git a/src/MCP/MCPReparentClassCommand.class.st b/src/MCP/MCPReparentClassCommand.class.st index a6d26ff..6c9b5f1 100644 --- a/src/MCP/MCPReparentClassCommand.class.st +++ b/src/MCP/MCPReparentClassCommand.class.st @@ -5,7 +5,7 @@ It records the previous superclass and returns MCPReparentClassResult with updat " Class { #name : 'MCPReparentClassCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'superclassName' @@ -48,12 +48,6 @@ MCPReparentClassCommand >> className: aString [ className := aString ] -{ #category : 'private' } -MCPReparentClassCommand >> currentClass [ - - ^ MCPImageLookup classNamed: self className -] - { #category : 'executing' } MCPReparentClassCommand >> execute [ diff --git a/src/MCP/MCPReparentClassResult.class.st b/src/MCP/MCPReparentClassResult.class.st index 28c1740..a3e0e90 100644 --- a/src/MCP/MCPReparentClassResult.class.st +++ b/src/MCP/MCPReparentClassResult.class.st @@ -5,7 +5,7 @@ It carries the updated class info and the old superclass name. " Class { #name : 'MCPReparentClassResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldSuperclassName' @@ -28,7 +28,7 @@ MCPReparentClassResult class >> classInfo: aClassInfo oldSuperclassName: anOldSu MCPReparentClassResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldSuperclassName put: self oldSuperclassName. ^ data ] diff --git a/src/MCP/MCPReplaceClassDefinitionCommand.class.st b/src/MCP/MCPReplaceClassDefinitionCommand.class.st index 190ee2f..7b38fd1 100644 --- a/src/MCP/MCPReplaceClassDefinitionCommand.class.st +++ b/src/MCP/MCPReplaceClassDefinitionCommand.class.st @@ -3,7 +3,7 @@ Replaces the slot shape of an existing class using the Shift class installer. Om " Class { #name : 'MCPReplaceClassDefinitionCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'slotNames', diff --git a/src/MCP/MCPReplaceClassDefinitionResult.class.st b/src/MCP/MCPReplaceClassDefinitionResult.class.st index 9712f8b..860488b 100644 --- a/src/MCP/MCPReplaceClassDefinitionResult.class.st +++ b/src/MCP/MCPReplaceClassDefinitionResult.class.st @@ -5,7 +5,7 @@ It carries the class state after replacement and the old/new instance-side and c " Class { #name : 'MCPReplaceClassDefinitionResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldInstanceSlotNames', @@ -30,7 +30,7 @@ MCPReplaceClassDefinitionResult class >> classInfo: aClassInfo [ MCPReplaceClassDefinitionResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldInstanceSlotNames put: self oldInstanceSlotNames. data at: #newInstanceSlotNames put: self newInstanceSlotNames. data at: #oldClassSlotNames put: self oldClassSlotNames. diff --git a/src/MCP/MCPReplaceClassLayoutCommand.class.st b/src/MCP/MCPReplaceClassLayoutCommand.class.st index 712cfe8..dce7420 100644 --- a/src/MCP/MCPReplaceClassLayoutCommand.class.st +++ b/src/MCP/MCPReplaceClassLayoutCommand.class.st @@ -3,7 +3,7 @@ Replaces the layout of an existing class using the Shift class installer and ret " Class { #name : 'MCPReplaceClassLayoutCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'layout' diff --git a/src/MCP/MCPReplaceClassLayoutResult.class.st b/src/MCP/MCPReplaceClassLayoutResult.class.st index 3db286a..2068f26 100644 --- a/src/MCP/MCPReplaceClassLayoutResult.class.st +++ b/src/MCP/MCPReplaceClassLayoutResult.class.st @@ -5,7 +5,7 @@ It carries the class state after replacement and the old/new layout class names " Class { #name : 'MCPReplaceClassLayoutResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldLayoutClassName', @@ -30,7 +30,7 @@ MCPReplaceClassLayoutResult class >> classInfo: aClassInfo oldLayoutClassName: o MCPReplaceClassLayoutResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldLayoutClassName put: self oldLayoutClassName. data at: #newLayoutClassName put: self newLayoutClassName. ^ data diff --git a/src/MCP/MCPReplaceClassSharedPoolsCommand.class.st b/src/MCP/MCPReplaceClassSharedPoolsCommand.class.st index ef53c92..3bf1416 100644 --- a/src/MCP/MCPReplaceClassSharedPoolsCommand.class.st +++ b/src/MCP/MCPReplaceClassSharedPoolsCommand.class.st @@ -3,7 +3,7 @@ Replaces the shared pools of an existing class using the Shift class installer a " Class { #name : 'MCPReplaceClassSharedPoolsCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'sharedPoolNames' diff --git a/src/MCP/MCPReplaceClassSharedPoolsResult.class.st b/src/MCP/MCPReplaceClassSharedPoolsResult.class.st index e868c76..0adb339 100644 --- a/src/MCP/MCPReplaceClassSharedPoolsResult.class.st +++ b/src/MCP/MCPReplaceClassSharedPoolsResult.class.st @@ -5,7 +5,7 @@ It carries the class state after replacement and the old/new shared pool name li " Class { #name : 'MCPReplaceClassSharedPoolsResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldSharedPoolNames', @@ -30,7 +30,7 @@ MCPReplaceClassSharedPoolsResult class >> classInfo: aClassInfo oldSharedPoolNam MCPReplaceClassSharedPoolsResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldSharedPoolNames put: self oldSharedPoolNames. data at: #newSharedPoolNames put: self newSharedPoolNames. ^ data diff --git a/src/MCP/MCPReplaceClassSharedVariablesCommand.class.st b/src/MCP/MCPReplaceClassSharedVariablesCommand.class.st index ed281b9..0d2746c 100644 --- a/src/MCP/MCPReplaceClassSharedVariablesCommand.class.st +++ b/src/MCP/MCPReplaceClassSharedVariablesCommand.class.st @@ -3,7 +3,7 @@ Replaces the class variables of an existing class using the Shift class installe " Class { #name : 'MCPReplaceClassSharedVariablesCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'sharedVariableNames' diff --git a/src/MCP/MCPReplaceClassSharedVariablesResult.class.st b/src/MCP/MCPReplaceClassSharedVariablesResult.class.st index 98bce3a..c2256c7 100644 --- a/src/MCP/MCPReplaceClassSharedVariablesResult.class.st +++ b/src/MCP/MCPReplaceClassSharedVariablesResult.class.st @@ -5,7 +5,7 @@ It carries the class state after replacement and the old/new shared variable nam " Class { #name : 'MCPReplaceClassSharedVariablesResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldSharedVariableNames', @@ -30,7 +30,7 @@ MCPReplaceClassSharedVariablesResult class >> classInfo: aClassInfo oldSharedVar MCPReplaceClassSharedVariablesResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldSharedVariableNames put: self oldSharedVariableNames. data at: #newSharedVariableNames put: self newSharedVariableNames. ^ data diff --git a/src/MCP/MCPReplaceClassSideTraitsCommand.class.st b/src/MCP/MCPReplaceClassSideTraitsCommand.class.st index dde8e4a..8e0e7a5 100644 --- a/src/MCP/MCPReplaceClassSideTraitsCommand.class.st +++ b/src/MCP/MCPReplaceClassSideTraitsCommand.class.st @@ -3,7 +3,7 @@ Replaces the class-side traits of an existing class and returns a DTO describing " Class { #name : 'MCPReplaceClassSideTraitsCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'classTraitNames' diff --git a/src/MCP/MCPReplaceClassSideTraitsResult.class.st b/src/MCP/MCPReplaceClassSideTraitsResult.class.st index 0c76890..2e1c3a7 100644 --- a/src/MCP/MCPReplaceClassSideTraitsResult.class.st +++ b/src/MCP/MCPReplaceClassSideTraitsResult.class.st @@ -5,7 +5,7 @@ It carries the class state after replacement and the old/new class-side trait na " Class { #name : 'MCPReplaceClassSideTraitsResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldClassTraitNames', @@ -30,7 +30,7 @@ MCPReplaceClassSideTraitsResult class >> classInfo: aClassInfo oldClassTraitName MCPReplaceClassSideTraitsResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldClassTraitNames put: self oldClassTraitNames. data at: #newClassTraitNames put: self newClassTraitNames. ^ data diff --git a/src/MCP/MCPReplaceClassTraitsCommand.class.st b/src/MCP/MCPReplaceClassTraitsCommand.class.st index 3feef81..9a1e9a9 100644 --- a/src/MCP/MCPReplaceClassTraitsCommand.class.st +++ b/src/MCP/MCPReplaceClassTraitsCommand.class.st @@ -3,7 +3,7 @@ Replaces the instance-side trait composition of an existing class and returns a " Class { #name : 'MCPReplaceClassTraitsCommand', - #superclass : 'Object', + #superclass : 'MCPClassCommand', #instVars : [ 'className', 'traitNames' diff --git a/src/MCP/MCPReplaceClassTraitsResult.class.st b/src/MCP/MCPReplaceClassTraitsResult.class.st index e99ddd9..f57263f 100644 --- a/src/MCP/MCPReplaceClassTraitsResult.class.st +++ b/src/MCP/MCPReplaceClassTraitsResult.class.st @@ -5,7 +5,7 @@ It carries the class state after replacement and the old/new trait name lists fo " Class { #name : 'MCPReplaceClassTraitsResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'oldTraitNames', @@ -30,7 +30,7 @@ MCPReplaceClassTraitsResult class >> classInfo: aClassInfo oldTraitNames: oldNam MCPReplaceClassTraitsResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #oldTraitNames put: self oldTraitNames. data at: #newTraitNames put: self newTraitNames. ^ data diff --git a/src/MCP/MCPRepositoryCommand.class.st b/src/MCP/MCPRepositoryCommand.class.st index e5c7e4e..792d82c 100644 --- a/src/MCP/MCPRepositoryCommand.class.st +++ b/src/MCP/MCPRepositoryCommand.class.st @@ -3,11 +3,7 @@ Abstract base for repository command objects. It owns the shared tool/request st " Class { #name : 'MCPRepositoryCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' @@ -19,14 +15,6 @@ MCPRepositoryCommand class >> isAbstract [ ^ self = MCPRepositoryCommand ] -{ #category : 'instance creation' } -MCPRepositoryCommand class >> tool: aTool request: aRequest [ - - ^ self new - initializeTool: aTool request: aRequest; - yourself -] - { #category : 'private - execution' } MCPRepositoryCommand >> executeRepositoryAction: actionName work: workBlock successResult: successBlock failureSummary: failureBlock [ @@ -39,27 +27,8 @@ MCPRepositoryCommand >> executeRepositoryAction: actionName work: workBlock succ failureSummary: failureBlock ] -{ #category : 'initialization' } -MCPRepositoryCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest -] - -{ #category : 'accessing' } -MCPRepositoryCommand >> request [ - - ^ request -] - { #category : 'private' } MCPRepositoryCommand >> sortedStringsFrom: aCollection [ ^ (aCollection collect: [ :each | each asString ]) asSet asArray sort ] - -{ #category : 'accessing' } -MCPRepositoryCommand >> tool [ - - ^ tool -] diff --git a/src/MCP/MCPRewriteMethodsCommand.class.st b/src/MCP/MCPRewriteMethodsCommand.class.st index 37d6c34..dfc2e88 100644 --- a/src/MCP/MCPRewriteMethodsCommand.class.st +++ b/src/MCP/MCPRewriteMethodsCommand.class.st @@ -5,22 +5,12 @@ It resolves the method scope, delegates pattern matching to the NewTools rewrite " Class { #name : 'MCPRewriteMethodsCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPRewriteMethodsCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'private - rewriting' } MCPRewriteMethodsCommand >> applyChanges: changes [ @@ -111,26 +101,12 @@ MCPRewriteMethodsCommand >> hashForChange: aChange [ into: [ :hash :valueHash | (hash bitXor: valueHash) hashMultiply ] ] -{ #category : 'initialization' } -MCPRewriteMethodsCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - { #category : 'private - rewriting' } MCPRewriteMethodsCommand >> refactoringChangeManager [ ^ PharoCompatibility refactoringChangeManagerClass instance ] -{ #category : 'accessing' } -MCPRewriteMethodsCommand >> request [ - - ^ request -] - { #category : 'private - rewriting' } MCPRewriteMethodsCommand >> rewriteChanges [ @@ -223,12 +199,6 @@ MCPRewriteMethodsCommand >> successSummaryForReport: report [ , ' method rewrite change(s).' ] -{ #category : 'accessing' } -MCPRewriteMethodsCommand >> tool [ - - ^ tool -] - { #category : 'private - validating' } MCPRewriteMethodsCommand >> validateExpectedChangeSetHash: changeSetHashInteger [ diff --git a/src/MCP/MCPRunTestsCommand.class.st b/src/MCP/MCPRunTestsCommand.class.st index b9aa8bc..48de5fa 100644 --- a/src/MCP/MCPRunTestsCommand.class.st +++ b/src/MCP/MCPRunTestsCommand.class.st @@ -5,22 +5,12 @@ It resolves MCPTestRunRequest objects to MCPValidatedTestRunRequest objects, exe " Class { #name : 'MCPRunTestsCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPRunTestsCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'private' } MCPRunTestsCommand >> addTestCasesFrom: aTestOrSuite to: testCases [ @@ -104,14 +94,6 @@ MCPRunTestsCommand >> hasTimedOutAt: deadline [ ^ (self millisecondsRemainingUntil: deadline) <= 0 ] -{ #category : 'initialization' } -MCPRunTestsCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - { #category : 'private - timeout' } MCPRunTestsCommand >> millisecondsRemainingUntil: deadline [ @@ -133,12 +115,6 @@ MCPRunTestsCommand >> refreshRegisteredRepositoryDirtyPackages [ repository workingCopy refreshDirtyPackages ] ] ] -{ #category : 'accessing' } -MCPRunTestsCommand >> request [ - - ^ request -] - { #category : 'private' } MCPRunTestsCommand >> resultForValidatedRequest: validatedRequest deadline: deadline seenTestCaseNames: seenTestCaseNames [ @@ -338,12 +314,6 @@ MCPRunTestsCommand >> testRunInfoForTestResult: aResult validatedRequest: valida issues: issues ] -{ #category : 'accessing' } -MCPRunTestsCommand >> tool [ - - ^ tool -] - { #category : 'private' } MCPRunTestsCommand >> uniqueTestCasesForValidatedRequest: validatedRequest seenTestCaseNames: seenTestCaseNames [ diff --git a/src/MCP/MCPScreenshotCommand.class.st b/src/MCP/MCPScreenshotCommand.class.st index 4c95335..d9aa228 100644 --- a/src/MCP/MCPScreenshotCommand.class.st +++ b/src/MCP/MCPScreenshotCommand.class.st @@ -5,10 +5,8 @@ It supports the world target and uses an injectable form provider so tests can e " Class { #name : 'MCPScreenshotCommand', - #superclass : 'Object', + #superclass : 'MCPToolRequestCommand', #instVars : [ - 'tool', - 'request', 'formProvider' ], #category : 'MCP-Commands', @@ -72,20 +70,6 @@ MCPScreenshotCommand >> formProvider [ { #category : 'initialization' } MCPScreenshotCommand >> initializeTool: aTool request: aRequest formProvider: aBlock [ - tool := aTool. - request := aRequest. - formProvider := aBlock ifNil: [ [ self captureWorldForm ] ]. - ^ self -] - -{ #category : 'accessing' } -MCPScreenshotCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPScreenshotCommand >> tool [ - - ^ tool + super initializeTool: aTool request: aRequest. + formProvider := aBlock ifNil: [ [ self captureWorldForm ] ] ] diff --git a/src/MCP/MCPSearchToolCommand.class.st b/src/MCP/MCPSearchToolCommand.class.st index 190a868..b1f16c5 100644 --- a/src/MCP/MCPSearchToolCommand.class.st +++ b/src/MCP/MCPSearchToolCommand.class.st @@ -3,51 +3,14 @@ Command object used by search tools. It executes a parsed search request against " Class { #name : 'MCPSearchToolCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPSearchToolCommand class >> tool: aTool request: aRequest [ - - ^ self new - tool: aTool; - request: aRequest; - yourself -] - { #category : 'executing' } MCPSearchToolCommand >> execute [ ^ tool queryEntriesForQueryRequest: request ] - -{ #category : 'accessing' } -MCPSearchToolCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPSearchToolCommand >> request: anObject [ - - request := anObject -] - -{ #category : 'accessing' } -MCPSearchToolCommand >> tool [ - - ^ tool -] - -{ #category : 'accessing' } -MCPSearchToolCommand >> tool: anObject [ - - tool := anObject -] diff --git a/src/MCP/MCPSearchToolsCommand.class.st b/src/MCP/MCPSearchToolsCommand.class.st index 601363f..af5f255 100644 --- a/src/MCP/MCPSearchToolsCommand.class.st +++ b/src/MCP/MCPSearchToolsCommand.class.st @@ -5,10 +5,8 @@ This command supports the discoverable-tool workflow: agents can search by text " Class { #name : 'MCPSearchToolsCommand', - #superclass : 'Object', + #superclass : 'MCPToolRequestCommand', #instVars : [ - 'tool', - 'request', 'toolExposurePolicy' ], #category : 'MCP-Commands', @@ -29,8 +27,7 @@ MCPSearchToolsCommand class >> tool: aTool request: aRequest [ MCPSearchToolsCommand class >> tool: aTool request: aRequest toolExposurePolicy: aToolExposurePolicy [ ^ self new - tool: aTool; - request: aRequest; + initializeTool: aTool request: aRequest; toolExposurePolicy: aToolExposurePolicy; yourself ] @@ -51,30 +48,6 @@ MCPSearchToolsCommand >> execute [ asDictionary ] -{ #category : 'accessing' } -MCPSearchToolsCommand >> request [ - - ^ request -] - -{ #category : 'accessing' } -MCPSearchToolsCommand >> request: anObject [ - - request := anObject -] - -{ #category : 'accessing' } -MCPSearchToolsCommand >> tool [ - - ^ tool -] - -{ #category : 'accessing' } -MCPSearchToolsCommand >> tool: anObject [ - - tool := anObject -] - { #category : 'accessing' } MCPSearchToolsCommand >> toolExposurePolicy [ diff --git a/src/MCP/MCPSlotResult.class.st b/src/MCP/MCPSlotResult.class.st index ec81670..aaed110 100644 --- a/src/MCP/MCPSlotResult.class.st +++ b/src/MCP/MCPSlotResult.class.st @@ -3,7 +3,7 @@ Captures the updated class state after a slot update. " Class { #name : 'MCPSlotResult', - #superclass : 'Object', + #superclass : 'MCPClassResult', #instVars : [ 'classInfo', 'slotName', @@ -28,7 +28,7 @@ MCPSlotResult class >> classInfo: aClassInfo slotName: aSlotName classSide: aBoo MCPSlotResult >> asDictionary [ | data | - data := self classInfo asDictionary copy. + data := self newClassInfoDictionary. data at: #slotName put: self slotName. data at: #classSide put: self classSide. ^ data diff --git a/src/MCP/MCPToolRequestCommand.class.st b/src/MCP/MCPToolRequestCommand.class.st new file mode 100644 index 0000000..d9db796 --- /dev/null +++ b/src/MCP/MCPToolRequestCommand.class.st @@ -0,0 +1,47 @@ +" +Abstract command for tool executions that carry the invoking tool and one validated request object. + +Subclasses implement #execute and use #tool and #request to collaborate with the owning tool and request. +" +Class { + #name : 'MCPToolRequestCommand', + #superclass : 'MCPCommand', + #instVars : [ + 'tool', + 'request' + ], + #category : 'MCP-Commands', + #package : 'MCP', + #tag : 'Commands' +} + +{ #category : 'testing' } +MCPToolRequestCommand class >> isAbstract [ + + ^ self == MCPToolRequestCommand +] + +{ #category : 'instance creation' } +MCPToolRequestCommand class >> tool: aTool request: aRequest [ + + ^ self new initializeTool: aTool request: aRequest +] + +{ #category : 'initialization' } +MCPToolRequestCommand >> initializeTool: aTool request: aRequest [ + + tool := aTool. + request := aRequest +] + +{ #category : 'accessing' } +MCPToolRequestCommand >> request [ + + ^ request +] + +{ #category : 'accessing' } +MCPToolRequestCommand >> tool [ + + ^ tool +] diff --git a/src/MCP/MCPUpdateClassCommand.class.st b/src/MCP/MCPUpdateClassCommand.class.st index 8c5fa01..c78ea2e 100644 --- a/src/MCP/MCPUpdateClassCommand.class.st +++ b/src/MCP/MCPUpdateClassCommand.class.st @@ -5,7 +5,7 @@ It builds an MCPClassUpdatePlanInfo for the selected internal update action, dis " Class { #name : 'MCPUpdateClassCommand', - #superclass : 'Object', + #superclass : 'MCPCommand', #instVars : [ 'tool', 'classRequest' diff --git a/src/MCP/MCPUpdateMethodCommand.class.st b/src/MCP/MCPUpdateMethodCommand.class.st index dbc13bb..ecb5941 100644 --- a/src/MCP/MCPUpdateMethodCommand.class.st +++ b/src/MCP/MCPUpdateMethodCommand.class.st @@ -3,22 +3,12 @@ Command for applying one method update patch. It selects an internal method upda " Class { #name : 'MCPUpdateMethodCommand', - #superclass : 'Object', - #instVars : [ - 'tool', - 'request' - ], + #superclass : 'MCPToolRequestCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' } -{ #category : 'instance creation' } -MCPUpdateMethodCommand class >> tool: aTool request: aRequest [ - - ^ self new initializeTool: aTool request: aRequest -] - { #category : 'private - results' } MCPUpdateMethodCommand >> appliedUpdateResultFor: aChangeResult plan: plan [ @@ -337,14 +327,6 @@ MCPUpdateMethodCommand >> executeRenameWithPlan: plan [ error: error ] ] -{ #category : 'initialization' } -MCPUpdateMethodCommand >> initializeTool: aTool request: aRequest [ - - tool := aTool. - request := aRequest. - ^ self -] - { #category : 'private - methods' } MCPUpdateMethodCommand >> protocolNameForMethod: aCompiledMethod [ @@ -353,12 +335,6 @@ MCPUpdateMethodCommand >> protocolNameForMethod: aCompiledMethod [ ifNotNil: [ :aProtocol | aProtocol name asString ] ] -{ #category : 'accessing' } -MCPUpdateMethodCommand >> request [ - - ^ request -] - { #category : 'private - planning' } MCPUpdateMethodCommand >> requestedContextForAction: action [ @@ -413,12 +389,6 @@ MCPUpdateMethodCommand >> signalNoUpdateRequested [ details: self request requestedContext ] -{ #category : 'accessing' } -MCPUpdateMethodCommand >> tool [ - - ^ tool -] - { #category : 'accessing' } MCPUpdateMethodCommand >> updateAction [ From 57bfbbac10961cc953ff6e115e38f008f6cb1b69 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Wed, 24 Jun 2026 19:49:23 +0200 Subject: [PATCH 08/21] Consolidate package tags Co-authored-by: Codex --- src/MCP/MCPClassUpdatePlanInfo.class.st | 4 ++-- src/MCP/MCPGitRepositoryMetadata.class.st | 4 ++-- src/MCP/MCPImageCodeChangeTracker.class.st | 4 ++-- src/MCP/MCPMethodUpdatePlanInfo.class.st | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/MCP/MCPClassUpdatePlanInfo.class.st b/src/MCP/MCPClassUpdatePlanInfo.class.st index 0017d6c..1a1c1ab 100644 --- a/src/MCP/MCPClassUpdatePlanInfo.class.st +++ b/src/MCP/MCPClassUpdatePlanInfo.class.st @@ -10,9 +10,9 @@ Class { 'requestedContext', 'updateAction' ], - #category : 'MCP-Results', + #category : 'MCP-DTOs', #package : 'MCP', - #tag : 'Results' + #tag : 'DTOs' } { #category : 'instance creation' } diff --git a/src/MCP/MCPGitRepositoryMetadata.class.st b/src/MCP/MCPGitRepositoryMetadata.class.st index 9ecfe4a..caf4ff5 100644 --- a/src/MCP/MCPGitRepositoryMetadata.class.st +++ b/src/MCP/MCPGitRepositoryMetadata.class.st @@ -11,9 +11,9 @@ Class { 'gitDirectory', 'configEntries' ], - #category : 'MCP-Support', + #category : 'MCP-Utilities', #package : 'MCP', - #tag : 'Support' + #tag : 'Utilities' } { #category : 'instance creation' } diff --git a/src/MCP/MCPImageCodeChangeTracker.class.st b/src/MCP/MCPImageCodeChangeTracker.class.st index 2d1e27f..bae2f06 100644 --- a/src/MCP/MCPImageCodeChangeTracker.class.st +++ b/src/MCP/MCPImageCodeChangeTracker.class.st @@ -11,9 +11,9 @@ Class { 'hasChanges', 'affectedPackageNames' ], - #category : 'MCP-Commands', + #category : 'MCP-Utilities', #package : 'MCP', - #tag : 'Commands' + #tag : 'Utilities' } { #category : 'accessing' } diff --git a/src/MCP/MCPMethodUpdatePlanInfo.class.st b/src/MCP/MCPMethodUpdatePlanInfo.class.st index 6d6c1f4..db523c9 100644 --- a/src/MCP/MCPMethodUpdatePlanInfo.class.st +++ b/src/MCP/MCPMethodUpdatePlanInfo.class.st @@ -8,9 +8,9 @@ Class { 'requestedContext', 'updateAction' ], - #category : 'MCP-Results', + #category : 'MCP-DTOs', #package : 'MCP', - #tag : 'Results' + #tag : 'DTOs' } { #category : 'instance creation' } From 3e86ea650e65f48977d2b6cc4342581e81d101c7 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Thu, 25 Jun 2026 10:26:23 +0200 Subject: [PATCH 09/21] Introduce DTO base class Co-authored-by: Codex --- src/MCP-Tests/MCPToolContractsTest.class.st | 1 + src/MCP/MCPChangeHistoryEntryInfo.class.st | 2 +- src/MCP/MCPChangeHistoryLogInfo.class.st | 2 +- src/MCP/MCPClassDescriptionInfo.class.st | 2 +- src/MCP/MCPClassInfo.class.st | 2 +- src/MCP/MCPClassUpdatePlanInfo.class.st | 2 +- src/MCP/MCPCompiledMethodInfo.class.st | 8 ++++++- src/MCP/MCPDataTransferObject.class.st | 24 +++++++++++++++++++++ src/MCP/MCPIcebergCommitInfo.class.st | 4 ++-- src/MCP/MCPMethodRewriteChangeInfo.class.st | 2 +- src/MCP/MCPMethodUpdatePlanInfo.class.st | 2 +- src/MCP/MCPPackageInfo.class.st | 2 +- src/MCP/MCPRepositoryInfo.class.st | 2 +- src/MCP/MCPRepositoryPackageInfo.class.st | 2 +- src/MCP/MCPTestRunInfo.class.st | 2 +- 15 files changed, 45 insertions(+), 14 deletions(-) create mode 100644 src/MCP/MCPDataTransferObject.class.st diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 7636de0..6ed9794 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -2052,6 +2052,7 @@ MCPToolContractsTest >> testOutputDtoClassesUseResultInfoOrReportSuffixes [ | dtoClasses invalidNames suffixes | dtoClasses := (self mcpClassesInPackageTagNamed: 'DTOs') , (self mcpClassesInPackageTagNamed: 'Results'). + dtoClasses := dtoClasses reject: [ :each | each isAbstract ]. suffixes := #( 'Result' 'Info' 'Report' ). invalidNames := dtoClasses reject: [ :each | suffixes anySatisfy: [ :suffix | diff --git a/src/MCP/MCPChangeHistoryEntryInfo.class.st b/src/MCP/MCPChangeHistoryEntryInfo.class.st index e9b16b3..31c050f 100644 --- a/src/MCP/MCPChangeHistoryEntryInfo.class.st +++ b/src/MCP/MCPChangeHistoryEntryInfo.class.st @@ -3,7 +3,7 @@ Structured metadata for one entry in image change history. " Class { #name : 'MCPChangeHistoryEntryInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'index', 'eventClassName', diff --git a/src/MCP/MCPChangeHistoryLogInfo.class.st b/src/MCP/MCPChangeHistoryLogInfo.class.st index 67affb3..240b463 100644 --- a/src/MCP/MCPChangeHistoryLogInfo.class.st +++ b/src/MCP/MCPChangeHistoryLogInfo.class.st @@ -3,7 +3,7 @@ Structured metadata for one change history file. " Class { #name : 'MCPChangeHistoryLogInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'fileName', 'exists', diff --git a/src/MCP/MCPClassDescriptionInfo.class.st b/src/MCP/MCPClassDescriptionInfo.class.st index 1c3c301..b3d82b8 100644 --- a/src/MCP/MCPClassDescriptionInfo.class.st +++ b/src/MCP/MCPClassDescriptionInfo.class.st @@ -5,7 +5,7 @@ It includes package, tag, layout, slots, traits, pools, shared variables, method " Class { #name : 'MCPClassDescriptionInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'className', 'superclassName', diff --git a/src/MCP/MCPClassInfo.class.st b/src/MCP/MCPClassInfo.class.st index 8fc1434..13c8ad1 100644 --- a/src/MCP/MCPClassInfo.class.st +++ b/src/MCP/MCPClassInfo.class.st @@ -5,7 +5,7 @@ It describes class identity, package placement, slots, traits, shared variables, " Class { #name : 'MCPClassInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'className', 'superclassName', diff --git a/src/MCP/MCPClassUpdatePlanInfo.class.st b/src/MCP/MCPClassUpdatePlanInfo.class.st index 1a1c1ab..c028250 100644 --- a/src/MCP/MCPClassUpdatePlanInfo.class.st +++ b/src/MCP/MCPClassUpdatePlanInfo.class.st @@ -5,7 +5,7 @@ It records the selected update action and the request context used for validatio " Class { #name : 'MCPClassUpdatePlanInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'requestedContext', 'updateAction' diff --git a/src/MCP/MCPCompiledMethodInfo.class.st b/src/MCP/MCPCompiledMethodInfo.class.st index bc726c4..2f25567 100644 --- a/src/MCP/MCPCompiledMethodInfo.class.st +++ b/src/MCP/MCPCompiledMethodInfo.class.st @@ -5,7 +5,7 @@ It records selector, declaring class, class-side flag, protocol, package, extens " Class { #name : 'MCPCompiledMethodInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'className', 'selector', @@ -26,6 +26,12 @@ MCPCompiledMethodInfo class >> fromMethod: aCompiledMethod [ ^ self new initializeFromMethod: aCompiledMethod ] +{ #category : 'converting' } +MCPCompiledMethodInfo >> asDictionary [ + + ^ self asDictionaryIncludingSource: false +] + { #category : 'converting' } MCPCompiledMethodInfo >> asDictionaryIncludingSource: includeSource [ diff --git a/src/MCP/MCPDataTransferObject.class.st b/src/MCP/MCPDataTransferObject.class.st new file mode 100644 index 0000000..8fb3984 --- /dev/null +++ b/src/MCP/MCPDataTransferObject.class.st @@ -0,0 +1,24 @@ +" +Abstract base for MCP value objects that can be rendered as compact dictionaries. + +Subclasses implement #asDictionary. +" +Class { + #name : 'MCPDataTransferObject', + #superclass : 'Object', + #category : 'MCP-DTOs', + #package : 'MCP', + #tag : 'DTOs' +} + +{ #category : 'testing' } +MCPDataTransferObject class >> isAbstract [ + + ^ self == MCPDataTransferObject +] + +{ #category : 'converting' } +MCPDataTransferObject >> asDictionary [ + + self subclassResponsibility +] diff --git a/src/MCP/MCPIcebergCommitInfo.class.st b/src/MCP/MCPIcebergCommitInfo.class.st index afac8ca..c2dc7cf 100644 --- a/src/MCP/MCPIcebergCommitInfo.class.st +++ b/src/MCP/MCPIcebergCommitInfo.class.st @@ -6,9 +6,9 @@ Iceberg has exposed commit metadata through slightly different protocols across Class { #name : 'MCPIcebergCommitInfo', #superclass : 'Object', - #category : 'MCP-DTOs', + #category : 'MCP-Utilities', #package : 'MCP', - #tag : 'DTOs' + #tag : 'Utilities' } { #category : 'accessing' } diff --git a/src/MCP/MCPMethodRewriteChangeInfo.class.st b/src/MCP/MCPMethodRewriteChangeInfo.class.st index aca25d9..35008ca 100644 --- a/src/MCP/MCPMethodRewriteChangeInfo.class.st +++ b/src/MCP/MCPMethodRewriteChangeInfo.class.st @@ -5,7 +5,7 @@ It records the affected method identity and, when requested, the before and afte " Class { #name : 'MCPMethodRewriteChangeInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'className', 'classSide', diff --git a/src/MCP/MCPMethodUpdatePlanInfo.class.st b/src/MCP/MCPMethodUpdatePlanInfo.class.st index db523c9..5a1a55c 100644 --- a/src/MCP/MCPMethodUpdatePlanInfo.class.st +++ b/src/MCP/MCPMethodUpdatePlanInfo.class.st @@ -3,7 +3,7 @@ DTO for the method update action selected from an update request before the acti " Class { #name : 'MCPMethodUpdatePlanInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'requestedContext', 'updateAction' diff --git a/src/MCP/MCPPackageInfo.class.st b/src/MCP/MCPPackageInfo.class.st index beff83c..62e404f 100644 --- a/src/MCP/MCPPackageInfo.class.st +++ b/src/MCP/MCPPackageInfo.class.st @@ -5,7 +5,7 @@ It records package name, project names, tag names, class and extension method co " Class { #name : 'MCPPackageInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'packageName', 'projectNames', diff --git a/src/MCP/MCPRepositoryInfo.class.st b/src/MCP/MCPRepositoryInfo.class.st index 81e17a3..bceaab1 100644 --- a/src/MCP/MCPRepositoryInfo.class.st +++ b/src/MCP/MCPRepositoryInfo.class.st @@ -5,7 +5,7 @@ It is read-only and intended for repository_search responses and repository oper " Class { #name : 'MCPRepositoryInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'name', 'className', diff --git a/src/MCP/MCPRepositoryPackageInfo.class.st b/src/MCP/MCPRepositoryPackageInfo.class.st index 923f8cf..efea014 100644 --- a/src/MCP/MCPRepositoryPackageInfo.class.st +++ b/src/MCP/MCPRepositoryPackageInfo.class.st @@ -5,7 +5,7 @@ It reports package metadata needed by repository management tools without exposi " Class { #name : 'MCPRepositoryPackageInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'name', 'directoryName', diff --git a/src/MCP/MCPTestRunInfo.class.st b/src/MCP/MCPTestRunInfo.class.st index 669844e..4754885 100644 --- a/src/MCP/MCPTestRunInfo.class.st +++ b/src/MCP/MCPTestRunInfo.class.st @@ -5,7 +5,7 @@ It records the selected test class or method, the number of executed tests, and " Class { #name : 'MCPTestRunInfo', - #superclass : 'Object', + #superclass : 'MCPDataTransferObject', #instVars : [ 'className', 'testMethodName', From 9f78c7e07310954c9faad6aed0923937b01edb49 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Thu, 25 Jun 2026 10:38:02 +0200 Subject: [PATCH 10/21] Introduce result base class Co-authored-by: Codex --- src/MCP/MCPAppliedChangeResult.class.st | 2 +- ...MCPChangeHistoryListEntriesResult.class.st | 2 +- .../MCPChangeHistoryListLogsResult.class.st | 2 +- .../MCPChangeHistorySelectionResult.class.st | 2 +- src/MCP/MCPClassResult.class.st | 2 +- src/MCP/MCPDebugToolResult.class.st | 16 ++++++++++++- src/MCP/MCPEvaluateResult.class.st | 14 ++++++++++- src/MCP/MCPGetClassResult.class.st | 14 ++++++++++- src/MCP/MCPGetMethodResult.class.st | 12 +++++++++- src/MCP/MCPLoadBaselineResult.class.st | 2 +- src/MCP/MCPLoadRepositoryResult.class.st | 2 +- src/MCP/MCPMethodCompileResult.class.st | 2 +- src/MCP/MCPMethodRewriteReport.class.st | 2 +- src/MCP/MCPMethodUpdateChangeResult.class.st | 2 +- src/MCP/MCPPaginationResult.class.st | 8 ++++++- src/MCP/MCPRemoveClassesResult.class.st | 2 +- src/MCP/MCPRemoveMethodsResult.class.st | 2 +- src/MCP/MCPRepositoryResult.class.st | 2 +- src/MCP/MCPResult.class.st | 24 +++++++++++++++++++ src/MCP/MCPRunTestsResult.class.st | 2 +- src/MCP/MCPScreenshotResult.class.st | 2 +- src/MCP/MCPTestCoverageResult.class.st | 2 +- src/MCP/MCPTestRunResult.class.st | 2 +- src/MCP/MCPToolRegistry.class.st | 2 +- 24 files changed, 101 insertions(+), 23 deletions(-) create mode 100644 src/MCP/MCPResult.class.st diff --git a/src/MCP/MCPAppliedChangeResult.class.st b/src/MCP/MCPAppliedChangeResult.class.st index 7016028..41ebdd3 100644 --- a/src/MCP/MCPAppliedChangeResult.class.st +++ b/src/MCP/MCPAppliedChangeResult.class.st @@ -5,7 +5,7 @@ Subclasses decide how much of the applied change to expose in #asDictionary. " Class { #name : 'MCPAppliedChangeResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'updatePlan', 'changeResult' diff --git a/src/MCP/MCPChangeHistoryListEntriesResult.class.st b/src/MCP/MCPChangeHistoryListEntriesResult.class.st index ba196df..fd4c673 100644 --- a/src/MCP/MCPChangeHistoryListEntriesResult.class.st +++ b/src/MCP/MCPChangeHistoryListEntriesResult.class.st @@ -3,7 +3,7 @@ Result DTO for listing entries from a change history source. " Class { #name : 'MCPChangeHistoryListEntriesResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'historyFileName', 'entries', diff --git a/src/MCP/MCPChangeHistoryListLogsResult.class.st b/src/MCP/MCPChangeHistoryListLogsResult.class.st index fd98d7c..20fa4e7 100644 --- a/src/MCP/MCPChangeHistoryListLogsResult.class.st +++ b/src/MCP/MCPChangeHistoryListLogsResult.class.st @@ -3,7 +3,7 @@ Result DTO for listing change history files and the directory that was scanned. " Class { #name : 'MCPChangeHistoryListLogsResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'logs', 'directoryPath', diff --git a/src/MCP/MCPChangeHistorySelectionResult.class.st b/src/MCP/MCPChangeHistorySelectionResult.class.st index 75b0ab1..e780582 100644 --- a/src/MCP/MCPChangeHistorySelectionResult.class.st +++ b/src/MCP/MCPChangeHistorySelectionResult.class.st @@ -3,7 +3,7 @@ Structured result for previewing or applying selected image change history entri " Class { #name : 'MCPChangeHistorySelectionResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'historyFileName', 'selectionCriteria', diff --git a/src/MCP/MCPClassResult.class.st b/src/MCP/MCPClassResult.class.st index e52ad89..dba79f5 100644 --- a/src/MCP/MCPClassResult.class.st +++ b/src/MCP/MCPClassResult.class.st @@ -5,7 +5,7 @@ Subclasses provide #classInfo and add operation-specific fields when needed. " Class { #name : 'MCPClassResult', - #superclass : 'Object', + #superclass : 'MCPResult', #category : 'MCP-Results', #package : 'MCP', #tag : 'Results' diff --git a/src/MCP/MCPDebugToolResult.class.st b/src/MCP/MCPDebugToolResult.class.st index d9e6173..753e047 100644 --- a/src/MCP/MCPDebugToolResult.class.st +++ b/src/MCP/MCPDebugToolResult.class.st @@ -5,7 +5,7 @@ It normalizes debugger success, warning, and error payloads before they are rend " Class { #name : 'MCPDebugToolResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'status', 'summary', @@ -46,6 +46,20 @@ MCPDebugToolResult class >> okSummary: aSummary data: aDictionary warnings: warn errorDetails: nil ] +{ #category : 'converting' } +MCPDebugToolResult >> asDictionary [ + + | result | + result := Dictionary new. + result at: #status put: self status. + self summary ifNotNil: [ :text | result at: #summary put: text ]. + self data ifNotEmpty: [ :value | result at: #data put: value ]. + self warnings ifNotEmpty: [ :value | result at: #warnings put: value ]. + self errorDetails ifNotEmpty: [ :value | + result at: #error put: value ]. + ^ result +] + { #category : 'accessing' } MCPDebugToolResult >> data [ diff --git a/src/MCP/MCPEvaluateResult.class.st b/src/MCP/MCPEvaluateResult.class.st index 91ab2cb..e0a0ec1 100644 --- a/src/MCP/MCPEvaluateResult.class.st +++ b/src/MCP/MCPEvaluateResult.class.st @@ -3,7 +3,7 @@ Result DTO produced by the evaluate command. It transports either evaluated data " Class { #name : 'MCPEvaluateResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'status', 'data', @@ -35,6 +35,18 @@ MCPEvaluateResult class >> okData: aDictionary [ errorDetails: nil ] +{ #category : 'converting' } +MCPEvaluateResult >> asDictionary [ + + | result | + result := Dictionary new. + result at: #status put: self status. + self data ifNotNil: [ :value | result at: #data put: value ]. + self summary ifNotNil: [ :text | result at: #summary put: text ]. + self errorDetails ifNotNil: [ :value | result at: #error put: value ]. + ^ result +] + { #category : 'accessing' } MCPEvaluateResult >> data [ diff --git a/src/MCP/MCPGetClassResult.class.st b/src/MCP/MCPGetClassResult.class.st index 8d1525c..4d64af5 100644 --- a/src/MCP/MCPGetClassResult.class.st +++ b/src/MCP/MCPGetClassResult.class.st @@ -3,7 +3,7 @@ Result DTO produced by the class_get command. " Class { #name : 'MCPGetClassResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'className', 'data', @@ -25,6 +25,18 @@ MCPGetClassResult class >> className: aClassName data: aDictionary superclasses: subclasses: subclassCollection ] +{ #category : 'converting' } +MCPGetClassResult >> asDictionary [ + + | result | + result := self data copy. + self superclasses ifNotEmpty: [ :value | + result at: #superclasses put: value ]. + self subclasses ifNotEmpty: [ :value | + result at: #subclasses put: value ]. + ^ result +] + { #category : 'accessing' } MCPGetClassResult >> className [ diff --git a/src/MCP/MCPGetMethodResult.class.st b/src/MCP/MCPGetMethodResult.class.st index 73ad4e3..319a6b8 100644 --- a/src/MCP/MCPGetMethodResult.class.st +++ b/src/MCP/MCPGetMethodResult.class.st @@ -3,7 +3,7 @@ Result DTO produced by the method_get command. " Class { #name : 'MCPGetMethodResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'data', 'externalVariableCount' @@ -21,6 +21,16 @@ MCPGetMethodResult class >> data: aDictionary externalVariableCount: anIntegerOr externalVariableCount: anIntegerOrNil ] +{ #category : 'converting' } +MCPGetMethodResult >> asDictionary [ + + | result | + result := self data copy. + self externalVariableCount ifNotNil: [ :count | + result at: #externalVariableCount put: count ]. + ^ result +] + { #category : 'accessing' } MCPGetMethodResult >> data [ diff --git a/src/MCP/MCPLoadBaselineResult.class.st b/src/MCP/MCPLoadBaselineResult.class.st index f21611b..da891d4 100644 --- a/src/MCP/MCPLoadBaselineResult.class.st +++ b/src/MCP/MCPLoadBaselineResult.class.st @@ -3,7 +3,7 @@ Result DTO for the reusable Metacello baseline load core. It reports baseline gr " Class { #name : 'MCPLoadBaselineResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'baseline', 'groups', diff --git a/src/MCP/MCPLoadRepositoryResult.class.st b/src/MCP/MCPLoadRepositoryResult.class.st index 9e14258..48b54f1 100644 --- a/src/MCP/MCPLoadRepositoryResult.class.st +++ b/src/MCP/MCPLoadRepositoryResult.class.st @@ -3,7 +3,7 @@ Result DTO for repository_load. It wraps the reusable baseline load result and r " Class { #name : 'MCPLoadRepositoryResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'mode', 'repositoryUrl', diff --git a/src/MCP/MCPMethodCompileResult.class.st b/src/MCP/MCPMethodCompileResult.class.st index 0bcb5ad..c546b29 100644 --- a/src/MCP/MCPMethodCompileResult.class.st +++ b/src/MCP/MCPMethodCompileResult.class.st @@ -5,7 +5,7 @@ It reports whether compiling the source created a new method or replaced an exis " Class { #name : 'MCPMethodCompileResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'methodInfo', 'critiques', diff --git a/src/MCP/MCPMethodRewriteReport.class.st b/src/MCP/MCPMethodRewriteReport.class.st index 880de65..d868b00 100644 --- a/src/MCP/MCPMethodRewriteReport.class.st +++ b/src/MCP/MCPMethodRewriteReport.class.st @@ -5,7 +5,7 @@ It summarizes preview or apply mode, calculated and applied change counts, norma " Class { #name : 'MCPMethodRewriteReport', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'apply', 'changeInfos', diff --git a/src/MCP/MCPMethodUpdateChangeResult.class.st b/src/MCP/MCPMethodUpdateChangeResult.class.st index c1b8597..dc6cfb0 100644 --- a/src/MCP/MCPMethodUpdateChangeResult.class.st +++ b/src/MCP/MCPMethodUpdateChangeResult.class.st @@ -3,7 +3,7 @@ DTO for the narrow method update performed by a method update request, such as a " Class { #name : 'MCPMethodUpdateChangeResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'methodInfo', 'oldSelector', diff --git a/src/MCP/MCPPaginationResult.class.st b/src/MCP/MCPPaginationResult.class.st index 9df1739..90b7414 100644 --- a/src/MCP/MCPPaginationResult.class.st +++ b/src/MCP/MCPPaginationResult.class.st @@ -3,7 +3,7 @@ Compact pagination result shared by list and search tools. It keeps MCP payloads " Class { #name : 'MCPPaginationResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'entries', 'nextOffset' @@ -39,6 +39,12 @@ MCPPaginationResult class >> fromEntries: entryCollection limit: limit offset: o offset + pageEntries size ]) ] +{ #category : 'converting' } +MCPPaginationResult >> asDictionary [ + + ^ self asDictionaryWithEntriesKey: #entries +] + { #category : 'converting' } MCPPaginationResult >> asDictionaryWithEntriesKey: entriesKey [ diff --git a/src/MCP/MCPRemoveClassesResult.class.st b/src/MCP/MCPRemoveClassesResult.class.st index 850c63b..1000cd5 100644 --- a/src/MCP/MCPRemoveClassesResult.class.st +++ b/src/MCP/MCPRemoveClassesResult.class.st @@ -5,7 +5,7 @@ It groups per-class removal results, package names removed as cleanup, and warni " Class { #name : 'MCPRemoveClassesResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'removedClasses', 'removedPackageNames', diff --git a/src/MCP/MCPRemoveMethodsResult.class.st b/src/MCP/MCPRemoveMethodsResult.class.st index beb26e1..792387c 100644 --- a/src/MCP/MCPRemoveMethodsResult.class.st +++ b/src/MCP/MCPRemoveMethodsResult.class.st @@ -3,7 +3,7 @@ Result DTO produced by the method_remove command. " Class { #name : 'MCPRemoveMethodsResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'className', 'classSide', diff --git a/src/MCP/MCPRepositoryResult.class.st b/src/MCP/MCPRepositoryResult.class.st index 5b8d8ce..d1829e6 100644 --- a/src/MCP/MCPRepositoryResult.class.st +++ b/src/MCP/MCPRepositoryResult.class.st @@ -3,7 +3,7 @@ Abstract base for repository result DTOs. It owns shared repository snapshot hel " Class { #name : 'MCPRepositoryResult', - #superclass : 'Object', + #superclass : 'MCPResult', #category : 'MCP-Results', #package : 'MCP', #tag : 'Results' diff --git a/src/MCP/MCPResult.class.st b/src/MCP/MCPResult.class.st new file mode 100644 index 0000000..cf28e53 --- /dev/null +++ b/src/MCP/MCPResult.class.st @@ -0,0 +1,24 @@ +" +Abstract base for MCP result objects. + +Dictionary-style results implement #asDictionary. +" +Class { + #name : 'MCPResult', + #superclass : 'Object', + #category : 'MCP-Results', + #package : 'MCP', + #tag : 'Results' +} + +{ #category : 'testing' } +MCPResult class >> isAbstract [ + + ^ self == MCPResult +] + +{ #category : 'converting' } +MCPResult >> asDictionary [ + + self subclassResponsibility +] diff --git a/src/MCP/MCPRunTestsResult.class.st b/src/MCP/MCPRunTestsResult.class.st index 74080a8..902da51 100644 --- a/src/MCP/MCPRunTestsResult.class.st +++ b/src/MCP/MCPRunTestsResult.class.st @@ -5,7 +5,7 @@ It carries structured per-selection results plus timeout state and unrun MCPTest " Class { #name : 'MCPRunTestsResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'results', 'timedOut', diff --git a/src/MCP/MCPScreenshotResult.class.st b/src/MCP/MCPScreenshotResult.class.st index b8122fa..011cbca 100644 --- a/src/MCP/MCPScreenshotResult.class.st +++ b/src/MCP/MCPScreenshotResult.class.st @@ -5,7 +5,7 @@ It keeps the MCP image content block separate from the structured metadata so to " Class { #name : 'MCPScreenshotResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'target', 'width', diff --git a/src/MCP/MCPTestCoverageResult.class.st b/src/MCP/MCPTestCoverageResult.class.st index 7543fa1..25d692f 100644 --- a/src/MCP/MCPTestCoverageResult.class.st +++ b/src/MCP/MCPTestCoverageResult.class.st @@ -3,7 +3,7 @@ Structured coverage result DTO returned by test_coverage_run. " Class { #name : 'MCPTestCoverageResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'coverageResult', 'includeCoveredMethods', diff --git a/src/MCP/MCPTestRunResult.class.st b/src/MCP/MCPTestRunResult.class.st index e631078..b2bb2fa 100644 --- a/src/MCP/MCPTestRunResult.class.st +++ b/src/MCP/MCPTestRunResult.class.st @@ -5,7 +5,7 @@ It carries the structured result entry when any tests ran, timeout state, and re " Class { #name : 'MCPTestRunResult', - #superclass : 'Object', + #superclass : 'MCPResult', #instVars : [ 'timedOut', 'unrunTestRequests', diff --git a/src/MCP/MCPToolRegistry.class.st b/src/MCP/MCPToolRegistry.class.st index cb31116..bac68fa 100644 --- a/src/MCP/MCPToolRegistry.class.st +++ b/src/MCP/MCPToolRegistry.class.st @@ -470,7 +470,7 @@ MCPToolRegistry class >> publicToolNames [ { #category : 'tools' } MCPToolRegistry class >> publicTools [ - ^ (self registrations collect: [ :each | each tool ]) asArray + ^ self registrations collect: [ :each | each tool ] ] { #category : 'tools' } From 336b12015d8912648f5d5fb7910ce5172b37d92d Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Thu, 25 Jun 2026 10:39:15 +0200 Subject: [PATCH 11/21] Move scope name suggester to utilities Co-authored-by: Codex --- src/MCP/MCPScopeNameSuggester.class.st | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/MCP/MCPScopeNameSuggester.class.st b/src/MCP/MCPScopeNameSuggester.class.st index b90b370..04af442 100644 --- a/src/MCP/MCPScopeNameSuggester.class.st +++ b/src/MCP/MCPScopeNameSuggester.class.st @@ -6,9 +6,9 @@ It scores nearby names and limits repeated suggestions from the same package or Class { #name : 'MCPScopeNameSuggester', #superclass : 'Object', - #category : 'MCP-Queries', + #category : 'MCP-Utilities', #package : 'MCP', - #tag : 'Queries' + #tag : 'Utilities' } { #category : 'suggesting' } From 7bb6597ead7975c518a34b7bdb6ba67421679e33 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Thu, 25 Jun 2026 12:00:32 +0200 Subject: [PATCH 12/21] Compact test runner API Co-authored-by: Codex --- .../MCPJSONSchemaValidatorTest.class.st | 18 +- src/MCP-Tests/MCPToolContractsTest.class.st | 235 ++++----- .../MCPToolMethodMutationTest.class.st | 85 ++-- .../MCPToolStructuredOutputTest.class.st | 379 ++++++-------- src/MCP/MCPRunTestsCommand.class.st | 64 ++- src/MCP/MCPRunTestsRequest.class.st | 92 ++-- src/MCP/MCPRunTestsResult.class.st | 125 ++++- src/MCP/MCPTestRunInfo.class.st | 4 +- src/MCP/MCPTestRunRequest.class.st | 34 +- src/MCP/MCPToolMethodMutation.class.st | 3 - src/MCP/MCPToolRunTestCoverage.class.st | 58 +-- src/MCP/MCPToolRunTests.class.st | 467 +++++++----------- 12 files changed, 735 insertions(+), 829 deletions(-) diff --git a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st index e0e1ca9..507a410 100644 --- a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st +++ b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st @@ -14,9 +14,8 @@ MCPJSONSchemaValidatorTest >> baseRepresentativeArgumentsByToolClass [ ^ { (MCPToolEvaluate -> { (#code -> '1 + 1') } asDictionary). - (MCPToolRunTests -> { (#tests - -> { { (#className -> 'MCPToolContractsTest') } asDictionary }) } - asDictionary). + (MCPToolRunTests + -> { (#classes -> { 'MCPToolContractsTest' }) } asDictionary). (MCPToolGetClass -> { (#className -> 'MCPTool') } asDictionary). (MCPToolGetMethod -> { (#className -> 'MCPTool'). @@ -227,11 +226,10 @@ MCPJSONSchemaValidatorTest >> representativeArgumentsByToolClass [ at: MCPToolLoadBaseline put: { (#baseline -> 'ExampleBaseline') } asDictionary; at: MCPToolRunTestCoverage put: { - (#tests - -> { { (#className -> 'MCPToolContractsTest') } asDictionary }). - (#coverage - -> { (#scope -> { (#classes -> #( 'MCPToolContractsTest' )) } asDictionary) } asDictionary) } - asDictionary; + (#classes -> { 'MCPToolContractsTest' }). + (#coverage -> { (#scope + -> { (#classes -> #( 'MCPToolContractsTest' )) } asDictionary) } + asDictionary) } asDictionary; at: MCPToolApplyChangeHistoryEntries put: { (#latestCount -> 1) } asDictionary; at: MCPToolRevertChangeHistoryEntries @@ -358,9 +356,7 @@ MCPJSONSchemaValidatorTest >> testCurrentToolRequestValidationRejectsOperationSp self should: [ MCPToolRunTestCoverage new requestFromToolCallArguments: - { (#tests - -> { { (#className -> 'MCPToolContractsTest') } asDictionary }) } - asDictionary ] + { (#classes -> { 'MCPToolContractsTest' }) } asDictionary ] raise: MCPInvalidToolInput. self should: [ diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 6ed9794..5560d29 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -129,9 +129,8 @@ MCPToolContractsTest >> baseToolFlowSpecs [ (#commandClass -> MCPRemoveMethodsCommand) } asDictionary. { (#toolClass -> MCPToolRunTests). - (#arguments -> { (#tests - -> { { (#className -> 'MCPToolContractsTest') } asDictionary }) } - asDictionary). + (#arguments + -> { (#classes -> { 'MCPToolContractsTest' }) } asDictionary). (#requestClass -> MCPRunTestsRequest). (#commandClass -> MCPRunTestsCommand) } asDictionary. { @@ -192,7 +191,6 @@ MCPToolContractsTest >> baseToolFlowSpecs [ (#arguments -> Dictionary new) } asDictionary). (#requestClass -> MCPCallToolRequest). (#commandClass -> MCPCallToolCommand) } asDictionary } - ] { #category : 'private' } @@ -382,8 +380,7 @@ MCPToolContractsTest >> coverageToolFlowSpec [ ^ { (#toolClass -> MCPToolRunTestCoverage). (#arguments -> { - (#tests - -> { { (#className -> 'MCPToolContractsTest') } asDictionary }). + (#classes -> { 'MCPToolContractsTest' }). (#coverage -> { (#scope -> { (#classes -> #( 'MCPToolContractsTest' )) } asDictionary) } asDictionary) } asDictionary). @@ -2447,7 +2444,8 @@ MCPToolContractsTest >> testRpcToolCallSignalsInvalidParametersForInvalidNestedA self callToolNamed: 'test_run' withArguments: - { (#tests -> #( 'MCPToolContractsTest' )) } asDictionary ] + { (#methods -> { { (#selector -> 'testPasses') } asDictionary }) } + asDictionary ] raise: JRPCInvalidParameters ] @@ -2485,178 +2483,145 @@ MCPToolContractsTest >> testRpcToolCallSignalsInvalidParametersWhenRequiredArgum ] { #category : 'tests' } -MCPToolContractsTest >> testRunTestCoverageUsesNestedRequestDTOs [ +MCPToolContractsTest >> testRunTestCoverageParsesCompactSelections [ | command parsedRequest rawRequest tool validatedRequests | tool := MCPToolRunTestCoverage new. rawRequest := tool requestFromToolCallArguments: { - (#tests - -> - { { (#className -> 'MCPToolContractsTest') } - asDictionary }). - (#coverage -> { (#scope - -> - { (#classes -> #( 'MCPToolContractsTest' )) } - asDictionary) } asDictionary) } asDictionary. + (#classes -> #( 'MCPToolContractsTest' )). + (#coverage -> { (#scope -> { (#classes -> #( 'MCPToolContractsTest' )) } asDictionary) } asDictionary) } + asDictionary. parsedRequest := tool parsedRequestFromToolRequest: rawRequest. command := tool commandForRequest: parsedRequest. validatedRequests := command validatedRequestsFrom: parsedRequest testRequests. self assert: parsedRequest class equals: MCPRunTestsRequest. self assert: parsedRequest isCoverageOperation. - self - assert: parsedRequest coverageRequest class - equals: MCPTestCoverageRequest. - self - assert: parsedRequest testRequests first class - equals: MCPTestRunRequest. - self - assert: validatedRequests first class - equals: MCPValidatedTestRunRequest. - self - assert: validatedRequests first testClass - equals: MCPToolContractsTest + self assert: parsedRequest coverageRequest class equals: MCPTestCoverageRequest. + self assert: parsedRequest testRequests first class equals: MCPTestRunRequest. + self assert: validatedRequests first class equals: MCPValidatedTestRunRequest. + self assert: validatedRequests first testClass equals: MCPToolContractsTest ] { #category : 'tests' } MCPToolContractsTest >> testRunTestToolsHaveAccurateNamesAndRequiredArguments [ - | coverageInputProperties coverageInputProperty coverageScopeProperty coverageScopePropertyNames coverageTool inputPropertyNames methodLimitProperty outputSchema dataProperties resultsProperty timeoutMillisecondsProperty tool | + | coverageDataProperties coverageInputProperties coverageInputProperty coverageTool dataProperties inputPropertyNames outputSchema tool | tool := MCPToolRunTests new. self assert: tool name equals: 'test_run'. - self - assert: tool inputSchema required asSet - equals: #( 'tests' ) asSet. - self deny: (tool inputSchema extraProperties includesKey: #oneOf). + self assert: (tool inputSchema required ifNil: [ #( ) ]) isEmpty. inputPropertyNames := tool inputSchema properties collect: [ :each | each name ]. - timeoutMillisecondsProperty := tool inputSchema properties detect: [ - :each | - each name = 'timeoutMilliseconds' ]. - self deny: (inputPropertyNames includes: 'operation'). - self deny: (inputPropertyNames includes: 'coverage'). - self assert: (inputPropertyNames includes: 'timeoutSeconds'). - self assert: (inputPropertyNames includes: 'timeoutMilliseconds'). self - assert: timeoutMillisecondsProperty description - equals: 'Timeout in milliseconds.'. + assert: inputPropertyNames asSet + equals: #( 'packages' 'classes' 'methods' 'timeoutSeconds' ) asSet. + self deny: (inputPropertyNames includes: 'tests'). + self deny: (inputPropertyNames includes: 'timeoutMilliseconds'). + self deny: (inputPropertyNames includes: 'coverage'). outputSchema := tool outputSchema asJRPCJSON. - dataProperties := ((outputSchema at: #properties) at: 'data') at: - #properties. - resultsProperty := dataProperties at: 'results'. - self assert: (resultsProperty at: #type) equals: 'array'. - self - assert: ((resultsProperty at: #items) at: #type) - equals: 'object'. + dataProperties := ((outputSchema at: #properties) at: 'data') at: #properties. + self assert: (dataProperties includesKey: 'runCount'). + self assert: (dataProperties includesKey: 'passedCount'). + self assert: (dataProperties includesKey: 'skipped'). + self assert: (dataProperties includesKey: 'failures'). + self assert: (dataProperties includesKey: 'errors'). + self assert: (dataProperties includesKey: 'unrunClasses'). + self assert: (dataProperties includesKey: 'unrunMethods'). + self deny: (dataProperties includesKey: 'results'). self deny: (dataProperties includesKey: 'coverage'). - self deny: (dataProperties includesKey: 'tests'). + coverageTool := MCPToolRunTestCoverage new. self assert: coverageTool name equals: 'test_coverage_run'. + self assert: coverageTool inputSchema required asSet equals: #( 'coverage' ) asSet. + inputPropertyNames := coverageTool inputSchema properties collect: [ :each | + each name ]. self - assert: coverageTool inputSchema required asSet - equals: #( 'tests' 'coverage' ) asSet. - inputPropertyNames := coverageTool inputSchema properties collect: [ - :each | each name ]. - coverageInputProperty := coverageTool inputSchema properties detect: [ - :each | each name = 'coverage' ]. - coverageInputProperties := coverageInputProperty extraProperties at: - #properties. - methodLimitProperty := coverageInputProperties detect: [ :each | - each name = 'methodLimit' ]. - self deny: (inputPropertyNames includes: 'operation'). - self assert: (inputPropertyNames includes: 'coverage'). - self assert: (inputPropertyNames includes: 'timeoutSeconds'). - self assert: (inputPropertyNames includes: 'timeoutMilliseconds'). - self - assert: (methodLimitProperty extraProperties at: #minimum) - equals: 0. - self - assert: (methodLimitProperty extraProperties at: #default) - equals: 50. - coverageScopeProperty := coverageInputProperties detect: [ :each | - each name = 'scope' ]. - coverageScopePropertyNames := (coverageScopeProperty extraProperties - at: #properties) collect: [ :each | - each name ]. - self assert: (coverageScopePropertyNames includes: 'packages'). - self assert: (coverageScopePropertyNames includes: 'classes'). - self deny: (coverageScopePropertyNames includes: 'packageNames'). - self deny: (coverageScopePropertyNames includes: 'classNames') + assert: inputPropertyNames asSet + equals: + #( 'packages' 'classes' 'methods' 'coverage' 'timeoutSeconds' ) asSet. + self deny: (inputPropertyNames includes: 'tests'). + self deny: (inputPropertyNames includes: 'timeoutMilliseconds'). + coverageInputProperty := coverageTool inputSchema properties detect: [ :each | + each name = 'coverage' ]. + coverageInputProperties := coverageInputProperty extraProperties at: #properties. + self assert: (coverageInputProperties anySatisfy: [ :each | + each name = 'methodLimit' ]). + outputSchema := coverageTool outputSchema asJRPCJSON. + coverageDataProperties := ((outputSchema at: #properties) at: 'data') + at: #properties. + self assert: (coverageDataProperties includesKey: 'runCount'). + self assert: (coverageDataProperties includesKey: 'passedCount'). + self assert: (coverageDataProperties includesKey: 'coverage'). + self deny: (coverageDataProperties includesKey: 'results') +] + +{ #category : 'tests' } +MCPToolContractsTest >> testRunTestsExpandsPackagesToConcreteTestClasses [ + + | classNames parsedRequest rawRequest tool | + tool := MCPToolRunTests new. + rawRequest := tool requestFromToolCallArguments: + { (#packages -> #( 'MCP-Tests' )) } asDictionary. + parsedRequest := tool parsedRequestFromToolRequest: rawRequest. + classNames := parsedRequest testRequests collect: [ :each | + each className ]. + self assert: classNames isSorted. + self assert: (classNames includes: 'MCPToolContractsTest'). + self deny: (classNames includes: 'MCPToolStructuredOutputTestTarget'). + self assert: (parsedRequest testRequests allSatisfy: [ :each | + each testMethodName isNil ]) ] { #category : 'tests' } -MCPToolContractsTest >> testRunTestsParsesTimeoutMilliseconds [ +MCPToolContractsTest >> testRunTestsParsesCompactSelections [ - | parsedRequest rawRequest tool | + | command parsedRequest rawRequest testRequests tool validatedRequests | tool := MCPToolRunTests new. rawRequest := tool requestFromToolCallArguments: { - (#tests -> { { - (#className -> 'MCPToolContractsTest'). - (#testMethodName - -> - 'testRunTestToolsHaveAccurateNamesAndRequiredArguments') } - asDictionary }). - (#timeoutMilliseconds -> 25) } asDictionary. + (#classes -> #( 'MCPToolContractsTest' )). + (#methods -> + #( 'MCPToolStructuredOutputTestTarget>>#testPasses' )) } + asDictionary. parsedRequest := tool parsedRequestFromToolRequest: rawRequest. - self assert: parsedRequest timeoutMilliseconds equals: 25 + command := tool commandForRequest: parsedRequest. + validatedRequests := command validatedRequestsFrom: + parsedRequest testRequests. + testRequests := parsedRequest testRequests. + self assert: parsedRequest class equals: MCPRunTestsRequest. + self assert: testRequests size equals: 2. + self assert: testRequests first className equals: 'MCPToolContractsTest'. + self assert: testRequests first testMethodName equals: nil. + self assert: testRequests second className equals: 'MCPToolStructuredOutputTestTarget'. + self assert: testRequests second testMethodName equals: 'testPasses'. + self assert: testRequests second displayName equals: 'MCPToolStructuredOutputTestTarget>>#testPasses'. + self assert: validatedRequests first class equals: MCPValidatedTestRunRequest. + self assert: validatedRequests first testRunRequest equals: testRequests first. + self assert: validatedRequests first testClass equals: MCPToolContractsTest ] { #category : 'tests' } -MCPToolContractsTest >> testRunTestsRejectsConflictingTimeoutUnits [ +MCPToolContractsTest >> testRunTestsParsesTimeoutSeconds [ - | rawRequest tool | + | parsedRequest rawRequest tool | tool := MCPToolRunTests new. rawRequest := tool requestFromToolCallArguments: { - (#tests -> { { - (#className -> 'MCPToolContractsTest'). - (#testMethodName - -> - 'testRunTestToolsHaveAccurateNamesAndRequiredArguments') } - asDictionary }). - (#timeoutSeconds -> 1). - (#timeoutMilliseconds -> 25) } asDictionary. - self - should: [ tool parsedRequestFromToolRequest: rawRequest ] - raise: Error - whoseDescriptionIncludes: - 'timeoutSeconds and timeoutMilliseconds cannot both be provided' - description: 'Timeout requests should use one unit.' + (#classes -> #( 'MCPToolContractsTest' )). + (#timeoutSeconds -> 2) } asDictionary. + parsedRequest := tool parsedRequestFromToolRequest: rawRequest. + self assert: parsedRequest timeoutMilliseconds equals: 2000 ] { #category : 'tests' } -MCPToolContractsTest >> testRunTestsUsesNestedRequestDTOs [ +MCPToolContractsTest >> testRunTestsRejectsEmptySelection [ - | command parsedRequest rawRequest tool validatedRequests | + | rawRequest tool | tool := MCPToolRunTests new. - rawRequest := tool requestFromToolCallArguments: { (#tests -> { { - (#className -> 'MCPToolContractsTest'). - (#testMethodName - -> - 'testRunTestToolsHaveAccurateNamesAndRequiredArguments') } - asDictionary }) } asDictionary. - parsedRequest := tool parsedRequestFromToolRequest: rawRequest. - command := tool commandForRequest: parsedRequest. - validatedRequests := command validatedRequestsFrom: - parsedRequest testRequests. - self assert: parsedRequest class equals: MCPRunTestsRequest. - self - assert: parsedRequest testRequests first class - equals: MCPTestRunRequest. + rawRequest := tool requestFromToolCallArguments: Dictionary new. self - assert: parsedRequest testRequests first className - equals: 'MCPToolContractsTest'. - self - assert: parsedRequest testRequests first testMethodName - equals: 'testRunTestToolsHaveAccurateNamesAndRequiredArguments'. - self - assert: validatedRequests first class - equals: MCPValidatedTestRunRequest. - self - assert: validatedRequests first testRunRequest - equals: parsedRequest testRequests first. - self - assert: validatedRequests first testClass - equals: MCPToolContractsTest + should: [ tool parsedRequestFromToolRequest: rawRequest ] + raise: Error + whoseDescriptionIncludes: 'Provide at least one package, class, or method' + description: 'test_run requires at least one compact selection.' ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPToolMethodMutationTest.class.st b/src/MCP-Tests/MCPToolMethodMutationTest.class.st index 53ad973..fe2e404 100644 --- a/src/MCP-Tests/MCPToolMethodMutationTest.class.st +++ b/src/MCP-Tests/MCPToolMethodMutationTest.class.st @@ -951,6 +951,32 @@ MCPToolMethodMutationTest >> testCompileReturnsStructuredCommandErrorForUndeclar (MCPToolMethodMutationTestTarget includesSelector: #brokenMethod) ] +{ #category : 'tests' } +MCPToolMethodMutationTest >> testCompileStoresMethodSourceWithoutFormatterCorruption [ + + | result selector source storedSource | + selector := #sourceIntegrityProbe. + source := 'sourceIntegrityProbe + | values | + values := #(1 2) collect: [ :each | each asString ]. + ^ '','' join: values'. + [ + result := self callToolWith: (self + compileArgumentsForClassName: + 'MCPToolMethodMutationTestTarget' + classSide: false + methodSource: source + protocol: 'tests'). + storedSource := (MCPToolMethodMutationTestTarget >> selector) sourceCode. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (storedSource includesSubstring: 'each asString'). + self + assert: (MCPToolMethodMutationTestTarget new perform: selector) + equals: '1,2' ] + ensure: [ + self removeSelector: selector from: MCPToolMethodMutationTestTarget ] +] + { #category : 'tests' } MCPToolMethodMutationTest >> testCompilesClassSideMethod [ @@ -1091,25 +1117,6 @@ MCPToolMethodMutationTest >> testNormalizesLineFeedStringLiteralBeforeCompilatio from: MCPToolMethodMutationTestTarget ] ] -{ #category : 'tests' } -MCPToolMethodMutationTest >> testReformatsMethod [ - - | data reformattedSource result source | - source := 'uglyAnswer ^ 1+2'. - result := self callToolWith: (self - compileArgumentsForClassName: - 'MCPToolMethodMutationTestTarget' - classSide: false - methodSource: source - protocol: 'tests'). - data := self dataFrom: result. - reformattedSource := (MCPToolMethodMutationTestTarget >> #uglyAnswer) - sourceCode. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (reformattedSource includesSubstring: '1 + 2'). - self assert: MCPToolMethodMutationTestTarget new uglyAnswer equals: 3 -] - { #category : 'tests' } MCPToolMethodMutationTest >> testRemoveArgumentsFailsWhenRemovedArgumentIsReferenced [ @@ -1273,40 +1280,34 @@ MCPToolMethodMutationTest >> testRenameCanLimitRefactoringToNamedPackages [ ] { #category : 'tests' } -MCPToolMethodMutationTest >> testRenameReturnsFormattedSourceForRenamedMethod [ +MCPToolMethodMutationTest >> testRenameKeepsRenamedMethodCallable [ - | data newSelector oldSelector renamedSource result | + | newSelector oldSelector result target | oldSelector := ('uglyRename:' , 'with:') asSymbol. newSelector := ('with:' , 'uglyRename:') asSymbol. [ self ensureMethodSource: - 'uglyRename: first with:second ^first,''-'',second' + 'uglyRename: first with: second ^ first , ''-'' , second' protocol: 'tests' on: MCPToolMethodMutationTestTarget. result := self callToolWith: { - (#action -> 'update'). - (#className -> 'MCPToolMethodMutationTestTarget'). - (#classSide -> false). - (#selector -> oldSelector asString). - (#newSelector -> newSelector asString). - (#permutation -> #( 2 1 )) } asDictionary. - data := self dataFrom: result. - renamedSource := (MCPToolMethodMutationTestTarget >> newSelector) - sourceCode. + (#action -> 'update'). + (#className -> 'MCPToolMethodMutationTestTarget'). + (#classSide -> false). + (#selector -> oldSelector asString). + (#newSelector -> newSelector asString). + (#permutation -> #( 2 1 )) } asDictionary. + target := MCPToolMethodMutationTestTarget new. self deny: (result at: #isError ifAbsent: [ false ]). - self assert: - (renamedSource includesSubstring: 'with: second uglyRename: first'). - self assert: - (renamedSource includesSubstring: '^ first , ''-'' , second') ] + self deny: (MCPToolMethodMutationTestTarget includesSelector: oldSelector). + self assert: (MCPToolMethodMutationTestTarget includesSelector: newSelector). + self + assert: (target perform: newSelector with: 'right' with: 'left') + equals: 'left-right' ] ensure: [ - self - removeSelector: oldSelector - from: MCPToolMethodMutationTestTarget. - self - removeSelector: newSelector - from: MCPToolMethodMutationTestTarget ] - + self removeSelector: oldSelector from: MCPToolMethodMutationTestTarget. + self removeSelector: newSelector from: MCPToolMethodMutationTestTarget ] ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPToolStructuredOutputTest.class.st b/src/MCP-Tests/MCPToolStructuredOutputTest.class.st index 17d5221..0b9fdad 100644 --- a/src/MCP-Tests/MCPToolStructuredOutputTest.class.st +++ b/src/MCP-Tests/MCPToolStructuredOutputTest.class.st @@ -290,108 +290,68 @@ MCPToolStructuredOutputTest >> testRemoveClassReturnsStructuredError [ { #category : 'tests' } MCPToolStructuredOutputTest >> testRunTestClassReturnsStructuredIssues [ - | data firstIssue issueMethodNames result singleResult | - result := self callToolNamed: 'test_run' withArguments: { (#tests - -> - { { (#className -> 'MCPToolStructuredOutputTestTarget') } - asDictionary }) } asDictionary. + | data error failure result skipped | + result := self + callToolNamed: 'test_run' + withArguments: + { (#classes -> #( 'MCPToolStructuredOutputTestTarget' )) } + asDictionary. data := self dataFrom: result. - singleResult := (data at: #results) first. - issueMethodNames := (singleResult at: #issues) collect: [ :each | - each at: #testMethodName ]. - firstIssue := (singleResult at: #issues) first. self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. - self assert: data keys asSet equals: #( #results ) asSet. - self assert: (data at: #results) size equals: 1. - self - assert: (singleResult at: #className) - equals: 'MCPToolStructuredOutputTestTarget'. - self assert: (singleResult at: #selectedTestCount) equals: 4. - self assert: (singleResult at: #runCount) equals: 3. - self assert: (singleResult at: #passedCount) equals: 1. - self assert: (singleResult at: #skippedCount) equals: 1. - self assert: (singleResult at: #failureCount) equals: 1. - self assert: (singleResult at: #errorCount) equals: 1. - self assert: (singleResult at: #issues) size equals: 3. - self assert: (issueMethodNames includes: 'testFails'). - self assert: (issueMethodNames includes: 'testErrors'). - self assert: (issueMethodNames includes: 'testSkips'). - self assert: (firstIssue includesKey: #message). - self - assert: (firstIssue at: #className) - equals: 'MCPToolStructuredOutputTestTarget'. - self deny: (firstIssue includesKey: #testName). - self deny: (data includesKey: #tests). - self deny: (data includesKey: #selectionCount). - self deny: (data includesKey: #runCount). - self deny: (data includesKey: #passedCount). - self deny: (data includesKey: #skippedCount). - self deny: (data includesKey: #failureCount). - self deny: (data includesKey: #errorCount). - self deny: (data includesKey: #failingTestNames). + self assert: (data at: #runCount) equals: 3. + self assert: (data at: #passedCount) equals: 1. + skipped := data at: #skipped. + failure := (data at: #failures) first. + error := (data at: #errors) first. + self assert: skipped equals: #( 'MCPToolStructuredOutputTestTarget>>#testSkips' ). + self assert: (failure at: #test) equals: 'MCPToolStructuredOutputTestTarget>>#testFails'. + self assert: ((failure at: #message) includesSubstring: 'boom failure'). + self assert: (error at: #test) equals: 'MCPToolStructuredOutputTestTarget>>#testErrors'. + self assert: (error at: #errorClass) equals: 'Error'. + self assert: ((error at: #message) includesSubstring: 'boom error'). + self deny: (data includesKey: #results). self deny: (data includesKey: #issues) ] { #category : 'tests' } MCPToolStructuredOutputTest >> testRunTestMethodReturnsStructuredIssues [ - | data firstIssue methodResult result | + | data failure result | result := self callToolNamed: 'test_run' - withArguments: { (#tests -> { { - (#className -> 'MCPToolStructuredOutputTestTarget'). - (#testMethodName -> 'testFails') } asDictionary }) } - asDictionary. + withArguments: { (#methods -> + #( 'MCPToolStructuredOutputTestTarget>>#testFails' )) } + asDictionary. data := self dataFrom: result. - methodResult := (data at: #results) first. - firstIssue := (methodResult at: #issues) first. + failure := (data at: #failures) first. self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. - self assert: data keys asSet equals: #( #results ) asSet. - self assert: (data at: #results) size equals: 1. - self assert: (methodResult at: #selectedTestCount) equals: 1. - self assert: (methodResult at: #runCount) equals: 1. - self assert: (methodResult at: #passedCount) equals: 0. - self assert: (methodResult at: #skippedCount) equals: 0. - self assert: (methodResult at: #failureCount) equals: 1. - self assert: (methodResult at: #errorCount) equals: 0. - self assert: (methodResult at: #testMethodName) equals: 'testFails'. - self assert: (methodResult at: #issues) size equals: 1. - self assert: (firstIssue at: #testMethodName) equals: 'testFails'. - self - assert: (firstIssue at: #className) - equals: 'MCPToolStructuredOutputTestTarget'. - self deny: (firstIssue includesKey: #testName). - self deny: (data includesKey: #tests). - self deny: (data includesKey: #selectionCount). - self deny: (data includesKey: #runCount). - self deny: (data includesKey: #passedCount). - self deny: (data includesKey: #skippedCount). - self deny: (data includesKey: #failureCount). - self deny: (data includesKey: #errorCount). - self deny: (data includesKey: #failingTestNames). - self deny: (data includesKey: #issues) + self assert: (data at: #runCount) equals: 1. + self assert: (data at: #passedCount) equals: 0. + self assert: (data at: #failures) size equals: 1. + self assert: (failure at: #test) equals: 'MCPToolStructuredOutputTestTarget>>#testFails'. + self assert: ((failure at: #message) includesSubstring: 'boom failure'). + self deny: (data includesKey: #results). + self deny: (data includesKey: #skipped). + self deny: (data includesKey: #errors) ] { #category : 'tests' } MCPToolStructuredOutputTest >> testRunTestsCoverageCanIncludeCoveredMethodsAndCapLists [ | coverage coveredSelectors data result | - result := self callToolNamed: 'test_coverage_run' withArguments: { - (#tests - -> - { { (#className -> 'MCPToolCoverageTargetTest') } - asDictionary }). + result := self + callToolNamed: 'test_coverage_run' + withArguments: { + (#classes -> #( 'MCPToolCoverageTargetTest' )). (#coverage -> { - (#scope - -> - { (#classes -> #( 'MCPToolCoverageTarget' )) } - asDictionary). - (#includeCoveredMethods -> true). - (#methodLimit -> 1) } asDictionary) } asDictionary. + (#scope -> { (#classes -> #( 'MCPToolCoverageTarget' )) } asDictionary). + (#includeCoveredMethods -> true). + (#methodLimit -> 1) } asDictionary) } + asDictionary. data := self dataFrom: result. coverage := data at: #coverage. coveredSelectors := (coverage at: #coveredMethods) collect: [ :each | @@ -399,6 +359,8 @@ MCPToolStructuredOutputTest >> testRunTestsCoverageCanIncludeCoveredMethodsAndCa self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. + self assert: (data at: #runCount) equals: 2. + self assert: (data at: #passedCount) equals: 2. self assert: (coverage at: #coveredMethodCount) equals: 2. self assert: (coverage at: #coveredMethods) size equals: 1. self assert: (coverage at: #coveredMethodsTruncated). @@ -409,11 +371,10 @@ MCPToolStructuredOutputTest >> testRunTestsCoverageCanIncludeCoveredMethodsAndCa MCPToolStructuredOutputTest >> testRunTestsCoverageRequiresExplicitScope [ | error result | - result := self callToolNamed: 'test_coverage_run' withArguments: { - (#tests - -> - { { (#className -> 'MCPToolCoverageTargetTest') } - asDictionary }). + result := self + callToolNamed: 'test_coverage_run' + withArguments: { + (#classes -> #( 'MCPToolCoverageTargetTest' )). (#coverage -> Dictionary new) } asDictionary. error := self errorFrom: result. self assert: (result at: #isError). @@ -421,38 +382,33 @@ MCPToolStructuredOutputTest >> testRunTestsCoverageRequiresExplicitScope [ assert: ((self structuredContentFrom: result) at: #status) equals: 'error'. self assert: (error at: #errorCode) equals: 'CoverageScopeRequired'. - self assert: - ((error at: #message) includesSubstring: 'explicit method scope') + self assert: ((error at: #message) includesSubstring: 'explicit method scope') ] { #category : 'tests' } MCPToolStructuredOutputTest >> testRunTestsCoverageReturnsStructuredCoverage [ - | coverage data partialSelectors result singleResult uncoveredSelectors | - result := self callToolNamed: 'test_coverage_run' withArguments: { - (#tests - -> - { { (#className -> 'MCPToolCoverageTargetTest') } - asDictionary }). + | coverage data partialSelectors result uncoveredSelectors | + result := self + callToolNamed: 'test_coverage_run' + withArguments: { + (#classes -> #( 'MCPToolCoverageTargetTest' )). (#coverage -> { - (#scope - -> - { (#classes -> #( 'MCPToolCoverageTarget' )) } - asDictionary). - (#methodLimit -> 10) } asDictionary) } asDictionary. + (#scope -> { (#classes -> #( 'MCPToolCoverageTarget' )) } asDictionary). + (#methodLimit -> 10) } asDictionary) } asDictionary. data := self dataFrom: result. coverage := data at: #coverage. - singleResult := (data at: #results) first. - uncoveredSelectors := (coverage at: #uncoveredMethods) collect: [ - :each | each at: #selector ]. - partialSelectors := (coverage at: #partiallyCoveredMethods) collect: [ - :each | each at: #selector ]. + uncoveredSelectors := (coverage at: #uncoveredMethods) collect: [ :each | + each at: #selector ]. + partialSelectors := (coverage at: #partiallyCoveredMethods) collect: [ :each | + each at: #selector ]. self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. - self assert: - ((self summaryFrom: result) includesSubstring: 'Coverage:'). - self assert: (singleResult at: #runCount) equals: 2. + self assert: ((self summaryFrom: result) includesSubstring: 'Coverage:'). + self assert: (data at: #runCount) equals: 2. + self assert: (data at: #passedCount) equals: 2. + self deny: (data includesKey: #results). self assert: (coverage at: #methodCount) equals: 3. self assert: (coverage at: #coveredMethodCount) equals: 2. self assert: (coverage at: #fullyCoveredMethodCount) equals: 1. @@ -468,94 +424,66 @@ MCPToolStructuredOutputTest >> testRunTestsCoverageReturnsStructuredCoverage [ { #category : 'tests' } MCPToolStructuredOutputTest >> testRunTestsDeduplicatesConcreteCasesAcrossSelections [ - | data result singleResult | + | data result | result := self callToolNamed: 'test_run' - withArguments: { (#tests -> { - { (#className -> 'MCPToolStructuredOutputTestTarget') } - asDictionary. - { - (#className -> 'MCPToolStructuredOutputTestTarget'). - (#testMethodName -> 'testFails') } asDictionary. - { (#className -> 'MCPToolStructuredOutputTestTarget') } - asDictionary }) } asDictionary. + withArguments: { + (#classes -> #( 'MCPToolStructuredOutputTestTarget' )). + (#methods -> #( 'MCPToolStructuredOutputTestTarget>>#testFails' )) } + asDictionary. data := self dataFrom: result. - singleResult := (data at: #results) first. self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. - self assert: (data at: #results) size equals: 1. - self - assert: (singleResult at: #className) - equals: 'MCPToolStructuredOutputTestTarget'. - self assert: (singleResult at: #selectedTestCount) equals: 4. - self assert: (singleResult at: #runCount) equals: 3. - self assert: (singleResult at: #passedCount) equals: 1. - self assert: (singleResult at: #skippedCount) equals: 1. - self assert: (singleResult at: #failureCount) equals: 1. - self assert: (singleResult at: #errorCount) equals: 1 + self assert: (data at: #runCount) equals: 3. + self assert: (data at: #passedCount) equals: 1. + self assert: (data at: #skipped) size equals: 1. + self assert: (data at: #failures) size equals: 1. + self assert: (data at: #errors) size equals: 1 ] { #category : 'tests' } MCPToolStructuredOutputTest >> testRunTestsDeduplicatesUnrunCasesAcrossSelections [ - | data result unrunMethodNames | + | data result | result := self callToolNamed: 'test_run' withArguments: { - (#tests -> { - { (#className -> 'MCPToolStructuredOutputTestTarget') } - asDictionary. - { - (#className -> 'MCPToolStructuredOutputTestTarget'). - (#testMethodName -> 'testFails') } asDictionary. - { (#className -> 'MCPToolStructuredOutputTestTarget') } - asDictionary }). + (#classes -> #( 'MCPToolStructuredOutputTestTarget' )). + (#methods -> #( 'MCPToolStructuredOutputTestTarget>>#testFails' )). (#timeoutSeconds -> 0) } asDictionary. data := self dataFrom: result. - unrunMethodNames := ((data at: #unrunTests) collect: [ :each | - each at: #testMethodName ]) asSet. self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. self assert: (data at: #timedOut) equals: true. - self assert: (data at: #results) isEmpty. - self assert: (data at: #unrunTests) size equals: 4. - self - assert: unrunMethodNames - equals: #( 'testErrors' 'testFails' 'testPasses' 'testSkips' ) asSet + self assert: (data at: #runCount) equals: 0. + self assert: (data at: #passedCount) equals: 0. + self assert: (data at: #unrunClasses) equals: #( 'MCPToolStructuredOutputTestTarget' ). + self deny: (data includesKey: #unrunMethods). + self deny: (data includesKey: #results) ] { #category : 'tests' } MCPToolStructuredOutputTest >> testRunTestsParameterizedMethodFailureIncludesCaseDetails [ - | data issue methodResult result | + | data issue result | result := self callToolNamed: 'test_run' - withArguments: { (#tests -> { { - (#className -> 'MCPToolRunTestsParameterizedTarget'). - (#testMethodName -> 'testFailsOnlyForUTF16') } - asDictionary }) } asDictionary. + withArguments: { (#methods -> + #( 'MCPToolRunTestsParameterizedTarget>>#testFailsOnlyForUTF16' )) } + asDictionary. data := self dataFrom: result. - methodResult := (data at: #results) first. - issue := (methodResult at: #issues) first. + issue := (data at: #failures) first. self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. - self assert: (methodResult at: #runCount) equals: 3. - self - assert: (methodResult at: #testMethodName) - equals: 'testFailsOnlyForUTF16'. - self assert: (methodResult at: #issues) size equals: 1. - self - assert: (issue at: #testMethodName) - equals: 'testFailsOnlyForUTF16'. - self - assert: (issue at: #testCaseName) - equals: 'testFailsOnlyForUTF16(#encoding->''UTF-16'')'. - self - assert: (issue at: #parameters) - equals: #( '#encoding->''UTF-16''' ). + self assert: (data at: #runCount) equals: 3. + self assert: (data at: #passedCount) equals: 2. + self assert: (data at: #failures) size equals: 1. + self assert: (issue at: #test) equals: 'MCPToolRunTestsParameterizedTarget>>#testFailsOnlyForUTF16'. + self assert: (issue at: #parameters) equals: #( '#encoding->''UTF-16''' ). self assert: ((issue at: #message) includesSubstring: 'UTF-16'). - self deny: (issue includesKey: #testName) + self deny: (issue includesKey: #testName). + self deny: (issue includesKey: #testCaseName) ] { #category : 'tests' } @@ -563,111 +491,94 @@ MCPToolStructuredOutputTest >> testRunTestsParseErrorReturnsStructuredToolError | error result structured | result := self - callToolNamed: 'test_run' - withArguments: - { (#tests -> { { (#className -> '') } asDictionary }) } - asDictionary. + callToolNamed: 'test_run' + withArguments: { (#methods -> #( 'NotAMethodReference' )) } 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: #tests) equals: #( '' ). - self assert: ((error at: #message) includesSubstring: - 'tests must contain only non-empty class names') + self deny: (error includesKey: #tests). + self assert: ((error at: #message) includesSubstring: 'Class>>#selector') ] { #category : 'tests' } -MCPToolStructuredOutputTest >> testRunTestsSkippedMethodReportsExplicitCounts [ +MCPToolStructuredOutputTest >> testRunTestsSkippedMethodReportsCompactList [ - | data issue result singleResult | + | data result | result := self callToolNamed: 'test_run' - withArguments: { (#tests -> { { - (#className -> 'MCPToolStructuredOutputTestTarget'). - (#testMethodName -> 'testSkips') } asDictionary }) } - asDictionary. + withArguments: { (#methods -> + #( 'MCPToolStructuredOutputTestTarget>>#testSkips' )) } + asDictionary. data := self dataFrom: result. - singleResult := (data at: #results) first. - issue := (singleResult at: #issues) first. self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. - self assert: (data at: #results) size equals: 1. - self assert: (singleResult at: #selectedTestCount) equals: 1. - self assert: (singleResult at: #runCount) equals: 0. - self assert: (singleResult at: #passedCount) equals: 0. - self assert: (singleResult at: #skippedCount) equals: 1. - self assert: (singleResult at: #failureCount) equals: 0. - self assert: (singleResult at: #errorCount) equals: 0. - self assert: (singleResult at: #testMethodName) equals: 'testSkips'. - self assert: (issue at: #kind) equals: 'skipped'. - self assert: (issue at: #testMethodName) equals: 'testSkips' + self assert: (data at: #runCount) equals: 0. + self assert: (data at: #passedCount) equals: 0. + self assert: (data at: #skipped) equals: #( 'MCPToolStructuredOutputTestTarget>>#testSkips' ). + self deny: (data includesKey: #failures). + self deny: (data includesKey: #errors) ] { #category : 'tests' } -MCPToolStructuredOutputTest >> testRunTestsSuccessfulResultOmitsEmptyIssues [ +MCPToolStructuredOutputTest >> testRunTestsSuccessfulResultOmitsEmptyIssueLists [ - | data result singleResult | + | data result | result := self callToolNamed: 'test_run' - withArguments: { (#tests -> { { - (#className -> 'MCPToolStructuredOutputTestTarget'). - (#testMethodName -> 'testPasses') } asDictionary }) } - asDictionary. + withArguments: { (#methods -> + #( 'MCPToolStructuredOutputTestTarget>>#testPasses' )) } + asDictionary. data := self dataFrom: result. - singleResult := (data at: #results) first. self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. - self assert: (singleResult at: #runCount) equals: 1. - self deny: (singleResult includesKey: #issues) + self assert: (data at: #runCount) equals: 1. + self assert: (data at: #passedCount) equals: 1. + self deny: (data includesKey: #skipped). + self deny: (data includesKey: #failures). + self deny: (data includesKey: #errors). + self deny: (data includesKey: #results) ] { #category : 'tests' } -MCPToolStructuredOutputTest >> testRunTestsTimeoutReturnsPartialResultsAndUnrunTestsCanResume [ - - | data partialResult resumedData resumedResult result unrunTests | - result := self callToolNamed: 'test_run' withArguments: { - (#tests -> { - { (#className -> 'MCPToolRunTestsTimeoutTarget') } - asDictionary. - { - (#className -> 'MCPToolRequestTest'). - (#testMethodName - -> 'testValidRequestProvidesTypedAccessors') } - asDictionary }). - (#timeoutMilliseconds -> 100) } asDictionary. - data := self dataFrom: result. - self - assert: ((self structuredContentFrom: result) at: #status) - equals: 'ok'. +MCPToolStructuredOutputTest >> testRunTestsTimeoutReturnsPartialResultsAndUnrunSelectionsCanResume [ + + | data request resumedData resumedResult result runTestsRequest tool | + tool := MCPToolRunTests new. + runTestsRequest := MCPRunTestsRequest new + initializeTestRequests: { + (MCPTestRunRequest className: + 'MCPToolRunTestsTimeoutTarget'). + (MCPTestRunRequest className: + 'MCPToolCoverageTargetTest') } + timeoutMilliseconds: 100 + operation: 'run' + coverageRequest: nil. + result := (tool commandForRequest: runTestsRequest) execute. + data := result asDictionary. self assert: (data at: #timedOut). - partialResult := (data at: #results) first. - self - assert: (partialResult at: #className) - equals: 'MCPToolRunTestsTimeoutTarget'. - self assert: (partialResult at: #runCount) equals: 1. - unrunTests := data at: #unrunTests. - self assert: (unrunTests anySatisfy: [ :each | - (each at: #className) = 'MCPToolRunTestsTimeoutTarget' and: [ - (each at: #testMethodName) = 'testSlowPass' ] ]). - self assert: (unrunTests anySatisfy: [ :each | - (each at: #className) = 'MCPToolRequestTest' and: [ - (each at: #testMethodName) - = 'testValidRequestProvidesTypedAccessors' ] ]). - resumedResult := self callToolNamed: 'test_run' withArguments: { - (#tests -> unrunTests). - (#timeoutMilliseconds -> 1000) } asDictionary. + self assert: (data at: #runCount) equals: 1. + self assert: (data at: #passedCount) equals: 1. + self assert: (data at: #unrunMethods) equals: + #( 'MCPToolRunTestsTimeoutTarget>>#testSlowPass' ). + self assert: (data at: #unrunClasses) equals: + #( 'MCPToolCoverageTargetTest' ). + request := Dictionary new + at: #methods put: (data at: #unrunMethods); + at: #classes put: (data at: #unrunClasses); + at: #timeoutSeconds put: 1; + yourself. + resumedResult := self callToolNamed: 'test_run' withArguments: request. resumedData := self dataFrom: resumedResult. self assert: ((self structuredContentFrom: resumedResult) at: #status) equals: 'ok'. self deny: (resumedData includesKey: #timedOut). - self - assert: - ((resumedData at: #results) sum: [ :each | each at: #runCount ]) - equals: unrunTests size + self assert: (resumedData at: #runCount) equals: 3. + self assert: (resumedData at: #passedCount) equals: 3 ] { #category : 'tests' } diff --git a/src/MCP/MCPRunTestsCommand.class.st b/src/MCP/MCPRunTestsCommand.class.st index 48de5fa..25990ca 100644 --- a/src/MCP/MCPRunTestsCommand.class.st +++ b/src/MCP/MCPRunTestsCommand.class.st @@ -317,29 +317,49 @@ MCPRunTestsCommand >> testRunInfoForTestResult: aResult validatedRequest: valida { #category : 'private' } MCPRunTestsCommand >> uniqueTestCasesForValidatedRequest: validatedRequest seenTestCaseNames: seenTestCaseNames [ + ^ self + uniqueTestCasesFrom: (self testCasesForValidatedRequest: validatedRequest) + seenTestCaseNames: seenTestCaseNames +] + +{ #category : 'private' } +MCPRunTestsCommand >> uniqueTestCasesFrom: testCases seenTestCaseNames: seenTestCaseNames [ + | uniqueTestCases | uniqueTestCases := OrderedCollection new. - (self testCasesForValidatedRequest: validatedRequest) do: [ :testCase | - | testCaseName | - testCaseName := self testCaseDeduplicationKeyFor: testCase. - (seenTestCaseNames includes: testCaseName) ifFalse: [ - seenTestCaseNames add: testCaseName. - uniqueTestCases add: testCase ] ]. + testCases do: [ :testCase | + | testCaseName | + testCaseName := self testCaseDeduplicationKeyFor: testCase. + (seenTestCaseNames includes: testCaseName) ifFalse: [ + seenTestCaseNames add: testCaseName. + uniqueTestCases add: testCase ] ]. ^ uniqueTestCases asArray ] +{ #category : 'private' } +MCPRunTestsCommand >> unrunRequestsForValidatedRequest: validatedRequest seenTestCaseNames: seenTestCaseNames [ + + | testCases uniqueTestCases | + testCases := self testCasesForValidatedRequest: validatedRequest. + uniqueTestCases := self + uniqueTestCasesFrom: testCases + seenTestCaseNames: seenTestCaseNames. + uniqueTestCases ifEmpty: [ ^ #( ) ]. + (validatedRequest hasTestMethod not and: [ + uniqueTestCases size = testCases size ]) ifTrue: [ + ^ { validatedRequest testRunRequest } ]. + ^ self testRequestsForTestCases: uniqueTestCases startingAt: 1 +] + { #category : 'private' } MCPRunTestsCommand >> unrunTestsFrom: validatedRequests startingAt: startIndex seenTestCaseNames: seenTestCaseNames [ | unrun | unrun := OrderedCollection new. startIndex to: validatedRequests size do: [ :index | - unrun addAll: (self - testRequestsForTestCases: (self - uniqueTestCasesForValidatedRequest: - (validatedRequests at: index) - seenTestCaseNames: seenTestCaseNames) - startingAt: 1) ]. + unrun addAll: (self + unrunRequestsForValidatedRequest: (validatedRequests at: index) + seenTestCaseNames: seenTestCaseNames) ]. ^ unrun asArray ] @@ -347,13 +367,15 @@ MCPRunTestsCommand >> unrunTestsFrom: validatedRequests startingAt: startIndex s MCPRunTestsCommand >> validatedRequestsFrom: testRequests [ ^ testRequests collect: [ :each | - | testClass | - testClass := MCPImageLookup classNamed: each className. - each testMethodName ifNotNil: [ :testMethodName | - testClass compiledMethodAt: testMethodName asSymbol ifAbsent: [ - MCPCommandError - signalMissingMethodInClassName: each className - classSide: false - selector: testMethodName ] ]. - MCPValidatedTestRunRequest request: each testClass: testClass ] + | testClass | + testClass := MCPImageLookup classNamed: each className. + each testMethodName ifNotNil: [ :testMethodName | + testClass + compiledMethodAt: testMethodName asSymbol + ifAbsent: [ + MCPCommandError + signalMissingMethodInClassName: each className + classSide: false + selector: testMethodName ] ]. + MCPValidatedTestRunRequest request: each testClass: testClass ] ] diff --git a/src/MCP/MCPRunTestsRequest.class.st b/src/MCP/MCPRunTestsRequest.class.st index b4c3805..53153af 100644 --- a/src/MCP/MCPRunTestsRequest.class.st +++ b/src/MCP/MCPRunTestsRequest.class.st @@ -15,54 +15,86 @@ Class { #tag : 'Requests' } +{ #category : 'private - parsing' } +MCPRunTestsRequest class >> addClassNames: classNames to: requests [ + + classNames do: [ :className | + requests add: (MCPTestRunRequest className: className) ] +] + +{ #category : 'private - parsing' } +MCPRunTestsRequest class >> addMethodReferences: methodReferences to: requests [ + + methodReferences do: [ :methodReference | + requests add: (MCPTestRunRequest fromMethodReference: methodReference) ] +] + +{ #category : 'private - parsing' } +MCPRunTestsRequest class >> addPackageNames: packageNames to: requests [ + + packageNames do: [ :packageName | + (self testClassesInPackageNamed: packageName) do: [ :testClass | + requests add: (MCPTestRunRequest className: testClass name asString) ] ] +] + { #category : 'instance creation' } MCPRunTestsRequest class >> fromRequest: aRequest tool: aTool operation: operation [ | coverageRequest | (#( 'run' 'coverage' ) includes: operation) ifFalse: [ - Error signal: 'operation must be one of run or coverage.' ]. + Error signal: 'operation must be run or coverage.' ]. coverageRequest := operation = 'coverage' ifTrue: [ - MCPTestCoverageRequest - fromValue: - (aRequest - argumentNamed: 'coverage' - ifAbsent: [ nil ]) - usingToolRequest: aRequest - defaultMethodLimit: - aTool defaultCoverageMethodLimit ]. + MCPTestCoverageRequest + fromValue: (aRequest argumentNamed: 'coverage' ifAbsent: [ nil ]) + usingToolRequest: aRequest + defaultMethodLimit: aTool defaultCoverageMethodLimit ]. ^ self new - initializeTestRequests: - (self testRequestsFromToolRequest: aRequest) - timeoutMilliseconds: (self - timeoutMillisecondsFromToolRequest: aRequest - defaultSeconds: aTool defaultTimeoutSeconds) - operation: operation - coverageRequest: coverageRequest + initializeTestRequests: (self testRequestsFromToolRequest: aRequest) + timeoutMilliseconds: (self + timeoutMillisecondsFromToolRequest: aRequest + defaultSeconds: aTool defaultTimeoutSeconds) + operation: operation + coverageRequest: coverageRequest +] + +{ #category : 'private - parsing' } +MCPRunTestsRequest class >> testClassesInPackageNamed: packageName [ + + | package | + package := MCPImageLookup packageNamed: packageName scopeName: 'packages'. + ^ (package definedClasses select: [ :each | + each isTestCase and: [ each isAbstract not ] ]) asArray + sort: [ :left :right | left name <= right name ] ] { #category : 'private - parsing' } MCPRunTestsRequest class >> testRequestsFromToolRequest: request [ - | requests | - requests := request objectCollectionArgumentNamed: 'tests'. + | classNames methodReferences packageNames requests | + packageNames := request + uniqueStringCollectionArgumentNamed: 'packages' + default: #( ). + classNames := request + uniqueStringCollectionArgumentNamed: 'classes' + default: #( ). + methodReferences := request + uniqueStringCollectionArgumentNamed: 'methods' + default: #( ). + (packageNames isEmpty and: [ + classNames isEmpty and: [ methodReferences isEmpty ] ]) ifTrue: [ + Error signal: 'Provide at least one package, class, or method.' ]. + requests := OrderedCollection new. + self addPackageNames: packageNames to: requests. + self addClassNames: classNames to: requests. + self addMethodReferences: methodReferences to: requests. requests ifEmpty: [ - Error signal: 'tests must contain at least one test request.' ]. - ^ (requests collect: [ :each | - MCPTestRunRequest fromValue: each usingToolRequest: request ]) - asArray + Error signal: 'No test classes or methods matched request.' ]. + ^ requests asArray ] { #category : 'private - parsing' } MCPRunTestsRequest class >> timeoutMillisecondsFromToolRequest: request defaultSeconds: defaultSeconds [ - ((request hasArgumentNamed: 'timeoutSeconds') and: [ - request hasArgumentNamed: 'timeoutMilliseconds' ]) ifTrue: [ - Error signal: - 'timeoutSeconds and timeoutMilliseconds cannot both be provided.' ]. - (request hasArgumentNamed: 'timeoutMilliseconds') ifTrue: [ - ^ request - nonNegativeIntegerArgumentNamed: 'timeoutMilliseconds' - default: defaultSeconds * 1000 ]. ^ (request nonNegativeIntegerArgumentNamed: 'timeoutSeconds' default: defaultSeconds) * 1000 diff --git a/src/MCP/MCPRunTestsResult.class.st b/src/MCP/MCPRunTestsResult.class.st index 902da51..86a0298 100644 --- a/src/MCP/MCPRunTestsResult.class.st +++ b/src/MCP/MCPRunTestsResult.class.st @@ -1,7 +1,7 @@ " -Aggregate result DTO produced by the test_run command. +Aggregate result DTO produced by test_run. -It carries structured per-selection results plus timeout state and unrun MCPTestRunRequest objects for resumable output. Coverage operation results additionally attach an MCPTestCoverageResult. +It exposes compact public output: aggregate counts, compact failure/error details, skipped test references, timeout leftovers, and optional coverage. " Class { #name : 'MCPRunTestsResult', @@ -29,14 +29,42 @@ MCPRunTestsResult class >> results: resultCollection timedOut: aBoolean unrunTes { #category : 'converting' } MCPRunTestsResult >> asDictionary [ - | data | + | data errors failures skipped unrunClasses unrunMethods | data := Dictionary new. - data at: #results put: self resultDictionaries. + data at: #runCount put: self runCount. + data at: #passedCount put: self passedCount. + skipped := self skippedTestReferences. + skipped ifNotEmpty: [ data at: #skipped put: skipped ]. + failures := self failureDictionaries. + failures ifNotEmpty: [ data at: #failures put: failures ]. + errors := self errorDictionaries. + errors ifNotEmpty: [ data at: #errors put: errors ]. self coverage ifNotNil: [ :coverageResult | data at: #coverage put: coverageResult asDictionary ]. self timedOut ifTrue: [ data at: #timedOut put: true. - data at: #unrunTests put: self unrunTestDictionaries ]. + unrunClasses := self unrunClassNames. + unrunClasses ifNotEmpty: [ + data at: #unrunClasses put: unrunClasses ]. + unrunMethods := self unrunMethodReferences. + unrunMethods ifNotEmpty: [ + data at: #unrunMethods put: unrunMethods ] ]. + ^ data +] + +{ #category : 'converting' } +MCPRunTestsResult >> compactIssueFor: issue [ + + | data | + data := Dictionary new. + data at: #test put: (self testReferenceForIssue: issue). + issue at: #message ifPresent: [ :message | + message isEmpty ifFalse: [ data at: #message put: message ] ]. + (issue at: #kind ifAbsent: [ nil ]) = 'error' ifTrue: [ + issue at: #errorClass ifPresent: [ :className | + data at: #errorClass put: className ] ]. + issue at: #parameters ifPresent: [ :parameters | + parameters ifNotEmpty: [ data at: #parameters put: parameters ] ]. ^ data ] @@ -52,6 +80,22 @@ MCPRunTestsResult >> coverage: aCoverageResult [ coverage := aCoverageResult ] +{ #category : 'converting' } +MCPRunTestsResult >> errorDictionaries [ + + ^ Array streamContents: [ :stream | + (self issuesOfKind: 'error') do: [ :issue | + stream nextPut: (self compactIssueFor: issue) ] ] +] + +{ #category : 'converting' } +MCPRunTestsResult >> failureDictionaries [ + + ^ Array streamContents: [ :stream | + (self issuesOfKind: 'failure') do: [ :issue | + stream nextPut: (self compactIssueFor: issue) ] ] +] + { #category : 'initialization' } MCPRunTestsResult >> initializeResults: resultCollection timedOut: aBoolean unrunTests: testCollection [ @@ -61,6 +105,24 @@ MCPRunTestsResult >> initializeResults: resultCollection timedOut: aBoolean unru ^ self ] +{ #category : 'converting' } +MCPRunTestsResult >> issuesOfKind: issueKind [ + + ^ Array streamContents: [ :stream | + self results do: [ :resultInfo | + resultInfo issues do: [ :issue | + (issue at: #kind ifAbsent: [ nil ]) = issueKind ifTrue: [ + stream nextPut: issue ] ] ] ] +] + +{ #category : 'converting' } +MCPRunTestsResult >> passedCount [ + + ^ self results + inject: 0 + into: [ :sum :each | sum + each passedCount ] +] + { #category : 'converting' } MCPRunTestsResult >> resultDictionaries [ @@ -73,12 +135,65 @@ MCPRunTestsResult >> results [ ^ results ] +{ #category : 'converting' } +MCPRunTestsResult >> runCount [ + + ^ self results + inject: 0 + into: [ :sum :each | sum + each runCount ] +] + +{ #category : 'converting' } +MCPRunTestsResult >> skippedTestReferences [ + + ^ self uniqueStringsFrom: + ((self issuesOfKind: 'skipped') collect: [ :issue | + self testReferenceForIssue: issue ]) +] + +{ #category : 'converting' } +MCPRunTestsResult >> testReferenceForIssue: issue [ + + ^ (issue at: #className) asString , '>>#' + , (issue at: #testMethodName) asString +] + { #category : 'accessing' } MCPRunTestsResult >> timedOut [ ^ timedOut ] +{ #category : 'converting' } +MCPRunTestsResult >> uniqueStringsFrom: strings [ + + | seen | + seen := Set new. + ^ Array streamContents: [ :stream | + strings do: [ :each | + (seen includes: each) ifFalse: [ + seen add: each. + stream nextPut: each ] ] ] +] + +{ #category : 'converting' } +MCPRunTestsResult >> unrunClassNames [ + + ^ self uniqueStringsFrom: (Array streamContents: [ :stream | + self unrunTests do: [ :request | + request hasTestMethod ifFalse: [ + stream nextPut: request className ] ] ]) +] + +{ #category : 'converting' } +MCPRunTestsResult >> unrunMethodReferences [ + + ^ self uniqueStringsFrom: (Array streamContents: [ :stream | + self unrunTests do: [ :request | + request hasTestMethod ifTrue: [ + stream nextPut: request displayName ] ] ]) +] + { #category : 'converting' } MCPRunTestsResult >> unrunTestDictionaries [ diff --git a/src/MCP/MCPTestRunInfo.class.st b/src/MCP/MCPTestRunInfo.class.st index 4754885..3cfc0a1 100644 --- a/src/MCP/MCPTestRunInfo.class.st +++ b/src/MCP/MCPTestRunInfo.class.st @@ -1,7 +1,7 @@ " -DTO for one completed test_run selection. +Internal DTO for one executed test_run selection. -It records the selected test class or method, the number of executed tests, and structured issue dictionaries captured during the run. +It records counts and normalized issue dictionaries so MCPRunTestsResult can build compact aggregate output. " Class { #name : 'MCPTestRunInfo', diff --git a/src/MCP/MCPTestRunRequest.class.st b/src/MCP/MCPTestRunRequest.class.st index 0c80fba..6c5db22 100644 --- a/src/MCP/MCPTestRunRequest.class.st +++ b/src/MCP/MCPTestRunRequest.class.st @@ -1,7 +1,7 @@ " -Parsed request DTO for one test_run selection. +Parsed test_run selection. -It represents either a full test class run or one specific test method inside the batch. +A request represents either a whole test class or one test method. Package selections are expanded into class requests before execution. " Class { #name : 'MCPTestRunRequest', @@ -15,6 +15,12 @@ Class { #tag : 'Requests' } +{ #category : 'instance creation' } +MCPTestRunRequest class >> className: aClassName [ + + ^ self className: aClassName testMethodName: nil +] + { #category : 'instance creation' } MCPTestRunRequest class >> className: aClassName testMethodName: aTestMethodName [ @@ -23,6 +29,24 @@ MCPTestRunRequest class >> className: aClassName testMethodName: aTestMethodName testMethodName: aTestMethodName ] +{ #category : 'instance creation' } +MCPTestRunRequest class >> fromMethodReference: aString [ + + | className delimiterIndex selector | + delimiterIndex := aString findString: '>>' startingAt: 1. + delimiterIndex isZero ifTrue: [ + Error signal: 'methods must use Class>>#selector references.' ]. + className := (aString copyFrom: 1 to: delimiterIndex - 1) trimBoth. + selector := (aString + copyFrom: delimiterIndex + 2 + to: aString size) trimBoth. + (selector notEmpty and: [ selector first = $# ]) ifTrue: [ + selector := selector allButFirst ]. + (className isEmpty or: [ selector isEmpty ]) ifTrue: [ + Error signal: 'methods must use Class>>#selector references.' ]. + ^ self className: className testMethodName: selector +] + { #category : 'instance creation' } MCPTestRunRequest class >> fromValue: rawValue usingToolRequest: toolRequest [ @@ -54,12 +78,12 @@ MCPTestRunRequest >> className [ ^ className ] -{ #category : 'printing' } +{ #category : 'accessing' } MCPTestRunRequest >> displayName [ ^ self testMethodName - ifNil: [ self className ] - ifNotNil: [ :methodName | self className , '>>' , methodName ] + ifNil: [ self className ] + ifNotNil: [ :methodName | self className , '>>#' , methodName ] ] { #category : 'testing' } diff --git a/src/MCP/MCPToolMethodMutation.class.st b/src/MCP/MCPToolMethodMutation.class.st index b8317f3..531ab13 100644 --- a/src/MCP/MCPToolMethodMutation.class.st +++ b/src/MCP/MCPToolMethodMutation.class.st @@ -285,9 +285,6 @@ MCPToolMethodMutation >> parsedRequestFromToolRequest: request [ { #category : 'private' } MCPToolMethodMutation >> reformattedMethodForBehavior: aBehavior selector: aSelector [ - | compiledMethod | - compiledMethod := aBehavior >> aSelector. - compiledMethod reformat. ^ aBehavior >> aSelector ] diff --git a/src/MCP/MCPToolRunTestCoverage.class.st b/src/MCP/MCPToolRunTestCoverage.class.st index 4d352b3..52f3eab 100644 --- a/src/MCP/MCPToolRunTestCoverage.class.st +++ b/src/MCP/MCPToolRunTestCoverage.class.st @@ -18,60 +18,34 @@ MCPToolRunTestCoverage class >> toolName [ { #category : 'metadata' } MCPToolRunTestCoverage >> buildInputSchema [ + | timeoutProperty | + timeoutProperty := self + integerSchemaPropertyNamed: 'timeoutSeconds' + description: 'Timeout seconds; 0 returns immediately.' + default: self defaultTimeoutSeconds. + timeoutProperty minimum: 0. ^ MCPStructureInputSchema new - type: 'object'; - properties: { - ((MCPStructureProperties new - name: 'tests'; - type: 'array'; - description: 'Test requests.') - items: self testRequestObjectSchema; - yourself). - self coverageOptionsObjectSchema. - (self - integerSchemaPropertyNamed: 'timeoutSeconds' - description: 'Timeout in seconds; 0 returns immediately.' - default: self defaultTimeoutSeconds). - (self - integerSchemaPropertyNamed: 'timeoutMilliseconds' - description: 'Timeout in milliseconds.') }; - required: #( 'tests' 'coverage' ); - yourself + type: 'object'; + properties: self testSelectionInputProperties , { + self coverageOptionsObjectSchema. + timeoutProperty }; + required: #( 'coverage' ); + yourself ] { #category : 'metadata' } MCPToolRunTestCoverage >> buildOutputSchema [ - | coverageProperty resultsProperty unrunTestsProperty | - resultsProperty := self - schemaPropertyNamed: 'results' - type: 'array' - description: - 'Structured results for each test execution request in the batch that completed before timeout.'. - resultsProperty items: self testResultObjectSchema. - unrunTestsProperty := self - schemaPropertyNamed: 'unrunTests' - type: 'array' - description: - 'Test execution requests that did not run because the batch timed out. Pass this array to test_coverage_run to continue from the timeout point.'. - unrunTestsProperty items: self testRequestObjectSchema. - coverageProperty := self coverageResultObjectSchema. ^ self - standardOutputSchemaForDataProperties: { - resultsProperty. - coverageProperty. - (self - booleanSchemaPropertyNamed: 'timedOut' - description: - 'Whether the batch stopped early because timeoutSeconds elapsed.'). - unrunTestsProperty } - required: #( 'results' 'coverage' ) + standardOutputSchemaForDataProperties: + self testRunDataProperties , { self coverageResultObjectSchema } + required: #( 'runCount' 'passedCount' 'coverage' ) ] { #category : 'metadata' } MCPToolRunTestCoverage >> description [ - ^ 'Run test classes or individual test methods under coverage and return aggregated test and method coverage results.' + ^ 'Run tests under coverage return compact aggregate test coverage results.' ] { #category : 'private - request' } diff --git a/src/MCP/MCPToolRunTests.class.st b/src/MCP/MCPToolRunTests.class.st index 199fea5..46cb436 100644 --- a/src/MCP/MCPToolRunTests.class.st +++ b/src/MCP/MCPToolRunTests.class.st @@ -1,5 +1,7 @@ " -Run SUnit test classes or individual methods and return structured per-selection results. Coverage is exposed by MCPToolRunTestCoverage while both tools share the same command pipeline. +Run test packages, classes, or methods and return compact aggregate results. + +MCPToolRunTestCoverage reuses the same selection and execution pipeline with coverage collection enabled. " Class { #name : 'MCPToolRunTests', @@ -20,51 +22,24 @@ MCPToolRunTests class >> toolName [ { #category : 'metadata' } MCPToolRunTests >> buildInputSchema [ + | timeoutProperty | + timeoutProperty := self + integerSchemaPropertyNamed: 'timeoutSeconds' + description: 'Timeout seconds; 0 returns immediately.' + default: self defaultTimeoutSeconds. + timeoutProperty minimum: 0. ^ MCPStructureInputSchema new - type: 'object'; - properties: { - ((MCPStructureProperties new - name: 'tests'; - type: 'array'; - description: 'Test requests.') - items: self testRequestObjectSchema; - yourself). - (self - integerSchemaPropertyNamed: 'timeoutSeconds' - description: 'Timeout in seconds; 0 returns immediately.' - default: self defaultTimeoutSeconds). - (self - integerSchemaPropertyNamed: 'timeoutMilliseconds' - description: 'Timeout in milliseconds.') }; - required: #( 'tests' ); - yourself + type: 'object'; + properties: self testSelectionInputProperties , { timeoutProperty }; + yourself ] { #category : 'metadata' } MCPToolRunTests >> buildOutputSchema [ - | resultsProperty unrunTestsProperty | - resultsProperty := self - schemaPropertyNamed: 'results' - type: 'array' - description: - 'Structured results for each test execution request in the batch that completed before timeout.'. - resultsProperty items: self testResultObjectSchema. - unrunTestsProperty := self - schemaPropertyNamed: 'unrunTests' - type: 'array' - description: - 'Test execution requests that did not run because the batch timed out. Pass this array to test_run to continue from the timeout point.'. - unrunTestsProperty items: self testRequestObjectSchema. ^ self - standardOutputSchemaForDataProperties: { - resultsProperty. - (self - booleanSchemaPropertyNamed: 'timedOut' - description: - 'Whether the batch stopped early because timeoutSeconds elapsed.'). - unrunTestsProperty } - required: #( 'results' ) + standardOutputSchemaForDataProperties: self testRunDataProperties + required: #( 'runCount' 'passedCount' ) ] { #category : 'private - execution' } @@ -246,25 +221,23 @@ MCPToolRunTests >> defaultTimeoutSeconds [ { #category : 'metadata' } MCPToolRunTests >> description [ - ^ 'Run test classes or individual test methods as a batch and return aggregated results.' + ^ 'Run test packages, classes, methods return compact aggregate results.' ] { #category : 'private' } MCPToolRunTests >> errorResultForError: anError testNames: testNames [ ^ anError - mcpCommandErrorDo: [ :commandError | - self - errorResultText: commandError messageText - details: commandError structuredDetails ] - otherwise: [ :toolError | - self - errorResultText: - (self failureMessageForTestNames: testNames error: toolError) - details: { - (#errorClass -> toolError class name). - (#message -> toolError messageText). - (#tests -> testNames) } asDictionary ] + mcpCommandErrorDo: [ :commandError | + self + errorResultText: commandError messageText + details: commandError structuredDetails ] + otherwise: [ :toolError | + self + errorResultText: (self failureMessageForTestNames: testNames error: toolError) + details: { + (#errorClass -> toolError class name). + (#message -> toolError messageText) } asDictionary ] ] { #category : 'executing' } @@ -289,13 +262,16 @@ MCPToolRunTests >> executeWithRequest: request [ MCPToolRunTests >> failureMessageForTestNames: testNames error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to run tests: '; - nextPutAll: (', ' join: testNames); - nextPutAll: ' ('; - nextPutAll: anError class name; - nextPutAll: '): '; - nextPutAll: anError messageText ] + stream nextPutAll: 'Unable to run tests'. + testNames ifNotEmpty: [ + stream + nextPutAll: ': '; + nextPutAll: (', ' join: testNames) ]. + stream + nextPutAll: ' ('; + nextPutAll: anError class name; + nextPutAll: '): '; + nextPutAll: anError messageText ] ] { #category : 'private - request' } @@ -304,220 +280,107 @@ MCPToolRunTests >> parsedRequestFromToolRequest: request [ ^ MCPRunTestsRequest fromRequest: request tool: self operation: 'run' ] -{ #category : 'private - tests' } -MCPToolRunTests >> standardTestDataPropertiesIncludingMethodName: includeMethodName [ - - | issuesProperty properties | - properties := OrderedCollection withAll: { - (self - schemaPropertyNamed: 'className' - type: 'string' - description: 'The test class that was executed.'). - (self - integerSchemaPropertyNamed: 'selectedTestCount' - description: - 'The number of unique concrete test cases selected for this request after batch deduplication.'). - (self - integerSchemaPropertyNamed: 'runCount' - description: - 'The number of non-skipped test cases that ran.'). - (self - integerSchemaPropertyNamed: 'passedCount' - description: - 'The number of test cases that passed.'). - (self - integerSchemaPropertyNamed: 'skippedCount' - description: - 'The number of test cases that were skipped.'). - (self - integerSchemaPropertyNamed: 'failureCount' - description: - 'The number of test cases that failed assertions.'). - (self - integerSchemaPropertyNamed: 'errorCount' - description: - 'The number of test cases that raised errors.') }. - includeMethodName ifTrue: [ - properties add: (self - schemaPropertyNamed: 'testMethodName' - type: 'string' - description: 'The single test method that was executed.') ]. - issuesProperty := self - schemaPropertyNamed: 'issues' - type: 'array' - description: - 'Detailed issues captured while running tests.'. - issuesProperty items: self testIssueObjectSchema. - properties add: issuesProperty. - ^ properties asArray +{ #category : 'private - errors' } +MCPToolRunTests >> rawStringCollectionNamed: argumentName fromRequest: rawRequest [ + + | value | + value := rawRequest argumentNamed: argumentName ifAbsent: [ ^ #( ) ]. + value isArray ifFalse: [ ^ #( ) ]. + ^ (value collect: [ :each | each asString ]) asArray ] -{ #category : 'private - tests' } -MCPToolRunTests >> standardTestRequiredFieldsIncludingMethodName: includeMethodName [ - - | required | - required := OrderedCollection withAll: - #( 'className' 'selectedTestCount' 'runCount' 'passedCount' - 'skippedCount' 'failureCount' 'errorCount' ). - includeMethodName ifTrue: [ required add: 'testMethodName' ]. - ^ required asArray +{ #category : 'private - errors' } +MCPToolRunTests >> rawTestNamesFromRequest: rawRequest [ + + ^ Array streamContents: [ :stream | + #( 'packages' 'classes' 'methods' ) do: [ :argumentName | + (self rawStringCollectionNamed: argumentName fromRequest: rawRequest) do: [ :each | + stream nextPut: each ] ] ] ] { #category : 'private' } MCPToolRunTests >> successSummaryForData: data [ - | coverage errorCount failureCount failureLikeCount results runCount selectedTestCount selectionCount selectionWord skippedCount timedOut unrunCount | - results := data at: #results. - selectionCount := results size. - selectionWord := selectionCount = 1 - ifTrue: [ 'test selection' ] - ifFalse: [ 'test selections' ]. - selectedTestCount := results - inject: 0 - into: [ :sum :each | - sum + (each at: #selectedTestCount) ]. - runCount := results - inject: 0 - into: [ :sum :each | sum + (each at: #runCount) ]. - skippedCount := results - inject: 0 - into: [ :sum :each | sum + (each at: #skippedCount) ]. - failureCount := results - inject: 0 - into: [ :sum :each | sum + (each at: #failureCount) ]. - errorCount := results - inject: 0 - into: [ :sum :each | sum + (each at: #errorCount) ]. - failureLikeCount := failureCount + errorCount. + | coverage errorCount failureCount passedCount runCount skippedCount timedOut unrunCount | + runCount := data at: #runCount. + passedCount := data at: #passedCount. + skippedCount := (data at: #skipped ifAbsent: [ #( ) ]) size. + failureCount := (data at: #failures ifAbsent: [ #( ) ]) size. + errorCount := (data at: #errors ifAbsent: [ #( ) ]) size. timedOut := data at: #timedOut ifAbsent: [ false ]. - unrunCount := (data at: #unrunTests ifAbsent: [ #( ) ]) size. + unrunCount := (data at: #unrunClasses ifAbsent: [ #( ) ]) size + + (data at: #unrunMethods ifAbsent: [ #( ) ]) size. coverage := data at: #coverage ifAbsent: [ nil ]. ^ String streamContents: [ :stream | - timedOut ifTrue: [ stream nextPutAll: 'Timed out. ' ]. - stream - nextPutAll: 'Executed '; - nextPutAll: selectionCount asString; - nextPutAll: ' '; - nextPutAll: selectionWord; - nextPutAll: ' covering '; - nextPutAll: selectedTestCount asString; - nextPutAll: ' unique tests ('; - nextPutAll: runCount asString; - nextPutAll: ' ran'. - skippedCount > 0 ifTrue: [ - stream - nextPutAll: ', '; - nextPutAll: skippedCount asString; - nextPutAll: ' skipped' ]. - stream nextPutAll: ').'. - failureLikeCount > 0 ifTrue: [ - stream - space; - nextPutAll: failureCount asString; - nextPutAll: ' failures and '; - nextPutAll: errorCount asString; - nextPutAll: ' errors were reported.' ]. - timedOut ifTrue: [ - stream - space; - nextPutAll: unrunCount asString; - nextPutAll: ' test requests remain in unrunTests.' ]. - coverage ifNotNil: [ - stream - space; - nextPutAll: 'Coverage: '; - nextPutAll: (self coveragePercentageTextFor: coverage); - nextPutAll: ' over '; - nextPutAll: (coverage at: #methodCount) asString; - nextPutAll: ' methods; '; - nextPutAll: (coverage at: #uncoveredMethodCount) asString; - nextPutAll: ' uncovered, '; - nextPutAll: - (coverage at: #partiallyCoveredMethodCount) asString; - nextPutAll: ' partially covered.' ] ] + timedOut ifTrue: [ stream nextPutAll: 'Timed out. ' ]. + stream + nextPutAll: 'Ran '; + nextPutAll: runCount asString; + nextPutAll: ' tests ('; + nextPutAll: passedCount asString; + nextPutAll: ' passed'. + skippedCount > 0 ifTrue: [ + stream + nextPutAll: ', '; + nextPutAll: skippedCount asString; + nextPutAll: ' skipped' ]. + stream nextPutAll: ').'. + failureCount + errorCount > 0 ifTrue: [ + stream + space; + nextPutAll: failureCount asString; + nextPutAll: ' failures, '; + nextPutAll: errorCount asString; + nextPutAll: ' errors.' ]. + unrunCount > 0 ifTrue: [ + stream + space; + nextPutAll: unrunCount asString; + nextPutAll: ' selections left unrun.' ]. + coverage ifNotNil: [ :coverageData | + stream + space; + nextPutAll: 'Coverage: '; + nextPutAll: (self coveragePercentageTextFor: coverageData); + nextPutAll: '%.' ] ] ] { #category : 'private - tests' } -MCPToolRunTests >> testIssueObjectSchema [ +MCPToolRunTests >> testIssueArraySchemaNamed: propertyName description: propertyDescription [ - | issueProperty | - issueProperty := MCPStructureProperties new - type: 'object'; - description: - 'A single test issue recorded while running tests.'; - properties: { - (self - schemaPropertyNamed: 'kind' - type: 'string' - description: - 'The issue category, such as failure, error, or skipped.'). - (self - schemaPropertyNamed: 'className' - type: 'string' - description: - 'The test class that produced the issue.'). - (self - schemaPropertyNamed: 'testMethodName' - type: 'string' - description: - 'The test method that produced the issue.'). - (self - schemaPropertyNamed: 'testCaseName' - type: 'string' - description: - 'The concrete test case name, including parameter values when available.'). - (self - stringArraySchemaNamed: 'parameters' - description: - 'Parameter bindings for the concrete test case when the issue came from a parameterized test.' - itemDescription: - 'A printed parameter binding, such as #encoding->''UTF-16''.'). - (self - schemaPropertyNamed: 'errorClass' - type: 'string' - description: - 'The exception class captured for the issue.'). - (self - schemaPropertyNamed: 'message' - type: 'string' - description: - 'The exception message for the issue.'). - (self - schemaPropertyNamed: 'description' - type: 'string' - description: - 'A longer textual description of the issue when available.'). - (self - schemaPropertyNamed: 'signalerContext' - type: 'string' - description: - 'The signaler context captured for the issue when available.') }; - required: - #( 'kind' 'className' 'testMethodName' - 'errorClass' 'message' ); - additionalProperties: false; - yourself. - ^ issueProperty + ^ (self + schemaPropertyNamed: propertyName + type: 'array' + description: propertyDescription) + items: self testIssueObjectSchema; + yourself ] -{ #category : 'private - errors' } -MCPToolRunTests >> testNameFromRawTestValue: rawValue request: rawRequest [ - - | className testMethodName | - rawValue isDictionary ifFalse: [ ^ rawValue asString ]. - className := rawRequest - valueNamed: 'className' - in: rawValue - ifAbsent: [ ^ rawValue asString ]. - className ifNil: [ ^ rawValue asString ]. - testMethodName := rawRequest - valueNamed: 'testMethodName' - in: rawValue - ifAbsent: [ nil ]. - ^ testMethodName - ifNil: [ className asString ] - ifNotNil: [ :methodName | - className asString , '>>' , methodName asString ] +{ #category : 'private - tests' } +MCPToolRunTests >> testIssueObjectSchema [ + + ^ MCPStructureProperties new + type: 'object'; + properties: { + (self + schemaPropertyNamed: 'test' + type: 'string' + description: 'Test reference.'). + (self + schemaPropertyNamed: 'message' + type: 'string' + description: 'Failure or error message.'). + (self + schemaPropertyNamed: 'errorClass' + type: 'string' + description: 'Error class.'). + (self + stringArraySchemaNamed: 'parameters' + description: 'Parameterized test values.' + itemDescription: nil) }; + required: #( 'test' ); + additionalProperties: false; + yourself ] { #category : 'private - errors' } @@ -525,9 +388,7 @@ MCPToolRunTests >> testNamesForErrorFromParsedRequest: runTestsRequest rawReques runTestsRequest ifNotNil: [ ^ self testNamesFromRequests: runTestsRequest testRequests ]. - ^ ((rawRequest objectCollectionArgumentNamed: 'tests') collect: [ - :each | self testNameFromRawTestValue: each request: rawRequest ]) - asArray + ^ self rawTestNamesFromRequest: rawRequest ] { #category : 'private - errors' } @@ -536,47 +397,55 @@ MCPToolRunTests >> testNamesFromRequests: testRequests [ ^ (testRequests collect: [ :each | each displayName ]) asArray ] -{ #category : 'private' } -MCPToolRunTests >> testRequestObjectSchema [ - - ^ MCPStructureProperties new - type: 'object'; - description: 'Test request.'; - properties: { - (self - schemaPropertyNamed: 'className' - type: 'string' - description: 'Test class.'). - (self - schemaPropertyNamed: 'testMethodName' - type: 'string' - description: 'Test method.') }; - required: #( 'className' ); - additionalProperties: false; - yourself +{ #category : 'private - tests' } +MCPToolRunTests >> testRunDataProperties [ + + ^ { + (self + integerSchemaPropertyNamed: 'runCount' + description: 'Tests run.'). + (self + integerSchemaPropertyNamed: 'passedCount' + description: 'Tests passed.'). + (self + stringArraySchemaNamed: 'skipped' + description: 'Skipped tests.' + itemDescription: nil). + (self + testIssueArraySchemaNamed: 'failures' + description: 'Failed tests.'). + (self + testIssueArraySchemaNamed: 'errors' + description: 'Errored tests.'). + (self + booleanSchemaPropertyNamed: 'timedOut' + description: 'Timeout stopped run.'). + (self + stringArraySchemaNamed: 'unrunClasses' + description: 'Unrun test classes.' + itemDescription: nil). + (self + stringArraySchemaNamed: 'unrunMethods' + description: 'Unrun test methods.' + itemDescription: nil) } ] -{ #category : 'private' } -MCPToolRunTests >> testResultObjectSchema [ - - | properties | - properties := OrderedCollection withAll: - (self standardTestDataPropertiesIncludingMethodName: - false). - properties add: (self - schemaPropertyNamed: 'testMethodName' - type: 'string' - description: - 'The single test method that was executed when the batch entry targeted one method.'). - ^ MCPStructureProperties new - type: 'object'; - description: - 'Structured results for one test execution request in the batch.'; - properties: properties asArray; - required: - (self standardTestRequiredFieldsIncludingMethodName: false); - additionalProperties: false; - yourself +{ #category : 'private - tests' } +MCPToolRunTests >> testSelectionInputProperties [ + + ^ { + (self + stringArraySchemaNamed: 'packages' + description: 'Test packages run.' + itemDescription: nil). + (self + stringArraySchemaNamed: 'classes' + description: 'Test classes run.' + itemDescription: nil). + (self + stringArraySchemaNamed: 'methods' + description: 'Test methods as Class>>#selector.' + itemDescription: nil) } ] { #category : 'metadata' } From 0fa45002b5f05bfa4bb1bcecb2b73e090e4be509 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Thu, 25 Jun 2026 14:27:20 +0200 Subject: [PATCH 13/21] Track unrun test packages Co-authored-by: Codex --- src/MCP-Tests/MCPToolContractsTest.class.st | 57 +++++---- .../MCPToolStructuredOutputTest.class.st | 39 +++--- src/MCP/MCPRunTestsCommand.class.st | 119 +++++++++++++----- src/MCP/MCPRunTestsRequest.class.st | 17 +-- src/MCP/MCPRunTestsResult.class.st | 16 ++- src/MCP/MCPTestRunRequest.class.st | 58 ++++++--- src/MCP/MCPToolRunTests.class.st | 7 +- src/MCP/MCPValidatedTestRunRequest.class.st | 14 ++- 8 files changed, 220 insertions(+), 107 deletions(-) diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 5560d29..f79348a 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -2509,9 +2509,9 @@ MCPToolContractsTest >> testRunTestToolsHaveAccurateNamesAndRequiredArguments [ | coverageDataProperties coverageInputProperties coverageInputProperty coverageTool dataProperties inputPropertyNames outputSchema tool | tool := MCPToolRunTests new. self assert: tool name equals: 'test_run'. - self assert: (tool inputSchema required ifNil: [ #( ) ]) isEmpty. + self assert: (tool inputSchema required ifNil: [ #( ) ]) isEmpty. inputPropertyNames := tool inputSchema properties collect: [ :each | - each name ]. + each name ]. self assert: inputPropertyNames asSet equals: #( 'packages' 'classes' 'methods' 'timeoutSeconds' ) asSet. @@ -2525,6 +2525,7 @@ MCPToolContractsTest >> testRunTestToolsHaveAccurateNamesAndRequiredArguments [ self assert: (dataProperties includesKey: 'skipped'). self assert: (dataProperties includesKey: 'failures'). self assert: (dataProperties includesKey: 'errors'). + self assert: (dataProperties includesKey: 'unrunPackages'). self assert: (dataProperties includesKey: 'unrunClasses'). self assert: (dataProperties includesKey: 'unrunMethods'). self deny: (dataProperties includesKey: 'results'). @@ -2534,7 +2535,7 @@ MCPToolContractsTest >> testRunTestToolsHaveAccurateNamesAndRequiredArguments [ self assert: coverageTool name equals: 'test_coverage_run'. self assert: coverageTool inputSchema required asSet equals: #( 'coverage' ) asSet. inputPropertyNames := coverageTool inputSchema properties collect: [ :each | - each name ]. + each name ]. self assert: inputPropertyNames asSet equals: @@ -2542,34 +2543,44 @@ MCPToolContractsTest >> testRunTestToolsHaveAccurateNamesAndRequiredArguments [ self deny: (inputPropertyNames includes: 'tests'). self deny: (inputPropertyNames includes: 'timeoutMilliseconds'). coverageInputProperty := coverageTool inputSchema properties detect: [ :each | - each name = 'coverage' ]. - coverageInputProperties := coverageInputProperty extraProperties at: #properties. - self assert: (coverageInputProperties anySatisfy: [ :each | - each name = 'methodLimit' ]). + each name = 'coverage' ]. + coverageInputProperties := coverageInputProperty asJRPCJSON at: #properties. + self + assert: coverageInputProperties keys asSet + equals: #( 'scope' 'side' 'includeCoveredMethods' 'methodLimit' ) asSet. outputSchema := coverageTool outputSchema asJRPCJSON. - coverageDataProperties := ((outputSchema at: #properties) at: 'data') - at: #properties. - self assert: (coverageDataProperties includesKey: 'runCount'). - self assert: (coverageDataProperties includesKey: 'passedCount'). - self assert: (coverageDataProperties includesKey: 'coverage'). - self deny: (coverageDataProperties includesKey: 'results') + dataProperties := ((outputSchema at: #properties) at: 'data') at: #properties. + self assert: (dataProperties includesKey: 'coverage'). + self assert: (dataProperties includesKey: 'runCount'). + self assert: (dataProperties includesKey: 'passedCount'). + self assert: (dataProperties includesKey: 'unrunPackages'). + coverageDataProperties := (dataProperties at: 'coverage') at: #properties. + self assert: (coverageDataProperties includesKey: 'methodCount'). + self assert: (coverageDataProperties includesKey: 'uncoveredMethods'). + self assert: (coverageDataProperties includesKey: 'partiallyCoveredMethods') ] { #category : 'tests' } -MCPToolContractsTest >> testRunTestsExpandsPackagesToConcreteTestClasses [ +MCPToolContractsTest >> testRunTestsKeepsPackagesAsPackageSelections [ - | classNames parsedRequest rawRequest tool | + | command parsedRequest rawRequest testCases testRequests tool validatedRequests | tool := MCPToolRunTests new. rawRequest := tool requestFromToolCallArguments: - { (#packages -> #( 'MCP-Tests' )) } asDictionary. + { (#packages -> #( 'MCP-Tests' )) } asDictionary. parsedRequest := tool parsedRequestFromToolRequest: rawRequest. - classNames := parsedRequest testRequests collect: [ :each | - each className ]. - self assert: classNames isSorted. - self assert: (classNames includes: 'MCPToolContractsTest'). - self deny: (classNames includes: 'MCPToolStructuredOutputTestTarget'). - self assert: (parsedRequest testRequests allSatisfy: [ :each | - each testMethodName isNil ]) + testRequests := parsedRequest testRequests. + self assert: testRequests size equals: 1. + self assert: testRequests first isPackageRequest. + self assert: testRequests first packageName equals: 'MCP-Tests'. + self assert: testRequests first displayName equals: 'MCP-Tests'. + self assert: testRequests first className equals: nil. + self assert: testRequests first testMethodName equals: nil. + command := tool commandForRequest: parsedRequest. + validatedRequests := command validatedRequestsFrom: testRequests. + self assert: validatedRequests first isPackageRequest. + testCases := command testCasesForValidatedRequest: validatedRequests first. + self assert: testCases notEmpty. + self assert: (testCases noneSatisfy: [ :each | each class isAbstract ]) ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPToolStructuredOutputTest.class.st b/src/MCP-Tests/MCPToolStructuredOutputTest.class.st index 0b9fdad..fcbcf57 100644 --- a/src/MCP-Tests/MCPToolStructuredOutputTest.class.st +++ b/src/MCP-Tests/MCPToolStructuredOutputTest.class.st @@ -549,36 +549,39 @@ MCPToolStructuredOutputTest >> testRunTestsTimeoutReturnsPartialResultsAndUnrunS | data request resumedData resumedResult result runTestsRequest tool | tool := MCPToolRunTests new. runTestsRequest := MCPRunTestsRequest new - initializeTestRequests: { - (MCPTestRunRequest className: - 'MCPToolRunTestsTimeoutTarget'). - (MCPTestRunRequest className: - 'MCPToolCoverageTargetTest') } - timeoutMilliseconds: 100 - operation: 'run' - coverageRequest: nil. + initializeTestRequests: { + (MCPTestRunRequest className: 'MCPToolRunTestsTimeoutTarget'). + (MCPTestRunRequest className: 'MCPToolCoverageTargetTest'). + (MCPTestRunRequest packageName: 'MCP-Spec-Tests') } + timeoutMilliseconds: 100 + operation: 'run' + coverageRequest: nil. result := (tool commandForRequest: runTestsRequest) execute. data := result asDictionary. self assert: (data at: #timedOut). self assert: (data at: #runCount) equals: 1. self assert: (data at: #passedCount) equals: 1. - self assert: (data at: #unrunMethods) equals: - #( 'MCPToolRunTestsTimeoutTarget>>#testSlowPass' ). - self assert: (data at: #unrunClasses) equals: - #( 'MCPToolCoverageTargetTest' ). + self + assert: (data at: #unrunMethods) + equals: #( 'MCPToolRunTestsTimeoutTarget>>#testSlowPass' ). + self + assert: (data at: #unrunClasses) + equals: #( 'MCPToolCoverageTargetTest' ). + self assert: (data at: #unrunPackages) equals: #( 'MCP-Spec-Tests' ). request := Dictionary new - at: #methods put: (data at: #unrunMethods); - at: #classes put: (data at: #unrunClasses); - at: #timeoutSeconds put: 1; - yourself. + at: #methods put: (data at: #unrunMethods); + at: #classes put: (data at: #unrunClasses); + at: #packages put: (data at: #unrunPackages); + at: #timeoutSeconds put: 30; + yourself. resumedResult := self callToolNamed: 'test_run' withArguments: request. resumedData := self dataFrom: resumedResult. self assert: ((self structuredContentFrom: resumedResult) at: #status) equals: 'ok'. self deny: (resumedData includesKey: #timedOut). - self assert: (resumedData at: #runCount) equals: 3. - self assert: (resumedData at: #passedCount) equals: 3 + self assert: (resumedData at: #passedCount) equals: (resumedData at: #runCount). + self assert: (resumedData at: #runCount) > 3 ] { #category : 'tests' } diff --git a/src/MCP/MCPRunTestsCommand.class.st b/src/MCP/MCPRunTestsCommand.class.st index 25990ca..596a043 100644 --- a/src/MCP/MCPRunTestsCommand.class.st +++ b/src/MCP/MCPRunTestsCommand.class.st @@ -120,34 +120,35 @@ MCPRunTestsCommand >> resultForValidatedRequest: validatedRequest deadline: dead | includeResult result resultInfo selectedTestCount testCases timedOutIndex unrunTestRequests | testCases := self - uniqueTestCasesForValidatedRequest: validatedRequest - seenTestCaseNames: seenTestCaseNames. + uniqueTestCasesForValidatedRequest: validatedRequest + seenTestCaseNames: seenTestCaseNames. selectedTestCount := testCases size. result := MCPStructuredTestResult new. timedOutIndex := nil. testCases doWithIndex: [ :testCase :index | - timedOutIndex ifNil: [ - (self runTestCase: testCase into: result deadline: deadline) - ifTrue: [ timedOutIndex := index ] ] ]. + timedOutIndex ifNil: [ + (self runTestCase: testCase into: result deadline: deadline) ifTrue: [ + timedOutIndex := index ] ] ]. includeResult := self - shouldIncludeTestResult: result - selectedTestCount: selectedTestCount - timedOutIndex: timedOutIndex. + shouldIncludeTestResult: result + selectedTestCount: selectedTestCount + timedOutIndex: timedOutIndex. resultInfo := includeResult ifTrue: [ - self - testRunInfoForTestResult: result - validatedRequest: validatedRequest - selectedTestCount: selectedTestCount ]. + self + testRunInfoForTestResult: result + validatedRequest: validatedRequest + selectedTestCount: selectedTestCount ]. unrunTestRequests := timedOutIndex - ifNil: [ #( ) ] - ifNotNil: [ - self - testRequestsForTestCases: testCases - startingAt: timedOutIndex ]. + ifNil: [ #( ) ] + ifNotNil: [ + self + unrunRequestsForValidatedRequest: validatedRequest + testCases: testCases + startingAt: timedOutIndex ]. ^ MCPTestRunResult - resultInfo: resultInfo - timedOut: timedOutIndex notNil - unrunTestRequests: unrunTestRequests + resultInfo: resultInfo + timedOut: timedOutIndex notNil + unrunTestRequests: unrunTestRequests ] { #category : 'private - coverage' } @@ -257,10 +258,21 @@ MCPRunTestsCommand >> testCaseDeduplicationKeyFor: aTestCase [ nextPutAll: aTestCase nameForReport ] ] +{ #category : 'private' } +MCPRunTestsCommand >> testCasesForPackageRequest: validatedRequest [ + + ^ Array streamContents: [ :stream | + (self testClassesInPackageNamed: validatedRequest packageName) do: [ :testClass | + (self testCasesFromSuite: testClass suite) do: [ :testCase | + stream nextPut: testCase ] ] ] +] + { #category : 'private' } MCPRunTestsCommand >> testCasesForValidatedRequest: validatedRequest [ | suite testCases testMethodSelector | + validatedRequest isPackageRequest ifTrue: [ + ^ self testCasesForPackageRequest: validatedRequest ]. suite := validatedRequest testClass suite. testCases := self testCasesFromSuite: suite. validatedRequest testMethodName ifNotNil: [ :testMethodName | @@ -278,6 +290,16 @@ MCPRunTestsCommand >> testCasesFromSuite: aSuite [ ^ testCases asArray ] +{ #category : 'private' } +MCPRunTestsCommand >> testClassesInPackageNamed: packageName [ + + | package | + package := MCPImageLookup packageNamed: packageName scopeName: 'packages'. + ^ (package definedClasses select: [ :each | + each isTestCase and: [ each isAbstract not ] ]) asArray + sort: [ :left :right | left name <= right name ] +] + { #category : 'private' } MCPRunTestsCommand >> testRequestForTestCase: aTestCase [ @@ -286,6 +308,26 @@ MCPRunTestsCommand >> testRequestForTestCase: aTestCase [ testMethodName: aTestCase selector asString ] +{ #category : 'private' } +MCPRunTestsCommand >> testRequestsByClassForTestCases: testCases startingAt: startIndex [ + + | firstClass requests seenClassNames | + requests := OrderedCollection new. + seenClassNames := Set new. + firstClass := (testCases at: startIndex) class. + startIndex to: testCases size do: [ :index | + | className testCase | + testCase := testCases at: index. + className := testCase class name asString. + testCase class = firstClass + ifTrue: [ requests add: (self testRequestForTestCase: testCase) ] + ifFalse: [ + (seenClassNames includes: className) ifFalse: [ + seenClassNames add: className. + requests add: (MCPTestRunRequest className: className) ] ] ]. + ^ requests asArray +] + { #category : 'private' } MCPRunTestsCommand >> testRequestsForTestCases: testCases startingAt: startIndex [ @@ -351,6 +393,16 @@ MCPRunTestsCommand >> unrunRequestsForValidatedRequest: validatedRequest seenTes ^ self testRequestsForTestCases: uniqueTestCases startingAt: 1 ] +{ #category : 'private' } +MCPRunTestsCommand >> unrunRequestsForValidatedRequest: validatedRequest testCases: testCases startingAt: startIndex [ + + validatedRequest isPackageRequest ifTrue: [ + ^ self + testRequestsByClassForTestCases: testCases + startingAt: startIndex ]. + ^ self testRequestsForTestCases: testCases startingAt: startIndex +] + { #category : 'private' } MCPRunTestsCommand >> unrunTestsFrom: validatedRequests startingAt: startIndex seenTestCaseNames: seenTestCaseNames [ @@ -367,15 +419,20 @@ MCPRunTestsCommand >> unrunTestsFrom: validatedRequests startingAt: startIndex s MCPRunTestsCommand >> validatedRequestsFrom: testRequests [ ^ testRequests collect: [ :each | - | testClass | - testClass := MCPImageLookup classNamed: each className. - each testMethodName ifNotNil: [ :testMethodName | - testClass - compiledMethodAt: testMethodName asSymbol - ifAbsent: [ - MCPCommandError - signalMissingMethodInClassName: each className - classSide: false - selector: testMethodName ] ]. - MCPValidatedTestRunRequest request: each testClass: testClass ] + each isPackageRequest + ifTrue: [ + self testClassesInPackageNamed: each packageName. + MCPValidatedTestRunRequest request: each testClass: nil ] + ifFalse: [ + | testClass | + testClass := MCPImageLookup classNamed: each className. + each testMethodName ifNotNil: [ :testMethodName | + testClass + compiledMethodAt: testMethodName asSymbol + ifAbsent: [ + MCPCommandError + signalMissingMethodInClassName: each className + classSide: false + selector: testMethodName ] ]. + MCPValidatedTestRunRequest request: each testClass: testClass ] ] ] diff --git a/src/MCP/MCPRunTestsRequest.class.st b/src/MCP/MCPRunTestsRequest.class.st index 53153af..34c886a 100644 --- a/src/MCP/MCPRunTestsRequest.class.st +++ b/src/MCP/MCPRunTestsRequest.class.st @@ -1,5 +1,7 @@ " -Parsed request for the shared test runner command. It contains parsed test requests, the timeout converted to milliseconds, and the internal operation selected by the concrete tool. Coverage requests are supplied by MCPToolRunTestCoverage. +Parsed request shared by test_run and test_coverage_run. + +It stores compact test selections, timeout converted to milliseconds, and the internal operation selected by the concrete tool. Coverage requests are supplied by MCPToolRunTestCoverage. " Class { #name : 'MCPRunTestsRequest', @@ -33,8 +35,7 @@ MCPRunTestsRequest class >> addMethodReferences: methodReferences to: requests [ MCPRunTestsRequest class >> addPackageNames: packageNames to: requests [ packageNames do: [ :packageName | - (self testClassesInPackageNamed: packageName) do: [ :testClass | - requests add: (MCPTestRunRequest className: testClass name asString) ] ] + requests add: (MCPTestRunRequest packageName: packageName) ] ] { #category : 'instance creation' } @@ -57,16 +58,6 @@ MCPRunTestsRequest class >> fromRequest: aRequest tool: aTool operation: operati coverageRequest: coverageRequest ] -{ #category : 'private - parsing' } -MCPRunTestsRequest class >> testClassesInPackageNamed: packageName [ - - | package | - package := MCPImageLookup packageNamed: packageName scopeName: 'packages'. - ^ (package definedClasses select: [ :each | - each isTestCase and: [ each isAbstract not ] ]) asArray - sort: [ :left :right | left name <= right name ] -] - { #category : 'private - parsing' } MCPRunTestsRequest class >> testRequestsFromToolRequest: request [ diff --git a/src/MCP/MCPRunTestsResult.class.st b/src/MCP/MCPRunTestsResult.class.st index 86a0298..6731607 100644 --- a/src/MCP/MCPRunTestsResult.class.st +++ b/src/MCP/MCPRunTestsResult.class.st @@ -29,7 +29,7 @@ MCPRunTestsResult class >> results: resultCollection timedOut: aBoolean unrunTes { #category : 'converting' } MCPRunTestsResult >> asDictionary [ - | data errors failures skipped unrunClasses unrunMethods | + | data errors failures skipped unrunClasses unrunMethods unrunPackages | data := Dictionary new. data at: #runCount put: self runCount. data at: #passedCount put: self passedCount. @@ -43,6 +43,9 @@ MCPRunTestsResult >> asDictionary [ data at: #coverage put: coverageResult asDictionary ]. self timedOut ifTrue: [ data at: #timedOut put: true. + unrunPackages := self unrunPackageNames. + unrunPackages ifNotEmpty: [ + data at: #unrunPackages put: unrunPackages ]. unrunClasses := self unrunClassNames. unrunClasses ifNotEmpty: [ data at: #unrunClasses put: unrunClasses ]. @@ -181,7 +184,7 @@ MCPRunTestsResult >> unrunClassNames [ ^ self uniqueStringsFrom: (Array streamContents: [ :stream | self unrunTests do: [ :request | - request hasTestMethod ifFalse: [ + (request isPackageRequest not and: [ request hasTestMethod not ]) ifTrue: [ stream nextPut: request className ] ] ]) ] @@ -194,6 +197,15 @@ MCPRunTestsResult >> unrunMethodReferences [ stream nextPut: request displayName ] ] ]) ] +{ #category : 'converting' } +MCPRunTestsResult >> unrunPackageNames [ + + ^ self uniqueStringsFrom: (Array streamContents: [ :stream | + self unrunTests do: [ :request | + request isPackageRequest ifTrue: [ + stream nextPut: request packageName ] ] ]) +] + { #category : 'converting' } MCPRunTestsResult >> unrunTestDictionaries [ diff --git a/src/MCP/MCPTestRunRequest.class.st b/src/MCP/MCPTestRunRequest.class.st index 6c5db22..4d22dc0 100644 --- a/src/MCP/MCPTestRunRequest.class.st +++ b/src/MCP/MCPTestRunRequest.class.st @@ -1,12 +1,13 @@ " Parsed test_run selection. -A request represents either a whole test class or one test method. Package selections are expanded into class requests before execution. +A request represents one package, one whole test class, or one test method. Package selections remain package requests until execution so timeout reporting can distinguish unentered packages from interrupted classes. " Class { #name : 'MCPTestRunRequest', #superclass : 'Object', #instVars : [ + 'packageName', 'className', 'testMethodName' ], @@ -25,8 +26,9 @@ MCPTestRunRequest class >> className: aClassName [ MCPTestRunRequest class >> className: aClassName testMethodName: aTestMethodName [ ^ self new - initializeClassName: aClassName - testMethodName: aTestMethodName + initializePackageName: nil + className: aClassName + testMethodName: aTestMethodName ] { #category : 'instance creation' } @@ -48,25 +50,23 @@ MCPTestRunRequest class >> fromMethodReference: aString [ ] { #category : 'instance creation' } -MCPTestRunRequest class >> fromValue: rawValue usingToolRequest: toolRequest [ - - | className testMethodName | - className := toolRequest - stringArgumentNamed: 'className' - in: rawValue. - className ifNil: [ - Error signal: 'tests must contain only non-empty class names.' ]. - testMethodName := toolRequest - stringArgumentNamed: 'testMethodName' - in: rawValue. - ^ self className: className testMethodName: testMethodName +MCPTestRunRequest class >> packageName: aPackageName [ + + ^ self new + initializePackageName: aPackageName + className: nil + testMethodName: nil ] { #category : 'converting' } MCPTestRunRequest >> asDictionary [ | data | - data := { (#className -> self className) } asDictionary. + data := Dictionary new. + self isPackageRequest ifTrue: [ + data at: #packageName put: self packageName. + ^ data ]. + data at: #className put: self className. self testMethodName ifNotNil: [ data at: #testMethodName put: self testMethodName ]. ^ data @@ -81,6 +81,7 @@ MCPTestRunRequest >> className [ { #category : 'accessing' } MCPTestRunRequest >> displayName [ + self isPackageRequest ifTrue: [ ^ self packageName ]. ^ self testMethodName ifNil: [ self className ] ifNotNil: [ :methodName | self className , '>>#' , methodName ] @@ -95,9 +96,30 @@ MCPTestRunRequest >> hasTestMethod [ { #category : 'initialization' } MCPTestRunRequest >> initializeClassName: aClassName testMethodName: aTestMethodName [ + self + initializePackageName: nil + className: aClassName + testMethodName: aTestMethodName +] + +{ #category : 'initialization' } +MCPTestRunRequest >> initializePackageName: aPackageName className: aClassName testMethodName: aTestMethodName [ + + packageName := aPackageName. className := aClassName. - testMethodName := aTestMethodName. - ^ self + testMethodName := aTestMethodName +] + +{ #category : 'testing' } +MCPTestRunRequest >> isPackageRequest [ + + ^ self packageName notNil +] + +{ #category : 'accessing' } +MCPTestRunRequest >> packageName [ + + ^ packageName ] { #category : 'printing' } diff --git a/src/MCP/MCPToolRunTests.class.st b/src/MCP/MCPToolRunTests.class.st index 46cb436..5ac56eb 100644 --- a/src/MCP/MCPToolRunTests.class.st +++ b/src/MCP/MCPToolRunTests.class.st @@ -308,7 +308,8 @@ MCPToolRunTests >> successSummaryForData: data [ failureCount := (data at: #failures ifAbsent: [ #( ) ]) size. errorCount := (data at: #errors ifAbsent: [ #( ) ]) size. timedOut := data at: #timedOut ifAbsent: [ false ]. - unrunCount := (data at: #unrunClasses ifAbsent: [ #( ) ]) size + unrunCount := (data at: #unrunPackages ifAbsent: [ #( ) ]) size + + (data at: #unrunClasses ifAbsent: [ #( ) ]) size + (data at: #unrunMethods ifAbsent: [ #( ) ]) size. coverage := data at: #coverage ifAbsent: [ nil ]. ^ String streamContents: [ :stream | @@ -420,6 +421,10 @@ MCPToolRunTests >> testRunDataProperties [ (self booleanSchemaPropertyNamed: 'timedOut' description: 'Timeout stopped run.'). + (self + stringArraySchemaNamed: 'unrunPackages' + description: 'Unrun test packages.' + itemDescription: nil). (self stringArraySchemaNamed: 'unrunClasses' description: 'Unrun test classes.' diff --git a/src/MCP/MCPValidatedTestRunRequest.class.st b/src/MCP/MCPValidatedTestRunRequest.class.st index d4f600e..601ef9a 100644 --- a/src/MCP/MCPValidatedTestRunRequest.class.st +++ b/src/MCP/MCPValidatedTestRunRequest.class.st @@ -1,7 +1,7 @@ " Validated test_run selection. -It pairs the parsed test run request with the resolved test class that the command will execute. +Class and method selections store their resolved test class. Package selections keep a nil test class and are expanded by MCPRunTestsCommand when execution reaches them. " Class { #name : 'MCPValidatedTestRunRequest', @@ -53,6 +53,18 @@ MCPValidatedTestRunRequest >> initializeRequest: aTestRunRequest testClass: aTes ^ self ] +{ #category : 'testing' } +MCPValidatedTestRunRequest >> isPackageRequest [ + + ^ self testRunRequest isPackageRequest +] + +{ #category : 'accessing' } +MCPValidatedTestRunRequest >> packageName [ + + ^ self testRunRequest packageName +] + { #category : 'accessing' } MCPValidatedTestRunRequest >> testClass [ From c40a2ec2713deec009863f57c7ccbe56e2be9543 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Thu, 25 Jun 2026 15:18:45 +0200 Subject: [PATCH 14/21] Consolidate command and query reuse Co-authored-by: Codex --- src/MCP/MCPAddSlotCommand.class.st | 41 ----- src/MCP/MCPChangeClassCommentCommand.class.st | 13 -- src/MCP/MCPClassCommand.class.st | 65 ++++++- src/MCP/MCPClassScopeQuery.class.st | 158 +----------------- src/MCP/MCPClassSlotCommand.class.st | 20 ++- src/MCP/MCPCompiledMethodScopeQuery.class.st | 158 +----------------- src/MCP/MCPCreateClassCommand.class.st | 61 ------- src/MCP/MCPDebugCommand.class.st | 35 +++- src/MCP/MCPDebugControlCommand.class.st | 37 ---- src/MCP/MCPDebugEvaluateCommand.class.st | 36 ---- .../MCPListChangeHistoryLogsCommand.class.st | 9 - src/MCP/MCPMoveClassCommand.class.st | 13 -- src/MCP/MCPMoveSlotCommand.class.st | 41 +---- src/MCP/MCPRemoveSlotCommand.class.st | 41 ----- src/MCP/MCPRenameClassCommand.class.st | 13 -- src/MCP/MCPRenameSlotCommand.class.st | 41 +---- src/MCP/MCPReparentClassCommand.class.st | 13 -- .../MCPReplaceClassDefinitionCommand.class.st | 13 -- src/MCP/MCPReplaceClassLayoutCommand.class.st | 36 ---- ...MCPReplaceClassSharedPoolsCommand.class.st | 38 ----- ...eplaceClassSharedVariablesCommand.class.st | 13 -- .../MCPReplaceClassSideTraitsCommand.class.st | 13 -- src/MCP/MCPReplaceClassTraitsCommand.class.st | 13 -- src/MCP/MCPRepositoryFetchResult.class.st | 7 +- src/MCP/MCPRepositoryPushResult.class.st | 7 +- src/MCP/MCPRepositoryResult.class.st | 24 +++ src/MCP/MCPScopeQuery.class.st | 157 +++++++++++++++++ src/MCP/MCPUpdateDebugMethodCommand.class.st | 36 ---- 28 files changed, 302 insertions(+), 850 deletions(-) create mode 100644 src/MCP/MCPScopeQuery.class.st diff --git a/src/MCP/MCPAddSlotCommand.class.st b/src/MCP/MCPAddSlotCommand.class.st index bf0eeea..dffa2df 100644 --- a/src/MCP/MCPAddSlotCommand.class.st +++ b/src/MCP/MCPAddSlotCommand.class.st @@ -4,11 +4,6 @@ Adds a slot to a class or metaclass through the refactoring engine. Class { #name : 'MCPAddSlotCommand', #superclass : 'MCPClassSlotCommand', - #instVars : [ - 'className', - 'slotName', - 'classSide' - ], #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' @@ -24,30 +19,6 @@ MCPAddSlotCommand class >> className: aClassName slotName: aSlotName classSide: yourself ] -{ #category : 'accessing' } -MCPAddSlotCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPAddSlotCommand >> className: aClassName [ - - className := aClassName -] - -{ #category : 'accessing' } -MCPAddSlotCommand >> classSide [ - - ^ classSide -] - -{ #category : 'accessing' } -MCPAddSlotCommand >> classSide: aBoolean [ - - classSide := aBoolean -] - { #category : 'executing' } MCPAddSlotCommand >> execute [ @@ -69,15 +40,3 @@ MCPAddSlotCommand >> refactoringForBehavior: aBehavior [ variable: self slotName class: aBehavior ] - -{ #category : 'accessing' } -MCPAddSlotCommand >> slotName [ - - ^ slotName -] - -{ #category : 'accessing' } -MCPAddSlotCommand >> slotName: aSlotName [ - - slotName := aSlotName -] diff --git a/src/MCP/MCPChangeClassCommentCommand.class.st b/src/MCP/MCPChangeClassCommentCommand.class.st index ab2814e..5e641af 100644 --- a/src/MCP/MCPChangeClassCommentCommand.class.st +++ b/src/MCP/MCPChangeClassCommentCommand.class.st @@ -7,7 +7,6 @@ Class { #name : 'MCPChangeClassCommentCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'classComment' ], #category : 'MCP-Commands', @@ -36,18 +35,6 @@ MCPChangeClassCommentCommand >> classComment: aString [ classComment := aString ifNil: [ '' ] ifNotNil: [ aString asString ] ] -{ #category : 'accessing' } -MCPChangeClassCommentCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPChangeClassCommentCommand >> className: aString [ - - className := aString -] - { #category : 'executing' } MCPChangeClassCommentCommand >> execute [ diff --git a/src/MCP/MCPClassCommand.class.st b/src/MCP/MCPClassCommand.class.st index b5e1421..d2f4b01 100644 --- a/src/MCP/MCPClassCommand.class.st +++ b/src/MCP/MCPClassCommand.class.st @@ -6,6 +6,9 @@ Subclasses provide #className and implement their command-specific execution. Class { #name : 'MCPClassCommand', #superclass : 'MCPCommand', + #instVars : [ + 'className' + ], #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' @@ -20,7 +23,13 @@ MCPClassCommand class >> isAbstract [ { #category : 'accessing' } MCPClassCommand >> className [ - self subclassResponsibility + ^ className +] + +{ #category : 'accessing' } +MCPClassCommand >> className: aClassName [ + + className := aClassName ] { #category : 'private' } @@ -28,3 +37,57 @@ MCPClassCommand >> currentClass [ ^ MCPImageLookup classNamed: self className ] + +{ #category : 'accessing' } +MCPClassCommand >> layout [ + + self subclassResponsibility +] + +{ #category : 'private - resolving' } +MCPClassCommand >> resolvedLayoutClass [ + + | behavior | + self layout ifNil: [ ^ nil ]. + behavior := Smalltalk globals + at: self layout asSymbol + ifAbsent: [ + MCPCommandError + signalErrorCode: #LayoutClassNotFound + message: 'Layout class ' , self layout , ' does not exist.' + details: { + (#className -> self className). + (#layout -> self layout) } asDictionary ]. + (AbstractLayout withAllSubclasses includes: behavior) ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidLayoutClass + message: self layout , ' not layout class.' + details: { + (#className -> self className). + (#layout -> self layout) } asDictionary ]. + ^ behavior +] + +{ #category : 'private - resolving' } +MCPClassCommand >> resolvedSharedPoolNamed: aSharedPoolName [ + + | behavior sharedPoolName | + sharedPoolName := aSharedPoolName. + behavior := Smalltalk globals + at: sharedPoolName asSymbol + ifAbsent: [ + MCPCommandError + signalErrorCode: #SharedPoolNotFound + message: 'Shared pool ' , sharedPoolName , ' does not exist.' + details: { + (#className -> self className). + (#sharedPoolName -> sharedPoolName) } asDictionary ]. + (SharedPool withAllSubclasses includes: behavior) ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidSharedPool + message: sharedPoolName , ' not shared pool.' + details: { + (#className -> self className). + (#sharedPoolName -> sharedPoolName) } asDictionary ]. + ^ behavior +] diff --git a/src/MCP/MCPClassScopeQuery.class.st b/src/MCP/MCPClassScopeQuery.class.st index 6333668..af2f68c 100644 --- a/src/MCP/MCPClassScopeQuery.class.st +++ b/src/MCP/MCPClassScopeQuery.class.st @@ -5,16 +5,7 @@ It handles packageNames, classNames, hierarchyClassNames, subclassClassNames, an " Class { #name : 'MCPClassScopeQuery', - #superclass : 'Object', - #instVars : [ - 'packageNames', - 'classNames', - 'hierarchyClassNames', - 'subclassClassNames', - 'parentClassNames', - 'warnings', - 'requiresCompleteScope' - ], + #superclass : 'MCPScopeQuery', #category : 'MCP-Queries', #package : 'MCP', #tag : 'Queries' @@ -30,20 +21,6 @@ MCPClassScopeQuery >> allClasses [ ^ self sortedClassesByName: classes ] -{ #category : 'accessing' } -MCPClassScopeQuery >> classNames [ - - ^ classNames -] - -{ #category : 'accessing' } -MCPClassScopeQuery >> classNames: someClassNames [ - - classNames := someClassNames - ifNil: [ #( ) ] - ifNotNil: [ someClassNames asArray ] -] - { #category : 'private - scope' } MCPClassScopeQuery >> classScopeSets [ @@ -84,20 +61,6 @@ MCPClassScopeQuery >> classesForPackageNames [ ^ self sortedClassesByName: classes ] -{ #category : 'accessing' } -MCPClassScopeQuery >> hierarchyClassNames [ - - ^ hierarchyClassNames ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPClassScopeQuery >> hierarchyClassNames: someClassNames [ - - hierarchyClassNames := someClassNames - ifNil: [ #( ) ] - ifNotNil: [ someClassNames asArray ] -] - { #category : 'private - scope' } MCPClassScopeQuery >> hierarchyClassesNamed: someClassNames [ @@ -124,34 +87,6 @@ MCPClassScopeQuery >> initialize [ requiresCompleteScope := false ] -{ #category : 'accessing' } -MCPClassScopeQuery >> packageNames [ - - ^ packageNames -] - -{ #category : 'accessing' } -MCPClassScopeQuery >> packageNames: somePackageNames [ - - packageNames := somePackageNames - ifNil: [ #( ) ] - ifNotNil: [ somePackageNames asArray ] -] - -{ #category : 'accessing' } -MCPClassScopeQuery >> parentClassNames [ - - ^ parentClassNames ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPClassScopeQuery >> parentClassNames: someClassNames [ - - parentClassNames := someClassNames - ifNil: [ #( ) ] - ifNotNil: [ someClassNames asArray ] -] - { #category : 'private - scope' } MCPClassScopeQuery >> parentClassesNamed: someClassNames [ @@ -165,67 +100,6 @@ MCPClassScopeQuery >> parentClassesNamed: someClassNames [ ^ self sortedClassesByName: classes ] -{ #category : 'private - resolution' } -MCPClassScopeQuery >> recordMissingClassNamed: className inScope: scopeName [ - - | suggestions | - suggestions := MCPScopeNameSuggester classSuggestionsFor: className. - self requiresCompleteScope ifTrue: [ - ^ MCPCommandError - signalMissingClassNamed: className - scopeName: scopeName ]. - warnings ifNil: [ self resetWarnings ]. - warnings add: (MCPScopeNameSuggester - missingNameWarningForKind: 'Class' - name: className - scope: scopeName - suggestions: suggestions). - ^ nil -] - -{ #category : 'private - resolution' } -MCPClassScopeQuery >> recordMissingPackageNamed: packageName inScope: scopeName [ - - | suggestions | - suggestions := MCPScopeNameSuggester packageSuggestionsFor: - packageName. - self requiresCompleteScope ifTrue: [ - ^ MCPCommandError - signalMissingPackageNamed: packageName - scopeName: scopeName ]. - warnings ifNil: [ self resetWarnings ]. - warnings add: (MCPScopeNameSuggester - missingNameWarningForKind: 'Package' - name: packageName - scope: scopeName - suggestions: suggestions). - ^ nil -] - -{ #category : 'configuring' } -MCPClassScopeQuery >> requireCompleteScope [ - - self requiresCompleteScope: true -] - -{ #category : 'accessing' } -MCPClassScopeQuery >> requiresCompleteScope [ - - ^ requiresCompleteScope ifNil: [ false ] -] - -{ #category : 'accessing' } -MCPClassScopeQuery >> requiresCompleteScope: aBoolean [ - - requiresCompleteScope := aBoolean = true -] - -{ #category : 'private - resolution' } -MCPClassScopeQuery >> resetWarnings [ - - warnings := OrderedCollection new -] - { #category : 'private - resolution' } MCPClassScopeQuery >> resolvedClassNamed: className [ @@ -279,20 +153,6 @@ MCPClassScopeQuery >> sortedClassesByName: someClasses [ ^ someClasses asArray sort: [ :left :right | left name <= right name ] ] -{ #category : 'accessing' } -MCPClassScopeQuery >> subclassClassNames [ - - ^ subclassClassNames ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPClassScopeQuery >> subclassClassNames: someClassNames [ - - subclassClassNames := someClassNames - ifNil: [ #( ) ] - ifNotNil: [ someClassNames asArray ] -] - { #category : 'private - scope' } MCPClassScopeQuery >> subclassClassesNamed: someClassNames [ @@ -314,19 +174,3 @@ MCPClassScopeQuery >> unionClasses [ self classScopeSets do: [ :eachSet | classes addAll: eachSet ]. ^ self sortedClassesByName: classes ] - -{ #category : 'private - source' } -MCPClassScopeQuery >> usesImplicitImageScope [ - - ^ self packageNames isEmpty and: [ - self classNames isEmpty and: [ - self hierarchyClassNames isEmpty and: [ - self subclassClassNames isEmpty and: [ - self parentClassNames isEmpty ] ] ] ] -] - -{ #category : 'accessing' } -MCPClassScopeQuery >> warnings [ - - ^ warnings ifNil: [ #( ) ] ifNotNil: [ warnings asArray ] -] diff --git a/src/MCP/MCPClassSlotCommand.class.st b/src/MCP/MCPClassSlotCommand.class.st index 65b7493..3d98e27 100644 --- a/src/MCP/MCPClassSlotCommand.class.st +++ b/src/MCP/MCPClassSlotCommand.class.st @@ -6,6 +6,10 @@ Subclasses provide #slotName, #classSide, and the operation-specific refactoring Class { #name : 'MCPClassSlotCommand', #superclass : 'MCPClassCommand', + #instVars : [ + 'slotName', + 'classSide' + ], #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' @@ -20,7 +24,13 @@ MCPClassSlotCommand class >> isAbstract [ { #category : 'accessing' } MCPClassSlotCommand >> classSide [ - self subclassResponsibility + ^ classSide ifNil: [ false ] +] + +{ #category : 'accessing' } +MCPClassSlotCommand >> classSide: aBoolean [ + + classSide := aBoolean ] { #category : 'private' } @@ -40,5 +50,11 @@ MCPClassSlotCommand >> refactoringForBehavior: aBehavior [ { #category : 'accessing' } MCPClassSlotCommand >> slotName [ - self subclassResponsibility + ^ slotName +] + +{ #category : 'accessing' } +MCPClassSlotCommand >> slotName: aSlotName [ + + slotName := aSlotName ] diff --git a/src/MCP/MCPCompiledMethodScopeQuery.class.st b/src/MCP/MCPCompiledMethodScopeQuery.class.st index 8a3885b..c4f08b7 100644 --- a/src/MCP/MCPCompiledMethodScopeQuery.class.st +++ b/src/MCP/MCPCompiledMethodScopeQuery.class.st @@ -5,16 +5,9 @@ It handles packageNames, classNames, hierarchyClassNames, subclassClassNames, pa " Class { #name : 'MCPCompiledMethodScopeQuery', - #superclass : 'Object', + #superclass : 'MCPScopeQuery', #instVars : [ - 'packageNames', - 'classNames', - 'side', - 'hierarchyClassNames', - 'subclassClassNames', - 'parentClassNames', - 'warnings', - 'requiresCompleteScope' + 'side' ], #category : 'MCP-Queries', #package : 'MCP', @@ -140,20 +133,6 @@ MCPCompiledMethodScopeQuery >> classNamed: aClassName inScope: scopeName [ self recordMissingClassNamed: aClassName inScope: scopeName ] ] -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> classNames [ - - ^ classNames ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> classNames: someNames [ - - classNames := someNames - ifNil: [ #( ) ] - ifNotNil: [ someNames asArray ] -] - { #category : 'private - source' } MCPCompiledMethodScopeQuery >> hierarchyBehaviorsForClassNames [ @@ -170,20 +149,6 @@ MCPCompiledMethodScopeQuery >> hierarchyBehaviorsForClassNames [ ^ behaviors asArray ] -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> hierarchyClassNames [ - - ^ hierarchyClassNames ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> hierarchyClassNames: someNames [ - - hierarchyClassNames := someNames - ifNil: [ #( ) ] - ifNotNil: [ someNames asArray ] -] - { #category : 'private - scope' } MCPCompiledMethodScopeQuery >> includesClassSide [ @@ -351,20 +316,6 @@ MCPCompiledMethodScopeQuery >> packageNamed: aPackageName inScope: scopeName [ ^ PackageOrganizer default packageNamed: aPackageName ] -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> packageNames [ - - ^ packageNames ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> packageNames: someNames [ - - packageNames := someNames - ifNil: [ #( ) ] - ifNotNil: [ someNames asArray ] -] - { #category : 'private - scope' } MCPCompiledMethodScopeQuery >> parentBehaviorsForClassNames [ @@ -381,81 +332,6 @@ MCPCompiledMethodScopeQuery >> parentBehaviorsForClassNames [ ^ behaviors asArray ] -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> parentClassNames [ - - ^ parentClassNames ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> parentClassNames: someNames [ - - parentClassNames := someNames - ifNil: [ #( ) ] - ifNotNil: [ someNames asArray ] -] - -{ #category : 'private - resolution' } -MCPCompiledMethodScopeQuery >> recordMissingClassNamed: className inScope: scopeName [ - - | suggestions | - suggestions := MCPScopeNameSuggester classSuggestionsFor: className. - self requiresCompleteScope ifTrue: [ - ^ MCPCommandError - signalMissingClassNamed: className - scopeName: scopeName ]. - warnings ifNil: [ self resetWarnings ]. - warnings add: (MCPScopeNameSuggester - missingNameWarningForKind: 'Class' - name: className - scope: scopeName - suggestions: suggestions). - ^ nil -] - -{ #category : 'private - resolution' } -MCPCompiledMethodScopeQuery >> recordMissingPackageNamed: packageName inScope: scopeName [ - - | suggestions | - suggestions := MCPScopeNameSuggester packageSuggestionsFor: - packageName. - self requiresCompleteScope ifTrue: [ - ^ MCPCommandError - signalMissingPackageNamed: packageName - scopeName: scopeName ]. - warnings ifNil: [ self resetWarnings ]. - warnings add: (MCPScopeNameSuggester - missingNameWarningForKind: 'Package' - name: packageName - scope: scopeName - suggestions: suggestions). - ^ nil -] - -{ #category : 'configuring' } -MCPCompiledMethodScopeQuery >> requireCompleteScope [ - - self requiresCompleteScope: true -] - -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> requiresCompleteScope [ - - ^ requiresCompleteScope ifNil: [ false ] -] - -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> requiresCompleteScope: aBoolean [ - - requiresCompleteScope := aBoolean = true -] - -{ #category : 'private - resolution' } -MCPCompiledMethodScopeQuery >> resetWarnings [ - - warnings := OrderedCollection new -] - { #category : 'accessing' } MCPCompiledMethodScopeQuery >> side [ @@ -484,20 +360,6 @@ MCPCompiledMethodScopeQuery >> subclassBehaviorsForClassNames [ ^ behaviors asArray ] -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> subclassClassNames [ - - ^ subclassClassNames ifNil: [ #( ) ] -] - -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> subclassClassNames: someNames [ - - subclassClassNames := someNames - ifNil: [ #( ) ] - ifNotNil: [ someNames asArray ] -] - { #category : 'private - scope' } MCPCompiledMethodScopeQuery >> unionBehaviors [ @@ -516,25 +378,9 @@ MCPCompiledMethodScopeQuery >> unionMethods [ ^ methods asArray ] -{ #category : 'private - source' } -MCPCompiledMethodScopeQuery >> usesImplicitImageScope [ - - ^ self packageNames isEmpty and: [ - self classNames isEmpty and: [ - self hierarchyClassNames isEmpty and: [ - self subclassClassNames isEmpty and: [ - self parentClassNames isEmpty ] ] ] ] -] - { #category : 'validating' } MCPCompiledMethodScopeQuery >> validate [ (#( 'instance' 'class' 'both' ) includes: side) ifFalse: [ Error signal: 'side must be one of instance, class, or both.' ] ] - -{ #category : 'accessing' } -MCPCompiledMethodScopeQuery >> warnings [ - - ^ warnings ifNil: [ #( ) ] ifNotNil: [ warnings asArray ] -] diff --git a/src/MCP/MCPCreateClassCommand.class.st b/src/MCP/MCPCreateClassCommand.class.st index 3f03ae9..d23e7a0 100644 --- a/src/MCP/MCPCreateClassCommand.class.st +++ b/src/MCP/MCPCreateClassCommand.class.st @@ -7,7 +7,6 @@ Class { #name : 'MCPCreateClassCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'superclassName', 'packageName', 'tag', @@ -76,18 +75,6 @@ MCPCreateClassCommand >> buildClass [ ^ createdClass ] -{ #category : 'accessing' } -MCPCreateClassCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPCreateClassCommand >> className: aString [ - - className := aString -] - { #category : 'accessing' } MCPCreateClassCommand >> classSlots [ @@ -197,54 +184,6 @@ MCPCreateClassCommand >> resolvedClassTraits [ as: Array ] -{ #category : 'private' } -MCPCreateClassCommand >> resolvedLayoutClass [ - - | behavior | - self layout ifNil: [ ^ nil ]. - behavior := Smalltalk globals at: self layout asSymbol ifAbsent: [ - MCPCommandError - signalErrorCode: #LayoutClassNotFound - message: - 'Layout class ' , self layout , ' does not exist.' - details: { - (#className -> self className). - (#layout -> self layout) } asDictionary ]. - (AbstractLayout withAllSubclasses includes: behavior) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidLayoutClass - message: self layout , ' is not a layout class.' - details: { - (#className -> self className). - (#layout -> self layout) } asDictionary ]. - ^ behavior -] - -{ #category : 'private' } -MCPCreateClassCommand >> resolvedSharedPoolNamed: aSharedPoolName [ - - | behavior sharedPoolName | - sharedPoolName := aSharedPoolName. - behavior := Smalltalk globals - at: sharedPoolName asSymbol - ifAbsent: [ - MCPCommandError - signalErrorCode: #SharedPoolNotFound - message: - 'Shared pool ' , sharedPoolName , ' does not exist.' - details: { - (#className -> self className). - (#sharedPoolName -> sharedPoolName) } asDictionary ]. - (SharedPool withAllSubclasses includes: behavior) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidSharedPool - message: sharedPoolName , ' is not a shared pool.' - details: { - (#className -> self className). - (#sharedPoolName -> sharedPoolName) } asDictionary ]. - ^ behavior -] - { #category : 'private' } MCPCreateClassCommand >> resolvedSharedPools [ diff --git a/src/MCP/MCPDebugCommand.class.st b/src/MCP/MCPDebugCommand.class.st index c7a12ad..728426b 100644 --- a/src/MCP/MCPDebugCommand.class.st +++ b/src/MCP/MCPDebugCommand.class.st @@ -23,10 +23,12 @@ MCPDebugCommand class >> tool: aTool request: aRequest [ registry: MCPDebugSessionRegistry default ] -{ #category : 'executing' } -MCPDebugCommand >> execute [ +{ #category : 'private - frames' } +MCPDebugCommand >> frameRefForRecord: aRecord frameIndex: frameIndex [ - self subclassResponsibility + frameIndex ifNil: [ ^ nil ]. + ^ aRecord sessionId , '/' , aRecord stateId , '/frame-' + , frameIndex asString ] { #category : 'initialization' } @@ -72,6 +74,17 @@ MCPDebugCommand >> requestedStateId [ ^ request requestedStateId ] +{ #category : 'private - frames' } +MCPDebugCommand >> selectedContextForRecord: aRecord frameIndex: frameIndex [ + + | contexts stateInfo | + stateInfo := MCPDebugStateInfo fromRecord: aRecord request: request. + contexts := stateInfo rawContexts. + ^ contexts + at: frameIndex + 1 + ifAbsent: [ self signalMissingFrameIndex: frameIndex record: aRecord ] +] + { #category : 'private - frames' } MCPDebugCommand >> selectedFrameIndex [ @@ -140,6 +153,22 @@ MCPDebugCommand >> signalInvalidFrameReference: aFrameRef details: detailAssocia details: details ] +{ #category : 'private - errors' } +MCPDebugCommand >> signalMissingFrameIndex: frameIndex record: aRecord [ + + ^ MCPCommandError + signalErrorCode: #DebugFrameNotFound + message: + 'Debug frame ' , frameIndex asString + , ' was not found for session ' , aRecord sessionId , '.' + details: { + (#sessionId -> aRecord sessionId). + (#stateId -> aRecord stateId). + (#frameIndex -> frameIndex). + (#frameRef -> (self frameRefForRecord: aRecord frameIndex: frameIndex)) } + asDictionary +] + { #category : 'private - errors' } MCPDebugCommand >> signalMissingSession [ diff --git a/src/MCP/MCPDebugControlCommand.class.st b/src/MCP/MCPDebugControlCommand.class.st index 6596991..8ca5314 100644 --- a/src/MCP/MCPDebugControlCommand.class.st +++ b/src/MCP/MCPDebugControlCommand.class.st @@ -96,14 +96,6 @@ MCPDebugControlCommand >> execute [ warnings: (data at: #warnings) ] -{ #category : 'private - frames' } -MCPDebugControlCommand >> frameRefForRecord: aRecord frameIndex: frameIndex [ - - frameIndex ifNil: [ ^ nil ]. - ^ aRecord sessionId , '/' , aRecord stateId , '/frame-' - , frameIndex asString -] - { #category : 'private - actions' } MCPDebugControlCommand >> operationRequiresContext: operationName [ @@ -200,18 +192,6 @@ MCPDebugControlCommand >> resultDataForRecord: aRecord previousStateId: previous ^ data ] -{ #category : 'private - frames' } -MCPDebugControlCommand >> selectedContextForRecord: aRecord frameIndex: frameIndex [ - - | contexts stateInfo | - stateInfo := MCPDebugStateInfo fromRecord: aRecord request: request. - contexts := stateInfo rawContexts. - ^ contexts - at: frameIndex + 1 - ifAbsent: [ - self signalMissingFrameIndex: frameIndex record: aRecord ] -] - { #category : 'private - data' } MCPDebugControlCommand >> shouldReturnStateForRecord: aRecord operation: operationName [ @@ -231,23 +211,6 @@ MCPDebugControlCommand >> signalMissingDebugSessionForRecord: aRecord [ details: { (#sessionId -> aRecord sessionId) } asDictionary ] -{ #category : 'private - errors' } -MCPDebugControlCommand >> signalMissingFrameIndex: frameIndex record: aRecord [ - - ^ MCPCommandError - signalErrorCode: #DebugFrameNotFound - message: - 'Debug frame ' , frameIndex asString - , ' was not found for session ' , aRecord sessionId , '.' - details: { - (#sessionId -> aRecord sessionId). - (#stateId -> aRecord stateId). - (#frameIndex -> frameIndex). - (#frameRef - -> (self frameRefForRecord: aRecord frameIndex: frameIndex)) } - asDictionary -] - { #category : 'private - data' } MCPDebugControlCommand >> stateSnapshotForRecord: aRecord operation: operationName [ diff --git a/src/MCP/MCPDebugEvaluateCommand.class.st b/src/MCP/MCPDebugEvaluateCommand.class.st index c449a35..8d42de8 100644 --- a/src/MCP/MCPDebugEvaluateCommand.class.st +++ b/src/MCP/MCPDebugEvaluateCommand.class.st @@ -100,13 +100,6 @@ MCPDebugEvaluateCommand >> execute [ warnings: warnings ] -{ #category : 'private - frames' } -MCPDebugEvaluateCommand >> frameRefForRecord: aRecord frameIndex: frameIndex [ - - ^ aRecord sessionId , '/' , aRecord stateId , '/frame-' - , frameIndex asString -] - { #category : 'private - printing' } MCPDebugEvaluateCommand >> limitedPrintStringOf: anObject [ @@ -149,35 +142,6 @@ MCPDebugEvaluateCommand >> runtimeFailureFor: anError record: aRecord frameIndex details: details ] -{ #category : 'private - frames' } -MCPDebugEvaluateCommand >> selectedContextForRecord: aRecord frameIndex: frameIndex [ - - | contexts stateInfo | - stateInfo := MCPDebugStateInfo fromRecord: aRecord request: request. - contexts := stateInfo rawContexts. - ^ contexts - at: frameIndex + 1 - ifAbsent: [ - self signalMissingFrameIndex: frameIndex record: aRecord ] -] - -{ #category : 'private - errors' } -MCPDebugEvaluateCommand >> signalMissingFrameIndex: frameIndex record: aRecord [ - - ^ MCPCommandError - signalErrorCode: #DebugFrameNotFound - message: - 'Debug frame ' , frameIndex asString - , ' was not found for session ' , aRecord sessionId , '.' - details: { - (#sessionId -> aRecord sessionId). - (#stateId -> aRecord stateId). - (#frameIndex -> frameIndex). - (#frameRef - -> (self frameRefForRecord: aRecord frameIndex: frameIndex)) } - asDictionary -] - { #category : 'private - errors' } MCPDebugEvaluateCommand >> syntaxFailureFor: aNotice record: aRecord frameIndex: frameIndex [ diff --git a/src/MCP/MCPListChangeHistoryLogsCommand.class.st b/src/MCP/MCPListChangeHistoryLogsCommand.class.st index 2f26a86..ea05c46 100644 --- a/src/MCP/MCPListChangeHistoryLogsCommand.class.st +++ b/src/MCP/MCPListChangeHistoryLogsCommand.class.st @@ -78,15 +78,6 @@ MCPListChangeHistoryLogsCommand >> execute [ page: resultPage ] -{ #category : 'private' } -MCPListChangeHistoryLogsCommand >> historyDirectoryForCurrentFile: aFileReference [ - - aFileReference ifNotNil: [ ^ aFileReference parent ]. - ^ [ EpMonitor logsDirectory ] - on: Error - do: [ :error | FileLocator localDirectory asFileReference ] -] - { #category : 'private' } MCPListChangeHistoryLogsCommand >> historyFileReferencesFrom: aDirectory including: currentFile [ diff --git a/src/MCP/MCPMoveClassCommand.class.st b/src/MCP/MCPMoveClassCommand.class.st index b2cb5d4..7d10705 100644 --- a/src/MCP/MCPMoveClassCommand.class.st +++ b/src/MCP/MCPMoveClassCommand.class.st @@ -7,7 +7,6 @@ Class { #name : 'MCPMoveClassCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'packageName', 'tag' ], @@ -26,18 +25,6 @@ MCPMoveClassCommand class >> className: aClassName packageName: aPackageName tag yourself ] -{ #category : 'accessing' } -MCPMoveClassCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPMoveClassCommand >> className: aString [ - - className := aString -] - { #category : 'private' } MCPMoveClassCommand >> destinationValidation [ diff --git a/src/MCP/MCPMoveSlotCommand.class.st b/src/MCP/MCPMoveSlotCommand.class.st index fc8165b..c24caea 100644 --- a/src/MCP/MCPMoveSlotCommand.class.st +++ b/src/MCP/MCPMoveSlotCommand.class.st @@ -7,10 +7,7 @@ Class { #name : 'MCPMoveSlotCommand', #superclass : 'MCPClassSlotCommand', #instVars : [ - 'className', - 'slotName', - 'direction', - 'classSide' + 'direction' ], #category : 'MCP-Commands', #package : 'MCP', @@ -49,30 +46,6 @@ MCPMoveSlotCommand >> affectedClassNamesFor: aBehavior [ as: Array) sort: [ :left :right | left <= right ] ] -{ #category : 'accessing' } -MCPMoveSlotCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPMoveSlotCommand >> className: aClassName [ - - className := aClassName -] - -{ #category : 'accessing' } -MCPMoveSlotCommand >> classSide [ - - ^ classSide -] - -{ #category : 'accessing' } -MCPMoveSlotCommand >> classSide: aBoolean [ - - classSide := aBoolean -] - { #category : 'accessing' } MCPMoveSlotCommand >> direction [ @@ -130,15 +103,3 @@ MCPMoveSlotCommand >> refactoringForBehavior: aBehavior [ variable: self slotName class: aBehavior ] - -{ #category : 'accessing' } -MCPMoveSlotCommand >> slotName [ - - ^ slotName -] - -{ #category : 'accessing' } -MCPMoveSlotCommand >> slotName: aSlotName [ - - slotName := aSlotName -] diff --git a/src/MCP/MCPRemoveSlotCommand.class.st b/src/MCP/MCPRemoveSlotCommand.class.st index 76b0b3a..3641218 100644 --- a/src/MCP/MCPRemoveSlotCommand.class.st +++ b/src/MCP/MCPRemoveSlotCommand.class.st @@ -4,11 +4,6 @@ Removes a slot from a class or metaclass through the refactoring engine. Class { #name : 'MCPRemoveSlotCommand', #superclass : 'MCPClassSlotCommand', - #instVars : [ - 'className', - 'slotName', - 'classSide' - ], #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' @@ -24,30 +19,6 @@ MCPRemoveSlotCommand class >> className: aClassName slotName: aSlotName classSid yourself ] -{ #category : 'accessing' } -MCPRemoveSlotCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPRemoveSlotCommand >> className: aClassName [ - - className := aClassName -] - -{ #category : 'accessing' } -MCPRemoveSlotCommand >> classSide [ - - ^ classSide -] - -{ #category : 'accessing' } -MCPRemoveSlotCommand >> classSide: aBoolean [ - - classSide := aBoolean -] - { #category : 'private' } MCPRemoveSlotCommand >> directlyDefinesSlotNamed: aSlotName inBehavior: aBehavior [ @@ -111,15 +82,3 @@ MCPRemoveSlotCommand >> signalReferenceWarningIfNeededForBehavior: aBehavior [ RBBreakingChangeChecksFailedWarning signal: ' Variable ' , self slotName , ' is still referenced' ] ] - -{ #category : 'accessing' } -MCPRemoveSlotCommand >> slotName [ - - ^ slotName -] - -{ #category : 'accessing' } -MCPRemoveSlotCommand >> slotName: aSlotName [ - - slotName := aSlotName -] diff --git a/src/MCP/MCPRenameClassCommand.class.st b/src/MCP/MCPRenameClassCommand.class.st index 9f0decc..68281ed 100644 --- a/src/MCP/MCPRenameClassCommand.class.st +++ b/src/MCP/MCPRenameClassCommand.class.st @@ -7,7 +7,6 @@ Class { #name : 'MCPRenameClassCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'newClassName', 'model' ], @@ -35,18 +34,6 @@ MCPRenameClassCommand class >> className: aClassName newClassName: aNewClassName yourself ] -{ #category : 'accessing' } -MCPRenameClassCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPRenameClassCommand >> className: aString [ - - className := aString -] - { #category : 'executing' } MCPRenameClassCommand >> execute [ diff --git a/src/MCP/MCPRenameSlotCommand.class.st b/src/MCP/MCPRenameSlotCommand.class.st index 1fb9694..834bc3a 100644 --- a/src/MCP/MCPRenameSlotCommand.class.st +++ b/src/MCP/MCPRenameSlotCommand.class.st @@ -5,10 +5,7 @@ Class { #name : 'MCPRenameSlotCommand', #superclass : 'MCPClassSlotCommand', #instVars : [ - 'className', - 'slotName', - 'newSlotName', - 'classSide' + 'newSlotName' ], #category : 'MCP-Commands', #package : 'MCP', @@ -26,30 +23,6 @@ MCPRenameSlotCommand class >> className: aClassName slotName: aSlotName newSlotN yourself ] -{ #category : 'accessing' } -MCPRenameSlotCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPRenameSlotCommand >> className: aClassName [ - - className := aClassName -] - -{ #category : 'accessing' } -MCPRenameSlotCommand >> classSide [ - - ^ classSide -] - -{ #category : 'accessing' } -MCPRenameSlotCommand >> classSide: aBoolean [ - - classSide := aBoolean -] - { #category : 'private' } MCPRenameSlotCommand >> classSideAccessorMessageRewriter [ @@ -343,18 +316,6 @@ MCPRenameSlotCommand >> setterSourceForNewSlot [ , self newSlotName , ' := anObject' ] -{ #category : 'accessing' } -MCPRenameSlotCommand >> slotName [ - - ^ slotName -] - -{ #category : 'accessing' } -MCPRenameSlotCommand >> slotName: aSlotName [ - - slotName := aSlotName -] - { #category : 'private' } MCPRenameSlotCommand >> slotNamed: aSlotName isDefinedIn: aBehavior [ diff --git a/src/MCP/MCPReparentClassCommand.class.st b/src/MCP/MCPReparentClassCommand.class.st index 6c9b5f1..98c5865 100644 --- a/src/MCP/MCPReparentClassCommand.class.st +++ b/src/MCP/MCPReparentClassCommand.class.st @@ -7,7 +7,6 @@ Class { #name : 'MCPReparentClassCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'superclassName' ], #category : 'MCP-Commands', @@ -36,18 +35,6 @@ MCPReparentClassCommand >> builderForReparenting: aClass toSuperclass: aSupercla ^ builder ] -{ #category : 'accessing' } -MCPReparentClassCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPReparentClassCommand >> className: aString [ - - className := aString -] - { #category : 'executing' } MCPReparentClassCommand >> execute [ diff --git a/src/MCP/MCPReplaceClassDefinitionCommand.class.st b/src/MCP/MCPReplaceClassDefinitionCommand.class.st index 7b38fd1..8eb4e48 100644 --- a/src/MCP/MCPReplaceClassDefinitionCommand.class.st +++ b/src/MCP/MCPReplaceClassDefinitionCommand.class.st @@ -5,7 +5,6 @@ Class { #name : 'MCPReplaceClassDefinitionCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'slotNames', 'classSlotNames', 'replaceSlots', @@ -16,18 +15,6 @@ Class { #tag : 'Commands' } -{ #category : 'accessing' } -MCPReplaceClassDefinitionCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPReplaceClassDefinitionCommand >> className: aClassName [ - - className := aClassName -] - { #category : 'accessing' } MCPReplaceClassDefinitionCommand >> classSlotNames [ diff --git a/src/MCP/MCPReplaceClassLayoutCommand.class.st b/src/MCP/MCPReplaceClassLayoutCommand.class.st index dce7420..4787865 100644 --- a/src/MCP/MCPReplaceClassLayoutCommand.class.st +++ b/src/MCP/MCPReplaceClassLayoutCommand.class.st @@ -5,7 +5,6 @@ Class { #name : 'MCPReplaceClassLayoutCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'layout' ], #category : 'MCP-Commands', @@ -22,18 +21,6 @@ MCPReplaceClassLayoutCommand class >> className: aClassName layout: aLayoutName yourself ] -{ #category : 'accessing' } -MCPReplaceClassLayoutCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPReplaceClassLayoutCommand >> className: aString [ - - className := aString -] - { #category : 'executing' } MCPReplaceClassLayoutCommand >> execute [ @@ -73,29 +60,6 @@ MCPReplaceClassLayoutCommand >> replaceLayoutOn: aClass [ to: [ :builder | builder layout: self resolvedLayoutClass ] ] -{ #category : 'private' } -MCPReplaceClassLayoutCommand >> resolvedLayoutClass [ - - | behavior | - self layout ifNil: [ ^ nil ]. - behavior := Smalltalk globals at: self layout asSymbol ifAbsent: [ - MCPCommandError - signalErrorCode: #LayoutClassNotFound - message: - 'Layout class ' , self layout , ' does not exist.' - details: { - (#className -> self className). - (#layout -> self layout) } asDictionary ]. - (AbstractLayout withAllSubclasses includes: behavior) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidLayoutClass - message: self layout , ' is not a layout class.' - details: { - (#className -> self className). - (#layout -> self layout) } asDictionary ]. - ^ behavior -] - { #category : 'private' } MCPReplaceClassLayoutCommand >> targetClass [ diff --git a/src/MCP/MCPReplaceClassSharedPoolsCommand.class.st b/src/MCP/MCPReplaceClassSharedPoolsCommand.class.st index 3bf1416..c2bc7d2 100644 --- a/src/MCP/MCPReplaceClassSharedPoolsCommand.class.st +++ b/src/MCP/MCPReplaceClassSharedPoolsCommand.class.st @@ -5,7 +5,6 @@ Class { #name : 'MCPReplaceClassSharedPoolsCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'sharedPoolNames' ], #category : 'MCP-Commands', @@ -22,18 +21,6 @@ MCPReplaceClassSharedPoolsCommand class >> className: aClassName sharedPoolNames yourself ] -{ #category : 'accessing' } -MCPReplaceClassSharedPoolsCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPReplaceClassSharedPoolsCommand >> className: aString [ - - className := aString -] - { #category : 'executing' } MCPReplaceClassSharedPoolsCommand >> execute [ @@ -55,31 +42,6 @@ MCPReplaceClassSharedPoolsCommand >> replaceSharedPoolsOn: aClass [ to: [ :builder | builder sharedPools: self resolvedSharedPools ] ] -{ #category : 'private' } -MCPReplaceClassSharedPoolsCommand >> resolvedSharedPoolNamed: aSharedPoolName [ - - | behavior sharedPoolName | - sharedPoolName := aSharedPoolName. - behavior := Smalltalk globals - at: sharedPoolName asSymbol - ifAbsent: [ - MCPCommandError - signalErrorCode: #SharedPoolNotFound - message: - 'Shared pool ' , sharedPoolName , ' does not exist.' - details: { - (#className -> self className). - (#sharedPoolName -> sharedPoolName) } asDictionary ]. - (SharedPool withAllSubclasses includes: behavior) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidSharedPool - message: sharedPoolName , ' is not a shared pool.' - details: { - (#className -> self className). - (#sharedPoolName -> sharedPoolName) } asDictionary ]. - ^ behavior -] - { #category : 'private' } MCPReplaceClassSharedPoolsCommand >> resolvedSharedPools [ diff --git a/src/MCP/MCPReplaceClassSharedVariablesCommand.class.st b/src/MCP/MCPReplaceClassSharedVariablesCommand.class.st index 0d2746c..6a10141 100644 --- a/src/MCP/MCPReplaceClassSharedVariablesCommand.class.st +++ b/src/MCP/MCPReplaceClassSharedVariablesCommand.class.st @@ -5,7 +5,6 @@ Class { #name : 'MCPReplaceClassSharedVariablesCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'sharedVariableNames' ], #category : 'MCP-Commands', @@ -22,18 +21,6 @@ MCPReplaceClassSharedVariablesCommand class >> className: aClassName sharedVaria yourself ] -{ #category : 'accessing' } -MCPReplaceClassSharedVariablesCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPReplaceClassSharedVariablesCommand >> className: aString [ - - className := aString -] - { #category : 'executing' } MCPReplaceClassSharedVariablesCommand >> execute [ diff --git a/src/MCP/MCPReplaceClassSideTraitsCommand.class.st b/src/MCP/MCPReplaceClassSideTraitsCommand.class.st index 8e0e7a5..0ad4476 100644 --- a/src/MCP/MCPReplaceClassSideTraitsCommand.class.st +++ b/src/MCP/MCPReplaceClassSideTraitsCommand.class.st @@ -5,7 +5,6 @@ Class { #name : 'MCPReplaceClassSideTraitsCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'classTraitNames' ], #category : 'MCP-Commands', @@ -22,18 +21,6 @@ MCPReplaceClassSideTraitsCommand class >> className: aClassName classTraitNames: yourself ] -{ #category : 'accessing' } -MCPReplaceClassSideTraitsCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPReplaceClassSideTraitsCommand >> className: aString [ - - className := aString -] - { #category : 'accessing' } MCPReplaceClassSideTraitsCommand >> classTraitNames [ diff --git a/src/MCP/MCPReplaceClassTraitsCommand.class.st b/src/MCP/MCPReplaceClassTraitsCommand.class.st index 9a1e9a9..eee01ec 100644 --- a/src/MCP/MCPReplaceClassTraitsCommand.class.st +++ b/src/MCP/MCPReplaceClassTraitsCommand.class.st @@ -5,7 +5,6 @@ Class { #name : 'MCPReplaceClassTraitsCommand', #superclass : 'MCPClassCommand', #instVars : [ - 'className', 'traitNames' ], #category : 'MCP-Commands', @@ -22,18 +21,6 @@ MCPReplaceClassTraitsCommand class >> className: aClassName traitNames: someTrai yourself ] -{ #category : 'accessing' } -MCPReplaceClassTraitsCommand >> className [ - - ^ className -] - -{ #category : 'accessing' } -MCPReplaceClassTraitsCommand >> className: aString [ - - className := aString -] - { #category : 'executing' } MCPReplaceClassTraitsCommand >> execute [ diff --git a/src/MCP/MCPRepositoryFetchResult.class.st b/src/MCP/MCPRepositoryFetchResult.class.st index 399e970..0ba360e 100644 --- a/src/MCP/MCPRepositoryFetchResult.class.st +++ b/src/MCP/MCPRepositoryFetchResult.class.st @@ -23,12 +23,7 @@ MCPRepositoryFetchResult class >> repositoryBefore: beforeInfo after: aRepositor { #category : 'converting' } MCPRepositoryFetchResult >> asDictionary [ - | data | - data := Dictionary new. - self branchName ifNotEmpty: [ :name | data at: #branchName put: name ]. - self headDescription ifNotEmpty: [ :description | - data at: #headDescription put: description ]. - ^ data + ^ self branchHeadDictionary ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryPushResult.class.st b/src/MCP/MCPRepositoryPushResult.class.st index 00ea224..7e4c934 100644 --- a/src/MCP/MCPRepositoryPushResult.class.st +++ b/src/MCP/MCPRepositoryPushResult.class.st @@ -23,12 +23,7 @@ MCPRepositoryPushResult class >> repository: aRepository [ { #category : 'converting' } MCPRepositoryPushResult >> asDictionary [ - | data | - data := Dictionary new. - self branchName ifNotEmpty: [ :name | data at: #branchName put: name ]. - self headDescription ifNotEmpty: [ :description | - data at: #headDescription put: description ]. - ^ data + ^ self branchHeadDictionary ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryResult.class.st b/src/MCP/MCPRepositoryResult.class.st index d1829e6..10f5f72 100644 --- a/src/MCP/MCPRepositoryResult.class.st +++ b/src/MCP/MCPRepositoryResult.class.st @@ -15,6 +15,30 @@ MCPRepositoryResult class >> isAbstract [ ^ self = MCPRepositoryResult ] +{ #category : 'converting' } +MCPRepositoryResult >> branchHeadDictionary [ + + | data | + data := Dictionary new. + self branchName ifNotEmpty: [ :name | + data at: #branchName put: name ]. + self headDescription ifNotEmpty: [ :description | + data at: #headDescription put: description ]. + ^ data +] + +{ #category : 'accessing' } +MCPRepositoryResult >> branchName [ + + ^ '' +] + +{ #category : 'accessing' } +MCPRepositoryResult >> headDescription [ + + ^ '' +] + { #category : 'private' } MCPRepositoryResult >> packageInfosFromRepository: aRepository [ diff --git a/src/MCP/MCPScopeQuery.class.st b/src/MCP/MCPScopeQuery.class.st new file mode 100644 index 0000000..3777724 --- /dev/null +++ b/src/MCP/MCPScopeQuery.class.st @@ -0,0 +1,157 @@ +" +Abstract query over named class/package scopes. + +Subclasses add the concrete entity lookup, but common scope names, completeness handling, and missing-name warnings live here. +" +Class { + #name : 'MCPScopeQuery', + #superclass : 'Object', + #instVars : [ + 'packageNames', + 'classNames', + 'hierarchyClassNames', + 'subclassClassNames', + 'parentClassNames', + 'warnings', + 'requiresCompleteScope' + ], + #category : 'MCP-Queries', + #package : 'MCP', + #tag : 'Queries' +} + +{ #category : 'accessing' } +MCPScopeQuery >> classNames [ + + ^ classNames ifNil: [ #( ) ] +] + +{ #category : 'accessing' } +MCPScopeQuery >> classNames: aCollection [ + + classNames := aCollection +] + +{ #category : 'accessing' } +MCPScopeQuery >> hierarchyClassNames [ + + ^ hierarchyClassNames ifNil: [ #( ) ] +] + +{ #category : 'accessing' } +MCPScopeQuery >> hierarchyClassNames: aCollection [ + + hierarchyClassNames := aCollection +] + +{ #category : 'accessing' } +MCPScopeQuery >> packageNames [ + + ^ packageNames ifNil: [ #( ) ] +] + +{ #category : 'accessing' } +MCPScopeQuery >> packageNames: aCollection [ + + packageNames := aCollection +] + +{ #category : 'accessing' } +MCPScopeQuery >> parentClassNames [ + + ^ parentClassNames ifNil: [ #( ) ] +] + +{ #category : 'accessing' } +MCPScopeQuery >> parentClassNames: aCollection [ + + parentClassNames := aCollection +] + +{ #category : 'private - resolution' } +MCPScopeQuery >> recordMissingClassNamed: className inScope: scopeName [ + + | suggestions | + suggestions := MCPScopeNameSuggester classSuggestionsFor: className. + self requiresCompleteScope ifTrue: [ + ^ MCPCommandError + signalMissingClassNamed: className + scopeName: scopeName ]. + warnings ifNil: [ self resetWarnings ]. + warnings add: (MCPScopeNameSuggester + missingNameWarningForKind: 'Class' + name: className + scope: scopeName + suggestions: suggestions). + ^ nil +] + +{ #category : 'private - resolution' } +MCPScopeQuery >> recordMissingPackageNamed: packageName inScope: scopeName [ + + | suggestions | + suggestions := MCPScopeNameSuggester packageSuggestionsFor: packageName. + self requiresCompleteScope ifTrue: [ + ^ MCPCommandError + signalMissingPackageNamed: packageName + scopeName: scopeName ]. + warnings ifNil: [ self resetWarnings ]. + warnings add: (MCPScopeNameSuggester + missingNameWarningForKind: 'Package' + name: packageName + scope: scopeName + suggestions: suggestions). + ^ nil +] + +{ #category : 'configuring' } +MCPScopeQuery >> requireCompleteScope [ + + self requiresCompleteScope: true +] + +{ #category : 'accessing' } +MCPScopeQuery >> requiresCompleteScope [ + + ^ requiresCompleteScope ifNil: [ false ] +] + +{ #category : 'accessing' } +MCPScopeQuery >> requiresCompleteScope: aBoolean [ + + requiresCompleteScope := aBoolean +] + +{ #category : 'private - resolution' } +MCPScopeQuery >> resetWarnings [ + + warnings := OrderedCollection new +] + +{ #category : 'accessing' } +MCPScopeQuery >> subclassClassNames [ + + ^ subclassClassNames ifNil: [ #( ) ] +] + +{ #category : 'accessing' } +MCPScopeQuery >> subclassClassNames: aCollection [ + + subclassClassNames := aCollection +] + +{ #category : 'private - source' } +MCPScopeQuery >> usesImplicitImageScope [ + + ^ self packageNames isEmpty and: [ + self classNames isEmpty and: [ + self hierarchyClassNames isEmpty and: [ + self subclassClassNames isEmpty and: [ + self parentClassNames isEmpty ] ] ] ] +] + +{ #category : 'accessing' } +MCPScopeQuery >> warnings [ + + ^ warnings ifNil: [ #( ) ] +] diff --git a/src/MCP/MCPUpdateDebugMethodCommand.class.st b/src/MCP/MCPUpdateDebugMethodCommand.class.st index 47d1d90..21ffaa9 100644 --- a/src/MCP/MCPUpdateDebugMethodCommand.class.st +++ b/src/MCP/MCPUpdateDebugMethodCommand.class.st @@ -219,13 +219,6 @@ MCPUpdateDebugMethodCommand >> frameIndexForContext: aContext record: aRecord fa ^ (rawContexts indexOf: aContext ifAbsent: [ fallbackIndex + 1 ]) - 1 ] -{ #category : 'private - frames' } -MCPUpdateDebugMethodCommand >> frameRefForRecord: aRecord frameIndex: frameIndex [ - - ^ aRecord sessionId , '/' , aRecord stateId , '/frame-' - , frameIndex asString -] - { #category : 'private - data' } MCPUpdateDebugMethodCommand >> methodDataFor: aCompiledMethod [ @@ -437,18 +430,6 @@ MCPUpdateDebugMethodCommand >> resultDataUsing: details critiques: critiques pro ^ data ] -{ #category : 'private - frames' } -MCPUpdateDebugMethodCommand >> selectedContextForRecord: aRecord frameIndex: frameIndex [ - - | contexts stateInfo | - stateInfo := MCPDebugStateInfo fromRecord: aRecord request: request. - contexts := stateInfo rawContexts. - ^ contexts - at: frameIndex + 1 - ifAbsent: [ - self signalMissingFrameIndex: frameIndex record: aRecord ] -] - { #category : 'private - critiques' } MCPUpdateDebugMethodCommand >> shouldBlockProceedForCritiques: critiqueData [ @@ -456,23 +437,6 @@ MCPUpdateDebugMethodCommand >> shouldBlockProceedForCritiques: critiqueData [ ^ request ignoreCritiques not ] -{ #category : 'private - errors' } -MCPUpdateDebugMethodCommand >> signalMissingFrameIndex: frameIndex record: aRecord [ - - ^ MCPCommandError - signalErrorCode: #DebugFrameNotFound - message: - 'Debug frame ' , frameIndex asString - , ' was not found for session ' , aRecord sessionId , '.' - details: { - (#sessionId -> aRecord sessionId). - (#stateId -> aRecord stateId). - (#frameIndex -> frameIndex). - (#frameRef - -> (self frameRefForRecord: aRecord frameIndex: frameIndex)) } - asDictionary -] - { #category : 'private - errors' } MCPUpdateDebugMethodCommand >> signalRecompileFailedForRecord: aRecord frameIndex: frameIndex updateKind: updateKind [ From 55166a579238b199026434885f46168e55b0f307 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Thu, 25 Jun 2026 15:45:53 +0200 Subject: [PATCH 15/21] Deepen repository request reuse Co-authored-by: Codex --- src/MCP-Tests/MCPToolContractsTest.class.st | 41 ++++++++----------- src/MCP/MCPGetToolCommand.class.st | 27 +----------- .../MCPRepositoryAdoptHeadRequest.class.st | 27 +----------- src/MCP/MCPRepositoryBranchRequest.class.st | 41 +++++++++++++++++++ ...CPRepositoryCheckoutBranchRequest.class.st | 35 +--------------- src/MCP/MCPRepositoryCommitRequest.class.st | 15 ++----- .../MCPRepositoryCreateBranchRequest.class.st | 36 +--------------- src/MCP/MCPRepositoryDiffRequest.class.st | 25 +---------- src/MCP/MCPRepositoryExportRequest.class.st | 25 +---------- src/MCP/MCPRepositoryFetchRequest.class.st | 25 +---------- src/MCP/MCPRepositoryPullRequest.class.st | 25 +---------- src/MCP/MCPRepositoryPushRequest.class.st | 25 +---------- src/MCP/MCPRepositoryRequest.class.st | 37 +++++++++++++++++ .../MCPRepositorySwitchBranchRequest.class.st | 36 +--------------- src/MCP/MCPRepositoryUpdateRequest.class.st | 21 +++------- ...CPRepositoryVerifyIdentityRequest.class.st | 32 ++++----------- src/MCP/MCPSearchToolsCommand.class.st | 27 +----------- src/MCP/MCPTool.class.st | 5 +-- src/MCP/MCPToolCatalogCommand.class.st | 41 +++++++++++++++++++ src/MCP/MCPToolClassMutation.class.st | 17 +------- src/MCP/MCPToolDebug.class.st | 33 +++++++++++++++ .../MCPToolDebugBreakpointOperation.class.st | 11 ----- ...PToolDebugSessionControlOperation.class.st | 10 ----- src/MCP/MCPToolDebugSessionOperation.class.st | 21 ---------- src/MCP/MCPToolMethodMutation.class.st | 21 ---------- src/MCP/MCPToolMethodSearch.class.st | 34 --------------- src/MCP/MCPToolMutation.class.st | 33 +++++++++++++++ src/MCP/MCPToolRepositoryOperation.class.st | 21 ---------- src/MCP/MCPToolSearch.class.st | 9 ++++ src/MCP/MCPToolSearchClasses.class.st | 10 ----- 30 files changed, 238 insertions(+), 528 deletions(-) create mode 100644 src/MCP/MCPRepositoryBranchRequest.class.st create mode 100644 src/MCP/MCPRepositoryRequest.class.st create mode 100644 src/MCP/MCPToolCatalogCommand.class.st diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index f79348a..868c6a1 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -1810,33 +1810,24 @@ MCPToolContractsTest >> testMethodToolTraitOwnsSharedMethodHelpers [ | methodToolClasses sharedSelectors | methodToolClasses := { - MCPToolGetMethod. - MCPToolMethodMutation. - MCPToolRewriteMethods. - MCPToolRemoveMethods }. + MCPToolGetMethod. + MCPToolMethodMutation. + MCPToolMethodSearch. + MCPToolRewriteMethods. + MCPToolRemoveMethods }. sharedSelectors := #( selectorStringFromRequest: - behaviorNamed:classSide: - methodReferenceForBehavior:selector: - methodReferenceForClassName:selector:isClassSide: - methodScopeQueryFromRequest: ). - self assert: - (MCPToolMethodSearch withAllSuperclasses anySatisfy: [ :each | - each traits includes: TMCPMethodTool ]). - self - assert: - (MCPToolMethodSearch >> #methodScopeQueryFromRequest:) origin - equals: MCPToolMethodSearch. + behaviorNamed:classSide: + methodReferenceForBehavior:selector: + methodReferenceForClassName:selector:isClassSide: + methodScopeQueryFromRequest: ). methodToolClasses do: [ :toolClass | - self assert: (toolClass withAllSuperclasses anySatisfy: [ :each | - each traits includes: TMCPMethodTool ]). - sharedSelectors do: [ :selector | - | implementingClass | - implementingClass := toolClass whichClassIncludesSelector: - selector. - self assert: implementingClass notNil. - self - assert: (implementingClass >> selector) origin - equals: TMCPMethodTool ] ] + self assert: (toolClass withAllSuperclasses anySatisfy: [ :each | + each traits includes: TMCPMethodTool ]). + sharedSelectors do: [ :selector | + | implementingClass | + implementingClass := toolClass whichClassIncludesSelector: selector. + self assert: implementingClass notNil. + self assert: (implementingClass >> selector) origin equals: TMCPMethodTool ] ] ] { #category : 'tests' } diff --git a/src/MCP/MCPGetToolCommand.class.st b/src/MCP/MCPGetToolCommand.class.st index b7bc3e6..d71951c 100644 --- a/src/MCP/MCPGetToolCommand.class.st +++ b/src/MCP/MCPGetToolCommand.class.st @@ -5,10 +5,7 @@ This command is the second step of the discoverable-tool flow: after discovery g " Class { #name : 'MCPGetToolCommand', - #superclass : 'MCPToolRequestCommand', - #instVars : [ - 'toolExposurePolicy' - ], + #superclass : 'MCPToolCatalogCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' @@ -23,15 +20,6 @@ MCPGetToolCommand class >> tool: aTool request: aRequest [ toolExposurePolicy: MCPToolExposurePolicy default ] -{ #category : 'instance creation' } -MCPGetToolCommand class >> tool: aTool request: aRequest toolExposurePolicy: aToolExposurePolicy [ - - ^ self new - initializeTool: aTool request: aRequest; - toolExposurePolicy: aToolExposurePolicy; - yourself -] - { #category : 'executing' } MCPGetToolCommand >> execute [ @@ -47,16 +35,3 @@ MCPGetToolCommand >> execute [ includeOutputSchema: request includeOutputSchema)) } asDictionary ] - -{ #category : 'accessing' } -MCPGetToolCommand >> toolExposurePolicy [ - - ^ toolExposurePolicy ifNil: [ MCPToolExposurePolicy default ] -] - -{ #category : 'accessing' } -MCPGetToolCommand >> toolExposurePolicy: aToolExposurePolicy [ - - toolExposurePolicy := aToolExposurePolicy ifNil: [ - MCPToolExposurePolicy default ] -] diff --git a/src/MCP/MCPRepositoryAdoptHeadRequest.class.st b/src/MCP/MCPRepositoryAdoptHeadRequest.class.st index 350ed59..de03f88 100644 --- a/src/MCP/MCPRepositoryAdoptHeadRequest.class.st +++ b/src/MCP/MCPRepositoryAdoptHeadRequest.class.st @@ -3,11 +3,7 @@ Parsed input for repository_head_adopt. It resolves the registered Iceberg repos " Class { #name : 'MCPRepositoryAdoptHeadRequest', - #superclass : 'Object', - #instVars : [ - 'repositoryReference', - 'branchName' - ], + #superclass : 'MCPRepositoryBranchRequest', #category : 'MCP-Requests', #package : 'MCP', #tag : 'Requests' @@ -19,27 +15,12 @@ MCPRepositoryAdoptHeadRequest class >> fromRequest: request tool: aTool [ ^ self new initializeFromRequest: request ] -{ #category : 'accessing' } -MCPRepositoryAdoptHeadRequest >> branchName [ - - ^ branchName ifNil: [ '' ] -] - { #category : 'converting' } MCPRepositoryAdoptHeadRequest >> commandForTool: aTool [ ^ MCPAdoptRepositoryHeadCommand tool: aTool request: self ] -{ #category : 'initialization' } -MCPRepositoryAdoptHeadRequest >> initializeFromRequest: request [ - - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - branchName := request stringArgumentNamed: 'branchName'. - ^ self -] - { #category : 'accessing' } MCPRepositoryAdoptHeadRequest >> operation [ @@ -52,12 +33,6 @@ MCPRepositoryAdoptHeadRequest >> repository [ ^ self repositoryReference repository ] -{ #category : 'accessing' } -MCPRepositoryAdoptHeadRequest >> repositoryReference [ - - ^ repositoryReference -] - { #category : 'converting' } MCPRepositoryAdoptHeadRequest >> requestedContext [ diff --git a/src/MCP/MCPRepositoryBranchRequest.class.st b/src/MCP/MCPRepositoryBranchRequest.class.st new file mode 100644 index 0000000..e8e9d66 --- /dev/null +++ b/src/MCP/MCPRepositoryBranchRequest.class.st @@ -0,0 +1,41 @@ +" +Abstract request DTO for repository operations that target an existing repository and branch. +" +Class { + #name : 'MCPRepositoryBranchRequest', + #superclass : 'MCPRepositoryRequest', + #instVars : [ + 'branchName' + ], + #category : 'MCP-Requests', + #package : 'MCP', + #tag : 'Requests' +} + +{ #category : 'testing' } +MCPRepositoryBranchRequest class >> isAbstract [ + + ^ self == MCPRepositoryBranchRequest +] + +{ #category : 'accessing' } +MCPRepositoryBranchRequest >> branchName [ + + ^ branchName ifNil: [ '' ] +] + +{ #category : 'initialization' } +MCPRepositoryBranchRequest >> initializeFromRequest: request [ + + super initializeFromRequest: request. + branchName := request stringArgumentNamed: 'branchName' +] + +{ #category : 'converting' } +MCPRepositoryBranchRequest >> requestedContext [ + + | context | + context := self repositoryReference requestedContext copy. + context at: #branchName put: self branchName. + ^ context +] diff --git a/src/MCP/MCPRepositoryCheckoutBranchRequest.class.st b/src/MCP/MCPRepositoryCheckoutBranchRequest.class.st index 2ca8598..a2d9f9b 100644 --- a/src/MCP/MCPRepositoryCheckoutBranchRequest.class.st +++ b/src/MCP/MCPRepositoryCheckoutBranchRequest.class.st @@ -3,11 +3,7 @@ Parsed input for repository_branch_checkout. It resolves the registered Iceberg " Class { #name : 'MCPRepositoryCheckoutBranchRequest', - #superclass : 'Object', - #instVars : [ - 'repositoryReference', - 'branchName' - ], + #superclass : 'MCPRepositoryBranchRequest', #category : 'MCP-Requests', #package : 'MCP', #tag : 'Requests' @@ -19,26 +15,12 @@ MCPRepositoryCheckoutBranchRequest class >> fromRequest: request tool: aTool [ ^ self new initializeFromRequest: request ] -{ #category : 'accessing' } -MCPRepositoryCheckoutBranchRequest >> branchName [ - - ^ branchName -] - { #category : 'converting' } MCPRepositoryCheckoutBranchRequest >> commandForTool: aTool [ ^ MCPCheckoutRepositoryBranchCommand tool: aTool request: self ] -{ #category : 'initialization' } -MCPRepositoryCheckoutBranchRequest >> initializeFromRequest: request [ - - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - branchName := request stringArgumentNamed: 'branchName' -] - { #category : 'accessing' } MCPRepositoryCheckoutBranchRequest >> operation [ @@ -50,18 +32,3 @@ MCPRepositoryCheckoutBranchRequest >> repository [ ^ self repositoryReference repository ] - -{ #category : 'accessing' } -MCPRepositoryCheckoutBranchRequest >> repositoryReference [ - - ^ repositoryReference -] - -{ #category : 'converting' } -MCPRepositoryCheckoutBranchRequest >> requestedContext [ - - | context | - context := self repositoryReference requestedContext copy. - context at: #branchName put: self branchName. - ^ context -] diff --git a/src/MCP/MCPRepositoryCommitRequest.class.st b/src/MCP/MCPRepositoryCommitRequest.class.st index 7d523e3..9c4bd3b 100644 --- a/src/MCP/MCPRepositoryCommitRequest.class.st +++ b/src/MCP/MCPRepositoryCommitRequest.class.st @@ -3,9 +3,8 @@ Parsed input for repository_commit. It resolves the registered Iceberg repositor " Class { #name : 'MCPRepositoryCommitRequest', - #superclass : 'Object', + #superclass : 'MCPRepositoryRequest', #instVars : [ - 'repositoryReference', 'message' ], #category : 'MCP-Requests', @@ -28,10 +27,8 @@ MCPRepositoryCommitRequest >> commandForTool: aTool [ { #category : 'initialization' } MCPRepositoryCommitRequest >> initializeFromRequest: request [ - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - message := request stringArgumentNamed: 'message'. - ^ self + super initializeFromRequest: request. + message := request stringArgumentNamed: 'message' ] { #category : 'accessing' } @@ -52,12 +49,6 @@ MCPRepositoryCommitRequest >> repository [ ^ self repositoryReference repository ] -{ #category : 'accessing' } -MCPRepositoryCommitRequest >> repositoryReference [ - - ^ repositoryReference -] - { #category : 'converting' } MCPRepositoryCommitRequest >> requestedContext [ diff --git a/src/MCP/MCPRepositoryCreateBranchRequest.class.st b/src/MCP/MCPRepositoryCreateBranchRequest.class.st index 29632f8..328520d 100644 --- a/src/MCP/MCPRepositoryCreateBranchRequest.class.st +++ b/src/MCP/MCPRepositoryCreateBranchRequest.class.st @@ -3,11 +3,7 @@ Parsed input for repository_branch_create. It resolves the registered Iceberg re " Class { #name : 'MCPRepositoryCreateBranchRequest', - #superclass : 'Object', - #instVars : [ - 'repositoryReference', - 'branchName' - ], + #superclass : 'MCPRepositoryBranchRequest', #category : 'MCP-Requests', #package : 'MCP', #tag : 'Requests' @@ -19,27 +15,12 @@ MCPRepositoryCreateBranchRequest class >> fromRequest: request tool: aTool [ ^ self new initializeFromRequest: request ] -{ #category : 'accessing' } -MCPRepositoryCreateBranchRequest >> branchName [ - - ^ branchName ifNil: [ '' ] -] - { #category : 'converting' } MCPRepositoryCreateBranchRequest >> commandForTool: aTool [ ^ MCPCreateRepositoryBranchCommand tool: aTool request: self ] -{ #category : 'initialization' } -MCPRepositoryCreateBranchRequest >> initializeFromRequest: request [ - - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - branchName := request stringArgumentNamed: 'branchName'. - ^ self -] - { #category : 'accessing' } MCPRepositoryCreateBranchRequest >> operation [ @@ -51,18 +32,3 @@ MCPRepositoryCreateBranchRequest >> repository [ ^ self repositoryReference repository ] - -{ #category : 'accessing' } -MCPRepositoryCreateBranchRequest >> repositoryReference [ - - ^ repositoryReference -] - -{ #category : 'converting' } -MCPRepositoryCreateBranchRequest >> requestedContext [ - - | context | - context := self repositoryReference requestedContext copy. - context at: #branchName put: self branchName. - ^ context -] diff --git a/src/MCP/MCPRepositoryDiffRequest.class.st b/src/MCP/MCPRepositoryDiffRequest.class.st index b456fd7..9467b36 100644 --- a/src/MCP/MCPRepositoryDiffRequest.class.st +++ b/src/MCP/MCPRepositoryDiffRequest.class.st @@ -3,10 +3,7 @@ Parsed input for repository_change_list. It resolves the registered Iceberg repo " Class { #name : 'MCPRepositoryDiffRequest', - #superclass : 'Object', - #instVars : [ - 'repositoryReference' - ], + #superclass : 'MCPRepositoryRequest', #category : 'MCP-Requests', #package : 'MCP', #tag : 'Requests' @@ -24,14 +21,6 @@ MCPRepositoryDiffRequest >> commandForTool: aTool [ ^ MCPRepositoryDiffCommand tool: aTool request: self ] -{ #category : 'initialization' } -MCPRepositoryDiffRequest >> initializeFromRequest: request [ - - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - ^ self -] - { #category : 'accessing' } MCPRepositoryDiffRequest >> operation [ @@ -43,15 +32,3 @@ MCPRepositoryDiffRequest >> repository [ ^ self repositoryReference repository ] - -{ #category : 'accessing' } -MCPRepositoryDiffRequest >> repositoryReference [ - - ^ repositoryReference -] - -{ #category : 'converting' } -MCPRepositoryDiffRequest >> requestedContext [ - - ^ self repositoryReference requestedContext -] diff --git a/src/MCP/MCPRepositoryExportRequest.class.st b/src/MCP/MCPRepositoryExportRequest.class.st index 7bf0470..e9fe0de 100644 --- a/src/MCP/MCPRepositoryExportRequest.class.st +++ b/src/MCP/MCPRepositoryExportRequest.class.st @@ -3,10 +3,7 @@ Parsed input for repository_export. It resolves the registered Iceberg repositor " Class { #name : 'MCPRepositoryExportRequest', - #superclass : 'Object', - #instVars : [ - 'repositoryReference' - ], + #superclass : 'MCPRepositoryRequest', #category : 'MCP-Requests', #package : 'MCP', #tag : 'Requests' @@ -24,14 +21,6 @@ MCPRepositoryExportRequest >> commandForTool: aTool [ ^ MCPExportRepositoryCommand tool: aTool request: self ] -{ #category : 'initialization' } -MCPRepositoryExportRequest >> initializeFromRequest: request [ - - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - ^ self -] - { #category : 'accessing' } MCPRepositoryExportRequest >> operation [ @@ -43,15 +32,3 @@ MCPRepositoryExportRequest >> repository [ ^ self repositoryReference repository ] - -{ #category : 'accessing' } -MCPRepositoryExportRequest >> repositoryReference [ - - ^ repositoryReference -] - -{ #category : 'converting' } -MCPRepositoryExportRequest >> requestedContext [ - - ^ self repositoryReference requestedContext -] diff --git a/src/MCP/MCPRepositoryFetchRequest.class.st b/src/MCP/MCPRepositoryFetchRequest.class.st index 1401d43..c1548fc 100644 --- a/src/MCP/MCPRepositoryFetchRequest.class.st +++ b/src/MCP/MCPRepositoryFetchRequest.class.st @@ -3,10 +3,7 @@ Parsed input for repository_fetch. It resolves the registered Iceberg repository " Class { #name : 'MCPRepositoryFetchRequest', - #superclass : 'Object', - #instVars : [ - 'repositoryReference' - ], + #superclass : 'MCPRepositoryRequest', #category : 'MCP-Requests', #package : 'MCP', #tag : 'Requests' @@ -24,14 +21,6 @@ MCPRepositoryFetchRequest >> commandForTool: aTool [ ^ MCPFetchRepositoryCommand tool: aTool request: self ] -{ #category : 'initialization' } -MCPRepositoryFetchRequest >> initializeFromRequest: request [ - - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - ^ self -] - { #category : 'accessing' } MCPRepositoryFetchRequest >> operation [ @@ -43,15 +32,3 @@ MCPRepositoryFetchRequest >> repository [ ^ self repositoryReference repository ] - -{ #category : 'accessing' } -MCPRepositoryFetchRequest >> repositoryReference [ - - ^ repositoryReference -] - -{ #category : 'converting' } -MCPRepositoryFetchRequest >> requestedContext [ - - ^ self repositoryReference requestedContext -] diff --git a/src/MCP/MCPRepositoryPullRequest.class.st b/src/MCP/MCPRepositoryPullRequest.class.st index 87afd70..9204f58 100644 --- a/src/MCP/MCPRepositoryPullRequest.class.st +++ b/src/MCP/MCPRepositoryPullRequest.class.st @@ -3,10 +3,7 @@ Parsed input for repository_pull. It resolves the registered Iceberg repository " Class { #name : 'MCPRepositoryPullRequest', - #superclass : 'Object', - #instVars : [ - 'repositoryReference' - ], + #superclass : 'MCPRepositoryRequest', #category : 'MCP-Requests', #package : 'MCP', #tag : 'Requests' @@ -24,14 +21,6 @@ MCPRepositoryPullRequest >> commandForTool: aTool [ ^ MCPPullRepositoryCommand tool: aTool request: self ] -{ #category : 'initialization' } -MCPRepositoryPullRequest >> initializeFromRequest: request [ - - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - ^ self -] - { #category : 'accessing' } MCPRepositoryPullRequest >> operation [ @@ -43,15 +32,3 @@ MCPRepositoryPullRequest >> repository [ ^ self repositoryReference repository ] - -{ #category : 'accessing' } -MCPRepositoryPullRequest >> repositoryReference [ - - ^ repositoryReference -] - -{ #category : 'converting' } -MCPRepositoryPullRequest >> requestedContext [ - - ^ self repositoryReference requestedContext -] diff --git a/src/MCP/MCPRepositoryPushRequest.class.st b/src/MCP/MCPRepositoryPushRequest.class.st index de4a82e..6aa8628 100644 --- a/src/MCP/MCPRepositoryPushRequest.class.st +++ b/src/MCP/MCPRepositoryPushRequest.class.st @@ -3,10 +3,7 @@ Parsed input for repository_push. It resolves the registered Iceberg repository " Class { #name : 'MCPRepositoryPushRequest', - #superclass : 'Object', - #instVars : [ - 'repositoryReference' - ], + #superclass : 'MCPRepositoryRequest', #category : 'MCP-Requests', #package : 'MCP', #tag : 'Requests' @@ -24,14 +21,6 @@ MCPRepositoryPushRequest >> commandForTool: aTool [ ^ MCPPushRepositoryCommand tool: aTool request: self ] -{ #category : 'initialization' } -MCPRepositoryPushRequest >> initializeFromRequest: request [ - - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - ^ self -] - { #category : 'accessing' } MCPRepositoryPushRequest >> operation [ @@ -43,15 +32,3 @@ MCPRepositoryPushRequest >> repository [ ^ self repositoryReference repository ] - -{ #category : 'accessing' } -MCPRepositoryPushRequest >> repositoryReference [ - - ^ repositoryReference -] - -{ #category : 'converting' } -MCPRepositoryPushRequest >> requestedContext [ - - ^ self repositoryReference requestedContext -] diff --git a/src/MCP/MCPRepositoryRequest.class.st b/src/MCP/MCPRepositoryRequest.class.st new file mode 100644 index 0000000..4474ee3 --- /dev/null +++ b/src/MCP/MCPRepositoryRequest.class.st @@ -0,0 +1,37 @@ +" +Abstract request DTO for repository operations that target an existing repository reference. +" +Class { + #name : 'MCPRepositoryRequest', + #superclass : 'Object', + #instVars : [ + 'repositoryReference' + ], + #category : 'MCP-Requests', + #package : 'MCP', + #tag : 'Requests' +} + +{ #category : 'testing' } +MCPRepositoryRequest class >> isAbstract [ + + ^ self == MCPRepositoryRequest +] + +{ #category : 'initialization' } +MCPRepositoryRequest >> initializeFromRequest: request [ + + repositoryReference := MCPRepositoryReferenceSpec fromRequest: request +] + +{ #category : 'accessing' } +MCPRepositoryRequest >> repositoryReference [ + + ^ repositoryReference +] + +{ #category : 'converting' } +MCPRepositoryRequest >> requestedContext [ + + ^ self repositoryReference requestedContext +] diff --git a/src/MCP/MCPRepositorySwitchBranchRequest.class.st b/src/MCP/MCPRepositorySwitchBranchRequest.class.st index 6623f02..378d906 100644 --- a/src/MCP/MCPRepositorySwitchBranchRequest.class.st +++ b/src/MCP/MCPRepositorySwitchBranchRequest.class.st @@ -3,11 +3,7 @@ Parsed input for repository_branch_switch. It resolves the registered Iceberg re " Class { #name : 'MCPRepositorySwitchBranchRequest', - #superclass : 'Object', - #instVars : [ - 'repositoryReference', - 'branchName' - ], + #superclass : 'MCPRepositoryBranchRequest', #category : 'MCP-Requests', #package : 'MCP', #tag : 'Requests' @@ -19,27 +15,12 @@ MCPRepositorySwitchBranchRequest class >> fromRequest: request tool: aTool [ ^ self new initializeFromRequest: request ] -{ #category : 'accessing' } -MCPRepositorySwitchBranchRequest >> branchName [ - - ^ branchName ifNil: [ '' ] -] - { #category : 'converting' } MCPRepositorySwitchBranchRequest >> commandForTool: aTool [ ^ MCPSwitchRepositoryBranchCommand tool: aTool request: self ] -{ #category : 'initialization' } -MCPRepositorySwitchBranchRequest >> initializeFromRequest: request [ - - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - branchName := request stringArgumentNamed: 'branchName'. - ^ self -] - { #category : 'accessing' } MCPRepositorySwitchBranchRequest >> operation [ @@ -51,18 +32,3 @@ MCPRepositorySwitchBranchRequest >> repository [ ^ self repositoryReference repository ] - -{ #category : 'accessing' } -MCPRepositorySwitchBranchRequest >> repositoryReference [ - - ^ repositoryReference -] - -{ #category : 'converting' } -MCPRepositorySwitchBranchRequest >> requestedContext [ - - | context | - context := self repositoryReference requestedContext copy. - context at: #branchName put: self branchName. - ^ context -] diff --git a/src/MCP/MCPRepositoryUpdateRequest.class.st b/src/MCP/MCPRepositoryUpdateRequest.class.st index 1f3ee75..18ec3b2 100644 --- a/src/MCP/MCPRepositoryUpdateRequest.class.st +++ b/src/MCP/MCPRepositoryUpdateRequest.class.st @@ -5,9 +5,8 @@ It identifies a registered repository and describes package membership or subdir " Class { #name : 'MCPRepositoryUpdateRequest', - #superclass : 'Object', + #superclass : 'MCPRepositoryRequest', #instVars : [ - 'repositoryReference', 'subdirectory', 'packageNames', 'addPackageNames', @@ -63,17 +62,13 @@ MCPRepositoryUpdateRequest >> hasUpdates [ { #category : 'initialization' } MCPRepositoryUpdateRequest >> initializeFromRequest: request [ + super initializeFromRequest: request. suppliedProperties := self updatePropertyNames select: [ :each | - request hasArgumentNamed: each ]. - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. + request hasArgumentNamed: each ]. subdirectory := request stringArgumentNamed: 'subdirectory'. packageNames := request stringCollectionArgumentNamed: 'packageNames'. - addPackageNames := request stringCollectionArgumentNamed: - 'addPackageNames'. - removePackageNames := request stringCollectionArgumentNamed: - 'removePackageNames'. - ^ self + addPackageNames := request stringCollectionArgumentNamed: 'addPackageNames'. + removePackageNames := request stringCollectionArgumentNamed: 'removePackageNames' ] { #category : 'accessing' } @@ -100,12 +95,6 @@ MCPRepositoryUpdateRequest >> repository [ ^ self repositoryReference repository ] -{ #category : 'accessing' } -MCPRepositoryUpdateRequest >> repositoryReference [ - - ^ repositoryReference -] - { #category : 'converting' } MCPRepositoryUpdateRequest >> requestedContext [ diff --git a/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st b/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st index 054b018..a3f7fa3 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st @@ -3,10 +3,8 @@ Parsed input for repository_identity_verify. It resolves a registered Iceberg re " Class { #name : 'MCPRepositoryVerifyIdentityRequest', - #superclass : 'Object', + #superclass : 'MCPRepositoryBranchRequest', #instVars : [ - 'repositoryReference', - 'branchName', 'subdirectory', 'packageNames', 'modifiedPackageNames', @@ -27,12 +25,6 @@ MCPRepositoryVerifyIdentityRequest class >> fromRequest: request tool: aTool [ ^ self new initializeFromRequest: request ] -{ #category : 'accessing' } -MCPRepositoryVerifyIdentityRequest >> branchName [ - - ^ branchName ifNil: [ '' ] -] - { #category : 'converting' } MCPRepositoryVerifyIdentityRequest >> commandForTool: aTool [ @@ -77,26 +69,22 @@ MCPRepositoryVerifyIdentityRequest >> hasExpectedSubdirectory [ { #category : 'initialization' } MCPRepositoryVerifyIdentityRequest >> initializeFromRequest: request [ - repositoryReference := MCPRepositoryReferenceSpec fromRequest: - request. - branchName := request stringArgumentNamed: 'branchName'. + super initializeFromRequest: request. hasSubdirectory := request hasArgumentNamed: 'subdirectory'. hasPackageNames := request hasArgumentNamed: 'packageNames'. hasModifiedPackageNames := request hasArgumentNamed: 'modifiedPackageNames'. hasIsModified := request hasArgumentNamed: 'isModified'. hasSubdirectory ifTrue: [ subdirectory := self - stringArgumentNamed: 'subdirectory' - preservingEmptyFrom: request ]. + stringArgumentNamed: 'subdirectory' + preservingEmptyFrom: request ]. hasPackageNames ifTrue: [ - packageNames := request uniqueStringCollectionArgumentNamed: - 'packageNames' ]. + packageNames := request uniqueStringCollectionArgumentNamed: 'packageNames' ]. hasModifiedPackageNames ifTrue: [ modifiedPackageNames := request uniqueStringCollectionArgumentNamed: - 'modifiedPackageNames' ]. + 'modifiedPackageNames' ]. hasIsModified ifTrue: [ - isModified := request booleanArgumentNamed: 'isModified' default: false ]. - ^ self + isModified := request booleanArgumentNamed: 'isModified' default: false ] ] { #category : 'accessing' } @@ -129,12 +117,6 @@ MCPRepositoryVerifyIdentityRequest >> repository [ ^ self repositoryReference repository ] -{ #category : 'accessing' } -MCPRepositoryVerifyIdentityRequest >> repositoryReference [ - - ^ repositoryReference -] - { #category : 'converting' } MCPRepositoryVerifyIdentityRequest >> requestedContext [ diff --git a/src/MCP/MCPSearchToolsCommand.class.st b/src/MCP/MCPSearchToolsCommand.class.st index af5f255..c41a294 100644 --- a/src/MCP/MCPSearchToolsCommand.class.st +++ b/src/MCP/MCPSearchToolsCommand.class.st @@ -5,10 +5,7 @@ This command supports the discoverable-tool workflow: agents can search by text " Class { #name : 'MCPSearchToolsCommand', - #superclass : 'MCPToolRequestCommand', - #instVars : [ - 'toolExposurePolicy' - ], + #superclass : 'MCPToolCatalogCommand', #category : 'MCP-Commands', #package : 'MCP', #tag : 'Commands' @@ -23,15 +20,6 @@ MCPSearchToolsCommand class >> tool: aTool request: aRequest [ toolExposurePolicy: MCPToolExposurePolicy default ] -{ #category : 'instance creation' } -MCPSearchToolsCommand class >> tool: aTool request: aRequest toolExposurePolicy: aToolExposurePolicy [ - - ^ self new - initializeTool: aTool request: aRequest; - toolExposurePolicy: aToolExposurePolicy; - yourself -] - { #category : 'executing' } MCPSearchToolsCommand >> execute [ @@ -47,16 +35,3 @@ MCPSearchToolsCommand >> execute [ usingPolicy: self toolExposurePolicy ]) asArray) } asDictionary ] - -{ #category : 'accessing' } -MCPSearchToolsCommand >> toolExposurePolicy [ - - ^ toolExposurePolicy ifNil: [ MCPToolExposurePolicy default ] -] - -{ #category : 'accessing' } -MCPSearchToolsCommand >> toolExposurePolicy: aToolExposurePolicy [ - - toolExposurePolicy := aToolExposurePolicy ifNil: [ - MCPToolExposurePolicy default ] -] diff --git a/src/MCP/MCPTool.class.st b/src/MCP/MCPTool.class.st index 2ea528f..736bf3a 100644 --- a/src/MCP/MCPTool.class.st +++ b/src/MCP/MCPTool.class.st @@ -332,10 +332,7 @@ MCPTool >> pngCompositeBaseIconNamed: aBaseIconSymbol badgeIconNamed: aBadgeIcon { #category : 'private - icons' } MCPTool >> pngDataUriForForm: aForm [ - | bytes | - bytes := ByteArray streamContents: [ :stream | - PNGReadWriter putForm: aForm onStream: stream ]. - ^ 'data:image/png;base64,' , bytes base64Encoded + ^ MCPStructureIcon pngDataUriForForm: aForm ] { #category : 'private - icons' } diff --git a/src/MCP/MCPToolCatalogCommand.class.st b/src/MCP/MCPToolCatalogCommand.class.st new file mode 100644 index 0000000..56c687c --- /dev/null +++ b/src/MCP/MCPToolCatalogCommand.class.st @@ -0,0 +1,41 @@ +" +Abstract command for tool-catalog operations that need the current exposure policy. +" +Class { + #name : 'MCPToolCatalogCommand', + #superclass : 'MCPToolRequestCommand', + #instVars : [ + 'toolExposurePolicy' + ], + #category : 'MCP-Commands', + #package : 'MCP', + #tag : 'Commands' +} + +{ #category : 'testing' } +MCPToolCatalogCommand class >> isAbstract [ + + ^ self == MCPToolCatalogCommand +] + +{ #category : 'instance creation' } +MCPToolCatalogCommand class >> tool: aTool request: aRequest toolExposurePolicy: aToolExposurePolicy [ + + ^ self new + initializeTool: aTool request: aRequest; + toolExposurePolicy: aToolExposurePolicy; + yourself +] + +{ #category : 'accessing' } +MCPToolCatalogCommand >> toolExposurePolicy [ + + ^ toolExposurePolicy ifNil: [ MCPToolExposurePolicy default ] +] + +{ #category : 'accessing' } +MCPToolCatalogCommand >> toolExposurePolicy: aToolExposurePolicy [ + + toolExposurePolicy := aToolExposurePolicy ifNil: [ + MCPToolExposurePolicy default ] +] diff --git a/src/MCP/MCPToolClassMutation.class.st b/src/MCP/MCPToolClassMutation.class.st index 0dd99e0..0e4b0e8 100644 --- a/src/MCP/MCPToolClassMutation.class.st +++ b/src/MCP/MCPToolClassMutation.class.st @@ -27,17 +27,6 @@ MCPToolClassMutation >> atLeastOneInputProperties [ ifAbsent: [ #( ) ] ] -{ #category : 'metadata' } -MCPToolClassMutation >> buildInputSchema [ - - ^ MCPStructureInputSchema new - type: 'object'; - properties: self inputProperties; - required: self requiredInputProperties; - additionalProperties: false; - yourself -] - { #category : 'metadata' } MCPToolClassMutation >> buildOutputSchema [ @@ -493,10 +482,6 @@ MCPToolClassMutation >> validateAtLeastOneInputPropertyIn: request [ { #category : 'validating' } MCPToolClassMutation >> validateRequest: request [ - self requiredInputProperties do: [ :each | - (request argumentNamed: each ifAbsent: [ nil ]) ifNil: [ - MCPInvalidToolInput - signalMissingRequiredArgumentNamed: each - forTool: self ] ]. + super validateRequest: request. self validateAtLeastOneInputPropertyIn: request ] diff --git a/src/MCP/MCPToolDebug.class.st b/src/MCP/MCPToolDebug.class.st index 3d5f360..3a8056a 100644 --- a/src/MCP/MCPToolDebug.class.st +++ b/src/MCP/MCPToolDebug.class.st @@ -29,6 +29,17 @@ MCPToolDebug >> boundedIntegerSchemaPropertyNamed: propertyName description: pro ^ property ] +{ #category : 'metadata' } +MCPToolDebug >> buildInputSchema [ + + ^ MCPStructureInputSchema new + type: 'object'; + properties: self inputProperties; + required: self requiredInputProperties; + additionalProperties: false; + yourself +] + { #category : 'private - execution' } MCPToolDebug >> commandForRequest: debugRequest [ @@ -65,6 +76,12 @@ MCPToolDebug >> executeWithRequest: request [ onError: [ :error :ignored | self errorResultForDebugError: error ] ] +{ #category : 'private - schema' } +MCPToolDebug >> inputProperties [ + + self subclassResponsibility +] + { #category : 'private - schema' } MCPToolDebug >> nonNegativeIntegerSchemaPropertyNamed: propertyName description: propertyDescription default: defaultValue [ @@ -77,6 +94,12 @@ MCPToolDebug >> nonNegativeIntegerSchemaPropertyNamed: propertyName description: ^ property ] +{ #category : 'private - schema' } +MCPToolDebug >> requiredInputProperties [ + + self subclassResponsibility +] + { #category : 'private - execution' } MCPToolDebug >> resultForCommandResult: commandResult [ @@ -90,6 +113,16 @@ MCPToolDebug >> resultForCommandResult: commandResult [ warnings: commandResult warnings ] +{ #category : 'private - schema' } +MCPToolDebug >> sessionIdSchemaProperty [ + + ^ self + schemaPropertyNamed: 'sessionId' + type: 'string' + description: + 'Opaque debug session identifier returned by debug_session_list, debug_capture, debug_test_run, or debug_candidate_attach.' +] + { #category : 'private - schema' } MCPToolDebug >> sourceContextLinesSchemaPropertyWithDescription: aDescription default: defaultValue [ diff --git a/src/MCP/MCPToolDebugBreakpointOperation.class.st b/src/MCP/MCPToolDebugBreakpointOperation.class.st index 6bd9e46..efdac2f 100644 --- a/src/MCP/MCPToolDebugBreakpointOperation.class.st +++ b/src/MCP/MCPToolDebugBreakpointOperation.class.st @@ -71,17 +71,6 @@ MCPToolDebugBreakpointOperation >> breakpointToolSpec [ self subclassResponsibility ] -{ #category : 'metadata' } -MCPToolDebugBreakpointOperation >> buildInputSchema [ - - ^ MCPStructureInputSchema new - type: 'object'; - properties: self inputProperties; - required: self requiredInputProperties; - additionalProperties: false; - yourself -] - { #category : 'metadata' } MCPToolDebugBreakpointOperation >> buildOutputSchema [ diff --git a/src/MCP/MCPToolDebugSessionControlOperation.class.st b/src/MCP/MCPToolDebugSessionControlOperation.class.st index c996d11..6426d46 100644 --- a/src/MCP/MCPToolDebugSessionControlOperation.class.st +++ b/src/MCP/MCPToolDebugSessionControlOperation.class.st @@ -158,16 +158,6 @@ MCPToolDebugSessionControlOperation >> parsedRequestFromToolRequest: request [ operation: self actionName ] -{ #category : 'private - schema' } -MCPToolDebugSessionControlOperation >> sessionIdSchemaProperty [ - - ^ self - schemaPropertyNamed: 'sessionId' - type: 'string' - description: - 'Opaque debug session identifier returned by debug_session_list, debug_capture, debug_test_run, or debug_candidate_attach.' -] - { #category : 'private - schema' } MCPToolDebugSessionControlOperation >> stateIdSchemaProperty [ diff --git a/src/MCP/MCPToolDebugSessionOperation.class.st b/src/MCP/MCPToolDebugSessionOperation.class.st index 3a598cb..30c6298 100644 --- a/src/MCP/MCPToolDebugSessionOperation.class.st +++ b/src/MCP/MCPToolDebugSessionOperation.class.st @@ -23,17 +23,6 @@ MCPToolDebugSessionOperation >> actionName [ ^ self sessionToolSpec at: #action ] -{ #category : 'metadata' } -MCPToolDebugSessionOperation >> buildInputSchema [ - - ^ MCPStructureInputSchema new - type: 'object'; - properties: self inputProperties; - required: self requiredInputProperties; - additionalProperties: false; - yourself -] - { #category : 'metadata' } MCPToolDebugSessionOperation >> buildOutputSchema [ @@ -133,16 +122,6 @@ MCPToolDebugSessionOperation >> requiredInputProperties [ ifAbsent: [ #( ) ] ] -{ #category : 'private - schema' } -MCPToolDebugSessionOperation >> sessionIdSchemaProperty [ - - ^ self - schemaPropertyNamed: 'sessionId' - type: 'string' - description: - 'Opaque debug session identifier returned by debug_session_list, debug_capture, debug_test_run, or debug_candidate_attach.' -] - { #category : 'private - specs' } MCPToolDebugSessionOperation >> sessionToolSpec [ diff --git a/src/MCP/MCPToolMethodMutation.class.st b/src/MCP/MCPToolMethodMutation.class.st index 531ab13..f87f2be 100644 --- a/src/MCP/MCPToolMethodMutation.class.st +++ b/src/MCP/MCPToolMethodMutation.class.st @@ -54,17 +54,6 @@ MCPToolMethodMutation >> allowedNonErrorCritiqueRuleClasses [ ReUnaryAccessingMethodWithoutReturnRule } ] -{ #category : 'metadata' } -MCPToolMethodMutation >> buildInputSchema [ - - ^ MCPStructureInputSchema new - type: 'object'; - properties: self inputProperties; - required: self requiredInputProperties; - additionalProperties: false; - yourself -] - { #category : 'metadata' } MCPToolMethodMutation >> buildOutputSchema [ @@ -345,13 +334,3 @@ MCPToolMethodMutation >> title [ ^ self methodToolSpec at: #title ] - -{ #category : 'validating' } -MCPToolMethodMutation >> validateRequest: request [ - - self requiredInputProperties do: [ :each | - (request argumentNamed: each ifAbsent: [ nil ]) ifNil: [ - MCPInvalidToolInput - signalMissingRequiredArgumentNamed: each - forTool: self ] ] -] diff --git a/src/MCP/MCPToolMethodSearch.class.st b/src/MCP/MCPToolMethodSearch.class.st index ddd0b24..df70664 100644 --- a/src/MCP/MCPToolMethodSearch.class.st +++ b/src/MCP/MCPToolMethodSearch.class.st @@ -293,30 +293,6 @@ MCPToolMethodSearch >> methodQueryScopeInputProperties [ self searchScopeSchemaProperty } ] -{ #category : 'private - methods' } -MCPToolMethodSearch >> 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'); - yourself -] - { #category : 'private - filtering' } MCPToolMethodSearch >> needsSourceForFiltering [ @@ -368,16 +344,6 @@ MCPToolMethodSearch >> sortedMethodEntries: entries [ (self methodEntryLabel: left) <= (self methodEntryLabel: right) ] ] -{ #category : 'private - template' } -MCPToolMethodSearch >> successSummaryForQueryRequest: queryRequest page: page [ - - ^ self - successSummaryForScope: - (self classAndMethodScopeSummaryForScopeQuery: - queryRequest scopeQuery) - page: page -] - { #category : 'private - results' } MCPToolMethodSearch >> successSummaryForScope: scopeSummary page: page [ diff --git a/src/MCP/MCPToolMutation.class.st b/src/MCP/MCPToolMutation.class.st index 2cdc53e..d9c353d 100644 --- a/src/MCP/MCPToolMutation.class.st +++ b/src/MCP/MCPToolMutation.class.st @@ -75,6 +75,17 @@ MCPToolMutation >> addSupplementalSelectorFromMethodNode: methodNode to: details details at: #selector ifAbsentPut: [ selector asString ] ] ] +{ #category : 'metadata' } +MCPToolMutation >> buildInputSchema [ + + ^ MCPStructureInputSchema new + type: 'object'; + properties: self inputProperties; + required: self requiredInputProperties; + additionalProperties: false; + yourself +] + { #category : 'private - refactoring' } MCPToolMutation >> classesRefactoringEnvironmentForClassNames: classNames baseEnvironment: baseEnvironment [ @@ -292,6 +303,12 @@ MCPToolMutation >> impactMessagesForRefactoringWarning: aWarning [ ^ impactMessages asArray ] +{ #category : 'private - schema' } +MCPToolMutation >> inputProperties [ + + self subclassResponsibility +] + { #category : 'private - errors' } MCPToolMutation >> methodNodeFromError: anError [ @@ -526,6 +543,12 @@ MCPToolMutation >> requestedContextForErrorFromParsedRequest: mutationRequest ra ^ mutationRequest requestedContext ] +{ #category : 'private - schema' } +MCPToolMutation >> requiredInputProperties [ + + self subclassResponsibility +] + { #category : 'private - request' } MCPToolMutation >> resolvedRefactoringScopeClassesFrom: classNames [ @@ -627,6 +650,16 @@ MCPToolMutation >> validateRefactoringScopePackageNamesExist: packageNames [ packageNames do: [ :eachName | MCPImageLookup packageNamed: eachName ] ] +{ #category : 'validating' } +MCPToolMutation >> validateRequest: request [ + + self requiredInputProperties do: [ :each | + (request argumentNamed: each ifAbsent: [ nil ]) ifNil: [ + MCPInvalidToolInput + signalMissingRequiredArgumentNamed: each + forTool: self ] ] +] + { #category : 'private - errors' } MCPToolMutation >> variableNameFromNode: aNode [ diff --git a/src/MCP/MCPToolRepositoryOperation.class.st b/src/MCP/MCPToolRepositoryOperation.class.st index be7e0e2..a35c1a7 100644 --- a/src/MCP/MCPToolRepositoryOperation.class.st +++ b/src/MCP/MCPToolRepositoryOperation.class.st @@ -26,17 +26,6 @@ MCPToolRepositoryOperation >> branchNameSchemaProperty [ description: 'Branch name.' ] -{ #category : 'metadata' } -MCPToolRepositoryOperation >> buildInputSchema [ - - ^ MCPStructureInputSchema new - type: 'object'; - properties: self inputProperties; - required: self requiredInputProperties; - additionalProperties: false; - yourself -] - { #category : 'metadata' } MCPToolRepositoryOperation >> buildOutputSchema [ @@ -353,13 +342,3 @@ MCPToolRepositoryOperation >> title [ ^ self repositoryToolSpec at: #title ] - -{ #category : 'validating' } -MCPToolRepositoryOperation >> validateRequest: request [ - - self requiredInputProperties do: [ :each | - (request argumentNamed: each ifAbsent: [ nil ]) ifNil: [ - MCPInvalidToolInput - signalMissingRequiredArgumentNamed: each - forTool: self ] ] -] diff --git a/src/MCP/MCPToolSearch.class.st b/src/MCP/MCPToolSearch.class.st index 96dfd35..157e6e8 100644 --- a/src/MCP/MCPToolSearch.class.st +++ b/src/MCP/MCPToolSearch.class.st @@ -550,6 +550,15 @@ MCPToolSearch >> searchScopeStringCollectionNamed: aName fromRequest: request [ { #category : 'private - template' } MCPToolSearch >> successSummaryForQueryRequest: queryRequest page: page [ + ^ self + successSummaryForScope: + (self classAndMethodScopeSummaryForScopeQuery: queryRequest scopeQuery) + page: page +] + +{ #category : 'private - results' } +MCPToolSearch >> successSummaryForScope: scopeDescription page: page [ + self subclassResponsibility ] diff --git a/src/MCP/MCPToolSearchClasses.class.st b/src/MCP/MCPToolSearchClasses.class.st index 8ef3995..0cd02de 100644 --- a/src/MCP/MCPToolSearchClasses.class.st +++ b/src/MCP/MCPToolSearchClasses.class.st @@ -200,16 +200,6 @@ MCPToolSearchClasses >> searchRequestFromToolRequest: request [ ^ MCPSearchClassesRequest fromRequest: request tool: self ] -{ #category : 'private - template' } -MCPToolSearchClasses >> successSummaryForQueryRequest: queryRequest page: page [ - - ^ self - successSummaryForScope: - (self classAndMethodScopeSummaryForScopeQuery: - queryRequest scopeQuery) - page: page -] - { #category : 'private - results' } MCPToolSearchClasses >> successSummaryForScope: scopeSummary page: page [ From efdbf8870ea1002b357de36bfdd9598c376fa2f8 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Thu, 25 Jun 2026 18:32:30 +0200 Subject: [PATCH 16/21] Fix concrete abstract responsibilities Co-authored-by: Codex --- src/MCP-Tests/MCPToolContractsTest.class.st | 62 +++++++++++++++++++ src/MCP/MCPClassCommand.class.st | 6 -- ...AttachedDebuggerSelectionStrategy.class.st | 6 ++ src/MCP/MCPDebugCommand.class.st | 6 ++ src/MCP/MCPDebugController.class.st | 6 ++ src/MCP/MCPMessageSendHandler.class.st | 6 ++ src/MCP/MCPToolDebug.class.st | 4 +- src/MCP/MCPToolIconSpec.class.st | 6 ++ 8 files changed, 94 insertions(+), 8 deletions(-) diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 868c6a1..9b50f4b 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -9,6 +9,25 @@ Class { #tag : 'Tools' } +{ #category : 'private' } +MCPToolContractsTest >> addUnimplementedResponsibilitiesFor: aClass behavior: aBehavior side: sideName to: issues [ + + aBehavior allSelectors do: [ :selector | + | method | + selector = #subclassResponsibility ifFalse: [ + method := aBehavior lookupSelector: selector. + (method notNil and: [ self methodSendsSubclassResponsibility: method ]) ifTrue: [ + issues add: (String streamContents: [ :stream | + stream + nextPutAll: aClass name asString; + space; + nextPutAll: sideName; + nextPutAll: ' #'; + nextPutAll: selector asString; + nextPutAll: ' inherited from '; + nextPutAll: method methodClass name asString ]) ] ] ] +] + { #category : 'private' } MCPToolContractsTest >> assertDebugInputPropertyNamed: propertyName inTool: aTool default: defaultValue maximum: maximumValue [ @@ -607,6 +626,16 @@ MCPToolContractsTest >> methodMutationToolFlowSpecs [ (#commandClass -> MCPUpdateMethodCommand) } asDictionary } ] +{ #category : 'private' } +MCPToolContractsTest >> methodSendsSubclassResponsibility: aCompiledMethod [ + + (aCompiledMethod sendsSelector: #subclassResponsibility) ifFalse: [ ^ false ]. + aCompiledMethod ast nodesDo: [ :node | + (node isMessage and: [ node selector = #subclassResponsibility ]) ifTrue: [ + ^ true ] ]. + ^ false +] + { #category : 'private' } MCPToolContractsTest >> repositoryToolFlowSpecs [ @@ -1105,6 +1134,17 @@ MCPToolContractsTest >> testClassToolsOutputSchemaAdvertisesMinimalMutationResul self assert: dataProperties isEmpty ] +{ #category : 'tests' } +MCPToolContractsTest >> testConcreteMCPClassesHaveNoUnimplementedResponsibilities [ + + | issues | + issues := self unimplementedResponsibilitiesForConcreteMCPClasses. + self + assert: issues isEmpty + description: (String streamContents: [ :stream | + issues do: [ :each | stream nextPutAll: each ] separatedBy: [ stream cr ] ]) +] + { #category : 'tests' } MCPToolContractsTest >> testConfiguredDiscoverableToolsAreNotDirectlyCallable [ @@ -3357,3 +3397,25 @@ MCPToolContractsTest >> toolFlowSpecs [ ^ specs asArray ] + +{ #category : 'private' } +MCPToolContractsTest >> unimplementedResponsibilitiesForConcreteMCPClasses [ + + | classes issues | + classes := (PackageOrganizer default packageNamed: #MCP) definedClasses + reject: [ :each | each isTrait ]. + issues := OrderedCollection new. + classes do: [ :class | + class isAbstract ifFalse: [ + self + addUnimplementedResponsibilitiesFor: class + behavior: class + side: 'instance' + to: issues. + self + addUnimplementedResponsibilitiesFor: class + behavior: class class + side: 'class' + to: issues ] ]. + ^ issues asArray sort +] diff --git a/src/MCP/MCPClassCommand.class.st b/src/MCP/MCPClassCommand.class.st index d2f4b01..d2ba8d1 100644 --- a/src/MCP/MCPClassCommand.class.st +++ b/src/MCP/MCPClassCommand.class.st @@ -38,12 +38,6 @@ MCPClassCommand >> currentClass [ ^ MCPImageLookup classNamed: self className ] -{ #category : 'accessing' } -MCPClassCommand >> layout [ - - self subclassResponsibility -] - { #category : 'private - resolving' } MCPClassCommand >> resolvedLayoutClass [ diff --git a/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st b/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st index ac002c7..add3e5c 100644 --- a/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st +++ b/src/MCP/MCPDebugAttachedDebuggerSelectionStrategy.class.st @@ -90,6 +90,12 @@ MCPDebugAttachedDebuggerSelectionStrategy class >> reset [ ^ self ] +{ #category : 'iterating' } +MCPDebugAttachedDebuggerSelectionStrategy >> nextDebugger [ + + ^ self shouldNotImplement +] + { #category : 'debuggers' } MCPDebugAttachedDebuggerSelectionStrategy >> openDebuggerForSession: aDebugSession [ diff --git a/src/MCP/MCPDebugCommand.class.st b/src/MCP/MCPDebugCommand.class.st index 728426b..cd28d71 100644 --- a/src/MCP/MCPDebugCommand.class.st +++ b/src/MCP/MCPDebugCommand.class.st @@ -14,6 +14,12 @@ Class { #tag : 'Commands' } +{ #category : 'testing' } +MCPDebugCommand class >> isAbstract [ + + ^ self == MCPDebugCommand +] + { #category : 'instance creation' } MCPDebugCommand class >> tool: aTool request: aRequest [ diff --git a/src/MCP/MCPDebugController.class.st b/src/MCP/MCPDebugController.class.st index 9e73096..3265856 100644 --- a/src/MCP/MCPDebugController.class.st +++ b/src/MCP/MCPDebugController.class.st @@ -9,6 +9,12 @@ Class { #tag : 'Debugging' } +{ #category : 'testing' } +MCPDebugController class >> isAbstract [ + + ^ self == MCPDebugController +] + { #category : 'accessing' } MCPDebugController >> debugSession [ diff --git a/src/MCP/MCPMessageSendHandler.class.st b/src/MCP/MCPMessageSendHandler.class.st index 3857c19..957a5cf 100644 --- a/src/MCP/MCPMessageSendHandler.class.st +++ b/src/MCP/MCPMessageSendHandler.class.st @@ -11,6 +11,12 @@ Class { #tag : 'Server' } +{ #category : 'accessing' } +MCPMessageSendHandler class >> defaultMethodName [ + + ^ self shouldNotImplement +] + { #category : 'private' } MCPMessageSendHandler >> argumentsFromParameters: parameters [ diff --git a/src/MCP/MCPToolDebug.class.st b/src/MCP/MCPToolDebug.class.st index 3a8056a..b1f617f 100644 --- a/src/MCP/MCPToolDebug.class.st +++ b/src/MCP/MCPToolDebug.class.st @@ -79,7 +79,7 @@ MCPToolDebug >> executeWithRequest: request [ { #category : 'private - schema' } MCPToolDebug >> inputProperties [ - self subclassResponsibility + ^ #( ) ] { #category : 'private - schema' } @@ -97,7 +97,7 @@ MCPToolDebug >> nonNegativeIntegerSchemaPropertyNamed: propertyName description: { #category : 'private - schema' } MCPToolDebug >> requiredInputProperties [ - self subclassResponsibility + ^ #( ) ] { #category : 'private - execution' } diff --git a/src/MCP/MCPToolIconSpec.class.st b/src/MCP/MCPToolIconSpec.class.st index cffdd8a..5fab0dc 100644 --- a/src/MCP/MCPToolIconSpec.class.st +++ b/src/MCP/MCPToolIconSpec.class.st @@ -134,6 +134,12 @@ MCPToolIconSpec class >> iconNameForObject: objectString [ ^ self objectIconMap at: objectString asString ifAbsent: [ #info ] ] +{ #category : 'testing' } +MCPToolIconSpec class >> isAbstract [ + + ^ self == MCPToolIconSpec +] + { #category : 'instance creation' } MCPToolIconSpec class >> named: anIconSymbol [ From dc70673ef174ba78429725591cf88b729ed31399 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Thu, 25 Jun 2026 21:43:28 +0200 Subject: [PATCH 17/21] Fix layout resolver self send Co-authored-by: Codex --- src/MCP-Tests/MCPToolContractsTest.class.st | 47 +++++++++++++++++++ src/MCP/MCPClassCommand.class.st | 14 +++--- src/MCP/MCPCreateClassCommand.class.st | 3 +- src/MCP/MCPReplaceClassLayoutCommand.class.st | 5 +- 4 files changed, 59 insertions(+), 10 deletions(-) diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index 9b50f4b..fd3a078 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -9,6 +9,21 @@ Class { #tag : 'Tools' } +{ #category : 'private' } +MCPToolContractsTest >> addSelfSentNotImplementedCritiquesFrom: aMethod using: aRule to: issues [ + + aRule check: aMethod forCritiquesDo: [ :critique | + issues add: (String streamContents: [ :stream | + stream + nextPutAll: aMethod methodClass name asString; + nextPutAll: '>>'; + nextPutAll: aMethod selector asString. + critique tinyHint ifNotNil: [ :hint | + stream + space; + nextPutAll: hint asString ] ]) ] +] + { #category : 'private' } MCPToolContractsTest >> addUnimplementedResponsibilitiesFor: aClass behavior: aBehavior side: sideName to: issues [ @@ -732,6 +747,27 @@ MCPToolContractsTest >> repositoryToolFlowSpecs [ (#commandClass -> MCPAdoptRepositoryHeadCommand) } asDictionary } ] +{ #category : 'private' } +MCPToolContractsTest >> selfSentNotImplementedCritiquesForMCPMethods [ + + | issues package rule | + rule := ReSelfSentNotImplementedRule new. + package := PackageOrganizer default packageNamed: #MCP. + issues := OrderedCollection new. + package definedClasses do: [ :class | + class localMethods do: [ :method | + self + addSelfSentNotImplementedCritiquesFrom: method + using: rule + to: issues ]. + class class localMethods do: [ :method | + self + addSelfSentNotImplementedCritiquesFrom: method + using: rule + to: issues ] ]. + ^ issues asArray sort +] + { #category : 'private' } MCPToolContractsTest >> signalHaltForMCPMessageProcessorTest [ @@ -1662,6 +1698,17 @@ MCPToolContractsTest >> testInputSchemaJSONOmitsDefaultSchemaNoise [ self assert: (schema at: #additionalProperties) equals: false ] +{ #category : 'tests' } +MCPToolContractsTest >> testMCPMethodsHaveImplementedSelfAndSuperSends [ + + | issues | + issues := self selfSentNotImplementedCritiquesForMCPMethods. + self + assert: issues isEmpty + description: (String streamContents: [ :stream | + issues do: [ :each | stream nextPutAll: each ] separatedBy: [ stream cr ] ]) +] + { #category : 'tests' } MCPToolContractsTest >> testMethodMetadataSearchDescriptionPointsToSpecializedReferenceTools [ diff --git a/src/MCP/MCPClassCommand.class.st b/src/MCP/MCPClassCommand.class.st index d2ba8d1..5adab83 100644 --- a/src/MCP/MCPClassCommand.class.st +++ b/src/MCP/MCPClassCommand.class.st @@ -39,26 +39,26 @@ MCPClassCommand >> currentClass [ ] { #category : 'private - resolving' } -MCPClassCommand >> resolvedLayoutClass [ +MCPClassCommand >> resolvedLayoutClassNamed: layoutName [ | behavior | - self layout ifNil: [ ^ nil ]. + layoutName ifNil: [ ^ nil ]. behavior := Smalltalk globals - at: self layout asSymbol + at: layoutName asSymbol ifAbsent: [ MCPCommandError signalErrorCode: #LayoutClassNotFound - message: 'Layout class ' , self layout , ' does not exist.' + message: 'Layout class ' , layoutName , ' does not exist.' details: { (#className -> self className). - (#layout -> self layout) } asDictionary ]. + (#layout -> layoutName) } asDictionary ]. (AbstractLayout withAllSubclasses includes: behavior) ifFalse: [ MCPCommandError signalErrorCode: #InvalidLayoutClass - message: self layout , ' not layout class.' + message: layoutName , ' not layout class.' details: { (#className -> self className). - (#layout -> self layout) } asDictionary ]. + (#layout -> layoutName) } asDictionary ]. ^ behavior ] diff --git a/src/MCP/MCPCreateClassCommand.class.st b/src/MCP/MCPCreateClassCommand.class.st index d23e7a0..7822f9b 100644 --- a/src/MCP/MCPCreateClassCommand.class.st +++ b/src/MCP/MCPCreateClassCommand.class.st @@ -70,7 +70,8 @@ MCPCreateClassCommand >> buildClass [ builder sharedVariables: self sharedVariables ]. self sharedPools ifNotEmpty: [ builder sharedPools: self resolvedSharedPools ]. - self layout ifNotNil: [ builder layout: self resolvedLayoutClass ]. + self layout ifNotNil: [ :layoutName | + builder layout: (self resolvedLayoutClassNamed: layoutName) ]. createdClass := builder install. ^ createdClass ] diff --git a/src/MCP/MCPReplaceClassLayoutCommand.class.st b/src/MCP/MCPReplaceClassLayoutCommand.class.st index 4787865..5180eb3 100644 --- a/src/MCP/MCPReplaceClassLayoutCommand.class.st +++ b/src/MCP/MCPReplaceClassLayoutCommand.class.st @@ -56,8 +56,9 @@ MCPReplaceClassLayoutCommand >> layoutClassNameFromClass: aClass [ MCPReplaceClassLayoutCommand >> replaceLayoutOn: aClass [ ^ ShiftClassInstaller - update: aClass - to: [ :builder | builder layout: self resolvedLayoutClass ] + update: aClass + to: [ :builder | + builder layout: (self resolvedLayoutClassNamed: self layout) ] ] { #category : 'private' } From 1c8c7aa2a99123572baef04630fc230d8d75cfd2 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Fri, 26 Jun 2026 10:33:26 +0200 Subject: [PATCH 18/21] Format MCP packages Co-authored-by: Codex --- src/BaselineOfMCP/BaselineOfMCP.class.st | 18 +- .../MCPMonitoringStateTest.class.st | 12 +- src/MCP-Spec/MCPDashboardPresenter.class.st | 71 +-- .../MCPToolsCatalogPresenter.class.st | 24 +- ...PCompiledMethodInfoTestTarget.extension.st | 4 +- ...PToolMethodMutationTestTarget.extension.st | 4 +- .../MCPCompiledMethodInfoTestTarget.class.st | 8 +- .../MCPToolMethodMutationTestSender.class.st | 8 +- .../MCPToolMethodMutationTestTarget.class.st | 16 +- .../MCPToolRemoveMethodsTestSender.class.st | 4 +- .../MCPToolRemoveMethodsTestTarget.class.st | 20 +- .../MCPChangeClassCommentCommandTest.class.st | 10 +- .../MCPClassMutationRequestTest.class.st | 39 +- src/MCP-Tests/MCPCommandErrorTest.class.st | 32 +- src/MCP-Tests/MCPCommandTestCase.class.st | 4 +- .../MCPCompiledMethodInfoTest.class.st | 12 +- .../MCPCompiledMethodScopeQueryTest.class.st | 16 +- .../MCPCreateClassCommandTest.class.st | 36 +- .../MCPDebugToolContractTest.class.st | 63 ++- src/MCP-Tests/MCPHaltingTestTool.class.st | 10 +- .../MCPJSONSchemaValidatorTest.class.st | 2 - .../MCPMoveClassCommandTest.class.st | 24 +- src/MCP-Tests/MCPRecordingMetacello.class.st | 4 +- .../MCPRemoveClassesCommandTest.class.st | 26 +- .../MCPRenameClassCommandTest.class.st | 22 +- .../MCPReparentClassCommandTest.class.st | 16 +- src/MCP-Tests/MCPRepositorySpecTest.class.st | 47 +- src/MCP-Tests/MCPTestCase.class.st | 28 +- src/MCP-Tests/MCPTestIceRepository.class.st | 8 +- .../MCPToolChangeHistoryTest.class.st | 134 ++--- .../MCPToolClassMutationTest.class.st | 211 ++++---- src/MCP-Tests/MCPToolContractsTest.class.st | 357 +++++++------ src/MCP-Tests/MCPToolGetClassTest.class.st | 18 +- .../MCPToolMethodMutationTest.class.st | 325 ++++++------ .../MCPToolRemoveClassesTest.class.st | 64 ++- .../MCPToolRemoveMethodsTest.class.st | 59 ++- .../MCPToolRepositoryOperationTest.class.st | 347 +++++++------ src/MCP-Tests/MCPToolRequestTest.class.st | 18 +- .../MCPToolSearchPackagesTest.class.st | 64 +-- .../MCPToolSearchRepositoriesTest.class.st | 8 +- .../MCPToolStructuredOutputTest.class.st | 170 ++++--- .../MCPUpdateClassCommandTest.class.st | 58 ++- src/MCP/MCP.class.st | 24 +- src/MCP/MCPAppliedChangeResult.class.st | 6 +- src/MCP/MCPChangeClassCommentCommand.class.st | 8 +- .../MCPChangeHistorySelectionCommand.class.st | 46 +- .../MCPChangeHistorySelectionRequest.class.st | 28 +- src/MCP/MCPClassCommand.class.st | 54 +- src/MCP/MCPClassScopeQuery.class.st | 28 +- src/MCP/MCPClassUpdateRequest.class.st | 52 +- src/MCP/MCPCommandError.class.st | 32 +- src/MCP/MCPCommitRepositoryCommand.class.st | 28 +- src/MCP/MCPCompiledMethodScopeQuery.class.st | 83 ++-- src/MCP/MCPCreateClassCommand.class.st | 62 +-- src/MCP/MCPCreateClassToolCommand.class.st | 53 +- src/MCP/MCPDebugCommand.class.st | 28 +- src/MCP/MCPDebugRepairAnalyzer.class.st | 3 +- src/MCP/MCPDebugVariablesCommand.class.st | 16 +- src/MCP/MCPEvaluateCommand.class.st | 12 +- src/MCP/MCPGetClassCommand.class.st | 12 +- src/MCP/MCPGetMethodCommand.class.st | 14 +- src/MCP/MCPHTTPServer.class.st | 6 +- src/MCP/MCPImageLookup.class.st | 12 +- src/MCP/MCPJSONSchemaValidator.class.st | 97 ++-- ...CPListChangeHistoryEntriesCommand.class.st | 10 +- src/MCP/MCPLoadBaselineCommand.class.st | 6 +- src/MCP/MCPLoadRepositoryRequest.class.st | 8 +- src/MCP/MCPMessageProcessor.class.st | 46 +- src/MCP/MCPMethodCompileRequest.class.st | 3 +- src/MCP/MCPMethodReferenceSpec.class.st | 8 +- src/MCP/MCPMethodRewriteChangeInfo.class.st | 18 +- src/MCP/MCPMethodRewriteRuleSpec.class.st | 16 +- src/MCP/MCPMethodUpdateRequest.class.st | 208 ++++---- src/MCP/MCPMonitoringState.class.st | 55 +- src/MCP/MCPMoveClassCommand.class.st | 14 +- src/MCP/MCPMoveSlotCommand.class.st | 8 +- src/MCP/MCPPackageScopeQuery.class.st | 26 +- src/MCP/MCPRemoveClassesCommand.class.st | 24 +- src/MCP/MCPRemoveClassesResult.class.st | 7 +- src/MCP/MCPRemoveMethodsCommand.class.st | 22 +- src/MCP/MCPRemoveSlotCommand.class.st | 12 +- src/MCP/MCPRenameClassCommand.class.st | 8 +- src/MCP/MCPRenameSlotCommand.class.st | 83 ++-- src/MCP/MCPReparentClassCommand.class.st | 12 +- .../MCPReplaceClassDefinitionCommand.class.st | 6 +- src/MCP/MCPReplaceClassLayoutCommand.class.st | 6 +- .../MCPReplaceClassSideTraitsCommand.class.st | 32 +- src/MCP/MCPReplaceClassTraitsCommand.class.st | 34 +- src/MCP/MCPRepositoryReferenceSpec.class.st | 4 +- src/MCP/MCPRepositoryRequest.class.st | 3 +- src/MCP/MCPRepositoryResult.class.st | 3 +- src/MCP/MCPRepositoryUpdateRequest.class.st | 14 +- ...CPRepositoryVerifyIdentityCommand.class.st | 20 +- ...CPRepositoryVerifyIdentityRequest.class.st | 31 +- src/MCP/MCPRewriteMethodsCommand.class.st | 14 +- src/MCP/MCPRunTestsCommand.class.st | 180 +++---- src/MCP/MCPRunTestsRequest.class.st | 42 +- src/MCP/MCPRunTestsResult.class.st | 82 +-- src/MCP/MCPScopeNameSuggester.class.st | 114 ++--- src/MCP/MCPScopeQuery.class.st | 51 +- src/MCP/MCPStructureInitialize.class.st | 6 +- src/MCP/MCPStructuredTestResult.class.st | 12 +- src/MCP/MCPTestCoverageResult.class.st | 24 +- src/MCP/MCPTestRunRequest.class.st | 25 +- src/MCP/MCPTool.class.st | 22 +- src/MCP/MCPToolCaptureScreenshot.class.st | 16 +- src/MCP/MCPToolCatalogCommand.class.st | 8 +- src/MCP/MCPToolChangeHistory.class.st | 23 +- src/MCP/MCPToolClassMutation.class.st | 182 ++++--- src/MCP/MCPToolDebug.class.st | 22 +- .../MCPToolDebugBreakpointOperation.class.st | 8 +- ...PToolDebugSessionControlOperation.class.st | 4 +- src/MCP/MCPToolDebugSessionOperation.class.st | 4 +- src/MCP/MCPToolEvaluate.class.st | 50 +- src/MCP/MCPToolGetClass.class.st | 6 +- src/MCP/MCPToolGetMethod.class.st | 6 +- src/MCP/MCPToolMethodMutation.class.st | 98 ++-- src/MCP/MCPToolMethodSearch.class.st | 20 +- src/MCP/MCPToolMutation.class.st | 109 ++-- src/MCP/MCPToolRegistry.class.st | 3 +- src/MCP/MCPToolRemoveClasses.class.st | 128 ++--- src/MCP/MCPToolRemoveMethods.class.st | 58 +-- src/MCP/MCPToolRepositoryOperation.class.st | 8 +- src/MCP/MCPToolRequest.class.st | 4 +- src/MCP/MCPToolRewriteMethods.class.st | 14 +- src/MCP/MCPToolRunTestCoverage.class.st | 25 +- src/MCP/MCPToolRunTests.class.st | 282 +++++------ src/MCP/MCPToolSearch.class.st | 102 ++-- src/MCP/MCPToolSearchRepositories.class.st | 4 +- src/MCP/MCPToolUpdateDebugMethod.class.st | 6 +- src/MCP/MCPUpdateClassCommand.class.st | 470 +++++++++--------- src/MCP/MCPUpdateDebugMethodCommand.class.st | 34 +- src/MCP/MCPUpdateMethodCommand.class.st | 428 ++++++++-------- src/MCP/TMCPMethodTool.trait.st | 24 +- 134 files changed, 3401 insertions(+), 3189 deletions(-) diff --git a/src/BaselineOfMCP/BaselineOfMCP.class.st b/src/BaselineOfMCP/BaselineOfMCP.class.st index 5358615..508d946 100644 --- a/src/BaselineOfMCP/BaselineOfMCP.class.st +++ b/src/BaselineOfMCP/BaselineOfMCP.class.st @@ -19,17 +19,17 @@ BaselineOfMCP >> defineDependencies: spec [ spec baseline: 'PharoCompatibility' with: [ - spec - repository: 'github://Evref-BL/PharoCompatibility:main/src'; - loads: #( 'Pharo13Surface' ) ]; + spec + repository: 'github://Evref-BL/PharoCompatibility:main/src'; + loads: #( 'Pharo13Surface' ) ]; baseline: 'JRPC' with: [ - spec - repository: 'github://juliendelplanque/JRPC:v3.2.1/src'; - loads: #( 'Deployment' ) ]. + spec + repository: 'github://juliendelplanque/JRPC:v3.2.1/src'; + loads: #( 'Deployment' ) ]. spec baseline: 'TinyLogger' with: [ - spec - repository: 'github://jecisc/TinyLogger:v1.x.x/src'; - loads: #( 'Core' ) ] + spec + repository: 'github://jecisc/TinyLogger:v1.x.x/src'; + loads: #( 'Core' ) ] ] { #category : 'baselines' } diff --git a/src/MCP-Spec-Tests/MCPMonitoringStateTest.class.st b/src/MCP-Spec-Tests/MCPMonitoringStateTest.class.st index 912e11d..f7cdcda 100644 --- a/src/MCP-Spec-Tests/MCPMonitoringStateTest.class.st +++ b/src/MCP-Spec-Tests/MCPMonitoringStateTest.class.st @@ -150,12 +150,12 @@ MCPMonitoringStateTest >> testOutlierExplanationUsesPriorAverage [ stats := MCPToolCallStats forToolNamed: 'slow-tool'. start := DateAndTime now. 1 to: 3 do: [ :index | - record := MCPToolCallRecord - id: index - toolName: 'slow-tool' - startedAt: start. - record finishAt: start durationMilliseconds: 10 status: 'ok'. - stats recordCall: record ]. + record := MCPToolCallRecord + id: index + toolName: 'slow-tool' + startedAt: start. + record finishAt: start durationMilliseconds: 10 status: 'ok'. + stats recordCall: record ]. explanation := state outlierExplanationForDurationMilliseconds: 25 diff --git a/src/MCP-Spec/MCPDashboardPresenter.class.st b/src/MCP-Spec/MCPDashboardPresenter.class.st index 842c963..cdd226f 100644 --- a/src/MCP-Spec/MCPDashboardPresenter.class.st +++ b/src/MCP-Spec/MCPDashboardPresenter.class.st @@ -87,9 +87,9 @@ MCPDashboardPresenter >> addSectionLayout: aSectionLayout expanded: expanded to: MCPDashboardPresenter >> applyConfiguration [ [ - | newPort | - newPort := self readPortFromInput. - self model configurePort: newPort debugMode: debugCheckBox state ] + | newPort | + newPort := self readPortFromInput. + self model configurePort: newPort debugMode: debugCheckBox state ] on: Error do: [ :error | UIManager default alert: error messageText ]. @@ -121,9 +121,9 @@ MCPDashboardPresenter >> autoRefreshIntervalSeconds [ MCPDashboardPresenter >> autoRefreshLoop [ [ - [ self shouldAutoRefresh ] whileTrue: [ - (Delay forSeconds: self autoRefreshIntervalSeconds) wait. - self shouldAutoRefresh ifTrue: [ self defer: [ self refreshView ] ] ] ] + [ self shouldAutoRefresh ] whileTrue: [ + (Delay forSeconds: self autoRefreshIntervalSeconds) wait. + self shouldAutoRefresh ifTrue: [ self defer: [ self refreshView ] ] ] ] ensure: [ autoRefreshProcess := nil ] ] @@ -195,11 +195,11 @@ MCPDashboardPresenter >> dashboardWidgetsLayout [ (self isToolsSectionExpanded and: [ self hasExpandedMonitoringSection ]) ifTrue: [ - ^ SpPanedLayout newTopToBottom - positionOfSlider: 42 percent; - first: self toolsWidgetLayout; - second: self monitoringWidgetsLayout; - yourself ]. + ^ SpPanedLayout newTopToBottom + positionOfSlider: 42 percent; + first: self toolsWidgetLayout; + second: self monitoringWidgetsLayout; + yourself ]. ^ self dashboardWidgetsBoxLayout ] @@ -226,14 +226,14 @@ MCPDashboardPresenter >> defaultLayout [ MCPDashboardPresenter >> disclosureLabelFor: title count: count expanded: expanded [ ^ String streamContents: [ :stream | - stream - nextPutAll: (expanded - ifTrue: [ '[-] ' ] - ifFalse: [ '[+] ' ]); - nextPutAll: title; - nextPutAll: ' ('; - print: count; - nextPut: $) ] + stream + nextPutAll: (expanded + ifTrue: [ '[-] ' ] + ifFalse: [ '[+] ' ]); + nextPutAll: title; + nextPutAll: ' ('; + print: count; + nextPut: $) ] ] { #category : 'collapsing' } @@ -535,7 +535,8 @@ MCPDashboardPresenter >> monitoringSectionsLayout [ second: self logsWidgetLayout; yourself); yourself ]. - self expandedMonitoringSectionCount = 2 ifTrue: [ ^ self twoExpandedMonitoringSectionsLayout ]. + self expandedMonitoringSectionCount = 2 ifTrue: [ + ^ self twoExpandedMonitoringSectionsLayout ]. ^ self monitoringWidgetsBoxLayout ] @@ -670,9 +671,9 @@ MCPDashboardPresenter >> restartServer [ MCPDashboardPresenter >> serverStatusIconNameForRunning: isRunning listening: isListening [ isRunning ifFalse: [ - ^ isListening - ifTrue: [ #testRed ] - ifFalse: [ #testNotRun ] ]. + ^ isListening + ifTrue: [ #testRed ] + ifFalse: [ #testNotRun ] ]. ^ isListening ifTrue: [ #testGreen ] ifFalse: [ #testRed ] @@ -690,9 +691,9 @@ MCPDashboardPresenter >> serverStatusLabelForRunning: isRunning listening: isLis MCPDashboardPresenter >> serverStatusValueForRunning: isRunning listening: isListening [ isRunning ifFalse: [ - ^ isListening - ifTrue: [ 'stopped, socket still listening' ] - ifFalse: [ 'stopped' ] ]. + ^ isListening + ifTrue: [ 'stopped, socket still listening' ] + ifFalse: [ 'stopped' ] ]. ^ isListening ifTrue: [ 'running' ] ifFalse: [ 'running, socket not listening' ] @@ -731,9 +732,9 @@ MCPDashboardPresenter >> statusRowLayout [ vAlignCenter; add: statusLabel expand: false; add: statusIcon withConstraints: [ :constraints | - constraints - width: 18; - height: 18 ]; + constraints + width: 18; + height: 18 ]; add: statusValueLabel expand: false; yourself ] @@ -814,12 +815,12 @@ MCPDashboardPresenter >> tracesContextMenu [ ^ self newMenu addGroup: [ :group | - group addItem: [ :item | - item - name: 'Inspect'; - description: 'Inspect the selected trace record'; - enabled: [ tracesTable selectedItem isNotNil ]; - action: [ self inspectSelectedTraceRecord ] ] ]; + group addItem: [ :item | + item + name: 'Inspect'; + description: 'Inspect the selected trace record'; + enabled: [ tracesTable selectedItem isNotNil ]; + action: [ self inspectSelectedTraceRecord ] ] ]; yourself ] diff --git a/src/MCP-Spec/MCPToolsCatalogPresenter.class.st b/src/MCP-Spec/MCPToolsCatalogPresenter.class.st index e4651d9..aaed334 100644 --- a/src/MCP-Spec/MCPToolsCatalogPresenter.class.st +++ b/src/MCP-Spec/MCPToolsCatalogPresenter.class.st @@ -29,12 +29,12 @@ MCPToolsCatalogPresenter >> addToolCatalogGroup: group to: contentLayout [ displayBold: [ :ignored | true ]. contentLayout add: heading expand: false. group value do: [ :toolClass | - contentLayout - add: (self toolCatalogCardFor: toolClass) - withConstraints: [ :constraints | - constraints - expand: false; - fill: true ] ] + contentLayout + add: (self toolCatalogCardFor: toolClass) + withConstraints: [ :constraints | + constraints + expand: false; + fill: true ] ] ] { #category : 'layout' } @@ -87,9 +87,9 @@ MCPToolsCatalogPresenter >> toolCatalogCardFor: toolClass [ width: self toolCatalogLeftColumnWidth; add: (self toolCatalogDescriptionPresenterFor: tool) withConstraints: [ :constraints | - constraints - expand: true; - fill: true ]. + constraints + expand: true; + fill: true ]. card layout: cardLayout. ^ card ] @@ -114,9 +114,9 @@ MCPToolsCatalogPresenter >> toolCatalogDescriptionPresenterFor: tool [ withoutScrollBars. descriptionLayout := SpBoxLayout newTopToBottom yourself. descriptionLayout add: description withConstraints: [ :constraints | - constraints - expand: true; - fill: true ]. + constraints + expand: true; + fill: true ]. descriptionCell layout: descriptionLayout. ^ descriptionCell ] diff --git a/src/MCP-Tests-Resources-Extensions/MCPCompiledMethodInfoTestTarget.extension.st b/src/MCP-Tests-Resources-Extensions/MCPCompiledMethodInfoTestTarget.extension.st index 400c6db..354ca14 100644 --- a/src/MCP-Tests-Resources-Extensions/MCPCompiledMethodInfoTestTarget.extension.st +++ b/src/MCP-Tests-Resources-Extensions/MCPCompiledMethodInfoTestTarget.extension.st @@ -1,5 +1,7 @@ Extension { #name : 'MCPCompiledMethodInfoTestTarget' } { #category : '*MCP-Tests-Resources-Extensions' } -MCPCompiledMethodInfoTestTarget >> extensionInfoTarget [ ^ 3 +MCPCompiledMethodInfoTestTarget >> extensionInfoTarget [ + + ^ 3 ] diff --git a/src/MCP-Tests-Resources-Extensions/MCPToolMethodMutationTestTarget.extension.st b/src/MCP-Tests-Resources-Extensions/MCPToolMethodMutationTestTarget.extension.st index 47b545a..bd59b11 100644 --- a/src/MCP-Tests-Resources-Extensions/MCPToolMethodMutationTestTarget.extension.st +++ b/src/MCP-Tests-Resources-Extensions/MCPToolMethodMutationTestTarget.extension.st @@ -1,5 +1,7 @@ Extension { #name : 'MCPToolMethodMutationTestTarget' } { #category : '*MCP-Tests-Resources-Extensions' } -MCPToolMethodMutationTestTarget >> extensionProtocolTarget [ ^ 99 +MCPToolMethodMutationTestTarget >> extensionProtocolTarget [ + + ^ 99 ] diff --git a/src/MCP-Tests-Resources/MCPCompiledMethodInfoTestTarget.class.st b/src/MCP-Tests-Resources/MCPCompiledMethodInfoTestTarget.class.st index bd91632..fd50081 100644 --- a/src/MCP-Tests-Resources/MCPCompiledMethodInfoTestTarget.class.st +++ b/src/MCP-Tests-Resources/MCPCompiledMethodInfoTestTarget.class.st @@ -9,9 +9,13 @@ Class { } { #category : 'tests' } -MCPCompiledMethodInfoTestTarget class >> classInfoTarget [ ^ 2 +MCPCompiledMethodInfoTestTarget class >> classInfoTarget [ + + ^ 2 ] { #category : 'tests' } -MCPCompiledMethodInfoTestTarget >> infoTarget [ ^ 1 +MCPCompiledMethodInfoTestTarget >> infoTarget [ + + ^ 1 ] diff --git a/src/MCP-Tests-Resources/MCPToolMethodMutationTestSender.class.st b/src/MCP-Tests-Resources/MCPToolMethodMutationTestSender.class.st index f267444..e8248ad 100644 --- a/src/MCP-Tests-Resources/MCPToolMethodMutationTestSender.class.st +++ b/src/MCP-Tests-Resources/MCPToolMethodMutationTestSender.class.st @@ -9,9 +9,13 @@ Class { } { #category : 'tests' } -MCPToolMethodMutationTestSender >> callClassTarget [ ^ MCPToolMethodMutationTestTarget buildValue: 'value' +MCPToolMethodMutationTestSender >> callClassTarget [ + + ^ MCPToolMethodMutationTestTarget buildValue: 'value' ] { #category : 'tests' } -MCPToolMethodMutationTestSender >> callInstanceTarget [ ^ MCPToolMethodMutationTestTarget new combine: 'first' with: 'second' +MCPToolMethodMutationTestSender >> callInstanceTarget [ + + ^ MCPToolMethodMutationTestTarget new combine: 'first' with: 'second' ] diff --git a/src/MCP-Tests-Resources/MCPToolMethodMutationTestTarget.class.st b/src/MCP-Tests-Resources/MCPToolMethodMutationTestTarget.class.st index df06428..40f8b49 100644 --- a/src/MCP-Tests-Resources/MCPToolMethodMutationTestTarget.class.st +++ b/src/MCP-Tests-Resources/MCPToolMethodMutationTestTarget.class.st @@ -9,17 +9,25 @@ Class { } { #category : 'tests' } -MCPToolMethodMutationTestTarget class >> buildValue: aString [ ^ 'Class-' , aString +MCPToolMethodMutationTestTarget class >> buildValue: aString [ + + ^ 'Class-' , aString ] { #category : 'tests' } -MCPToolMethodMutationTestTarget class >> classProtocolTarget [ ^ 7 +MCPToolMethodMutationTestTarget class >> classProtocolTarget [ + + ^ 7 ] { #category : 'tests' } -MCPToolMethodMutationTestTarget >> combine: first with: second [ ^ first , '-' , second +MCPToolMethodMutationTestTarget >> combine: first with: second [ + + ^ first , '-' , second ] { #category : 'tests' } -MCPToolMethodMutationTestTarget >> instanceProtocolTarget [ ^ 41 +MCPToolMethodMutationTestTarget >> instanceProtocolTarget [ + + ^ 41 ] diff --git a/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestSender.class.st b/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestSender.class.st index 607f6bf..e5bf6bc 100644 --- a/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestSender.class.st +++ b/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestSender.class.st @@ -9,5 +9,7 @@ Class { } { #category : 'tests' } -MCPToolRemoveMethodsTestSender >> sendProtectedRemovalTarget [ ^ MCPToolRemoveMethodsTestTarget new externallyReferencedBatchRemoval +MCPToolRemoveMethodsTestSender >> sendProtectedRemovalTarget [ + + ^ MCPToolRemoveMethodsTestTarget new externallyReferencedBatchRemoval ] diff --git a/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestTarget.class.st b/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestTarget.class.st index 8398ece..7e9da93 100644 --- a/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestTarget.class.st +++ b/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestTarget.class.st @@ -9,21 +9,31 @@ Class { } { #category : 'tests' } -MCPToolRemoveMethodsTestTarget class >> firstClassBatchRemoval [ ^ self secondClassBatchRemoval + 1 +MCPToolRemoveMethodsTestTarget class >> firstClassBatchRemoval [ + + ^ self secondClassBatchRemoval + 1 ] { #category : 'tests' } -MCPToolRemoveMethodsTestTarget class >> secondClassBatchRemoval [ ^ 7 +MCPToolRemoveMethodsTestTarget class >> secondClassBatchRemoval [ + + ^ 7 ] { #category : 'tests' } -MCPToolRemoveMethodsTestTarget >> externallyReferencedBatchRemoval [ ^ 5 +MCPToolRemoveMethodsTestTarget >> externallyReferencedBatchRemoval [ + + ^ 5 ] { #category : 'tests' } -MCPToolRemoveMethodsTestTarget >> firstBatchRemoval [ ^ self secondBatchRemoval + 1 +MCPToolRemoveMethodsTestTarget >> firstBatchRemoval [ + + ^ self secondBatchRemoval + 1 ] { #category : 'tests' } -MCPToolRemoveMethodsTestTarget >> secondBatchRemoval [ ^ 2 +MCPToolRemoveMethodsTestTarget >> secondBatchRemoval [ + + ^ 2 ] diff --git a/src/MCP-Tests/MCPChangeClassCommentCommandTest.class.st b/src/MCP-Tests/MCPChangeClassCommentCommandTest.class.st index 5efe46a..427a5b7 100644 --- a/src/MCP-Tests/MCPChangeClassCommentCommandTest.class.st +++ b/src/MCP-Tests/MCPChangeClassCommentCommandTest.class.st @@ -25,8 +25,8 @@ MCPChangeClassCommentCommandTest >> ensureTargetClass [ slots: #( ) classSlots: #( ). self withoutEpiceaDuring: [ - (self classNamed: self commentTargetClassName) comment: - 'original comment' ] + (self classNamed: self commentTargetClassName) comment: + 'original comment' ] ] { #category : 'private' } @@ -67,9 +67,9 @@ MCPChangeClassCommentCommandTest >> testMissingClassSignalsCommandError [ | error | error := self captureCommandError: [ - (MCPChangeClassCommentCommand - className: 'MCPChangeClassCommentCommandTestMissing' - classComment: 'ignored') execute ]. + (MCPChangeClassCommentCommand + className: 'MCPChangeClassCommentCommandTestMissing' + classComment: 'ignored') execute ]. self assert: error errorCode equals: #ClassNotFound. self assert: (error structuredDetails at: #className) diff --git a/src/MCP-Tests/MCPClassMutationRequestTest.class.st b/src/MCP-Tests/MCPClassMutationRequestTest.class.st index 444969f..6c78506 100644 --- a/src/MCP-Tests/MCPClassMutationRequestTest.class.st +++ b/src/MCP-Tests/MCPClassMutationRequestTest.class.st @@ -15,22 +15,22 @@ MCPClassMutationRequestTest >> testCreateRequestParsesDefinitionArguments [ | context request | request := MCPClassCreateRequest fromRequest: (MCPToolRequest new - tool: MCPToolCreateClass new; - arguments: { - (#className -> 'MCPGeneratedClass'). - (#superclassName -> 'Object'). - (#packageName -> 'MCP-Generated'). - (#tag -> 'Models'). - (#classComment -> 'Generated comment.'). - (#force -> true). - (#slots -> #( 'firstName' 'lastName' )). - (#classSlots -> #( 'defaultName' )). - (#traits -> #( 'TComparable' )). - (#classTraits -> #( 'TComparable classTrait' )). - (#sharedVariables -> #( 'Current' )). - (#sharedPools -> #( 'ChronologyConstants' )). - (#layout -> 'WeakLayout') } asDictionary; - yourself) + tool: MCPToolCreateClass new; + arguments: { + (#className -> 'MCPGeneratedClass'). + (#superclassName -> 'Object'). + (#packageName -> 'MCP-Generated'). + (#tag -> 'Models'). + (#classComment -> 'Generated comment.'). + (#force -> true). + (#slots -> #( 'firstName' 'lastName' )). + (#classSlots -> #( 'defaultName' )). + (#traits -> #( 'TComparable' )). + (#classTraits -> #( 'TComparable classTrait' )). + (#sharedVariables -> #( 'Current' )). + (#sharedPools -> #( 'ChronologyConstants' )). + (#layout -> 'WeakLayout') } asDictionary; + yourself) tool: MCPToolCreateClass new. self assert: request className equals: 'MCPGeneratedClass'. self assert: request superclassName equals: 'Object'. @@ -63,8 +63,8 @@ MCPClassMutationRequestTest >> testUpdateCommandResolvesOmittedMovePackageName [ request := MCPToolRequest new tool: tool; arguments: { - (#className -> self class name asString). - (#tag -> 'Requests') } asDictionary; + (#className -> self class name asString). + (#tag -> 'Requests') } asDictionary; yourself. mutationRequest := tool parsedRequestFromToolRequest: request. command := tool commandForRequest: mutationRequest. @@ -107,7 +107,6 @@ MCPClassMutationRequestTest >> testUpdateRequestParsesSlotArguments [ self assert: (context at: #slotName) equals: 'oldName'. self assert: (context at: #newSlotName) equals: 'newName'. self assert: (context at: #classSide) - ] { #category : 'tests' } @@ -139,7 +138,6 @@ MCPClassMutationRequestTest >> testUpdateRequestTracksSuppliedProperties [ self assert: (context at: #classComment) equals: ''. self assert: (context at: #slots) equals: #( ). self deny: (context includesKey: #classSlots) - ] { #category : 'tests' } @@ -157,7 +155,6 @@ MCPClassMutationRequestTest >> testUpdateRequestWithNoPatchArgumentsHasNoUpdates context := request requestedContext. self assert: context size equals: 1. self assert: (context at: #className) equals: 'ExistingClass' - ] { #category : 'private' } diff --git a/src/MCP-Tests/MCPCommandErrorTest.class.st b/src/MCP-Tests/MCPCommandErrorTest.class.st index 66afd3d..c952894 100644 --- a/src/MCP-Tests/MCPCommandErrorTest.class.st +++ b/src/MCP-Tests/MCPCommandErrorTest.class.st @@ -13,8 +13,8 @@ Class { MCPCommandErrorTest >> capture: aBlock [ ^ [ - aBlock value. - self fail: 'Expected MCPCommandError' ] + aBlock value. + self fail: 'Expected MCPCommandError' ] on: MCPCommandError do: [ :error | error ] ] @@ -24,8 +24,8 @@ MCPCommandErrorTest >> testClassAlreadyExistsErrorCarriesClassName [ | details error | error := self capture: [ - MCPCommandError signalClassAlreadyExistsNamed: - 'MCPCommandErrorTestExisting' ]. + MCPCommandError signalClassAlreadyExistsNamed: + 'MCPCommandErrorTestExisting' ]. details := error structuredDetails. self assert: error errorCode equals: #ClassAlreadyExists. self @@ -64,11 +64,11 @@ MCPCommandErrorTest >> testMissingMethodErrorCarriesClassSideAndSelector [ | details error | error := self capture: [ - MCPCommandError - signalMissingMethodInClassName: - 'MCPCommandErrorTestTarget' - classSide: true - selector: 'value' ]. + MCPCommandError + signalMissingMethodInClassName: + 'MCPCommandErrorTestTarget' + classSide: true + selector: 'value' ]. details := error structuredDetails. self assert: error errorCode equals: #MethodNotFound. self assert: (details at: #errorClass) equals: 'MCPCommandError'. @@ -108,9 +108,9 @@ MCPCommandErrorTest >> testMissingSuperclassErrorCarriesSuperclassName [ | details error | error := self capture: [ - MCPCommandError - signalMissingSuperclassNamed: 'MCPMissingSuperclass' - forClassNamed: 'MCPNewClass' ]. + MCPCommandError + signalMissingSuperclassNamed: 'MCPMissingSuperclass' + forClassNamed: 'MCPNewClass' ]. details := error structuredDetails. self assert: error errorCode equals: #SuperclassNotFound. self assert: (details at: #className) equals: 'MCPNewClass'. @@ -124,10 +124,10 @@ MCPCommandErrorTest >> testMissingTagErrorCarriesTagAndClassName [ | details error | error := self capture: [ - MCPCommandError - signalMissingTag: 'MissingTag' - packageName: 'MCP-Tests' - forClassNamed: 'MCPCommandErrorTestTarget' ]. + MCPCommandError + signalMissingTag: 'MissingTag' + packageName: 'MCP-Tests' + forClassNamed: 'MCPCommandErrorTestTarget' ]. details := error structuredDetails. self assert: error errorCode equals: #TagNotFound. self diff --git a/src/MCP-Tests/MCPCommandTestCase.class.st b/src/MCP-Tests/MCPCommandTestCase.class.st index 58a2f9d..01ea375 100644 --- a/src/MCP-Tests/MCPCommandTestCase.class.st +++ b/src/MCP-Tests/MCPCommandTestCase.class.st @@ -25,8 +25,8 @@ MCPCommandTestCase >> aroundCommandExecution: aBlock [ MCPCommandTestCase >> captureCommandError: aBlock [ ^ [ - self aroundCommandExecution: [ aBlock value ]. - self fail: 'Expected MCPCommandError' ] + self aroundCommandExecution: [ aBlock value ]. + self fail: 'Expected MCPCommandError' ] on: MCPCommandError do: [ :error | error ] ] diff --git a/src/MCP-Tests/MCPCompiledMethodInfoTest.class.st b/src/MCP-Tests/MCPCompiledMethodInfoTest.class.st index 73f69fd..cac571b 100644 --- a/src/MCP-Tests/MCPCompiledMethodInfoTest.class.st +++ b/src/MCP-Tests/MCPCompiledMethodInfoTest.class.st @@ -26,12 +26,12 @@ MCPCompiledMethodInfoTest >> createTargetClass [ self hasTargetClass ifTrue: [ ^ self ]. self withoutEpiceaDuring: [ - | builder | - builder := Object << self targetClassName asSymbol. - builder package: 'MCP-Tests'. - builder tag: 'Internal'. - builder slots: #( ). - builder install ] + | builder | + builder := Object << self targetClassName asSymbol. + builder package: 'MCP-Tests'. + builder tag: 'Internal'. + builder slots: #( ). + builder install ] ] { #category : 'private' } diff --git a/src/MCP-Tests/MCPCompiledMethodScopeQueryTest.class.st b/src/MCP-Tests/MCPCompiledMethodScopeQueryTest.class.st index d9edad0..0645a40 100644 --- a/src/MCP-Tests/MCPCompiledMethodScopeQueryTest.class.st +++ b/src/MCP-Tests/MCPCompiledMethodScopeQueryTest.class.st @@ -13,12 +13,12 @@ Class { MCPCompiledMethodScopeQueryTest >> methodIdentitiesFor: compiledMethods [ ^ (compiledMethods collect: [ :each | - String streamContents: [ :stream | - stream nextPutAll: each methodClass instanceSide name asString. - each methodClass isMeta ifTrue: [ stream nextPutAll: ' class' ]. - stream - nextPutAll: '>>'; - nextPutAll: each selector asString ] ]) asSet + String streamContents: [ :stream | + stream nextPutAll: each methodClass instanceSide name asString. + each methodClass isMeta ifTrue: [ stream nextPutAll: ' class' ]. + stream + nextPutAll: '>>'; + nextPutAll: each selector asString ] ]) asSet ] { #category : 'tests' } @@ -94,8 +94,8 @@ MCPCompiledMethodScopeQueryTest >> testInvalidSideSignalsErrorWhenQuerying [ side: 'invalid'; yourself. error := [ - query methods. - self fail: 'Expected Error' ] + query methods. + self fail: 'Expected Error' ] on: Error do: [ :caught | caught ]. self diff --git a/src/MCP-Tests/MCPCreateClassCommandTest.class.st b/src/MCP-Tests/MCPCreateClassCommandTest.class.st index 072f514..f8c21e0 100644 --- a/src/MCP-Tests/MCPCreateClassCommandTest.class.st +++ b/src/MCP-Tests/MCPCreateClassCommandTest.class.st @@ -29,10 +29,10 @@ MCPCreateClassCommandTest >> generatedPackageName [ MCPCreateClassCommandTest >> removeGeneratedPackage [ self withoutEpiceaDuring: [ - (self packageOrganizer hasPackage: self generatedPackageName) - ifTrue: [ - self packageOrganizer removePackage: - (self packageOrganizer packageNamed: self generatedPackageName) ] ] + (self packageOrganizer hasPackage: self generatedPackageName) + ifTrue: [ + self packageOrganizer removePackage: + (self packageOrganizer packageNamed: self generatedPackageName) ] ] ] { #category : 'running' } @@ -160,13 +160,13 @@ MCPCreateClassCommandTest >> testExistingClassSignalsCommandError [ slots: nil classSlots: nil). error := self captureCommandError: [ - (MCPCreateClassCommand - className: 'MCPCreateClassCommandTestGenerated' - superclassName: 'Object' - packageName: self generatedPackageName - tag: nil - slots: nil - classSlots: nil) execute ]. + (MCPCreateClassCommand + className: 'MCPCreateClassCommandTestGenerated' + superclassName: 'Object' + packageName: self generatedPackageName + tag: nil + slots: nil + classSlots: nil) execute ]. self assert: error errorCode equals: #ClassAlreadyExists. self assert: (error structuredDetails at: #className) @@ -178,13 +178,13 @@ MCPCreateClassCommandTest >> testMissingSuperclassSignalsCommandError [ | error | error := self captureCommandError: [ - (MCPCreateClassCommand - className: 'MCPCreateClassCommandTestGenerated' - superclassName: 'DefinitelyMissingSuperclass' - packageName: self generatedPackageName - tag: nil - slots: nil - classSlots: nil) execute ]. + (MCPCreateClassCommand + className: 'MCPCreateClassCommandTestGenerated' + superclassName: 'DefinitelyMissingSuperclass' + packageName: self generatedPackageName + tag: nil + slots: nil + classSlots: nil) execute ]. self assert: error errorCode equals: #SuperclassNotFound. self assert: (error structuredDetails at: #superclassName) diff --git a/src/MCP-Tests/MCPDebugToolContractTest.class.st b/src/MCP-Tests/MCPDebugToolContractTest.class.st index e9b9f9f..800534a 100644 --- a/src/MCP-Tests/MCPDebugToolContractTest.class.st +++ b/src/MCP-Tests/MCPDebugToolContractTest.class.st @@ -90,8 +90,8 @@ MCPDebugToolContractTest >> registerSyntheticSession [ { #category : 'private' } MCPDebugToolContractTest >> removeDebugMethodUpdateTestMethods [ - #( #mcpDebugMethodUpdateGeneratedValue #mcpDebugMethodUpdateTemporaryStub ) do: [ - :selector | + #( #mcpDebugMethodUpdateGeneratedValue + #mcpDebugMethodUpdateTemporaryStub ) do: [ :selector | (MCPUpdateDebugMethodTestTarget includesSelector: selector) ifTrue: [ MCPUpdateDebugMethodTestTarget removeSelector: selector ] ]. Smalltalk globals @@ -821,10 +821,12 @@ MCPDebugToolContractTest >> testDebugEvaluateEvaluatesExpressionInSelectedFrame record := self registerSyntheticSession. stateData := self stateDataForRecord: record. frameRef := (stateData at: #selectedFrame) at: #frameRef. - result := self callToolNamed: 'debug_expression_evaluate' withArguments: { - (#sessionId -> record sessionId). - (#frameRef -> frameRef). - (#expression -> 'self class name') } asDictionary. + result := self + callToolNamed: 'debug_expression_evaluate' + withArguments: { + (#sessionId -> record sessionId). + (#frameRef -> frameRef). + (#expression -> 'self class name') } asDictionary. data := self dataFrom: result. self assert: ((self structuredContentFrom: result) at: #status) @@ -852,10 +854,12 @@ MCPDebugToolContractTest >> testDebugEvaluateReadsTemporaryInSelectedFrame [ reason: 'halt'. stateData := self stateDataForRecord: record. frameRef := (stateData at: #selectedFrame) at: #frameRef. - result := self callToolNamed: 'debug_expression_evaluate' withArguments: { - (#sessionId -> record sessionId). - (#frameRef -> frameRef). - (#expression -> 'marker + 1') } asDictionary. + result := self + callToolNamed: 'debug_expression_evaluate' + withArguments: { + (#sessionId -> record sessionId). + (#frameRef -> frameRef). + (#expression -> 'marker + 1') } asDictionary. data := self dataFrom: result. self assert: ((self structuredContentFrom: result) at: #status) @@ -870,13 +874,15 @@ MCPDebugToolContractTest >> testDebugEvaluateRejectsForeignFrameRef [ | error foreignRecord record result | record := self registerSyntheticSession. foreignRecord := self registerSyntheticSession. - result := self callToolNamed: 'debug_expression_evaluate' withArguments: { - (#sessionId -> record sessionId). - (#frameRef - -> - (foreignRecord sessionId , '/' , foreignRecord stateId - , '/frame-0')). - (#expression -> '1') } asDictionary. + result := self + callToolNamed: 'debug_expression_evaluate' + withArguments: { + (#sessionId -> record sessionId). + (#frameRef + -> + (foreignRecord sessionId , '/' , foreignRecord stateId + , '/frame-0')). + (#expression -> '1') } asDictionary. error := self errorFrom: result. self assert: ((self structuredContentFrom: result) at: #status) @@ -895,10 +901,12 @@ MCPDebugToolContractTest >> testDebugEvaluateRejectsStaleFrameRef [ | record result error | record := self registerSyntheticSession. - result := self callToolNamed: 'debug_expression_evaluate' withArguments: { - (#sessionId -> record sessionId). - (#frameRef -> (record sessionId , '/old-state/frame-0')). - (#expression -> '1') } asDictionary. + result := self + callToolNamed: 'debug_expression_evaluate' + withArguments: { + (#sessionId -> record sessionId). + (#frameRef -> (record sessionId , '/old-state/frame-0')). + (#expression -> '1') } asDictionary. error := self errorFrom: result. self assert: ((self structuredContentFrom: result) at: #status) @@ -939,10 +947,12 @@ MCPDebugToolContractTest >> testDebugEvaluateReportsSyntaxFailure [ record := self registerSyntheticSession. stateData := self stateDataForRecord: record. frameRef := (stateData at: #selectedFrame) at: #frameRef. - result := self callToolNamed: 'debug_expression_evaluate' withArguments: { - (#sessionId -> record sessionId). - (#frameRef -> frameRef). - (#expression -> '1 +') } asDictionary. + result := self + callToolNamed: 'debug_expression_evaluate' + withArguments: { + (#sessionId -> record sessionId). + (#frameRef -> frameRef). + (#expression -> '1 +') } asDictionary. error := self errorFrom: result. self assert: ((self structuredContentFrom: result) at: #status) @@ -1503,7 +1513,8 @@ MCPDebugToolContractTest >> testDebugStateOffersMissingMethodRepairAction [ | action arguments data result state | result := self callToolNamed: 'debug_capture' withArguments: { (#expression - -> 'MCPUpdateDebugMethodTestTarget new triggerMissingMethod'). + -> + 'MCPUpdateDebugMethodTestTarget new triggerMissingMethod'). (#name -> 'Captured missing method'). (#timeoutMilliseconds -> 1000) } asDictionary. data := self dataFrom: result. diff --git a/src/MCP-Tests/MCPHaltingTestTool.class.st b/src/MCP-Tests/MCPHaltingTestTool.class.st index 96536bf..1b25d48 100644 --- a/src/MCP-Tests/MCPHaltingTestTool.class.st +++ b/src/MCP-Tests/MCPHaltingTestTool.class.st @@ -25,11 +25,11 @@ MCPHaltingTestTool class >> toolName [ MCPHaltingTestTool >> buildInputSchema [ ^ MCPStructureInputSchema new - type: 'object'; - properties: #( ); - required: #( ); - additionalProperties: false; - yourself + type: 'object'; + properties: #( ); + required: #( ); + additionalProperties: false; + yourself ] { #category : 'metadata' } diff --git a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st index 507a410..c96f444 100644 --- a/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st +++ b/src/MCP-Tests/MCPJSONSchemaValidatorTest.class.st @@ -423,7 +423,6 @@ MCPJSONSchemaValidatorTest >> testValidatesAllOfAndIfThen [ keywords := self keywordsFrom: (self violationsFor: arguments schema: schema). self assert: keywords equals: #( 'required' ) - ] { #category : 'tests' } @@ -451,7 +450,6 @@ MCPJSONSchemaValidatorTest >> testValidatesArrayItemsEnumAndConst [ self assert: (self keywordsFrom: violations) asBag equals: #( 'enum' 'const' 'type' ) asBag - ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPMoveClassCommandTest.class.st b/src/MCP-Tests/MCPMoveClassCommandTest.class.st index 169d06c..65a7d5b 100644 --- a/src/MCP-Tests/MCPMoveClassCommandTest.class.st +++ b/src/MCP-Tests/MCPMoveClassCommandTest.class.st @@ -31,10 +31,10 @@ MCPMoveClassCommandTest >> destinationTagName [ MCPMoveClassCommandTest >> ensureDestinationPackage [ self withoutEpiceaDuring: [ - | package | - package := PackageOrganizer default ensurePackage: - self destinationPackageName. - package ensureTag: self destinationTagName ] + | package | + package := PackageOrganizer default ensurePackage: + self destinationPackageName. + package ensureTag: self destinationTagName ] ] { #category : 'private' } @@ -47,11 +47,11 @@ MCPMoveClassCommandTest >> originalPackageName [ MCPMoveClassCommandTest >> removeDestinationPackage [ self withoutEpiceaDuring: [ - (PackageOrganizer default hasPackage: self destinationPackageName) - ifTrue: [ - PackageOrganizer default removePackage: - (PackageOrganizer default packageNamed: - self destinationPackageName) ] ] + (PackageOrganizer default hasPackage: self destinationPackageName) + ifTrue: [ + PackageOrganizer default removePackage: + (PackageOrganizer default packageNamed: + self destinationPackageName) ] ] ] { #category : 'private' } @@ -61,9 +61,9 @@ MCPMoveClassCommandTest >> restoreTargetClassLocation [ and: [ self currentTagOfTargetClass = 'Uncategorized' ]) ifTrue: [ ^ self ]. self withoutEpiceaDuring: [ - (RBMoveClassTransformation - move: self targetClassName - toPackage: self originalPackageName) execute ] + (RBMoveClassTransformation + move: self targetClassName + toPackage: self originalPackageName) execute ] ] { #category : 'running' } diff --git a/src/MCP-Tests/MCPRecordingMetacello.class.st b/src/MCP-Tests/MCPRecordingMetacello.class.st index 8d43974..19c7706 100644 --- a/src/MCP-Tests/MCPRecordingMetacello.class.st +++ b/src/MCP-Tests/MCPRecordingMetacello.class.st @@ -141,8 +141,8 @@ MCPRecordingMetacello >> received: selector [ MCPRecordingMetacello >> received: selector withArguments: arguments [ ^ messages anySatisfy: [ :each | - (each at: #selector) = selector and: [ - (each at: #arguments) = arguments asArray ] ] + (each at: #selector) = selector and: [ + (each at: #arguments) = arguments asArray ] ] ] { #category : 'recording' } diff --git a/src/MCP-Tests/MCPRemoveClassesCommandTest.class.st b/src/MCP-Tests/MCPRemoveClassesCommandTest.class.st index af4e9f9..3a83299 100644 --- a/src/MCP-Tests/MCPRemoveClassesCommandTest.class.st +++ b/src/MCP-Tests/MCPRemoveClassesCommandTest.class.st @@ -30,13 +30,13 @@ MCPRemoveClassesCommandTest >> createClassNamed: aClassName superclassName: aSup MCPRemoveClassesCommandTest >> createClassNamed: aClassName superclassName: aSuperclassName packageName: aPackageName [ ^ self withoutEpiceaDuring: [ - | builder superclass | - superclass := self classNamed: aSuperclassName. - builder := superclass << aClassName asSymbol. - builder package: aPackageName. - builder tag: 'Internal'. - builder slots: #( ). - builder install ] + | builder superclass | + superclass := self classNamed: aSuperclassName. + builder := superclass << aClassName asSymbol. + builder package: aPackageName. + builder tag: 'Internal'. + builder slots: #( ). + builder install ] ] { #category : 'private' } @@ -79,9 +79,9 @@ MCPRemoveClassesCommandTest >> ensureFixtureClasses [ MCPRemoveClassesCommandTest >> ensureMethodSource: aMethodSource onClassNamed: aClassName [ self withoutEpiceaDuring: [ - (self classNamed: aClassName) - compile: aMethodSource - classified: 'tests' ] + (self classNamed: aClassName) + compile: aMethodSource + classified: 'tests' ] ] { #category : 'private' } @@ -188,9 +188,9 @@ MCPRemoveClassesCommandTest >> testMissingClassSignalsCommandError [ | error | error := self captureCommandError: [ - (MCPRemoveClassesCommand classNames: { - self simpleClassName. - self missingClassName }) execute ]. + (MCPRemoveClassesCommand classNames: { + self simpleClassName. + self missingClassName }) execute ]. self assert: error errorCode equals: #ClassNotFound. self assert: (error structuredDetails at: #className) diff --git a/src/MCP-Tests/MCPRenameClassCommandTest.class.st b/src/MCP-Tests/MCPRenameClassCommandTest.class.st index f1bfb06..d36c8e8 100644 --- a/src/MCP-Tests/MCPRenameClassCommandTest.class.st +++ b/src/MCP-Tests/MCPRenameClassCommandTest.class.st @@ -16,14 +16,14 @@ MCPRenameClassCommandTest >> ensureOriginalFixtureState [ originalSymbol := self originalClassName asSymbol. renamedSymbol := self renamedClassName asSymbol. self withoutEpiceaDuring: [ - ((Smalltalk globals includesKey: originalSymbol) and: [ - Smalltalk globals includesKey: renamedSymbol ]) ifTrue: [ - (Smalltalk globals at: renamedSymbol) removeFromSystem ]. - ((Smalltalk globals includesKey: renamedSymbol) and: [ - (Smalltalk globals includesKey: originalSymbol) not ]) ifTrue: [ - (ReRenameClassRefactoring - rename: self renamedClassName - to: self originalClassName) execute ] ] + ((Smalltalk globals includesKey: originalSymbol) and: [ + Smalltalk globals includesKey: renamedSymbol ]) ifTrue: [ + (Smalltalk globals at: renamedSymbol) removeFromSystem ]. + ((Smalltalk globals includesKey: renamedSymbol) and: [ + (Smalltalk globals includesKey: originalSymbol) not ]) ifTrue: [ + (ReRenameClassRefactoring + rename: self renamedClassName + to: self originalClassName) execute ] ] ] { #category : 'private' } @@ -57,9 +57,9 @@ MCPRenameClassCommandTest >> testMissingClassSignalsCommandError [ | error | error := self captureCommandError: [ - (MCPRenameClassCommand - className: 'MCPRenameClassCommandTestMissing' - newClassName: self renamedClassName) execute ]. + (MCPRenameClassCommand + className: 'MCPRenameClassCommandTestMissing' + newClassName: self renamedClassName) execute ]. self assert: error errorCode equals: #ClassNotFound. self assert: (error structuredDetails at: #className) diff --git a/src/MCP-Tests/MCPReparentClassCommandTest.class.st b/src/MCP-Tests/MCPReparentClassCommandTest.class.st index 153c649..55172f7 100644 --- a/src/MCP-Tests/MCPReparentClassCommandTest.class.st +++ b/src/MCP-Tests/MCPReparentClassCommandTest.class.st @@ -28,8 +28,8 @@ MCPReparentClassCommandTest >> ensureFixtureClasses [ protocol: 'testing' on: (self classNamed: self reparentTargetClassName). self withoutEpiceaDuring: [ - (self classNamed: self reparentTargetClassName) comment: - 'reparent comment' ] + (self classNamed: self reparentTargetClassName) comment: + 'reparent comment' ] ] { #category : 'private' } @@ -78,9 +78,9 @@ MCPReparentClassCommandTest >> testMissingClassSignalsCommandError [ | error | error := self captureCommandError: [ - (MCPReparentClassCommand - className: 'MCPReparentClassCommandTestMissing' - superclassName: self reparentSuperclassName) execute ]. + (MCPReparentClassCommand + className: 'MCPReparentClassCommandTestMissing' + superclassName: self reparentSuperclassName) execute ]. self assert: error errorCode equals: #ClassNotFound. self assert: (error structuredDetails at: #className) @@ -92,9 +92,9 @@ MCPReparentClassCommandTest >> testMissingSuperclassSignalsCommandError [ | error | error := self captureCommandError: [ - (MCPReparentClassCommand - className: self reparentTargetClassName - superclassName: 'DefinitelyMissingSuperclass') execute ]. + (MCPReparentClassCommand + className: self reparentTargetClassName + superclassName: 'DefinitelyMissingSuperclass') execute ]. self assert: error errorCode equals: #SuperclassNotFound. self assert: (error structuredDetails at: #superclassName) diff --git a/src/MCP-Tests/MCPRepositorySpecTest.class.st b/src/MCP-Tests/MCPRepositorySpecTest.class.st index ae75df9..7e70f55 100644 --- a/src/MCP-Tests/MCPRepositorySpecTest.class.st +++ b/src/MCP-Tests/MCPRepositorySpecTest.class.st @@ -299,16 +299,16 @@ MCPRepositorySpecTest >> testRepositoryReferenceResolvesByNameAndLocation [ location: FileLocator imageDirectory packageNames: #( 'MCP' ). 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: #location) - equals: FileLocator imageDirectory pathString ] + 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: #location) + equals: FileLocator imageDirectory pathString ] ] { #category : 'tests' } @@ -375,15 +375,16 @@ MCPRepositorySpecTest >> testRepositoryVerifyIdentityRequestParsesTypedInput [ | context verifyIdentityRequest | verifyIdentityRequest := MCPRepositoryVerifyIdentityRequest - fromRequest: (self requestWithArguments: { - (#repositoryName -> 'MCP Repo'). - (#location -> '/tmp/MCP'). - (#branchName -> 'main'). - (#subdirectory -> 'src'). - (#packageNames -> #( 'MCP' 'MCP-Tests' )). - (#modifiedPackageNames -> #( 'MCP' )). - (#isModified -> true) } asDictionary) - tool: nil. + fromRequest: (self requestWithArguments: { + (#repositoryName -> 'MCP Repo'). + (#location -> '/tmp/MCP'). + (#branchName -> 'main'). + (#subdirectory -> 'src'). + (#packageNames + -> #( 'MCP' 'MCP-Tests' )). + (#modifiedPackageNames -> #( 'MCP' )). + (#isModified -> true) } asDictionary) + tool: nil. context := verifyIdentityRequest requestedContext. self assert: verifyIdentityRequest operation equals: 'verifyIdentity'. self @@ -431,9 +432,9 @@ MCPRepositorySpecTest >> withRepositories: repositories do: aBlock [ registry := IceRepository registry. previousRepositories := registry copy. [ - registry removeAll. - registry addAll: repositories. - aBlock value ] ensure: [ registry removeAll. - registry addAll: previousRepositories ] + registry addAll: repositories. + aBlock value ] ensure: [ + registry removeAll. + registry addAll: previousRepositories ] ] diff --git a/src/MCP-Tests/MCPTestCase.class.st b/src/MCP-Tests/MCPTestCase.class.st index 1dd9aa0..7c182c9 100644 --- a/src/MCP-Tests/MCPTestCase.class.st +++ b/src/MCP-Tests/MCPTestCase.class.st @@ -25,14 +25,14 @@ MCPTestCase >> classNamed: aClassName [ MCPTestCase >> createClassNamed: aClassName superclassName: aSuperclassName slots: someSlots classSlots: someClassSlots [ ^ self withoutEpiceaDuring: [ - | builder superclass | - superclass := self classNamed: aSuperclassName. - builder := superclass << aClassName asSymbol. - builder package: 'MCP-Tests'. - builder tag: 'Internal'. - builder slots: someSlots. - builder classSlots: someClassSlots. - builder install ] + | builder superclass | + superclass := self classNamed: aSuperclassName. + builder := superclass << aClassName asSymbol. + builder package: 'MCP-Tests'. + builder tag: 'Internal'. + builder slots: someSlots. + builder classSlots: someClassSlots. + builder install ] ] { #category : 'private - methods' } @@ -56,24 +56,24 @@ MCPTestCase >> removeClassNamed: aClassName [ | classSymbol | classSymbol := aClassName asSymbol. self withoutEpiceaDuring: [ - (Smalltalk globals includesKey: classSymbol) ifTrue: [ - (Smalltalk globals at: classSymbol) removeFromSystem ] ] + (Smalltalk globals includesKey: classSymbol) ifTrue: [ + (Smalltalk globals at: classSymbol) removeFromSystem ] ] ] { #category : 'private - packages' } MCPTestCase >> removePackageNamed: aPackageName [ self withoutEpiceaDuring: [ - (PackageOrganizer default hasPackage: aPackageName) ifTrue: [ - PackageOrganizer default removePackage: aPackageName ] ] + (PackageOrganizer default hasPackage: aPackageName) ifTrue: [ + PackageOrganizer default removePackage: aPackageName ] ] ] { #category : 'private - methods' } MCPTestCase >> removeSelector: aSelector from: aBehavior [ self withoutEpiceaDuring: [ - (aBehavior includesSelector: aSelector) ifTrue: [ - aBehavior removeSelector: aSelector ] ] + (aBehavior includesSelector: aSelector) ifTrue: [ + aBehavior removeSelector: aSelector ] ] ] { #category : 'private - execution' } diff --git a/src/MCP-Tests/MCPTestIceRepository.class.st b/src/MCP-Tests/MCPTestIceRepository.class.st index 5d261ec..5d9b88e 100644 --- a/src/MCP-Tests/MCPTestIceRepository.class.st +++ b/src/MCP-Tests/MCPTestIceRepository.class.st @@ -266,10 +266,10 @@ MCPTestIceRepository >> remoteNames: aCollection [ MCPTestIceRepository >> remotes [ ^ self remoteNames collect: [ :each | - MCPTestRepositoryRemote - named: each - repository: self - shouldFail: self failFetch ] + MCPTestRepositoryRemote + named: each + repository: self + shouldFail: self failFetch ] ] { #category : 'private' } diff --git a/src/MCP-Tests/MCPToolChangeHistoryTest.class.st b/src/MCP-Tests/MCPToolChangeHistoryTest.class.st index bc397f2..026b0fa 100644 --- a/src/MCP-Tests/MCPToolChangeHistoryTest.class.st +++ b/src/MCP-Tests/MCPToolChangeHistoryTest.class.st @@ -25,15 +25,18 @@ MCPToolChangeHistoryTest >> callToolWith: someArguments [ toolClass := Dictionary new at: 'listFiles' put: MCPToolListChangeHistoryFiles; at: 'listEntries' put: MCPToolListChangeHistoryEntries; - at: 'applyEntries' put: MCPToolApplyChangeHistoryEntries; - at: 'revertEntries' put: MCPToolRevertChangeHistoryEntries; + at: 'applyEntries' + put: MCPToolApplyChangeHistoryEntries; + at: 'revertEntries' + put: MCPToolRevertChangeHistoryEntries; at: action - ifAbsent: [ Error signal: 'Unknown change history action: ' , action asString ]. + ifAbsent: [ + Error signal: + 'Unknown change history action: ' , action asString ]. tool := toolClass new. request := tool requestFromToolCallArguments: arguments. result := tool executeWithRequest: request. ^ result asJRPCJSON - ] { #category : 'private' } @@ -56,8 +59,8 @@ MCPToolChangeHistoryTest >> latestRecoverableMethodEntryIndexFor: aClass [ | foundIndex | EpMonitor current log refresh. EpMonitor current log entries doWithIndex: [ :entry :index | - (self isRecoverableMethodEntry: entry forClass: aClass) ifTrue: [ - foundIndex := index ] ]. + (self isRecoverableMethodEntry: entry forClass: aClass) ifTrue: [ + foundIndex := index ] ]. foundIndex ifNil: [ self fail: 'Expected recoverable method entry in change history.' ]. ^ foundIndex @@ -67,9 +70,9 @@ MCPToolChangeHistoryTest >> latestRecoverableMethodEntryIndexFor: aClass [ MCPToolChangeHistoryTest >> recordMethodAdditionOn: aClass [ ^ PharoCompatibility withNonInteractiveAuthorNamed: 'MCP' during: [ - aClass compile: 'rescuedValue ^ 42' classified: 'testing'. - EpMonitor current sessionStore flush. - self latestRecoverableMethodEntryIndexFor: aClass ] + aClass compile: 'rescuedValue ^ 42' classified: 'testing'. + EpMonitor current sessionStore flush. + self latestRecoverableMethodEntryIndexFor: aClass ] ] { #category : 'private' } @@ -85,41 +88,41 @@ MCPToolChangeHistoryTest >> recordRecoverableMethodAdditionOn: aClass [ MCPToolChangeHistoryTest >> testApplyEntriesAppliesConfirmedChanges [ self withTemporaryRecoveryClassDo: [ :class | - | data entryIndex result | - entryIndex := self recordRecoverableMethodAdditionOn: class. - self deny: (class includesSelector: #rescuedValue). - result := self callToolWith: { - (#action -> 'applyEntries'). - (#indexes -> { entryIndex }). - (#confirm -> true) } asDictionary. - data := self dataFrom: result. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (data at: #action) equals: 'apply'. - self assert: (data at: #performed). - self assert: (data at: #performedCount) equals: 1. - self assert: (class includesSelector: #rescuedValue). - self - assert: (class >> #rescuedValue) sourceCode - equals: 'rescuedValue ^ 42' ] + | data entryIndex result | + entryIndex := self recordRecoverableMethodAdditionOn: class. + self deny: (class includesSelector: #rescuedValue). + result := self callToolWith: { + (#action -> 'applyEntries'). + (#indexes -> { entryIndex }). + (#confirm -> true) } asDictionary. + data := self dataFrom: result. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #action) equals: 'apply'. + self assert: (data at: #performed). + self assert: (data at: #performedCount) equals: 1. + self assert: (class includesSelector: #rescuedValue). + self + assert: (class >> #rescuedValue) sourceCode + equals: 'rescuedValue ^ 42' ] ] { #category : 'tests' } MCPToolChangeHistoryTest >> testApplyEntriesPreviewsChanges [ self withTemporaryRecoveryClassDo: [ :class | - | data entryIndex previewEntry result | - entryIndex := self recordRecoverableMethodAdditionOn: class. - result := self callToolWith: { - (#action -> 'applyEntries'). - (#indexes -> { entryIndex }) } asDictionary. - data := self dataFrom: result. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (data at: #action) equals: 'apply'. - self assert: (data at: #selectedCount) equals: 1. - self assert: (data at: #previewCount) equals: 1. - self deny: (data at: #performed). - previewEntry := (data at: #previewEntries) first. - self assert: (previewEntry at: #selector) equals: 'rescuedValue' ] + | data entryIndex previewEntry result | + entryIndex := self recordRecoverableMethodAdditionOn: class. + result := self callToolWith: { + (#action -> 'applyEntries'). + (#indexes -> { entryIndex }) } asDictionary. + data := self dataFrom: result. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #action) equals: 'apply'. + self assert: (data at: #selectedCount) equals: 1. + self assert: (data at: #previewCount) equals: 1. + self deny: (data at: #performed). + previewEntry := (data at: #previewEntries) first. + self assert: (previewEntry at: #selector) equals: 'rescuedValue' ] ] { #category : 'tests' } @@ -171,20 +174,20 @@ MCPToolChangeHistoryTest >> testApplyEntriesRequiresSelectionCriteria [ MCPToolChangeHistoryTest >> testApplyEntriesWithoutConfirmOnlyPreviews [ self withTemporaryRecoveryClassDo: [ :class | - | data entryIndex result | - entryIndex := self recordRecoverableMethodAdditionOn: class. - self deny: (class includesSelector: #rescuedValue). - result := self callToolWith: { - (#action -> 'applyEntries'). - (#indexes -> { entryIndex }). - (#confirm -> false) } asDictionary. - data := self dataFrom: result. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (data at: #action) equals: 'apply'. - self deny: (data at: #performed). - self assert: (data at: #performedCount) equals: 0. - self assert: (data at: #previewCount) equals: 1. - self deny: (class includesSelector: #rescuedValue) ] + | data entryIndex result | + entryIndex := self recordRecoverableMethodAdditionOn: class. + self deny: (class includesSelector: #rescuedValue). + result := self callToolWith: { + (#action -> 'applyEntries'). + (#indexes -> { entryIndex }). + (#confirm -> false) } asDictionary. + data := self dataFrom: result. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #action) equals: 'apply'. + self deny: (data at: #performed). + self assert: (data at: #performedCount) equals: 0. + self assert: (data at: #previewCount) equals: 1. + self deny: (class includesSelector: #rescuedValue) ] ] { #category : 'tests' } @@ -370,19 +373,19 @@ MCPToolChangeHistoryTest >> testNonCodeEntryDictionaryOmitsAbsentFields [ MCPToolChangeHistoryTest >> testRevertEntriesRevertsConfirmedChanges [ self withTemporaryRecoveryClassDo: [ :class | - | data entryIndex result | - entryIndex := self recordMethodAdditionOn: class. - self assert: (class includesSelector: #rescuedValue). - result := self callToolWith: { - (#action -> 'revertEntries'). - (#indexes -> { entryIndex }). - (#confirm -> true) } asDictionary. - data := self dataFrom: result. - self deny: (result at: #isError ifAbsent: [ false ]). - self assert: (data at: #action) equals: 'revert'. - self assert: (data at: #performed). - self assert: (data at: #performedCount) equals: 1. - self deny: (class includesSelector: #rescuedValue) ] + | data entryIndex result | + entryIndex := self recordMethodAdditionOn: class. + self assert: (class includesSelector: #rescuedValue). + result := self callToolWith: { + (#action -> 'revertEntries'). + (#indexes -> { entryIndex }). + (#confirm -> true) } asDictionary. + data := self dataFrom: result. + self deny: (result at: #isError ifAbsent: [ false ]). + self assert: (data at: #action) equals: 'revert'. + self assert: (data at: #performed). + self assert: (data at: #performedCount) equals: 1. + self deny: (class includesSelector: #rescuedValue) ] ] { #category : 'tests' } @@ -412,7 +415,6 @@ MCPToolChangeHistoryTest >> testSelectionResultRequestsImageSaveOnlyAfterPerform emptyConfirmedResult). self assert: (tool shouldSaveImageAfterSuccessfulExecutionForResult: confirmedResult) - ] { #category : 'private - calling' } diff --git a/src/MCP-Tests/MCPToolClassMutationTest.class.st b/src/MCP-Tests/MCPToolClassMutationTest.class.st index 8953dc7..02ab439 100644 --- a/src/MCP-Tests/MCPToolClassMutationTest.class.st +++ b/src/MCP-Tests/MCPToolClassMutationTest.class.st @@ -19,8 +19,8 @@ MCPToolClassMutationTest >> aroundToolCall: aBlock [ MCPToolClassMutationTest >> assertIncludesReferencedSlotWarning: warningMessages [ self assert: (warningMessages anySatisfy: [ :each | - (each includesSubstring: 'referencedSlot') and: [ - each includesSubstring: 'referenced' ] ]) + (each includesSubstring: 'referencedSlot') and: [ + each includesSubstring: 'referenced' ] ]) ] { #category : 'private - calling' } @@ -28,7 +28,7 @@ MCPToolClassMutationTest >> callToolWith: someArguments [ | arguments request result slotAction tool toolClass | arguments := someArguments copy. - arguments removeKey: #action ifAbsent: [ ]. + arguments removeKey: #action ifAbsent: [ ]. slotAction := arguments removeKey: #slotAction ifAbsent: [ nil ]. toolClass := self classToolClassForArguments: arguments @@ -42,22 +42,36 @@ MCPToolClassMutationTest >> callToolWith: someArguments [ { #category : 'private - calling' } MCPToolClassMutationTest >> classToolClassForArguments: arguments slotAction: slotAction [ - ((arguments includesKey: #superclassName) and: [ arguments includesKey: #packageName ]) ifTrue: [ ^ MCPToolCreateClass ]. + ((arguments includesKey: #superclassName) and: [ + arguments includesKey: #packageName ]) ifTrue: [ + ^ MCPToolCreateClass ]. slotAction = 'add' ifTrue: [ ^ MCPToolAddClassSlot ]. slotAction = 'remove' ifTrue: [ ^ MCPToolRemoveClassSlot ]. slotAction = 'rename' ifTrue: [ ^ MCPToolUpdateClassSlotName ]. slotAction = 'pullUp' ifTrue: [ ^ MCPToolPullUpClassSlot ]. slotAction = 'pushDown' ifTrue: [ ^ MCPToolPushDownClassSlot ]. - (arguments includesKey: #newClassName) ifTrue: [ ^ MCPToolUpdateClassName ]. - (arguments includesKey: #classComment) ifTrue: [ ^ MCPToolUpdateClassComment ]. - (arguments includesKey: #traits) ifTrue: [ ^ MCPToolUpdateClassTraits ]. - (arguments includesKey: #classTraits) ifTrue: [ ^ MCPToolUpdateClassSideTraits ]. - (arguments includesKey: #sharedVariables) ifTrue: [ ^ MCPToolUpdateClassSharedVariables ]. - (arguments includesKey: #sharedPools) ifTrue: [ ^ MCPToolUpdateClassSharedPools ]. - (arguments includesKey: #layout) ifTrue: [ ^ MCPToolUpdateClassLayout ]. - ((arguments includesKey: #slots) or: [ arguments includesKey: #classSlots ]) ifTrue: [ ^ MCPToolUpdateClassSlots ]. - (arguments includesKey: #superclassName) ifTrue: [ ^ MCPToolUpdateClassSuperclass ]. - ((arguments includesKey: #packageName) or: [ arguments includesKey: #tag ]) ifTrue: [ ^ MCPToolUpdateClassPackage ]. + (arguments includesKey: #newClassName) ifTrue: [ + ^ MCPToolUpdateClassName ]. + (arguments includesKey: #classComment) ifTrue: [ + ^ MCPToolUpdateClassComment ]. + (arguments includesKey: #traits) ifTrue: [ + ^ MCPToolUpdateClassTraits ]. + (arguments includesKey: #classTraits) ifTrue: [ + ^ MCPToolUpdateClassSideTraits ]. + (arguments includesKey: #sharedVariables) ifTrue: [ + ^ MCPToolUpdateClassSharedVariables ]. + (arguments includesKey: #sharedPools) ifTrue: [ + ^ MCPToolUpdateClassSharedPools ]. + (arguments includesKey: #layout) ifTrue: [ + ^ MCPToolUpdateClassLayout ]. + ((arguments includesKey: #slots) or: [ + arguments includesKey: #classSlots ]) ifTrue: [ + ^ MCPToolUpdateClassSlots ]. + (arguments includesKey: #superclassName) ifTrue: [ + ^ MCPToolUpdateClassSuperclass ]. + ((arguments includesKey: #packageName) or: [ + arguments includesKey: #tag ]) ifTrue: [ + ^ MCPToolUpdateClassPackage ]. ^ MCPToolUpdateClassComment ] @@ -89,12 +103,14 @@ MCPToolClassMutationTest >> createRequestArgumentsWith: associations [ { #category : 'private' } MCPToolClassMutationTest >> createdClassNames [ - ^ #( 'MCPToolClassMutationTestGenerated' 'MCPToolClassMutationTestTagged' + ^ #( 'MCPToolClassMutationTestGenerated' + 'MCPToolClassMutationTestTagged' 'MCPToolClassMutationTestClassSlots' 'MCPToolClassMutationTestConfigured' 'MCPToolClassMutationTestTemporaryPackage' 'MCPToolClassMutationTestCommentTarget' - 'MCPToolClassMutationTestCommented' 'MCPToolClassMutationTestReparentTarget' + 'MCPToolClassMutationTestCommented' + 'MCPToolClassMutationTestReparentTarget' 'MCPToolClassMutationTestReparentSuperclass' 'MCPToolClassMutationTestTraitTarget' 'MCPToolClassMutationTestTraitRemovalTarget' @@ -152,10 +168,10 @@ MCPToolClassMutationTest >> destinationTagName [ MCPToolClassMutationTest >> ensureDestinationPackage [ self withoutEpiceaDuring: [ - | package | - package := PackageOrganizer default ensurePackage: - self destinationPackageName. - package ensureTag: self destinationTagName ] + | package | + package := PackageOrganizer default ensurePackage: + self destinationPackageName. + package ensureTag: self destinationTagName ] ] { #category : 'private' } @@ -165,14 +181,14 @@ MCPToolClassMutationTest >> ensureOriginalRenameFixtureState [ originalSymbol := self originalClassName asSymbol. renamedSymbol := self renamedClassName asSymbol. self withoutEpiceaDuring: [ - ((Smalltalk globals includesKey: originalSymbol) and: [ - Smalltalk globals includesKey: renamedSymbol ]) ifTrue: [ - (Smalltalk globals at: renamedSymbol) removeFromSystem ]. - ((Smalltalk globals includesKey: renamedSymbol) and: [ - (Smalltalk globals includesKey: originalSymbol) not ]) ifTrue: [ - (ReRenameClassRefactoring - rename: self renamedClassName - to: self originalClassName) execute ] ] + ((Smalltalk globals includesKey: originalSymbol) and: [ + Smalltalk globals includesKey: renamedSymbol ]) ifTrue: [ + (Smalltalk globals at: renamedSymbol) removeFromSystem ]. + ((Smalltalk globals includesKey: renamedSymbol) and: [ + (Smalltalk globals includesKey: originalSymbol) not ]) ifTrue: [ + (ReRenameClassRefactoring + rename: self renamedClassName + to: self originalClassName) execute ] ] ] { #category : 'private' } @@ -215,21 +231,21 @@ MCPToolClassMutationTest >> referenceClassName [ MCPToolClassMutationTest >> removeDestinationPackage [ self withoutEpiceaDuring: [ - (PackageOrganizer default hasPackage: self destinationPackageName) - ifTrue: [ - PackageOrganizer default removePackage: - (PackageOrganizer default packageNamed: - self destinationPackageName) ] ] + (PackageOrganizer default hasPackage: self destinationPackageName) + ifTrue: [ + PackageOrganizer default removePackage: + (PackageOrganizer default packageNamed: + self destinationPackageName) ] ] ] { #category : 'private' } MCPToolClassMutationTest >> removeGeneratedPackage [ self withoutEpiceaDuring: [ - (self packageOrganizer hasPackage: self generatedPackageName) - ifTrue: [ - self packageOrganizer removePackage: - (self packageOrganizer packageNamed: self generatedPackageName) ] ] + (self packageOrganizer hasPackage: self generatedPackageName) + ifTrue: [ + self packageOrganizer removePackage: + (self packageOrganizer packageNamed: self generatedPackageName) ] ] ] { #category : 'private' } @@ -258,9 +274,9 @@ MCPToolClassMutationTest >> restoreMoveTargetClassLocation [ self currentTagOfMoveTargetClass = 'Uncategorized' ]) ifTrue: [ ^ self ]. self withoutEpiceaDuring: [ - (RBMoveClassTransformation - move: self moveTargetClassName - toPackage: self originalMovePackageName) execute ] + (RBMoveClassTransformation + move: self moveTargetClassName + toPackage: self originalMovePackageName) execute ] ] { #category : 'running' } @@ -396,8 +412,7 @@ MCPToolClassMutationTest >> testCreateAcceptsDefinitionOptions [ as: Array) equals: #( 'ChronologyConstants' ). self assert: createdClass classLayout class name equals: #WeakLayout. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - create' } @@ -419,8 +434,7 @@ MCPToolClassMutationTest >> testCreateAcceptsSlotsAndTag [ self assert: createdClass category asString equals: self generatedPackageName , '-Generated'. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - create' } @@ -439,8 +453,7 @@ MCPToolClassMutationTest >> testCreateCreatesClass [ assert: createdClass packageName asString equals: self generatedPackageName. self assert: createdClass slots isEmpty. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - create' } @@ -544,8 +557,7 @@ MCPToolClassMutationTest >> testCreateSetsClassComment [ createdClass := self classNamed: 'MCPToolClassMutationTestCommented'. self deny: (result at: #isError ifAbsent: [ false ]). self assert: createdClass comment equals: 'Created with a comment.'. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -569,8 +581,7 @@ MCPToolClassMutationTest >> testUpdateAddsClassSideSlot [ self assert: (target classSide slots collect: #name as: Array) equals: #( #addedClassSlot ). - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -593,8 +604,7 @@ MCPToolClassMutationTest >> testUpdateAddsInstanceSlot [ self assert: (target slots collect: #name as: Array) equals: #( #addedSlot ). - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -615,8 +625,7 @@ MCPToolClassMutationTest >> testUpdateCanClearClassComment [ target := self classNamed: self commentTargetClassName. self deny: (result at: #isError ifAbsent: [ false ]). self assert: target comment equals: ''. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -670,8 +679,7 @@ MCPToolClassMutationTest >> testUpdateForcePullUpSlotContinuesPastRefactoringWar self assert: (childOne slots collect: #name as: Array) equals: #( ). self assert: (childTwo slots collect: #name as: Array) equals: #( ). self assert: instance slotProbe equals: 17. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -702,8 +710,7 @@ MCPToolClassMutationTest >> testUpdateForceRemoveSlotContinuesPastRefactoringWar self deny: (result at: #isError ifAbsent: [ false ]). self assertIncludesReferencedSlotWarning: warnings. self assert: (target slots collect: #name as: Array) equals: #( ). - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -720,8 +727,7 @@ MCPToolClassMutationTest >> testUpdateMoveEnsuresMissingDestinationPackage [ self assert: self moveTargetClass packageName asString equals: self destinationPackageName. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -744,8 +750,7 @@ MCPToolClassMutationTest >> testUpdateMoveEnsuresMissingDestinationTag [ self assert: self currentTagOfMoveTargetClass equals: self destinationTagName. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -759,8 +764,7 @@ MCPToolClassMutationTest >> testUpdateMovesClassToAnotherPackage [ self assert: self moveTargetClass packageName asString equals: self destinationPackageName. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -777,8 +781,7 @@ MCPToolClassMutationTest >> testUpdateMovesClassToExistingTag [ self assert: self currentTagOfMoveTargetClass equals: self destinationTagName. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -865,7 +868,8 @@ MCPToolClassMutationTest >> testUpdatePullUpSlotStopsOnRefactoringWarningByDefau classSide: false). structured := self structuredContentFrom: result. error := self errorFrom: result. - target := self classNamed: 'MCPToolClassMutationTestWarningPullUpTarget'. + target := self classNamed: + 'MCPToolClassMutationTestWarningPullUpTarget'. childOne := self classNamed: 'MCPToolClassMutationTestWarningPullUpChildOne'. childTwo := self classNamed: @@ -888,8 +892,8 @@ MCPToolClassMutationTest >> testUpdatePullUpSlotStopsOnRefactoringWarningByDefau self assert: ((error at: #howToProceed) includesSubstring: 'force=true'). self assert: ((error at: #impactMessages) anySatisfy: [ :each | - each includesSubstring: - 'Not all subclasses have an instance variable named' ]). + each includesSubstring: + 'Not all subclasses have an instance variable named' ]). self assert: (target slots collect: #name as: Array) equals: #( ). self assert: (childOne slots collect: #name as: Array) @@ -938,8 +942,7 @@ MCPToolClassMutationTest >> testUpdatePullsUpInstanceSlotAcrossSubclasses [ self assert: (childOne slots collect: #name as: Array) equals: #( ). self assert: (childTwo slots collect: #name as: Array) equals: #( ). self assert: instance slotProbe equals: 41. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -989,8 +992,7 @@ MCPToolClassMutationTest >> testUpdatePushesDownClassSlotToDirectSubclasses [ assert: (childTwo classSide slots collect: #name as: Array) equals: #( #sharedClassSlot ). self assert: childOne slotProbe equals: 23. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1010,8 +1012,7 @@ MCPToolClassMutationTest >> testUpdateRecategorizesWithinCurrentPackageWhenPacka self assert: self currentTagOfMoveTargetClass equals: self destinationTagName. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1026,10 +1027,12 @@ MCPToolClassMutationTest >> testUpdateRemoveSlotStopsOnRefactoringWarningByDefau self ensureMethodSource: 'slotProbe ^ referencedSlot' protocol: 'testing' - on: (self classNamed: 'MCPToolClassMutationTestWarningRemoveSlotTarget'). + on: + (self classNamed: 'MCPToolClassMutationTestWarningRemoveSlotTarget'). result := self callToolWith: (self updateRequestArgumentsForSlotAction: 'remove' - className: 'MCPToolClassMutationTestWarningRemoveSlotTarget' + className: + 'MCPToolClassMutationTestWarningRemoveSlotTarget' slotName: 'referencedSlot' classSide: false). structured := self structuredContentFrom: result. @@ -1055,8 +1058,7 @@ MCPToolClassMutationTest >> testUpdateRemoveSlotStopsOnRefactoringWarningByDefau self assert: (error at: #forceSupported) equals: true. self assert: ((error at: #howToProceed) includesSubstring: 'force=true'). - self assertIncludesReferencedSlotWarning: - (error at: #impactMessages). + self assertIncludesReferencedSlotWarning: (error at: #impactMessages). self assert: (target slots collect: #name as: Array) equals: #( #referencedSlot ) @@ -1084,8 +1086,7 @@ MCPToolClassMutationTest >> testUpdateRemovesClassSideSlot [ self assert: (target classSide slots collect: #name as: Array) equals: #( ). - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1108,8 +1109,7 @@ MCPToolClassMutationTest >> testUpdateRemovesClassSideTraitsWithEmptyArray [ 'MCPToolClassMutationTestClassTraitRemovalTarget'. self deny: (result at: #isError ifAbsent: [ false ]). self assert: targetClass classSide traits isEmpty. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1130,8 +1130,7 @@ MCPToolClassMutationTest >> testUpdateRemovesInstanceSlot [ target := self classNamed: 'MCPToolClassMutationTestRemoveSlotTarget'. self deny: (result at: #isError ifAbsent: [ false ]). self assert: (target slots collect: #name as: Array) equals: #( ). - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1154,8 +1153,7 @@ MCPToolClassMutationTest >> testUpdateRemovesSharedPoolsWithEmptyArray [ 'MCPToolClassMutationTestSharedPoolRemovalTarget'. self deny: (result at: #isError ifAbsent: [ false ]). self assert: targetClass sharedPools isEmpty. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1178,8 +1176,7 @@ MCPToolClassMutationTest >> testUpdateRemovesSharedVariablesWithEmptyArray [ 'MCPToolClassMutationTestSharedVariableRemovalTarget'. self deny: (result at: #isError ifAbsent: [ false ]). self assert: targetClass classVarNames isEmpty. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1202,8 +1199,7 @@ MCPToolClassMutationTest >> testUpdateRemovesTraitsWithEmptyArray [ 'MCPToolClassMutationTestTraitRemovalTarget'. self deny: (result at: #isError ifAbsent: [ false ]). self assert: targetClass traits isEmpty. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1283,8 +1279,7 @@ MCPToolClassMutationTest >> testUpdateRenamesClassAndReturnsStructuredData [ (Smalltalk globals includesKey: self renamedClassName asSymbol). self deny: (Smalltalk globals includesKey: self originalClassName asSymbol). - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1333,8 +1328,7 @@ MCPToolClassMutationTest >> testUpdateRenamesClassSideSlotAndPreservesValue [ self assert: target renamedClassSlot equals: 73. target renamedClassSlot: 91. self assert: target slotProbe equals: 91. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1378,8 +1372,7 @@ MCPToolClassMutationTest >> testUpdateRenamesInstanceSlotAndUpdatesReferences [ self assert: (target includesSelector: #renamedSlot:). self assert: instance renamedSlot equals: 37. self assert: instance slotProbe equals: 37. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1412,8 +1405,7 @@ MCPToolClassMutationTest >> testUpdateReparentsClassAndPreservesExistingState [ equals: self reparentSuperclassName. self assert: target new probeMethod equals: 41. self assert: target comment equals: 'reparent comment'. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1443,8 +1435,7 @@ MCPToolClassMutationTest >> testUpdateReplacesClassSideTraits [ self assert: targetClass classSide traitCompositionString equals: 'TComparable classTrait'. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1465,8 +1456,7 @@ MCPToolClassMutationTest >> testUpdateReplacesLayout [ 'MCPToolClassMutationTestLayoutTarget'. self deny: (result at: #isError ifAbsent: [ false ]). self assert: targetClass classLayout class name equals: #WeakLayout. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1493,8 +1483,7 @@ MCPToolClassMutationTest >> testUpdateReplacesSharedPools [ collect: [ :each | each name asString ] as: Array) equals: #( 'TextConstants' ). - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1517,8 +1506,7 @@ MCPToolClassMutationTest >> testUpdateReplacesSharedVariables [ 'MCPToolClassMutationTestSharedVariableTarget'. self deny: (result at: #isError ifAbsent: [ false ]). self assert: targetClass classVarNames equals: #( #BetaShared ). - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1550,8 +1538,7 @@ MCPToolClassMutationTest >> testUpdateReplacesSlotDefinitionAndPreservesMatching equals: #( #keptClassSlot #newClassSlot ). self assert: (instance instVarNamed: 'keptSlot') equals: 13. self assert: (target instVarNamed: 'keptClassSlot') equals: 17. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1582,8 +1569,7 @@ MCPToolClassMutationTest >> testUpdateReplacesTraits [ self assert: targetClass classSide traitCompositionString equals: 'TComparable classTrait'. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests - update' } @@ -1945,8 +1931,7 @@ MCPToolClassMutationTest >> testUpdateSetsClassComment [ target := self classNamed: self commentTargetClassName. self deny: (result at: #isError ifAbsent: [ false ]). self assert: target comment equals: 'updated comment'. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'private - calling' } diff --git a/src/MCP-Tests/MCPToolContractsTest.class.st b/src/MCP-Tests/MCPToolContractsTest.class.st index fd3a078..65c08b6 100644 --- a/src/MCP-Tests/MCPToolContractsTest.class.st +++ b/src/MCP-Tests/MCPToolContractsTest.class.st @@ -13,34 +13,35 @@ Class { MCPToolContractsTest >> addSelfSentNotImplementedCritiquesFrom: aMethod using: aRule to: issues [ aRule check: aMethod forCritiquesDo: [ :critique | - issues add: (String streamContents: [ :stream | - stream - nextPutAll: aMethod methodClass name asString; - nextPutAll: '>>'; - nextPutAll: aMethod selector asString. - critique tinyHint ifNotNil: [ :hint | - stream - space; - nextPutAll: hint asString ] ]) ] + issues add: (String streamContents: [ :stream | + stream + nextPutAll: aMethod methodClass name asString; + nextPutAll: '>>'; + nextPutAll: aMethod selector asString. + critique tinyHint ifNotNil: [ :hint | + stream + space; + nextPutAll: hint asString ] ]) ] ] { #category : 'private' } MCPToolContractsTest >> addUnimplementedResponsibilitiesFor: aClass behavior: aBehavior side: sideName to: issues [ aBehavior allSelectors do: [ :selector | - | method | - selector = #subclassResponsibility ifFalse: [ - method := aBehavior lookupSelector: selector. - (method notNil and: [ self methodSendsSubclassResponsibility: method ]) ifTrue: [ - issues add: (String streamContents: [ :stream | - stream - nextPutAll: aClass name asString; - space; - nextPutAll: sideName; - nextPutAll: ' #'; - nextPutAll: selector asString; - nextPutAll: ' inherited from '; - nextPutAll: method methodClass name asString ]) ] ] ] + | method | + selector = #subclassResponsibility ifFalse: [ + method := aBehavior lookupSelector: selector. + (method notNil and: [ + self methodSendsSubclassResponsibility: method ]) ifTrue: [ + issues add: (String streamContents: [ :stream | + stream + nextPutAll: aClass name asString; + space; + nextPutAll: sideName; + nextPutAll: ' #'; + nextPutAll: selector asString; + nextPutAll: ' inherited from '; + nextPutAll: method methodClass name asString ]) ] ] ] ] { #category : 'private' } @@ -69,19 +70,19 @@ MCPToolContractsTest >> assertNoCompositionKeywordsIn: aValue path: path [ | compositionKeywords | compositionKeywords := #( oneOf anyOf allOf ). aValue isDictionary ifTrue: [ - compositionKeywords do: [ :keyword | - self deny: (aValue includesKey: keyword). - self deny: (aValue includesKey: keyword asString) ]. - aValue keysAndValuesDo: [ :key :nestedValue | - self - assertNoCompositionKeywordsIn: nestedValue - path: (path copyWith: key) ]. - ^ self ]. + compositionKeywords do: [ :keyword | + self deny: (aValue includesKey: keyword). + self deny: (aValue includesKey: keyword asString) ]. + aValue keysAndValuesDo: [ :key :nestedValue | + self + assertNoCompositionKeywordsIn: nestedValue + path: (path copyWith: key) ]. + ^ self ]. (aValue isCollection and: [ aValue isString not ]) ifTrue: [ - aValue withIndexDo: [ :nestedValue :index | - self - assertNoCompositionKeywordsIn: nestedValue - path: (path copyWith: index) ] ] + aValue withIndexDo: [ :nestedValue :index | + self + assertNoCompositionKeywordsIn: nestedValue + path: (path copyWith: index) ] ] ] { #category : 'private' } @@ -644,10 +645,11 @@ MCPToolContractsTest >> methodMutationToolFlowSpecs [ { #category : 'private' } MCPToolContractsTest >> methodSendsSubclassResponsibility: aCompiledMethod [ - (aCompiledMethod sendsSelector: #subclassResponsibility) ifFalse: [ ^ false ]. + (aCompiledMethod sendsSelector: #subclassResponsibility) ifFalse: [ + ^ false ]. aCompiledMethod ast nodesDo: [ :node | - (node isMessage and: [ node selector = #subclassResponsibility ]) ifTrue: [ - ^ true ] ]. + (node isMessage and: [ node selector = #subclassResponsibility ]) + ifTrue: [ ^ true ] ]. ^ false ] @@ -755,16 +757,16 @@ MCPToolContractsTest >> selfSentNotImplementedCritiquesForMCPMethods [ package := PackageOrganizer default packageNamed: #MCP. issues := OrderedCollection new. package definedClasses do: [ :class | - class localMethods do: [ :method | - self - addSelfSentNotImplementedCritiquesFrom: method - using: rule - to: issues ]. - class class localMethods do: [ :method | - self - addSelfSentNotImplementedCritiquesFrom: method - using: rule - to: issues ] ]. + class localMethods do: [ :method | + self + addSelfSentNotImplementedCritiquesFrom: method + using: rule + to: issues ]. + class class localMethods do: [ :method | + self + addSelfSentNotImplementedCritiquesFrom: method + using: rule + to: issues ] ]. ^ issues asArray sort ] @@ -778,8 +780,8 @@ MCPToolContractsTest >> signalHaltForMCPMessageProcessorTest [ MCPToolContractsTest >> testAllToolInputSchemasAvoidCompositionKeywords [ MCPTool concreteSubclasses do: [ :toolClass | - self assertNoCompositionKeywordsIn: - (toolClass new asJRPCJSON at: #inputSchema) ] + self assertNoCompositionKeywordsIn: + (toolClass new asJRPCJSON at: #inputSchema) ] ] { #category : 'tests' } @@ -1166,7 +1168,8 @@ MCPToolContractsTest >> testClassToolsOutputSchemaAdvertisesMinimalMutationResul | dataProperties outputSchema | outputSchema := MCPToolUpdateClassName new outputSchema asJRPCJSON. - dataProperties := ((outputSchema at: #properties) at: 'data') at: #properties. + dataProperties := ((outputSchema at: #properties) at: 'data') at: + #properties. self assert: dataProperties isEmpty ] @@ -1178,7 +1181,9 @@ MCPToolContractsTest >> testConcreteMCPClassesHaveNoUnimplementedResponsibilitie self assert: issues isEmpty description: (String streamContents: [ :stream | - issues do: [ :each | stream nextPutAll: each ] separatedBy: [ stream cr ] ]) + issues + do: [ :each | stream nextPutAll: each ] + separatedBy: [ stream cr ] ]) ] { #category : 'tests' } @@ -1186,8 +1191,7 @@ MCPToolContractsTest >> testConfiguredDiscoverableToolsAreNotDirectlyCallable [ | server | server := self mcpWithoutObservabilityExport. - server staticToolNames: - #( 'tool_search' 'tool_get' 'tool_call' ). + server staticToolNames: #( 'tool_search' 'tool_get' 'tool_call' ). self should: [ server @@ -1293,10 +1297,8 @@ MCPToolContractsTest >> testDictionaryShapedCommandResultsUseDTOClasses [ | commandResultClasses | commandResultClasses := { (MCPEvaluateCommand -> MCPEvaluateResult). - (MCPGetClassCommand - -> MCPGetClassResult). - (MCPGetMethodCommand - -> MCPGetMethodResult). + (MCPGetClassCommand -> MCPGetClassResult). + (MCPGetMethodCommand -> MCPGetMethodResult). (MCPRewriteMethodsCommand -> MCPMethodRewriteReport). (MCPRemoveMethodsCommand @@ -1706,7 +1708,9 @@ MCPToolContractsTest >> testMCPMethodsHaveImplementedSelfAndSuperSends [ self assert: issues isEmpty description: (String streamContents: [ :stream | - issues do: [ :each | stream nextPutAll: each ] separatedBy: [ stream cr ] ]) + issues + do: [ :each | stream nextPutAll: each ] + separatedBy: [ stream cr ] ]) ] { #category : 'tests' } @@ -1839,18 +1843,31 @@ MCPToolContractsTest >> testMethodMutationSchemaAdvertisesOnlyNonInputOutcomes [ | argumentNamesProperty argumentValuesProperty dataProperties dataProperty permutationProperty propertyNames tool toolPropertyNames | tool := MCPToolUpdateMethodSelector new. - toolPropertyNames := tool inputSchema properties collect: [ :each | each name ]. - permutationProperty := tool inputSchema properties detect: [ :each | each name = 'permutation' ]. - argumentNamesProperty := tool inputSchema properties detect: [ :each | each name = 'argumentNames' ]. - argumentValuesProperty := tool inputSchema properties detect: [ :each | each name = 'argumentValueExpressions' ]. - dataProperty := tool outputSchema properties detect: [ :each | each name = 'data' ]. + toolPropertyNames := tool inputSchema properties collect: [ :each | + each name ]. + permutationProperty := tool inputSchema properties detect: [ :each | + each name = 'permutation' ]. + argumentNamesProperty := tool inputSchema properties detect: [ :each | + each name = 'argumentNames' ]. + argumentValuesProperty := tool inputSchema properties detect: [ :each | + each name = 'argumentValueExpressions' ]. + dataProperty := tool outputSchema properties detect: [ :each | + each name = 'data' ]. dataProperties := dataProperty extraProperties at: #properties. propertyNames := dataProperties collect: [ :each | each name ]. self deny: (toolPropertyNames includes: 'action'). - self assert: (permutationProperty extraProperties at: #items) type equals: 'integer'. - self assert: (argumentNamesProperty extraProperties at: #items) type equals: 'string'. - self assert: (argumentValuesProperty extraProperties at: #items) type equals: 'string'. - self assert: propertyNames asSet equals: #( 'changeKind' 'critiques' ) asSet + self + assert: (permutationProperty extraProperties at: #items) type + equals: 'integer'. + self + assert: (argumentNamesProperty extraProperties at: #items) type + equals: 'string'. + self + assert: (argumentValuesProperty extraProperties at: #items) type + equals: 'string'. + self + assert: propertyNames asSet + equals: #( 'changeKind' 'critiques' ) asSet ] { #category : 'tests' } @@ -1897,31 +1914,34 @@ MCPToolContractsTest >> testMethodToolTraitOwnsSharedMethodHelpers [ | methodToolClasses sharedSelectors | methodToolClasses := { - MCPToolGetMethod. - MCPToolMethodMutation. - MCPToolMethodSearch. - MCPToolRewriteMethods. - MCPToolRemoveMethods }. + MCPToolGetMethod. + MCPToolMethodMutation. + MCPToolMethodSearch. + MCPToolRewriteMethods. + MCPToolRemoveMethods }. sharedSelectors := #( selectorStringFromRequest: - behaviorNamed:classSide: - methodReferenceForBehavior:selector: - methodReferenceForClassName:selector:isClassSide: - methodScopeQueryFromRequest: ). + behaviorNamed:classSide: + methodReferenceForBehavior:selector: + methodReferenceForClassName:selector:isClassSide: + methodScopeQueryFromRequest: ). methodToolClasses do: [ :toolClass | - self assert: (toolClass withAllSuperclasses anySatisfy: [ :each | - each traits includes: TMCPMethodTool ]). - sharedSelectors do: [ :selector | - | implementingClass | - implementingClass := toolClass whichClassIncludesSelector: selector. - self assert: implementingClass notNil. - self assert: (implementingClass >> selector) origin equals: TMCPMethodTool ] ] + self assert: (toolClass withAllSuperclasses anySatisfy: [ :each | + each traits includes: TMCPMethodTool ]). + sharedSelectors do: [ :selector | + | implementingClass | + implementingClass := toolClass whichClassIncludesSelector: + selector. + self assert: implementingClass notNil. + self + assert: (implementingClass >> selector) origin + equals: TMCPMethodTool ] ] ] { #category : 'tests' } MCPToolContractsTest >> testMutatingToolsRequestImageSaveAfterSuccessfulExecution [ - self deny: - MCPToolSearchMethodMetadata new shouldSaveImageAfterSuccessfulExecution. + self deny: MCPToolSearchMethodMetadata new + shouldSaveImageAfterSuccessfulExecution. self deny: MCPToolGetClass new shouldSaveImageAfterSuccessfulExecution. self assert: @@ -1942,7 +1962,6 @@ MCPToolContractsTest >> testMutatingToolsRequestImageSaveAfterSuccessfulExecutio MCPToolRemoveMethods new shouldSaveImageAfterSuccessfulExecution. self assert: MCPToolEvaluate new shouldSaveImageAfterSuccessfulExecution - ] { #category : 'tests' } @@ -2238,8 +2257,8 @@ MCPToolContractsTest >> testQueryScopeDescriptionsExplainScopeSemantics [ MCPToolContractsTest >> testRPCAdvertisesStaticToolSurfaceOnly [ | discoverableToolNames expectedStaticToolNames toolNames | - toolNames := (self mcpWithoutObservabilityExport rpcToolsList at: #tools) collect: [ :each | - each at: #name ]. + toolNames := (self mcpWithoutObservabilityExport rpcToolsList at: + #tools) collect: [ :each | each at: #name ]. expectedStaticToolNames := #( 'tool_search' 'tool_get' 'tool_call' 'package_search' 'class_search' 'class_get' 'class_create' @@ -2508,9 +2527,9 @@ MCPToolContractsTest >> testRpcToolCallRejectsLegacyScopeArgument [ self should: [ - self - callToolNamed: 'class_search' - withArguments: { (#scope -> 'packages') } asDictionary ] + self + callToolNamed: 'class_search' + withArguments: { (#scope -> 'packages') } asDictionary ] raise: JRPCInvalidParameters ] @@ -2522,8 +2541,8 @@ MCPToolContractsTest >> testRpcToolCallSignalsInvalidParametersForInvalidNestedA self callToolNamed: 'test_run' withArguments: - { (#methods -> { { (#selector -> 'testPasses') } asDictionary }) } - asDictionary ] + { (#methods -> { { (#selector -> 'testPasses') } asDictionary }) } + asDictionary ] raise: JRPCInvalidParameters ] @@ -2543,9 +2562,9 @@ MCPToolContractsTest >> testRpcToolCallSignalsInvalidParametersForWrongArgumentT self should: [ - self - callToolNamed: 'class_search' - withArguments: { (#caseSensitive -> 'true') } asDictionary ] + self + callToolNamed: 'class_search' + withArguments: { (#caseSensitive -> 'true') } asDictionary ] raise: JRPCInvalidParameters ] @@ -2554,9 +2573,9 @@ MCPToolContractsTest >> testRpcToolCallSignalsInvalidParametersWhenRequiredArgum self should: [ - self - callDiscoveredToolNamed: 'image_evaluate' - withArguments: Dictionary new ] + self + callDiscoveredToolNamed: 'image_evaluate' + withArguments: Dictionary new ] raise: JRPCInvalidParameters ] @@ -2567,18 +2586,28 @@ MCPToolContractsTest >> testRunTestCoverageParsesCompactSelections [ tool := MCPToolRunTestCoverage new. rawRequest := tool requestFromToolCallArguments: { (#classes -> #( 'MCPToolContractsTest' )). - (#coverage -> { (#scope -> { (#classes -> #( 'MCPToolContractsTest' )) } asDictionary) } asDictionary) } - asDictionary. + (#coverage -> { (#scope + -> + { (#classes -> #( 'MCPToolContractsTest' )) } + asDictionary) } asDictionary) } asDictionary. parsedRequest := tool parsedRequestFromToolRequest: rawRequest. command := tool commandForRequest: parsedRequest. validatedRequests := command validatedRequestsFrom: parsedRequest testRequests. self assert: parsedRequest class equals: MCPRunTestsRequest. self assert: parsedRequest isCoverageOperation. - self assert: parsedRequest coverageRequest class equals: MCPTestCoverageRequest. - self assert: parsedRequest testRequests first class equals: MCPTestRunRequest. - self assert: validatedRequests first class equals: MCPValidatedTestRunRequest. - self assert: validatedRequests first testClass equals: MCPToolContractsTest + self + assert: parsedRequest coverageRequest class + equals: MCPTestCoverageRequest. + self + assert: parsedRequest testRequests first class + equals: MCPTestRunRequest. + self + assert: validatedRequests first class + equals: MCPValidatedTestRunRequest. + self + assert: validatedRequests first testClass + equals: MCPToolContractsTest ] { #category : 'tests' } @@ -2587,9 +2616,9 @@ MCPToolContractsTest >> testRunTestToolsHaveAccurateNamesAndRequiredArguments [ | coverageDataProperties coverageInputProperties coverageInputProperty coverageTool dataProperties inputPropertyNames outputSchema tool | tool := MCPToolRunTests new. self assert: tool name equals: 'test_run'. - self assert: (tool inputSchema required ifNil: [ #( ) ]) isEmpty. + self assert: (tool inputSchema required ifNil: [ #( ) ]) isEmpty. inputPropertyNames := tool inputSchema properties collect: [ :each | - each name ]. + each name ]. self assert: inputPropertyNames asSet equals: #( 'packages' 'classes' 'methods' 'timeoutSeconds' ) asSet. @@ -2597,7 +2626,8 @@ MCPToolContractsTest >> testRunTestToolsHaveAccurateNamesAndRequiredArguments [ self deny: (inputPropertyNames includes: 'timeoutMilliseconds'). self deny: (inputPropertyNames includes: 'coverage'). outputSchema := tool outputSchema asJRPCJSON. - dataProperties := ((outputSchema at: #properties) at: 'data') at: #properties. + dataProperties := ((outputSchema at: #properties) at: 'data') at: + #properties. self assert: (dataProperties includesKey: 'runCount'). self assert: (dataProperties includesKey: 'passedCount'). self assert: (dataProperties includesKey: 'skipped'). @@ -2611,31 +2641,39 @@ MCPToolContractsTest >> testRunTestToolsHaveAccurateNamesAndRequiredArguments [ coverageTool := MCPToolRunTestCoverage new. self assert: coverageTool name equals: 'test_coverage_run'. - self assert: coverageTool inputSchema required asSet equals: #( 'coverage' ) asSet. - inputPropertyNames := coverageTool inputSchema properties collect: [ :each | - each name ]. + self + assert: coverageTool inputSchema required asSet + equals: #( 'coverage' ) asSet. + inputPropertyNames := coverageTool inputSchema properties collect: [ + :each | each name ]. self assert: inputPropertyNames asSet equals: - #( 'packages' 'classes' 'methods' 'coverage' 'timeoutSeconds' ) asSet. + #( 'packages' 'classes' 'methods' 'coverage' 'timeoutSeconds' ) + asSet. self deny: (inputPropertyNames includes: 'tests'). self deny: (inputPropertyNames includes: 'timeoutMilliseconds'). - coverageInputProperty := coverageTool inputSchema properties detect: [ :each | - each name = 'coverage' ]. - coverageInputProperties := coverageInputProperty asJRPCJSON at: #properties. + coverageInputProperty := coverageTool inputSchema properties detect: [ + :each | each name = 'coverage' ]. + coverageInputProperties := coverageInputProperty asJRPCJSON at: + #properties. self assert: coverageInputProperties keys asSet - equals: #( 'scope' 'side' 'includeCoveredMethods' 'methodLimit' ) asSet. + equals: + #( 'scope' 'side' 'includeCoveredMethods' 'methodLimit' ) asSet. outputSchema := coverageTool outputSchema asJRPCJSON. - dataProperties := ((outputSchema at: #properties) at: 'data') at: #properties. + dataProperties := ((outputSchema at: #properties) at: 'data') at: + #properties. self assert: (dataProperties includesKey: 'coverage'). self assert: (dataProperties includesKey: 'runCount'). self assert: (dataProperties includesKey: 'passedCount'). self assert: (dataProperties includesKey: 'unrunPackages'). - coverageDataProperties := (dataProperties at: 'coverage') at: #properties. + coverageDataProperties := (dataProperties at: 'coverage') at: + #properties. self assert: (coverageDataProperties includesKey: 'methodCount'). self assert: (coverageDataProperties includesKey: 'uncoveredMethods'). - self assert: (coverageDataProperties includesKey: 'partiallyCoveredMethods') + self assert: + (coverageDataProperties includesKey: 'partiallyCoveredMethods') ] { #category : 'tests' } @@ -2644,7 +2682,7 @@ MCPToolContractsTest >> testRunTestsKeepsPackagesAsPackageSelections [ | command parsedRequest rawRequest testCases testRequests tool validatedRequests | tool := MCPToolRunTests new. rawRequest := tool requestFromToolCallArguments: - { (#packages -> #( 'MCP-Tests' )) } asDictionary. + { (#packages -> #( 'MCP-Tests' )) } asDictionary. parsedRequest := tool parsedRequestFromToolRequest: rawRequest. testRequests := parsedRequest testRequests. self assert: testRequests size equals: 1. @@ -2656,9 +2694,11 @@ MCPToolContractsTest >> testRunTestsKeepsPackagesAsPackageSelections [ command := tool commandForRequest: parsedRequest. validatedRequests := command validatedRequestsFrom: testRequests. self assert: validatedRequests first isPackageRequest. - testCases := command testCasesForValidatedRequest: validatedRequests first. + testCases := command testCasesForValidatedRequest: + validatedRequests first. self assert: testCases notEmpty. - self assert: (testCases noneSatisfy: [ :each | each class isAbstract ]) + self assert: + (testCases noneSatisfy: [ :each | each class isAbstract ]) ] { #category : 'tests' } @@ -2668,9 +2708,10 @@ MCPToolContractsTest >> testRunTestsParsesCompactSelections [ tool := MCPToolRunTests new. rawRequest := tool requestFromToolCallArguments: { (#classes -> #( 'MCPToolContractsTest' )). - (#methods -> + (#methods + -> #( 'MCPToolStructuredOutputTestTarget>>#testPasses' )) } - asDictionary. + asDictionary. parsedRequest := tool parsedRequestFromToolRequest: rawRequest. command := tool commandForRequest: parsedRequest. validatedRequests := command validatedRequestsFrom: @@ -2678,14 +2719,26 @@ MCPToolContractsTest >> testRunTestsParsesCompactSelections [ testRequests := parsedRequest testRequests. self assert: parsedRequest class equals: MCPRunTestsRequest. self assert: testRequests size equals: 2. - self assert: testRequests first className equals: 'MCPToolContractsTest'. + self + assert: testRequests first className + equals: 'MCPToolContractsTest'. self assert: testRequests first testMethodName equals: nil. - self assert: testRequests second className equals: 'MCPToolStructuredOutputTestTarget'. + self + assert: testRequests second className + equals: 'MCPToolStructuredOutputTestTarget'. self assert: testRequests second testMethodName equals: 'testPasses'. - self assert: testRequests second displayName equals: 'MCPToolStructuredOutputTestTarget>>#testPasses'. - self assert: validatedRequests first class equals: MCPValidatedTestRunRequest. - self assert: validatedRequests first testRunRequest equals: testRequests first. - self assert: validatedRequests first testClass equals: MCPToolContractsTest + self + assert: testRequests second displayName + equals: 'MCPToolStructuredOutputTestTarget>>#testPasses'. + self + assert: validatedRequests first class + equals: MCPValidatedTestRunRequest. + self + assert: validatedRequests first testRunRequest + equals: testRequests first. + self + assert: validatedRequests first testClass + equals: MCPToolContractsTest ] { #category : 'tests' } @@ -2709,7 +2762,8 @@ MCPToolContractsTest >> testRunTestsRejectsEmptySelection [ self should: [ tool parsedRequestFromToolRequest: rawRequest ] raise: Error - whoseDescriptionIncludes: 'Provide at least one package, class, or method' + whoseDescriptionIncludes: + 'Provide at least one package, class, or method' description: 'test_run requires at least one compact selection.' ] @@ -3115,8 +3169,7 @@ MCPToolContractsTest >> testServerCanConfigureStaticToolNames [ self assert: toolNames asSet equals: - #( 'tool_search' 'tool_get' 'tool_call' 'class_search' ) - asSet. + #( 'tool_search' 'tool_get' 'tool_call' 'class_search' ) asSet. self deny: (toolNames includes: 'class_name_update') ] @@ -3175,7 +3228,8 @@ MCPToolContractsTest >> testStaticToolConfigurationRejectsUnknownToolNames [ self should: [ - self mcpWithoutObservabilityExport staticToolNames: #( 'tool_search' 'not-a-tool' ) ] + self mcpWithoutObservabilityExport staticToolNames: + #( 'tool_search' 'not-a-tool' ) ] raise: Error ] @@ -3222,8 +3276,8 @@ MCPToolContractsTest >> testToolFlowSelectorNamesSeparateTransportAndParsedInput refactoringScopeParametersFromRequest: refactoringModelForScopeParameters:anchoredAtBehavior: ). staleSelectors do: [ :selector | - self deny: (MCPTool withAllSubclasses anySatisfy: [ :each | - each includesSelector: selector ]) ] + self deny: (MCPTool withAllSubclasses anySatisfy: [ :each | + each includesSelector: selector ]) ] ] { #category : 'tests' } @@ -3389,7 +3443,9 @@ MCPToolContractsTest >> testToolRegistryNamesUseClassSideMetadata [ assert: MCPToolStepOverDebugSession toolName equals: 'debug_session_step_over'. self assert: MCPToolDebugCapture toolName equals: 'debug_capture'. - self assert: MCPToolUpdateDebugMethod toolName equals: 'debug_method_update' + self + assert: MCPToolUpdateDebugMethod toolName + equals: 'debug_method_update' ] { #category : 'tests' } @@ -3442,27 +3498,26 @@ MCPToolContractsTest >> toolFlowSpecs [ specs addAll: self debugBreakpointToolFlowSpecs. specs add: self debugTestToolFlowSpec. ^ specs asArray - ] { #category : 'private' } MCPToolContractsTest >> unimplementedResponsibilitiesForConcreteMCPClasses [ | classes issues | - classes := (PackageOrganizer default packageNamed: #MCP) definedClasses - reject: [ :each | each isTrait ]. + classes := (PackageOrganizer default packageNamed: #MCP) + definedClasses reject: [ :each | each isTrait ]. issues := OrderedCollection new. classes do: [ :class | - class isAbstract ifFalse: [ - self - addUnimplementedResponsibilitiesFor: class - behavior: class - side: 'instance' - to: issues. - self - addUnimplementedResponsibilitiesFor: class - behavior: class class - side: 'class' - to: issues ] ]. + class isAbstract ifFalse: [ + self + addUnimplementedResponsibilitiesFor: class + behavior: class + side: 'instance' + to: issues. + self + addUnimplementedResponsibilitiesFor: class + behavior: class class + side: 'class' + to: issues ] ]. ^ issues asArray sort ] diff --git a/src/MCP-Tests/MCPToolGetClassTest.class.st b/src/MCP-Tests/MCPToolGetClassTest.class.st index 427f7cb..4f1acbb 100644 --- a/src/MCP-Tests/MCPToolGetClassTest.class.st +++ b/src/MCP-Tests/MCPToolGetClassTest.class.st @@ -38,18 +38,18 @@ MCPToolGetClassTest >> ensureClassComment: aComment onClassNamed: aClassName [ MCPToolGetClassTest >> ensureClassMethodSource: aMethodSource onClassNamed: aClassName [ self withoutEpiceaDuring: [ - (self classNamed: aClassName) classSide - compile: aMethodSource - classified: 'testing' ] + (self classNamed: aClassName) classSide + compile: aMethodSource + classified: 'testing' ] ] { #category : 'private' } MCPToolGetClassTest >> ensureMethodSource: aMethodSource onClassNamed: aClassName [ self withoutEpiceaDuring: [ - (self classNamed: aClassName) - compile: aMethodSource - classified: 'testing' ] + (self classNamed: aClassName) + compile: aMethodSource + classified: 'testing' ] ] { #category : 'private' } @@ -97,9 +97,9 @@ MCPToolGetClassTest >> restoreFixtureClasses [ slots: #( betaSlot alphaSlot ) classSlots: #( classBeta classAlpha ). self withoutEpiceaDuring: [ - (self classNamed: self baseClassName) - addClassVarNamed: 'BetaShared'; - addClassVarNamed: 'AlphaShared' ]. + (self classNamed: self baseClassName) + addClassVarNamed: 'BetaShared'; + addClassVarNamed: 'AlphaShared' ]. self createClassNamed: self childZClassName superclassName: self baseClassName diff --git a/src/MCP-Tests/MCPToolMethodMutationTest.class.st b/src/MCP-Tests/MCPToolMethodMutationTest.class.st index fe2e404..3828475 100644 --- a/src/MCP-Tests/MCPToolMethodMutationTest.class.st +++ b/src/MCP-Tests/MCPToolMethodMutationTest.class.st @@ -39,10 +39,13 @@ MCPToolMethodMutationTest >> assertCompileForClassName: aClassName methodSource: { #category : 'private' } MCPToolMethodMutationTest >> assertSuccessDataHasMethodShape: data [ - #( selector className classSide packageName isExtension protocol source side action updateAction oldSelector newSelector oldProtocol newProtocol ) do: [ :key | + #( selector className classSide packageName isExtension protocol + source side action updateAction oldSelector newSelector + oldProtocol newProtocol ) do: [ :key | self deny: (data includesKey: key) ]. (data includesKey: #changeKind) ifTrue: [ - self assert: (#( 'created' 'replaced' ) includes: (data at: #changeKind)) ] + self assert: + (#( 'created' 'replaced' ) includes: (data at: #changeKind)) ] ] { #category : 'private - calling' } @@ -113,10 +116,10 @@ MCPToolMethodMutationTest >> compileArgumentsForClassName: aClassName classSide: MCPToolMethodMutationTest >> createRenameScopeFixtureClassNamed: aClassName packageName: aPackageName [ self withoutEpiceaDuring: [ - | builder | - builder := Object << aClassName asSymbol. - builder package: aPackageName. - builder install ] + | builder | + builder := Object << aClassName asSymbol. + builder package: aPackageName. + builder install ] ] { #category : 'private' } @@ -355,7 +358,6 @@ MCPToolMethodMutationTest >> testAddArgumentsUpdatesClassSideSenders [ self assert: MCPToolMethodMutationTestSender new callClassTarget equals: 'Class-value' - ] { #category : 'tests' } @@ -386,7 +388,6 @@ MCPToolMethodMutationTest >> testAddArgumentsUpdatesSendersAndReportsAction [ self assert: MCPToolMethodMutationTestSender new callInstanceTarget equals: 'first-second' - ] { #category : 'tests' } @@ -432,8 +433,7 @@ MCPToolMethodMutationTest >> testChangesClassSideMethodProtocol [ >> self classProtocolSelector) protocol name asString equals: 'instance creation'. self assertSuccessDataHasMethodShape: data. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests' } @@ -449,8 +449,7 @@ MCPToolMethodMutationTest >> testChangesInstanceSideMethodProtocol [ protocol name asString equals: 'accessing'. self assertSuccessDataHasMethodShape: data. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests' } @@ -461,7 +460,9 @@ MCPToolMethodMutationTest >> testChangingExtensionMethodProtocolUpdatesPackageMe data := self dataFrom: result. self deny: (result at: #isError ifAbsent: [ false ]). self - assert: (MCPToolMethodMutationTestTarget >> self extensionProtocolSelector) protocol name asString + assert: + (MCPToolMethodMutationTestTarget >> self extensionProtocolSelector) + protocol name asString equals: 'tests'. self assertSuccessDataHasMethodShape: data ] @@ -636,13 +637,13 @@ MCPToolMethodMutationTest >> testCompileReturnsAllowlistedExcessiveArgumentsCrit selector := #argumentHeavyMethod:with:with:with:with:. self removeSelector: selector from: MCPToolMethodMutationTestTarget. [ - self - assertCompileForClassName: 'MCPToolMethodMutationTestTarget' - methodSource: - 'argumentHeavyMethod: first with: second with: third with: fourth with: fifth ^ first + second + third + fourth + fifth' - protocol: 'tests' - returnsSingleCritiqueRuleClass: 'ReExcessiveArgumentsRule' - titledLike: 'Excessive number of arguments' ] ensure: [ + self + assertCompileForClassName: 'MCPToolMethodMutationTestTarget' + methodSource: + 'argumentHeavyMethod: first with: second with: third with: fourth with: fifth ^ first + second + third + fourth + fifth' + protocol: 'tests' + returnsSingleCritiqueRuleClass: 'ReExcessiveArgumentsRule' + titledLike: 'Excessive number of arguments' ] ensure: [ self removeSelector: selector from: MCPToolMethodMutationTestTarget ] ] @@ -652,18 +653,18 @@ MCPToolMethodMutationTest >> testCompileReturnsAllowlistedMissingSuperSendsCriti self removeSelector: #initialize from: MCPToolHierarchyTestBase. self removeSelector: #initialize from: MCPToolHierarchyTestChild. [ - self - ensureMethodSource: 'initialize super initialize. ^ 1' - protocol: 'initialization' - on: MCPToolHierarchyTestBase. - self - assertCompileForClassName: 'MCPToolHierarchyTestChild' - methodSource: 'initialize 2 + 3' - protocol: 'initialization' - returnsSingleCritiqueRuleClass: 'ReMissingSuperSendsRule' - titledLike: 'Missing super sends' ] ensure: [ - self removeSelector: #initialize from: MCPToolHierarchyTestBase. - self removeSelector: #initialize from: MCPToolHierarchyTestChild ] + self + ensureMethodSource: 'initialize super initialize. ^ 1' + protocol: 'initialization' + on: MCPToolHierarchyTestBase. + self + assertCompileForClassName: 'MCPToolHierarchyTestChild' + methodSource: 'initialize 2 + 3' + protocol: 'initialization' + returnsSingleCritiqueRuleClass: 'ReMissingSuperSendsRule' + titledLike: 'Missing super sends' ] ensure: [ + self removeSelector: #initialize from: MCPToolHierarchyTestBase. + self removeSelector: #initialize from: MCPToolHierarchyTestChild ] ] { #category : 'tests' } @@ -705,12 +706,12 @@ MCPToolMethodMutationTest >> testCompileReturnsAllowlistedReturnInEnsureCritique selector := #returnInEnsure. self removeSelector: selector from: MCPToolMethodMutationTestTarget. [ - self - assertCompileForClassName: 'MCPToolMethodMutationTestTarget' - methodSource: 'returnInEnsure [ 1 ] ensure: [ ^ 2 ]' - protocol: 'tests' - returnsSingleCritiqueRuleClass: 'ReReturnInEnsureRule' - titledLike: 'return in an ensure:' ] ensure: [ + self + assertCompileForClassName: 'MCPToolMethodMutationTestTarget' + methodSource: 'returnInEnsure [ 1 ] ensure: [ ^ 2 ]' + protocol: 'tests' + returnsSingleCritiqueRuleClass: 'ReReturnInEnsureRule' + titledLike: 'return in an ensure:' ] ensure: [ self removeSelector: selector from: MCPToolMethodMutationTestTarget ] ] @@ -721,13 +722,13 @@ MCPToolMethodMutationTest >> testCompileReturnsAllowlistedUnaryAccessingWithoutR selector := #counterValue. self removeSelector: selector from: MCPToolGetMethodTestTarget. [ - self - assertCompileForClassName: 'MCPToolGetMethodTestTarget' - methodSource: 'counterValue instanceCounter + 1' - protocol: 'accessing' - returnsSingleCritiqueRuleClass: - 'ReUnaryAccessingMethodWithoutReturnRule' - titledLike: 'without explicit return' ] ensure: [ + self + assertCompileForClassName: 'MCPToolGetMethodTestTarget' + methodSource: 'counterValue instanceCounter + 1' + protocol: 'accessing' + returnsSingleCritiqueRuleClass: + 'ReUnaryAccessingMethodWithoutReturnRule' + titledLike: 'without explicit return' ] ensure: [ self removeSelector: selector from: MCPToolGetMethodTestTarget ] ] @@ -738,13 +739,13 @@ MCPToolMethodMutationTest >> testCompileReturnsAllowlistedWarningCritiques [ selector := #shadowedCounter:. self removeSelector: selector from: MCPToolGetMethodTestTarget. [ - self - assertCompileForClassName: 'MCPToolGetMethodTestTarget' - methodSource: - 'shadowedCounter: value | instanceCounter | instanceCounter := value. ^ instanceCounter + 1' - protocol: 'tests' - returnsSingleCritiqueRuleClass: 'ReTempVarOverridesInstVarRule' - titledLike: 'Outer variable shadowed' ] ensure: [ + self + assertCompileForClassName: 'MCPToolGetMethodTestTarget' + methodSource: + 'shadowedCounter: value | instanceCounter | instanceCounter := value. ^ instanceCounter + 1' + protocol: 'tests' + returnsSingleCritiqueRuleClass: 'ReTempVarOverridesInstVarRule' + titledLike: 'Outer variable shadowed' ] ensure: [ self removeSelector: selector from: MCPToolGetMethodTestTarget ] ] @@ -967,14 +968,14 @@ MCPToolMethodMutationTest >> testCompileStoresMethodSourceWithoutFormatterCorrup classSide: false methodSource: source protocol: 'tests'). - storedSource := (MCPToolMethodMutationTestTarget >> selector) sourceCode. + storedSource := (MCPToolMethodMutationTestTarget >> selector) + sourceCode. self deny: (result at: #isError ifAbsent: [ false ]). self assert: (storedSource includesSubstring: 'each asString'). self assert: (MCPToolMethodMutationTestTarget new perform: selector) - equals: '1,2' ] - ensure: [ - self removeSelector: selector from: MCPToolMethodMutationTestTarget ] + equals: '1,2' ] ensure: [ + self removeSelector: selector from: MCPToolMethodMutationTestTarget ] ] { #category : 'tests' } @@ -995,8 +996,7 @@ MCPToolMethodMutationTest >> testCompilesClassSideMethod [ protocol name equals: #tests. self assertSuccessDataHasMethodShape: data. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests' } @@ -1018,8 +1018,7 @@ MCPToolMethodMutationTest >> testCompilesInstanceSideMethod [ (MCPToolMethodMutationTestTarget >> #instanceAnswer) protocol name equals: #tests. self assertSuccessDataHasMethodShape: data. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests' } @@ -1037,8 +1036,8 @@ MCPToolMethodMutationTest >> testMCPPackageMethodSourcesDoNotContainLineFeeds [ MCPToolMethodMutationTest >> testMethodToolSchemasDeclareExpectedInputs [ | classSideProperty createPropertyNames protocolPropertyNames selectorPropertyNames | - createPropertyNames := MCPToolCompileMethod new inputSchema properties - collect: [ :each | each name ]. + createPropertyNames := MCPToolCompileMethod new inputSchema + properties collect: [ :each | each name ]. selectorPropertyNames := MCPToolUpdateMethodSelector new inputSchema properties collect: [ :each | each name ]. protocolPropertyNames := MCPToolUpdateMethodProtocol new inputSchema @@ -1047,8 +1046,7 @@ MCPToolMethodMutationTest >> testMethodToolSchemasDeclareExpectedInputs [ detect: [ :each | each name = 'classSide' ]. self assert: createPropertyNames asArray - equals: - #( 'className' 'classSide' 'force' 'source' 'protocol' ). + equals: #( 'className' 'classSide' 'force' 'source' 'protocol' ). self assert: selectorPropertyNames asArray equals: #( 'className' 'classSide' 'force' 'selector' 'newSelector' @@ -1082,8 +1080,8 @@ MCPToolMethodMutationTest >> testNormalizesLineEndingsBeforeCompilation [ classSide: false methodSource: source protocol: 'tests'). - normalizedSource := (MCPToolMethodMutationTestTarget >> #multilineAnswer) - sourceCode. + normalizedSource := (MCPToolMethodMutationTestTarget + >> #multilineAnswer) sourceCode. self deny: (normalizedSource includes: Character lf). self assert: (normalizedSource includes: Character cr). self @@ -1124,35 +1122,39 @@ MCPToolMethodMutationTest >> testRemoveArgumentsFailsWhenRemovedArgumentIsRefere oldSelector := ('referencedRemove:' , 'unused:') asSymbol. newSelector := #referencedRemove:. [ - self - ensureMethodSource: - 'referencedRemove: first unused: ignored ^ ignored' - protocol: 'tests' - on: MCPToolMethodMutationTestTarget. - result := self callToolWith: { - (#action -> 'update'). - (#className -> 'MCPToolMethodMutationTestTarget'). - (#classSide -> false). - (#selector -> oldSelector asString). - (#newSelector -> newSelector asString) } 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: #action) equals: 'update'. - self assert: (error at: #updateAction) equals: 'removeArguments'. - self - assert: (error at: #className) - equals: 'MCPToolMethodMutationTestTarget'. - self assert: (error at: #selector) equals: oldSelector asString. - self assert: (error at: #newSelector) equals: newSelector asString. - self assert: - (MCPToolMethodMutationTestTarget includesSelector: oldSelector). - self deny: - (MCPToolMethodMutationTestTarget includesSelector: newSelector) ] + self + ensureMethodSource: + 'referencedRemove: first unused: ignored ^ ignored' + protocol: 'tests' + on: MCPToolMethodMutationTestTarget. + result := self callToolWith: { + (#action -> 'update'). + (#className -> 'MCPToolMethodMutationTestTarget'). + (#classSide -> false). + (#selector -> oldSelector asString). + (#newSelector -> newSelector asString) } 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: #action) equals: 'update'. + self assert: (error at: #updateAction) equals: 'removeArguments'. + self + assert: (error at: #className) + equals: 'MCPToolMethodMutationTestTarget'. + self assert: (error at: #selector) equals: oldSelector asString. + self assert: (error at: #newSelector) equals: newSelector asString. + self assert: + (MCPToolMethodMutationTestTarget includesSelector: oldSelector). + self deny: + (MCPToolMethodMutationTestTarget includesSelector: newSelector) ] ensure: [ - self removeSelector: oldSelector from: MCPToolMethodMutationTestTarget. - self removeSelector: newSelector from: MCPToolMethodMutationTestTarget ] + self + removeSelector: oldSelector + from: MCPToolMethodMutationTestTarget. + self + removeSelector: newSelector + from: MCPToolMethodMutationTestTarget ] ] { #category : 'tests' } @@ -1199,7 +1201,6 @@ MCPToolMethodMutationTest >> testRemoveArgumentsUpdatesSendersAndReportsAction [ self removeSelector: #callRemoveArgumentTarget from: MCPToolMethodMutationTestSender ] - ] { #category : 'tests' } @@ -1292,22 +1293,27 @@ MCPToolMethodMutationTest >> testRenameKeepsRenamedMethodCallable [ protocol: 'tests' on: MCPToolMethodMutationTestTarget. result := self callToolWith: { - (#action -> 'update'). - (#className -> 'MCPToolMethodMutationTestTarget'). - (#classSide -> false). - (#selector -> oldSelector asString). - (#newSelector -> newSelector asString). - (#permutation -> #( 2 1 )) } asDictionary. + (#action -> 'update'). + (#className -> 'MCPToolMethodMutationTestTarget'). + (#classSide -> false). + (#selector -> oldSelector asString). + (#newSelector -> newSelector asString). + (#permutation -> #( 2 1 )) } asDictionary. target := MCPToolMethodMutationTestTarget new. self deny: (result at: #isError ifAbsent: [ false ]). - self deny: (MCPToolMethodMutationTestTarget includesSelector: oldSelector). - self assert: (MCPToolMethodMutationTestTarget includesSelector: newSelector). + self deny: + (MCPToolMethodMutationTestTarget includesSelector: oldSelector). + self assert: + (MCPToolMethodMutationTestTarget includesSelector: newSelector). self assert: (target perform: newSelector with: 'right' with: 'left') - equals: 'left-right' ] - ensure: [ - self removeSelector: oldSelector from: MCPToolMethodMutationTestTarget. - self removeSelector: newSelector from: MCPToolMethodMutationTestTarget ] + equals: 'left-right' ] ensure: [ + self + removeSelector: oldSelector + from: MCPToolMethodMutationTestTarget. + self + removeSelector: newSelector + from: MCPToolMethodMutationTestTarget ] ] { #category : 'tests' } @@ -1392,8 +1398,8 @@ MCPToolMethodMutationTest >> testRenameUpdatesSendersAndPermutesArguments [ self assert: MCPToolMethodMutationTestSender new callInstanceTarget equals: 'first-second'. - senderSource := (MCPToolMethodMutationTestSender >> #callInstanceTarget) - sourceCode. + senderSource := (MCPToolMethodMutationTestSender + >> #callInstanceTarget) sourceCode. self assert: (senderSource includesSubstring: 'with: ''second'' combine: ''first''') @@ -1416,8 +1422,7 @@ MCPToolMethodMutationTest >> testRenamesClassSideMethodWithDefaultPermutation [ assert: MCPToolMethodMutationTestSender new callClassTarget equals: 'Class-value'. self assertSuccessDataHasMethodShape: data. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'tests' } @@ -1432,8 +1437,7 @@ MCPToolMethodMutationTest >> testRenamesInstanceMethodAndReturnsStructuredData [ self assert: (MCPToolMethodMutationTestTarget includesSelector: self renamedInstanceSelector). self assertSuccessDataHasMethodShape: data. - self deny: (result at: #isError ifAbsent: [ false ]). - + self deny: (result at: #isError ifAbsent: [ false ]) ] { #category : 'private - calling' } @@ -1462,51 +1466,52 @@ MCPToolMethodMutationTest >> withRenameScopeFixturesDo: aBlock [ packageAName. packageBName } do: [ :eachName | self removePackageNamed: eachName ]. [ - self - createRenameScopeFixtureClassNamed: targetAClassName - packageName: packageAName. - self - createRenameScopeFixtureClassNamed: targetBClassName - packageName: packageBName. - self - createRenameScopeFixtureClassNamed: senderAClassName - packageName: packageAName. - self - createRenameScopeFixtureClassNamed: senderBClassName - packageName: packageBName. - self - ensureMethodSource: 'scopeSharedTarget ^ ''A''' - protocol: 'tests' - on: (Smalltalk globals at: targetAClassName asSymbol). - self - ensureMethodSource: 'scopeSharedTarget ^ ''B''' - protocol: 'tests' - on: (Smalltalk globals at: targetBClassName asSymbol). - self - ensureMethodSource: - 'callScopedTarget ^ MCPToolMethodMutationScopeTargetA new scopeSharedTarget' - protocol: 'tests' - on: (Smalltalk globals at: senderAClassName asSymbol). - self - ensureMethodSource: - 'callScopedTarget ^ MCPToolMethodMutationScopeTargetB new scopeSharedTarget' - protocol: 'tests' - on: (Smalltalk globals at: senderBClassName asSymbol). - fixtures := { - (#packageAName -> packageAName). - (#packageBName -> packageBName). - (#targetAClassName -> targetAClassName). - (#targetBClassName -> targetBClassName). - (#senderAClassName -> senderAClassName). - (#senderBClassName -> senderBClassName) } asDictionary. - aBlock value: fixtures ] ensure: [ - { - targetAClassName. - targetBClassName. - senderAClassName. - senderBClassName } do: [ :eachName | - self removeClassNamed: eachName ]. - { - packageAName. - packageBName } do: [ :eachName | self removePackageNamed: eachName ] ] + self + createRenameScopeFixtureClassNamed: targetAClassName + packageName: packageAName. + self + createRenameScopeFixtureClassNamed: targetBClassName + packageName: packageBName. + self + createRenameScopeFixtureClassNamed: senderAClassName + packageName: packageAName. + self + createRenameScopeFixtureClassNamed: senderBClassName + packageName: packageBName. + self + ensureMethodSource: 'scopeSharedTarget ^ ''A''' + protocol: 'tests' + on: (Smalltalk globals at: targetAClassName asSymbol). + self + ensureMethodSource: 'scopeSharedTarget ^ ''B''' + protocol: 'tests' + on: (Smalltalk globals at: targetBClassName asSymbol). + self + ensureMethodSource: + 'callScopedTarget ^ MCPToolMethodMutationScopeTargetA new scopeSharedTarget' + protocol: 'tests' + on: (Smalltalk globals at: senderAClassName asSymbol). + self + ensureMethodSource: + 'callScopedTarget ^ MCPToolMethodMutationScopeTargetB new scopeSharedTarget' + protocol: 'tests' + on: (Smalltalk globals at: senderBClassName asSymbol). + fixtures := { + (#packageAName -> packageAName). + (#packageBName -> packageBName). + (#targetAClassName -> targetAClassName). + (#targetBClassName -> targetBClassName). + (#senderAClassName -> senderAClassName). + (#senderBClassName -> senderBClassName) } asDictionary. + aBlock value: fixtures ] ensure: [ + { + targetAClassName. + targetBClassName. + senderAClassName. + senderBClassName } do: [ :eachName | + self removeClassNamed: eachName ]. + { + packageAName. + packageBName } do: [ :eachName | + self removePackageNamed: eachName ] ] ] diff --git a/src/MCP-Tests/MCPToolRemoveClassesTest.class.st b/src/MCP-Tests/MCPToolRemoveClassesTest.class.st index 2f52851..81f39fa 100644 --- a/src/MCP-Tests/MCPToolRemoveClassesTest.class.st +++ b/src/MCP-Tests/MCPToolRemoveClassesTest.class.st @@ -66,18 +66,18 @@ MCPToolRemoveClassesTest >> ensureClassNamed: aClassName superclassName: aSuperc (self class environment includesKey: symbol) ifTrue: [ ^ self ]. superclass := self class environment at: aSuperclassName asSymbol. self withoutEpiceaDuring: [ - (superclass << symbol) - package: aPackageName; - install ] + (superclass << symbol) + package: aPackageName; + install ] ] { #category : 'private' } MCPToolRemoveClassesTest >> ensureMethodSource: aMethodSource onClassNamed: aClassName [ self withoutEpiceaDuring: [ - (self classNamed: aClassName) - compile: aMethodSource - classified: 'tests' ] + (self classNamed: aClassName) + compile: aMethodSource + classified: 'tests' ] ] { #category : 'private' } @@ -219,34 +219,48 @@ MCPToolRemoveClassesTest >> tearDown [ MCPToolRemoveClassesTest >> testForceRemovesNonEmptyClassAndReparentsSubclassesWithWarnings [ | data result structured warnings | - result := self callToolWith: (self argumentsForClassNames: { self nonEmptyParentClassName } force: true). + result := self callToolWith: (self + argumentsForClassNames: { self nonEmptyParentClassName } + force: true). structured := self structuredContentFrom: result. data := self dataFrom: result. warnings := structured at: #warnings. self deny: (result at: #isError ifAbsent: [ false ]). - self deny: (self class environment includesKey: self nonEmptyParentClassName asSymbol). + self deny: (self class environment includesKey: + self nonEmptyParentClassName asSymbol). self - assert: (self classNamed: self nonEmptyChildClassName) superclass name asString + assert: + (self classNamed: self nonEmptyChildClassName) superclass name + asString equals: 'Object'. self assert: (data at: #reparentedSubclassNames ifAbsent: [ #( ) ]) equals: { self nonEmptyChildClassName } asArray. self assert: warnings size equals: 1. - self assert: (warnings first includesSubstring: self nonEmptyParentClassName) + self assert: + (warnings first includesSubstring: self nonEmptyParentClassName) ] { #category : 'tests' } MCPToolRemoveClassesTest >> testForceRemovesReferencedClassAndReturnsWarnings [ | result structured warnings | - result := self callToolWith: (self argumentsForClassNames: { self referencedClassName } force: true). + result := self callToolWith: + (self + argumentsForClassNames: { self referencedClassName } + force: true). structured := self structuredContentFrom: result. warnings := structured at: #warnings. self deny: (result at: #isError ifAbsent: [ false ]). - self deny: (self class environment includesKey: self referencedClassName asSymbol). - self assert: ((self classNamed: self senderClassName) includesSelector: #useReferencedClass). + self deny: + (self class environment includesKey: + self referencedClassName asSymbol). + self assert: + ((self classNamed: self senderClassName) includesSelector: + #useReferencedClass). self assert: warnings size equals: 1. - self assert: (warnings first includesSubstring: self referencedClassName) + self assert: + (warnings first includesSubstring: self referencedClassName) ] { #category : 'tests' } @@ -312,12 +326,16 @@ MCPToolRemoveClassesTest >> testReturnsStructuredErrorWhenNonEmptyClassHasSubcla MCPToolRemoveClassesTest >> testSafelyRemovesEmptyClassAndReparentsDirectSubclasses [ | data result | - result := self callToolWith: (self argumentsForClassNames: { self emptyParentClassName }). + result := self callToolWith: + (self argumentsForClassNames: + { self emptyParentClassName }). data := self dataFrom: result. self deny: (result at: #isError ifAbsent: [ false ]). - self deny: (self class environment includesKey: self emptyParentClassName asSymbol). + self deny: (self class environment includesKey: + self emptyParentClassName asSymbol). self - assert: (self classNamed: self emptyChildClassName) superclass name asString + assert: + (self classNamed: self emptyChildClassName) superclass name asString equals: 'Object'. self assert: (data at: #reparentedSubclassNames ifAbsent: [ #( ) ]) @@ -328,12 +346,16 @@ MCPToolRemoveClassesTest >> testSafelyRemovesEmptyClassAndReparentsDirectSubclas MCPToolRemoveClassesTest >> testSafelyRemovesSimpleClass [ | data result | - result := self callToolWith: (self argumentsForClassNames: self batchClassNames). + result := self callToolWith: + (self argumentsForClassNames: self batchClassNames). data := self dataFrom: result. self deny: (result at: #isError ifAbsent: [ false ]). - self deny: (self class environment includesKey: self simpleClassName asSymbol). - self deny: (self class environment includesKey: self packageCleanupClassName asSymbol). - self deny: (PackageOrganizer default hasPackage: self packageCleanupPackageName). + self deny: + (self class environment includesKey: self simpleClassName asSymbol). + self deny: (self class environment includesKey: + self packageCleanupClassName asSymbol). + self deny: + (PackageOrganizer default hasPackage: self packageCleanupPackageName). self assert: (data at: #removedPackageNames ifAbsent: [ #( ) ]) equals: { self packageCleanupPackageName } asArray diff --git a/src/MCP-Tests/MCPToolRemoveMethodsTest.class.st b/src/MCP-Tests/MCPToolRemoveMethodsTest.class.st index 61f4def..41b494b 100644 --- a/src/MCP-Tests/MCPToolRemoveMethodsTest.class.st +++ b/src/MCP-Tests/MCPToolRemoveMethodsTest.class.st @@ -223,11 +223,14 @@ MCPToolRemoveMethodsTest >> testDefaultsToRemovingInstanceSideMethodsWhenClassSi | result | result := self callToolWith: { - (#className -> 'MCPToolRemoveMethodsTestTarget'). - (#selectors -> self instanceBatchSelectors) } asDictionary. + (#className -> 'MCPToolRemoveMethodsTestTarget'). + (#selectors -> self instanceBatchSelectors) } + asDictionary. self deny: (result at: #isError ifAbsent: [ false ]). - self deny: (MCPToolRemoveMethodsTestTarget includesSelector: self firstInstanceBatchSelector). - self deny: (MCPToolRemoveMethodsTestTarget includesSelector: self secondInstanceBatchSelector) + self deny: (MCPToolRemoveMethodsTestTarget includesSelector: + self firstInstanceBatchSelector). + self deny: (MCPToolRemoveMethodsTestTarget includesSelector: + self secondInstanceBatchSelector) ] { #category : 'tests' } @@ -235,18 +238,27 @@ MCPToolRemoveMethodsTest >> testForceRemovesMethodsEvenWhenExternalSendersExistA | result structured text warnings | result := self callToolWith: { - (#className -> 'MCPToolRemoveMethodsTestTarget'). - (#classSide -> false). - (#selectors -> { self protectedSelector }) } asDictionary. + (#className -> 'MCPToolRemoveMethodsTestTarget'). + (#classSide -> false). + (#selectors -> { self protectedSelector }) } asDictionary. structured := self structuredContentFrom: result. text := self firstTextFrom: result. warnings := structured at: #warnings. self deny: (result at: #isError ifAbsent: [ false ]). self deny: (text includesSubstring: 'Warning:'). - self assert: warnings equals: { 'This bypasses sender checks and may leave broken senders.' } asArray. - self deny: (MCPToolRemoveMethodsTestTarget includesSelector: self protectedSelectorSymbol). - self assert: (MCPToolRemoveMethodsTestSender includesSelector: #sendProtectedRemovalTarget). - self should: [ MCPToolRemoveMethodsTestSender new sendProtectedRemovalTarget ] raise: MessageNotUnderstood + self + assert: warnings + equals: + { 'This bypasses sender checks and may leave broken senders.' } + asArray. + self deny: (MCPToolRemoveMethodsTestTarget includesSelector: + self protectedSelectorSymbol). + self assert: (MCPToolRemoveMethodsTestSender includesSelector: + #sendProtectedRemovalTarget). + self + should: [ + MCPToolRemoveMethodsTestSender new sendProtectedRemovalTarget ] + raise: MessageNotUnderstood ] { #category : 'tests' } @@ -277,8 +289,12 @@ MCPToolRemoveMethodsTest >> testRemovesBatchOfClassSideMethods [ | result | result := self callToolWith: self classBatchArguments. self deny: (result at: #isError ifAbsent: [ false ]). - self deny: (MCPToolRemoveMethodsTestTarget classSide includesSelector: self firstClassBatchSelector). - self deny: (MCPToolRemoveMethodsTestTarget classSide includesSelector: self secondClassBatchSelector) + self deny: + (MCPToolRemoveMethodsTestTarget classSide includesSelector: + self firstClassBatchSelector). + self deny: + (MCPToolRemoveMethodsTestTarget classSide includesSelector: + self secondClassBatchSelector) ] { #category : 'tests' } @@ -287,8 +303,10 @@ MCPToolRemoveMethodsTest >> testRemovesBatchOfInstanceMethods [ | result | result := self callToolWith: self instanceBatchArguments. self deny: (result at: #isError ifAbsent: [ false ]). - self deny: (MCPToolRemoveMethodsTestTarget includesSelector: self firstInstanceBatchSelector). - self deny: (MCPToolRemoveMethodsTestTarget includesSelector: self secondInstanceBatchSelector) + self deny: (MCPToolRemoveMethodsTestTarget includesSelector: + self firstInstanceBatchSelector). + self deny: (MCPToolRemoveMethodsTestTarget includesSelector: + self secondInstanceBatchSelector) ] { #category : 'tests' } @@ -296,9 +314,11 @@ MCPToolRemoveMethodsTest >> testReturnsStructuredErrorWhenAnyMethodIsMissing [ | error result structured | result := self callToolWith: { - (#className -> 'MCPToolRemoveMethodsTestTarget'). - (#classSide -> false). - (#selectors -> { self firstInstanceBatchSelectorString. self missingSelectorString }) } asDictionary. + (#className -> 'MCPToolRemoveMethodsTestTarget'). + (#classSide -> false). + (#selectors -> { + self firstInstanceBatchSelectorString. + self missingSelectorString }) } asDictionary. structured := self structuredContentFrom: result. error := self errorFrom: result. self assert: (result at: #isError). @@ -306,7 +326,8 @@ MCPToolRemoveMethodsTest >> testReturnsStructuredErrorWhenAnyMethodIsMissing [ self assert: (error at: #errorClass) equals: 'MCPCommandError'. self assert: (error at: #errorCode) equals: 'MethodNotFound'. self assert: (error at: #selector) equals: self missingSelectorString. - self assert: (MCPToolRemoveMethodsTestTarget includesSelector: self firstInstanceBatchSelector) + self assert: (MCPToolRemoveMethodsTestTarget includesSelector: + self firstInstanceBatchSelector) ] { #category : 'tests' } diff --git a/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st b/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st index c287e72..b801339 100644 --- a/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st +++ b/src/MCP-Tests/MCPToolRepositoryOperationTest.class.st @@ -74,11 +74,11 @@ MCPToolRepositoryOperationTest >> commitAllIn: aRepositoryLocation message: aMes MCPToolRepositoryOperationTest >> createClassNamed: aClassName inPackageNamed: aPackageName [ ^ self withoutEpiceaDuring: [ - | builder | - builder := Object << aClassName asSymbol. - builder package: aPackageName. - builder tag: 'Generated'. - builder install ] + | builder | + builder := Object << aClassName asSymbol. + builder package: aPackageName. + builder tag: 'Generated'. + builder install ] ] { #category : 'private' } @@ -148,7 +148,7 @@ MCPToolRepositoryOperationTest >> removeRegisteredRepositoriesNamed: aRepository registry := IceRepository registry. repositories := registry select: [ :each | each name asString = aRepositoryName ]. - repositories do: [ :each | registry remove: each ifAbsent: [ ] ] + repositories do: [ :each | registry remove: each ifAbsent: [ ] ] ] { #category : 'private - calling' } @@ -235,7 +235,6 @@ MCPToolRepositoryOperationTest >> testAdoptHeadOperationRequiresRepositoryAndPar self assert: parsedRequest operation equals: 'adoptHead'. self assert: parsedRequest branchName equals: 'main'. self assert: command class equals: MCPAdoptRepositoryHeadCommand - ] { #category : 'tests' } @@ -278,7 +277,6 @@ MCPToolRepositoryOperationTest >> testAttachParsesAndDispatchesToAttachCommand [ self assert: parsedRequest class equals: MCPRepositoryAttachRequest. self assert: parsedRequest operation equals: 'attach'. self assert: command class equals: MCPAttachRepositoryCommand - ] { #category : 'tests' } @@ -534,7 +532,6 @@ MCPToolRepositoryOperationTest >> testCommitParsesAndDispatchesToCommitCommand [ self assert: parsedRequest message equals: 'Commit from test'. self assert: parsedRequest operation equals: 'commit'. self assert: command class equals: MCPCommitRepositoryCommand - ] { #category : 'tests' } @@ -549,27 +546,27 @@ MCPToolRepositoryOperationTest >> testCommitReportsIcebergRefusalErrors [ withExportPackageNamed: packageName className: 'MCPToolRepositoryOperationRefusedCommitClass' do: [ - self - withCleanRepositoryNamed: repositoryName - location: location - do: [ - self callToolWith: { - (#action -> 'create'). - (#name -> repositoryName). - (#location -> location pathString). - (#packageNames -> { packageName }) } asDictionary. - self callToolWith: { - (#action -> 'commit'). - (#repositoryName -> repositoryName). - (#message -> 'Initial commit from MCP test') } asDictionary. - result := self callToolWith: { - (#action -> 'commit'). - (#repositoryName -> repositoryName). - (#message -> 'Second commit from MCP test') } - asDictionary. - self assert: (result at: #isError ifAbsent: [ false ]). - self assert: ((self summaryFrom: result) includesSubstring: - 'Failed to commit repository') ] ] + self + withCleanRepositoryNamed: repositoryName + location: location + do: [ + self callToolWith: { + (#action -> 'create'). + (#name -> repositoryName). + (#location -> location pathString). + (#packageNames -> { packageName }) } asDictionary. + self callToolWith: { + (#action -> 'commit'). + (#repositoryName -> repositoryName). + (#message -> 'Initial commit from MCP test') } asDictionary. + result := self callToolWith: { + (#action -> 'commit'). + (#repositoryName -> repositoryName). + (#message -> 'Second commit from MCP test') } + asDictionary. + self assert: (result at: #isError ifAbsent: [ false ]). + self assert: ((self summaryFrom: result) includesSubstring: + 'Failed to commit repository') ] ] ] { #category : 'tests' } @@ -610,8 +607,8 @@ MCPToolRepositoryOperationTest >> testCommitUsesFallbackGitIdentityWhenGitSignat | data location packageName repository repositoryName result | PharoCompatibility isPharo13OrLater ifTrue: [ - self skip: - 'Pharo 13 commits use the Author API; forcing empty libgit2 config can crash the VM in CI.' ]. + self skip: + 'Pharo 13 commits use the Author API; forcing empty libgit2 config can crash the VM in CI.' ]. repositoryName := 'MCP Repository Command Commit Fallback Identity Test'. packageName := 'MCPToolRepositoryOperationCommitFallbackIdentityPackage'. location := self temporaryRepositoryLocationNamed: @@ -620,32 +617,32 @@ MCPToolRepositoryOperationTest >> testCommitUsesFallbackGitIdentityWhenGitSignat withExportPackageNamed: packageName className: 'MCPToolRepositoryOperationCommitFallbackIdentityClass' do: [ - self - withCleanRepositoryNamed: repositoryName - location: location - do: [ - self callToolWith: { - (#action -> 'create'). - (#name -> repositoryName). - (#location -> location pathString). - (#packageNames -> { packageName }) } asDictionary. - repository := IceRepository repositories detect: [ :each | - each name asString = repositoryName ]. - repository repositoryHandle config - username: ''; - email: ''. - result := self callToolWith: { - (#action -> 'commit'). - (#repositoryName -> repositoryName). - (#message - -> 'Commit with fallback identity from MCP test') } - asDictionary. - self deny: (result at: #isError ifAbsent: [ false ]). - data := self dataFrom: result. - self - assert: (data at: #commitDescription) - equals: 'Commit with fallback identity from MCP test'. - self assert: repository headCommit author equals: 'MCP' ] ] + self + withCleanRepositoryNamed: repositoryName + location: location + do: [ + self callToolWith: { + (#action -> 'create'). + (#name -> repositoryName). + (#location -> location pathString). + (#packageNames -> { packageName }) } asDictionary. + repository := IceRepository repositories detect: [ :each | + each name asString = repositoryName ]. + repository repositoryHandle config + username: ''; + email: ''. + result := self callToolWith: { + (#action -> 'commit'). + (#repositoryName -> repositoryName). + (#message + -> 'Commit with fallback identity from MCP test') } + asDictionary. + self deny: (result at: #isError ifAbsent: [ false ]). + data := self dataFrom: result. + self + assert: (data at: #commitDescription) + equals: 'Commit with fallback identity from MCP test'. + self assert: repository headCommit author equals: 'MCP' ] ] ] { #category : 'tests' } @@ -781,7 +778,6 @@ MCPToolRepositoryOperationTest >> testDiffParsesAndDispatchesToDiffCommand [ self assert: parsedRequest class equals: MCPRepositoryDiffRequest. self assert: parsedRequest operation equals: 'diff'. self assert: command class equals: MCPRepositoryDiffCommand - ] { #category : 'tests' } @@ -1024,34 +1020,34 @@ MCPToolRepositoryOperationTest >> testPullReportsIcebergMergeAndLoadErrors [ repository failPull: IceMergeAborted -> 'Iceberg merge failed for test repository'. self withRegisteredRepository: repository do: [ - mergeErrorResult := self callToolWith: { - (#action -> 'pull'). - (#repositoryName -> repository name) } - asDictionary. - self assert: (mergeErrorResult at: #isError ifAbsent: [ false ]). - self assert: - ((self summaryFrom: mergeErrorResult) includesSubstring: - 'Failed to pull repository'). - self assert: - ((self summaryFrom: mergeErrorResult) includesSubstring: - 'Iceberg merge failed') ]. + mergeErrorResult := self callToolWith: { + (#action -> 'pull'). + (#repositoryName -> repository name) } + asDictionary. + self assert: (mergeErrorResult at: #isError ifAbsent: [ false ]). + self assert: + ((self summaryFrom: mergeErrorResult) includesSubstring: + 'Failed to pull repository'). + self assert: + ((self summaryFrom: mergeErrorResult) includesSubstring: + 'Iceberg merge failed') ]. repository := self newTestRepositoryNamed: 'MCP Pull Load Error Test Repository'. repository failPull: IceCheckoutConflictError -> 'Iceberg load failed for test repository'. self withRegisteredRepository: repository do: [ - loadErrorResult := self callToolWith: { - (#action -> 'pull'). - (#repositoryName -> repository name) } - asDictionary. - self assert: (loadErrorResult at: #isError ifAbsent: [ false ]). - self assert: - ((self summaryFrom: loadErrorResult) includesSubstring: - 'Failed to pull repository'). - self assert: - ((self summaryFrom: loadErrorResult) includesSubstring: - 'Iceberg load failed') ] + loadErrorResult := self callToolWith: { + (#action -> 'pull'). + (#repositoryName -> repository name) } + asDictionary. + self assert: (loadErrorResult at: #isError ifAbsent: [ false ]). + self assert: + ((self summaryFrom: loadErrorResult) includesSubstring: + 'Failed to pull repository'). + self assert: + ((self summaryFrom: loadErrorResult) includesSubstring: + 'Iceberg load failed') ] ] { #category : 'tests' } @@ -1103,33 +1099,33 @@ MCPToolRepositoryOperationTest >> testPushReportsRemoteAndAuthenticationErrors [ repository failPush: IceRemoteNotFoundError -> 'Iceberg remote not found for test repository'. self withRegisteredRepository: repository do: [ - remoteErrorResult := self callToolWith: { - (#action -> 'push'). - (#repositoryName -> repository name) } - asDictionary. - self assert: (remoteErrorResult at: #isError ifAbsent: [ false ]). - self assert: - ((self summaryFrom: remoteErrorResult) includesSubstring: - 'Failed to push repository'). - self assert: - ((self summaryFrom: remoteErrorResult) includesSubstring: - 'Iceberg remote not found') ]. + remoteErrorResult := self callToolWith: { + (#action -> 'push'). + (#repositoryName -> repository name) } + asDictionary. + self assert: (remoteErrorResult at: #isError ifAbsent: [ false ]). + self assert: + ((self summaryFrom: remoteErrorResult) includesSubstring: + 'Failed to push repository'). + self assert: + ((self summaryFrom: remoteErrorResult) includesSubstring: + 'Iceberg remote not found') ]. repository := self newTestRepositoryNamed: 'MCP Push Authentication Error Test Repository'. repository failPush: IceAuthenticationError -> 'Iceberg authentication failed for test repository'. self withRegisteredRepository: repository do: [ - authErrorResult := self callToolWith: { - (#action -> 'push'). - (#repositoryName -> repository name) } - asDictionary. - self assert: (authErrorResult at: #isError ifAbsent: [ false ]). - self assert: - ((self summaryFrom: authErrorResult) includesSubstring: - 'Failed to push repository'). - self assert: - ((self summaryFrom: authErrorResult) includesSubstring: - 'Iceberg authentication failed') ] + authErrorResult := self callToolWith: { + (#action -> 'push'). + (#repositoryName -> repository name) } + asDictionary. + self assert: (authErrorResult at: #isError ifAbsent: [ false ]). + self assert: + ((self summaryFrom: authErrorResult) includesSubstring: + 'Failed to push repository'). + self assert: + ((self summaryFrom: authErrorResult) includesSubstring: + 'Iceberg authentication failed') ] ] { #category : 'tests' } @@ -1240,15 +1236,14 @@ MCPToolRepositoryOperationTest >> testRepositoryErrorDetailsUseActionNotOperatio 'MCP Repository Error Action Test Repository'. repository failPush: true. self withRegisteredRepository: repository do: [ - result := self callToolWith: { - (#action -> 'push'). - (#repositoryName -> repository name) } asDictionary. - self assert: (result at: #isError ifAbsent: [ false ]). - errorDetails := self errorFrom: result. - self assert: (errorDetails at: #action) equals: 'push'. - self deny: (errorDetails includesKey: #operation). - self deny: (errorDetails includesKey: #updateAction) ] - + result := self callToolWith: { + (#action -> 'push'). + (#repositoryName -> repository name) } asDictionary. + self assert: (result at: #isError ifAbsent: [ false ]). + errorDetails := self errorFrom: result. + self assert: (errorDetails at: #action) equals: 'push'. + self deny: (errorDetails includesKey: #operation). + self deny: (errorDetails includesKey: #updateAction) ] ] { #category : 'tests' } @@ -1415,34 +1410,36 @@ MCPToolRepositoryOperationTest >> testUpdateCanReplacePackageMembership [ | data repository result | repository := self - newRepositoryNamed: 'MCP Repository Command Replace Test' + newRepositoryNamed: + 'MCP Repository Command Replace Test' location: FileLocator imageDirectory packageNames: #( 'MCPToolRepositoryOperationOldA' 'MCPToolRepositoryOperationOldB' ). self withRegisteredRepository: repository do: [ - result := self callToolWith: { - (#action -> 'update'). - (#repositoryName -> repository name). - (#packageNames - -> - #( 'MCPToolRepositoryOperationNewC' - 'MCPToolRepositoryOperationOldB' )) } asDictionary. - data := self dataFrom: result. - self deny: (result at: #isError ifAbsent: [ false ]). - self - assert: (self packageNamesIn: repository) - equals: - #( 'MCPToolRepositoryOperationNewC' 'MCPToolRepositoryOperationOldB' ). - self - assert: (data at: #updateActions) - equals: #( 'replacePackages' ). - self - assert: (data at: #addedPackageNames) - equals: #( 'MCPToolRepositoryOperationNewC' ). - self - assert: (data at: #removedPackageNames) - equals: #( 'MCPToolRepositoryOperationOldA' ) ] + result := self callToolWith: { + (#action -> 'update'). + (#repositoryName -> repository name). + (#packageNames + -> + #( 'MCPToolRepositoryOperationNewC' + 'MCPToolRepositoryOperationOldB' )) } asDictionary. + data := self dataFrom: result. + self deny: (result at: #isError ifAbsent: [ false ]). + self + assert: (self packageNamesIn: repository) + equals: + #( 'MCPToolRepositoryOperationNewC' + 'MCPToolRepositoryOperationOldB' ). + self + assert: (data at: #updateActions) + equals: #( 'replacePackages' ). + self + assert: (data at: #addedPackageNames) + equals: #( 'MCPToolRepositoryOperationNewC' ). + self + assert: (data at: #removedPackageNames) + equals: #( 'MCPToolRepositoryOperationOldA' ) ] ] { #category : 'tests' } @@ -1510,12 +1507,13 @@ MCPToolRepositoryOperationTest >> testVerifyIdentityOperationRequiresRepositoryA parsedRequest := tool parsedRequestFromToolRequest: rawRequest. command := tool commandForRequest: parsedRequest. - self assert: parsedRequest class equals: MCPRepositoryVerifyIdentityRequest. + self + assert: parsedRequest class + equals: MCPRepositoryVerifyIdentityRequest. self assert: parsedRequest operation equals: 'verifyIdentity'. self assert: parsedRequest branchName equals: 'main'. self assert: parsedRequest isModified equals: false. self assert: command class equals: MCPRepositoryVerifyIdentityCommand - ] { #category : 'tests' } @@ -1584,24 +1582,24 @@ MCPToolRepositoryOperationTest >> testVerifyIdentityReportsWrongLocationAsIdenti repository := self newTestRepositoryNamed: 'MCP VerifyIdentity Location Mismatch Test Repository'. self withRegisteredRepository: repository do: [ - result := self callToolWith: { - (#action -> 'verifyIdentity'). - (#repositoryName -> repository name). - (#location -> 'memory://different-location') } - asDictionary. - self assert: (result at: #isError ifAbsent: [ false ]). - errorDetails := self errorFrom: result. - self - assert: (errorDetails at: #errorCode) - equals: 'RepositoryIdentityMismatch'. - locationMismatch := (errorDetails at: #mismatches) detect: [ - :each | (each at: #field) = 'location' ]. - self - assert: (locationMismatch at: #expected) - equals: 'memory://different-location'. - self - assert: (locationMismatch at: #actual) - equals: repository location ] + result := self callToolWith: { + (#action -> 'verifyIdentity'). + (#repositoryName -> repository name). + (#location -> 'memory://different-location') } + asDictionary. + self assert: (result at: #isError ifAbsent: [ false ]). + errorDetails := self errorFrom: result. + self + assert: (errorDetails at: #errorCode) + equals: 'RepositoryIdentityMismatch'. + locationMismatch := (errorDetails at: #mismatches) detect: [ :each | + (each at: #field) = 'location' ]. + self + assert: (locationMismatch at: #expected) + equals: 'memory://different-location'. + self + assert: (locationMismatch at: #actual) + equals: repository location ] ] { #category : 'tests' } @@ -1611,17 +1609,16 @@ MCPToolRepositoryOperationTest >> testVerifyIdentityRequiresExpectedIdentityFiel repository := self newTestRepositoryNamed: 'MCP VerifyIdentity Missing Expected Field Test Repository'. self withRegisteredRepository: repository do: [ - result := self callToolWith: { - (#action -> 'verifyIdentity'). - (#repositoryName -> repository name) } asDictionary. - self assert: (result at: #isError ifAbsent: [ false ]). - errorDetails := self errorFrom: result. - self - assert: (errorDetails at: #errorCode) - equals: 'RepositoryIdentityExpectationRequired'. - self assert: - ((self summaryFrom: result) includesSubstring: - 'requires at least one expected identity field') ] + result := self callToolWith: { + (#action -> 'verifyIdentity'). + (#repositoryName -> repository name) } asDictionary. + self assert: (result at: #isError ifAbsent: [ false ]). + errorDetails := self errorFrom: result. + self + assert: (errorDetails at: #errorCode) + equals: 'RepositoryIdentityExpectationRequired'. + self assert: ((self summaryFrom: result) includesSubstring: + 'requires at least one expected identity field') ] ] { #category : 'private - fixtures' } @@ -1668,23 +1665,23 @@ MCPToolRepositoryOperationTest >> toolName [ MCPToolRepositoryOperationTest >> withCleanRepositoryNamed: aRepositoryName location: aFileReference do: aBlock [ [ - self removeRegisteredRepositoriesNamed: aRepositoryName. - self deleteDirectoryIfExists: aFileReference. - aBlock value ] ensure: [ self removeRegisteredRepositoriesNamed: aRepositoryName. - self deleteDirectoryIfExists: aFileReference ] + self deleteDirectoryIfExists: aFileReference. + aBlock value ] ensure: [ + self removeRegisteredRepositoriesNamed: aRepositoryName. + self deleteDirectoryIfExists: aFileReference ] ] { #category : 'private - classes' } MCPToolRepositoryOperationTest >> withExportPackageNamed: aPackageName className: aClassName do: aBlock [ [ - self removeClassNamed: aClassName. - self removePackageNamed: aPackageName. - self createClassNamed: aClassName inPackageNamed: aPackageName. - aBlock value ] ensure: [ self removeClassNamed: aClassName. - self removePackageNamed: aPackageName ] + self removePackageNamed: aPackageName. + self createClassNamed: aClassName inPackageNamed: aPackageName. + aBlock value ] ensure: [ + self removeClassNamed: aClassName. + self removePackageNamed: aPackageName ] ] { #category : 'private' } diff --git a/src/MCP-Tests/MCPToolRequestTest.class.st b/src/MCP-Tests/MCPToolRequestTest.class.st index 26b4c33..49a0cfc 100644 --- a/src/MCP-Tests/MCPToolRequestTest.class.st +++ b/src/MCP-Tests/MCPToolRequestTest.class.st @@ -26,9 +26,9 @@ MCPToolRequestTest >> testInvalidRequestRaisesInvalidParameters [ self should: [ - MCPToolRequest - tool: MCPToolSearchClasses new - arguments: { (#caseSensitive -> 'true') } asDictionary ] + MCPToolRequest + tool: MCPToolSearchClasses new + arguments: { (#caseSensitive -> 'true') } asDictionary ] raise: JRPCInvalidParameters ] @@ -37,9 +37,9 @@ MCPToolRequestTest >> testInvalidRequestRaisesToolInputErrorWithViolations [ | error violation | [ - MCPToolRequest - tool: MCPToolSearchClasses new - arguments: { (#caseSensitive -> 'true') } asDictionary ] + MCPToolRequest + tool: MCPToolSearchClasses new + arguments: { (#caseSensitive -> 'true') } asDictionary ] on: MCPInvalidToolInput do: [ :signalledError | error := signalledError ]. self assert: error isNotNil. @@ -57,9 +57,9 @@ MCPToolRequestTest >> testInvalidToolInputErrorResponseIncludesViolations [ | data error errorJson firstViolation response violations | [ - MCPToolRequest - tool: MCPToolSearchClasses new - arguments: { (#caseSensitive -> 'true') } asDictionary ] + MCPToolRequest + tool: MCPToolSearchClasses new + arguments: { (#caseSensitive -> 'true') } asDictionary ] on: MCPInvalidToolInput do: [ :signalledError | error := signalledError ]. response := (error asJRPCResponseWithId: 7) asJRPCJSON. diff --git a/src/MCP-Tests/MCPToolSearchPackagesTest.class.st b/src/MCP-Tests/MCPToolSearchPackagesTest.class.st index 6613614..d1f79a6 100644 --- a/src/MCP-Tests/MCPToolSearchPackagesTest.class.st +++ b/src/MCP-Tests/MCPToolSearchPackagesTest.class.st @@ -13,11 +13,11 @@ Class { MCPToolSearchPackagesTest >> createFixtureClassNamed: aClassName packageName: aPackageName tag: aTag [ ^ self withoutEpiceaDuring: [ - | builder | - builder := Object << aClassName asSymbol. - builder package: aPackageName. - builder tag: aTag. - builder install ] + | builder | + builder := Object << aClassName asSymbol. + builder package: aPackageName. + builder tag: aTag. + builder install ] ] { #category : 'private' } @@ -234,31 +234,31 @@ MCPToolSearchPackagesTest >> withTemporaryTaggedPackagesDo: aBlock [ self removePackageNamed: alphaPackageName. self removePackageNamed: betaPackageName. [ - self - createFixtureClassNamed: alphaClassName - packageName: alphaPackageName - tag: 'FixtureAlphaTag'. - self - createFixtureClassNamed: betaClassName - packageName: betaPackageName - tag: 'FixtureBetaTag'. - alphaPackage := PackageOrganizer default packageNamed: - alphaPackageName asSymbol. - betaPackage := PackageOrganizer default packageNamed: - betaPackageName asSymbol. - packageProjectNames := Dictionary new - at: alphaPackageName - put: #( 'FixtureProject' ); - at: betaPackageName - put: #( 'FixtureProject' ); - yourself. - aBlock - value: { - alphaPackage. - betaPackage } asArray - value: packageProjectNames ] ensure: [ - self removeClassNamed: alphaClassName. - self removeClassNamed: betaClassName. - self removePackageNamed: alphaPackageName. - self removePackageNamed: betaPackageName ] + self + createFixtureClassNamed: alphaClassName + packageName: alphaPackageName + tag: 'FixtureAlphaTag'. + self + createFixtureClassNamed: betaClassName + packageName: betaPackageName + tag: 'FixtureBetaTag'. + alphaPackage := PackageOrganizer default packageNamed: + alphaPackageName asSymbol. + betaPackage := PackageOrganizer default packageNamed: + betaPackageName asSymbol. + packageProjectNames := Dictionary new + at: alphaPackageName + put: #( 'FixtureProject' ); + at: betaPackageName + put: #( 'FixtureProject' ); + yourself. + aBlock + value: { + alphaPackage. + betaPackage } asArray + value: packageProjectNames ] ensure: [ + self removeClassNamed: alphaClassName. + self removeClassNamed: betaClassName. + self removePackageNamed: alphaPackageName. + self removePackageNamed: betaPackageName ] ] diff --git a/src/MCP-Tests/MCPToolSearchRepositoriesTest.class.st b/src/MCP-Tests/MCPToolSearchRepositoriesTest.class.st index 0e64c5a..bad3e49 100644 --- a/src/MCP-Tests/MCPToolSearchRepositoriesTest.class.st +++ b/src/MCP-Tests/MCPToolSearchRepositoriesTest.class.st @@ -219,9 +219,9 @@ MCPToolSearchRepositoriesTest >> withRepositories: repositories do: aBlock [ registry := IceRepository registry. previousRepositories := registry copy. [ - registry removeAll. - registry addAll: repositories. - aBlock value ] ensure: [ registry removeAll. - registry addAll: previousRepositories ] + registry addAll: repositories. + aBlock value ] ensure: [ + registry removeAll. + registry addAll: previousRepositories ] ] diff --git a/src/MCP-Tests/MCPToolStructuredOutputTest.class.st b/src/MCP-Tests/MCPToolStructuredOutputTest.class.st index fcbcf57..6689dbe 100644 --- a/src/MCP-Tests/MCPToolStructuredOutputTest.class.st +++ b/src/MCP-Tests/MCPToolStructuredOutputTest.class.st @@ -294,8 +294,8 @@ MCPToolStructuredOutputTest >> testRunTestClassReturnsStructuredIssues [ result := self callToolNamed: 'test_run' withArguments: - { (#classes -> #( 'MCPToolStructuredOutputTestTarget' )) } - asDictionary. + { (#classes -> #( 'MCPToolStructuredOutputTestTarget' )) } + asDictionary. data := self dataFrom: result. self assert: ((self structuredContentFrom: result) at: #status) @@ -305,10 +305,17 @@ MCPToolStructuredOutputTest >> testRunTestClassReturnsStructuredIssues [ skipped := data at: #skipped. failure := (data at: #failures) first. error := (data at: #errors) first. - self assert: skipped equals: #( 'MCPToolStructuredOutputTestTarget>>#testSkips' ). - self assert: (failure at: #test) equals: 'MCPToolStructuredOutputTestTarget>>#testFails'. - self assert: ((failure at: #message) includesSubstring: 'boom failure'). - self assert: (error at: #test) equals: 'MCPToolStructuredOutputTestTarget>>#testErrors'. + self + assert: skipped + equals: #( 'MCPToolStructuredOutputTestTarget>>#testSkips' ). + self + assert: (failure at: #test) + equals: 'MCPToolStructuredOutputTestTarget>>#testFails'. + self assert: + ((failure at: #message) includesSubstring: 'boom failure'). + self + assert: (error at: #test) + equals: 'MCPToolStructuredOutputTestTarget>>#testErrors'. self assert: (error at: #errorClass) equals: 'Error'. self assert: ((error at: #message) includesSubstring: 'boom error'). self deny: (data includesKey: #results). @@ -321,9 +328,10 @@ MCPToolStructuredOutputTest >> testRunTestMethodReturnsStructuredIssues [ | data failure result | result := self callToolNamed: 'test_run' - withArguments: { (#methods -> - #( 'MCPToolStructuredOutputTestTarget>>#testFails' )) } - asDictionary. + withArguments: + { (#methods + -> #( 'MCPToolStructuredOutputTestTarget>>#testFails' )) } + asDictionary. data := self dataFrom: result. failure := (data at: #failures) first. self @@ -332,8 +340,11 @@ MCPToolStructuredOutputTest >> testRunTestMethodReturnsStructuredIssues [ self assert: (data at: #runCount) equals: 1. self assert: (data at: #passedCount) equals: 0. self assert: (data at: #failures) size equals: 1. - self assert: (failure at: #test) equals: 'MCPToolStructuredOutputTestTarget>>#testFails'. - self assert: ((failure at: #message) includesSubstring: 'boom failure'). + self + assert: (failure at: #test) + equals: 'MCPToolStructuredOutputTestTarget>>#testFails'. + self assert: + ((failure at: #message) includesSubstring: 'boom failure'). self deny: (data includesKey: #results). self deny: (data includesKey: #skipped). self deny: (data includesKey: #errors) @@ -343,15 +354,15 @@ MCPToolStructuredOutputTest >> testRunTestMethodReturnsStructuredIssues [ MCPToolStructuredOutputTest >> testRunTestsCoverageCanIncludeCoveredMethodsAndCapLists [ | coverage coveredSelectors data result | - result := self - callToolNamed: 'test_coverage_run' - withArguments: { + result := self callToolNamed: 'test_coverage_run' withArguments: { (#classes -> #( 'MCPToolCoverageTargetTest' )). (#coverage -> { - (#scope -> { (#classes -> #( 'MCPToolCoverageTarget' )) } asDictionary). - (#includeCoveredMethods -> true). - (#methodLimit -> 1) } asDictionary) } - asDictionary. + (#scope + -> + { (#classes -> #( 'MCPToolCoverageTarget' )) } + asDictionary). + (#includeCoveredMethods -> true). + (#methodLimit -> 1) } asDictionary) } asDictionary. data := self dataFrom: result. coverage := data at: #coverage. coveredSelectors := (coverage at: #coveredMethods) collect: [ :each | @@ -371,9 +382,7 @@ MCPToolStructuredOutputTest >> testRunTestsCoverageCanIncludeCoveredMethodsAndCa MCPToolStructuredOutputTest >> testRunTestsCoverageRequiresExplicitScope [ | error result | - result := self - callToolNamed: 'test_coverage_run' - withArguments: { + result := self callToolNamed: 'test_coverage_run' withArguments: { (#classes -> #( 'MCPToolCoverageTargetTest' )). (#coverage -> Dictionary new) } asDictionary. error := self errorFrom: result. @@ -382,30 +391,33 @@ MCPToolStructuredOutputTest >> testRunTestsCoverageRequiresExplicitScope [ assert: ((self structuredContentFrom: result) at: #status) equals: 'error'. self assert: (error at: #errorCode) equals: 'CoverageScopeRequired'. - self assert: ((error at: #message) includesSubstring: 'explicit method scope') + self assert: + ((error at: #message) includesSubstring: 'explicit method scope') ] { #category : 'tests' } MCPToolStructuredOutputTest >> testRunTestsCoverageReturnsStructuredCoverage [ | coverage data partialSelectors result uncoveredSelectors | - result := self - callToolNamed: 'test_coverage_run' - withArguments: { + result := self callToolNamed: 'test_coverage_run' withArguments: { (#classes -> #( 'MCPToolCoverageTargetTest' )). (#coverage -> { - (#scope -> { (#classes -> #( 'MCPToolCoverageTarget' )) } asDictionary). - (#methodLimit -> 10) } asDictionary) } asDictionary. + (#scope + -> + { (#classes -> #( 'MCPToolCoverageTarget' )) } + asDictionary). + (#methodLimit -> 10) } asDictionary) } asDictionary. data := self dataFrom: result. coverage := data at: #coverage. - uncoveredSelectors := (coverage at: #uncoveredMethods) collect: [ :each | - each at: #selector ]. - partialSelectors := (coverage at: #partiallyCoveredMethods) collect: [ :each | - each at: #selector ]. + uncoveredSelectors := (coverage at: #uncoveredMethods) collect: [ + :each | each at: #selector ]. + partialSelectors := (coverage at: #partiallyCoveredMethods) collect: [ + :each | each at: #selector ]. self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. - self assert: ((self summaryFrom: result) includesSubstring: 'Coverage:'). + self assert: + ((self summaryFrom: result) includesSubstring: 'Coverage:'). self assert: (data at: #runCount) equals: 2. self assert: (data at: #passedCount) equals: 2. self deny: (data includesKey: #results). @@ -425,12 +437,11 @@ MCPToolStructuredOutputTest >> testRunTestsCoverageReturnsStructuredCoverage [ MCPToolStructuredOutputTest >> testRunTestsDeduplicatesConcreteCasesAcrossSelections [ | data result | - result := self - callToolNamed: 'test_run' - withArguments: { + result := self callToolNamed: 'test_run' withArguments: { (#classes -> #( 'MCPToolStructuredOutputTestTarget' )). - (#methods -> #( 'MCPToolStructuredOutputTestTarget>>#testFails' )) } - asDictionary. + (#methods + -> #( 'MCPToolStructuredOutputTestTarget>>#testFails' )) } + asDictionary. data := self dataFrom: result. self assert: ((self structuredContentFrom: result) at: #status) @@ -448,7 +459,8 @@ MCPToolStructuredOutputTest >> testRunTestsDeduplicatesUnrunCasesAcrossSelection | data result | result := self callToolNamed: 'test_run' withArguments: { (#classes -> #( 'MCPToolStructuredOutputTestTarget' )). - (#methods -> #( 'MCPToolStructuredOutputTestTarget>>#testFails' )). + (#methods + -> #( 'MCPToolStructuredOutputTestTarget>>#testFails' )). (#timeoutSeconds -> 0) } asDictionary. data := self dataFrom: result. self @@ -457,7 +469,9 @@ MCPToolStructuredOutputTest >> testRunTestsDeduplicatesUnrunCasesAcrossSelection self assert: (data at: #timedOut) equals: true. self assert: (data at: #runCount) equals: 0. self assert: (data at: #passedCount) equals: 0. - self assert: (data at: #unrunClasses) equals: #( 'MCPToolStructuredOutputTestTarget' ). + self + assert: (data at: #unrunClasses) + equals: #( 'MCPToolStructuredOutputTestTarget' ). self deny: (data includesKey: #unrunMethods). self deny: (data includesKey: #results) ] @@ -466,11 +480,10 @@ MCPToolStructuredOutputTest >> testRunTestsDeduplicatesUnrunCasesAcrossSelection MCPToolStructuredOutputTest >> testRunTestsParameterizedMethodFailureIncludesCaseDetails [ | data issue result | - result := self - callToolNamed: 'test_run' - withArguments: { (#methods -> - #( 'MCPToolRunTestsParameterizedTarget>>#testFailsOnlyForUTF16' )) } - asDictionary. + result := self callToolNamed: 'test_run' withArguments: { (#methods + -> + #( 'MCPToolRunTestsParameterizedTarget>>#testFailsOnlyForUTF16' )) } + asDictionary. data := self dataFrom: result. issue := (data at: #failures) first. self @@ -479,8 +492,12 @@ MCPToolStructuredOutputTest >> testRunTestsParameterizedMethodFailureIncludesCas self assert: (data at: #runCount) equals: 3. self assert: (data at: #passedCount) equals: 2. self assert: (data at: #failures) size equals: 1. - self assert: (issue at: #test) equals: 'MCPToolRunTestsParameterizedTarget>>#testFailsOnlyForUTF16'. - self assert: (issue at: #parameters) equals: #( '#encoding->''UTF-16''' ). + self + assert: (issue at: #test) + equals: 'MCPToolRunTestsParameterizedTarget>>#testFailsOnlyForUTF16'. + self + assert: (issue at: #parameters) + equals: #( '#encoding->''UTF-16''' ). self assert: ((issue at: #message) includesSubstring: 'UTF-16'). self deny: (issue includesKey: #testName). self deny: (issue includesKey: #testCaseName) @@ -491,15 +508,17 @@ MCPToolStructuredOutputTest >> testRunTestsParseErrorReturnsStructuredToolError | error result structured | result := self - callToolNamed: 'test_run' - withArguments: { (#methods -> #( 'NotAMethodReference' )) } asDictionary. + callToolNamed: 'test_run' + withArguments: + { (#methods -> #( 'NotAMethodReference' )) } 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 deny: (error includesKey: #tests). - self assert: ((error at: #message) includesSubstring: 'Class>>#selector') + self assert: + ((error at: #message) includesSubstring: 'Class>>#selector') ] { #category : 'tests' } @@ -508,16 +527,19 @@ MCPToolStructuredOutputTest >> testRunTestsSkippedMethodReportsCompactList [ | data result | result := self callToolNamed: 'test_run' - withArguments: { (#methods -> - #( 'MCPToolStructuredOutputTestTarget>>#testSkips' )) } - asDictionary. + withArguments: + { (#methods + -> #( 'MCPToolStructuredOutputTestTarget>>#testSkips' )) } + asDictionary. data := self dataFrom: result. self assert: ((self structuredContentFrom: result) at: #status) equals: 'ok'. self assert: (data at: #runCount) equals: 0. self assert: (data at: #passedCount) equals: 0. - self assert: (data at: #skipped) equals: #( 'MCPToolStructuredOutputTestTarget>>#testSkips' ). + self + assert: (data at: #skipped) + equals: #( 'MCPToolStructuredOutputTestTarget>>#testSkips' ). self deny: (data includesKey: #failures). self deny: (data includesKey: #errors) ] @@ -528,9 +550,10 @@ MCPToolStructuredOutputTest >> testRunTestsSuccessfulResultOmitsEmptyIssueLists | data result | result := self callToolNamed: 'test_run' - withArguments: { (#methods -> - #( 'MCPToolStructuredOutputTestTarget>>#testPasses' )) } - asDictionary. + withArguments: + { (#methods + -> #( 'MCPToolStructuredOutputTestTarget>>#testPasses' )) } + asDictionary. data := self dataFrom: result. self assert: ((self structuredContentFrom: result) at: #status) @@ -549,13 +572,16 @@ MCPToolStructuredOutputTest >> testRunTestsTimeoutReturnsPartialResultsAndUnrunS | data request resumedData resumedResult result runTestsRequest tool | tool := MCPToolRunTests new. runTestsRequest := MCPRunTestsRequest new - initializeTestRequests: { - (MCPTestRunRequest className: 'MCPToolRunTestsTimeoutTarget'). - (MCPTestRunRequest className: 'MCPToolCoverageTargetTest'). - (MCPTestRunRequest packageName: 'MCP-Spec-Tests') } - timeoutMilliseconds: 100 - operation: 'run' - coverageRequest: nil. + initializeTestRequests: { + (MCPTestRunRequest className: + 'MCPToolRunTestsTimeoutTarget'). + (MCPTestRunRequest className: + 'MCPToolCoverageTargetTest'). + (MCPTestRunRequest packageName: + 'MCP-Spec-Tests') } + timeoutMilliseconds: 100 + operation: 'run' + coverageRequest: nil. result := (tool commandForRequest: runTestsRequest) execute. data := result asDictionary. self assert: (data at: #timedOut). @@ -569,18 +595,22 @@ MCPToolStructuredOutputTest >> testRunTestsTimeoutReturnsPartialResultsAndUnrunS equals: #( 'MCPToolCoverageTargetTest' ). self assert: (data at: #unrunPackages) equals: #( 'MCP-Spec-Tests' ). request := Dictionary new - at: #methods put: (data at: #unrunMethods); - at: #classes put: (data at: #unrunClasses); - at: #packages put: (data at: #unrunPackages); - at: #timeoutSeconds put: 30; - yourself. - resumedResult := self callToolNamed: 'test_run' withArguments: request. + at: #methods put: (data at: #unrunMethods); + at: #classes put: (data at: #unrunClasses); + at: #packages put: (data at: #unrunPackages); + at: #timeoutSeconds put: 30; + yourself. + resumedResult := self + callToolNamed: 'test_run' + withArguments: request. resumedData := self dataFrom: resumedResult. self assert: ((self structuredContentFrom: resumedResult) at: #status) equals: 'ok'. self deny: (resumedData includesKey: #timedOut). - self assert: (resumedData at: #passedCount) equals: (resumedData at: #runCount). + self + assert: (resumedData at: #passedCount) + equals: (resumedData at: #runCount). self assert: (resumedData at: #runCount) > 3 ] diff --git a/src/MCP-Tests/MCPUpdateClassCommandTest.class.st b/src/MCP-Tests/MCPUpdateClassCommandTest.class.st index 2fdce20..9fd9478 100644 --- a/src/MCP-Tests/MCPUpdateClassCommandTest.class.st +++ b/src/MCP-Tests/MCPUpdateClassCommandTest.class.st @@ -12,22 +12,36 @@ Class { { #category : 'private' } MCPUpdateClassCommandTest >> classToolClassForArguments: arguments slotAction: slotAction [ - ((arguments includesKey: #superclassName) and: [ arguments includesKey: #packageName ]) ifTrue: [ ^ MCPToolCreateClass ]. + ((arguments includesKey: #superclassName) and: [ + arguments includesKey: #packageName ]) ifTrue: [ + ^ MCPToolCreateClass ]. slotAction = 'add' ifTrue: [ ^ MCPToolAddClassSlot ]. slotAction = 'remove' ifTrue: [ ^ MCPToolRemoveClassSlot ]. slotAction = 'rename' ifTrue: [ ^ MCPToolUpdateClassSlotName ]. slotAction = 'pullUp' ifTrue: [ ^ MCPToolPullUpClassSlot ]. slotAction = 'pushDown' ifTrue: [ ^ MCPToolPushDownClassSlot ]. - (arguments includesKey: #newClassName) ifTrue: [ ^ MCPToolUpdateClassName ]. - (arguments includesKey: #classComment) ifTrue: [ ^ MCPToolUpdateClassComment ]. - (arguments includesKey: #traits) ifTrue: [ ^ MCPToolUpdateClassTraits ]. - (arguments includesKey: #classTraits) ifTrue: [ ^ MCPToolUpdateClassSideTraits ]. - (arguments includesKey: #sharedVariables) ifTrue: [ ^ MCPToolUpdateClassSharedVariables ]. - (arguments includesKey: #sharedPools) ifTrue: [ ^ MCPToolUpdateClassSharedPools ]. - (arguments includesKey: #layout) ifTrue: [ ^ MCPToolUpdateClassLayout ]. - ((arguments includesKey: #slots) or: [ arguments includesKey: #classSlots ]) ifTrue: [ ^ MCPToolUpdateClassSlots ]. - (arguments includesKey: #superclassName) ifTrue: [ ^ MCPToolUpdateClassSuperclass ]. - ((arguments includesKey: #packageName) or: [ arguments includesKey: #tag ]) ifTrue: [ ^ MCPToolUpdateClassPackage ]. + (arguments includesKey: #newClassName) ifTrue: [ + ^ MCPToolUpdateClassName ]. + (arguments includesKey: #classComment) ifTrue: [ + ^ MCPToolUpdateClassComment ]. + (arguments includesKey: #traits) ifTrue: [ + ^ MCPToolUpdateClassTraits ]. + (arguments includesKey: #classTraits) ifTrue: [ + ^ MCPToolUpdateClassSideTraits ]. + (arguments includesKey: #sharedVariables) ifTrue: [ + ^ MCPToolUpdateClassSharedVariables ]. + (arguments includesKey: #sharedPools) ifTrue: [ + ^ MCPToolUpdateClassSharedPools ]. + (arguments includesKey: #layout) ifTrue: [ + ^ MCPToolUpdateClassLayout ]. + ((arguments includesKey: #slots) or: [ + arguments includesKey: #classSlots ]) ifTrue: [ + ^ MCPToolUpdateClassSlots ]. + (arguments includesKey: #superclassName) ifTrue: [ + ^ MCPToolUpdateClassSuperclass ]. + ((arguments includesKey: #packageName) or: [ + arguments includesKey: #tag ]) ifTrue: [ + ^ MCPToolUpdateClassPackage ]. ^ MCPToolUpdateClassComment ] @@ -36,7 +50,7 @@ MCPUpdateClassCommandTest >> commandForArguments: arguments [ | mutationRequest rawArguments slotAction tool toolClass toolRequest | rawArguments := arguments copy. - rawArguments removeKey: #action ifAbsent: [ ]. + rawArguments removeKey: #action ifAbsent: [ ]. slotAction := rawArguments removeKey: #slotAction ifAbsent: [ nil ]. toolClass := self classToolClassForArguments: rawArguments @@ -52,15 +66,15 @@ MCPUpdateClassCommandTest >> testAppliedChangeResultWrapsPlanAndResult [ | appliedChange changeResult data plan | plan := MCPClassUpdatePlanInfo - updateAction: 'setComment' - requestedContext: { (#className -> 'Object') } asDictionary. + updateAction: 'setComment' + requestedContext: { (#className -> 'Object') } asDictionary. changeResult := MCPChangeClassCommentResult - classInfo: (MCPClassInfo fromClass: Object) - oldClassComment: 'old' - newClassComment: 'new'. + classInfo: (MCPClassInfo fromClass: Object) + oldClassComment: 'old' + newClassComment: 'new'. appliedChange := MCPClassAppliedChangeResult - updatePlan: plan - changeResult: changeResult. + updatePlan: plan + changeResult: changeResult. data := appliedChange asDictionary. self assert: data isEmpty ] @@ -264,9 +278,9 @@ MCPUpdateClassCommandTest >> testToolBuildsUpdateClassCommand [ | command mutationRequest tool toolRequest | tool := MCPToolUpdateClassComment new. - toolRequest := tool requestFromToolCallArguments: - { (#className -> 'Object'). (#classComment -> 'updated') } - asDictionary. + toolRequest := tool requestFromToolCallArguments: { + (#className -> 'Object'). + (#classComment -> 'updated') } asDictionary. mutationRequest := tool parsedRequestFromToolRequest: toolRequest. command := tool commandForRequest: mutationRequest. self assert: mutationRequest class equals: MCPClassUpdateRequest. diff --git a/src/MCP/MCP.class.st b/src/MCP/MCP.class.st index 57d0de3..52c3959 100644 --- a/src/MCP/MCP.class.st +++ b/src/MCP/MCP.class.st @@ -29,26 +29,26 @@ MCP >> configurePort: aPortNumber debugMode: aBoolean [ wasRunning := self isRunning. wasRunning ifFalse: [ - self port: aPortNumber. - self debugMode: aBoolean. - ^ self ]. + self port: aPortNumber. + self debugMode: aBoolean. + ^ self ]. currentPort = aPortNumber ifTrue: [ - self debugMode: aBoolean. - ^ self ]. + self debugMode: aBoolean. + ^ self ]. self stop. [ - self port: aPortNumber. - self debugMode: aBoolean. - self start ] + self port: aPortNumber. + self debugMode: aBoolean. + self start ] on: Error do: [ :error | - self port: currentPort. - self debugMode: aBoolean. - self start. - error pass ] + self port: currentPort. + self debugMode: aBoolean. + self start. + error pass ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPAppliedChangeResult.class.st b/src/MCP/MCPAppliedChangeResult.class.st index 41ebdd3..d362cb7 100644 --- a/src/MCP/MCPAppliedChangeResult.class.st +++ b/src/MCP/MCPAppliedChangeResult.class.st @@ -25,9 +25,9 @@ MCPAppliedChangeResult class >> isAbstract [ MCPAppliedChangeResult class >> updatePlan: anUpdatePlan changeResult: aChangeResult [ ^ self new - updatePlan: anUpdatePlan; - changeResult: aChangeResult; - yourself + updatePlan: anUpdatePlan; + changeResult: aChangeResult; + yourself ] { #category : 'accessing' } diff --git a/src/MCP/MCPChangeClassCommentCommand.class.st b/src/MCP/MCPChangeClassCommentCommand.class.st index 5e641af..b83e3fe 100644 --- a/src/MCP/MCPChangeClassCommentCommand.class.st +++ b/src/MCP/MCPChangeClassCommentCommand.class.st @@ -42,10 +42,10 @@ MCPChangeClassCommentCommand >> execute [ targetClass := self targetClass. oldClassComment := targetClass comment. oldClassComment = self classComment ifTrue: [ - ^ MCPChangeClassCommentResult - classInfo: (MCPClassInfo fromClass: targetClass) - oldClassComment: oldClassComment - newClassComment: oldClassComment ]. + ^ MCPChangeClassCommentResult + classInfo: (MCPClassInfo fromClass: targetClass) + oldClassComment: oldClassComment + newClassComment: oldClassComment ]. targetClass comment: self classComment. updatedClass := Smalltalk globals at: self className asSymbol. ^ MCPChangeClassCommentResult diff --git a/src/MCP/MCPChangeHistorySelectionCommand.class.st b/src/MCP/MCPChangeHistorySelectionCommand.class.st index f0c0166..4384db2 100644 --- a/src/MCP/MCPChangeHistorySelectionCommand.class.st +++ b/src/MCP/MCPChangeHistorySelectionCommand.class.st @@ -13,9 +13,9 @@ Class { MCPChangeHistorySelectionCommand >> addIndexSelectionsTo: pairs fromLog: aLog [ request indexes do: [ :index | - pairs add: { - index. - (self entryAtIndex: index inLog: aLog) } ]. + pairs add: { + index. + (self entryAtIndex: index inLog: aLog) } ]. ^ pairs ] @@ -26,8 +26,8 @@ MCPChangeHistorySelectionCommand >> addLatestSelectionTo: pairs fromLog: aLog [ request latestCount ifNil: [ ^ pairs ]. allPairs := self entryPairsFromLog: aLog. request codeChangesOnly ifTrue: [ - allPairs := allPairs select: [ :pair | - self isCodeChangeEntry: pair second ] ]. + allPairs := allPairs select: [ :pair | + self isCodeChangeEntry: pair second ] ]. allPairs ifEmpty: [ ^ pairs ]. start := allPairs size - request latestCount + 1 max: 1. selected := allPairs copyFrom: start to: allPairs size. @@ -40,9 +40,9 @@ MCPChangeHistorySelectionCommand >> addRangeSelectionTo: pairs fromLog: aLog [ request hasRangeSelection ifFalse: [ ^ pairs ]. request startIndex to: request endIndex do: [ :index | - pairs add: { - index. - (self entryAtIndex: index inLog: aLog) } ]. + pairs add: { + index. + (self entryAtIndex: index inLog: aLog) } ]. ^ pairs ] @@ -75,14 +75,14 @@ MCPChangeHistorySelectionCommand >> applyOrRevertEntries [ MCPChangeHistorySelectionCommand >> entryAtIndex: anIndex inLog: aLog [ (anIndex between: 1 and: aLog entries size) ifFalse: [ - MCPCommandError - signalErrorCode: #ChangeHistoryEntryNotFound - message: - 'Change history entry index ' , anIndex asString - , ' does not exist.' - details: { - (#index -> anIndex). - (#entryCount -> aLog entries size) } asDictionary ]. + MCPCommandError + signalErrorCode: #ChangeHistoryEntryNotFound + message: + 'Change history entry index ' , anIndex asString + , ' does not exist.' + details: { + (#index -> anIndex). + (#entryCount -> aLog entries size) } asDictionary ]. ^ aLog entries at: anIndex ] @@ -97,10 +97,10 @@ MCPChangeHistorySelectionCommand >> entryInfosFromLog: aLog [ MCPChangeHistorySelectionCommand >> entryInfosFromPairs: pairs log: aLog [ ^ pairs collect: [ :pair | - MCPChangeHistoryEntryInfo - fromEntry: pair second - index: pair first - log: aLog ] + MCPChangeHistoryEntryInfo + fromEntry: pair second + index: pair first + log: aLog ] ] { #category : 'private - entries' } @@ -109,9 +109,9 @@ MCPChangeHistorySelectionCommand >> entryPairsFromLog: aLog [ | pairs | pairs := OrderedCollection new. aLog entries doWithIndex: [ :entry :index | - pairs add: { - index. - entry } ]. + pairs add: { + index. + entry } ]. ^ pairs ] diff --git a/src/MCP/MCPChangeHistorySelectionRequest.class.st b/src/MCP/MCPChangeHistorySelectionRequest.class.st index e304a4d..db990b5 100644 --- a/src/MCP/MCPChangeHistorySelectionRequest.class.st +++ b/src/MCP/MCPChangeHistorySelectionRequest.class.st @@ -154,12 +154,12 @@ MCPChangeHistorySelectionRequest >> optionalPositiveIntegerArgumentNamed: argume (aRequest hasArgumentNamed: argumentName) ifFalse: [ ^ nil ]. value := aRequest argumentNamed: argumentName ifAbsent: [ ^ nil ]. (value isInteger and: [ value > 0 ]) ifFalse: [ - self - signalInvalidSelection: - argumentName , ' must be a positive integer.' - details: { - (#argumentName -> argumentName). - (#actualValue -> value) } asDictionary ]. + self + signalInvalidSelection: + argumentName , ' must be a positive integer.' + details: { + (#argumentName -> argumentName). + (#actualValue -> value) } asDictionary ]. ^ value ] @@ -169,14 +169,14 @@ MCPChangeHistorySelectionRequest >> positiveIntegerCollectionArgumentNamed: argu | values | values := aRequest arrayArgumentNamed: argumentName. ^ (values collect: [ :each | - (each isInteger and: [ each > 0 ]) ifFalse: [ - self - signalInvalidSelection: - argumentName , ' must contain only positive integers.' - details: { - (#argumentName -> argumentName). - (#actualValue -> each) } asDictionary ]. - each ]) asArray + (each isInteger and: [ each > 0 ]) ifFalse: [ + self + signalInvalidSelection: + argumentName , ' must contain only positive integers.' + details: { + (#argumentName -> argumentName). + (#actualValue -> each) } asDictionary ]. + each ]) asArray ] { #category : 'converting' } diff --git a/src/MCP/MCPClassCommand.class.st b/src/MCP/MCPClassCommand.class.st index 5adab83..475d7cd 100644 --- a/src/MCP/MCPClassCommand.class.st +++ b/src/MCP/MCPClassCommand.class.st @@ -43,22 +43,21 @@ MCPClassCommand >> resolvedLayoutClassNamed: layoutName [ | behavior | layoutName ifNil: [ ^ nil ]. - behavior := Smalltalk globals - at: layoutName asSymbol - ifAbsent: [ + behavior := Smalltalk globals at: layoutName asSymbol ifAbsent: [ + MCPCommandError + signalErrorCode: #LayoutClassNotFound + message: + 'Layout class ' , layoutName , ' does not exist.' + details: { + (#className -> self className). + (#layout -> layoutName) } asDictionary ]. + (AbstractLayout withAllSubclasses includes: behavior) ifFalse: [ MCPCommandError - signalErrorCode: #LayoutClassNotFound - message: 'Layout class ' , layoutName , ' does not exist.' + signalErrorCode: #InvalidLayoutClass + message: layoutName , ' not layout class.' details: { - (#className -> self className). - (#layout -> layoutName) } asDictionary ]. - (AbstractLayout withAllSubclasses includes: behavior) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidLayoutClass - message: layoutName , ' not layout class.' - details: { - (#className -> self className). - (#layout -> layoutName) } asDictionary ]. + (#className -> self className). + (#layout -> layoutName) } asDictionary ]. ^ behavior ] @@ -68,20 +67,21 @@ MCPClassCommand >> resolvedSharedPoolNamed: aSharedPoolName [ | behavior sharedPoolName | sharedPoolName := aSharedPoolName. behavior := Smalltalk globals - at: sharedPoolName asSymbol - ifAbsent: [ + at: sharedPoolName asSymbol + ifAbsent: [ + MCPCommandError + signalErrorCode: #SharedPoolNotFound + message: + 'Shared pool ' , sharedPoolName , ' does not exist.' + details: { + (#className -> self className). + (#sharedPoolName -> sharedPoolName) } asDictionary ]. + (SharedPool withAllSubclasses includes: behavior) ifFalse: [ MCPCommandError - signalErrorCode: #SharedPoolNotFound - message: 'Shared pool ' , sharedPoolName , ' does not exist.' + signalErrorCode: #InvalidSharedPool + message: sharedPoolName , ' not shared pool.' details: { - (#className -> self className). - (#sharedPoolName -> sharedPoolName) } asDictionary ]. - (SharedPool withAllSubclasses includes: behavior) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidSharedPool - message: sharedPoolName , ' not shared pool.' - details: { - (#className -> self className). - (#sharedPoolName -> sharedPoolName) } asDictionary ]. + (#className -> self className). + (#sharedPoolName -> sharedPoolName) } asDictionary ]. ^ behavior ] diff --git a/src/MCP/MCPClassScopeQuery.class.st b/src/MCP/MCPClassScopeQuery.class.st index af2f68c..5e88ed2 100644 --- a/src/MCP/MCPClassScopeQuery.class.st +++ b/src/MCP/MCPClassScopeQuery.class.st @@ -29,8 +29,8 @@ MCPClassScopeQuery >> classScopeSets [ self packageNames ifNotEmpty: [ sets add: self classesForPackageNames ]. self classNames ifNotEmpty: [ - sets add: - (self resolvedClassesNamed: self classNames inScope: 'classNames') ]. + sets add: + (self resolvedClassesNamed: self classNames inScope: 'classNames') ]. self hierarchyClassNames ifNotEmpty: [ sets add: (self hierarchyClassesNamed: self hierarchyClassNames) ]. self subclassClassNames ifNotEmpty: [ @@ -54,10 +54,10 @@ MCPClassScopeQuery >> classesForPackageNames [ | classes | classes := IdentitySet new. packageNames do: [ :eachName | - (self resolvedPackageNamed: eachName inScope: 'packageNames') - ifNotNil: [ :package | - package classes do: [ :eachClass | - classes add: eachClass instanceSide ] ] ]. + (self resolvedPackageNamed: eachName inScope: 'packageNames') + ifNotNil: [ :package | + package classes do: [ :eachClass | + classes add: eachClass instanceSide ] ] ]. ^ self sortedClassesByName: classes ] @@ -69,8 +69,8 @@ MCPClassScopeQuery >> hierarchyClassesNamed: someClassNames [ (self resolvedClassesNamed: someClassNames inScope: 'hierarchyClassNames') do: [ :eachClass | - eachClass withAllSuperAndSubclasses do: [ :relatedClass | - classes add: relatedClass instanceSide ] ]. + eachClass withAllSuperAndSubclasses do: [ :relatedClass | + classes add: relatedClass instanceSide ] ]. ^ self sortedClassesByName: classes ] @@ -95,8 +95,8 @@ MCPClassScopeQuery >> parentClassesNamed: someClassNames [ (self resolvedClassesNamed: someClassNames inScope: 'parentClassNames') do: [ :eachClass | - eachClass allSuperclasses do: [ :relatedClass | - classes add: relatedClass instanceSide ] ]. + eachClass allSuperclasses do: [ :relatedClass | + classes add: relatedClass instanceSide ] ]. ^ self sortedClassesByName: classes ] @@ -127,8 +127,8 @@ MCPClassScopeQuery >> resolvedClassesNamed: someClassNames inScope: scopeName [ | classes | classes := IdentitySet new. someClassNames do: [ :eachName | - (self resolvedClassNamed: eachName inScope: scopeName) ifNotNil: [ - :resolvedClass | classes add: resolvedClass instanceSide ] ]. + (self resolvedClassNamed: eachName inScope: scopeName) ifNotNil: [ + :resolvedClass | classes add: resolvedClass instanceSide ] ]. ^ self sortedClassesByName: classes ] @@ -161,8 +161,8 @@ MCPClassScopeQuery >> subclassClassesNamed: someClassNames [ (self resolvedClassesNamed: someClassNames inScope: 'subclassClassNames') do: [ :eachClass | - eachClass allSubclasses do: [ :relatedClass | - classes add: relatedClass instanceSide ] ]. + eachClass allSubclasses do: [ :relatedClass | + classes add: relatedClass instanceSide ] ]. ^ self sortedClassesByName: classes ] diff --git a/src/MCP/MCPClassUpdateRequest.class.st b/src/MCP/MCPClassUpdateRequest.class.st index 4a8cf22..67b9bd3 100644 --- a/src/MCP/MCPClassUpdateRequest.class.st +++ b/src/MCP/MCPClassUpdateRequest.class.st @@ -281,9 +281,9 @@ MCPClassUpdateRequest >> requestedContext [ context := Dictionary new. context at: #className put: self className. self suppliedProperties do: [ :propertyName | - context - at: propertyName asSymbol - put: (self contextValueForPropertyNamed: propertyName) ]. + context + at: propertyName asSymbol + put: (self contextValueForPropertyNamed: propertyName) ]. ^ context ] @@ -341,11 +341,11 @@ MCPClassUpdateRequest >> slotOperation [ ('pullUp' -> 'pullUpSlot'). ('pushDown' -> 'pushDownSlot') } asDictionary. ^ operations at: self slotAction ifAbsent: [ - MCPCommandError - signalErrorCode: #InvalidSlotAction - message: - 'slotAction must be one of add, remove, rename, pullUp, pushDown.' - details: self slotRequestedContext ] + MCPCommandError + signalErrorCode: #InvalidSlotAction + message: + 'slotAction must be one of add, remove, rename, pullUp, pushDown.' + details: self slotRequestedContext ] ] { #category : 'converting' } @@ -418,28 +418,28 @@ MCPClassUpdateRequest >> validateSlotUpdate [ | operation | operation := self slotOperation. operation ifNil: [ - (self hasSlotName or: [ self hasNewSlotName ]) ifTrue: [ + (self hasSlotName or: [ self hasNewSlotName ]) ifTrue: [ + MCPCommandError + signalErrorCode: #SlotActionRequired + message: + 'slotAction is required when slotName or newSlotName is provided for update.' + details: self slotRequestedContext ]. + ^ self ]. + self hasSlotName ifFalse: [ MCPCommandError - signalErrorCode: #SlotActionRequired - message: - 'slotAction is required when slotName or newSlotName is provided for update.' + signalErrorCode: #SlotNameRequired + message: 'slotName is required for slot updates.' details: self slotRequestedContext ]. - ^ self ]. - self hasSlotName ifFalse: [ - MCPCommandError - signalErrorCode: #SlotNameRequired - message: 'slotName is required for slot updates.' - details: self slotRequestedContext ]. (operation = 'renameSlot' and: [ self hasNewSlotName not ]) ifTrue: [ - MCPCommandError - signalErrorCode: #NewSlotNameRequired - message: 'newSlotName is required when slotAction=rename.' - details: self slotRequestedContext ]. + MCPCommandError + signalErrorCode: #NewSlotNameRequired + message: 'newSlotName is required when slotAction=rename.' + details: self slotRequestedContext ]. (operation ~= 'renameSlot' and: [ self hasNewSlotName ]) ifTrue: [ - MCPCommandError - signalErrorCode: #UnexpectedNewSlotName - message: 'newSlotName is only accepted when slotAction=rename.' - details: self slotRequestedContext ]. + MCPCommandError + signalErrorCode: #UnexpectedNewSlotName + message: 'newSlotName is only accepted when slotAction=rename.' + details: self slotRequestedContext ]. ^ self ] diff --git a/src/MCP/MCPCommandError.class.st b/src/MCP/MCPCommandError.class.st index 0929a12..ae069cc 100644 --- a/src/MCP/MCPCommandError.class.st +++ b/src/MCP/MCPCommandError.class.st @@ -46,23 +46,23 @@ MCPCommandError class >> detailsWith: associations suggestionsForPackageNamed: p MCPCommandError class >> messageForMissingKind: kind name: missingName scopeName: scopeName suggestions: suggestions [ ^ String streamContents: [ :stream | - stream - nextPutAll: kind; - space; - nextPutAll: missingName asString; - nextPutAll: ' does not exist'. - scopeName ifNotNil: [ stream - nextPutAll: ' in '; - nextPutAll: scopeName asString; - nextPutAll: ' scope' ]. - stream nextPut: $.. - suggestions ifNotEmpty: [ - stream nextPutAll: ' Did you mean: '. - suggestions - do: [ :each | stream nextPutAll: each ] - separatedBy: [ stream nextPutAll: ', ' ]. - stream nextPut: $. ] ] + nextPutAll: kind; + space; + nextPutAll: missingName asString; + nextPutAll: ' does not exist'. + scopeName ifNotNil: [ + stream + nextPutAll: ' in '; + nextPutAll: scopeName asString; + nextPutAll: ' scope' ]. + stream nextPut: $.. + suggestions ifNotEmpty: [ + stream nextPutAll: ' Did you mean: '. + suggestions + do: [ :each | stream nextPutAll: each ] + separatedBy: [ stream nextPutAll: ', ' ]. + stream nextPut: $. ] ] ] { #category : 'signaling' } diff --git a/src/MCP/MCPCommitRepositoryCommand.class.st b/src/MCP/MCPCommitRepositoryCommand.class.st index 4938628..787d507 100644 --- a/src/MCP/MCPCommitRepositoryCommand.class.st +++ b/src/MCP/MCPCommitRepositoryCommand.class.st @@ -72,10 +72,10 @@ MCPCommitRepositoryCommand >> gitSignatureMissingFor: anError [ message := anError messageText ifNil: [ '' ]. message := message asLowercase. ^ message = 'config value ''user.name'' was not found' or: [ - message = 'config value ''user.email'' was not found' or: [ - message - = - 'failed to parse signature - signature cannot have an empty name or email' ] ] + message = 'config value ''user.email'' was not found' or: [ + message + = + 'failed to parse signature - signature cannot have an empty name or email' ] ] ] { #category : 'private - git identity' } @@ -89,8 +89,8 @@ MCPCommitRepositoryCommand >> removeGitConfigKey: key from: config [ { #category : 'private - git identity' } MCPCommitRepositoryCommand >> removeTemporaryGitConfigKey: key from: config [ - "Pharo 13 libgit2 can crash while deleting freshly-created repository config entries." + PharoCompatibility isPharo13OrLater ifTrue: [ ^ self ]. self removeGitConfigKey: key from: config ] @@ -106,13 +106,13 @@ MCPCommitRepositoryCommand >> repositoryHasChangesToCommit: aRepository [ MCPCommitRepositoryCommand >> repositoryHasDefaultGitSignature: aRepository [ ^ [ - aRepository repositoryHandle defaultSignature. - true ] + aRepository repositoryHandle defaultSignature. + true ] on: LGit_GIT_ENOTFOUND , LGit_GIT_ERROR do: [ :error | - (self gitSignatureMissingFor: error) - ifTrue: [ false ] - ifFalse: [ error pass ] ] + (self gitSignatureMissingFor: error) + ifTrue: [ false ] + ifFalse: [ error pass ] ] ] { #category : 'private - diff' } @@ -142,8 +142,8 @@ MCPCommitRepositoryCommand >> withNonInteractiveGitIdentityFor: aRepository duri shouldSetName ifTrue: [ config username: self fallbackGitUserName ]. shouldSetEmail ifTrue: [ config email: self fallbackGitUserEmail ]. ^ [ aBlock value ] ensure: [ - shouldSetName ifTrue: [ - self removeTemporaryGitConfigKey: 'user.name' from: config ]. - shouldSetEmail ifTrue: [ - self removeTemporaryGitConfigKey: 'user.email' from: config ] ] + shouldSetName ifTrue: [ + self removeTemporaryGitConfigKey: 'user.name' from: config ]. + shouldSetEmail ifTrue: [ + self removeTemporaryGitConfigKey: 'user.email' from: config ] ] ] diff --git a/src/MCP/MCPCompiledMethodScopeQuery.class.st b/src/MCP/MCPCompiledMethodScopeQuery.class.st index c4f08b7..72502af 100644 --- a/src/MCP/MCPCompiledMethodScopeQuery.class.st +++ b/src/MCP/MCPCompiledMethodScopeQuery.class.st @@ -29,8 +29,8 @@ MCPCompiledMethodScopeQuery >> allBehaviors [ | behaviors | behaviors := IdentitySet new. Smalltalk globals allBehaviorsDo: [ :eachBehavior | - (self matchesSideForBehavior: eachBehavior) ifTrue: [ - behaviors add: eachBehavior ] ]. + (self matchesSideForBehavior: eachBehavior) ifTrue: [ + behaviors add: eachBehavior ] ]. ^ behaviors asArray ] @@ -46,11 +46,11 @@ MCPCompiledMethodScopeQuery >> allMethodsDo: aBlock [ | seenMethods | seenMethods := IdentitySet new. Smalltalk globals allBehaviorsDo: [ :eachBehavior | - (self matchesSideForBehavior: eachBehavior) ifTrue: [ - eachBehavior methods do: [ :eachMethod | - (seenMethods includes: eachMethod) ifFalse: [ - seenMethods add: eachMethod. - aBlock value: eachMethod ] ] ] ] + (self matchesSideForBehavior: eachBehavior) ifTrue: [ + eachBehavior methods do: [ :eachMethod | + (seenMethods includes: eachMethod) ifFalse: [ + seenMethods add: eachMethod. + aBlock value: eachMethod ] ] ] ] ] { #category : 'converting' } @@ -97,8 +97,9 @@ MCPCompiledMethodScopeQuery >> behaviorsForClassNames [ | behaviors | behaviors := IdentitySet new. self classNames do: [ :eachName | - (self classNamed: eachName inScope: 'classNames') ifNotNil: [ :class | - self addBehaviorsForBaseClass: class instanceSide to: behaviors ] ]. + (self classNamed: eachName inScope: 'classNames') ifNotNil: [ + :class | + self addBehaviorsForBaseClass: class instanceSide to: behaviors ] ]. ^ behaviors asArray ] @@ -108,13 +109,13 @@ MCPCompiledMethodScopeQuery >> behaviorsForPackageNames [ | behaviors | behaviors := IdentitySet new. self packageNames do: [ :eachName | - (self packageNamed: eachName inScope: 'packageNames') ifNotNil: [ - :package | - package definedClasses do: [ :aClass | - self addBehaviorsForBaseClass: aClass to: behaviors ]. - package extensionMethods do: [ :eachMethod | - (self matchesSideForMethod: eachMethod) ifTrue: [ - behaviors add: eachMethod methodClass ] ] ] ]. + (self packageNamed: eachName inScope: 'packageNames') ifNotNil: [ + :package | + package definedClasses do: [ :aClass | + self addBehaviorsForBaseClass: aClass to: behaviors ]. + package extensionMethods do: [ :eachMethod | + (self matchesSideForMethod: eachMethod) ifTrue: [ + behaviors add: eachMethod methodClass ] ] ] ]. ^ behaviors asArray ] @@ -139,10 +140,10 @@ MCPCompiledMethodScopeQuery >> hierarchyBehaviorsForClassNames [ | behaviors hierarchyClasses | hierarchyClasses := IdentitySet new. self hierarchyClassNames do: [ :eachName | - (self classNamed: eachName inScope: 'hierarchyClassNames') - ifNotNil: [ :class | - class instanceSide withAllSuperAndSubclasses do: [ :relatedClass | - hierarchyClasses add: relatedClass instanceSide ] ] ]. + (self classNamed: eachName inScope: 'hierarchyClassNames') + ifNotNil: [ :class | + class instanceSide withAllSuperAndSubclasses do: [ :relatedClass | + hierarchyClasses add: relatedClass instanceSide ] ] ]. behaviors := IdentitySet new. hierarchyClasses do: [ :eachClass | self addBehaviorsForBaseClass: eachClass to: behaviors ]. @@ -200,14 +201,14 @@ MCPCompiledMethodScopeQuery >> methodScopeSets [ self classNames ifNotEmpty: [ sets add: (self methodsForBehaviors: self behaviorsForClassNames) ]. self hierarchyClassNames ifNotEmpty: [ - sets add: - (self methodsForBehaviors: self hierarchyBehaviorsForClassNames) ]. + sets add: + (self methodsForBehaviors: self hierarchyBehaviorsForClassNames) ]. self subclassClassNames ifNotEmpty: [ - sets add: - (self methodsForBehaviors: self subclassBehaviorsForClassNames) ]. + sets add: + (self methodsForBehaviors: self subclassBehaviorsForClassNames) ]. self parentClassNames ifNotEmpty: [ - sets add: - (self methodsForBehaviors: self parentBehaviorsForClassNames) ]. + sets add: + (self methodsForBehaviors: self parentBehaviorsForClassNames) ]. ^ sets asArray ] @@ -228,9 +229,9 @@ MCPCompiledMethodScopeQuery >> methodsDo: aBlock [ self usesImplicitImageScope ifTrue: [ ^ self allMethodsDo: aBlock ]. seenMethods := IdentitySet new. self methods do: [ :eachMethod | - (seenMethods includes: eachMethod) ifFalse: [ - seenMethods add: eachMethod. - aBlock value: eachMethod ] ] + (seenMethods includes: eachMethod) ifFalse: [ + seenMethods add: eachMethod. + aBlock value: eachMethod ] ] ] { #category : 'private - scope' } @@ -249,10 +250,10 @@ MCPCompiledMethodScopeQuery >> methodsForBehaviors: behaviors do: aBlock [ | seenMethods | seenMethods := IdentitySet new. behaviors do: [ :eachBehavior | - eachBehavior methods do: [ :eachMethod | - (seenMethods includes: eachMethod) ifFalse: [ - seenMethods add: eachMethod. - aBlock value: eachMethod ] ] ] + eachBehavior methods do: [ :eachMethod | + (seenMethods includes: eachMethod) ifFalse: [ + seenMethods add: eachMethod. + aBlock value: eachMethod ] ] ] ] { #category : 'private - scope' } @@ -322,10 +323,10 @@ MCPCompiledMethodScopeQuery >> parentBehaviorsForClassNames [ | behaviors relatedClasses | relatedClasses := IdentitySet new. self parentClassNames do: [ :eachName | - (self classNamed: eachName inScope: 'parentClassNames') ifNotNil: [ - :class | - class instanceSide allSuperclasses do: [ :relatedClass | - relatedClasses add: relatedClass instanceSide ] ] ]. + (self classNamed: eachName inScope: 'parentClassNames') ifNotNil: [ + :class | + class instanceSide allSuperclasses do: [ :relatedClass | + relatedClasses add: relatedClass instanceSide ] ] ]. behaviors := IdentitySet new. relatedClasses do: [ :eachClass | self addBehaviorsForBaseClass: eachClass to: behaviors ]. @@ -350,10 +351,10 @@ MCPCompiledMethodScopeQuery >> subclassBehaviorsForClassNames [ | behaviors relatedClasses | relatedClasses := IdentitySet new. self subclassClassNames do: [ :eachName | - (self classNamed: eachName inScope: 'subclassClassNames') ifNotNil: [ - :class | - class instanceSide allSubclasses do: [ :relatedClass | - relatedClasses add: relatedClass instanceSide ] ] ]. + (self classNamed: eachName inScope: 'subclassClassNames') + ifNotNil: [ :class | + class instanceSide allSubclasses do: [ :relatedClass | + relatedClasses add: relatedClass instanceSide ] ] ]. behaviors := IdentitySet new. relatedClasses do: [ :eachClass | self addBehaviorsForBaseClass: eachClass to: behaviors ]. diff --git a/src/MCP/MCPCreateClassCommand.class.st b/src/MCP/MCPCreateClassCommand.class.st index 7822f9b..406be48 100644 --- a/src/MCP/MCPCreateClassCommand.class.st +++ b/src/MCP/MCPCreateClassCommand.class.st @@ -160,20 +160,20 @@ MCPCreateClassCommand >> resolvedClassTraitNamed: aClassTraitName [ behavior := Smalltalk globals at: classTraitName asSymbol ifAbsent: [ - MCPCommandError - signalErrorCode: #ClassTraitNotFound - message: - 'Class trait ' , originalName , ' does not exist.' - details: { - (#className -> self className). - (#classTraitName -> originalName) } asDictionary ]. + MCPCommandError + signalErrorCode: #ClassTraitNotFound + message: + 'Class trait ' , originalName , ' does not exist.' + details: { + (#className -> self className). + (#classTraitName -> originalName) } asDictionary ]. behavior isTrait ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidClassTrait - message: originalName , ' is not a class trait.' - details: { - (#className -> self className). - (#classTraitName -> originalName) } asDictionary ]. + MCPCommandError + signalErrorCode: #InvalidClassTrait + message: originalName , ' is not a class trait.' + details: { + (#className -> self className). + (#classTraitName -> originalName) } asDictionary ]. ^ behavior classTrait ] @@ -199,23 +199,23 @@ MCPCreateClassCommand >> resolvedTraitNamed: aTraitName [ | behavior traitName | traitName := aTraitName. (traitName endsWith: ' classTrait') ifTrue: [ - traitName := traitName - copyFrom: 1 - to: traitName size - ' classTrait' size ]. + traitName := traitName + copyFrom: 1 + to: traitName size - ' classTrait' size ]. behavior := Smalltalk globals at: traitName asSymbol ifAbsent: [ - MCPCommandError - signalErrorCode: #TraitNotFound - message: 'Trait ' , traitName , ' does not exist.' - details: { - (#className -> self className). - (#traitName -> traitName) } asDictionary ]. + MCPCommandError + signalErrorCode: #TraitNotFound + message: 'Trait ' , traitName , ' does not exist.' + details: { + (#className -> self className). + (#traitName -> traitName) } asDictionary ]. behavior isTrait ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidTrait - message: traitName , ' is not a trait.' - details: { - (#className -> self className). - (#traitName -> traitName) } asDictionary ]. + MCPCommandError + signalErrorCode: #InvalidTrait + message: traitName , ' is not a trait.' + details: { + (#className -> self className). + (#traitName -> traitName) } asDictionary ]. ^ behavior ] @@ -271,9 +271,9 @@ MCPCreateClassCommand >> slots: someSlots [ MCPCreateClassCommand >> superclass [ ^ Smalltalk globals at: self superclassName asSymbol ifAbsent: [ - MCPCommandError - signalMissingSuperclassNamed: self superclassName - forClassNamed: self className ] + MCPCommandError + signalMissingSuperclassNamed: self superclassName + forClassNamed: self className ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPCreateClassToolCommand.class.st b/src/MCP/MCPCreateClassToolCommand.class.st index ddca57e..e585e73 100644 --- a/src/MCP/MCPCreateClassToolCommand.class.st +++ b/src/MCP/MCPCreateClassToolCommand.class.st @@ -20,33 +20,32 @@ MCPCreateClassToolCommand >> execute [ force: self request force requestedContext: self request requestedContext work: [ - result := (MCPCreateClassCommand - className: self request className - superclassName: self request superclassName - packageName: self request packageName - tag: self request tag - slots: self request slots - classSlots: self request classSlots - traits: self request traits - classTraits: self request classTraits - sharedVariables: self request sharedVariables - sharedPools: self request sharedPools - layout: self request layout) execute. - self request classComment ifNotNil: [ - (MCPChangeClassCommentCommand - className: self request className - classComment: self request classComment) execute ] ] + result := (MCPCreateClassCommand + className: self request className + superclassName: self request superclassName + packageName: self request packageName + tag: self request tag + slots: self request slots + classSlots: self request classSlots + traits: self request traits + classTraits: self request classTraits + sharedVariables: self request sharedVariables + sharedPools: self request sharedPools + layout: self request layout) execute. + self request classComment ifNotNil: [ + (MCPChangeClassCommentCommand + className: self request className + classComment: self request classComment) execute ] ] successResult: [ :warningMessages | - self tool - successResultText: - 'Created class ' , self request className , '.' - data: (self tool dataForResult: result action: 'create') - warnings: warningMessages ] + self tool + successResultText: + 'Created class ' , self request className , '.' + data: (self tool dataForResult: result action: 'create') + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForCreateClassNamed: self request className - superclassName: self request superclassName - packageName: self request packageName - error: error ] - + self tool + failureMessageForCreateClassNamed: self request className + superclassName: self request superclassName + packageName: self request packageName + error: error ] ] diff --git a/src/MCP/MCPDebugCommand.class.st b/src/MCP/MCPDebugCommand.class.st index cd28d71..70db5be 100644 --- a/src/MCP/MCPDebugCommand.class.st +++ b/src/MCP/MCPDebugCommand.class.st @@ -34,7 +34,7 @@ MCPDebugCommand >> frameRefForRecord: aRecord frameIndex: frameIndex [ frameIndex ifNil: [ ^ nil ]. ^ aRecord sessionId , '/' , aRecord stateId , '/frame-' - , frameIndex asString + , frameIndex asString ] { #category : 'initialization' } @@ -87,8 +87,9 @@ MCPDebugCommand >> selectedContextForRecord: aRecord frameIndex: frameIndex [ stateInfo := MCPDebugStateInfo fromRecord: aRecord request: request. contexts := stateInfo rawContexts. ^ contexts - at: frameIndex + 1 - ifAbsent: [ self signalMissingFrameIndex: frameIndex record: aRecord ] + at: frameIndex + 1 + ifAbsent: [ + self signalMissingFrameIndex: frameIndex record: aRecord ] ] { #category : 'private - frames' } @@ -163,16 +164,17 @@ MCPDebugCommand >> signalInvalidFrameReference: aFrameRef details: detailAssocia MCPDebugCommand >> signalMissingFrameIndex: frameIndex record: aRecord [ ^ MCPCommandError - signalErrorCode: #DebugFrameNotFound - message: - 'Debug frame ' , frameIndex asString - , ' was not found for session ' , aRecord sessionId , '.' - details: { - (#sessionId -> aRecord sessionId). - (#stateId -> aRecord stateId). - (#frameIndex -> frameIndex). - (#frameRef -> (self frameRefForRecord: aRecord frameIndex: frameIndex)) } - asDictionary + signalErrorCode: #DebugFrameNotFound + message: + 'Debug frame ' , frameIndex asString + , ' was not found for session ' , aRecord sessionId , '.' + details: { + (#sessionId -> aRecord sessionId). + (#stateId -> aRecord stateId). + (#frameIndex -> frameIndex). + (#frameRef + -> (self frameRefForRecord: aRecord frameIndex: frameIndex)) } + asDictionary ] { #category : 'private - errors' } diff --git a/src/MCP/MCPDebugRepairAnalyzer.class.st b/src/MCP/MCPDebugRepairAnalyzer.class.st index a4ddc97..3eebfa3 100644 --- a/src/MCP/MCPDebugRepairAnalyzer.class.st +++ b/src/MCP/MCPDebugRepairAnalyzer.class.st @@ -224,7 +224,8 @@ MCPDebugRepairAnalyzer >> repairActionForContext: aContext behavior: aBehavior s (#selector -> aSelector asString). (#targetClassName -> (self classNameForBehavior: aBehavior)). (#classSide -> (self classSideForBehavior: aBehavior)). - (#arguments -> (self debugMethodUpdateArgumentsForFrameRef: frameRef)) } + (#arguments + -> (self debugMethodUpdateArgumentsForFrameRef: frameRef)) } asDictionary ] diff --git a/src/MCP/MCPDebugVariablesCommand.class.st b/src/MCP/MCPDebugVariablesCommand.class.st index e7e9eee..60abc88 100644 --- a/src/MCP/MCPDebugVariablesCommand.class.st +++ b/src/MCP/MCPDebugVariablesCommand.class.st @@ -277,15 +277,15 @@ MCPDebugVariablesCommand >> rootValueForVariableReference: aReference context: a aReference variableName ifNil: [ ^ self signalMissingVariableForReference: aReference ]. aReference scopeName = 'receiver' ifTrue: [ - aReference variableName = 'self' ifTrue: [ ^ aContext receiver ]. - ^ self signalMissingVariableForReference: aReference ]. + aReference variableName = 'self' ifTrue: [ ^ aContext receiver ]. + ^ self signalMissingVariableForReference: aReference ]. aReference scopeName = 'temporaries' ifTrue: [ - names := aContext tempNames collect: [ :each | each asString ]. - index := names - indexOf: aReference variableName - ifAbsent: [ - ^ self signalMissingVariableForReference: aReference ]. - ^ aContext tempAt: index ]. + names := aContext tempNames collect: [ :each | each asString ]. + index := names + indexOf: aReference variableName + ifAbsent: [ + ^ self signalMissingVariableForReference: aReference ]. + ^ aContext tempAt: index ]. ^ self signalMissingScopeNamed: aReference scopeName forReference: aReference diff --git a/src/MCP/MCPEvaluateCommand.class.st b/src/MCP/MCPEvaluateCommand.class.st index 71ec89d..258792e 100644 --- a/src/MCP/MCPEvaluateCommand.class.st +++ b/src/MCP/MCPEvaluateCommand.class.st @@ -29,15 +29,15 @@ MCPEvaluateCommand >> execute [ compiler compilationContext isScripting: true. notice := nil. compiler failBlock: [ :aNotice | - notice := aNotice. - nil ]. + notice := aNotice. + nil ]. answer := [ compiler evaluate: request code ] on: Exception do: [ :error | - (PharoCompatibility syntaxNoticeFromException: error) - ifNotNil: [ - :syntaxNotice | ^ self syntaxFailureFor: syntaxNotice ]. - ^ self runtimeFailureFor: error ]. + (PharoCompatibility syntaxNoticeFromException: error) + ifNotNil: [ :syntaxNotice | + ^ self syntaxFailureFor: syntaxNotice ]. + ^ self runtimeFailureFor: error ]. notice ifNotNil: [ ^ self syntaxFailureFor: notice ]. ^ MCPEvaluateResult okData: { (#resultClassName -> answer class name asString). diff --git a/src/MCP/MCPGetClassCommand.class.st b/src/MCP/MCPGetClassCommand.class.st index ff4f95f..493781f 100644 --- a/src/MCP/MCPGetClassCommand.class.st +++ b/src/MCP/MCPGetClassCommand.class.st @@ -42,8 +42,8 @@ MCPGetClassCommand >> subclassesForClass: aClass [ subclasses := OrderedCollection new. aClass allSubclassesWithLevelDo: [ :eachClass :level | - (level between: 1 and: request subclassDepth) ifTrue: [ - subclasses add: eachClass ] ] + (level between: 1 and: request subclassDepth) ifTrue: [ + subclasses add: eachClass ] ] startingLevel: 0. ^ subclasses asArray ] @@ -57,9 +57,9 @@ MCPGetClassCommand >> superclassesForClass: aClass [ targetSuperclass := Smalltalk globals at: targetSuperclassName asSymbol ifAbsent: [ - MCPCommandError - signalMissingSuperclassNamed: - targetSuperclassName - forClassNamed: aClass name asString ]. + MCPCommandError + signalMissingSuperclassNamed: + targetSuperclassName + forClassNamed: aClass name asString ]. ^ aClass allSuperclasses asArray copyUpTo: targetSuperclass ] diff --git a/src/MCP/MCPGetMethodCommand.class.st b/src/MCP/MCPGetMethodCommand.class.st index ee774d9..5609ea3 100644 --- a/src/MCP/MCPGetMethodCommand.class.st +++ b/src/MCP/MCPGetMethodCommand.class.st @@ -25,12 +25,12 @@ MCPGetMethodCommand >> execute [ (#source -> (compiledMethod sourceCode ifNil: [ '' ])) } asDictionary. request includeVariableDetails ifTrue: [ - methodBehavior := tool - behaviorNamed: request className - classSide: request classSide. - variableReferences := tool - variableSummariesForMethod: compiledMethod - methodBehavior: methodBehavior. - data at: #variableReferences put: variableReferences ]. + methodBehavior := tool + behaviorNamed: request className + classSide: request classSide. + variableReferences := tool + variableSummariesForMethod: compiledMethod + methodBehavior: methodBehavior. + data at: #variableReferences put: variableReferences ]. ^ MCPGetMethodResult data: data externalVariableCount: nil ] diff --git a/src/MCP/MCPHTTPServer.class.st b/src/MCP/MCPHTTPServer.class.st index a244526..4ca7a8f 100644 --- a/src/MCP/MCPHTTPServer.class.st +++ b/src/MCP/MCPHTTPServer.class.st @@ -46,9 +46,9 @@ MCPHTTPServer >> answerPost: request with: response [ | payload | payload := self handleJSON: request contents. (payload isString and: [ payload isEmpty ]) ifTrue: [ - response statusLine: ZnStatusLine accepted. - response headers at: #'Content-Length' put: '0'. - ^ response ]. + response statusLine: ZnStatusLine accepted. + response headers at: #'Content-Length' put: '0'. + ^ response ]. response entity: (ZnEntity json: payload). ^ response ] diff --git a/src/MCP/MCPImageLookup.class.st b/src/MCP/MCPImageLookup.class.st index 34c9707..1f7c508 100644 --- a/src/MCP/MCPImageLookup.class.st +++ b/src/MCP/MCPImageLookup.class.st @@ -21,9 +21,9 @@ MCPImageLookup class >> classNamed: aClassName [ MCPImageLookup class >> classNamed: aClassName scopeName: scopeName [ ^ Smalltalk globals at: aClassName asSymbol ifAbsent: [ - MCPCommandError - signalMissingClassNamed: aClassName - scopeName: scopeName ] + MCPCommandError + signalMissingClassNamed: aClassName + scopeName: scopeName ] ] { #category : 'resolving' } @@ -38,7 +38,7 @@ MCPImageLookup class >> packageNamed: aPackageName scopeName: scopeName [ ^ PackageOrganizer default packageNamed: aPackageName asSymbol ifAbsent: [ - MCPCommandError - signalMissingPackageNamed: aPackageName - scopeName: scopeName ] + MCPCommandError + signalMissingPackageNamed: aPackageName + scopeName: scopeName ] ] diff --git a/src/MCP/MCPJSONSchemaValidator.class.st b/src/MCP/MCPJSONSchemaValidator.class.st index 8ed0cfa..24aee1e 100644 --- a/src/MCP/MCPJSONSchemaValidator.class.st +++ b/src/MCP/MCPJSONSchemaValidator.class.st @@ -53,8 +53,8 @@ MCPJSONSchemaValidator >> hasObjectKeywordsIn: schema [ MCPJSONSchemaValidator >> includesPropertyNamed: propertyName in: aDictionary [ ^ (aDictionary includesKey: propertyName) or: [ - (aDictionary includesKey: propertyName asString) or: [ - aDictionary includesKey: propertyName asSymbol ] ] + (aDictionary includesKey: propertyName asString) or: [ + aDictionary includesKey: propertyName asSymbol ] ] ] { #category : 'initialization' } @@ -192,12 +192,12 @@ MCPJSONSchemaValidator >> validateAnyOfIn: schema for: aValue atPath: path [ matches := schemas count: [ :eachSchema | self schema: eachSchema matchesValue: aValue ]. matches = 0 ifTrue: [ - self - addViolationAt: path - keyword: #anyOf - message: 'Value must match at least one schema branch.' - expected: 'at least one matching branch' - actual: matches ] + self + addViolationAt: path + keyword: #anyOf + message: 'Value must match at least one schema branch.' + expected: 'at least one matching branch' + actual: matches ] ] { #category : 'private - array validation' } @@ -236,12 +236,12 @@ MCPJSONSchemaValidator >> validateConstIn: schema for: aValue atPath: path [ in: schema ifAbsent: [ ^ self ]. aValue = expectedValue ifFalse: [ - self - addViolationAt: path - keyword: #const - message: 'Value must equal the schema constant.' - expected: expectedValue - actual: aValue ] + self + addViolationAt: path + keyword: #const + message: 'Value must equal the schema constant.' + expected: expectedValue + actual: aValue ] ] { #category : 'private - object validation' } @@ -253,15 +253,15 @@ MCPJSONSchemaValidator >> validateDefinedPropertiesIn: aDictionary againstSchema in: schema ifAbsent: [ ^ self ]. properties keysAndValuesDo: [ :propertyName :propertySchema | - self - propertyValueNamed: propertyName - in: aDictionary - ifPresent: [ :value | - self - validateValue: value - againstSchema: propertySchema - atPath: (path copyWith: propertyName asString) ] - ifAbsent: [ ] ] + self + propertyValueNamed: propertyName + in: aDictionary + ifPresent: [ :value | + self + validateValue: value + againstSchema: propertySchema + atPath: (path copyWith: propertyName asString) ] + ifAbsent: [ ] ] ] { #category : 'private - validating' } @@ -273,12 +273,12 @@ MCPJSONSchemaValidator >> validateEnumIn: schema for: aValue atPath: path [ in: schema ifAbsent: [ ^ self ]. (expectedValues includes: aValue) ifFalse: [ - self - addViolationAt: path - keyword: #enum - message: 'Value must be one of the schema enum values.' - expected: expectedValues - actual: aValue ] + self + addViolationAt: path + keyword: #enum + message: 'Value must be one of the schema enum values.' + expected: expectedValues + actual: aValue ] ] { #category : 'private - combinators' } @@ -306,12 +306,12 @@ MCPJSONSchemaValidator >> validateNotIn: schema for: aValue atPath: path [ in: schema ifAbsent: [ ^ self ]. (self schema: prohibitedSchema matchesValue: aValue) ifTrue: [ - self - addViolationAt: path - keyword: #not - message: 'Value must not match the prohibited schema.' - expected: 'a value that does not match the prohibited schema' - actual: 'matched prohibited schema' ] + self + addViolationAt: path + keyword: #not + message: 'Value must not match the prohibited schema.' + expected: 'a value that does not match the prohibited schema' + actual: 'matched prohibited schema' ] ] { #category : 'private - number validation' } @@ -363,12 +363,12 @@ MCPJSONSchemaValidator >> validateOneOfIn: schema for: aValue atPath: path [ matches := schemas count: [ :eachSchema | self schema: eachSchema matchesValue: aValue ]. matches = 1 ifFalse: [ - self - addViolationAt: path - keyword: #oneOf - message: 'Value must match exactly one schema branch.' - expected: 'exactly one matching branch' - actual: matches ] + self + addViolationAt: path + keyword: #oneOf + message: 'Value must match exactly one schema branch.' + expected: 'exactly one matching branch' + actual: matches ] ] { #category : 'private - object validation' } @@ -380,13 +380,14 @@ MCPJSONSchemaValidator >> validateRequiredPropertiesIn: aDictionary againstSchem in: schema ifAbsent: [ #( ) ]. requiredProperties do: [ :propertyName | - (self includesPropertyNamed: propertyName in: aDictionary) ifFalse: [ - self - addViolationAt: path - keyword: #required - message: 'Object is missing a required property.' - expected: propertyName - actual: nil ] ] + (self includesPropertyNamed: propertyName in: aDictionary) + ifFalse: [ + self + addViolationAt: path + keyword: #required + message: 'Object is missing a required property.' + expected: propertyName + actual: nil ] ] ] { #category : 'private - string validation' } diff --git a/src/MCP/MCPListChangeHistoryEntriesCommand.class.st b/src/MCP/MCPListChangeHistoryEntriesCommand.class.st index 1afa023..083ef1f 100644 --- a/src/MCP/MCPListChangeHistoryEntriesCommand.class.st +++ b/src/MCP/MCPListChangeHistoryEntriesCommand.class.st @@ -42,11 +42,11 @@ MCPListChangeHistoryEntriesCommand >> matchingEntryPairsFrom: aLog [ | pairs | pairs := OrderedCollection new. aLog entries doWithIndex: [ :entry :index | - (request codeChangesOnly not or: [ self isCodeChangeEntry: entry ]) - ifTrue: [ - pairs add: { - index. - entry } ] ]. + (request codeChangesOnly not or: [ self isCodeChangeEntry: entry ]) + ifTrue: [ + pairs add: { + index. + entry } ] ]. request newestFirst ifTrue: [ ^ pairs reversed asOrderedCollection ]. ^ pairs ] diff --git a/src/MCP/MCPLoadBaselineCommand.class.st b/src/MCP/MCPLoadBaselineCommand.class.st index b9a8a5d..bd92fce 100644 --- a/src/MCP/MCPLoadBaselineCommand.class.st +++ b/src/MCP/MCPLoadBaselineCommand.class.st @@ -89,9 +89,9 @@ MCPLoadBaselineCommand >> initializeTool: aTool request: aRequest configureMetac MCPLoadBaselineCommand >> loadMetacello: metacello [ [ - self request groups isEmpty - ifTrue: [ metacello load ] - ifFalse: [ metacello load: self request groups ] ] + self request groups isEmpty + ifTrue: [ metacello load ] + ifFalse: [ metacello load: self request groups ] ] on: MetacelloNotification do: [ :notification | notification resume ] ] diff --git a/src/MCP/MCPLoadRepositoryRequest.class.st b/src/MCP/MCPLoadRepositoryRequest.class.st index 64a7ccf..60ee540 100644 --- a/src/MCP/MCPLoadRepositoryRequest.class.st +++ b/src/MCP/MCPLoadRepositoryRequest.class.st @@ -347,10 +347,10 @@ MCPLoadRepositoryRequest >> repositoryScheme [ scheme = 'gitlabs' ifTrue: [ ^ 'gitlab' ]. scheme = 'bitbucket.org' ifTrue: [ ^ 'bitbucket' ]. (#( 'github' 'gitlab' 'bitbucket' ) includes: scheme) ifFalse: [ - MCPCommandError - signalErrorCode: #UnsupportedLoadRepositoryHost - message: 'hostUrl must identify github, gitlab, or bitbucket.' - details: { (#hostUrl -> self hostUrl) } asDictionary ]. + MCPCommandError + signalErrorCode: #UnsupportedLoadRepositoryHost + message: 'hostUrl must identify github, gitlab, or bitbucket.' + details: { (#hostUrl -> self hostUrl) } asDictionary ]. ^ scheme ] diff --git a/src/MCP/MCPMessageProcessor.class.st b/src/MCP/MCPMessageProcessor.class.st index b3bf0ec..e1c5805 100644 --- a/src/MCP/MCPMessageProcessor.class.st +++ b/src/MCP/MCPMessageProcessor.class.st @@ -24,31 +24,31 @@ MCPMessageProcessor >> addHandler: aJRPCHandler [ MCPMessageProcessor >> addHandlersFromPragmasIn: anObject [ (Pragma allNamed: #jrpc: in: anObject class) do: [ :pragma | - self addHandler: (MCPMessageSendHandler new - receiver: anObject; - methodName: pragma arguments first; - messageSelector: pragma methodSelector; - yourself) ] + self addHandler: (MCPMessageSendHandler new + receiver: anObject; + methodName: pragma arguments first; + messageSelector: pragma methodSelector; + yourself) ] ] { #category : 'handling - jrpc' } MCPMessageProcessor >> handleJRPCRequestObject: aJRPCRequestObject [ ^ [ - | handler result | - handler := self handlerFor: aJRPCRequestObject. - handler checkParametersForRequest: aJRPCRequestObject. - result := handler executeWithArguments: aJRPCRequestObject params. - JRPCSuccessResponseObject id: aJRPCRequestObject id result: result ] + | handler result | + handler := self handlerFor: aJRPCRequestObject. + handler checkParametersForRequest: aJRPCRequestObject. + result := handler executeWithArguments: aJRPCRequestObject params. + JRPCSuccessResponseObject id: aJRPCRequestObject id result: result ] on: Exception do: [ :exception | - self debugMode - ifTrue: [ exception pass ] - ifFalse: [ - exception return: - (self - responseForException: exception - request: aJRPCRequestObject) ] ] + self debugMode + ifTrue: [ exception pass ] + ifFalse: [ + exception return: + (self + responseForException: exception + request: aJRPCRequestObject) ] ] ] { #category : 'handling - json' } @@ -56,14 +56,14 @@ MCPMessageProcessor >> handleJSON: aJSONString [ | jrpcResponse | jrpcResponse := [ - (self parseSupposedJRPCMessageObjectFromString: - aJSONString) beHandledBy: self ] + (self parseSupposedJRPCMessageObjectFromString: + aJSONString) beHandledBy: self ] on: Exception do: [ :exception | - self debugMode - ifTrue: [ exception pass ] - ifFalse: [ - exception return: exception asJRPCResponse ] ]. + self debugMode + ifTrue: [ exception pass ] + ifFalse: [ + exception return: exception asJRPCResponse ] ]. ^ jrpcResponse beConvertedBy: self ] diff --git a/src/MCP/MCPMethodCompileRequest.class.st b/src/MCP/MCPMethodCompileRequest.class.st index 410999f..66f72e4 100644 --- a/src/MCP/MCPMethodCompileRequest.class.st +++ b/src/MCP/MCPMethodCompileRequest.class.st @@ -55,8 +55,7 @@ MCPMethodCompileRequest >> initializeFromRequest: request tool: aTool [ classSide := request booleanArgumentNamed: 'classSide' default: false. methodSource := (request argumentNamed: 'source' ifAbsent: [ MCPInvalidToolInput - signalMissingRequiredArgumentNamed: - 'source' + signalMissingRequiredArgumentNamed: 'source' forTool: aTool ]) withInternalLineEndings. protocol := request stringArgumentNamed: 'protocol'. force := request booleanArgumentNamed: 'force' default: false. diff --git a/src/MCP/MCPMethodReferenceSpec.class.st b/src/MCP/MCPMethodReferenceSpec.class.st index 7bcd1a5..df5e890 100644 --- a/src/MCP/MCPMethodReferenceSpec.class.st +++ b/src/MCP/MCPMethodReferenceSpec.class.st @@ -52,10 +52,10 @@ MCPMethodReferenceSpec >> compiledMethod [ behavior := self behavior. selectorSymbol := self selector asSymbol. (behavior includesSelector: selectorSymbol) ifFalse: [ - MCPCommandError - signalMissingMethodInClassName: self className - classSide: self classSide - selector: self selector ]. + MCPCommandError + signalMissingMethodInClassName: self className + classSide: self classSide + selector: self selector ]. ^ behavior compiledMethodAt: selectorSymbol ] diff --git a/src/MCP/MCPMethodRewriteChangeInfo.class.st b/src/MCP/MCPMethodRewriteChangeInfo.class.st index 35008ca..e253527 100644 --- a/src/MCP/MCPMethodRewriteChangeInfo.class.st +++ b/src/MCP/MCPMethodRewriteChangeInfo.class.st @@ -38,8 +38,8 @@ MCPMethodRewriteChangeInfo >> asDictionary [ (#packageName -> self packageName). (#protocol -> self protocol) } asDictionary. self includeSources ifTrue: [ - data at: #oldSource put: self oldSource. - data at: #newSource put: self newSource ]. + data at: #oldSource put: self oldSource. + data at: #newSource put: self newSource ]. ^ data ] @@ -76,14 +76,14 @@ MCPMethodRewriteChangeInfo >> initializeFromChange: aChange includeSources: aBoo ifAbsent: [ nil ]. compiledMethod ifNil: [ - packageName := ''. - protocol := ''. - oldSource := '' ] + packageName := ''. + protocol := ''. + oldSource := '' ] ifNotNil: [ - methodInfo := MCPCompiledMethodInfo fromMethod: compiledMethod. - packageName := methodInfo packageName. - protocol := methodInfo protocol. - oldSource := compiledMethod sourceCode ifNil: [ '' ] ]. + methodInfo := MCPCompiledMethodInfo fromMethod: compiledMethod. + packageName := methodInfo packageName. + protocol := methodInfo protocol. + oldSource := compiledMethod sourceCode ifNil: [ '' ] ]. newSource := aChange source ifNil: [ '' ]. includeSources := aBoolean. ^ self diff --git a/src/MCP/MCPMethodRewriteRuleSpec.class.st b/src/MCP/MCPMethodRewriteRuleSpec.class.st index 92ab169..6361bb5 100644 --- a/src/MCP/MCPMethodRewriteRuleSpec.class.st +++ b/src/MCP/MCPMethodRewriteRuleSpec.class.st @@ -129,15 +129,15 @@ MCPMethodRewriteRuleSpec >> signalInvalidPatternError: anError [ MCPMethodRewriteRuleSpec >> validateAtIndex: index [ lhs ifNil: [ - MCPCommandError - signalErrorCode: #RewriteRuleMissingLhs - message: 'Rewrite rule ' , index asString , ' is missing lhs.' - details: self diagnosticDetails ]. + MCPCommandError + signalErrorCode: #RewriteRuleMissingLhs + message: 'Rewrite rule ' , index asString , ' is missing lhs.' + details: self diagnosticDetails ]. rhs ifNil: [ - MCPCommandError - signalErrorCode: #RewriteRuleMissingRhs - message: 'Rewrite rule ' , index asString , ' is missing rhs.' - details: self diagnosticDetails ] + MCPCommandError + signalErrorCode: #RewriteRuleMissingRhs + message: 'Rewrite rule ' , index asString , ' is missing rhs.' + details: self diagnosticDetails ] ] { #category : 'validating' } diff --git a/src/MCP/MCPMethodUpdateRequest.class.st b/src/MCP/MCPMethodUpdateRequest.class.st index 163af32..499fdec 100644 --- a/src/MCP/MCPMethodUpdateRequest.class.st +++ b/src/MCP/MCPMethodUpdateRequest.class.st @@ -29,13 +29,13 @@ MCPMethodUpdateRequest class >> fromRequest: request tool: aTool [ parsedRequest := self new initializeFromRequest: request. parsedRequest hasRenameUpdate ifTrue: [ - parsedRequest refactoringScopeSpec: - (aTool refactoringScopeSpecFromRequest: request) ] + parsedRequest refactoringScopeSpec: + (aTool refactoringScopeSpecFromRequest: request) ] ifFalse: [ - parsedRequest refactoringScopeSpec: (MCPRefactoringScopeSpec - packageNames: #( ) - classNames: #( ) - hierarchyClassNames: #( )) ]. + parsedRequest refactoringScopeSpec: (MCPRefactoringScopeSpec + packageNames: #( ) + classNames: #( ) + hierarchyClassNames: #( )) ]. ^ parsedRequest ] @@ -61,15 +61,15 @@ MCPMethodUpdateRequest >> argumentRenameMapForBehavior: aBehavior [ oldArgumentNames := parseTree argumentNames. renameMap := OrderedCollection new. 1 to: self permutation size do: [ :targetIndex | - | oldIndex newArgumentName oldArgumentName renameArgument | - oldIndex := self permutation at: targetIndex. - oldIndex > 0 ifTrue: [ - oldArgumentName := oldArgumentNames at: oldIndex. - newArgumentName := self argumentNames at: targetIndex. - oldArgumentName = newArgumentName ifFalse: [ - renameArgument := RBArgumentName name: oldArgumentName. - renameArgument newName: newArgumentName. - renameMap add: renameArgument ] ] ]. + | oldIndex newArgumentName oldArgumentName renameArgument | + oldIndex := self permutation at: targetIndex. + oldIndex > 0 ifTrue: [ + oldArgumentName := oldArgumentNames at: oldIndex. + newArgumentName := self argumentNames at: targetIndex. + oldArgumentName = newArgumentName ifFalse: [ + renameArgument := RBArgumentName name: oldArgumentName. + renameArgument newName: newArgumentName. + renameMap add: renameArgument ] ] ]. ^ renameMap asArray ] @@ -126,8 +126,8 @@ MCPMethodUpdateRequest >> defaultPermutationFromSelector: oldSelector toSelector ^ self identityPermutationForSelector: oldSelector ]. newArgumentCount = 0 ifTrue: [ ^ #( ) ]. oldArgumentCount = 0 ifTrue: [ - ^ ((1 to: newArgumentCount) collect: [ :index | index negated ]) - asArray ]. + ^ ((1 to: newArgumentCount) collect: [ :index | index negated ]) + asArray ]. ^ self keywordPermutationFromSelector: oldSelector toSelector: newSelector @@ -212,18 +212,18 @@ MCPMethodUpdateRequest >> keywordPermutationFromSelector: oldSelector toSelector usedOldIndexes := Set new. nextNewArgument := 0. ^ (newSelector keywords collect: [ :keyword | - | oldIndex | - oldIndex := self - unusedIndexOf: keyword - in: oldKeywords - excluding: usedOldIndexes. - oldIndex = 0 - ifTrue: [ - nextNewArgument := nextNewArgument + 1. - nextNewArgument negated ] - ifFalse: [ - usedOldIndexes add: oldIndex. - oldIndex ] ]) asArray + | oldIndex | + oldIndex := self + unusedIndexOf: keyword + in: oldKeywords + excluding: usedOldIndexes. + oldIndex = 0 + ifTrue: [ + nextNewArgument := nextNewArgument + 1. + nextNewArgument negated ] + ifFalse: [ + usedOldIndexes add: oldIndex. + oldIndex ] ]) asArray ] { #category : 'converting' } @@ -274,10 +274,10 @@ MCPMethodUpdateRequest >> permutationFromRequest: request selector: oldSelector requestedPermutation := request arrayArgumentNamed: 'permutation' ifAbsent: [ - ^ self - defaultPermutationFromSelector: - oldSelector - toSelector: selectorToUse ]. + ^ self + defaultPermutationFromSelector: + oldSelector + toSelector: selectorToUse ]. self validatePermutation: requestedPermutation fromSelector: oldSelector @@ -335,9 +335,9 @@ MCPMethodUpdateRequest >> requestedContext [ context at: #classSide put: self classSide. context at: #selector put: self selector. self suppliedProperties do: [ :propertyName | - context - at: propertyName asSymbol - put: (self contextValueForPropertyNamed: propertyName) ]. + context + at: propertyName asSymbol + put: (self contextValueForPropertyNamed: propertyName) ]. ^ context ] @@ -368,8 +368,8 @@ MCPMethodUpdateRequest >> suppliedProperties [ MCPMethodUpdateRequest >> unusedIndexOf: keyword in: oldKeywords excluding: usedOldIndexes [ 1 to: oldKeywords size do: [ :index | - ((oldKeywords at: index) = keyword and: [ - (usedOldIndexes includes: index) not ]) ifTrue: [ ^ index ] ]. + ((oldKeywords at: index) = keyword and: [ + (usedOldIndexes includes: index) not ]) ifTrue: [ ^ index ] ]. ^ 0 ] @@ -384,31 +384,31 @@ MCPMethodUpdateRequest >> updatePropertyNames [ MCPMethodUpdateRequest >> validateAddArgumentsUpdate [ self argumentNames isEmpty ifTrue: [ - MCPCommandError - signalErrorCode: #ArgumentNamesRequiredForAddedArguments - message: - 'argumentNames is required when newSelector adds method arguments.' - details: self requestedContext ]. + MCPCommandError + signalErrorCode: #ArgumentNamesRequiredForAddedArguments + message: + 'argumentNames is required when newSelector adds method arguments.' + details: self requestedContext ]. self argumentNames size = self newSelector asSymbol numArgs ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentNames - message: - 'argumentNames must contain one name for each target selector argument.' - details: self requestedContext ]. - (self argumentNames allSatisfy: [ :each | each isNotEmpty ]) - ifFalse: [ MCPCommandError signalErrorCode: #InvalidMethodArgumentNames - message: 'argumentNames must not contain empty names.' + message: + 'argumentNames must contain one name for each target selector argument.' details: self requestedContext ]. + (self argumentNames allSatisfy: [ :each | each isNotEmpty ]) + ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentNames + message: 'argumentNames must not contain empty names.' + details: self requestedContext ]. (self argumentValueExpressions isNotEmpty and: [ self argumentValueExpressions size ~= self addedArgumentCount ]) ifTrue: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentValueExpressions - message: - 'argumentValueExpressions must contain one expression for each newly added argument.' - details: self requestedContext ]. + MCPCommandError + signalErrorCode: #InvalidMethodArgumentValueExpressions + message: + 'argumentValueExpressions must contain one expression for each newly added argument.' + details: self requestedContext ]. ^ self ] @@ -417,20 +417,20 @@ MCPMethodUpdateRequest >> validateForUpdate [ | action | self hasPermutation ifTrue: [ - self hasRenameUpdate ifFalse: [ - MCPCommandError - signalErrorCode: #PermutationRequiresMethodSelectorUpdate - message: - 'permutation is only valid when update changes a method selector with newSelector.' - details: self requestedContext ] ]. + self hasRenameUpdate ifFalse: [ + MCPCommandError + signalErrorCode: #PermutationRequiresMethodSelectorUpdate + message: + 'permutation is only valid when update changes a method selector with newSelector.' + details: self requestedContext ] ]. (self hasArgumentNames or: [ self hasArgumentValueExpressions ]) ifTrue: [ - self hasRenameUpdate ifFalse: [ - MCPCommandError - signalErrorCode: #ArgumentMetadataRequiresMethodSelectorUpdate - message: - 'argumentNames and argumentValueExpressions are only valid with newSelector.' - details: self requestedContext ] ]. + self hasRenameUpdate ifFalse: [ + MCPCommandError + signalErrorCode: #ArgumentMetadataRequiresMethodSelectorUpdate + message: + 'argumentNames and argumentValueExpressions are only valid with newSelector.' + details: self requestedContext ] ]. action := self newSelectorUpdateAction. action = 'addArguments' ifTrue: [ self validateAddArgumentsUpdate ]. ^ self @@ -443,51 +443,51 @@ MCPMethodUpdateRequest >> validatePermutation: requestedPermutation fromSelector oldArgumentCount := oldSelector numArgs. newArgumentCount := newSelector numArgs. requestedPermutation size = newArgumentCount ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'permutation must contain one entry for each target selector argument.' - details: self requestedContext ]. - (requestedPermutation allSatisfy: [ :each | each isInteger ]) - ifFalse: [ MCPCommandError signalErrorCode: #InvalidMethodArgumentPermutation - message: 'permutation entries must be integers.' + message: + 'permutation must contain one entry for each target selector argument.' details: self requestedContext ]. + (requestedPermutation allSatisfy: [ :each | each isInteger ]) + ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: 'permutation entries must be integers.' + details: self requestedContext ]. positiveIndexes := requestedPermutation select: [ :each | each > 0 ]. (positiveIndexes allSatisfy: [ :each | each between: 1 and: oldArgumentCount ]) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'positive permutation entries must reference existing arguments by 1-based index.' - details: self requestedContext ]. + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'positive permutation entries must reference existing arguments by 1-based index.' + details: self requestedContext ]. positiveIndexes asSet size = positiveIndexes size ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'permutation must not reference the same old argument twice.' - details: self requestedContext ]. + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'permutation must not reference the same old argument twice.' + details: self requestedContext ]. newArgumentCount >= oldArgumentCount ifTrue: [ - positiveIndexes size = oldArgumentCount ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'adding arguments requires every old argument to appear exactly once in permutation.' - details: self requestedContext ] ] + positiveIndexes size = oldArgumentCount ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'adding arguments requires every old argument to appear exactly once in permutation.' + details: self requestedContext ] ] ifFalse: [ - positiveIndexes size = newArgumentCount ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'removing arguments requires permutation to contain only kept old argument indexes.' - details: self requestedContext ]. - (requestedPermutation allSatisfy: [ :each | each > 0 ]) ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidMethodArgumentPermutation - message: - 'removing arguments does not accept negative permutation entries.' - details: self requestedContext ] ]. + positiveIndexes size = newArgumentCount ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'removing arguments requires permutation to contain only kept old argument indexes.' + details: self requestedContext ]. + (requestedPermutation allSatisfy: [ :each | each > 0 ]) ifFalse: [ + MCPCommandError + signalErrorCode: #InvalidMethodArgumentPermutation + message: + 'removing arguments does not accept negative permutation entries.' + details: self requestedContext ] ]. ^ self ] diff --git a/src/MCP/MCPMonitoringState.class.st b/src/MCP/MCPMonitoringState.class.st index 142efd3..bcc37d7 100644 --- a/src/MCP/MCPMonitoringState.class.st +++ b/src/MCP/MCPMonitoringState.class.st @@ -73,24 +73,25 @@ MCPMonitoringState >> approximateOutputTokensForBytes: byteCount [ MCPMonitoringState >> captureTraceSnapshotsFor: aRecord result: aToolResult error: anError [ [ - [ - aRecord isTraceWorthy - ifTrue: [ - aRecord inputSnapshot: (self traceSnapshotFor: aRecord inputObject). - aRecord outputSnapshot: - (self traceSnapshotForResult: aToolResult error: anError) ] - ifFalse: [ - aRecord inputSnapshot: nil. - aRecord outputSnapshot: nil ] ] - on: Error - do: [ :snapshotError | - aRecord inputSnapshot: nil. - aRecord outputSnapshot: (self traceSnapshotFor: { - (#errorClass -> snapshotError class name asString). - (#message - -> - (snapshotError messageText ifNil: [ snapshotError asString ])). - (#during -> 'trace snapshot creation') } asDictionary) ] ] + [ + aRecord isTraceWorthy + ifTrue: [ + aRecord inputSnapshot: + (self traceSnapshotFor: aRecord inputObject). + aRecord outputSnapshot: + (self traceSnapshotForResult: aToolResult error: anError) ] + ifFalse: [ + aRecord inputSnapshot: nil. + aRecord outputSnapshot: nil ] ] + on: Error + do: [ :snapshotError | + aRecord inputSnapshot: nil. + aRecord outputSnapshot: (self traceSnapshotFor: { + (#errorClass -> snapshotError class name asString). + (#message + -> + (snapshotError messageText ifNil: [ snapshotError asString ])). + (#during -> 'trace snapshot creation') } asDictionary) ] ] ensure: [ aRecord inputObject: nil ] ] @@ -165,8 +166,8 @@ MCPMonitoringState >> ensureLogger [ logger ifNil: [ logger := TinyLogger new ]. memoryLogger ifNil: [ - memoryLogger := MCPMemoryTinyLogger new. - logger addLogger: memoryLogger ]. + memoryLogger := MCPMemoryTinyLogger new. + logger addLogger: memoryLogger ]. ^ logger ] @@ -475,13 +476,13 @@ MCPMonitoringState >> outlierExplanationForDurationMilliseconds: duration stats: ratio := duration / average. ratio < self outlierFactor ifTrue: [ ^ '' ]. ^ String streamContents: [ :stream | - stream - print: duration; - nextPutAll: ' ms is '; - nextPutAll: (ratio asFloat printShowingDecimalPlaces: 1); - nextPutAll: 'x the prior average of '; - nextPutAll: (average asFloat printShowingDecimalPlaces: 1); - nextPutAll: ' ms' ] + stream + print: duration; + nextPutAll: ' ms is '; + nextPutAll: (ratio asFloat printShowingDecimalPlaces: 1); + nextPutAll: 'x the prior average of '; + nextPutAll: (average asFloat printShowingDecimalPlaces: 1); + nextPutAll: ' ms' ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPMoveClassCommand.class.st b/src/MCP/MCPMoveClassCommand.class.st index 7d10705..4ffc060 100644 --- a/src/MCP/MCPMoveClassCommand.class.st +++ b/src/MCP/MCPMoveClassCommand.class.st @@ -72,14 +72,14 @@ MCPMoveClassCommand >> performMove [ self tag ifNil: [ - (RBMoveClassTransformation - move: self className - toPackage: self packageName) execute ] + (RBMoveClassTransformation + move: self className + toPackage: self packageName) execute ] ifNotNil: [ - (RBMoveClassTransformation - move: self className - toPackage: self packageName - inTag: self tag) execute ] + (RBMoveClassTransformation + move: self className + toPackage: self packageName + inTag: self tag) execute ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPMoveSlotCommand.class.st b/src/MCP/MCPMoveSlotCommand.class.st index c24caea..525d133 100644 --- a/src/MCP/MCPMoveSlotCommand.class.st +++ b/src/MCP/MCPMoveSlotCommand.class.st @@ -96,10 +96,10 @@ MCPMoveSlotCommand >> refactoringForBehavior: aBehavior [ ^ (self direction = 'pullUpSlot' ifTrue: [ RePullUpInstanceVariableRefactoring ] ifFalse: [ - self direction = 'pushDownSlot' - ifTrue: [ RBPushDownInstanceVariableRefactoring ] - ifFalse: [ - Error signal: 'direction must be pullUpSlot or pushDownSlot.' ] ]) + self direction = 'pushDownSlot' + ifTrue: [ RBPushDownInstanceVariableRefactoring ] + ifFalse: [ + Error signal: 'direction must be pullUpSlot or pushDownSlot.' ] ]) variable: self slotName class: aBehavior ] diff --git a/src/MCP/MCPPackageScopeQuery.class.st b/src/MCP/MCPPackageScopeQuery.class.st index 3077c8f..3d5e075 100644 --- a/src/MCP/MCPPackageScopeQuery.class.st +++ b/src/MCP/MCPPackageScopeQuery.class.st @@ -49,13 +49,13 @@ MCPPackageScopeQuery >> packageProjectNamesMap [ | packageProjects | packageProjects := Dictionary new. self projectRegistrations do: [ :eachProject | - | projectName | - projectName := eachProject projectName asString. - (self packagesForProjectRegistration: eachProject) do: [ - :eachPackage | - (packageProjects - at: eachPackage name asString - ifAbsentPut: [ OrderedCollection new ]) add: projectName ] ]. + | projectName | + projectName := eachProject projectName asString. + (self packagesForProjectRegistration: eachProject) do: [ + :eachPackage | + (packageProjects + at: eachPackage name asString + ifAbsentPut: [ OrderedCollection new ]) add: projectName ] ]. packageProjects valuesDo: [ :eachProjectNames | eachProjectNames sort ]. ^ packageProjects @@ -125,9 +125,9 @@ MCPPackageScopeQuery >> projectNames: someProjectNames [ MCPPackageScopeQuery >> projectRegistrations [ ^ MetacelloProjectRegistration registry registrations select: [ :each | - [ each loadedInImage ] - on: Error - do: [ :error | false ] ] + [ each loadedInImage ] + on: Error + do: [ :error | false ] ] ] { #category : 'private - querying' } @@ -153,9 +153,9 @@ MCPPackageScopeQuery >> resolvedProjectsNamed: someProjectNames [ projectsByName := self projectsByName. projects := OrderedCollection new. someProjectNames do: [ :eachName | - projects add: (projectsByName - at: eachName - ifAbsent: [ MCPCommandError signalMissingProjectNamed: eachName ]) ]. + projects add: (projectsByName + at: eachName + ifAbsent: [ MCPCommandError signalMissingProjectNamed: eachName ]) ]. ^ projects asArray ] diff --git a/src/MCP/MCPRemoveClassesCommand.class.st b/src/MCP/MCPRemoveClassesCommand.class.st index c99ecb3..26f5fbd 100644 --- a/src/MCP/MCPRemoveClassesCommand.class.st +++ b/src/MCP/MCPRemoveClassesCommand.class.st @@ -56,9 +56,9 @@ MCPRemoveClassesCommand >> execute [ self performRemovalWithPreparedRefactoring: refactoring. removedPackageNames := OrderedCollection new. removedClasses do: [ :eachResult | - self - removePackageIfNowEmptyNamed: eachResult classInfo packageName - recordingInto: removedPackageNames ]. + self + removePackageIfNowEmptyNamed: eachResult classInfo packageName + recordingInto: removedPackageNames ]. ^ MCPRemoveClassesResult removedClasses: removedClasses removedPackageNames: removedPackageNames @@ -108,10 +108,10 @@ MCPRemoveClassesCommand >> removePackageIfNowEmptyNamed: aPackageName recordingI PackageOrganizer default packageNamed: aPackageName ifPresent: [ :package | - package definedClasses isEmpty ifTrue: [ - PackageOrganizer default removePackage: package. - (removedPackageNamesCollection includes: aPackageName) ifFalse: [ - removedPackageNamesCollection add: aPackageName ] ] ] + package definedClasses isEmpty ifTrue: [ + PackageOrganizer default removePackage: package. + (removedPackageNamesCollection includes: aPackageName) ifFalse: [ + removedPackageNamesCollection add: aPackageName ] ] ] ] { #category : 'private' } @@ -156,11 +156,11 @@ MCPRemoveClassesCommand >> validatePreparedRefactoring: aRefactoring [ warningMessages := OrderedCollection new. self force ifTrue: [ - [ aRefactoring checkPreconditions ] - on: RBRefactoringWarning - do: [ :warning | - warningMessages add: warning messageText. - warning resume: true ] ] + [ aRefactoring checkPreconditions ] + on: RBRefactoringWarning + do: [ :warning | + warningMessages add: warning messageText. + warning resume: true ] ] ifFalse: [ aRefactoring checkPreconditions ]. ^ warningMessages asArray ] diff --git a/src/MCP/MCPRemoveClassesResult.class.st b/src/MCP/MCPRemoveClassesResult.class.st index 1000cd5..1bb6f71 100644 --- a/src/MCP/MCPRemoveClassesResult.class.st +++ b/src/MCP/MCPRemoveClassesResult.class.st @@ -43,9 +43,10 @@ MCPRemoveClassesResult >> asDictionary [ self removedPackageNames ifNotEmpty: [ data at: #removedPackageNames put: self removedPackageNames asArray ]. reparentedSubclassNames := Array streamContents: [ :stream | - self removedClasses do: [ :each | - each reparentedSubclassNames do: [ :subclassName | - stream nextPut: subclassName ] ] ]. + self removedClasses do: [ :each | + each reparentedSubclassNames do: [ + :subclassName | + stream nextPut: subclassName ] ] ]. reparentedSubclassNames ifNotEmpty: [ data at: #reparentedSubclassNames put: reparentedSubclassNames ]. ^ data diff --git a/src/MCP/MCPRemoveMethodsCommand.class.st b/src/MCP/MCPRemoveMethodsCommand.class.st index 5bf2208..cb2baab 100644 --- a/src/MCP/MCPRemoveMethodsCommand.class.st +++ b/src/MCP/MCPRemoveMethodsCommand.class.st @@ -16,19 +16,17 @@ MCPRemoveMethodsCommand >> execute [ selectorSymbols := self request selectors collect: #asSymbol. warningMessage := 'This bypasses sender checks and may leave broken senders.'. behavior := self tool - behaviorNamed: self request className - classSide: self request classSide. + behaviorNamed: self request className + classSide: self request classSide. selectorSymbols do: [ :selector | - behavior - compiledMethodAt: selector - ifAbsent: [ - MCPCommandError - signalMissingMethodInClassName: self request className - classSide: self request classSide - selector: selector asString ] ]. + behavior compiledMethodAt: selector ifAbsent: [ + MCPCommandError + signalMissingMethodInClassName: self request className + classSide: self request classSide + selector: selector asString ] ]. self tool forceRemoveSelectors: selectorSymbols from: behavior. ^ MCPRemoveMethodsResult - fromRequest: self request - removedMethods: #( ) - warningMessages: { warningMessage } + fromRequest: self request + removedMethods: #( ) + warningMessages: { warningMessage } ] diff --git a/src/MCP/MCPRemoveSlotCommand.class.st b/src/MCP/MCPRemoveSlotCommand.class.st index 3641218..3267886 100644 --- a/src/MCP/MCPRemoveSlotCommand.class.st +++ b/src/MCP/MCPRemoveSlotCommand.class.st @@ -64,10 +64,10 @@ MCPRemoveSlotCommand >> removeClassSideSlotFromBehavior: aBehavior [ (self directlyDefinesSlotNamed: self slotName inBehavior: aBehavior) ifFalse: [ - RBApplicabilityChecksFailedError signal: - 'The variable ' , self slotName - , ' is not directly defined in the class ' - , (self normalizedBehaviorNameFor: aBehavior) ]. + RBApplicabilityChecksFailedError signal: + 'The variable ' , self slotName + , ' is not directly defined in the class ' + , (self normalizedBehaviorNameFor: aBehavior) ]. self signalReferenceWarningIfNeededForBehavior: aBehavior. aBehavior removeInstVarNamed: self slotName ] @@ -79,6 +79,6 @@ MCPRemoveSlotCommand >> signalReferenceWarningIfNeededForBehavior: aBehavior [ hasReferences := aBehavior withAllSubclasses anySatisfy: [ :each | (each whichMethodsAccess: self slotName) isNotEmpty ]. hasReferences ifTrue: [ - RBBreakingChangeChecksFailedWarning signal: - ' Variable ' , self slotName , ' is still referenced' ] + RBBreakingChangeChecksFailedWarning signal: + ' Variable ' , self slotName , ' is still referenced' ] ] diff --git a/src/MCP/MCPRenameClassCommand.class.st b/src/MCP/MCPRenameClassCommand.class.st index 68281ed..207bbd0 100644 --- a/src/MCP/MCPRenameClassCommand.class.st +++ b/src/MCP/MCPRenameClassCommand.class.st @@ -80,8 +80,8 @@ MCPRenameClassCommand >> refactoring [ rename: self className to: self newClassName ] ifNotNil: [ - ReRenameClassRefactoring - model: self model - rename: self className - to: self newClassName ] + ReRenameClassRefactoring + model: self model + rename: self className + to: self newClassName ] ] diff --git a/src/MCP/MCPRenameSlotCommand.class.st b/src/MCP/MCPRenameSlotCommand.class.st index 834bc3a..9be9b56 100644 --- a/src/MCP/MCPRenameSlotCommand.class.st +++ b/src/MCP/MCPRenameSlotCommand.class.st @@ -58,9 +58,9 @@ MCPRenameSlotCommand >> classSideSlotValuesForBehavior: aBehavior [ ^ #( ) ]. values := OrderedCollection new. aBehavior withAllSubclasses do: [ :eachBehavior | - eachBehavior allInstances do: [ :eachObject | - values add: - eachObject -> (eachObject instVarNamed: self slotName asString) ] ]. + eachBehavior allInstances do: [ :eachObject | + values add: + eachObject -> (eachObject instVarNamed: self slotName asString) ] ]. ^ values asArray ] @@ -71,12 +71,13 @@ MCPRenameSlotCommand >> execute [ currentClass := self currentClass. updatedClass := self classSide ifTrue: [ - self renameClassSideSlotInBehavior: - currentClass classSide. - Smalltalk globals at: self className asSymbol ] + self renameClassSideSlotInBehavior: + currentClass classSide. + Smalltalk globals at: self className asSymbol ] ifFalse: [ - self renameInstanceSideSlotInBehavior: currentClass. - Smalltalk globals at: self className asSymbol ]. + self renameInstanceSideSlotInBehavior: + currentClass. + Smalltalk globals at: self className asSymbol ]. ^ MCPRenameSlotResult classInfo: (MCPClassInfo fromClass: updatedClass) oldSlotName: self slotName @@ -120,9 +121,9 @@ MCPRenameSlotCommand >> instanceSideSlotValuesForBehavior: aBehavior [ ^ #( ) ]. values := OrderedCollection new. aBehavior withAllSubclasses do: [ :eachBehavior | - eachBehavior allInstances do: [ :eachObject | - values add: - eachObject -> (eachObject instVarNamed: self slotName asString) ] ]. + eachBehavior allInstances do: [ :eachObject | + values add: + eachObject -> (eachObject instVarNamed: self slotName asString) ] ]. ^ values asArray ] @@ -269,11 +270,11 @@ MCPRenameSlotCommand >> rewriteClassSideReferencesForSelector: aSelector inBehav MCPRenameSlotCommand >> rewriteClassSideReferencesInBehavior: aBehavior [ aBehavior withAllSubclasses do: [ :eachBehavior | - (self classSideReferenceSelectorsInBehavior: eachBehavior) do: [ - :eachSelector | - self - rewriteClassSideReferencesForSelector: eachSelector - inBehavior: eachBehavior ] ] + (self classSideReferenceSelectorsInBehavior: eachBehavior) do: [ + :eachSelector | + self + rewriteClassSideReferencesForSelector: eachSelector + inBehavior: eachBehavior ] ] ] { #category : 'private' } @@ -302,11 +303,11 @@ MCPRenameSlotCommand >> rewriteInstanceSideReferencesForSelector: aSelector inBe MCPRenameSlotCommand >> rewriteInstanceSideReferencesInBehavior: aBehavior [ aBehavior withAllSubclasses do: [ :eachBehavior | - (self instanceSideReferenceSelectorsInBehavior: eachBehavior) do: [ - :eachSelector | - self - rewriteInstanceSideReferencesForSelector: eachSelector - inBehavior: eachBehavior ] ] + (self instanceSideReferenceSelectorsInBehavior: eachBehavior) do: [ + :eachSelector | + self + rewriteInstanceSideReferencesForSelector: eachSelector + inBehavior: eachBehavior ] ] ] { #category : 'private' } @@ -327,34 +328,34 @@ MCPRenameSlotCommand >> slotNamed: aSlotName isDefinedIn: aBehavior [ MCPRenameSlotCommand >> validateClassSideSlotRenameInBehavior: aBehavior [ (self slotNamed: self slotName isDefinedIn: aBehavior) ifFalse: [ - RBApplicabilityChecksFailedError signal: - 'The variable ' , self slotName - , ' is not directly defined in the class ' - , (self normalizedBehaviorNameFor: aBehavior) ]. + RBApplicabilityChecksFailedError signal: + 'The variable ' , self slotName + , ' is not directly defined in the class ' + , (self normalizedBehaviorNameFor: aBehavior) ]. (self hierarchyDefinesSlotNamed: self newSlotName inBehavior: aBehavior) ifTrue: [ - RBApplicabilityChecksFailedError signal: - self newSlotName , ' is already defined in the class ' - , (self normalizedBehaviorNameFor: aBehavior) - , ' or its hierarchy.' ] + RBApplicabilityChecksFailedError signal: + self newSlotName , ' is already defined in the class ' + , (self normalizedBehaviorNameFor: aBehavior) + , ' or its hierarchy.' ] ] { #category : 'private' } MCPRenameSlotCommand >> validateInstanceSideSlotRenameInBehavior: aBehavior [ (self slotNamed: self slotName isDefinedIn: aBehavior) ifFalse: [ - RBApplicabilityChecksFailedError signal: - 'The variable ' , self slotName - , ' is not directly defined in the class ' - , (self normalizedBehaviorNameFor: aBehavior) ]. + RBApplicabilityChecksFailedError signal: + 'The variable ' , self slotName + , ' is not directly defined in the class ' + , (self normalizedBehaviorNameFor: aBehavior) ]. (self hierarchyDefinesSlotNamed: self newSlotName inBehavior: aBehavior) ifTrue: [ - RBApplicabilityChecksFailedError signal: - self newSlotName , ' is already defined in the class ' - , (self normalizedBehaviorNameFor: aBehavior) - , ' or its hierarchy.' ] + RBApplicabilityChecksFailedError signal: + self newSlotName , ' is already defined in the class ' + , (self normalizedBehaviorNameFor: aBehavior) + , ' or its hierarchy.' ] ] { #category : 'private' } @@ -364,8 +365,8 @@ MCPRenameSlotCommand >> variableReferenceRewriterForSelector: aSelector [ rename: self slotName to: self newSlotName handler: [ - RBRefactoringError signal: self newSlotName - , - ' is already defined as a method or block temporary variable while rewriting ' - , aSelector asString ] + RBRefactoringError signal: self newSlotName + , + ' is already defined as a method or block temporary variable while rewriting ' + , aSelector asString ] ] diff --git a/src/MCP/MCPReparentClassCommand.class.st b/src/MCP/MCPReparentClassCommand.class.st index 98c5865..be36008 100644 --- a/src/MCP/MCPReparentClassCommand.class.st +++ b/src/MCP/MCPReparentClassCommand.class.st @@ -45,9 +45,9 @@ MCPReparentClassCommand >> execute [ ifNotNil: [ :aSuperclass | aSuperclass name asString ]. currentSuperclassName = self superclassName ifTrue: [ - ^ MCPReparentClassResult - classInfo: (MCPClassInfo fromClass: currentClass) - oldSuperclassName: currentSuperclassName ]. + ^ MCPReparentClassResult + classInfo: (MCPClassInfo fromClass: currentClass) + oldSuperclassName: currentSuperclassName ]. superclass := self newSuperclass. (self builderForReparenting: currentClass toSuperclass: superclass) install. @@ -61,9 +61,9 @@ MCPReparentClassCommand >> execute [ MCPReparentClassCommand >> newSuperclass [ ^ Smalltalk globals at: self superclassName asSymbol ifAbsent: [ - MCPCommandError - signalMissingSuperclassNamed: self superclassName - forClassNamed: self className ] + MCPCommandError + signalMissingSuperclassNamed: self superclassName + forClassNamed: self className ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPReplaceClassDefinitionCommand.class.st b/src/MCP/MCPReplaceClassDefinitionCommand.class.st index 8eb4e48..b7cfb95 100644 --- a/src/MCP/MCPReplaceClassDefinitionCommand.class.st +++ b/src/MCP/MCPReplaceClassDefinitionCommand.class.st @@ -84,9 +84,9 @@ MCPReplaceClassDefinitionCommand >> replaceClassSlots: aBoolean [ MCPReplaceClassDefinitionCommand >> replaceDefinitionOn: aClass [ ^ ShiftClassInstaller update: aClass to: [ :builder | - self replaceSlots ifTrue: [ builder slots: self slots ]. - self replaceClassSlots ifTrue: [ - builder classSlots: self classSlots ] ] + self replaceSlots ifTrue: [ builder slots: self slots ]. + self replaceClassSlots ifTrue: [ + builder classSlots: self classSlots ] ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPReplaceClassLayoutCommand.class.st b/src/MCP/MCPReplaceClassLayoutCommand.class.st index 5180eb3..d47f951 100644 --- a/src/MCP/MCPReplaceClassLayoutCommand.class.st +++ b/src/MCP/MCPReplaceClassLayoutCommand.class.st @@ -55,10 +55,8 @@ MCPReplaceClassLayoutCommand >> layoutClassNameFromClass: aClass [ { #category : 'private' } MCPReplaceClassLayoutCommand >> replaceLayoutOn: aClass [ - ^ ShiftClassInstaller - update: aClass - to: [ :builder | - builder layout: (self resolvedLayoutClassNamed: self layout) ] + ^ ShiftClassInstaller update: aClass to: [ :builder | + builder layout: (self resolvedLayoutClassNamed: self layout) ] ] { #category : 'private' } diff --git a/src/MCP/MCPReplaceClassSideTraitsCommand.class.st b/src/MCP/MCPReplaceClassSideTraitsCommand.class.st index 0ad4476..546dd3c 100644 --- a/src/MCP/MCPReplaceClassSideTraitsCommand.class.st +++ b/src/MCP/MCPReplaceClassSideTraitsCommand.class.st @@ -76,23 +76,23 @@ MCPReplaceClassSideTraitsCommand >> resolvedClassTraitNamed: aClassTraitName [ behavior := Smalltalk globals at: classTraitName asSymbol ifAbsent: [ - MCPCommandError - signalErrorCode: #ClassTraitNotFound - message: - 'Class trait ' , originalName , ' does not exist.' - details: { - (#className -> self className). - (#classTraitName -> originalName). - (#classTraits -> self classTraitNames) } - asDictionary ]. + MCPCommandError + signalErrorCode: #ClassTraitNotFound + message: + 'Class trait ' , originalName , ' does not exist.' + details: { + (#className -> self className). + (#classTraitName -> originalName). + (#classTraits -> self classTraitNames) } + asDictionary ]. behavior isTrait ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidClassTrait - message: originalName , ' is not a class trait.' - details: { - (#className -> self className). - (#classTraitName -> originalName). - (#classTraits -> self classTraitNames) } asDictionary ]. + MCPCommandError + signalErrorCode: #InvalidClassTrait + message: originalName , ' is not a class trait.' + details: { + (#className -> self className). + (#classTraitName -> originalName). + (#classTraits -> self classTraitNames) } asDictionary ]. ^ behavior classTrait ] diff --git a/src/MCP/MCPReplaceClassTraitsCommand.class.st b/src/MCP/MCPReplaceClassTraitsCommand.class.st index eee01ec..8f18507 100644 --- a/src/MCP/MCPReplaceClassTraitsCommand.class.st +++ b/src/MCP/MCPReplaceClassTraitsCommand.class.st @@ -40,25 +40,25 @@ MCPReplaceClassTraitsCommand >> resolvedTraitNamed: aTraitName [ | behavior traitName | traitName := aTraitName. (traitName endsWith: ' classTrait') ifTrue: [ - traitName := traitName - copyFrom: 1 - to: traitName size - ' classTrait' size ]. + traitName := traitName + copyFrom: 1 + to: traitName size - ' classTrait' size ]. behavior := Smalltalk globals at: traitName asSymbol ifAbsent: [ - MCPCommandError - signalErrorCode: #TraitNotFound - message: 'Trait ' , traitName , ' does not exist.' - details: { - (#className -> self className). - (#traitName -> traitName). - (#traits -> self traitNames) } asDictionary ]. + MCPCommandError + signalErrorCode: #TraitNotFound + message: 'Trait ' , traitName , ' does not exist.' + details: { + (#className -> self className). + (#traitName -> traitName). + (#traits -> self traitNames) } asDictionary ]. behavior isTrait ifFalse: [ - MCPCommandError - signalErrorCode: #InvalidTrait - message: traitName , ' is not a trait.' - details: { - (#className -> self className). - (#traitName -> traitName). - (#traits -> self traitNames) } asDictionary ]. + MCPCommandError + signalErrorCode: #InvalidTrait + message: traitName , ' is not a trait.' + details: { + (#className -> self className). + (#traitName -> traitName). + (#traits -> self traitNames) } asDictionary ]. ^ behavior ] diff --git a/src/MCP/MCPRepositoryReferenceSpec.class.st b/src/MCP/MCPRepositoryReferenceSpec.class.st index e34e3e8..5798b68 100644 --- a/src/MCP/MCPRepositoryReferenceSpec.class.st +++ b/src/MCP/MCPRepositoryReferenceSpec.class.st @@ -78,8 +78,8 @@ MCPRepositoryReferenceSpec >> matchesRepository: aRepository [ (self repositoryNameFor: aRepository) = self name ifFalse: [ ^ false ] ]. self hasLocation ifTrue: [ - (self repositoryLocationFor: aRepository) = self location ifFalse: [ - ^ false ] ]. + (self repositoryLocationFor: aRepository) = self location ifFalse: [ + ^ false ] ]. ^ true ] diff --git a/src/MCP/MCPRepositoryRequest.class.st b/src/MCP/MCPRepositoryRequest.class.st index 4474ee3..0e12404 100644 --- a/src/MCP/MCPRepositoryRequest.class.st +++ b/src/MCP/MCPRepositoryRequest.class.st @@ -21,7 +21,8 @@ MCPRepositoryRequest class >> isAbstract [ { #category : 'initialization' } MCPRepositoryRequest >> initializeFromRequest: request [ - repositoryReference := MCPRepositoryReferenceSpec fromRequest: request + repositoryReference := MCPRepositoryReferenceSpec fromRequest: + request ] { #category : 'accessing' } diff --git a/src/MCP/MCPRepositoryResult.class.st b/src/MCP/MCPRepositoryResult.class.st index 10f5f72..d6454ee 100644 --- a/src/MCP/MCPRepositoryResult.class.st +++ b/src/MCP/MCPRepositoryResult.class.st @@ -20,8 +20,7 @@ MCPRepositoryResult >> branchHeadDictionary [ | data | data := Dictionary new. - self branchName ifNotEmpty: [ :name | - data at: #branchName put: name ]. + self branchName ifNotEmpty: [ :name | data at: #branchName put: name ]. self headDescription ifNotEmpty: [ :description | data at: #headDescription put: description ]. ^ data diff --git a/src/MCP/MCPRepositoryUpdateRequest.class.st b/src/MCP/MCPRepositoryUpdateRequest.class.st index 18ec3b2..b35ec83 100644 --- a/src/MCP/MCPRepositoryUpdateRequest.class.st +++ b/src/MCP/MCPRepositoryUpdateRequest.class.st @@ -64,11 +64,13 @@ MCPRepositoryUpdateRequest >> initializeFromRequest: request [ super initializeFromRequest: request. suppliedProperties := self updatePropertyNames select: [ :each | - request hasArgumentNamed: each ]. + request hasArgumentNamed: each ]. subdirectory := request stringArgumentNamed: 'subdirectory'. packageNames := request stringCollectionArgumentNamed: 'packageNames'. - addPackageNames := request stringCollectionArgumentNamed: 'addPackageNames'. - removePackageNames := request stringCollectionArgumentNamed: 'removePackageNames' + addPackageNames := request stringCollectionArgumentNamed: + 'addPackageNames'. + removePackageNames := request stringCollectionArgumentNamed: + 'removePackageNames' ] { #category : 'accessing' } @@ -101,9 +103,9 @@ MCPRepositoryUpdateRequest >> requestedContext [ | context | context := self repositoryReference requestedContext copy. self suppliedProperties do: [ :propertyName | - context - at: propertyName asSymbol - put: (self contextValueForPropertyNamed: propertyName) ]. + context + at: propertyName asSymbol + put: (self contextValueForPropertyNamed: propertyName) ]. context at: #updateActions put: self requestedRepositoryUpdateActions. ^ context ] diff --git a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st index e9cbab1..9596b7b 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityCommand.class.st @@ -161,20 +161,20 @@ MCPRepositoryVerifyIdentityCommand >> repositoryForVerifyIdentity [ ^ [ self request repository ] on: MCPCommandError do: [ :error | - (self shouldRetryByNameOnlyAfter: error) - ifTrue: [ - (MCPRepositoryReferenceSpec - name: self request repositoryReference name - location: nil) repository ] - ifFalse: [ error signal ] ] + (self shouldRetryByNameOnlyAfter: error) + ifTrue: [ + (MCPRepositoryReferenceSpec + name: self request repositoryReference name + location: nil) repository ] + ifFalse: [ error signal ] ] ] { #category : 'private - resolving' } MCPRepositoryVerifyIdentityCommand >> shouldRetryByNameOnlyAfter: anError [ ^ anError errorCode = #RepositoryNotFound and: [ - self request repositoryReference hasName and: [ - self request repositoryReference hasLocation ] ] + self request repositoryReference hasName and: [ + self request repositoryReference hasLocation ] ] ] { #category : 'private - validation' } @@ -183,8 +183,8 @@ MCPRepositoryVerifyIdentityCommand >> signalIdentityMismatchFor: repositoryInfo MCPCommandError signalErrorCode: #RepositoryIdentityMismatch message: - 'Repository identity verification failed for ' , repositoryInfo name - , '.' + 'Repository identity verification failed for ' + , repositoryInfo name , '.' details: (self request requestedContext copy at: #repository put: repositoryInfo asDictionary; at: #mismatches put: mismatches; diff --git a/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st b/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st index a3f7fa3..29eb3b5 100644 --- a/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st +++ b/src/MCP/MCPRepositoryVerifyIdentityRequest.class.st @@ -35,11 +35,11 @@ MCPRepositoryVerifyIdentityRequest >> commandForTool: aTool [ MCPRepositoryVerifyIdentityRequest >> hasExpectedIdentityFields [ ^ self repositoryReference hasLocation or: [ - self branchName isNotEmpty or: [ - self hasExpectedSubdirectory or: [ - self hasExpectedPackageNames or: [ - self hasExpectedModifiedPackageNames or: [ - self hasExpectedIsModified ] ] ] ] ] + self branchName isNotEmpty or: [ + self hasExpectedSubdirectory or: [ + self hasExpectedPackageNames or: [ + self hasExpectedModifiedPackageNames or: [ + self hasExpectedIsModified ] ] ] ] ] ] { #category : 'testing' } @@ -72,19 +72,24 @@ MCPRepositoryVerifyIdentityRequest >> initializeFromRequest: request [ super initializeFromRequest: request. hasSubdirectory := request hasArgumentNamed: 'subdirectory'. hasPackageNames := request hasArgumentNamed: 'packageNames'. - hasModifiedPackageNames := request hasArgumentNamed: 'modifiedPackageNames'. + hasModifiedPackageNames := request hasArgumentNamed: + 'modifiedPackageNames'. hasIsModified := request hasArgumentNamed: 'isModified'. hasSubdirectory ifTrue: [ - subdirectory := self - stringArgumentNamed: 'subdirectory' - preservingEmptyFrom: request ]. + subdirectory := self + stringArgumentNamed: 'subdirectory' + preservingEmptyFrom: request ]. hasPackageNames ifTrue: [ - packageNames := request uniqueStringCollectionArgumentNamed: 'packageNames' ]. + packageNames := request uniqueStringCollectionArgumentNamed: + 'packageNames' ]. hasModifiedPackageNames ifTrue: [ - modifiedPackageNames := request uniqueStringCollectionArgumentNamed: - 'modifiedPackageNames' ]. + modifiedPackageNames := request + uniqueStringCollectionArgumentNamed: + 'modifiedPackageNames' ]. hasIsModified ifTrue: [ - isModified := request booleanArgumentNamed: 'isModified' default: false ] + isModified := request + booleanArgumentNamed: 'isModified' + default: false ] ] { #category : 'accessing' } diff --git a/src/MCP/MCPRewriteMethodsCommand.class.st b/src/MCP/MCPRewriteMethodsCommand.class.st index dfc2e88..9a06907 100644 --- a/src/MCP/MCPRewriteMethodsCommand.class.st +++ b/src/MCP/MCPRewriteMethodsCommand.class.st @@ -25,9 +25,9 @@ MCPRewriteMethodsCommand >> changeInfosForChanges: changes [ ^ changes collect: [ :each | - MCPMethodRewriteChangeInfo - fromChange: each - includeSources: self request includeSources ] + MCPMethodRewriteChangeInfo + fromChange: each + includeSources: self request includeSources ] as: Array ] @@ -164,8 +164,8 @@ MCPRewriteMethodsCommand >> stableHashForSource: aString [ | hash | hash := 5381. aString do: [ :character | - character isSeparator ifFalse: [ - hash := (hash bitXor: character asciiValue) hashMultiply ] ]. + character isSeparator ifFalse: [ + hash := (hash bitXor: character asciiValue) hashMultiply ] ]. ^ hash abs ] @@ -193,8 +193,8 @@ MCPRewriteMethodsCommand >> stableHashForValue: anObject [ MCPRewriteMethodsCommand >> successSummaryForReport: report [ report apply ifTrue: [ - ^ 'Applied ' , report appliedCount asString - , ' method rewrite change(s).' ]. + ^ 'Applied ' , report appliedCount asString + , ' method rewrite change(s).' ]. ^ 'Previewed ' , report changeCount asString , ' method rewrite change(s).' ] diff --git a/src/MCP/MCPRunTestsCommand.class.st b/src/MCP/MCPRunTestsCommand.class.st index 596a043..0be7eac 100644 --- a/src/MCP/MCPRunTestsCommand.class.st +++ b/src/MCP/MCPRunTestsCommand.class.st @@ -37,10 +37,10 @@ MCPRunTestsCommand >> coverableMethodsForCoverageRequest: aCoverageRequest [ MCPRunTestsCommand >> coverageCollectorClass [ ^ Smalltalk globals at: #CoverageCollector ifAbsent: [ - MCPCommandError - signalErrorCode: #CoverageUnavailable - message: 'CoverageCollector is not available in this image.' - details: Dictionary new ] + MCPCommandError + signalErrorCode: #CoverageUnavailable + message: 'CoverageCollector is not available in this image.' + details: Dictionary new ] ] { #category : 'private - coverage' } @@ -120,35 +120,34 @@ MCPRunTestsCommand >> resultForValidatedRequest: validatedRequest deadline: dead | includeResult result resultInfo selectedTestCount testCases timedOutIndex unrunTestRequests | testCases := self - uniqueTestCasesForValidatedRequest: validatedRequest - seenTestCaseNames: seenTestCaseNames. + uniqueTestCasesForValidatedRequest: validatedRequest + seenTestCaseNames: seenTestCaseNames. selectedTestCount := testCases size. result := MCPStructuredTestResult new. timedOutIndex := nil. testCases doWithIndex: [ :testCase :index | - timedOutIndex ifNil: [ - (self runTestCase: testCase into: result deadline: deadline) ifTrue: [ - timedOutIndex := index ] ] ]. + timedOutIndex ifNil: [ + (self runTestCase: testCase into: result deadline: deadline) + ifTrue: [ timedOutIndex := index ] ] ]. includeResult := self - shouldIncludeTestResult: result - selectedTestCount: selectedTestCount - timedOutIndex: timedOutIndex. + shouldIncludeTestResult: result + selectedTestCount: selectedTestCount + timedOutIndex: timedOutIndex. resultInfo := includeResult ifTrue: [ - self - testRunInfoForTestResult: result - validatedRequest: validatedRequest - selectedTestCount: selectedTestCount ]. - unrunTestRequests := timedOutIndex - ifNil: [ #( ) ] - ifNotNil: [ - self - unrunRequestsForValidatedRequest: validatedRequest - testCases: testCases - startingAt: timedOutIndex ]. + self + testRunInfoForTestResult: result + validatedRequest: validatedRequest + selectedTestCount: selectedTestCount ]. + unrunTestRequests := timedOutIndex ifNil: [ #( ) ] ifNotNil: [ + self + unrunRequestsForValidatedRequest: + validatedRequest + testCases: testCases + startingAt: timedOutIndex ]. ^ MCPTestRunResult - resultInfo: resultInfo - timedOut: timedOutIndex notNil - unrunTestRequests: unrunTestRequests + resultInfo: resultInfo + timedOut: timedOutIndex notNil + unrunTestRequests: unrunTestRequests ] { #category : 'private - coverage' } @@ -159,16 +158,16 @@ MCPRunTestsCommand >> runCoverageForValidatedRequests: validatedRequests deadlin methods := self coverableMethodsForCoverageRequest: coverageRequest. collector := self coverageCollectorForMethods: methods. [ - collector installOn: [ - collector reset. - runResult := self - runValidatedRequests: validatedRequests - deadline: deadline. - "Collect before resetting annotations so partial node coverage remains observable." - collector remapMethods. - coverageResult := collector basicCollectResult. - partialMethods := self partiallyCoveredMethodsFromCoverageResult: - coverageResult ] ] ensure: [ collector reset ]. + collector installOn: [ + collector reset. + runResult := self + runValidatedRequests: validatedRequests + deadline: deadline. + "Collect before resetting annotations so partial node coverage remains observable." + collector remapMethods. + coverageResult := collector basicCollectResult. + partialMethods := self partiallyCoveredMethodsFromCoverageResult: + coverageResult ] ] ensure: [ collector reset ]. runResult coverage: (MCPTestCoverageResult coverageResult: coverageResult includeCoveredMethods: coverageRequest includeCoveredMethods @@ -184,8 +183,8 @@ MCPRunTestsCommand >> runTestCase: aTestCase into: aResult deadline: deadline [ remaining := self millisecondsRemainingUntil: deadline. remaining <= 0 ifTrue: [ ^ true ]. ^ [ - aTestCase run: aResult. - false ] valueWithinMilliseconds: remaining onTimeout: [ true ] + aTestCase run: aResult. + false ] valueWithinMilliseconds: remaining onTimeout: [ true ] ] { #category : 'private' } @@ -262,9 +261,10 @@ MCPRunTestsCommand >> testCaseDeduplicationKeyFor: aTestCase [ MCPRunTestsCommand >> testCasesForPackageRequest: validatedRequest [ ^ Array streamContents: [ :stream | - (self testClassesInPackageNamed: validatedRequest packageName) do: [ :testClass | - (self testCasesFromSuite: testClass suite) do: [ :testCase | - stream nextPut: testCase ] ] ] + (self testClassesInPackageNamed: validatedRequest packageName) + do: [ :testClass | + (self testCasesFromSuite: testClass suite) do: [ :testCase | + stream nextPut: testCase ] ] ] ] { #category : 'private' } @@ -276,8 +276,8 @@ MCPRunTestsCommand >> testCasesForValidatedRequest: validatedRequest [ suite := validatedRequest testClass suite. testCases := self testCasesFromSuite: suite. validatedRequest testMethodName ifNotNil: [ :testMethodName | - testMethodSelector := testMethodName asSymbol. - ^ testCases select: [ :each | each selector = testMethodSelector ] ]. + testMethodSelector := testMethodName asSymbol. + ^ testCases select: [ :each | each selector = testMethodSelector ] ]. ^ testCases ] @@ -294,10 +294,13 @@ MCPRunTestsCommand >> testCasesFromSuite: aSuite [ MCPRunTestsCommand >> testClassesInPackageNamed: packageName [ | package | - package := MCPImageLookup packageNamed: packageName scopeName: 'packages'. + package := MCPImageLookup + packageNamed: packageName + scopeName: 'packages'. ^ (package definedClasses select: [ :each | - each isTestCase and: [ each isAbstract not ] ]) asArray - sort: [ :left :right | left name <= right name ] + each isTestCase and: [ each isAbstract not ] ]) asArray sort: [ + :left + :right | left name <= right name ] ] { #category : 'private' } @@ -316,15 +319,15 @@ MCPRunTestsCommand >> testRequestsByClassForTestCases: testCases startingAt: sta seenClassNames := Set new. firstClass := (testCases at: startIndex) class. startIndex to: testCases size do: [ :index | - | className testCase | - testCase := testCases at: index. - className := testCase class name asString. - testCase class = firstClass - ifTrue: [ requests add: (self testRequestForTestCase: testCase) ] - ifFalse: [ - (seenClassNames includes: className) ifFalse: [ - seenClassNames add: className. - requests add: (MCPTestRunRequest className: className) ] ] ]. + | className testCase | + testCase := testCases at: index. + className := testCase class name asString. + testCase class = firstClass + ifTrue: [ requests add: (self testRequestForTestCase: testCase) ] + ifFalse: [ + (seenClassNames includes: className) ifFalse: [ + seenClassNames add: className. + requests add: (MCPTestRunRequest className: className) ] ] ]. ^ requests asArray ] @@ -360,8 +363,9 @@ MCPRunTestsCommand >> testRunInfoForTestResult: aResult validatedRequest: valida MCPRunTestsCommand >> uniqueTestCasesForValidatedRequest: validatedRequest seenTestCaseNames: seenTestCaseNames [ ^ self - uniqueTestCasesFrom: (self testCasesForValidatedRequest: validatedRequest) - seenTestCaseNames: seenTestCaseNames + uniqueTestCasesFrom: + (self testCasesForValidatedRequest: validatedRequest) + seenTestCaseNames: seenTestCaseNames ] { #category : 'private' } @@ -370,11 +374,11 @@ MCPRunTestsCommand >> uniqueTestCasesFrom: testCases seenTestCaseNames: seenTest | uniqueTestCases | uniqueTestCases := OrderedCollection new. testCases do: [ :testCase | - | testCaseName | - testCaseName := self testCaseDeduplicationKeyFor: testCase. - (seenTestCaseNames includes: testCaseName) ifFalse: [ - seenTestCaseNames add: testCaseName. - uniqueTestCases add: testCase ] ]. + | testCaseName | + testCaseName := self testCaseDeduplicationKeyFor: testCase. + (seenTestCaseNames includes: testCaseName) ifFalse: [ + seenTestCaseNames add: testCaseName. + uniqueTestCases add: testCase ] ]. ^ uniqueTestCases asArray ] @@ -384,11 +388,11 @@ MCPRunTestsCommand >> unrunRequestsForValidatedRequest: validatedRequest seenTes | testCases uniqueTestCases | testCases := self testCasesForValidatedRequest: validatedRequest. uniqueTestCases := self - uniqueTestCasesFrom: testCases - seenTestCaseNames: seenTestCaseNames. - uniqueTestCases ifEmpty: [ ^ #( ) ]. + uniqueTestCasesFrom: testCases + seenTestCaseNames: seenTestCaseNames. + uniqueTestCases ifEmpty: [ ^ #( ) ]. (validatedRequest hasTestMethod not and: [ - uniqueTestCases size = testCases size ]) ifTrue: [ + uniqueTestCases size = testCases size ]) ifTrue: [ ^ { validatedRequest testRunRequest } ]. ^ self testRequestsForTestCases: uniqueTestCases startingAt: 1 ] @@ -397,9 +401,9 @@ MCPRunTestsCommand >> unrunRequestsForValidatedRequest: validatedRequest seenTes MCPRunTestsCommand >> unrunRequestsForValidatedRequest: validatedRequest testCases: testCases startingAt: startIndex [ validatedRequest isPackageRequest ifTrue: [ - ^ self - testRequestsByClassForTestCases: testCases - startingAt: startIndex ]. + ^ self + testRequestsByClassForTestCases: testCases + startingAt: startIndex ]. ^ self testRequestsForTestCases: testCases startingAt: startIndex ] @@ -409,9 +413,9 @@ MCPRunTestsCommand >> unrunTestsFrom: validatedRequests startingAt: startIndex s | unrun | unrun := OrderedCollection new. startIndex to: validatedRequests size do: [ :index | - unrun addAll: (self - unrunRequestsForValidatedRequest: (validatedRequests at: index) - seenTestCaseNames: seenTestCaseNames) ]. + unrun addAll: (self + unrunRequestsForValidatedRequest: (validatedRequests at: index) + seenTestCaseNames: seenTestCaseNames) ]. ^ unrun asArray ] @@ -419,20 +423,20 @@ MCPRunTestsCommand >> unrunTestsFrom: validatedRequests startingAt: startIndex s MCPRunTestsCommand >> validatedRequestsFrom: testRequests [ ^ testRequests collect: [ :each | - each isPackageRequest - ifTrue: [ - self testClassesInPackageNamed: each packageName. - MCPValidatedTestRunRequest request: each testClass: nil ] - ifFalse: [ - | testClass | - testClass := MCPImageLookup classNamed: each className. - each testMethodName ifNotNil: [ :testMethodName | - testClass - compiledMethodAt: testMethodName asSymbol - ifAbsent: [ - MCPCommandError - signalMissingMethodInClassName: each className - classSide: false - selector: testMethodName ] ]. - MCPValidatedTestRunRequest request: each testClass: testClass ] ] + each isPackageRequest + ifTrue: [ + self testClassesInPackageNamed: each packageName. + MCPValidatedTestRunRequest request: each testClass: nil ] + ifFalse: [ + | testClass | + testClass := MCPImageLookup classNamed: each className. + each testMethodName ifNotNil: [ :testMethodName | + testClass + compiledMethodAt: testMethodName asSymbol + ifAbsent: [ + MCPCommandError + signalMissingMethodInClassName: each className + classSide: false + selector: testMethodName ] ]. + MCPValidatedTestRunRequest request: each testClass: testClass ] ] ] diff --git a/src/MCP/MCPRunTestsRequest.class.st b/src/MCP/MCPRunTestsRequest.class.st index 34c886a..eae5011 100644 --- a/src/MCP/MCPRunTestsRequest.class.st +++ b/src/MCP/MCPRunTestsRequest.class.st @@ -28,7 +28,8 @@ MCPRunTestsRequest class >> addClassNames: classNames to: requests [ MCPRunTestsRequest class >> addMethodReferences: methodReferences to: requests [ methodReferences do: [ :methodReference | - requests add: (MCPTestRunRequest fromMethodReference: methodReference) ] + requests add: + (MCPTestRunRequest fromMethodReference: methodReference) ] ] { #category : 'private - parsing' } @@ -45,17 +46,22 @@ MCPRunTestsRequest class >> fromRequest: aRequest tool: aTool operation: operati (#( 'run' 'coverage' ) includes: operation) ifFalse: [ Error signal: 'operation must be run or coverage.' ]. coverageRequest := operation = 'coverage' ifTrue: [ - MCPTestCoverageRequest - fromValue: (aRequest argumentNamed: 'coverage' ifAbsent: [ nil ]) - usingToolRequest: aRequest - defaultMethodLimit: aTool defaultCoverageMethodLimit ]. + MCPTestCoverageRequest + fromValue: + (aRequest + argumentNamed: 'coverage' + ifAbsent: [ nil ]) + usingToolRequest: aRequest + defaultMethodLimit: + aTool defaultCoverageMethodLimit ]. ^ self new - initializeTestRequests: (self testRequestsFromToolRequest: aRequest) - timeoutMilliseconds: (self - timeoutMillisecondsFromToolRequest: aRequest - defaultSeconds: aTool defaultTimeoutSeconds) - operation: operation - coverageRequest: coverageRequest + initializeTestRequests: + (self testRequestsFromToolRequest: aRequest) + timeoutMilliseconds: (self + timeoutMillisecondsFromToolRequest: aRequest + defaultSeconds: aTool defaultTimeoutSeconds) + operation: operation + coverageRequest: coverageRequest ] { #category : 'private - parsing' } @@ -63,16 +69,16 @@ MCPRunTestsRequest class >> testRequestsFromToolRequest: request [ | classNames methodReferences packageNames requests | packageNames := request - uniqueStringCollectionArgumentNamed: 'packages' - default: #( ). + uniqueStringCollectionArgumentNamed: 'packages' + default: #( ). classNames := request - uniqueStringCollectionArgumentNamed: 'classes' - default: #( ). + uniqueStringCollectionArgumentNamed: 'classes' + default: #( ). methodReferences := request - uniqueStringCollectionArgumentNamed: 'methods' - default: #( ). + uniqueStringCollectionArgumentNamed: 'methods' + default: #( ). (packageNames isEmpty and: [ - classNames isEmpty and: [ methodReferences isEmpty ] ]) ifTrue: [ + classNames isEmpty and: [ methodReferences isEmpty ] ]) ifTrue: [ Error signal: 'Provide at least one package, class, or method.' ]. requests := OrderedCollection new. self addPackageNames: packageNames to: requests. diff --git a/src/MCP/MCPRunTestsResult.class.st b/src/MCP/MCPRunTestsResult.class.st index 6731607..eaf231a 100644 --- a/src/MCP/MCPRunTestsResult.class.st +++ b/src/MCP/MCPRunTestsResult.class.st @@ -42,16 +42,16 @@ MCPRunTestsResult >> asDictionary [ self coverage ifNotNil: [ :coverageResult | data at: #coverage put: coverageResult asDictionary ]. self timedOut ifTrue: [ - data at: #timedOut put: true. - unrunPackages := self unrunPackageNames. - unrunPackages ifNotEmpty: [ - data at: #unrunPackages put: unrunPackages ]. - unrunClasses := self unrunClassNames. - unrunClasses ifNotEmpty: [ - data at: #unrunClasses put: unrunClasses ]. - unrunMethods := self unrunMethodReferences. - unrunMethods ifNotEmpty: [ - data at: #unrunMethods put: unrunMethods ] ]. + data at: #timedOut put: true. + unrunPackages := self unrunPackageNames. + unrunPackages ifNotEmpty: [ + data at: #unrunPackages put: unrunPackages ]. + unrunClasses := self unrunClassNames. + unrunClasses ifNotEmpty: [ + data at: #unrunClasses put: unrunClasses ]. + unrunMethods := self unrunMethodReferences. + unrunMethods ifNotEmpty: [ + data at: #unrunMethods put: unrunMethods ] ]. ^ data ] @@ -64,8 +64,9 @@ MCPRunTestsResult >> compactIssueFor: issue [ issue at: #message ifPresent: [ :message | message isEmpty ifFalse: [ data at: #message put: message ] ]. (issue at: #kind ifAbsent: [ nil ]) = 'error' ifTrue: [ - issue at: #errorClass ifPresent: [ :className | - data at: #errorClass put: className ] ]. + issue + at: #errorClass + ifPresent: [ :className | data at: #errorClass put: className ] ]. issue at: #parameters ifPresent: [ :parameters | parameters ifNotEmpty: [ data at: #parameters put: parameters ] ]. ^ data @@ -87,16 +88,16 @@ MCPRunTestsResult >> coverage: aCoverageResult [ MCPRunTestsResult >> errorDictionaries [ ^ Array streamContents: [ :stream | - (self issuesOfKind: 'error') do: [ :issue | - stream nextPut: (self compactIssueFor: issue) ] ] + (self issuesOfKind: 'error') do: [ :issue | + stream nextPut: (self compactIssueFor: issue) ] ] ] { #category : 'converting' } MCPRunTestsResult >> failureDictionaries [ ^ Array streamContents: [ :stream | - (self issuesOfKind: 'failure') do: [ :issue | - stream nextPut: (self compactIssueFor: issue) ] ] + (self issuesOfKind: 'failure') do: [ :issue | + stream nextPut: (self compactIssueFor: issue) ] ] ] { #category : 'initialization' } @@ -112,18 +113,18 @@ MCPRunTestsResult >> initializeResults: resultCollection timedOut: aBoolean unru MCPRunTestsResult >> issuesOfKind: issueKind [ ^ Array streamContents: [ :stream | - self results do: [ :resultInfo | - resultInfo issues do: [ :issue | - (issue at: #kind ifAbsent: [ nil ]) = issueKind ifTrue: [ - stream nextPut: issue ] ] ] ] + self results do: [ :resultInfo | + resultInfo issues do: [ :issue | + (issue at: #kind ifAbsent: [ nil ]) = issueKind ifTrue: [ + stream nextPut: issue ] ] ] ] ] { #category : 'converting' } MCPRunTestsResult >> passedCount [ ^ self results - inject: 0 - into: [ :sum :each | sum + each passedCount ] + inject: 0 + into: [ :sum :each | sum + each passedCount ] ] { #category : 'converting' } @@ -141,24 +142,22 @@ MCPRunTestsResult >> results [ { #category : 'converting' } MCPRunTestsResult >> runCount [ - ^ self results - inject: 0 - into: [ :sum :each | sum + each runCount ] + ^ self results inject: 0 into: [ :sum :each | sum + each runCount ] ] { #category : 'converting' } MCPRunTestsResult >> skippedTestReferences [ ^ self uniqueStringsFrom: - ((self issuesOfKind: 'skipped') collect: [ :issue | - self testReferenceForIssue: issue ]) + ((self issuesOfKind: 'skipped') collect: [ :issue | + self testReferenceForIssue: issue ]) ] { #category : 'converting' } MCPRunTestsResult >> testReferenceForIssue: issue [ ^ (issue at: #className) asString , '>>#' - , (issue at: #testMethodName) asString + , (issue at: #testMethodName) asString ] { #category : 'accessing' } @@ -173,37 +172,38 @@ MCPRunTestsResult >> uniqueStringsFrom: strings [ | seen | seen := Set new. ^ Array streamContents: [ :stream | - strings do: [ :each | - (seen includes: each) ifFalse: [ - seen add: each. - stream nextPut: each ] ] ] + strings do: [ :each | + (seen includes: each) ifFalse: [ + seen add: each. + stream nextPut: each ] ] ] ] { #category : 'converting' } MCPRunTestsResult >> unrunClassNames [ ^ self uniqueStringsFrom: (Array streamContents: [ :stream | - self unrunTests do: [ :request | - (request isPackageRequest not and: [ request hasTestMethod not ]) ifTrue: [ - stream nextPut: request className ] ] ]) + self unrunTests do: [ :request | + (request isPackageRequest not and: [ + request hasTestMethod not ]) ifTrue: [ + stream nextPut: request className ] ] ]) ] { #category : 'converting' } MCPRunTestsResult >> unrunMethodReferences [ ^ self uniqueStringsFrom: (Array streamContents: [ :stream | - self unrunTests do: [ :request | - request hasTestMethod ifTrue: [ - stream nextPut: request displayName ] ] ]) + self unrunTests do: [ :request | + request hasTestMethod ifTrue: [ + stream nextPut: request displayName ] ] ]) ] { #category : 'converting' } MCPRunTestsResult >> unrunPackageNames [ ^ self uniqueStringsFrom: (Array streamContents: [ :stream | - self unrunTests do: [ :request | - request isPackageRequest ifTrue: [ - stream nextPut: request packageName ] ] ]) + self unrunTests do: [ :request | + request isPackageRequest ifTrue: [ + stream nextPut: request packageName ] ] ]) ] { #category : 'converting' } diff --git a/src/MCP/MCPScopeNameSuggester.class.st b/src/MCP/MCPScopeNameSuggester.class.st index 04af442..5120699 100644 --- a/src/MCP/MCPScopeNameSuggester.class.st +++ b/src/MCP/MCPScopeNameSuggester.class.st @@ -33,9 +33,9 @@ MCPScopeNameSuggester class >> classSuggestionCandidates [ | candidates | candidates := OrderedCollection new. Smalltalk globals allClasses do: [ :eachClass | - candidates add: { - (#name -> eachClass name asString). - (#bucket -> eachClass package name asString) } asDictionary ]. + candidates add: { + (#name -> eachClass name asString). + (#bucket -> eachClass package name asString) } asDictionary ]. ^ candidates asArray ] @@ -62,18 +62,20 @@ MCPScopeNameSuggester class >> editDistanceBetween: leftString and: rightString rightString isEmpty ifTrue: [ ^ leftString size ]. previous := (0 to: rightString size) asArray. 1 to: leftString size do: [ :leftIndex | - current := Array new: rightString size + 1. - current at: 1 put: leftIndex. - 1 to: rightString size do: [ :rightIndex | - | cost delete insert replace | - cost := (leftString at: leftIndex) = (rightString at: rightIndex) - ifTrue: [ 0 ] - ifFalse: [ 1 ]. - delete := (previous at: rightIndex + 1) + 1. - insert := (current at: rightIndex) + 1. - replace := (previous at: rightIndex) + cost. - current at: rightIndex + 1 put: ((delete min: insert) min: replace) ]. - previous := current ]. + current := Array new: rightString size + 1. + current at: 1 put: leftIndex. + 1 to: rightString size do: [ :rightIndex | + | cost delete insert replace | + cost := (leftString at: leftIndex) = (rightString at: rightIndex) + ifTrue: [ 0 ] + ifFalse: [ 1 ]. + delete := (previous at: rightIndex + 1) + 1. + insert := (current at: rightIndex) + 1. + replace := (previous at: rightIndex) + cost. + current + at: rightIndex + 1 + put: ((delete min: insert) min: replace) ]. + previous := current ]. ^ previous last ] @@ -91,19 +93,19 @@ MCPScopeNameSuggester class >> missingClassWarningFor: className scope: scopeNam MCPScopeNameSuggester class >> missingNameWarningForKind: kind name: missingName scope: scopeName suggestions: suggestions [ ^ String streamContents: [ :stream | - stream - nextPutAll: kind; - space; - nextPutAll: missingName asString; - nextPutAll: ' does not exist in '; - nextPutAll: scopeName asString; - nextPutAll: ' scope.'. - suggestions ifNotEmpty: [ - stream nextPutAll: ' Did you mean: '. - suggestions - do: [ :each | stream nextPutAll: each ] - separatedBy: [ stream nextPutAll: ', ' ]. - stream nextPut: $. ] ] + stream + nextPutAll: kind; + space; + nextPutAll: missingName asString; + nextPutAll: ' does not exist in '; + nextPutAll: scopeName asString; + nextPutAll: ' scope.'. + suggestions ifNotEmpty: [ + stream nextPutAll: ' Did you mean: '. + suggestions + do: [ :each | stream nextPutAll: each ] + separatedBy: [ stream nextPutAll: ', ' ]. + stream nextPut: $. ] ] ] { #category : 'warnings' } @@ -120,9 +122,9 @@ MCPScopeNameSuggester class >> missingPackageWarningFor: packageName scope: scop MCPScopeNameSuggester class >> packageSuggestionCandidates [ ^ PackageOrganizer default packages collect: [ :eachPackage | - { - (#name -> eachPackage name asString). - (#bucket -> eachPackage name asString) } asDictionary ] + { + (#name -> eachPackage name asString). + (#bucket -> eachPackage name asString) } asDictionary ] ] { #category : 'suggesting' } @@ -162,36 +164,36 @@ MCPScopeNameSuggester class >> suggestionsFor: requestedName candidates: candida matchesRequested: requestedName ]. filtered isEmpty ifTrue: [ ^ #( ) ]. scored := filtered collect: [ :eachCandidate | - eachCandidate copy - at: #score put: (self - scoreForRequested: requestedName - candidate: (eachCandidate at: #name)); - yourself ]. + eachCandidate copy + at: #score put: (self + scoreForRequested: requestedName + candidate: (eachCandidate at: #name)); + yourself ]. sorted := scored asSortedCollection: [ :left :right | - (left at: #score) = (right at: #score) - ifTrue: [ (left at: #name) <= (right at: #name) ] - ifFalse: [ (left at: #score) < (right at: #score) ] ]. + (left at: #score) = (right at: #score) + ifTrue: [ (left at: #name) <= (right at: #name) ] + ifFalse: [ (left at: #score) < (right at: #score) ] ]. chosen := OrderedCollection new. chosenNames := Set new. bucketCounts := Dictionary new. sorted do: [ :eachCandidate | - chosen size < maxCount ifTrue: [ - | bucket count candidateName | - candidateName := eachCandidate at: #name. - bucket := eachCandidate at: #bucket ifAbsent: [ '' ]. - count := bucketCounts at: bucket ifAbsent: [ 0 ]. - (count < 2 and: [ (chosenNames includes: candidateName) not ]) - ifTrue: [ - chosen add: candidateName. - chosenNames add: candidateName. - bucketCounts at: bucket put: count + 1 ] ] ]. - chosen size < maxCount ifTrue: [ - sorted do: [ :eachCandidate | chosen size < maxCount ifTrue: [ - | candidateName | - candidateName := eachCandidate at: #name. - (chosenNames includes: candidateName) ifFalse: [ - chosen add: candidateName. - chosenNames add: candidateName ] ] ] ]. + | bucket count candidateName | + candidateName := eachCandidate at: #name. + bucket := eachCandidate at: #bucket ifAbsent: [ '' ]. + count := bucketCounts at: bucket ifAbsent: [ 0 ]. + (count < 2 and: [ (chosenNames includes: candidateName) not ]) + ifTrue: [ + chosen add: candidateName. + chosenNames add: candidateName. + bucketCounts at: bucket put: count + 1 ] ] ]. + chosen size < maxCount ifTrue: [ + sorted do: [ :eachCandidate | + chosen size < maxCount ifTrue: [ + | candidateName | + candidateName := eachCandidate at: #name. + (chosenNames includes: candidateName) ifFalse: [ + chosen add: candidateName. + chosenNames add: candidateName ] ] ] ]. ^ chosen asArray ] diff --git a/src/MCP/MCPScopeQuery.class.st b/src/MCP/MCPScopeQuery.class.st index 3777724..e9423d3 100644 --- a/src/MCP/MCPScopeQuery.class.st +++ b/src/MCP/MCPScopeQuery.class.st @@ -23,7 +23,7 @@ Class { { #category : 'accessing' } MCPScopeQuery >> classNames [ - ^ classNames ifNil: [ #( ) ] + ^ classNames ifNil: [ #( ) ] ] { #category : 'accessing' } @@ -35,7 +35,7 @@ MCPScopeQuery >> classNames: aCollection [ { #category : 'accessing' } MCPScopeQuery >> hierarchyClassNames [ - ^ hierarchyClassNames ifNil: [ #( ) ] + ^ hierarchyClassNames ifNil: [ #( ) ] ] { #category : 'accessing' } @@ -47,7 +47,7 @@ MCPScopeQuery >> hierarchyClassNames: aCollection [ { #category : 'accessing' } MCPScopeQuery >> packageNames [ - ^ packageNames ifNil: [ #( ) ] + ^ packageNames ifNil: [ #( ) ] ] { #category : 'accessing' } @@ -59,7 +59,7 @@ MCPScopeQuery >> packageNames: aCollection [ { #category : 'accessing' } MCPScopeQuery >> parentClassNames [ - ^ parentClassNames ifNil: [ #( ) ] + ^ parentClassNames ifNil: [ #( ) ] ] { #category : 'accessing' } @@ -74,15 +74,15 @@ MCPScopeQuery >> recordMissingClassNamed: className inScope: scopeName [ | suggestions | suggestions := MCPScopeNameSuggester classSuggestionsFor: className. self requiresCompleteScope ifTrue: [ - ^ MCPCommandError - signalMissingClassNamed: className - scopeName: scopeName ]. + ^ MCPCommandError + signalMissingClassNamed: className + scopeName: scopeName ]. warnings ifNil: [ self resetWarnings ]. warnings add: (MCPScopeNameSuggester - missingNameWarningForKind: 'Class' - name: className - scope: scopeName - suggestions: suggestions). + missingNameWarningForKind: 'Class' + name: className + scope: scopeName + suggestions: suggestions). ^ nil ] @@ -90,17 +90,18 @@ MCPScopeQuery >> recordMissingClassNamed: className inScope: scopeName [ MCPScopeQuery >> recordMissingPackageNamed: packageName inScope: scopeName [ | suggestions | - suggestions := MCPScopeNameSuggester packageSuggestionsFor: packageName. + suggestions := MCPScopeNameSuggester packageSuggestionsFor: + packageName. self requiresCompleteScope ifTrue: [ - ^ MCPCommandError - signalMissingPackageNamed: packageName - scopeName: scopeName ]. + ^ MCPCommandError + signalMissingPackageNamed: packageName + scopeName: scopeName ]. warnings ifNil: [ self resetWarnings ]. warnings add: (MCPScopeNameSuggester - missingNameWarningForKind: 'Package' - name: packageName - scope: scopeName - suggestions: suggestions). + missingNameWarningForKind: 'Package' + name: packageName + scope: scopeName + suggestions: suggestions). ^ nil ] @@ -131,7 +132,7 @@ MCPScopeQuery >> resetWarnings [ { #category : 'accessing' } MCPScopeQuery >> subclassClassNames [ - ^ subclassClassNames ifNil: [ #( ) ] + ^ subclassClassNames ifNil: [ #( ) ] ] { #category : 'accessing' } @@ -144,14 +145,14 @@ MCPScopeQuery >> subclassClassNames: aCollection [ MCPScopeQuery >> usesImplicitImageScope [ ^ self packageNames isEmpty and: [ - self classNames isEmpty and: [ - self hierarchyClassNames isEmpty and: [ - self subclassClassNames isEmpty and: [ - self parentClassNames isEmpty ] ] ] ] + self classNames isEmpty and: [ + self hierarchyClassNames isEmpty and: [ + self subclassClassNames isEmpty and: [ + self parentClassNames isEmpty ] ] ] ] ] { #category : 'accessing' } MCPScopeQuery >> warnings [ - ^ warnings ifNil: [ #( ) ] + ^ warnings ifNil: [ #( ) ] ] diff --git a/src/MCP/MCPStructureInitialize.class.st b/src/MCP/MCPStructureInitialize.class.st index ad70305..73a4e4e 100644 --- a/src/MCP/MCPStructureInitialize.class.st +++ b/src/MCP/MCPStructureInitialize.class.st @@ -22,9 +22,9 @@ MCPStructureInitialize >> asJRPCJSON [ | dic | dic := { - (#capabilities -> self capabilities asJRPCJSON). - (#protocolVersion -> self protocolVersion asJRPCJSON). - (#serverInfo -> self serverInfo asJRPCJSON) } asDictionary. + (#capabilities -> self capabilities asJRPCJSON). + (#protocolVersion -> self protocolVersion asJRPCJSON). + (#serverInfo -> self serverInfo asJRPCJSON) } asDictionary. self metadata ifNotNil: [ dic at: #_meta put: self metadata asJRPCJSON ]. ^ dic diff --git a/src/MCP/MCPStructuredTestResult.class.st b/src/MCP/MCPStructuredTestResult.class.st index 6343d4e..f1fbf8a 100644 --- a/src/MCP/MCPStructuredTestResult.class.st +++ b/src/MCP/MCPStructuredTestResult.class.st @@ -74,15 +74,15 @@ MCPStructuredTestResult >> recordIssueFrom: anException forTestCase: aTestCase [ MCPStructuredTestResult >> runCase: aTestCase [ [ - aTestCase announce: TestCaseStarted withResult: self. - aTestCase runCaseManaged. - aTestCase announce: TestCaseEnded withResult: self. - self addPass: aTestCase ] + aTestCase announce: TestCaseStarted withResult: self. + aTestCase runCaseManaged. + aTestCase announce: TestCaseEnded withResult: self. + self addPass: aTestCase ] on: self class failure , self class skip , self class warning , self class error do: [ :ex | - ex sunitAnnounce: aTestCase toResult: self. - self recordIssueFrom: ex forTestCase: aTestCase ] + ex sunitAnnounce: aTestCase toResult: self. + self recordIssueFrom: ex forTestCase: aTestCase ] ] { #category : 'private' } diff --git a/src/MCP/MCPTestCoverageResult.class.st b/src/MCP/MCPTestCoverageResult.class.st index 25d692f..8dafb83 100644 --- a/src/MCP/MCPTestCoverageResult.class.st +++ b/src/MCP/MCPTestCoverageResult.class.st @@ -61,12 +61,12 @@ MCPTestCoverageResult >> asDictionary [ at: #partiallyCoveredMethodsTruncated put: (self isListTruncated: partialMethods). self includeCoveredMethods ifTrue: [ - data - at: #coveredMethods - put: (self methodDictionariesFor: coveredMethods). - data - at: #coveredMethodsTruncated - put: (self isListTruncated: coveredMethods) ]. + data + at: #coveredMethods + put: (self methodDictionariesFor: coveredMethods). + data + at: #coveredMethodsTruncated + put: (self isListTruncated: coveredMethods) ]. ^ data ] @@ -149,12 +149,12 @@ MCPTestCoverageResult >> methodLimit [ MCPTestCoverageResult >> methodSortKeyFor: aCompiledMethod [ ^ String streamContents: [ :stream | - stream nextPutAll: aCompiledMethod methodClass instanceSide name. - aCompiledMethod methodClass isMeta ifTrue: [ - stream nextPutAll: ' class' ]. - stream - nextPutAll: '>>'; - nextPutAll: aCompiledMethod selector asString ] + stream nextPutAll: aCompiledMethod methodClass instanceSide name. + aCompiledMethod methodClass isMeta ifTrue: [ + stream nextPutAll: ' class' ]. + stream + nextPutAll: '>>'; + nextPutAll: aCompiledMethod selector asString ] ] { #category : 'private - coverage' } diff --git a/src/MCP/MCPTestRunRequest.class.st b/src/MCP/MCPTestRunRequest.class.st index 4d22dc0..d9dae67 100644 --- a/src/MCP/MCPTestRunRequest.class.st +++ b/src/MCP/MCPTestRunRequest.class.st @@ -26,9 +26,9 @@ MCPTestRunRequest class >> className: aClassName [ MCPTestRunRequest class >> className: aClassName testMethodName: aTestMethodName [ ^ self new - initializePackageName: nil - className: aClassName - testMethodName: aTestMethodName + initializePackageName: nil + className: aClassName + testMethodName: aTestMethodName ] { #category : 'instance creation' } @@ -39,9 +39,8 @@ MCPTestRunRequest class >> fromMethodReference: aString [ delimiterIndex isZero ifTrue: [ Error signal: 'methods must use Class>>#selector references.' ]. className := (aString copyFrom: 1 to: delimiterIndex - 1) trimBoth. - selector := (aString - copyFrom: delimiterIndex + 2 - to: aString size) trimBoth. + selector := (aString copyFrom: delimiterIndex + 2 to: aString size) + trimBoth. (selector notEmpty and: [ selector first = $# ]) ifTrue: [ selector := selector allButFirst ]. (className isEmpty or: [ selector isEmpty ]) ifTrue: [ @@ -53,9 +52,9 @@ MCPTestRunRequest class >> fromMethodReference: aString [ MCPTestRunRequest class >> packageName: aPackageName [ ^ self new - initializePackageName: aPackageName - className: nil - testMethodName: nil + initializePackageName: aPackageName + className: nil + testMethodName: nil ] { #category : 'converting' } @@ -64,8 +63,8 @@ MCPTestRunRequest >> asDictionary [ | data | data := Dictionary new. self isPackageRequest ifTrue: [ - data at: #packageName put: self packageName. - ^ data ]. + data at: #packageName put: self packageName. + ^ data ]. data at: #className put: self className. self testMethodName ifNotNil: [ data at: #testMethodName put: self testMethodName ]. @@ -83,8 +82,8 @@ MCPTestRunRequest >> displayName [ self isPackageRequest ifTrue: [ ^ self packageName ]. ^ self testMethodName - ifNil: [ self className ] - ifNotNil: [ :methodName | self className , '>>#' , methodName ] + ifNil: [ self className ] + ifNotNil: [ :methodName | self className , '>>#' , methodName ] ] { #category : 'testing' } diff --git a/src/MCP/MCPTool.class.st b/src/MCP/MCPTool.class.st index 736bf3a..dcc79e3 100644 --- a/src/MCP/MCPTool.class.st +++ b/src/MCP/MCPTool.class.st @@ -234,8 +234,8 @@ MCPTool >> executeParsedRequestFrom: request do: executionBlock onError: errorBl | parsedRequest | ^ [ - parsedRequest := self parsedRequestFromToolRequest: request. - executionBlock value: parsedRequest ] + parsedRequest := self parsedRequestFromToolRequest: request. + executionBlock value: parsedRequest ] on: Exception do: [ :error | errorBlock value: error value: parsedRequest ] ] @@ -260,16 +260,16 @@ MCPTool >> failureMessageFor: anError [ ifNil: [ '' ] ifNotNil: [ :text | text asString ]. ^ String streamContents: [ :stream | - stream - nextPutAll: 'Tool '; - nextPutAll: self name; - nextPutAll: ' failed ('; - nextPutAll: anError class name; - nextPutAll: ')'. - message isEmpty ifFalse: [ stream - nextPutAll: ': '; - nextPutAll: message ] ] + nextPutAll: 'Tool '; + nextPutAll: self name; + nextPutAll: ' failed ('; + nextPutAll: anError class name; + nextPutAll: ')'. + message isEmpty ifFalse: [ + stream + nextPutAll: ': '; + nextPutAll: message ] ] ] { #category : 'metadata' } diff --git a/src/MCP/MCPToolCaptureScreenshot.class.st b/src/MCP/MCPToolCaptureScreenshot.class.st index 239e4eb..9403304 100644 --- a/src/MCP/MCPToolCaptureScreenshot.class.st +++ b/src/MCP/MCPToolCaptureScreenshot.class.st @@ -104,14 +104,14 @@ MCPToolCaptureScreenshot >> parsedRequestFromToolRequest: request [ MCPToolCaptureScreenshot >> successSummaryForResult: aScreenshotResult [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Captured '; - nextPutAll: aScreenshotResult target; - nextPutAll: ' screenshot ('; - print: aScreenshotResult width; - nextPutAll: 'x'; - print: aScreenshotResult height; - nextPutAll: ').' ] + stream + nextPutAll: 'Captured '; + nextPutAll: aScreenshotResult target; + nextPutAll: ' screenshot ('; + print: aScreenshotResult width; + nextPutAll: 'x'; + print: aScreenshotResult height; + nextPutAll: ').' ] ] { #category : 'metadata' } diff --git a/src/MCP/MCPToolCatalogCommand.class.st b/src/MCP/MCPToolCatalogCommand.class.st index 56c687c..dc94986 100644 --- a/src/MCP/MCPToolCatalogCommand.class.st +++ b/src/MCP/MCPToolCatalogCommand.class.st @@ -22,9 +22,9 @@ MCPToolCatalogCommand class >> isAbstract [ MCPToolCatalogCommand class >> tool: aTool request: aRequest toolExposurePolicy: aToolExposurePolicy [ ^ self new - initializeTool: aTool request: aRequest; - toolExposurePolicy: aToolExposurePolicy; - yourself + initializeTool: aTool request: aRequest; + toolExposurePolicy: aToolExposurePolicy; + yourself ] { #category : 'accessing' } @@ -37,5 +37,5 @@ MCPToolCatalogCommand >> toolExposurePolicy [ MCPToolCatalogCommand >> toolExposurePolicy: aToolExposurePolicy [ toolExposurePolicy := aToolExposurePolicy ifNil: [ - MCPToolExposurePolicy default ] + MCPToolExposurePolicy default ] ] diff --git a/src/MCP/MCPToolChangeHistory.class.st b/src/MCP/MCPToolChangeHistory.class.st index 0626ff2..f157e3b 100644 --- a/src/MCP/MCPToolChangeHistory.class.st +++ b/src/MCP/MCPToolChangeHistory.class.st @@ -117,27 +117,28 @@ MCPToolChangeHistory >> changeHistoryLogSchemaProperty [ MCPToolChangeHistory >> commandForRequest: changeHistoryRequest [ changeHistoryRequest operation = 'listFiles' ifTrue: [ - ^ MCPListChangeHistoryLogsCommand - tool: self - request: changeHistoryRequest ]. + ^ MCPListChangeHistoryLogsCommand + tool: self + request: changeHistoryRequest ]. changeHistoryRequest operation = 'listEntries' ifTrue: [ - ^ MCPListChangeHistoryEntriesCommand - tool: self - request: changeHistoryRequest ]. + ^ MCPListChangeHistoryEntriesCommand + tool: self + request: changeHistoryRequest ]. (#( 'applyEntries' 'revertEntries' ) includes: changeHistoryRequest operation) ifTrue: [ - ^ MCPChangeHistorySelectionCommand - tool: self - request: changeHistoryRequest ]. + ^ MCPChangeHistorySelectionCommand + tool: self + request: changeHistoryRequest ]. MCPCommandError signalErrorCode: #UnsupportedChangeHistoryAction - message: 'Unsupported change history action: ' , changeHistoryRequest operation + message: + 'Unsupported change history action: ' + , changeHistoryRequest operation details: { (#action -> changeHistoryRequest operation). (#supportedActions -> #( 'listFiles' 'listEntries' 'applyEntries' 'revertEntries' )) } asDictionary - ] { #category : 'executing' } diff --git a/src/MCP/MCPToolClassMutation.class.st b/src/MCP/MCPToolClassMutation.class.st index 0e4b0e8..cd977e1 100644 --- a/src/MCP/MCPToolClassMutation.class.st +++ b/src/MCP/MCPToolClassMutation.class.st @@ -22,9 +22,7 @@ MCPToolClassMutation class >> isAbstract [ { #category : 'private - schema' } MCPToolClassMutation >> atLeastOneInputProperties [ - ^ self classToolSpec - at: #atLeastOneProperties - ifAbsent: [ #( ) ] + ^ self classToolSpec at: #atLeastOneProperties ifAbsent: [ #( ) ] ] { #category : 'metadata' } @@ -115,45 +113,45 @@ MCPToolClassMutation >> failureMessageForAddSlotNamed: slotName onClassNamed: cl MCPToolClassMutation >> failureMessageForCreateClassNamed: className superclassName: superclassName packageName: packageName error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to create class '; - nextPutAll: className; - nextPutAll: ' < '; - nextPutAll: superclassName; - nextPutAll: ' in package '; - nextPutAll: packageName; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to create class '; + nextPutAll: className; + nextPutAll: ' < '; + nextPutAll: superclassName; + nextPutAll: ' in package '; + nextPutAll: packageName; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } MCPToolClassMutation >> failureMessageForMoveClassNamed: className packageName: packageName tag: tag error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to move class '; - nextPutAll: className; - nextPutAll: ' to package '; - nextPutAll: packageName. - tag ifNotNil: [ stream - nextPutAll: ' tag '; - nextPutAll: tag ]. - stream - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + nextPutAll: 'Unable to move class '; + nextPutAll: className; + nextPutAll: ' to package '; + nextPutAll: packageName. + tag ifNotNil: [ + stream + nextPutAll: ' tag '; + nextPutAll: tag ]. + stream + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } MCPToolClassMutation >> failureMessageForMoveSlotNamed: slotName onClassNamed: className classSide: classSide operation: operation error: anError [ operation = 'pullUpSlot' ifTrue: [ - ^ 'Failed to pull up ' - , (self slotDescriptionForClassSide: classSide) , ' ' , slotName - , ' to class ' , className , ': ' - , (self normalizedCauseMessageForMutationError: anError) ]. + ^ 'Failed to pull up ' + , (self slotDescriptionForClassSide: classSide) , ' ' , slotName + , ' to class ' , className , ': ' + , (self normalizedCauseMessageForMutationError: anError) ]. ^ 'Failed to push down ' , (self slotDescriptionForClassSide: classSide) , ' ' , slotName , ' from class ' , className , ': ' @@ -172,14 +170,14 @@ MCPToolClassMutation >> failureMessageForRemoveSlotNamed: slotName onClassNamed: MCPToolClassMutation >> failureMessageForRenameClassNamed: className to: newClassName error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to rename class '; - nextPutAll: className; - nextPutAll: ' to '; - nextPutAll: newClassName; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to rename class '; + nextPutAll: className; + nextPutAll: ' to '; + nextPutAll: newClassName; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } @@ -194,106 +192,104 @@ MCPToolClassMutation >> failureMessageForRenameSlotNamed: slotName to: newSlotNa MCPToolClassMutation >> failureMessageForReparentClassNamed: className superclassName: superclassName error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to reparent class '; - nextPutAll: className; - nextPutAll: ' to superclass '; - nextPutAll: superclassName; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to reparent class '; + nextPutAll: className; + nextPutAll: ' to superclass '; + nextPutAll: superclassName; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } MCPToolClassMutation >> failureMessageForReplaceClassTraitsOnClassNamed: className error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to replace class-side traits for class '; - nextPutAll: className; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to replace class-side traits for class '; + nextPutAll: className; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } MCPToolClassMutation >> failureMessageForReplaceDefinitionOnClassNamed: className error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to replace slot definition for class '; - nextPutAll: className; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to replace slot definition for class '; + nextPutAll: className; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } MCPToolClassMutation >> failureMessageForReplaceLayoutOnClassNamed: className error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to replace layout for class '; - nextPutAll: className; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to replace layout for class '; + nextPutAll: className; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } MCPToolClassMutation >> failureMessageForReplaceSharedPoolsOnClassNamed: className error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to replace shared pools for class '; - nextPutAll: className; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to replace shared pools for class '; + nextPutAll: className; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } MCPToolClassMutation >> failureMessageForReplaceSharedVariablesOnClassNamed: className error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to replace shared variables for class '; - nextPutAll: className; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to replace shared variables for class '; + nextPutAll: className; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } MCPToolClassMutation >> failureMessageForReplaceTraitsOnClassNamed: className error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to replace traits for class '; - nextPutAll: className; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to replace traits for class '; + nextPutAll: className; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } MCPToolClassMutation >> failureMessageForSetCommentOnClassNamed: className error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to set comment for class '; - nextPutAll: className; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to set comment for class '; + nextPutAll: className; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private - specs' } MCPToolClassMutation >> fixedArguments [ - ^ self classToolSpec - at: #fixedArguments - ifAbsent: [ Dictionary new ] + ^ self classToolSpec at: #fixedArguments ifAbsent: [ Dictionary new ] ] { #category : 'private - schema' } @@ -367,9 +363,9 @@ MCPToolClassMutation >> parsedRequestFromToolRequest: request [ self fixedArguments keysAndValuesDo: [ :key :value | arguments at: key put: value ]. mutationToolRequest := MCPToolRequest new - tool: self; - arguments: arguments; - yourself. + tool: self; + arguments: arguments; + yourself. requestClass := self mutationAction = 'create' ifTrue: [ MCPClassCreateRequest ] ifFalse: [ MCPClassUpdateRequest ]. diff --git a/src/MCP/MCPToolDebug.class.st b/src/MCP/MCPToolDebug.class.st index b1f617f..a3d1b9d 100644 --- a/src/MCP/MCPToolDebug.class.st +++ b/src/MCP/MCPToolDebug.class.st @@ -33,11 +33,11 @@ MCPToolDebug >> boundedIntegerSchemaPropertyNamed: propertyName description: pro MCPToolDebug >> buildInputSchema [ ^ MCPStructureInputSchema new - type: 'object'; - properties: self inputProperties; - required: self requiredInputProperties; - additionalProperties: false; - yourself + type: 'object'; + properties: self inputProperties; + required: self requiredInputProperties; + additionalProperties: false; + yourself ] { #category : 'private - execution' } @@ -79,7 +79,7 @@ MCPToolDebug >> executeWithRequest: request [ { #category : 'private - schema' } MCPToolDebug >> inputProperties [ - ^ #( ) + ^ #( ) ] { #category : 'private - schema' } @@ -97,7 +97,7 @@ MCPToolDebug >> nonNegativeIntegerSchemaPropertyNamed: propertyName description: { #category : 'private - schema' } MCPToolDebug >> requiredInputProperties [ - ^ #( ) + ^ #( ) ] { #category : 'private - execution' } @@ -117,10 +117,10 @@ MCPToolDebug >> resultForCommandResult: commandResult [ MCPToolDebug >> sessionIdSchemaProperty [ ^ self - schemaPropertyNamed: 'sessionId' - type: 'string' - description: - 'Opaque debug session identifier returned by debug_session_list, debug_capture, debug_test_run, or debug_candidate_attach.' + schemaPropertyNamed: 'sessionId' + type: 'string' + description: + 'Opaque debug session identifier returned by debug_session_list, debug_capture, debug_test_run, or debug_candidate_attach.' ] { #category : 'private - schema' } diff --git a/src/MCP/MCPToolDebugBreakpointOperation.class.st b/src/MCP/MCPToolDebugBreakpointOperation.class.st index efdac2f..efa311e 100644 --- a/src/MCP/MCPToolDebugBreakpointOperation.class.st +++ b/src/MCP/MCPToolDebugBreakpointOperation.class.st @@ -157,9 +157,7 @@ MCPToolDebugBreakpointOperation >> description [ { #category : 'private - schema' } MCPToolDebugBreakpointOperation >> inputProperties [ - ^ self breakpointToolSpec - at: #inputProperties - ifAbsent: [ #( ) ] + ^ self breakpointToolSpec at: #inputProperties ifAbsent: [ #( ) ] ] { #category : 'private - request' } @@ -174,9 +172,7 @@ MCPToolDebugBreakpointOperation >> parsedRequestFromToolRequest: request [ { #category : 'private - schema' } MCPToolDebugBreakpointOperation >> requiredInputProperties [ - ^ self breakpointToolSpec - at: #requiredProperties - ifAbsent: [ #( ) ] + ^ self breakpointToolSpec at: #requiredProperties ifAbsent: [ #( ) ] ] { #category : 'metadata' } diff --git a/src/MCP/MCPToolDebugSessionControlOperation.class.st b/src/MCP/MCPToolDebugSessionControlOperation.class.st index 6426d46..ed97bdc 100644 --- a/src/MCP/MCPToolDebugSessionControlOperation.class.st +++ b/src/MCP/MCPToolDebugSessionControlOperation.class.st @@ -211,9 +211,7 @@ MCPToolDebugSessionControlOperation >> title [ { #category : 'private - specs' } MCPToolDebugSessionControlOperation >> usesFrameReference [ - ^ self controlToolSpec - at: #usesFrameReference - ifAbsent: [ false ] + ^ self controlToolSpec at: #usesFrameReference ifAbsent: [ false ] ] { #category : 'private - specs' } diff --git a/src/MCP/MCPToolDebugSessionOperation.class.st b/src/MCP/MCPToolDebugSessionOperation.class.st index 30c6298..c99de2d 100644 --- a/src/MCP/MCPToolDebugSessionOperation.class.st +++ b/src/MCP/MCPToolDebugSessionOperation.class.st @@ -117,9 +117,7 @@ MCPToolDebugSessionOperation >> parsedRequestFromToolRequest: request [ { #category : 'private - schema' } MCPToolDebugSessionOperation >> requiredInputProperties [ - ^ self sessionToolSpec - at: #requiredProperties - ifAbsent: [ #( ) ] + ^ self sessionToolSpec at: #requiredProperties ifAbsent: [ #( ) ] ] { #category : 'private - specs' } diff --git a/src/MCP/MCPToolEvaluate.class.st b/src/MCP/MCPToolEvaluate.class.st index d70398e..4cd6c1d 100644 --- a/src/MCP/MCPToolEvaluate.class.st +++ b/src/MCP/MCPToolEvaluate.class.st @@ -70,24 +70,24 @@ MCPToolEvaluate >> executeWithRequest: request [ ^ self executeParsedRequestFrom: request do: [ :evaluateRequest | - | commandResult | - commandResult := (self commandForRequest: evaluateRequest) - execute. - commandResult isError - ifTrue: [ - self - errorResultText: commandResult summary - details: commandResult errorDetails ] - ifFalse: [ - self - successResultText: 'Code evaluated successfully.' - data: commandResult data ] ] + | commandResult | + commandResult := (self commandForRequest: evaluateRequest) + execute. + commandResult isError + ifTrue: [ + self + errorResultText: commandResult summary + details: commandResult errorDetails ] + ifFalse: [ + self + successResultText: 'Code evaluated successfully.' + data: commandResult data ] ] onError: [ :error :ignored | - self - errorResultText: (error messageText - ifNil: [ error asString ] - ifNotNil: [ :text | text ]) - details: (self errorDetailsFor: error) ] + self + errorResultText: (error messageText + ifNil: [ error asString ] + ifNotNil: [ :text | text ]) + details: (self errorDetailsFor: error) ] ] { #category : 'private - request' } @@ -110,15 +110,15 @@ MCPToolEvaluate >> runtimeFailureMessageFor: anError [ ifNil: [ anError asString ] ifNotNil: [ :text | text asString ]. ^ String streamContents: [ :stream | - stream - nextPutAll: 'Evaluation failed during execution ('; - nextPutAll: anError class name; - nextPutAll: '): '; - nextPutAll: message. - anError signalerContext ifNotNil: [ :context | stream - nextPutAll: ' Signaler context: '; - nextPutAll: context printString ] ] + nextPutAll: 'Evaluation failed during execution ('; + nextPutAll: anError class name; + nextPutAll: '): '; + nextPutAll: message. + anError signalerContext ifNotNil: [ :context | + stream + nextPutAll: ' Signaler context: '; + nextPutAll: context printString ] ] ] { #category : 'testing' } diff --git a/src/MCP/MCPToolGetClass.class.st b/src/MCP/MCPToolGetClass.class.st index aed66b4..4c9e98a 100644 --- a/src/MCP/MCPToolGetClass.class.st +++ b/src/MCP/MCPToolGetClass.class.st @@ -210,9 +210,9 @@ MCPToolGetClass >> description [ MCPToolGetClass >> descriptionDictionariesForClasses: someClasses includeComment: includeComment [ ^ (someClasses collect: [ :each | - self - descriptionDictionaryForClass: each - includeComment: includeComment ]) asArray + self + descriptionDictionaryForClass: each + includeComment: includeComment ]) asArray ] { #category : 'private - hierarchy' } diff --git a/src/MCP/MCPToolGetMethod.class.st b/src/MCP/MCPToolGetMethod.class.st index 7b3b3fa..215dc33 100644 --- a/src/MCP/MCPToolGetMethod.class.st +++ b/src/MCP/MCPToolGetMethod.class.st @@ -202,9 +202,9 @@ MCPToolGetMethod >> matchingSummaryForNodeName: aName kind: aKind ownerName: anO ^ summaries detect: [ :each | - (each at: #name) = aName and: [ - (each at: #kind) = aKind and: [ - (each at: #ownerName ifAbsent: [ nil ]) = anOwnerName ] ] ] + (each at: #name) = aName and: [ + (each at: #kind) = aKind and: [ + (each at: #ownerName ifAbsent: [ nil ]) = anOwnerName ] ] ] ifNone: [ nil ] ] diff --git a/src/MCP/MCPToolMethodMutation.class.st b/src/MCP/MCPToolMethodMutation.class.st index f87f2be..4b0390e 100644 --- a/src/MCP/MCPToolMethodMutation.class.st +++ b/src/MCP/MCPToolMethodMutation.class.st @@ -58,10 +58,14 @@ MCPToolMethodMutation >> allowedNonErrorCritiqueRuleClasses [ MCPToolMethodMutation >> buildOutputSchema [ ^ self - standardOutputSchemaForDataProperties: { - (self schemaPropertyNamed: 'changeKind' type: 'string' description: 'Whether method_compile created or replaced a method.'). - self methodCritiquesSchemaProperty } - required: #( ) + standardOutputSchemaForDataProperties: { + (self + schemaPropertyNamed: 'changeKind' + type: 'string' + description: + 'Whether method_compile created or replaced a method.'). + self methodCritiquesSchemaProperty } + required: #( ) ] { #category : 'private' } @@ -83,9 +87,9 @@ MCPToolMethodMutation >> critiqueDataFor: aCritique [ asDictionary. interval := self sourceIntervalForCritique: aCritique. interval ifNotNil: [ - data - at: #start put: interval first; - at: #stop put: interval last ]. + data + at: #start put: interval first; + at: #stop put: interval last ]. ^ data ] @@ -119,18 +123,18 @@ MCPToolMethodMutation >> failureMessageForArgumentUpdateAction: updateAction cla ifTrue: [ 'add arguments to' ] ifFalse: [ 'remove arguments from' ]. ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to '; - nextPutAll: verb; - nextPutAll: ' method '; - nextPutAll: targetName; - nextPutAll: '>>'; - nextPutAll: oldSelector; - nextPutAll: ' as '; - nextPutAll: newSelector; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to '; + nextPutAll: verb; + nextPutAll: ' method '; + nextPutAll: targetName; + nextPutAll: '>>'; + nextPutAll: oldSelector; + nextPutAll: ' as '; + nextPutAll: newSelector; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } @@ -141,16 +145,16 @@ MCPToolMethodMutation >> failureMessageForChangeProtocolClassNamed: className cl classReferenceNameFor: className classSide: classSide. ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to change protocol for '; - nextPutAll: targetName; - nextPutAll: '>>'; - nextPutAll: selector; - nextPutAll: ' to '; - nextPutAll: protocol; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to change protocol for '; + nextPutAll: targetName; + nextPutAll: '>>'; + nextPutAll: selector; + nextPutAll: ' to '; + nextPutAll: protocol; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } @@ -161,12 +165,12 @@ MCPToolMethodMutation >> failureMessageForCompileClassNamed: className classSide classReferenceNameFor: className classSide: classSide. ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to compile method on '; - nextPutAll: targetName; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to compile method on '; + nextPutAll: targetName; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private' } @@ -177,16 +181,16 @@ MCPToolMethodMutation >> failureMessageForRenameClassNamed: className classSide: classReferenceNameFor: className classSide: classSide. ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to rename method '; - nextPutAll: targetName; - nextPutAll: '>>'; - nextPutAll: oldSelector; - nextPutAll: ' to '; - nextPutAll: newSelector; - nextPutAll: ': '; - nextPutAll: - (self normalizedCauseMessageForMutationError: anError) ] + stream + nextPutAll: 'Unable to rename method '; + nextPutAll: targetName; + nextPutAll: '>>'; + nextPutAll: oldSelector; + nextPutAll: ' to '; + nextPutAll: newSelector; + nextPutAll: ': '; + nextPutAll: + (self normalizedCauseMessageForMutationError: anError) ] ] { #category : 'private - schema' } @@ -266,8 +270,8 @@ MCPToolMethodMutation >> parsedRequestFromToolRequest: request [ | requestClass | requestClass := self mutationAction = 'compile' - ifTrue: [ MCPMethodCompileRequest ] - ifFalse: [ MCPMethodUpdateRequest ]. + ifTrue: [ MCPMethodCompileRequest ] + ifFalse: [ MCPMethodUpdateRequest ]. ^ requestClass fromRequest: request tool: self ] diff --git a/src/MCP/MCPToolMethodSearch.class.st b/src/MCP/MCPToolMethodSearch.class.st index df70664..0451b37 100644 --- a/src/MCP/MCPToolMethodSearch.class.st +++ b/src/MCP/MCPToolMethodSearch.class.st @@ -146,9 +146,9 @@ MCPToolMethodSearch >> matchingSelectorReferencesForSelector: aSelectorSymbol in specialSelectorIndex := Smalltalk specialSelectorIndexOrNil: aSelectorSymbol. ^ (compiledMethods select: [ :eachMethod | - eachMethod - hasSelector: aSelectorSymbol - specialSelectorIndex: specialSelectorIndex ]) asArray + eachMethod + hasSelector: aSelectorSymbol + specialSelectorIndex: specialSelectorIndex ]) asArray ] { #category : 'private - searching' } @@ -159,8 +159,8 @@ MCPToolMethodSearch >> matchingVariableReferencesNamed: aVariableName scopeQuery variableBindingsNamed: aVariableName inBehaviors: query behaviors. variables ifEmpty: [ - Error signal: 'No variable named ' , aVariableName - , ' is accessible in the requested scope.' ]. + Error signal: 'No variable named ' , aVariableName + , ' is accessible in the requested scope.' ]. ^ (compiledMethods select: [ :eachMethod | self method: eachMethod referencesAnyVariable: variables ]) asArray @@ -365,11 +365,11 @@ MCPToolMethodSearch >> variableBindingsNamed: aVariableName inBehaviors: behavio | variables | variables := IdentitySet new. behaviors do: [ :eachBehavior | - eachBehavior allSlots do: [ :eachSlot | - eachSlot name asString = aVariableName ifTrue: [ - variables add: eachSlot ] ]. - (eachBehavior bindingOf: aVariableName) ifNotNil: [ :binding | - variables add: binding ] ]. + eachBehavior allSlots do: [ :eachSlot | + eachSlot name asString = aVariableName ifTrue: [ + variables add: eachSlot ] ]. + (eachBehavior bindingOf: aVariableName) ifNotNil: [ :binding | + variables add: binding ] ]. ^ variables asArray ] diff --git a/src/MCP/MCPToolMutation.class.st b/src/MCP/MCPToolMutation.class.st index d9c353d..9042d8e 100644 --- a/src/MCP/MCPToolMutation.class.st +++ b/src/MCP/MCPToolMutation.class.st @@ -33,9 +33,9 @@ MCPToolMutation >> addRefactoringScopeContextFromSpec: scopeSpec toRequestedCont scopeSpec classNames ifNotEmpty: [ requestedContext at: #classNames put: scopeSpec classNames ]. scopeSpec hierarchyClassNames ifNotEmpty: [ - requestedContext - at: #hierarchyClassNames - put: scopeSpec hierarchyClassNames ] + requestedContext + at: #hierarchyClassNames + put: scopeSpec hierarchyClassNames ] ] { #category : 'private - errors' } @@ -79,11 +79,11 @@ MCPToolMutation >> addSupplementalSelectorFromMethodNode: methodNode to: details MCPToolMutation >> buildInputSchema [ ^ MCPStructureInputSchema new - type: 'object'; - properties: self inputProperties; - required: self requiredInputProperties; - additionalProperties: false; - yourself + type: 'object'; + properties: self inputProperties; + required: self requiredInputProperties; + additionalProperties: false; + yourself ] { #category : 'private - refactoring' } @@ -127,13 +127,13 @@ MCPToolMutation >> errorResultForCommandError: anError action: action requestedC | details | details := anError structuredDetails copy. requestedContext ifNotNil: [ - requestedContext keysAndValuesDo: [ :key :value | - value ifNotNil: [ details at: key ifAbsentPut: [ value ] ] ] ]. + requestedContext keysAndValuesDo: [ :key :value | + value ifNotNil: [ details at: key ifAbsentPut: [ value ] ] ] ]. (#( 'compile' 'create' 'update' ) includes: action) ifTrue: [ details at: #action put: action ] ifFalse: [ - details at: #action put: 'update'. - details at: #updateAction put: action ]. + details at: #action put: 'update'. + details at: #updateAction put: action ]. ^ self errorResultText: anError messageText details: details ] @@ -200,11 +200,12 @@ MCPToolMutation >> executeWithRequest: request [ ^ self executeParsedRequestFrom: request do: [ :mutationRequest | - (self commandForRequest: mutationRequest) execute ] + (self commandForRequest: mutationRequest) execute ] onError: [ :error :mutationRequest | | action requestedContext | action := self - mutationActionForErrorFromParsedRequest: mutationRequest + mutationActionForErrorFromParsedRequest: + mutationRequest rawRequest: request. requestedContext := self requestedContextForErrorFromParsedRequest: @@ -261,9 +262,10 @@ MCPToolMutation >> hierarchyRefactoringEnvironmentForClassNames: classNames base classNames. environment := nil. resolvedClasses do: [ :eachClass | - environment := self - unionRefactoringEnvironment: environment - with: (baseEnvironment forClassHierarchy: eachClass) ]. + environment := self + unionRefactoringEnvironment: environment + with: + (baseEnvironment forClassHierarchy: eachClass) ]. ^ environment ] @@ -278,9 +280,9 @@ MCPToolMutation >> impactMessageForRefactoringCondition: aCondition [ | message | message := String streamContents: [ :stream | - aCondition violationMessageOn: stream ]. + aCondition violationMessageOn: stream ]. ^ self normalizedRefactoringConditionMessage: - (self normalizedSingleLineText: message) + (self normalizedSingleLineText: message) ] { #category : 'private - warnings' } @@ -363,8 +365,7 @@ MCPToolMutation >> normalizedCommandErrorForActionFailure: anError action: actio causedBy: anError. self addSupplementalDetailsForMutationError: anError to: details. ^ MCPCommandError new - errorCode: - (self failureErrorCodeFor: anError action: action); + errorCode: (self failureErrorCodeFor: anError action: action); details: details; messageText: normalizedSummary; yourself @@ -387,8 +388,7 @@ MCPToolMutation >> normalizedCommandErrorForRefactoringWarning: aWarning action: details at: #howToProceed put: self howToProceedForRefactoringWarning. details at: #forceSupported put: true. ^ MCPCommandError new - errorCode: - (self failureErrorCodeFor: aWarning action: action); + errorCode: (self failureErrorCodeFor: aWarning action: action); details: details; messageText: summary; yourself @@ -435,25 +435,25 @@ MCPToolMutation >> refactoringEnvironmentForScopeSpec: scopeSpec [ scopeSpec isDefaultImageScope ifTrue: [ ^ baseEnvironment ]. environment := nil. scopeSpec packageNames ifNotEmpty: [ - environment := self - unionRefactoringEnvironment: environment - with: - (baseEnvironment forPackageNames: - scopeSpec packageNames) ]. + environment := self + unionRefactoringEnvironment: environment + with: + (baseEnvironment forPackageNames: + scopeSpec packageNames) ]. scopeSpec classNames ifNotEmpty: [ - environment := self - unionRefactoringEnvironment: environment - with: (self - classesRefactoringEnvironmentForClassNames: - scopeSpec classNames - baseEnvironment: baseEnvironment) ]. + environment := self + unionRefactoringEnvironment: environment + with: (self + classesRefactoringEnvironmentForClassNames: + scopeSpec classNames + baseEnvironment: baseEnvironment) ]. scopeSpec hierarchyClassNames ifNotEmpty: [ - environment := self - unionRefactoringEnvironment: environment - with: (self - hierarchyRefactoringEnvironmentForClassNames: - scopeSpec hierarchyClassNames - baseEnvironment: baseEnvironment) ]. + environment := self + unionRefactoringEnvironment: environment + with: (self + hierarchyRefactoringEnvironmentForClassNames: + scopeSpec hierarchyClassNames + baseEnvironment: baseEnvironment) ]. ^ environment ifNil: [ baseEnvironment ] ] @@ -463,16 +463,17 @@ MCPToolMutation >> refactoringModelForScopeSpec: scopeSpec anchoredAtBehavior: a | details environment | environment := self refactoringEnvironmentForScopeSpec: scopeSpec. (environment includesClass: aBehavior) ifFalse: [ - details := scopeSpec asDictionary copy. - details at: #className put: aBehavior instanceSide name asString. - details at: #classSide put: aBehavior isMeta. - MCPCommandError - signalErrorCode: #RefactoringScopeExcludesTargetClass - message: 'Refactoring scope does not include ' , (aBehavior isMeta - ifTrue: [ 'the class side of ' ] - ifFalse: [ 'class ' ]) , aBehavior instanceSide name asString - , '.' - details: details ]. + details := scopeSpec asDictionary copy. + details at: #className put: aBehavior instanceSide name asString. + details at: #classSide put: aBehavior isMeta. + MCPCommandError + signalErrorCode: #RefactoringScopeExcludesTargetClass + message: + 'Refactoring scope does not include ' , (aBehavior isMeta + ifTrue: [ 'the class side of ' ] + ifFalse: [ 'class ' ]) , aBehavior instanceSide name asString + , '.' + details: details ]. ^ RBNamespace onEnvironment: environment ] @@ -654,10 +655,10 @@ MCPToolMutation >> validateRefactoringScopePackageNamesExist: packageNames [ MCPToolMutation >> validateRequest: request [ self requiredInputProperties do: [ :each | - (request argumentNamed: each ifAbsent: [ nil ]) ifNil: [ - MCPInvalidToolInput - signalMissingRequiredArgumentNamed: each - forTool: self ] ] + (request argumentNamed: each ifAbsent: [ nil ]) ifNil: [ + MCPInvalidToolInput + signalMissingRequiredArgumentNamed: each + forTool: self ] ] ] { #category : 'private - errors' } diff --git a/src/MCP/MCPToolRegistry.class.st b/src/MCP/MCPToolRegistry.class.st index bac68fa..a4a74d1 100644 --- a/src/MCP/MCPToolRegistry.class.st +++ b/src/MCP/MCPToolRegistry.class.st @@ -54,7 +54,8 @@ MCPToolRegistry class >> additionalKeywordsForTool: aTool [ toolName = 'repository_branch_switch' ifTrue: [ ^ #( 'repo' 'iceberg' 'git' 'branch' 'switch' ) ]. toolName = 'repository_branch_checkout' ifTrue: [ - ^ #( 'repo' 'iceberg' 'git' 'branch' 'checkout' 'reload' 'stale' 'verification' ) ]. + ^ #( 'repo' 'iceberg' 'git' 'branch' 'checkout' 'reload' 'stale' + 'verification' ) ]. toolName = 'repository_head_adopt' ifTrue: [ ^ #( 'repo' 'iceberg' 'git' 'head' 'adopt' ) ]. toolName = 'baseline_load' ifTrue: [ diff --git a/src/MCP/MCPToolRemoveClasses.class.st b/src/MCP/MCPToolRemoveClasses.class.st index 7778753..56583c2 100644 --- a/src/MCP/MCPToolRemoveClasses.class.st +++ b/src/MCP/MCPToolRemoveClasses.class.st @@ -115,33 +115,33 @@ MCPToolRemoveClasses >> executeWithRequest: request [ ^ self executeParsedRequestFrom: request do: [ :removeRequest | - | result | - result := (self commandForRequest: removeRequest) execute. - self - successResultText: (self - successSummaryForClassNames: removeRequest classNames - removedClasses: result removedClasses - removedPackageNames: result removedPackageNames - forced: result warningMessages notEmpty) - data: result asDictionary - warnings: result warningMessages ] + | result | + result := (self commandForRequest: removeRequest) execute. + self + successResultText: (self + successSummaryForClassNames: removeRequest classNames + removedClasses: result removedClasses + removedPackageNames: result removedPackageNames + forced: result warningMessages notEmpty) + data: result asDictionary + warnings: result warningMessages ] onError: [ :error :removeRequest | - self errorResultForError: error classNames: (self - classNamesForErrorFromParsedRequest: removeRequest - rawRequest: request) ] + self errorResultForError: error classNames: (self + classNamesForErrorFromParsedRequest: removeRequest + rawRequest: request) ] ] { #category : 'private' } MCPToolRemoveClasses >> failureMessageForClassNames: classNames error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to remove classes: '; - nextPutAll: (', ' join: classNames); - nextPutAll: ' ('; - nextPutAll: anError class name; - nextPutAll: '): '; - nextPutAll: anError messageText ] + stream + nextPutAll: 'Unable to remove classes: '; + nextPutAll: (', ' join: classNames); + nextPutAll: ' ('; + nextPutAll: anError class name; + nextPutAll: '): '; + nextPutAll: anError messageText ] ] { #category : 'private - request' } @@ -162,51 +162,51 @@ MCPToolRemoveClasses >> successSummaryForClassNames: classNames removedClasses: | reparentedSubclassNames | reparentedSubclassNames := OrderedCollection new. removedClasses do: [ :each | - each reparentedSubclassNames do: [ :subclassName | - (reparentedSubclassNames includes: subclassName) ifFalse: [ - reparentedSubclassNames add: subclassName ] ] ]. + each reparentedSubclassNames do: [ :subclassName | + (reparentedSubclassNames includes: subclassName) ifFalse: [ + reparentedSubclassNames add: subclassName ] ] ]. ^ String streamContents: [ :stream | - classNames size = 1 - ifTrue: [ - wasForced - ifTrue: [ - stream - nextPutAll: 'Force-removed class '; - nextPutAll: classNames first; - nextPut: $. ] - ifFalse: [ - stream - nextPutAll: 'Removed class '; - nextPutAll: classNames first; - nextPut: $. ] ] - ifFalse: [ - wasForced - ifTrue: [ - stream - nextPutAll: 'Force-removed '; - nextPutAll: classNames size asString; - nextPutAll: ' classes: '; - nextPutAll: (', ' join: classNames); - nextPut: $. ] - ifFalse: [ - stream - nextPutAll: 'Removed '; - nextPutAll: classNames size asString; - nextPutAll: ' classes: '; - nextPutAll: (', ' join: classNames); - nextPut: $. ] ]. - reparentedSubclassNames ifNotEmpty: [ - stream - space; - nextPutAll: 'Reparented subclasses: '; - nextPutAll: (', ' join: reparentedSubclassNames); - nextPut: $. ]. - removedPackageNames ifNotEmpty: [ - stream - space; - nextPutAll: 'Removed packages: '; - nextPutAll: (', ' join: removedPackageNames); - nextPut: $. ] ] + classNames size = 1 + ifTrue: [ + wasForced + ifTrue: [ + stream + nextPutAll: 'Force-removed class '; + nextPutAll: classNames first; + nextPut: $. ] + ifFalse: [ + stream + nextPutAll: 'Removed class '; + nextPutAll: classNames first; + nextPut: $. ] ] + ifFalse: [ + wasForced + ifTrue: [ + stream + nextPutAll: 'Force-removed '; + nextPutAll: classNames size asString; + nextPutAll: ' classes: '; + nextPutAll: (', ' join: classNames); + nextPut: $. ] + ifFalse: [ + stream + nextPutAll: 'Removed '; + nextPutAll: classNames size asString; + nextPutAll: ' classes: '; + nextPutAll: (', ' join: classNames); + nextPut: $. ] ]. + reparentedSubclassNames ifNotEmpty: [ + stream + space; + nextPutAll: 'Reparented subclasses: '; + nextPutAll: (', ' join: reparentedSubclassNames); + nextPut: $. ]. + removedPackageNames ifNotEmpty: [ + stream + space; + nextPutAll: 'Removed packages: '; + nextPutAll: (', ' join: removedPackageNames); + nextPut: $. ] ] ] { #category : 'metadata' } diff --git a/src/MCP/MCPToolRemoveMethods.class.st b/src/MCP/MCPToolRemoveMethods.class.st index b8fe06b..10506e3 100644 --- a/src/MCP/MCPToolRemoveMethods.class.st +++ b/src/MCP/MCPToolRemoveMethods.class.st @@ -109,27 +109,27 @@ MCPToolRemoveMethods >> executeWithRequest: request [ ^ self executeParsedRequestFrom: request do: [ :removeRequest | - | result | - result := (self commandForRequest: removeRequest) execute. - self - successResultText: (self - successSummaryForClassName: result className - classSide: result classSide - selectors: result selectors) - data: result asDictionary - warnings: result warningMessages ] + | result | + result := (self commandForRequest: removeRequest) execute. + self + successResultText: (self + successSummaryForClassName: result className + classSide: result classSide + selectors: result selectors) + data: result asDictionary + warnings: result warningMessages ] onError: [ :error :removeRequest | - self - errorResultForError: error - className: (self - classNameForErrorFromParsedRequest: removeRequest - rawRequest: request) - classSide: (self - classSideForErrorFromParsedRequest: removeRequest - rawRequest: request) - selectors: (self - selectorsForErrorFromParsedRequest: removeRequest - rawRequest: request) ] + self + errorResultForError: error + className: (self + classNameForErrorFromParsedRequest: removeRequest + rawRequest: request) + classSide: (self + classSideForErrorFromParsedRequest: removeRequest + rawRequest: request) + selectors: (self + selectorsForErrorFromParsedRequest: removeRequest + rawRequest: request) ] ] { #category : 'private' } @@ -140,15 +140,15 @@ MCPToolRemoveMethods >> failureMessageForClassNamed: className classSide: classS ifTrue: [ className , ' class' ] ifFalse: [ className ]. ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to remove methods from '; - nextPutAll: targetName; - nextPutAll: ': '; - nextPutAll: (', ' join: selectors); - nextPutAll: ' ('; - nextPutAll: anError class name; - nextPutAll: '): '; - nextPutAll: anError messageText ] + stream + nextPutAll: 'Unable to remove methods from '; + nextPutAll: targetName; + nextPutAll: ': '; + nextPutAll: (', ' join: selectors); + nextPutAll: ' ('; + nextPutAll: anError class name; + nextPutAll: '): '; + nextPutAll: anError messageText ] ] { #category : 'private' } diff --git a/src/MCP/MCPToolRepositoryOperation.class.st b/src/MCP/MCPToolRepositoryOperation.class.st index a35c1a7..57e097d 100644 --- a/src/MCP/MCPToolRepositoryOperation.class.st +++ b/src/MCP/MCPToolRepositoryOperation.class.st @@ -65,8 +65,8 @@ MCPToolRepositoryOperation >> errorResultForCommandError: anError action: action | details | details := anError structuredDetails copy. requestedContext ifNotNil: [ - requestedContext keysAndValuesDo: [ :key :value | - value ifNotNil: [ details at: key ifAbsentPut: [ value ] ] ] ]. + requestedContext keysAndValuesDo: [ :key :value | + value ifNotNil: [ details at: key ifAbsentPut: [ value ] ] ] ]. details at: #action put: action. ^ self errorResultText: anError messageText details: details ] @@ -78,9 +78,7 @@ MCPToolRepositoryOperation >> inputProperties [ at: #referenceInputProperties ifAbsent: [ self repositoryReferenceInputProperties ]) , - (self repositoryToolSpec - at: #inputProperties - ifAbsent: [ #( ) ]) + (self repositoryToolSpec at: #inputProperties ifAbsent: [ #( ) ]) ] { #category : 'private - schema' } diff --git a/src/MCP/MCPToolRequest.class.st b/src/MCP/MCPToolRequest.class.st index 298cd3c..a9d6c81 100644 --- a/src/MCP/MCPToolRequest.class.st +++ b/src/MCP/MCPToolRequest.class.st @@ -195,8 +195,8 @@ MCPToolRequest >> stringCollectionFrom: aValue [ aValue ifNil: [ ^ #( ) ]. values := OrderedCollection new. aValue do: [ :each | - (self stringValue: each) ifNotNil: [ :normalized | - values add: normalized ] ]. + (self stringValue: each) ifNotNil: [ :normalized | + values add: normalized ] ]. ^ values asArray ] diff --git a/src/MCP/MCPToolRewriteMethods.class.st b/src/MCP/MCPToolRewriteMethods.class.st index 3474708..24efe39 100644 --- a/src/MCP/MCPToolRewriteMethods.class.st +++ b/src/MCP/MCPToolRewriteMethods.class.st @@ -69,10 +69,10 @@ MCPToolRewriteMethods >> executeWithRequest: request [ do: [ :rewriteRequest | (self commandForRequest: rewriteRequest) execute ] onError: [ :error :rewriteRequest | - self - errorResultForRewriteError: error - request: rewriteRequest - rawRequest: request ] + self + errorResultForRewriteError: error + request: rewriteRequest + rawRequest: request ] ] { #category : 'private - execution' } @@ -257,7 +257,7 @@ MCPToolRewriteMethods >> validateRequest: request [ ((request booleanArgumentNamed: 'apply' default: false) and: [ (request hasArgumentNamed: 'expectedChangeSetHash') not ]) ifTrue: [ - MCPInvalidToolInput - signalMissingRequiredArgumentNamed: 'expectedChangeSetHash' - forTool: self ] + MCPInvalidToolInput + signalMissingRequiredArgumentNamed: 'expectedChangeSetHash' + forTool: self ] ] diff --git a/src/MCP/MCPToolRunTestCoverage.class.st b/src/MCP/MCPToolRunTestCoverage.class.st index 52f3eab..5bd3bc5 100644 --- a/src/MCP/MCPToolRunTestCoverage.class.st +++ b/src/MCP/MCPToolRunTestCoverage.class.st @@ -20,26 +20,27 @@ MCPToolRunTestCoverage >> buildInputSchema [ | timeoutProperty | timeoutProperty := self - integerSchemaPropertyNamed: 'timeoutSeconds' - description: 'Timeout seconds; 0 returns immediately.' - default: self defaultTimeoutSeconds. + integerSchemaPropertyNamed: 'timeoutSeconds' + description: + 'Timeout seconds; 0 returns immediately.' + default: self defaultTimeoutSeconds. timeoutProperty minimum: 0. ^ MCPStructureInputSchema new - type: 'object'; - properties: self testSelectionInputProperties , { - self coverageOptionsObjectSchema. - timeoutProperty }; - required: #( 'coverage' ); - yourself + type: 'object'; + properties: self testSelectionInputProperties , { + self coverageOptionsObjectSchema. + timeoutProperty }; + required: #( 'coverage' ); + yourself ] { #category : 'metadata' } MCPToolRunTestCoverage >> buildOutputSchema [ ^ self - standardOutputSchemaForDataProperties: - self testRunDataProperties , { self coverageResultObjectSchema } - required: #( 'runCount' 'passedCount' 'coverage' ) + standardOutputSchemaForDataProperties: + self testRunDataProperties , { self coverageResultObjectSchema } + required: #( 'runCount' 'passedCount' 'coverage' ) ] { #category : 'metadata' } diff --git a/src/MCP/MCPToolRunTests.class.st b/src/MCP/MCPToolRunTests.class.st index 5ac56eb..4da250a 100644 --- a/src/MCP/MCPToolRunTests.class.st +++ b/src/MCP/MCPToolRunTests.class.st @@ -24,22 +24,24 @@ MCPToolRunTests >> buildInputSchema [ | timeoutProperty | timeoutProperty := self - integerSchemaPropertyNamed: 'timeoutSeconds' - description: 'Timeout seconds; 0 returns immediately.' - default: self defaultTimeoutSeconds. + integerSchemaPropertyNamed: 'timeoutSeconds' + description: + 'Timeout seconds; 0 returns immediately.' + default: self defaultTimeoutSeconds. timeoutProperty minimum: 0. ^ MCPStructureInputSchema new - type: 'object'; - properties: self testSelectionInputProperties , { timeoutProperty }; - yourself + type: 'object'; + properties: + self testSelectionInputProperties , { timeoutProperty }; + yourself ] { #category : 'metadata' } MCPToolRunTests >> buildOutputSchema [ ^ self - standardOutputSchemaForDataProperties: self testRunDataProperties - required: #( 'runCount' 'passedCount' ) + standardOutputSchemaForDataProperties: self testRunDataProperties + required: #( 'runCount' 'passedCount' ) ] { #category : 'private - execution' } @@ -228,16 +230,17 @@ MCPToolRunTests >> description [ MCPToolRunTests >> errorResultForError: anError testNames: testNames [ ^ anError - mcpCommandErrorDo: [ :commandError | - self - errorResultText: commandError messageText - details: commandError structuredDetails ] - otherwise: [ :toolError | - self - errorResultText: (self failureMessageForTestNames: testNames error: toolError) - details: { - (#errorClass -> toolError class name). - (#message -> toolError messageText) } asDictionary ] + mcpCommandErrorDo: [ :commandError | + self + errorResultText: commandError messageText + details: commandError structuredDetails ] + otherwise: [ :toolError | + self + errorResultText: + (self failureMessageForTestNames: testNames error: toolError) + details: { + (#errorClass -> toolError class name). + (#message -> toolError messageText) } asDictionary ] ] { #category : 'executing' } @@ -262,16 +265,16 @@ MCPToolRunTests >> executeWithRequest: request [ MCPToolRunTests >> failureMessageForTestNames: testNames error: anError [ ^ String streamContents: [ :stream | - stream nextPutAll: 'Unable to run tests'. - testNames ifNotEmpty: [ - stream - nextPutAll: ': '; - nextPutAll: (', ' join: testNames) ]. - stream - nextPutAll: ' ('; - nextPutAll: anError class name; - nextPutAll: '): '; - nextPutAll: anError messageText ] + stream nextPutAll: 'Unable to run tests'. + testNames ifNotEmpty: [ + stream + nextPutAll: ': '; + nextPutAll: (', ' join: testNames) ]. + stream + nextPutAll: ' ('; + nextPutAll: anError class name; + nextPutAll: '): '; + nextPutAll: anError messageText ] ] { #category : 'private - request' } @@ -284,8 +287,8 @@ MCPToolRunTests >> parsedRequestFromToolRequest: request [ MCPToolRunTests >> rawStringCollectionNamed: argumentName fromRequest: rawRequest [ | value | - value := rawRequest argumentNamed: argumentName ifAbsent: [ ^ #( ) ]. - value isArray ifFalse: [ ^ #( ) ]. + value := rawRequest argumentNamed: argumentName ifAbsent: [ ^ #( ) ]. + value isArray ifFalse: [ ^ #( ) ]. ^ (value collect: [ :each | each asString ]) asArray ] @@ -293,9 +296,10 @@ MCPToolRunTests >> rawStringCollectionNamed: argumentName fromRequest: rawReques MCPToolRunTests >> rawTestNamesFromRequest: rawRequest [ ^ Array streamContents: [ :stream | - #( 'packages' 'classes' 'methods' ) do: [ :argumentName | - (self rawStringCollectionNamed: argumentName fromRequest: rawRequest) do: [ :each | - stream nextPut: each ] ] ] + #( 'packages' 'classes' 'methods' ) do: [ :argumentName | + (self + rawStringCollectionNamed: argumentName + fromRequest: rawRequest) do: [ :each | stream nextPut: each ] ] ] ] { #category : 'private' } @@ -304,84 +308,84 @@ MCPToolRunTests >> successSummaryForData: data [ | coverage errorCount failureCount passedCount runCount skippedCount timedOut unrunCount | runCount := data at: #runCount. passedCount := data at: #passedCount. - skippedCount := (data at: #skipped ifAbsent: [ #( ) ]) size. - failureCount := (data at: #failures ifAbsent: [ #( ) ]) size. - errorCount := (data at: #errors ifAbsent: [ #( ) ]) size. + skippedCount := (data at: #skipped ifAbsent: [ #( ) ]) size. + failureCount := (data at: #failures ifAbsent: [ #( ) ]) size. + errorCount := (data at: #errors ifAbsent: [ #( ) ]) size. timedOut := data at: #timedOut ifAbsent: [ false ]. - unrunCount := (data at: #unrunPackages ifAbsent: [ #( ) ]) size - + (data at: #unrunClasses ifAbsent: [ #( ) ]) size - + (data at: #unrunMethods ifAbsent: [ #( ) ]) size. + unrunCount := (data at: #unrunPackages ifAbsent: [ #( ) ]) size + + (data at: #unrunClasses ifAbsent: [ #( ) ]) size + + (data at: #unrunMethods ifAbsent: [ #( ) ]) size. coverage := data at: #coverage ifAbsent: [ nil ]. ^ String streamContents: [ :stream | - timedOut ifTrue: [ stream nextPutAll: 'Timed out. ' ]. - stream - nextPutAll: 'Ran '; - nextPutAll: runCount asString; - nextPutAll: ' tests ('; - nextPutAll: passedCount asString; - nextPutAll: ' passed'. - skippedCount > 0 ifTrue: [ - stream - nextPutAll: ', '; - nextPutAll: skippedCount asString; - nextPutAll: ' skipped' ]. - stream nextPutAll: ').'. - failureCount + errorCount > 0 ifTrue: [ - stream - space; - nextPutAll: failureCount asString; - nextPutAll: ' failures, '; - nextPutAll: errorCount asString; - nextPutAll: ' errors.' ]. - unrunCount > 0 ifTrue: [ - stream - space; - nextPutAll: unrunCount asString; - nextPutAll: ' selections left unrun.' ]. - coverage ifNotNil: [ :coverageData | - stream - space; - nextPutAll: 'Coverage: '; - nextPutAll: (self coveragePercentageTextFor: coverageData); - nextPutAll: '%.' ] ] + timedOut ifTrue: [ stream nextPutAll: 'Timed out. ' ]. + stream + nextPutAll: 'Ran '; + nextPutAll: runCount asString; + nextPutAll: ' tests ('; + nextPutAll: passedCount asString; + nextPutAll: ' passed'. + skippedCount > 0 ifTrue: [ + stream + nextPutAll: ', '; + nextPutAll: skippedCount asString; + nextPutAll: ' skipped' ]. + stream nextPutAll: ').'. + failureCount + errorCount > 0 ifTrue: [ + stream + space; + nextPutAll: failureCount asString; + nextPutAll: ' failures, '; + nextPutAll: errorCount asString; + nextPutAll: ' errors.' ]. + unrunCount > 0 ifTrue: [ + stream + space; + nextPutAll: unrunCount asString; + nextPutAll: ' selections left unrun.' ]. + coverage ifNotNil: [ :coverageData | + stream + space; + nextPutAll: 'Coverage: '; + nextPutAll: (self coveragePercentageTextFor: coverageData); + nextPutAll: '%.' ] ] ] { #category : 'private - tests' } MCPToolRunTests >> testIssueArraySchemaNamed: propertyName description: propertyDescription [ ^ (self - schemaPropertyNamed: propertyName - type: 'array' - description: propertyDescription) - items: self testIssueObjectSchema; - yourself + schemaPropertyNamed: propertyName + type: 'array' + description: propertyDescription) + items: self testIssueObjectSchema; + yourself ] { #category : 'private - tests' } MCPToolRunTests >> testIssueObjectSchema [ ^ MCPStructureProperties new - type: 'object'; - properties: { - (self - schemaPropertyNamed: 'test' - type: 'string' - description: 'Test reference.'). - (self - schemaPropertyNamed: 'message' - type: 'string' - description: 'Failure or error message.'). - (self - schemaPropertyNamed: 'errorClass' - type: 'string' - description: 'Error class.'). - (self - stringArraySchemaNamed: 'parameters' - description: 'Parameterized test values.' - itemDescription: nil) }; - required: #( 'test' ); - additionalProperties: false; - yourself + type: 'object'; + properties: { + (self + schemaPropertyNamed: 'test' + type: 'string' + description: 'Test reference.'). + (self + schemaPropertyNamed: 'message' + type: 'string' + description: 'Failure or error message.'). + (self + schemaPropertyNamed: 'errorClass' + type: 'string' + description: 'Error class.'). + (self + stringArraySchemaNamed: 'parameters' + description: 'Parameterized test values.' + itemDescription: nil) }; + required: #( 'test' ); + additionalProperties: false; + yourself ] { #category : 'private - errors' } @@ -402,55 +406,55 @@ MCPToolRunTests >> testNamesFromRequests: testRequests [ MCPToolRunTests >> testRunDataProperties [ ^ { - (self - integerSchemaPropertyNamed: 'runCount' - description: 'Tests run.'). - (self - integerSchemaPropertyNamed: 'passedCount' - description: 'Tests passed.'). - (self - stringArraySchemaNamed: 'skipped' - description: 'Skipped tests.' - itemDescription: nil). - (self - testIssueArraySchemaNamed: 'failures' - description: 'Failed tests.'). - (self - testIssueArraySchemaNamed: 'errors' - description: 'Errored tests.'). - (self - booleanSchemaPropertyNamed: 'timedOut' - description: 'Timeout stopped run.'). - (self - stringArraySchemaNamed: 'unrunPackages' - description: 'Unrun test packages.' - itemDescription: nil). - (self - stringArraySchemaNamed: 'unrunClasses' - description: 'Unrun test classes.' - itemDescription: nil). - (self - stringArraySchemaNamed: 'unrunMethods' - description: 'Unrun test methods.' - itemDescription: nil) } + (self + integerSchemaPropertyNamed: 'runCount' + description: 'Tests run.'). + (self + integerSchemaPropertyNamed: 'passedCount' + description: 'Tests passed.'). + (self + stringArraySchemaNamed: 'skipped' + description: 'Skipped tests.' + itemDescription: nil). + (self + testIssueArraySchemaNamed: 'failures' + description: 'Failed tests.'). + (self + testIssueArraySchemaNamed: 'errors' + description: 'Errored tests.'). + (self + booleanSchemaPropertyNamed: 'timedOut' + description: 'Timeout stopped run.'). + (self + stringArraySchemaNamed: 'unrunPackages' + description: 'Unrun test packages.' + itemDescription: nil). + (self + stringArraySchemaNamed: 'unrunClasses' + description: 'Unrun test classes.' + itemDescription: nil). + (self + stringArraySchemaNamed: 'unrunMethods' + description: 'Unrun test methods.' + itemDescription: nil) } ] { #category : 'private - tests' } MCPToolRunTests >> testSelectionInputProperties [ ^ { - (self - stringArraySchemaNamed: 'packages' - description: 'Test packages run.' - itemDescription: nil). - (self - stringArraySchemaNamed: 'classes' - description: 'Test classes run.' - itemDescription: nil). - (self - stringArraySchemaNamed: 'methods' - description: 'Test methods as Class>>#selector.' - itemDescription: nil) } + (self + stringArraySchemaNamed: 'packages' + description: 'Test packages run.' + itemDescription: nil). + (self + stringArraySchemaNamed: 'classes' + description: 'Test classes run.' + itemDescription: nil). + (self + stringArraySchemaNamed: 'methods' + description: 'Test methods as Class>>#selector.' + itemDescription: nil) } ] { #category : 'metadata' } diff --git a/src/MCP/MCPToolSearch.class.st b/src/MCP/MCPToolSearch.class.st index 157e6e8..d7ff006 100644 --- a/src/MCP/MCPToolSearch.class.st +++ b/src/MCP/MCPToolSearch.class.st @@ -53,8 +53,8 @@ MCPToolSearch >> classAndMethodScopeSummaryFromAssociations: scopeAssociations [ | labels | labels := OrderedCollection new. scopeAssociations do: [ :eachAssociation | - eachAssociation value notEmpty ifTrue: [ - self addScopeLabel: eachAssociation key to: labels ] ]. + eachAssociation value notEmpty ifTrue: [ + self addScopeLabel: eachAssociation key to: labels ] ]. ^ self scopeSummaryFromLabels: labels ] @@ -160,23 +160,23 @@ MCPToolSearch >> executeWithRequest: request [ ^ self executeParsedRequestFrom: request do: [ :queryRequest | - | command page | - command := self commandForRequest: queryRequest. - page := self - queryPageForEntries: command execute - limit: (self limitFromQueryRequest: queryRequest) - offset: (self offsetFromQueryRequest: queryRequest). - self - successResultText: - (self successSummaryForQueryRequest: queryRequest page: page) - data: - (self queryResultDataForQueryRequest: queryRequest page: page) - warnings: (self warningsForQueryRequest: queryRequest) ] + | command page | + command := self commandForRequest: queryRequest. + page := self + queryPageForEntries: command execute + limit: (self limitFromQueryRequest: queryRequest) + offset: (self offsetFromQueryRequest: queryRequest). + self + successResultText: + (self successSummaryForQueryRequest: queryRequest page: page) + data: + (self queryResultDataForQueryRequest: queryRequest page: page) + warnings: (self warningsForQueryRequest: queryRequest) ] onError: [ :error :ignored | - self - errorResultForQueryError: error - requestedContext: - (self requestedContextForErrorFromRequest: request) ] + self + errorResultForQueryError: error + requestedContext: + (self requestedContextForErrorFromRequest: request) ] ] { #category : 'private - template' } @@ -286,27 +286,27 @@ MCPToolSearch >> matcherForPattern: aPattern mode: aMode caseSensitive: aBoolean | normalizedPattern regex | aPattern ifNil: [ ^ [ :candidate | true ] ]. aMode = 'regex' ifTrue: [ - regex := aBoolean - ifTrue: [ aPattern asRegex ] - ifFalse: [ aPattern asRegexIgnoringCase ]. - ^ [ :candidate | - regex search: - (candidate ifNil: [ '' ] ifNotNil: [ candidate asString ]) ] ]. + regex := aBoolean + ifTrue: [ aPattern asRegex ] + ifFalse: [ aPattern asRegexIgnoringCase ]. + ^ [ :candidate | + regex search: + (candidate ifNil: [ '' ] ifNotNil: [ candidate asString ]) ] ]. normalizedPattern := self normalizeFilterString: aPattern caseSensitive: aBoolean. aMode = 'substring' ifTrue: [ - ^ [ :candidate | - (self normalizeFilterString: candidate caseSensitive: aBoolean) - includesSubstring: normalizedPattern ] ]. + ^ [ :candidate | + (self normalizeFilterString: candidate caseSensitive: aBoolean) + includesSubstring: normalizedPattern ] ]. aMode = 'prefix' ifTrue: [ - ^ [ :candidate | - (self normalizeFilterString: candidate caseSensitive: aBoolean) - beginsWith: normalizedPattern ] ]. + ^ [ :candidate | + (self normalizeFilterString: candidate caseSensitive: aBoolean) + beginsWith: normalizedPattern ] ]. aMode = 'exact' ifTrue: [ - ^ [ :candidate | - (self normalizeFilterString: candidate caseSensitive: aBoolean) - = normalizedPattern ] ]. + ^ [ :candidate | + (self normalizeFilterString: candidate caseSensitive: aBoolean) + = normalizedPattern ] ]. Error signal: 'Unsupported filter mode: ' , aMode ] @@ -431,7 +431,10 @@ MCPToolSearch >> queryInputSchemaWithProperties: inputProperties [ { #category : 'private - pagination' } MCPToolSearch >> queryPageForEntries: entries limit: limit offset: offset [ - ^ MCPPaginationResult fromEntries: entries limit: limit offset: offset + ^ MCPPaginationResult + fromEntries: entries + limit: limit + offset: offset ] { #category : 'private - template' } @@ -464,15 +467,15 @@ MCPToolSearch >> requestedContextFromRequest: request [ MCPToolSearch >> scopeQueryFailureMessageFor: resultKind scope: scopeSummary error: anError [ ^ String streamContents: [ :stream | - stream - nextPutAll: 'Unable to query '; - nextPutAll: resultKind; - nextPutAll: ' [scope='; - nextPutAll: scopeSummary; - nextPutAll: '] ('; - nextPutAll: anError class name; - nextPutAll: '): '; - nextPutAll: anError messageText ] + stream + nextPutAll: 'Unable to query '; + nextPutAll: resultKind; + nextPutAll: ' [scope='; + nextPutAll: scopeSummary; + nextPutAll: '] ('; + nextPutAll: anError class name; + nextPutAll: '): '; + nextPutAll: anError messageText ] ] { #category : 'private - results' } @@ -498,9 +501,9 @@ MCPToolSearch >> scopeSummaryFromLabels: labels [ labels ifEmpty: [ ^ 'image' ]. ^ String streamContents: [ :stream | - labels doWithIndex: [ :each :index | - index > 1 ifTrue: [ stream nextPut: $+ ]. - stream nextPutAll: each ] ] + labels doWithIndex: [ :each :index | + index > 1 ifTrue: [ stream nextPut: $+ ]. + stream nextPutAll: each ] ] ] { #category : 'private - template' } @@ -551,9 +554,10 @@ MCPToolSearch >> searchScopeStringCollectionNamed: aName fromRequest: request [ MCPToolSearch >> successSummaryForQueryRequest: queryRequest page: page [ ^ self - successSummaryForScope: - (self classAndMethodScopeSummaryForScopeQuery: queryRequest scopeQuery) - page: page + successSummaryForScope: + (self classAndMethodScopeSummaryForScopeQuery: + queryRequest scopeQuery) + page: page ] { #category : 'private - results' } diff --git a/src/MCP/MCPToolSearchRepositories.class.st b/src/MCP/MCPToolSearchRepositories.class.st index e0cf486..bfbb11e 100644 --- a/src/MCP/MCPToolSearchRepositories.class.st +++ b/src/MCP/MCPToolSearchRepositories.class.st @@ -273,8 +273,8 @@ MCPToolSearchRepositories >> repositoryScopeSummaryForAssociations: scopeAssocia | labels | labels := OrderedCollection new. scopeAssociations do: [ :eachAssociation | - eachAssociation value ifTrue: [ - self addScopeLabel: eachAssociation key to: labels ] ]. + eachAssociation value ifTrue: [ + self addScopeLabel: eachAssociation key to: labels ] ]. ^ self scopeSummaryFromLabels: labels ] diff --git a/src/MCP/MCPToolUpdateDebugMethod.class.st b/src/MCP/MCPToolUpdateDebugMethod.class.st index 4d333a9..e5a71e3 100644 --- a/src/MCP/MCPToolUpdateDebugMethod.class.st +++ b/src/MCP/MCPToolUpdateDebugMethod.class.st @@ -91,7 +91,8 @@ MCPToolUpdateDebugMethod >> buildOutputSchema [ (self schemaPropertyNamed: 'stateId' type: 'string' - description: 'Debug state token after the update/proceed cycle.'). + description: + 'Debug state token after the update/proceed cycle.'). (self schemaPropertyNamed: 'frameRef' type: 'string' @@ -143,7 +144,8 @@ MCPToolUpdateDebugMethod >> buildOutputSchema [ (self schemaPropertyNamed: 'repairActions' type: 'array' - description: 'Repair actions still available after the update.'). + description: + 'Repair actions still available after the update.'). (self stringArraySchemaNamed: 'warnings' description: 'Update-specific warnings.' diff --git a/src/MCP/MCPUpdateClassCommand.class.st b/src/MCP/MCPUpdateClassCommand.class.st index c78ea2e..6df8962 100644 --- a/src/MCP/MCPUpdateClassCommand.class.st +++ b/src/MCP/MCPUpdateClassCommand.class.st @@ -42,10 +42,10 @@ MCPUpdateClassCommand >> execute [ [ plan := self updatePlan ] on: MCPCommandError do: [ :error | - ^ self tool - errorResultForCommandError: error - action: 'update' - requestedContext: self validationContext ]. + ^ self tool + errorResultForCommandError: error + action: 'update' + requestedContext: self validationContext ]. ^ self executePlan: plan ] @@ -58,27 +58,27 @@ MCPUpdateClassCommand >> executeAddSlotWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPAddSlotCommand - className: self classRequest className - slotName: self classRequest slotName - classSide: self classRequest classSide) execute ] + result := (MCPAddSlotCommand + className: self classRequest className + slotName: self classRequest slotName + classSide: self classRequest classSide) execute ] successResult: [ :warningMessages | - self tool - successResultText: 'Added ' - , - (self tool slotDescriptionForClassSide: - self classRequest classSide) , ' ' - , self classRequest slotName , ' to class ' - , self classRequest className , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: 'Added ' + , + (self tool slotDescriptionForClassSide: + self classRequest classSide) , ' ' + , self classRequest slotName , ' to class ' + , self classRequest className , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForAddSlotNamed: self classRequest slotName - onClassNamed: self classRequest className - classSide: self classRequest classSide - error: error ] + self tool + failureMessageForAddSlotNamed: self classRequest slotName + onClassNamed: self classRequest className + classSide: self classRequest classSide + error: error ] ] { #category : 'private - planning' } @@ -119,25 +119,25 @@ MCPUpdateClassCommand >> executeMoveSlotAction: operation withPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPMoveSlotCommand - className: self classRequest className - slotName: self classRequest slotName - direction: operation - classSide: self classRequest classSide) execute ] + result := (MCPMoveSlotCommand + className: self classRequest className + slotName: self classRequest slotName + direction: operation + classSide: self classRequest classSide) execute ] successResult: [ :warningMessages | - self tool - successResultText: - (self successMessageForMoveSlotAction: operation) - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + (self successMessageForMoveSlotAction: operation) + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForMoveSlotNamed: self classRequest slotName - onClassNamed: self classRequest className - classSide: self classRequest classSide - operation: operation - error: error ] + self tool + failureMessageForMoveSlotNamed: self classRequest slotName + onClassNamed: self classRequest className + classSide: self classRequest classSide + operation: operation + error: error ] ] { #category : 'executing - class' } @@ -150,24 +150,24 @@ MCPUpdateClassCommand >> executeMoveWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPMoveClassCommand - className: self classRequest className - packageName: packageName - tag: self classRequest tag) execute ] + result := (MCPMoveClassCommand + className: self classRequest className + packageName: packageName + tag: self classRequest tag) execute ] successResult: [ :warningMessages | - self tool - successResultText: - 'Moved class ' , self classRequest className , ' to package ' - , packageName , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Moved class ' , self classRequest className , ' to package ' + , packageName , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForMoveClassNamed: self classRequest className - packageName: packageName - tag: self classRequest tag - error: error ] + self tool + failureMessageForMoveClassNamed: self classRequest className + packageName: packageName + tag: self classRequest tag + error: error ] ] { #category : 'executing' } @@ -208,27 +208,27 @@ MCPUpdateClassCommand >> executeRemoveSlotWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPRemoveSlotCommand - className: self classRequest className - slotName: self classRequest slotName - classSide: self classRequest classSide) execute ] + result := (MCPRemoveSlotCommand + className: self classRequest className + slotName: self classRequest slotName + classSide: self classRequest classSide) execute ] successResult: [ :warningMessages | - self tool - successResultText: 'Removed ' - , - (self tool slotDescriptionForClassSide: - self classRequest classSide) , ' ' - , self classRequest slotName , ' from class ' - , self classRequest className , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: 'Removed ' + , + (self tool slotDescriptionForClassSide: + self classRequest classSide) , ' ' + , self classRequest slotName , ' from class ' + , self classRequest className , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForRemoveSlotNamed: self classRequest slotName - onClassNamed: self classRequest className - classSide: self classRequest classSide - error: error ] + self tool + failureMessageForRemoveSlotNamed: self classRequest slotName + onClassNamed: self classRequest className + classSide: self classRequest classSide + error: error ] ] { #category : 'executing - slot' } @@ -240,27 +240,27 @@ MCPUpdateClassCommand >> executeRenameSlotWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPRenameSlotCommand - className: self classRequest className - slotName: self classRequest slotName - newSlotName: self classRequest newSlotName - classSide: self classRequest classSide) execute ] + result := (MCPRenameSlotCommand + className: self classRequest className + slotName: self classRequest slotName + newSlotName: self classRequest newSlotName + classSide: self classRequest classSide) execute ] successResult: [ :warningMessages | - self tool - successResultText: - 'Renamed slot ' , self classRequest slotName , ' to ' - , self classRequest newSlotName , ' in class ' - , self classRequest className , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Renamed slot ' , self classRequest slotName , ' to ' + , self classRequest newSlotName , ' in class ' + , self classRequest className , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForRenameSlotNamed: self classRequest slotName - to: self classRequest newSlotName - onClassNamed: self classRequest className - classSide: self classRequest classSide - error: error ] + self tool + failureMessageForRenameSlotNamed: self classRequest slotName + to: self classRequest newSlotName + onClassNamed: self classRequest className + classSide: self classRequest classSide + error: error ] ] { #category : 'executing - class' } @@ -272,29 +272,29 @@ MCPUpdateClassCommand >> executeRenameWithPlan: plan [ force: self classRequest force 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 ] + 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 ] successResult: [ :warningMessages | - self tool - successResultText: - 'Renamed class ' , self classRequest className , ' to ' - , self classRequest newClassName , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Renamed class ' , self classRequest className , ' to ' + , self classRequest newClassName , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForRenameClassNamed: self classRequest className - to: self classRequest newClassName - error: error ] + self tool + failureMessageForRenameClassNamed: self classRequest className + to: self classRequest newClassName + error: error ] ] { #category : 'executing - class' } @@ -306,23 +306,24 @@ MCPUpdateClassCommand >> executeReparentWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPReparentClassCommand - className: self classRequest className - superclassName: self classRequest superclassName) - execute ] + result := (MCPReparentClassCommand + className: self classRequest className + superclassName: self classRequest superclassName) + execute ] successResult: [ :warningMessages | - self tool - successResultText: - 'Reparented class ' , self classRequest className - , ' to superclass ' , self classRequest superclassName , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Reparented class ' , self classRequest className + , ' to superclass ' , self classRequest superclassName , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForReparentClassNamed: self classRequest className - superclassName: self classRequest superclassName - error: error ] + self tool + failureMessageForReparentClassNamed: + self classRequest className + superclassName: self classRequest superclassName + error: error ] ] { #category : 'executing - class' } @@ -334,23 +335,23 @@ MCPUpdateClassCommand >> executeReplaceClassTraitsWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPReplaceClassSideTraitsCommand - className: self classRequest className - classTraitNames: self classRequest classTraits) - execute ] + result := (MCPReplaceClassSideTraitsCommand + className: self classRequest className + classTraitNames: self classRequest classTraits) + execute ] successResult: [ :warningMessages | - self tool - successResultText: - 'Replaced class-side traits for class ' - , self classRequest className , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Replaced class-side traits for class ' + , self classRequest className , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForReplaceClassTraitsOnClassNamed: - self classRequest className - error: error ] + self tool + failureMessageForReplaceClassTraitsOnClassNamed: + self classRequest className + error: error ] ] { #category : 'executing - class' } @@ -371,18 +372,18 @@ MCPUpdateClassCommand >> executeReplaceDefinitionWithPlan: plan [ requestedContext: plan requestedContext work: [ result := command execute ] successResult: [ :warningMessages | - self tool - successResultText: - 'Replaced slot definition for class ' - , self classRequest className , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Replaced slot definition for class ' + , self classRequest className , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForReplaceDefinitionOnClassNamed: - self classRequest className - error: error ] + self tool + failureMessageForReplaceDefinitionOnClassNamed: + self classRequest className + error: error ] ] { #category : 'executing - class' } @@ -394,21 +395,22 @@ MCPUpdateClassCommand >> executeReplaceLayoutWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPReplaceClassLayoutCommand - className: self classRequest className - layout: self classRequest layout) execute ] + result := (MCPReplaceClassLayoutCommand + className: self classRequest className + layout: self classRequest layout) execute ] successResult: [ :warningMessages | - self tool - successResultText: - 'Replaced layout for class ' , self classRequest className , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Replaced layout for class ' , self classRequest className + , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForReplaceLayoutOnClassNamed: - self classRequest className - error: error ] + self tool + failureMessageForReplaceLayoutOnClassNamed: + self classRequest className + error: error ] ] { #category : 'executing - class' } @@ -420,23 +422,23 @@ MCPUpdateClassCommand >> executeReplaceSharedPoolsWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPReplaceClassSharedPoolsCommand - className: self classRequest className - sharedPoolNames: self classRequest sharedPools) - execute ] + result := (MCPReplaceClassSharedPoolsCommand + className: self classRequest className + sharedPoolNames: self classRequest sharedPools) + execute ] successResult: [ :warningMessages | - self tool - successResultText: - 'Replaced shared pools for class ' , self classRequest className - , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Replaced shared pools for class ' + , self classRequest className , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForReplaceSharedPoolsOnClassNamed: - self classRequest className - error: error ] + self tool + failureMessageForReplaceSharedPoolsOnClassNamed: + self classRequest className + error: error ] ] { #category : 'executing - class' } @@ -448,23 +450,23 @@ MCPUpdateClassCommand >> executeReplaceSharedVariablesWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPReplaceClassSharedVariablesCommand - className: self classRequest className - sharedVariableNames: - self classRequest sharedVariables) execute ] + result := (MCPReplaceClassSharedVariablesCommand + className: self classRequest className + sharedVariableNames: + self classRequest sharedVariables) execute ] successResult: [ :warningMessages | - self tool - successResultText: - 'Replaced shared variables for class ' - , self classRequest className , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Replaced shared variables for class ' + , self classRequest className , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForReplaceSharedVariablesOnClassNamed: - self classRequest className - error: error ] + self tool + failureMessageForReplaceSharedVariablesOnClassNamed: + self classRequest className + error: error ] ] { #category : 'executing - class' } @@ -476,21 +478,22 @@ MCPUpdateClassCommand >> executeReplaceTraitsWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPReplaceClassTraitsCommand - className: self classRequest className - traitNames: self classRequest traits) execute ] + result := (MCPReplaceClassTraitsCommand + className: self classRequest className + traitNames: self classRequest traits) execute ] successResult: [ :warningMessages | - self tool - successResultText: - 'Replaced traits for class ' , self classRequest className , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Replaced traits for class ' , self classRequest className + , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForReplaceTraitsOnClassNamed: - self classRequest className - error: error ] + self tool + failureMessageForReplaceTraitsOnClassNamed: + self classRequest className + error: error ] ] { #category : 'executing - class' } @@ -502,21 +505,22 @@ MCPUpdateClassCommand >> executeSetCommentWithPlan: plan [ force: self classRequest force requestedContext: plan requestedContext work: [ - result := (MCPChangeClassCommentCommand - className: self classRequest className - classComment: self classRequest classComment) execute ] + result := (MCPChangeClassCommentCommand + className: self classRequest className + classComment: self classRequest classComment) + execute ] successResult: [ :warningMessages | - self tool - successResultText: - 'Set comment for class ' , self classRequest className , '.' - data: (self tool dataForAppliedUpdateResult: - (self appliedUpdateResultFor: result plan: plan)) - warnings: warningMessages ] + self tool + successResultText: + 'Set comment for class ' , self classRequest className , '.' + data: (self tool dataForAppliedUpdateResult: + (self appliedUpdateResultFor: result plan: plan)) + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForSetCommentOnClassNamed: - self classRequest className - error: error ] + self tool + failureMessageForSetCommentOnClassNamed: + self classRequest className + error: error ] ] { #category : 'initialization' } @@ -550,12 +554,12 @@ 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 ]. + context := self classRequest requestedContext. + self tool + addRefactoringScopeContextFromSpec: + self classRequest refactoringScopeSpec + toRequestedContext: context. + ^ context ]. action = 'renameSlot' ifTrue: [ ^ self classRequest renameSlotRequestedContext ]. (#( 'addSlot' 'removeSlot' 'pullUpSlot' 'pushDownSlot' ) includes: @@ -592,8 +596,8 @@ MCPUpdateClassCommand >> successMessageForMoveSlotAction: operation [ slotDescription := self tool slotDescriptionForClassSide: self classRequest classSide. operation = 'pullUpSlot' ifTrue: [ - ^ 'Pulled up ' , slotDescription , ' ' , self classRequest slotName - , ' to class ' , self classRequest className , '.' ]. + ^ 'Pulled up ' , slotDescription , ' ' , self classRequest slotName + , ' to class ' , self classRequest className , '.' ]. ^ 'Pushed down ' , slotDescription , ' ' , self classRequest slotName , ' from class ' , self classRequest className , '.' ] diff --git a/src/MCP/MCPUpdateDebugMethodCommand.class.st b/src/MCP/MCPUpdateDebugMethodCommand.class.st index 21ffaa9..e835ca0 100644 --- a/src/MCP/MCPUpdateDebugMethodCommand.class.st +++ b/src/MCP/MCPUpdateDebugMethodCommand.class.st @@ -57,8 +57,13 @@ MCPUpdateDebugMethodCommand >> compileForRecord: aRecord context: aContext updat updateKind: updateKind ]. (#( 'recompile' 'shouldBeImplemented' 'notYetImplemented' ) includes: updateKind) ifTrue: [ - ^ self recompileContext: aContext record: aRecord updateKind: updateKind ]. - ^ self signalUnsupportedUpdateForRecord: aRecord updateKind: updateKind + ^ self + recompileContext: aContext + record: aRecord + updateKind: updateKind ]. + ^ self + signalUnsupportedUpdateForRecord: aRecord + updateKind: updateKind ] { #category : 'private - compiling' } @@ -70,9 +75,9 @@ MCPUpdateDebugMethodCommand >> compileImplementationForRecord: aRecord context: messageForException: analyzer exception context: aContext. message ifNil: [ - ^ self - signalUnsupportedUpdateForRecord: aRecord - updateKind: updateKind ]. + ^ self + signalUnsupportedUpdateForRecord: aRecord + updateKind: updateKind ]. behavior := analyzer behaviorForContext: aContext. source := self methodSourceOrNil ifNil: [ analyzer @@ -148,7 +153,6 @@ MCPUpdateDebugMethodCommand >> compiledMethodForContext: aContext [ MCPUpdateDebugMethodCommand >> critiqueDataForMethod: aCompiledMethod [ ^ MCPToolCompileMethod new critiqueDataForMethod: aCompiledMethod - ] { #category : 'executing' } @@ -263,7 +267,8 @@ MCPUpdateDebugMethodCommand >> proceedContinuation: aContinuation forRecord: aRe aRecord debugSession: nil; continuation: nil; - advanceStateForStatus: 'completed' reason: 'debugMethodUpdateProceed'. + advanceStateForStatus: 'completed' + reason: 'debugMethodUpdateProceed'. ^ self proceedDataForCompletedAnswer: answer limit: aContinuation resultPreviewCharacterLimit ]. @@ -273,10 +278,14 @@ MCPUpdateDebugMethodCommand >> proceedContinuation: aContinuation forRecord: aRe advanceStateForStatus: 'paused' reason: 'capturedException'. ^ self proceedDataForOutcome: 'paused' timedOut: false ]. status = #paused ifTrue: [ - aRecord advanceStateForStatus: 'paused' reason: 'debugMethodUpdateProceed'. + aRecord + advanceStateForStatus: 'paused' + reason: 'debugMethodUpdateProceed'. ^ self proceedDataForOutcome: 'paused' timedOut: false ]. status = #running ifTrue: [ - aRecord advanceStateForStatus: 'running' reason: 'debugMethodUpdateProceed'. + aRecord + advanceStateForStatus: 'running' + reason: 'debugMethodUpdateProceed'. ^ self proceedDataForOutcome: 'running' timedOut: false ]. status = #timedOut ifTrue: [ aContinuation terminateWorker. @@ -288,7 +297,8 @@ MCPUpdateDebugMethodCommand >> proceedContinuation: aContinuation forRecord: aRe status = #terminated ifTrue: [ aRecord continuation: nil; - advanceStateForStatus: 'terminated' reason: 'debugMethodUpdateProceed'. + advanceStateForStatus: 'terminated' + reason: 'debugMethodUpdateProceed'. ^ self proceedDataForOutcome: 'terminated' timedOut: false ]. ^ self proceedDataForOutcome: status asString timedOut: false ] @@ -345,7 +355,9 @@ MCPUpdateDebugMethodCommand >> proceedDebugSessionForRecord: aRecord [ ^ self proceedDataForOutcome: 'unavailable' timedOut: false ]. [ aRecord debugSession resume. - aRecord advanceStateForStatus: 'running' reason: 'debugMethodUpdateProceed' ] + aRecord + advanceStateForStatus: 'running' + reason: 'debugMethodUpdateProceed' ] on: Exception do: [ :error | aRecord diff --git a/src/MCP/MCPUpdateMethodCommand.class.st b/src/MCP/MCPUpdateMethodCommand.class.st index ecb5941..877a699 100644 --- a/src/MCP/MCPUpdateMethodCommand.class.st +++ b/src/MCP/MCPUpdateMethodCommand.class.st @@ -24,10 +24,10 @@ MCPUpdateMethodCommand >> execute [ [ plan := self updatePlan ] on: MCPCommandError do: [ :error | - ^ self tool - errorResultForCommandError: error - action: 'update' - requestedContext: self request requestedContext ]. + ^ self tool + errorResultForCommandError: error + action: 'update' + requestedContext: self request requestedContext ]. ^ self executePlan: plan ] @@ -42,60 +42,60 @@ MCPUpdateMethodCommand >> executeAddArgumentsWithPlan: plan [ force: self request force requestedContext: plan requestedContext work: [ - behavior := self tool - behaviorNamed: self request className - classSide: self request classSide. - behavior compiledMethodAt: oldSelectorSymbol ifAbsent: [ - MCPCommandError - signalMissingMethodInClassName: self request className - classSide: self request classSide - selector: self request selector ]. - refactoringModel := self tool - refactoringModelForScopeSpec: - self request refactoringScopeSpec - anchoredAtBehavior: behavior. - oldMethodReference := self tool - methodReferenceForBehavior: behavior - selector: oldSelectorSymbol. - refactoring := self tool - addParameterRefactoringForSelector: - oldSelectorSymbol - inBehavior: behavior - to: newSelectorSymbol - permutation: self request permutation - newArgs: self request newArgumentSpecs - model: refactoringModel. - renameMap := self request argumentRenameMapForBehavior: behavior. - renameMap ifNotEmpty: [ refactoring renameMap: renameMap ]. - refactoring execute. - newCompiledMethod := self tool - reformattedMethodForBehavior: behavior - selector: newSelectorSymbol. - changeResult := (MCPMethodUpdateChangeResult - updateAction: 'addArguments' - method: newCompiledMethod) - oldSelector: self request selector; - newSelector: self request newSelector; - yourself ] + behavior := self tool + behaviorNamed: self request className + classSide: self request classSide. + behavior compiledMethodAt: oldSelectorSymbol ifAbsent: [ + MCPCommandError + signalMissingMethodInClassName: self request className + classSide: self request classSide + selector: self request selector ]. + refactoringModel := self tool + refactoringModelForScopeSpec: + self request refactoringScopeSpec + anchoredAtBehavior: behavior. + oldMethodReference := self tool + methodReferenceForBehavior: behavior + selector: oldSelectorSymbol. + refactoring := self tool + addParameterRefactoringForSelector: + oldSelectorSymbol + inBehavior: behavior + to: newSelectorSymbol + permutation: self request permutation + newArgs: self request newArgumentSpecs + model: refactoringModel. + renameMap := self request argumentRenameMapForBehavior: behavior. + renameMap ifNotEmpty: [ refactoring renameMap: renameMap ]. + refactoring execute. + newCompiledMethod := self tool + reformattedMethodForBehavior: behavior + selector: newSelectorSymbol. + changeResult := (MCPMethodUpdateChangeResult + updateAction: 'addArguments' + method: newCompiledMethod) + oldSelector: self request selector; + newSelector: self request newSelector; + yourself ] successResult: [ :warningMessages | - self tool - successResultText: - 'Added arguments to ' , oldMethodReference , ' as ' - , (self tool - methodReferenceForBehavior: behavior - selector: newSelectorSymbol) , '.' - data: - (self appliedUpdateResultFor: changeResult plan: plan) - asDictionary - warnings: warningMessages ] + self tool + successResultText: + 'Added arguments to ' , oldMethodReference , ' as ' + , (self tool + methodReferenceForBehavior: behavior + selector: newSelectorSymbol) , '.' + data: + (self appliedUpdateResultFor: changeResult plan: plan) + asDictionary + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForArgumentUpdateAction: 'addArguments' - classNamed: self request className - classSide: self request classSide - selector: self request selector - newSelector: self request newSelector - error: error ] + self tool + failureMessageForArgumentUpdateAction: 'addArguments' + classNamed: self request className + classSide: self request classSide + selector: self request selector + newSelector: self request newSelector + error: error ] ] { #category : 'private - planning' } @@ -122,48 +122,48 @@ MCPUpdateMethodCommand >> executeChangeProtocolWithPlan: plan [ force: self request force requestedContext: plan requestedContext work: [ - behavior := self tool - behaviorNamed: self request className - classSide: self request classSide. - oldCompiledMethod := behavior - compiledMethodAt: selectorSymbol - ifAbsent: [ - MCPCommandError - signalMissingMethodInClassName: - self request className - classSide: self request classSide - selector: self request selector ]. - oldProtocol := self protocolNameForMethod: oldCompiledMethod. - (RBMethodProtocolTransformation - protocol: self request protocol - inMethod: selectorSymbol - inClass: (self tool - classReferenceNameFor: self request className - classSide: self request classSide)) execute. - newCompiledMethod := behavior compiledMethodAt: selectorSymbol. - changeResult := (MCPMethodUpdateChangeResult - updateAction: 'changeProtocol' - method: newCompiledMethod) - oldProtocol: oldProtocol; - newProtocol: self request protocol; - yourself ] + behavior := self tool + behaviorNamed: self request className + classSide: self request classSide. + oldCompiledMethod := behavior + compiledMethodAt: selectorSymbol + ifAbsent: [ + MCPCommandError + signalMissingMethodInClassName: + self request className + classSide: self request classSide + selector: self request selector ]. + oldProtocol := self protocolNameForMethod: oldCompiledMethod. + (RBMethodProtocolTransformation + protocol: self request protocol + inMethod: selectorSymbol + inClass: (self tool + classReferenceNameFor: self request className + classSide: self request classSide)) execute. + newCompiledMethod := behavior compiledMethodAt: selectorSymbol. + changeResult := (MCPMethodUpdateChangeResult + updateAction: 'changeProtocol' + method: newCompiledMethod) + oldProtocol: oldProtocol; + newProtocol: self request protocol; + yourself ] successResult: [ :warningMessages | - self tool - successResultText: 'Changed protocol for ' , (self tool - methodReferenceForBehavior: behavior - selector: selectorSymbol) , '.' - data: - (self appliedUpdateResultFor: changeResult plan: plan) - asDictionary - warnings: warningMessages ] + self tool + successResultText: 'Changed protocol for ' , (self tool + methodReferenceForBehavior: behavior + selector: selectorSymbol) , '.' + data: + (self appliedUpdateResultFor: changeResult plan: plan) + asDictionary + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForChangeProtocolClassNamed: - self request className - classSide: self request classSide - selector: self request selector - protocol: self request protocol - error: error ] + self tool + failureMessageForChangeProtocolClassNamed: + self request className + classSide: self request classSide + selector: self request selector + protocol: self request protocol + error: error ] ] { #category : 'executing' } @@ -194,74 +194,74 @@ MCPUpdateMethodCommand >> executeRemoveArgumentsWithPlan: plan [ force: self request force requestedContext: plan requestedContext work: [ - behavior := self tool - behaviorNamed: self request className - classSide: self request classSide. - behavior compiledMethodAt: oldSelectorSymbol ifAbsent: [ - MCPCommandError - signalMissingMethodInClassName: self request className - classSide: self request classSide - selector: self request selector ]. - oldArgumentNames := (behavior parseTreeForSelector: - oldSelectorSymbol) argumentNames. - removedArgumentNames := self request - removedArgumentNamesInRemovalOrderFrom: - oldArgumentNames. - refactoringModel := self tool - refactoringModelForScopeSpec: - self request refactoringScopeSpec - anchoredAtBehavior: behavior. - oldMethodReference := self tool - methodReferenceForBehavior: behavior - selector: oldSelectorSymbol. - currentSelector := oldSelectorSymbol. - removedArgumentNames doWithIndex: [ :argumentName :index | - | nextSelector | - nextSelector := index = removedArgumentNames size - ifTrue: [ newSelectorSymbol ] - ifFalse: [ - self - selectorAfterRemovingArgumentNamed: - argumentName - fromBehavior: behavior - selector: currentSelector ]. - refactoring := self tool - removeParameterRefactoringForArgumentNamed: - argumentName - inBehavior: behavior - selector: currentSelector - model: refactoringModel. - refactoring newSelector: nextSelector. - refactoring execute. - currentSelector := nextSelector ]. - newCompiledMethod := self tool - reformattedMethodForBehavior: behavior - selector: newSelectorSymbol. - changeResult := (MCPMethodUpdateChangeResult - updateAction: 'removeArguments' - method: newCompiledMethod) - oldSelector: self request selector; - newSelector: self request newSelector; - yourself ] + behavior := self tool + behaviorNamed: self request className + classSide: self request classSide. + behavior compiledMethodAt: oldSelectorSymbol ifAbsent: [ + MCPCommandError + signalMissingMethodInClassName: self request className + classSide: self request classSide + selector: self request selector ]. + oldArgumentNames := (behavior parseTreeForSelector: + oldSelectorSymbol) argumentNames. + removedArgumentNames := self request + removedArgumentNamesInRemovalOrderFrom: + oldArgumentNames. + refactoringModel := self tool + refactoringModelForScopeSpec: + self request refactoringScopeSpec + anchoredAtBehavior: behavior. + oldMethodReference := self tool + methodReferenceForBehavior: behavior + selector: oldSelectorSymbol. + currentSelector := oldSelectorSymbol. + removedArgumentNames doWithIndex: [ :argumentName :index | + | nextSelector | + nextSelector := index = removedArgumentNames size + ifTrue: [ newSelectorSymbol ] + ifFalse: [ + self + selectorAfterRemovingArgumentNamed: + argumentName + fromBehavior: behavior + selector: currentSelector ]. + refactoring := self tool + removeParameterRefactoringForArgumentNamed: + argumentName + inBehavior: behavior + selector: currentSelector + model: refactoringModel. + refactoring newSelector: nextSelector. + refactoring execute. + currentSelector := nextSelector ]. + newCompiledMethod := self tool + reformattedMethodForBehavior: behavior + selector: newSelectorSymbol. + changeResult := (MCPMethodUpdateChangeResult + updateAction: 'removeArguments' + method: newCompiledMethod) + oldSelector: self request selector; + newSelector: self request newSelector; + yourself ] successResult: [ :warningMessages | - self tool - successResultText: - 'Removed arguments from ' , oldMethodReference , ' as ' - , (self tool - methodReferenceForBehavior: behavior - selector: newSelectorSymbol) , '.' - data: - (self appliedUpdateResultFor: changeResult plan: plan) - asDictionary - warnings: warningMessages ] + self tool + successResultText: + 'Removed arguments from ' , oldMethodReference , ' as ' + , (self tool + methodReferenceForBehavior: behavior + selector: newSelectorSymbol) , '.' + data: + (self appliedUpdateResultFor: changeResult plan: plan) + asDictionary + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForArgumentUpdateAction: 'removeArguments' - classNamed: self request className - classSide: self request classSide - selector: self request selector - newSelector: self request newSelector - error: error ] + self tool + failureMessageForArgumentUpdateAction: 'removeArguments' + classNamed: self request className + classSide: self request classSide + selector: self request selector + newSelector: self request newSelector + error: error ] ] { #category : 'executing - method' } @@ -275,56 +275,56 @@ MCPUpdateMethodCommand >> executeRenameWithPlan: plan [ force: self request force requestedContext: plan requestedContext work: [ - behavior := self tool - behaviorNamed: self request className - classSide: self request classSide. - behavior compiledMethodAt: oldSelectorSymbol ifAbsent: [ - MCPCommandError - signalMissingMethodInClassName: self request className - classSide: self request classSide - selector: self request selector ]. - refactoringModel := self tool - refactoringModelForScopeSpec: - self request refactoringScopeSpec - anchoredAtBehavior: behavior. - oldMethodReference := self tool - methodReferenceForBehavior: behavior - selector: oldSelectorSymbol. - refactoring := self tool - renameRefactoringForSelector: oldSelectorSymbol - inBehavior: behavior - to: newSelectorSymbol - permutation: self request permutation - model: refactoringModel. - renameMap := self request argumentRenameMapForBehavior: behavior. - renameMap ifNotEmpty: [ refactoring renameMap: renameMap ]. - refactoring execute. - newCompiledMethod := self tool - reformattedMethodForBehavior: behavior - selector: newSelectorSymbol. - changeResult := (MCPMethodUpdateChangeResult - updateAction: 'rename' - method: newCompiledMethod) - oldSelector: self request selector; - newSelector: self request newSelector; - yourself ] + behavior := self tool + behaviorNamed: self request className + classSide: self request classSide. + behavior compiledMethodAt: oldSelectorSymbol ifAbsent: [ + MCPCommandError + signalMissingMethodInClassName: self request className + classSide: self request classSide + selector: self request selector ]. + refactoringModel := self tool + refactoringModelForScopeSpec: + self request refactoringScopeSpec + anchoredAtBehavior: behavior. + oldMethodReference := self tool + methodReferenceForBehavior: behavior + selector: oldSelectorSymbol. + refactoring := self tool + renameRefactoringForSelector: oldSelectorSymbol + inBehavior: behavior + to: newSelectorSymbol + permutation: self request permutation + model: refactoringModel. + renameMap := self request argumentRenameMapForBehavior: behavior. + renameMap ifNotEmpty: [ refactoring renameMap: renameMap ]. + refactoring execute. + newCompiledMethod := self tool + reformattedMethodForBehavior: behavior + selector: newSelectorSymbol. + changeResult := (MCPMethodUpdateChangeResult + updateAction: 'rename' + method: newCompiledMethod) + oldSelector: self request selector; + newSelector: self request newSelector; + yourself ] successResult: [ :warningMessages | - self tool - successResultText: - 'Renamed ' , oldMethodReference , ' to ' , (self tool - methodReferenceForBehavior: behavior - selector: newSelectorSymbol) , '.' - data: - (self appliedUpdateResultFor: changeResult plan: plan) - asDictionary - warnings: warningMessages ] + self tool + successResultText: + 'Renamed ' , oldMethodReference , ' to ' , (self tool + methodReferenceForBehavior: behavior + selector: newSelectorSymbol) , '.' + data: + (self appliedUpdateResultFor: changeResult plan: plan) + asDictionary + warnings: warningMessages ] failureSummary: [ :error | - self tool - failureMessageForRenameClassNamed: self request className - classSide: self request classSide - selector: self request selector - newSelector: self request newSelector - error: error ] + self tool + failureMessageForRenameClassNamed: self request className + classSide: self request classSide + selector: self request selector + newSelector: self request newSelector + error: error ] ] { #category : 'private - methods' } @@ -342,10 +342,10 @@ MCPUpdateMethodCommand >> requestedContextForAction: action [ context := self request requestedContext copy. (#( 'rename' 'addArguments' 'removeArguments' ) includes: action) ifTrue: [ - self tool - addRefactoringScopeContextFromSpec: - self request refactoringScopeSpec - toRequestedContext: context ]. + self tool + addRefactoringScopeContextFromSpec: + self request refactoringScopeSpec + toRequestedContext: context ]. ^ context ] diff --git a/src/MCP/TMCPMethodTool.trait.st b/src/MCP/TMCPMethodTool.trait.st index a551817..b08c3a7 100644 --- a/src/MCP/TMCPMethodTool.trait.st +++ b/src/MCP/TMCPMethodTool.trait.st @@ -36,10 +36,10 @@ TMCPMethodTool >> methodForClassNamed: className selector: selectorString classS behavior := self behaviorNamed: className classSide: classSide. selectorSymbol := selectorString asSymbol. (behavior includesSelector: selectorSymbol) ifFalse: [ - MCPCommandError - signalMissingMethodInClassName: className - classSide: classSide - selector: selectorString ]. + MCPCommandError + signalMissingMethodInClassName: className + classSide: classSide + selector: selectorString ]. ^ behavior compiledMethodAt: selectorSymbol ] @@ -55,20 +55,20 @@ TMCPMethodTool >> methodQueryScopeInputProperties [ TMCPMethodTool >> methodReferenceForBehavior: aBehavior selector: aSelector [ ^ String streamContents: [ :stream | - stream nextPutAll: (self targetNameForBehavior: aBehavior). - stream nextPutAll: '>>'. - stream nextPutAll: aSelector asString ] + stream nextPutAll: (self targetNameForBehavior: aBehavior). + stream nextPutAll: '>>'. + stream nextPutAll: aSelector asString ] ] { #category : 'private - methods' } TMCPMethodTool >> methodReferenceForClassName: aClassName selector: aSelector isClassSide: isClassSide [ ^ String streamContents: [ :stream | - stream nextPutAll: aClassName. - isClassSide ifTrue: [ stream nextPutAll: ' class' ]. - stream - nextPutAll: '>>'; - nextPutAll: aSelector ] + stream nextPutAll: aClassName. + isClassSide ifTrue: [ stream nextPutAll: ' class' ]. + stream + nextPutAll: '>>'; + nextPutAll: aSelector ] ] { #category : 'private - schema' } From 8292f5d28ce2a6585b615413f1b52485f53afd9d Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Fri, 26 Jun 2026 14:20:16 +0200 Subject: [PATCH 19/21] Use compatibility hooks for debugger runtime lookups Co-authored-by: Codex --- src/MCP/MCPDebugRepairAnalyzer.class.st | 9 ++------- src/MCP/MCPDebugSessionsCommand.class.st | 7 ++----- src/MCP/MCPRunTestsCommand.class.st | 6 +----- 3 files changed, 5 insertions(+), 17 deletions(-) diff --git a/src/MCP/MCPDebugRepairAnalyzer.class.st b/src/MCP/MCPDebugRepairAnalyzer.class.st index 3eebfa3..782e6cf 100644 --- a/src/MCP/MCPDebugRepairAnalyzer.class.st +++ b/src/MCP/MCPDebugRepairAnalyzer.class.st @@ -150,13 +150,8 @@ MCPDebugRepairAnalyzer >> methodBehaviorForContext: aContext [ { #category : 'private - contexts' } MCPDebugRepairAnalyzer >> methodImplementor [ - | implementorClass session | - session := self debugSession. - session ifNil: [ ^ nil ]. - implementorClass := Smalltalk globals - at: #StDebuggerMethodImplementor - ifAbsent: [ ^ nil ]. - ^ implementorClass forSession: session + ^ self debugSession ifNotNil: [ :session | + PharoCompatibility debuggerMethodImplementorForSession: session ] ] { #category : 'private - actions' } diff --git a/src/MCP/MCPDebugSessionsCommand.class.st b/src/MCP/MCPDebugSessionsCommand.class.st index 92cb635..7237b6f 100644 --- a/src/MCP/MCPDebugSessionsCommand.class.st +++ b/src/MCP/MCPDebugSessionsCommand.class.st @@ -74,12 +74,9 @@ MCPDebugSessionsCommand >> candidateIsAttached: aCandidate [ { #category : 'private - candidates' } MCPDebugSessionsCommand >> debuggerCandidates [ - | candidates debuggerClass reversed | - debuggerClass := Smalltalk globals - at: #StDebugger - ifAbsent: [ ^ #( ) ]. + | candidates reversed | candidates := OrderedCollection new. - debuggerClass allInstancesDo: [ :debugger | + StDebugger allInstancesDo: [ :debugger | | candidate | candidate := MCPDebugSessionCandidate fromDebugger: debugger. candidate isAttachable ifTrue: [ candidates add: candidate ] ]. diff --git a/src/MCP/MCPRunTestsCommand.class.st b/src/MCP/MCPRunTestsCommand.class.st index 0be7eac..388c909 100644 --- a/src/MCP/MCPRunTestsCommand.class.st +++ b/src/MCP/MCPRunTestsCommand.class.st @@ -36,11 +36,7 @@ MCPRunTestsCommand >> coverableMethodsForCoverageRequest: aCoverageRequest [ { #category : 'private - coverage' } MCPRunTestsCommand >> coverageCollectorClass [ - ^ Smalltalk globals at: #CoverageCollector ifAbsent: [ - MCPCommandError - signalErrorCode: #CoverageUnavailable - message: 'CoverageCollector is not available in this image.' - details: Dictionary new ] + ^ CoverageCollector ] { #category : 'private - coverage' } From 73230ecd580cd59c8569ace00cf8decbca1847b7 Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Fri, 26 Jun 2026 15:29:21 +0200 Subject: [PATCH 20/21] Fix Renraku rule groups on Pharo 12 Co-authored-by: Codex --- src/MCP/MCPMessageNotUnderstoodHandlerRule.class.st | 2 +- src/MCP/MCPMethodStyleRule.class.st | 2 +- src/MCP/MCPRespondsToUsageRule.class.st | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/MCP/MCPMessageNotUnderstoodHandlerRule.class.st b/src/MCP/MCPMessageNotUnderstoodHandlerRule.class.st index a53bc33..556508d 100644 --- a/src/MCP/MCPMessageNotUnderstoodHandlerRule.class.st +++ b/src/MCP/MCPMessageNotUnderstoodHandlerRule.class.st @@ -26,7 +26,7 @@ MCPMessageNotUnderstoodHandlerRule class >> forbiddenExceptionName [ { #category : 'accessing' } MCPMessageNotUnderstoodHandlerRule class >> group [ - ^ self designFlawGroup + ^ #'Design Flaws' ] { #category : 'accessing' } diff --git a/src/MCP/MCPMethodStyleRule.class.st b/src/MCP/MCPMethodStyleRule.class.st index fb51ff8..ab65c66 100644 --- a/src/MCP/MCPMethodStyleRule.class.st +++ b/src/MCP/MCPMethodStyleRule.class.st @@ -14,7 +14,7 @@ Class { { #category : 'accessing' } MCPMethodStyleRule class >> group [ - ^ self designFlawGroup + ^ #'Design Flaws' ] { #category : 'testing' } diff --git a/src/MCP/MCPRespondsToUsageRule.class.st b/src/MCP/MCPRespondsToUsageRule.class.st index 0d501f4..86fa4d6 100644 --- a/src/MCP/MCPRespondsToUsageRule.class.st +++ b/src/MCP/MCPRespondsToUsageRule.class.st @@ -26,7 +26,7 @@ MCPRespondsToUsageRule class >> forbiddenSelector [ { #category : 'accessing' } MCPRespondsToUsageRule class >> group [ - ^ self designFlawGroup + ^ #'Design Flaws' ] { #category : 'accessing' } From 162fdb20cf124ac931277e5298d3da852bb2f94d Mon Sep 17 00:00:00 2001 From: Gabriel-Darbord Date: Fri, 26 Jun 2026 15:47:23 +0200 Subject: [PATCH 21/21] Regenerate test resource methods --- ...PCompiledMethodInfoTestTarget.extension.st | 4 +--- ...PToolMethodMutationTestTarget.extension.st | 4 +--- .../MCPCompiledMethodInfoTestTarget.class.st | 8 ++------ .../MCPToolMethodMutationTestSender.class.st | 8 ++------ .../MCPToolMethodMutationTestTarget.class.st | 16 ++++----------- .../MCPToolRemoveMethodsTestSender.class.st | 4 +--- .../MCPToolRemoveMethodsTestTarget.class.st | 20 +++++-------------- 7 files changed, 16 insertions(+), 48 deletions(-) diff --git a/src/MCP-Tests-Resources-Extensions/MCPCompiledMethodInfoTestTarget.extension.st b/src/MCP-Tests-Resources-Extensions/MCPCompiledMethodInfoTestTarget.extension.st index 354ca14..400c6db 100644 --- a/src/MCP-Tests-Resources-Extensions/MCPCompiledMethodInfoTestTarget.extension.st +++ b/src/MCP-Tests-Resources-Extensions/MCPCompiledMethodInfoTestTarget.extension.st @@ -1,7 +1,5 @@ Extension { #name : 'MCPCompiledMethodInfoTestTarget' } { #category : '*MCP-Tests-Resources-Extensions' } -MCPCompiledMethodInfoTestTarget >> extensionInfoTarget [ - - ^ 3 +MCPCompiledMethodInfoTestTarget >> extensionInfoTarget [ ^ 3 ] diff --git a/src/MCP-Tests-Resources-Extensions/MCPToolMethodMutationTestTarget.extension.st b/src/MCP-Tests-Resources-Extensions/MCPToolMethodMutationTestTarget.extension.st index bd59b11..47b545a 100644 --- a/src/MCP-Tests-Resources-Extensions/MCPToolMethodMutationTestTarget.extension.st +++ b/src/MCP-Tests-Resources-Extensions/MCPToolMethodMutationTestTarget.extension.st @@ -1,7 +1,5 @@ Extension { #name : 'MCPToolMethodMutationTestTarget' } { #category : '*MCP-Tests-Resources-Extensions' } -MCPToolMethodMutationTestTarget >> extensionProtocolTarget [ - - ^ 99 +MCPToolMethodMutationTestTarget >> extensionProtocolTarget [ ^ 99 ] diff --git a/src/MCP-Tests-Resources/MCPCompiledMethodInfoTestTarget.class.st b/src/MCP-Tests-Resources/MCPCompiledMethodInfoTestTarget.class.st index fd50081..bd91632 100644 --- a/src/MCP-Tests-Resources/MCPCompiledMethodInfoTestTarget.class.st +++ b/src/MCP-Tests-Resources/MCPCompiledMethodInfoTestTarget.class.st @@ -9,13 +9,9 @@ Class { } { #category : 'tests' } -MCPCompiledMethodInfoTestTarget class >> classInfoTarget [ - - ^ 2 +MCPCompiledMethodInfoTestTarget class >> classInfoTarget [ ^ 2 ] { #category : 'tests' } -MCPCompiledMethodInfoTestTarget >> infoTarget [ - - ^ 1 +MCPCompiledMethodInfoTestTarget >> infoTarget [ ^ 1 ] diff --git a/src/MCP-Tests-Resources/MCPToolMethodMutationTestSender.class.st b/src/MCP-Tests-Resources/MCPToolMethodMutationTestSender.class.st index e8248ad..f267444 100644 --- a/src/MCP-Tests-Resources/MCPToolMethodMutationTestSender.class.st +++ b/src/MCP-Tests-Resources/MCPToolMethodMutationTestSender.class.st @@ -9,13 +9,9 @@ Class { } { #category : 'tests' } -MCPToolMethodMutationTestSender >> callClassTarget [ - - ^ MCPToolMethodMutationTestTarget buildValue: 'value' +MCPToolMethodMutationTestSender >> callClassTarget [ ^ MCPToolMethodMutationTestTarget buildValue: 'value' ] { #category : 'tests' } -MCPToolMethodMutationTestSender >> callInstanceTarget [ - - ^ MCPToolMethodMutationTestTarget new combine: 'first' with: 'second' +MCPToolMethodMutationTestSender >> callInstanceTarget [ ^ MCPToolMethodMutationTestTarget new combine: 'first' with: 'second' ] diff --git a/src/MCP-Tests-Resources/MCPToolMethodMutationTestTarget.class.st b/src/MCP-Tests-Resources/MCPToolMethodMutationTestTarget.class.st index 40f8b49..df06428 100644 --- a/src/MCP-Tests-Resources/MCPToolMethodMutationTestTarget.class.st +++ b/src/MCP-Tests-Resources/MCPToolMethodMutationTestTarget.class.st @@ -9,25 +9,17 @@ Class { } { #category : 'tests' } -MCPToolMethodMutationTestTarget class >> buildValue: aString [ - - ^ 'Class-' , aString +MCPToolMethodMutationTestTarget class >> buildValue: aString [ ^ 'Class-' , aString ] { #category : 'tests' } -MCPToolMethodMutationTestTarget class >> classProtocolTarget [ - - ^ 7 +MCPToolMethodMutationTestTarget class >> classProtocolTarget [ ^ 7 ] { #category : 'tests' } -MCPToolMethodMutationTestTarget >> combine: first with: second [ - - ^ first , '-' , second +MCPToolMethodMutationTestTarget >> combine: first with: second [ ^ first , '-' , second ] { #category : 'tests' } -MCPToolMethodMutationTestTarget >> instanceProtocolTarget [ - - ^ 41 +MCPToolMethodMutationTestTarget >> instanceProtocolTarget [ ^ 41 ] diff --git a/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestSender.class.st b/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestSender.class.st index e5bf6bc..607f6bf 100644 --- a/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestSender.class.st +++ b/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestSender.class.st @@ -9,7 +9,5 @@ Class { } { #category : 'tests' } -MCPToolRemoveMethodsTestSender >> sendProtectedRemovalTarget [ - - ^ MCPToolRemoveMethodsTestTarget new externallyReferencedBatchRemoval +MCPToolRemoveMethodsTestSender >> sendProtectedRemovalTarget [ ^ MCPToolRemoveMethodsTestTarget new externallyReferencedBatchRemoval ] diff --git a/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestTarget.class.st b/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestTarget.class.st index 7e9da93..8398ece 100644 --- a/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestTarget.class.st +++ b/src/MCP-Tests-Resources/MCPToolRemoveMethodsTestTarget.class.st @@ -9,31 +9,21 @@ Class { } { #category : 'tests' } -MCPToolRemoveMethodsTestTarget class >> firstClassBatchRemoval [ - - ^ self secondClassBatchRemoval + 1 +MCPToolRemoveMethodsTestTarget class >> firstClassBatchRemoval [ ^ self secondClassBatchRemoval + 1 ] { #category : 'tests' } -MCPToolRemoveMethodsTestTarget class >> secondClassBatchRemoval [ - - ^ 7 +MCPToolRemoveMethodsTestTarget class >> secondClassBatchRemoval [ ^ 7 ] { #category : 'tests' } -MCPToolRemoveMethodsTestTarget >> externallyReferencedBatchRemoval [ - - ^ 5 +MCPToolRemoveMethodsTestTarget >> externallyReferencedBatchRemoval [ ^ 5 ] { #category : 'tests' } -MCPToolRemoveMethodsTestTarget >> firstBatchRemoval [ - - ^ self secondBatchRemoval + 1 +MCPToolRemoveMethodsTestTarget >> firstBatchRemoval [ ^ self secondBatchRemoval + 1 ] { #category : 'tests' } -MCPToolRemoveMethodsTestTarget >> secondBatchRemoval [ - - ^ 2 +MCPToolRemoveMethodsTestTarget >> secondBatchRemoval [ ^ 2 ]