Sync to latest version of STON and add BaselineOfSton

pharo-project#5166

src/BaselineOfSton/BaselineOfSton.class.st

@@ -0,0 +1,23 @@
+"
+I am BaselineOfSton, I load STON (Smalltalk Object Notation).
+I am a BaselineOf.
+"
+Class {
+	#name : #BaselineOfSton,
+	#superclass : #BaselineOf,
+	#category : #BaselineOfSton
+}
+
+{ #category : #baselines }
+BaselineOfSton >> baseline: spec [
+	<baseline>
+	spec
+		for: #common
+		do: [ spec blessing: #baseline.
+			spec
+				package: 'STON-Core';
+				package: 'STON-Tests';
+				package: 'STON-Text support';
+				group: 'Core' with: #('STON-Core');
+				group: 'default' with: #('STON-Core' 'STON-Text support' 'STON-Tests') ]
+]

src/BaselineOfSton/package.st

@@ -0,0 +1 @@
+Package { #name : #BaselineOfSton }

src/STON-Core/Bag.extension.st

@@ -0,0 +1,21 @@
+Extension { #name : #Bag }
+
+{ #category : #'*STON-Core' }
+Bag class >> fromSton: stonReader [
+	"Read a map representation containing element/occurences pairs"
+
+	| bag |
+	bag := self new.
+	stonReader parseMapDo: [ :key :value |
+		bag add: key withOccurrences: value ].
+	^ bag
+]
+
+{ #category : #'*STON-Core' }
+Bag >> stonOn: stonWriter [
+	"Use a map with element-occurences pairs as representation"
+
+	stonWriter 
+		writeObject: self 
+		do: [ stonWriter encodeMap: contents ]
+]

src/STON-Core/ByteArray.extension.st

@@ -2,6 +2,8 @@ Extension { #name : #ByteArray }
 
 { #category : #'*ston-core' }
 ByteArray class >> fromSton: stonReader [
+	"Use a hex representation"
+
 	^ self readHexFrom: stonReader parseListSingleton
 ]
 

src/STON-Core/Collection.extension.st

@@ -2,6 +2,10 @@ Extension { #name : #Collection }
 
 { #category : #'*ston-core' }
 Collection class >> fromSton: stonReader [
+	"For collections we chose to instanciate based a list of elements using #add:
+	This is not the best or most correct solution for all subclasses though,
+	so some will revert to standard object behavior or chose another solution."
+
 	| collection |
 	collection := self new.
 	stonReader parseListDo: [ :each |
@@ -11,6 +15,10 @@ Collection class >> fromSton: stonReader [
 
 { #category : #'*ston-core' }
 Collection >> stonOn: stonWriter [
+	"For collections we chose to write a list of elements as delivered by #do:
+	This is not the best or most correct solution for all subclasses though,
+	so some will revert to standard object behavior or chose another solution"
+
 	stonWriter writeObject: self do: [
 		stonWriter encodeList: self ]
 

src/STON-Core/Color.extension.st

@@ -0,0 +1,37 @@
+Extension { #name : #Color }
+
+{ #category : #'*ston-core' }
+Color class >> fromSton: stonReader [
+	| representation |
+	representation := stonReader parseMapOrListRepresentation.
+	^ representation isArray
+		ifTrue: [ 
+			self named: representation first ]
+		ifFalse: [ 
+			(representation includesKey: #rgb)
+				ifTrue: [ 
+					self basicNew setRGB: (representation at: #rgb); setAlpha: 1.0 "backwards compatibility" ]
+				ifFalse: [ 
+					self 
+						r: (representation at: #red) 
+						g: (representation at: #green) 
+						b: (representation at: #blue) 
+						alpha: (representation at: #alpha) ] ]
+]
+
+{ #category : #'*ston-core' }
+Color >> stonContainSubObjects [
+	^ false
+]
+
+{ #category : #'*ston-core' }
+Color >> stonOn: stonWriter [
+	| name |
+	(self isTranslucent or: [ (name := self name) = #unnamed ])
+		ifTrue: [ 
+			stonWriter writeObject: self streamMap: [ :map |
+				#(red green blue alpha) do: [ :each | 
+					map at: each put: ((self perform: each) roundTo: 0.001) ] ] ]
+		ifFalse: [ 
+			stonWriter writeObject: self listSingleton: name ]
+]

src/STON-Core/Date.extension.st

@@ -2,17 +2,46 @@ Extension { #name : #Date }
 
 { #category : #'*ston-core' }
 Date class >> fromSton: stonReader [
-	^ self readFrom: stonReader parseListSingleton readStream
+	"Read a ISO YYYY-MM-DD format.
+	Since my current implementation is time zone offset sensitive, the offset has to be taken into account.
+	A missing offset results in the local timezone offset to be used"
+
+	| readStream date |
+	readStream := stonReader parseListSingleton readStream.
+	date := self readFrom: readStream.
+	readStream atEnd
+		ifFalse: [ | offset |
+			offset := DateAndTime readTimezoneOffsetFrom: readStream.
+			offset = date offset 
+				ifFalse: [ date start: (date start translateTo: offset) ] ].
+	^ date
 ]
 
 { #category : #'*ston-core' }
 Date >> stonContainSubObjects [ 
 	^ false
 ]
 
-{ #category : #'*STON-Core' }
+{ #category : #'*ston-core' }
 Date >> stonOn: stonWriter [
-	"Use an ISO style YYYY-MM-DD representation"
-
-	stonWriter writeObject: self listSingleton: self yyyymmdd
+	"Use an ISO style YYYY-MM-DD representation.
+	Since my current implementation is time zone offset sensitive, the offset has to be included."
+
+	| representation |
+	representation := self offset isZero
+		ifTrue: [ 
+			String new: 11 streamContents: [ :out | 
+				self printOn: out format: #(3 2 1 $- 1 1 2).
+				out nextPut: $Z ] ]
+		ifFalse: [ 
+			String new: 32 streamContents: [ :out | 
+				self printOn: out format: #(3 2 1 $- 1 1 2).
+				out nextPut: (self offset positive ifTrue: [ $+ ] ifFalse: [ $- ]).
+				self offset hours abs printOn: out base: 10 length: 2 padded: true.
+				out nextPut: $:.
+				self offset minutes abs printOn: out base: 10 length: 2 padded: true.
+				self offset seconds = 0 
+					ifFalse:[ 
+						out nextPut: $:; print: self offset seconds abs truncated ] ] ].
+	stonWriter writeObject: self listSingleton: representation
 ]

src/STON-Core/FileReference.extension.st

@@ -0,0 +1,20 @@
+Extension { #name : #FileReference }
+
+{ #category : #'*ston-core' }
+FileReference >> stonContainSubObjects [
+	^ false
+]
+
+{ #category : #'*ston-core' }
+FileReference >> stonOn: stonWriter [
+	self fileSystem isDiskFileSystem
+		ifTrue: [ | diskFilePath |
+			diskFilePath := String streamContents: [ :out | 
+				filesystem printPath: path on: out ].
+			stonWriter 
+				writeObject: self 
+				named: STONFileReference stonName 
+				listSingleton: diskFilePath ]
+		ifFalse: [ 
+			super stonOn: stonWriter ]
+]

src/STON-Core/Fraction.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : #Fraction }
+
+{ #category : #'*ston-core' }
+Fraction >> stonOn: stonWriter [
+	stonWriter writeFraction: self
+]

src/STON-Core/Interval.extension.st

@@ -1,18 +1,24 @@
 Extension { #name : #Interval }
 
+{ #category : #'*ston-core' }
+Interval >> fromSton: stonReader [
+	"Overwritten to get back the standard object behavior"
+
+	stonReader parseNamedInstVarsFor: self
+]
+
 { #category : #'*ston-core' }
 Interval class >> fromSton: stonReader [
+	"Overwritten to get back the standard object behavior"
+
 	^ self new
 		fromSton: stonReader;
 		yourself
 ]
 
-{ #category : #'*ston-core' }
-Interval >> fromSton: stonReader [
-	stonReader parseNamedInstVarsFor: self
-]
-
 { #category : #'*ston-core' }
 Interval >> stonOn: stonWriter [
+	"Overwritten to get back the standard object behavior"
+
 	stonWriter writeObject: self
 ]

src/STON-Core/Object.extension.st

@@ -44,7 +44,8 @@ Object >> stonContainSubObjects [
 
 { #category : #'*ston-core' }
 Object class >> stonName [
-	"Override to encode my instances using a different class name."
+	"Override to encode my instances using a different class name.
+	Use symbols as class name/tag."
 
 	^ self name
 ]

src/STON-Core/OrderedDictionary.extension.st

@@ -13,9 +13,15 @@ OrderedDictionary class >> fromSton: stonReader [
 
 { #category : #'*ston-core' }
 OrderedDictionary >> stonOn: stonWriter [
-	"I store my instances as maps"
+	"I store my instances as maps. When in JSON mode, 
+	encode me directly, without a class tag, keeping the order."
 
-	stonWriter 
-		writeObject: self 
-		do: [ stonWriter encodeMap: self ]
+	stonWriter jsonMode 
+		ifTrue: [ 
+			stonWriter encodeMap: self ] 
+		ifFalse: [ 
+			stonWriter 
+				writeObject: self 
+				do: [ stonWriter encodeMap: self ] ]
+
 ]

src/STON-Core/STON.class.st

@@ -135,6 +135,8 @@ S y n t a x
 	  uppercase-alpha-char alphanumeric-char
 	number
 	  int
+	  int denominator
+	  int denominator scale
 	  int frac
 	  int exp
 	  int frac exp
@@ -143,6 +145,10 @@ S y n t a x
 	  digit1-9 digits 
 	  - digit
 	  - digit1-9 digits
+	denominator
+	  / digits
+	scale
+	  s digits
 	frac
 	  . digits
 	exp
@@ -162,7 +168,7 @@ S y n t a x
 Class {
 	#name : #STON,
 	#superclass : #Object,
-	#category : #'STON-Core-Base'
+	#category : #'STON-Core-Facade'
 }
 
 { #category : #accessing }

src/STON-Core/STONCStyleCommentsSkipStream.class.st

@@ -29,7 +29,7 @@ Class {
 		'delimiter',
 		'escape'
 	],
-	#category : #'STON-Core-Utilities'
+	#category : #'STON-Core-Reader'
 }
 
 { #category : #'instance creation' }
@@ -190,7 +190,7 @@ STONCStyleCommentsSkipStream >> nextNonCommentChar [
 		ifTrue: [ 
 			^ self handleStringDelimiter: char ].
 	escape := false. 
-	^ (char = $/ and: [ self insideString not ])
+	^ (char = $/ and: [ self insideString not and: [ (stream peek = $/) | (stream peek = $*) ] ])
 		ifTrue: [ 
 			self consumeComment.
 			stream next ]
@@ -233,16 +233,11 @@ STONCStyleCommentsSkipStream >> readInto: collection startingAt: offset count: r
 	Return the number of elements actually read."
 	
 	^ peekedCharacter 
-		ifNil: [ | readCount |
-			[ readCount := self encoder 
-					readInto: collection 
-					startingAt: offset 
-					count: requestedCount 
-					fromStream: stream ]
-				on: ZnByteStringBecameWideString 
-				do: [ :byteStringBecameWideString | 
-					byteStringBecameWideString becomeForward; resume ].
-			readCount ]
+		ifNil: [
+			0 to: requestedCount - 1 do: [ :count | | object |
+				(object := self nextNonCommentChar) ifNil: [ ^ count ].  
+				collection at: offset + count put: object ].
+			^ requestedCount ]
 		ifNotNil: [ 
 			collection at: offset put: peekedCharacter.
 			peekedCharacter := nil.

src/STON-Core/STONFileReference.class.st

@@ -0,0 +1,20 @@
+"
+I am STONFileReference, I am an implementation artifact to help reading objects with class tag equal to my #stonName.
+
+I am a FileReference.
+"
+Class {
+	#name : #STONFileReference,
+	#superclass : #FileReference,
+	#category : #'STON-Core-Reader'
+}
+
+{ #category : #ston }
+STONFileReference class >> fromSton: stonReader [
+	^ stonReader parseListSingleton asFileReference.
+]
+
+{ #category : #ston }
+STONFileReference class >> stonName [
+	^ #FILE
+]

src/STON-Core/STONJSON.class.st

@@ -35,7 +35,7 @@ For a much more sophisticated JSON parser/writer implementation, have a look at
 Class {
 	#name : #STONJSON,
 	#superclass : #Object,
-	#category : #'STON-Core-Base'
+	#category : #'STON-Core-Facade'
 }
 
 { #category : #convenience }