Inline traits in LLM core [feenkcom/gtoolkit#4322]

src/Gt4Llm-GToolkit/GtLlmActionMessage.extension.st

@@ -0,0 +1,90 @@
+Extension { #name : #GtLlmActionMessage }
+
+{ #category : #'*Gt4Llm-GToolkit' }
+GtLlmActionMessage >> gtActionFor: aView [
+	<gtView>
+	<gtLlmMessageView>
+	| view |
+	self action isEmptyOrNil ifTrue: [ ^ aView empty ].
+
+	view := aView textEditor
+			title: 'Action';
+			priority: 3;
+			text: [ self action ].
+	self chat
+		ifNotNil: [ view
+				actionButtonLabel: 'Action'
+					action: [ :aButton | aButton phlow spawnObject: (self chat tutor actionNamed: self action) ];
+				styler: [ BlCompositeStyler new
+						stylers: {GtLlmMessageStyler new threadMessageViewModel: self asViewModel.
+								GtLlmThreadMessageStyler new annotations: self annotations.
+								GtLlmTutorFormatTextStyler new tutor: self chat tutor} ] ].
+	^ view
+]
+
+{ #category : #'*Gt4Llm-GToolkit' }
+GtLlmActionMessage >> gtInspectActionFor: anAction [
+	<gtLlmAction>
+	self actionModel ifNil: [ ^ anAction noAction ].
+
+	^ anAction button
+		priority: 1;
+		icon: BrGlamorousVectorIcons inspect;
+		label: 'Action';
+		action: [ :aButton | aButton phlow spawnObject: (self chat tutor actionNamed: self action) ]
+]
+
+{ #category : #'*Gt4Llm-GToolkit' }
+GtLlmActionMessage >> gtReifyActionFor: anAction [
+	<gtLlmAction>
+	(self isAssistantRole
+		and: [ self action = 'Answer a chat request'
+				or: [ (self action beginsWith: 'Chat request: ') or: [ self actionModel isNil ] ] ])
+		ifFalse: [ ^ anAction noAction ].
+
+	^ anAction dropdown
+		priority: 5;
+		label: 'Reify action';
+		content: [ :anElement | 
+			GtLlmActionTemplateElement new
+				example: (GtLlmTutorActionExample new
+						input: self ancestor contentJson;
+						output: self contentJson);
+				onActionCreated: [ :action | 
+					self chat tutor class compile: action.
+					self chat tutor recomputeActions.
+					anElement phlow fireToolUpdateWish.
+					anElement fireEvent: BrDropdownHideWish new ];
+				padding: (BlInsets all: 5) ]
+]
+
+{ #category : #'*Gt4Llm-GToolkit' }
+GtLlmActionMessage >> gtReifyMessageActionFor: anAction [
+	<gtLlmAction>
+	^ anAction dropdown
+		priority: 1;
+		label: 'Reify';
+		content: [ :aButton | 
+			(GtLlmReificationForm new
+				message: self;
+				onAccept: [ :aValue | 
+					aButton
+						enqueueTask: (BlTaskAction new
+								action: [ aButton phlow fireToolUpdateWish.
+									aButton fireEvent: BrDropdownHideWish new ]) ]) asElement
+				margin: (BlInsets all: 5) ]
+]
+
+{ #category : #'*Gt4Llm-GToolkit' }
+GtLlmActionMessage >> gtTextFor: aView [
+	<gtView>
+	<gtLlmMessageView>
+	self textBlock isEmptyOrNil ifTrue: [ ^ aView empty ].
+
+	^ aView textEditor
+		title: 'Text';
+		priority: 1;
+		styler: (GtLlmMessageStyler new
+				threadMessageViewModel: (GtLlmNewThreadMessageViewModel new threadMessage: GtLlmNewThreadMessage new));
+		text: [ self textBlock ]
+]

src/Gt4Llm/GtLlmActionMessage.class.st

@@ -1,12 +1,54 @@
 Class {
 	#name : #GtLlmActionMessage,
 	#superclass : #GtLlmChatMessage,
-	#traits : 'TGtActionMessage',
-	#classTraits : 'TGtActionMessage classTrait',
 	#category : #Gt4Llm
 }
 
 { #category : #'as yet unclassified' }
 GtLlmActionMessage class >> defaultRole [
 	^ nil
 ]
+
+{ #category : #'as yet unclassified' }
+GtLlmActionMessage >> actionModel [
+	^ (self chat tutor actionNamed: self action)
+		ifNil: [ self isUserRole
+				ifTrue: [ (self chat descendantOf: self) ifNotNil: #actionModel ]
+				ifFalse: [ nil ] ]
+]
+
+{ #category : #'as yet unclassified' }
+GtLlmActionMessage >> contentSummary [
+	^ self action
+]
+
+{ #category : #'as yet unclassified' }
+GtLlmActionMessage >> gtContentFor: aView [
+	<gtView>
+	<gtLlmMessageView>
+	^ aView empty
+]
+
+{ #category : #'as yet unclassified' }
+GtLlmActionMessage >> gtPromoteToExampleActionFor: anAction [
+	<gtLlmAction>
+	self isAssistantRole ifFalse: [ ^ anAction noAction ].
+
+	^ anAction dropdown
+		priority: 5;
+		label: 'Promote example';
+		content: [ :aButton | 
+			| action example |
+			action := self chat tutor actionNamed: self action.
+			example := GtLlmTutorActionExample new
+					input: self ancestor contentJson;
+					output: self contentJson.
+			action addExample: example.
+			action persist.
+			example asGtMagritteViewModel asElement ]
+]
+
+{ #category : #'as yet unclassified' }
+GtLlmActionMessage >> textBlock [
+	^ self contentJson at: 'Text' ifAbsent: [ '' ]
+]

src/Gt4Llm/GtLlmAssistantChatNotReadyStatus.class.st

@@ -1,8 +1,6 @@
 Class {
 	#name : #GtLlmAssistantChatNotReadyStatus,
 	#superclass : #GtLlmAssistantChatStatus,
-	#traits : 'TGtUniqueInstance',
-	#classTraits : 'TGtUniqueInstance classTrait',
 	#classInstVars : [
 		'uniqueInstance'
 	],

src/Gt4Llm/GtLlmAssistantChatReadyStatus.class.st

@@ -1,8 +1,6 @@
 Class {
 	#name : #GtLlmAssistantChatReadyStatus,
 	#superclass : #GtLlmAssistantChatStatus,
-	#traits : 'TGtUniqueInstance',
-	#classTraits : 'TGtUniqueInstance classTrait',
 	#classInstVars : [
 		'uniqueInstance'
 	],

src/Gt4Llm/GtLlmChat.class.st

@@ -1,8 +1,6 @@
 Class {
 	#name : #GtLlmChat,
 	#superclass : #Object,
-	#traits : 'TGtAnnouncer',
-	#classTraits : 'TGtAnnouncer classTrait',
 	#instVars : [
 		'model',
 		'announcer',
@@ -32,6 +30,11 @@ GtLlmChat >> ancestorOf: aMessage [
 	self error: 'Message not found'
 ]
 
+{ #category : #announcer }
+GtLlmChat >> announce: anAnnouncement [
+	^ self announcer announce: anAnnouncement
+]
+
 { #category : #accessing }
 GtLlmChat >> announcer [
 	^ announcer ifNil: [ announcer := Announcer new ]
@@ -80,6 +83,11 @@ GtLlmChat >> gtMessagesFor: aView [
 		actionUpdateButton
 ]
 
+{ #category : #announcer }
+GtLlmChat >> hasSubscriber: anObject [
+	^ self announcer hasSubscriber: anObject
+]
+
 { #category : #accessing }
 GtLlmChat >> initialize [
 	super initialize.
@@ -144,6 +152,12 @@ GtLlmChat >> provider: anObject [
 	provider chat: self
 ]
 
+{ #category : #'announcer - subscription' }
+GtLlmChat >> removeSubscription: subscription [
+	"Remove the given subscription from the receiver"
+	^ self announcer removeSubscription: subscription
+]
+
 { #category : #'as yet unclassified' }
 GtLlmChat >> responseFormat [
 	^ self provider format
@@ -191,6 +205,51 @@ GtLlmChat >> status [
 	^ self provider status
 ]
 
+{ #category : #'announcer - subscription' }
+GtLlmChat >> subscribe: anAnnouncementClass do: aValuable [
+	"Declare that when anAnnouncementClass is raised, aValuable is executed."
+
+	self
+		deprecated: 'Please use #when:do: instead'
+		transformWith: '`@receiver subscribe: `@statements1 do: `@statements2' 
+						-> '`@receiver when: `@statements1 do: `@statements2'.
+
+	^ self when: anAnnouncementClass do: aValuable
+]
+
+{ #category : #'announcer - subscription' }
+GtLlmChat >> subscribe: anAnnouncementClass do: aValuable for: aSubscriber [
+	"Declare that when anAnnouncementClass is raised, aValuable is executed."
+
+	self
+		deprecated: 'Please use #when:do:for: instead'
+		transformWith: '`@receiver subscribe: `@statements1 do: `@aValuable for: `@aSubscriber' 
+						-> '`@receiver when: `@statements1 do: `@aValuable for: `@aSubscriber'.
+
+	^ self when: anAnnouncementClass do: aValuable for: aSubscriber
+]
+
+{ #category : #'announcer - subscription' }
+GtLlmChat >> subscribe: anAnnouncementClass send: aSelector to: anObject [
+	"Declare that when anAnnouncementClass is raised, anObject should receive the message aSelector."
+	self
+		deprecated: 'Please use #when:send:to: instead'
+		transformWith: '`@receiver subscribe: `@statements1 send: `@statements2 to: `@anObject' 
+						-> '`@receiver when: `@statements1 send: `@statements2 to: `@anObject'.
+	^ self when: anAnnouncementClass do: (MessageSend receiver: anObject selector: aSelector)
+]
+
+{ #category : #'announcer - subscription' }
+GtLlmChat >> subscribe: anAnnouncementClass send: aSelector to: anObject for: aSubscriber [
+	"Declare that when anAnnouncementClass is raised, anObject should receive the message aSelector."
+	self
+		deprecated: 'Please use #when:send:to:for: instead'
+		transformWith: '`@receiver subscribe: `@statements1 send: `@statements2 to: `@anObject for: `@aSubscriber' 
+						-> '`@receiver when: `@statements1 send: `@statements2 to: `@anObject for: `@aSubscriber'.
+
+	^ self when: anAnnouncementClass send: aSelector to: anObject for: aSubscriber
+]
+
 { #category : #accessing }
 GtLlmChat >> tutor [
 	^ tutor
@@ -201,7 +260,60 @@ GtLlmChat >> tutor: anObject [
 	tutor := anObject
 ]
 
+{ #category : #'announcer - subscription' }
+GtLlmChat >> unsubscribe: anObject [
+	"Unsubscribe all subscriptions of anObject from the receiver"
+	^ self announcer unsubscribe: anObject
+]
+
 { #category : #accessing }
 GtLlmChat >> updateLastUpdate [
 	lastUpdate := DateAndTime now
 ]
+
+{ #category : #'announcer - subscription' }
+GtLlmChat >> weak [
+	"announcer weak subscribe: foo"
+	^ self announcer weak
+]
+
+{ #category : #'announcer - subscription' }
+GtLlmChat >> when: anAnnouncementClass do: aValuable [
+	"Declare that when anAnnouncementClass is raised, aValuable is executed.  Pay attention that ushc method as well as when:do: should not be used on weak announcer since the block holds the receiver and more strongly."
+		^ self announcer when: anAnnouncementClass do: aValuable
+]
+
+{ #category : #'announcer - subscription' }
+GtLlmChat >> when: anAnnouncementClass do: aValuable for: aSubscriber [
+	"Declare that when anAnnouncementClass is raised, aValuable is executed and define the subscriber."
+
+	^ (self when: anAnnouncementClass do: aValuable) subscriber: aSubscriber; yourself
+]
+
+{ #category : #'announcer - subscription' }
+GtLlmChat >> when: anAnnouncementClass doOnce: aValuable for: aSubscriber [
+	"Declare that when anAnnouncementClass is raised, aValuable is executed and define the subscriber.
+	A valuable is executed ONCE, and then a subscriber gets unsubscribed"
+	^ self
+		when: anAnnouncementClass
+		do: [ :anAnnouncement |
+			self unsubscribe: aSubscriber.
+			aValuable cull: anAnnouncement ]
+		for: aSubscriber
+]
+
+{ #category : #'announcer - subscription' }
+GtLlmChat >> when: anAnnouncementClass send: aSelector to: anObject [
+	"Declare that when anAnnouncementClass is raised, anObject should receive the message aSelector.
+    When the message expects one argument (eg #fooAnnouncement:) the announcement is passed as argument.
+    When the message expects two arguments (eg #fooAnnouncement:announcer:) both the announcement and the announcer 
+    are passed as argument"
+		^ self announcer when: anAnnouncementClass send: aSelector to: anObject
+]
+
+{ #category : #'announcer - subscription' }
+GtLlmChat >> when: anAnnouncementClass send: aSelector to: anObject for: aSubscriber [
+	"Declare that when anAnnouncementClass is raised, anObject should receive the message aSelector."
+
+	^ (self when: anAnnouncementClass send: aSelector to: anObject) subscriber: aSubscriber
+]

src/Gt4Llm/GtLlmEmbeddingRegistry.class.st

@@ -1,8 +1,6 @@
 Class {
 	#name : #GtLlmEmbeddingRegistry,
 	#superclass : #Object,
-	#traits : 'TGtUniqueInstance',
-	#classTraits : 'TGtUniqueInstance classTrait',
 	#instVars : [
 		'embeddings'
 	],

src/Gt4Llm/GtLlmFailureThreadMessage.class.st

@@ -1,8 +1,6 @@
 Class {
 	#name : #GtLlmFailureThreadMessage,
 	#superclass : #Object,
-	#traits : 'TGtLlmThreadMessage',
-	#classTraits : 'TGtLlmThreadMessage classTrait',
 	#instVars : [
 		'failureText',
 		'createdAt',