"{ 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.