Finally, an IDE

src/Carp-AST/CarpExpressionNode.class.st

@@ -16,6 +16,11 @@ CarpExpressionNode >> acceptVisitor: anExpressionVisitor [
 	^ anExpressionVisitor visitExpression: self
 ]
 
+{ #category : #accessing }
+CarpExpressionNode >> isDefinition [
+	^ false
+]
+
 { #category : #accessing }
 CarpExpressionNode >> isQuoted [
 	^ parent ifNil: [ false ] ifNotNil: [ parent isQuoted ]

src/Carp-AST/CarpVariableNode.class.st

@@ -13,6 +13,15 @@ CarpVariableNode >> acceptVisitor: anExpressionVisitor [
 	^ anExpressionVisitor visitVariable: self
 ]
 
+{ #category : #accessing }
+CarpVariableNode >> isDefinitionPredicate [
+	^ {'defdynamic'.
+		'defndynamic'.
+		'defmacro'.
+		'defn'.
+		'def'} includes: self value source
+]
+
 { #category : #accessing }
 CarpVariableNode >> toPharo [
 	^ value source asSymbol

src/Carp-Parser/CarpListNode.class.st

@@ -21,6 +21,14 @@ CarpListNode >> compositeNodeVariables [
 	^ #( #expressions )
 ]
 
+{ #category : #accessing }
+CarpListNode >> definitionVariable [
+	^ (self expressions size > 1
+		and: [ self expressions first isDefinitionPredicate ])
+		ifTrue: [ self expressions second ]
+		ifFalse: [ nil ]
+]
+
 { #category : #generated }
 CarpListNode >> expressions [
 
@@ -41,6 +49,11 @@ CarpListNode >> initialize [
 	expressions := OrderedCollection new: 2.
 ]
 
+{ #category : #accessing }
+CarpListNode >> isDefinition [
+	^ self definitionVariable isNotNil
+]
+
 { #category : #generated }
 CarpListNode >> leftParen [
 

src/Carp/CarpExecutionResult.class.st

@@ -0,0 +1,68 @@
+Class {
+	#name : #CarpExecutionResult,
+	#superclass : #Object,
+	#instVars : [
+		'value',
+		'warnings',
+		'view'
+	],
+	#category : #'Carp-Execution'
+}
+
+{ #category : #'instance creation' }
+CarpExecutionResult class >> from: aCarpResult [
+	^ self new
+		value: (aCarpResult at: #value);
+		warnings: (aCarpResult at: #warnings)
+]
+
+{ #category : #accessing }
+CarpExecutionResult >> gtValueFor: aView [
+	<gtView>
+	| v |
+	v := aView forward
+		title: 'Value';
+		priority: 1;
+		object: value.
+	view ifNotNil: [ v view: view ].
+	^ v
+]
+
+{ #category : #accessing }
+CarpExecutionResult >> gtWarningsFor: aView [
+	<gtView>
+	^ aView list
+		title: 'Warnings';
+		priority: 2;
+		items: [ warnings ]
+]
+
+{ #category : #accessing }
+CarpExecutionResult >> parse [
+	value := CarpParser parse: value
+]
+
+{ #category : #accessing }
+CarpExecutionResult >> transformValue: aBlock [
+	value := aBlock value: value
+]
+
+{ #category : #accessing }
+CarpExecutionResult >> value [
+	^ value
+]
+
+{ #category : #accessing }
+CarpExecutionResult >> value: aValue [
+	value := aValue
+]
+
+{ #category : #accessing }
+CarpExecutionResult >> view: aView [
+	view := aView
+]
+
+{ #category : #accessing }
+CarpExecutionResult >> warnings: aCollection [
+	warnings := aCollection
+]

src/Carp/CarpTypeSignature.class.st

@@ -0,0 +1,180 @@
+Class {
+	#name : #CarpTypeSignature,
+	#superclass : #Object,
+	#instVars : [
+		'signature',
+		'model',
+		'tooltipsContainer'
+	],
+	#category : #'Carp-Coder'
+}
+
+{ #category : #'instance creation' }
+CarpTypeSignature class >> on: aValue using: aModel [
+	^ self new
+		fromAST: aValue;
+		model: aModel
+]
+
+{ #category : #accessing }
+CarpTypeSignature >> elementsList [
+	| tokens verticalContainer docsRegex |
+	tokens := signature value source findTokens: ' () []'.
+	docsRegex := 'Documentation\: (.*)' asRegexIgnoringCase.
+
+	verticalContainer := BrVerticalPane new
+			fitContent;
+			padding: (BlInsets all: 10).
+
+	tokens
+		do: [ :each | 
+			| res |
+			res := model bindAndExecuteRaw: '(info ' , each , ')'.
+			(docsRegex search: (res at: #value))
+				ifTrue: [ | docs |
+					docs := docsRegex subexpression: 2.
+					verticalContainer
+						addChild: (BrLabel new
+								aptitude: BrGlamorousLabelAptitude new
+										+ (GtExplainerExplanationAptitude new explanationModel: each)
+										+ (BrStyleCommonAptitude new
+												hovered: [ :aStyle | 
+													aStyle background: BrGlamorousColors textHighlightColor.
+													aStyle
+														do: [ tooltipsContainer
+																text: docs;
+																visibility: BlVisibility visible ]
+														after: [ tooltipsContainer
+																text: '' asRopedText;
+																visibility: BlVisibility gone ] ]);
+								geometry: (BlRoundedRectangleGeometry cornerRadius: 4);
+								text: each;
+								padding: (BlInsets all: 5)) ] ].
+
+	(tokens includes: '<StaticLifetime>')
+		ifTrue: [ verticalContainer
+				addChild: (BrLabel new
+						aptitude: BrGlamorousLabelAptitude new
+								+ (GtExplainerExplanationAptitude new explanationModel: '<StaticLifetime>')
+								+ (BrStyleCommonAptitude new
+										hovered: [ :aStyle | 
+											aStyle background: BrGlamorousColors textHighlightColor.
+											aStyle
+												do: [ tooltipsContainer
+														text: 'is the default static lifetime of values (this lifetime includes the entire program run).';
+														visibility: BlVisibility visible ]
+												after: [ tooltipsContainer
+														text: '' asRopedText;
+														visibility: BlVisibility gone ] ]);
+						geometry: (BlRoundedRectangleGeometry cornerRadius: 4);
+						text: '<StaticLifetime>';
+						padding: (BlInsets all: 5)) ].
+
+	^ verticalContainer asScrollableElement
+		constraintsDo: [ :c | 
+			c horizontal fitContent.
+			c vertical matchParent ];
+		background: Color white;
+		aptitude: BrShadowAptitude new
+]
+
+{ #category : #accessing }
+CarpTypeSignature >> explainSignature [
+	| mainContainer coderElement leftContainer rightContainer rightContainerLabel leftContainerLabel tooltipsTarget coder elementsContainer editor |
+	mainContainer := BrHorizontalPane new
+			matchParent;
+			padding: (BlInsets all: 5).
+	mainContainer explainer isExplanationHolder: true.
+
+	leftContainer := BrVerticalPane new
+			hFitContent;
+			vMatchParent;
+			padding: (BlInsets all: 5);
+			margin: (BlInsets right: 20).
+
+	rightContainer := BrVerticalPane new
+			matchParent;
+			padding: (BlInsets all: 5).
+
+	tooltipsContainer := BrEditor new
+			text: '' asRopedText;
+			padding: (BlInsets all: 10);
+			margin: (BlInsets
+					top: 10
+					right: 0
+					bottom: 0
+					left: 0);
+			constraintsDo: [ :c | c horizontal matchParent ];
+			visibility: BlVisibility gone;
+			border: (BlBorder paint: BrGlamorousColors textHighlightColor width: 2);
+			aptitude: BrShadowAptitude + BrGlamorousEditorAptitude;
+			vFitContent;
+			background: BrGlamorousColors textHighlightColor.
+
+	tooltipsTarget := BrButton new
+			constraintsDo: [ :c | c ignoreByLayout ];
+			size: 0 @ 0;
+			elevation: (BlRelativeElevation elevation: 10);
+			geometry: BlCircleGeometry new.
+
+	elementsContainer := self elementsList.
+
+	leftContainerLabel := BrLabel new
+			text: ('Type Elements:' asRopedText
+					glamorousRegularFont;
+					foreground: Color gray);
+			aptitude: BrGlamorousLabelAptitude;
+			hFitContent;
+			margin: (BlInsets
+					top: 0
+					right: 0
+					bottom: 5
+					left: 0).
+	rightContainerLabel := BrLabel new
+			text: ('Type:' asRopedText
+					glamorousRegularFont;
+					foreground: Color gray);
+			aptitude: BrGlamorousLabelAptitude;
+			margin: (BlInsets
+					top: 0
+					right: 0
+					bottom: 5
+					left: 5).
+
+	editor := BrEditorElement new
+			constraintsDo: [ :c | 
+				c horizontal matchParent.
+				c vertical matchParent ];
+			editor: (BrTextEditor new text: signature value source asRopedText glamorousCodeFont).
+
+	leftContainer addChild: leftContainerLabel.
+	leftContainer addChild: elementsContainer.
+
+	rightContainer addChild: rightContainerLabel.
+	rightContainer addChild: editor.
+	rightContainer addChild: tooltipsContainer.
+
+	mainContainer addChild: leftContainer.
+	mainContainer addChild: rightContainer.
+
+	^ mainContainer
+]
+
+{ #category : #accessing }
+CarpTypeSignature >> fromAST: anASTNode [
+	signature := anASTNode
+]
+
+{ #category : #accessing }
+CarpTypeSignature >> gtLiveFor: aView [
+	<gtView>
+	^ aView explicit
+		title: 'Signature';
+		priority: 1;
+		stencil: [ self explainSignature ]
+]
+
+{ #category : #accessing }
+CarpTypeSignature >> model: aModel [
+	model := aModel
+]

src/Carp/GtCarpCoderModel.class.st

@@ -45,7 +45,7 @@ GtCarpCoderModel >> bindAndExecute: sourceString [
 			returnedVarNames: varNames.
 	res := self bindAndExecuteRaw: sourceString.
 
-	(res at: #result) = 'success' ifTrue: [ ^ res at: #value ].
+	(res at: #result) = 'success' ifTrue: [ ^ CarpExecutionResult from: res ].
 	exception := (PharoLinkRemoteError new
 		application: application;
 		command: commandFactory command;
@@ -112,7 +112,8 @@ GtCarpCoderModel >> initializeAddOns: addOns [
 			| source |
 			source := '(expand ''' , sourceCode currentSourceText value text , ')'.
 			anElement phlow
-				spawnObject: (CarpParser parse: (aCoderUIModel coder bindAndExecute: source)) ].
+				spawnObject: ((self bindAndExecute: source) parse view: #gtSourceFor:) ]
+		id: #'source-coder--macro-expand-action'.
 	addOns
 		addMainAction: 'Build and Run' translated
 		icon: BrGlamorousVectorIcons refresh
@@ -120,8 +121,13 @@ GtCarpCoderModel >> initializeAddOns: addOns [
 			| source |
 			source := '' , sourceCode currentSourceText value text , '(build) (run)'.
 			anElement phlow
-				spawnObject: (CarpCliOutput text: ((aCoderUIModel coder bindAndExecuteRaw: source) at: 'value')) ]
+				spawnObject: (CarpCliOutput text: ((self bindAndExecuteRaw: source) at: 'value')) ]
-		id: #'source-coder--macro-expand-action'
+		id: #'source-coder--build-and-run-action'.
+	addOns
+		addMainAction: 'Infer Type' translated
+		icon: BrGlamorousVectorIcons inspect
+		action: [ :aCoderUIModel :anElement | self inspectTypeSpawningOn: anElement phlow]
+		id: #'source-coder--type-infer-action'
 ]
 
 { #category : #accessing }
@@ -133,6 +139,21 @@ GtCarpCoderModel >> initializeShortcuts: addOns [
 		addShortcut: GtSourceCoderDoItAndInspectShortcut new
 ]
 
+{ #category : #accessing }
+GtCarpCoderModel >> inspectTypeSpawningOn: aPhlow [
+	| source ast |
+	source := sourceCode currentSourceText value text.
+	ast := CarpParser parse: source.
+	
+	(ast expressions size = 1 and: [ ast expressions first isDefinition ])
+		ifTrue: [ self bindAndExecute: source asString.
+			source := ast expressions first definitionVariable value source ].
+			
+	source := '(def *type-infer-this* ' , source
+			, ') (defdynamic *type-infer-result* (type *type-infer-this*)) (def *type-infer-this* 0) *type-infer-result*'.
+	aPhlow spawnObject: ((self bindAndExecute: source) parse transformValue: [:aValue | CarpTypeSignature on: aValue expressions first using: self])
+]
+
 { #category : #accessing }
 GtCarpCoderModel >> newCompletionStrategy [
 	^ GtCompletionStrategy new
@@ -145,7 +166,8 @@ GtCarpCoderModel >> pharoBindings: anObject [
 
 { #category : #accessing }
 GtCarpCoderModel >> primitiveEvaluate: aSourceString inContext: aGtSourceCoderEvaluationContext onFailDo: anEvaluationFailBlock [
-	^ (CarpParser parse: (self bindAndExecute: aSourceString)) expressions first toPharo
+	^ (self bindAndExecute: aSourceString) parse
+		transformValue: [ :aValue | aValue expressions first toPharo ]
 ]
 
 { #category : #accessing }