Initial port from Pharo
Based on 305ae856d4b551 from https://github.com/svenvc/ston.git
"{ Package: 'stx:goodies/ston' }"!
!Association methodsFor:'*ston-core'!
stonOn: stonWriter
self class == STON associationClass
ifTrue: [ stonWriter writeAssociation: self ]
ifFalse: [ super stonOn: stonWriter ]
! !
!Bag methodsFor:'*STON-Core'!
stonOn: stonWriter
"Use a map with element-occurences pairs as representation"
stonWriter
writeObject: self
do: [ stonWriter encodeMap: contents ]
! !
!Bag class methodsFor:'*STON-Core'!
fromSton: stonReader
"Read a map representation containing element/occurences pairs"
| bag |
bag := self new.
stonReader parseMapDo: [ :key :value |
bag add: key withOccurrences: value ].
^ bag
! !
!Boolean methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!Boolean methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter writeBoolean: self
! !
!ByteArray methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!ByteArray methodsFor:'*ston-core'!
stonOn: stonWriter
"Use a hex representation"
stonWriter writeObject: self listSingleton: self hexPrintString
"Modified: / 04-06-2019 / 11:06:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ByteArray class methodsFor:'*ston-core'!
fromSton: stonReader
"Use a hex representation"
^ self fromHexString: stonReader parseListSingleton
"Modified: / 04-06-2019 / 11:07:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Character methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter writeObject: self listSingleton: self asString
! !
!Character class methodsFor:'*ston-core'!
fromSton: stonReader
^ stonReader parseListSingleton first
! !
!CharacterArray class methodsFor:'Compatibility-Pharo'!
findFirstInString: aString inSet: inclusionMap startingAt: start
| i stringSize |
inclusionMap size ~= 256 ifTrue: [ ^0 ].
i := start.
stringSize := aString size.
[ i <= stringSize and: [ (inclusionMap at: (aString basicAt: i) codePoint + 1) = 0 ] ] whileTrue: [
i := i + 1 ].
i > stringSize ifTrue: [ ^0 ].
^i
"Created: / 20-05-2020 / 13:24:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Class methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter
writeObject: self
listSingleton: self name asSymbol
! !
!Class class methodsFor:'*ston-core'!
fromSton: stonReader
| theClassName theClass |
theClassName := stonReader parseListSingleton.
theClass := self environment at: theClassName.
^ theClass
! !
!ClassDescription methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!Collection methodsFor:'*ston-core'!
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 ]
! !
!Collection class methodsFor:'*ston-core'!
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 |
collection add: each ].
^ collection
! !
!Color methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!Color methodsFor:'*ston-core'!
stonOn: stonWriter
| name |
(self isTranslucent or: [ (name := self name) = nil ])
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 ]
"Modified: / 20-05-2020 / 13:27:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Color class methodsFor:'*ston-core'!
fromSton: stonReader
| representation |
representation := stonReader parseSimpleValue.
^ representation isArray
ifTrue: [
self name: representation first ]
ifFalse: [
self
r: (representation at: #red)
g: (representation at: #green)
b: (representation at: #blue)
alpha: (representation at: #alpha) ]
"Modified: / 20-05-2020 / 12:22:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Date methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!Date methodsFor:'*ston-core'!
stonOn: stonWriter
"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
! !
!Date class methodsFor:'*ston-core'!
fromSton: stonReader
"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
! !
!Dictionary methodsFor:'*ston-core'!
stonOn: stonWriter
"Instances of STON mapClass will be encoded directly, without a class tag.
Other (sub)classes will be encoded with a class tag and will use a map representation. "
self class == STON mapClass
ifTrue: [
stonWriter writeMap: self ]
ifFalse: [
stonWriter
writeObject: self
do: [ stonWriter encodeMap: self ] ]
! !
!Dictionary methodsFor:'*ston-core'!
stonPostReferenceResolution
"When references were resolved in me, the hash of my keys might have changed.
Check if I am still healthy and rehash me if not."
self rehash
"Modified: / 04-06-2019 / 11:08:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Dictionary class methodsFor:'*ston-core'!
fromSton: stonReader
"Instances of STON mapClass will be read directly and won't arrive here.
Other (sub)classes will use this method."
| dictionary |
dictionary := self new.
stonReader parseMapDo: [ :key :value |
dictionary at: key put: value ].
^ dictionary
! !
!Filename methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!Filename methodsFor:'*ston-core'!
stonOn: stonWriter
true
ifTrue: [ | diskFilePath |
diskFilePath := self pathName.
stonWriter
writeObject: self
named: STONFileReference stonName
listSingleton: diskFilePath ]
ifFalse: [
super stonOn: stonWriter ]
"Modified: / 04-06-2019 / 12:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Fraction methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter writeFraction: self
! !
!Integer methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter writeInteger: self
! !
!Interval methodsFor:'*ston-core'!
fromSton: stonReader
"Overwritten to get back the standard object behavior"
stonReader parseNamedInstVarsFor: self
! !
!Interval methodsFor:'*ston-core'!
stonOn: stonWriter
"Overwritten to get back the standard object behavior"
stonWriter writeObject: self
! !
!Interval class methodsFor:'*ston-core'!
fromSton: stonReader
"Overwritten to get back the standard object behavior"
^ self new
fromSton: stonReader;
yourself
! !
!Metaclass methodsFor:'*ston-core'!
stonName
^ #Class
! !
!Metaclass methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter
writeObject: self
listSingleton: self theNonMetaclass name asSymbol
"Modified: / 04-06-2019 / 11:20:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Metaclass class methodsFor:'*ston-core'!
fromSton: stonReader
| theClassName theClass theMetaclass |
theClassName := stonReader parseListSingleton.
theClass := self environment at: theClassName.
theMetaclass := theClass class.
^ theMetaclass
! !
!Number methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!Number methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter writeFloat: self asFloat
! !
!Object methodsFor:'*ston-core'!
fromSton: stonReader
"Decode non-variable classes from a map of their instance variables and values.
Override to customize and add a matching #toSton: (see implementors)."
self class isVariable
ifTrue: [
stonReader error: 'custom #fromSton: implementation needed for variable/indexable class' ]
ifFalse: [
stonReader parseNamedInstVarsFor: self ]
! !
!Object methodsFor:'*ston-core'!
isStonReference
^ false
! !
!Object methodsFor:'*ston-core'!
stonContainSubObjects
"Return true if I contain subObjects that should be processed, false otherwise.
Overwrite when necessary. See also #stonProcessSubObjects:"
^ true
! !
!Object methodsFor:'*ston-core'!
stonOn: stonWriter
"Encode non-variable classes with a map of their instance variable and values.
Override to customize and add a matching #fromSton: (see implementors)."
self class isVariable
ifTrue: [
stonWriter error: 'custom #stonOn: implementation needed for variable/indexable class' ]
ifFalse: [
stonWriter writeObject: self ]
! !
!Object methodsFor:'*ston-core'!
stonPostReferenceResolution
"Hook that is called when references were resolved processing this object or one of its sub objects. This will most probably influence hash values. Override to take appropriate action."
! !
!Object methodsFor:'*ston-core'!
stonProcessSubObjects: block
"Execute block to (potentially) change each of my subObjects.
In general, all instance and indexable variables are processed.
Overwrite when necessary. Not used when #stonContainSubObjects returns false."
1 to: self class instSize do: [ :each |
self instVarAt: each put: (block value: (self instVarAt: each)) ].
(self class isVariable and: [ self class isBytes not ])
ifTrue: [
1 to: self basicSize do: [ :each |
self basicAt: each put: (block value: (self basicAt: each)) ] ]
! !
!Object methodsFor:'*ston-core'!
stonShouldWriteNilInstVars
"Return true if my instance variables that are nil should be written out,
false otherwise. Overwrite when necessary. By default, return false."
^ false
! !
!Object class methodsFor:'*ston-core'!
fromSton: stonReader
"Create a new instance and delegate decoding to instance side.
Override only when new instance should be created directly (see implementors). "
^ self new
fromSton: stonReader;
yourself
! !
!Object class methodsFor:'*ston-core'!
stonAllInstVarNames
"Override to encode my instances using a custom set of instance variables or to define their order."
^ self allInstVarNames
! !
!Object class methodsFor:'*ston-core'!
stonName
"Override to encode my instances using a different class name.
Use symbols as class name/tag."
^ self name
! !
!OrderedDictionary methodsFor:'*ston-core'!
stonOn: stonWriter
"I store my instances as maps. When in JSON mode,
encode me directly, without a class tag, keeping the order."
stonWriter jsonMode
ifTrue: [
stonWriter encodeMap: self ]
ifFalse: [
stonWriter
writeObject: self
do: [ stonWriter encodeMap: self ] ]
! !
!OrderedDictionary class methodsFor:'*ston-core'!
fromSton: stonReader
"My instances are stored as maps."
| dictionary |
dictionary := self new.
stonReader parseMapDo: [ :key :value |
dictionary at: key put: value ].
^ dictionary
! !
!Point methodsFor:'*ston-core'!
fromSton: stonReader
stonReader parseListDo: [ :each :index |
index = 1 ifTrue: [ x := each ].
index = 2 ifTrue: [ y := each ] ]
! !
!Point methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter writeObject: self streamShortList: [ :array |
array add: x; add: y ]
! !
!RunArray class methodsFor:'*ston-core'!
fromSton: stonReader
"Overwritten to get back the standard object behavior"
^ self new
fromSton: stonReader;
yourself
! !
!SequenceableCollection methodsFor:'*ston-core'!
stonOn: stonWriter
"Instances of STON listClass will be encoded directly, without a class tag.
Other (sub)classes will be encoded with a class tag and will use a list representation. "
((self class == STON listClass) or:[ self class == ImmutableArray ])
ifTrue: [ stonWriter writeList: self ]
ifFalse: [ super stonOn: stonWriter ]
"Modified: / 20-05-2020 / 11:19:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SequenceableCollection class methodsFor:'*ston-core'!
fromSton: stonReader
"Overwritten to use #streamContents: and #nextPut:"
^ self streamContents: [ :stream |
stonReader parseListDo: [ :each |
stream nextPut: each ] ]
! !
!Set methodsFor:'*ston-core'!
stonPostReferenceResolution
"When references were resolved in me, the hash of my elements might have changed.
Check if I am still healthy and rehash me if not."
self rehash
"Modified: / 04-06-2019 / 11:18:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!String methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!String methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter writeString: self
! !
!Symbol methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter writeSymbol: self
! !
!Time methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!Time methodsFor:'*ston-core'!
stonOn: stonWriter
"Use an ISO style HH:MM:SS.N representation (with optional nanoseconds)"
stonWriter writeObject: self listSingleton:
(String streamContents: [ :stream |
self print24: true showSeconds: true on: stream ])
! !
!Time class methodsFor:'*ston-core'!
fromSton: stonReader
^ self readFrom: stonReader parseListSingleton readStream
! !
!Timestamp methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!Timestamp methodsFor:'*ston-core'!
stonOn: stonWriter
"Use an ISO representation with all details YYYY-MM-DDTHH:MM:SS.N+TZ (with optional nanoseconds and timezone offset)"
stonWriter writeObject: self listSingleton:
(String streamContents: [ :stream |
self printOn: stream withLeadingSpace: false ])
! !
!Timestamp class methodsFor:'*ston-core'!
fromSton: stonReader
^ self readFrom: stonReader parseListSingleton readStream
! !
!URL class methodsFor:'*ston-core'!
fromSton: stonReader
| representation |
representation := stonReader parseSimpleValue.
representation isArray ifTrue:[
^ representation first asURL
] ifFalse:[
self error: 'Not yet supported'
].
"Created: / 20-05-2020 / 11:54:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UndefinedObject methodsFor:'*ston-core'!
stonContainSubObjects
^ false
! !
!UndefinedObject methodsFor:'*ston-core'!
stonOn: stonWriter
stonWriter writeNull
! !
!stx_goodies_ston class methodsFor:'documentation'!
extensionsVersion_HG
^ '$Changeset: <not expanded> $'
! !