Make tutors work in Gemstone [feenkcom/gtoolkit#4322]

src/GToolkit-GemStone-GemStone/AbstractDictionary.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : 'AbstractDictionary' }
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+AbstractDictionary >> isDictionary [
+	^ true
+]

src/GToolkit-GemStone-GemStone/Character.extension.st

@@ -11,3 +11,8 @@ Character class >> value: aCodePointInteger [
 
 	^ self withValue: aCodePointInteger
 ]
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+Character >> join: aSequenceableCollection [
+	^ self asString join: aSequenceableCollection
+]

src/GToolkit-GemStone-GemStone/Collection.extension.st

@@ -0,0 +1,28 @@
+Extension { #name : 'Collection' }
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+Collection >> detect: aBlock ifFound: foundBlock ifNone: exceptionBlock [
+	self
+		do: [ :each |
+			(aBlock value: each)
+				ifTrue: [ ^ foundBlock cull: each ] ].
+	^ exceptionBlock value
+]
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+Collection >> isNotEmpty [
+
+"Returns true if the receiver is not empty.  Returns false otherwise."
+
+^self size ~~ 0
+]
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+Collection >> select: selectBlock thenCollect: collectBlock [
+	^ (self select: selectBlock) collect: collectBlock
+]
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+Collection >> sorted: aBlock [
+	^ self sortWithBlock: aBlock
+]

src/GToolkit-GemStone-GemStone/Dictionary.extension.st

@@ -1,6 +1,11 @@
-Extension { #name : #Dictionary }
+Extension { #name : 'Dictionary' }
 
-{ #category : #'*GToolkit-GemStone-GemStone' }
+{ #category : '*GToolkit-GemStone-GemStone' }
+Dictionary >> , aCollection [
+	^self copy addAll: aCollection; yourself
+]
+
+{ #category : '*GToolkit-GemStone-GemStone' }
 Dictionary >> asGtGsArgument [
 	"Answer the the local object of the receiver"
 	| local |
@@ -11,7 +16,7 @@ Dictionary >> asGtGsArgument [
 	^ local
 ]
 
-{ #category : #'*GToolkit-GemStone-GemStone' }
+{ #category : '*GToolkit-GemStone-GemStone' }
 Dictionary >> asGtRsrProxyObjectForConnection: aRsrConnection [
 	"Answer the receiver with unsupported (non-immediate) objects converted to GtRsrProxyServiceServers.
 	Ideally we would look up objects in the connection and use the same proxy, but that isn't happening yet.
@@ -28,3 +33,9 @@ Dictionary >> asGtRsrProxyObjectForConnection: aRsrConnection [
 			put: (value asGtRsrProxyObjectForConnection: aRsrConnection) ].
 	^ proxyDict
 ]
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+Dictionary >> associations [
+	^Array new: self size streamContents: [ :stream |
+		self associationsDo: [ :each | stream nextPut: each ] ]
+]

src/GToolkit-GemStone-GemStone/Duration.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : 'Duration' }
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+Duration class >> nanoSeconds: nanoSeconds [
+	^ self seconds: nanoSeconds / 1000000
+]

src/GToolkit-GemStone-GemStone/GtGemstoneHttpClient.class.st

@@ -3,11 +3,17 @@ Class {
 	#superclass : 'Object',
 	#instVars : [
 		'url',
-		'contents'
+		'contents',
+		'contentType'
 	],
 	#category : 'GToolkit-GemStone-GemStone'
 }
 
+{ #category : 'other' }
+GtGemstoneHttpClient class >> new [
+	^ self basicNew initialize
+]
+
 { #category : 'other' }
 GtGemstoneHttpClient >> beOneShot [
 ]
@@ -22,15 +28,58 @@ GtGemstoneHttpClient >> contents: aDict [
 	contents := aDict
 ]
 
+{ #category : 'other' }
+GtGemstoneHttpClient >> contentType [
+	^ contentType
+]
+
+{ #category : 'other' }
+GtGemstoneHttpClient >> contentType: aString [
+	contentType := aString
+]
+
+{ #category : 'other' }
+GtGemstoneHttpClient >> defaultContentType [
+	^ 'application/json'
+]
+
+{ #category : 'other' }
+GtGemstoneHttpClient >> initialize [
+	super initialize.
+	self contentType: self defaultContentType
+]
+
+{ #category : 'other' }
+GtGemstoneHttpClient >> performMethod: aMethod [
+	| curlArguments |
+	curlArguments := {'curl'.
+	'-s'.
+	'--post301'.
+	'-L'.
+	(self url).
+	'-X'.
+	aMethod.
+	'-H'.
+	('''Content-Type: ' , self contentType, '''')} asOrderedCollection.
+
+	self contents
+		ifNotNil: [ :aContents | 
+			curlArguments
+				addAll:
+					{'--data'.
+					('''' , (GtGemstoneHttpJsonSerializer serialize: aContents) , '''')} ].
+
+	^ System performOnServer: (' ' join: curlArguments)
+]
+
 { #category : 'other' }
 GtGemstoneHttpClient >> post [
-	| socket |
-	socket := GsSocket new.
-	(socket connectTo: self url port on: self url authority)
-		ifFalse: [ 
-			socket close.
-			Error signal: 'Unable to connect to target.' ].
-	socket close
+	^ STONJSON fromString: (self performMethod: 'POST')
+]
+
+{ #category : 'other' }
+GtGemstoneHttpClient >> postStreaming [
+	^ (Character cr split: (self performMethod: 'POST')) collect: [:aLine | STONJSON fromString: aLine]
 ]
 
 { #category : 'other' }

src/GToolkit-GemStone-GemStone/GtGemstoneHttpJsonSerializer.class.st

@@ -0,0 +1,31 @@
+Class {
+	#name : 'GtGemstoneHttpJsonSerializer',
+	#superclass : 'Object',
+	#category : 'GToolkit-GemStone-GemStone'
+}
+
+{ #category : 'other' }
+GtGemstoneHttpJsonSerializer class >> serialize: anObject [
+	^ STONJSON toString: (self serializeObject: anObject)
+]
+
+{ #category : 'other' }
+GtGemstoneHttpJsonSerializer class >> serializeCollection: aCollection [
+	^ (aCollection collect: [:aValue | self serializeObject: aValue]) asArray
+]
+
+{ #category : 'other' }
+GtGemstoneHttpJsonSerializer class >> serializeDict: anObject [
+	^ anObject collect: [:aValue | self serializeObject: aValue]
+]
+
+{ #category : 'other' }
+GtGemstoneHttpJsonSerializer class >> serializeObject: anObject [
+	(anObject isKindOf: Dictionary)
+		ifTrue: [ ^ self serializeDict: anObject ].
+	(anObject isKindOf: String)
+		ifTrue: [ ^ anObject ].
+	(anObject isKindOf: Collection)
+		ifTrue: [ ^ self serializeCollection: anObject ].
+	^ anObject
+]

src/GToolkit-GemStone-GemStone/Number.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : 'Number' }
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+Number >> nanoSeconds [
+	^ Duration nanoSeconds: self
+]

src/GToolkit-GemStone-GemStone/Object.extension.st

@@ -1,13 +1,13 @@
-Extension { #name : #Object }
+Extension { #name : 'Object' }
 
-{ #category : #'*GToolkit-GemStone-GemStone' }
+{ #category : '*GToolkit-GemStone-GemStone' }
 Object >> asGtGsArgument [
 	"Answer the the local object of the receiver"
 
 	^ self
 ]
 
-{ #category : #'*GToolkit-GemStone-GemStone' }
+{ #category : '*GToolkit-GemStone-GemStone' }
 Object >> asGtRsrProxyObjectForConnection: aRsrConnection [
 	"Answer the receiver with unsupported objects converted to GtRsrProxyServiceServers.
 	Ideally we would look up objects in the connection and use the same proxy, but that isn't happening yet."
@@ -17,14 +17,14 @@ Object >> asGtRsrProxyObjectForConnection: aRsrConnection [
 	^ self
 ]
 
-{ #category : #'*GToolkit-GemStone-GemStone' }
+{ #category : '*GToolkit-GemStone-GemStone' }
 Object >> gtDo: gtoolkitBlock gemstoneDo: gemstoneBlock [
 	"Evaluate the supplied platform specific block"
 
 	^ gemstoneBlock value
 ]
 
-{ #category : #'*GToolkit-GemStone-GemStone' }
+{ #category : '*GToolkit-GemStone-GemStone' }
 Object >> instVarNamed: instVarName [
 	| index |
 
@@ -33,7 +33,7 @@ Object >> instVarNamed: instVarName [
 	^ self instVarAt: index
 ]
 
-{ #category : #'*GToolkit-GemStone-GemStone' }
+{ #category : '*GToolkit-GemStone-GemStone' }
 Object >> instVarNamed: instVarName put: anObject [
 	| index |
 
@@ -42,8 +42,18 @@ Object >> instVarNamed: instVarName put: anObject [
 	self instVarAt: index put: anObject
 ]
 
-{ #category : #'*GToolkit-GemStone-GemStone' }
+{ #category : '*GToolkit-GemStone-GemStone' }
+Object >> isDictionary [
+	^ false
+]
+
+{ #category : '*GToolkit-GemStone-GemStone' }
 Object >> isInteger [
 
 	^ false
 ]
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+Object >> isNotNil [
+	^ self ~~ nil
+]

src/GToolkit-GemStone-GemStone/Pragma.extension.st

@@ -0,0 +1,8 @@
+Extension { #name : 'Pragma' }
+
+{ #category : '*GToolkit-GemStone-GemStone' }
+Pragma >> methodSelector [
+	"Answer the selector of the method containing the pragma."
+
+	^ method selector.
+]

src/GToolkit-GemStone-GemStone/String.extension.st

@@ -1,10 +1,27 @@
 Extension { #name : 'String' }
 
+{ #category : '*GToolkit-GemStone-GemStone' }
+String class >> cr [
+	^ self with: Character cr
+]
+
 { #category : '*GToolkit-GemStone-GemStone' }
 String >> / anotherString [
 	^ self , '/', anotherString
 ]
 
+{ #category : '*GToolkit-GemStone-GemStone' }
+String >> repeat: aNumber [
+	"Returns a new string concatenated by itself repeated n times"
+	"('abc' repeat: 3) >>> 'abcabcabc'"
+
+	aNumber < 0 ifTrue: [ self error: 'aNumber cannot be negative' ].
+	^ self species
+		new: self size * aNumber
+		streamContents: [ :stringStream |
+			1 to: aNumber do: [ :idx | stringStream nextPutAll: self ] ]
+]
+
 { #category : '*GToolkit-GemStone-GemStone' }
 String >> utf8Encoded [
 	"Answer a ByteArray of the receiver in UTF8 format"