Cached Mementos - To Copy or Not To Copy? (#344)

* Cached Mementos - To Copy or Not To Copy?

- Hopefully finally resolves a buffet of related issues (and PRs) mentioned below
- Add Lepiter page describing the situation

- The problem is that mementos were copying described values in two places:
    - ```smalltalk
MACachedMemento>>cookRawPull: aDictionary

	super cookRawPull: aDictionary.
	aDictionary keysAndValuesDo: [ :key :value |
		| isCollectionOfRelations |
		isCollectionOfRelations := value isCollection and: [ key isKindOf: MAToManyRelationDescription ].
		isCollectionOfRelations ifTrue: [ 
			aDictionary at: key put: value copy ] ].```
    - There are several problems with the above: Firstly, it is applied to cached mementos. This overly broad, since the motivating problem affects the `original` dictionary - something only checked mementos have. Even worse, it applies to all pulls, not just those to `original` dictionaries. This lead to a host of problems described in more detail below.
    - ```smalltalk
MACheckedMemento>>reset
	super reset.
	self setOriginal: (self pullRawTransforming: [ :e | e copy ]).
```
        - While this second copying might sometimes be what we want, it clearly does not work in some scenarios, creating the false impression that the model object has changed elsewhere, which prevents committing the memento.
        - For example, {{gtMethod:MAMementoTest>>testSingletonValue}} was failing because the value was a class and the memento was storing a copying of it. Validation then failed because the installed class is not equivalent to a copy.
- Let's take a step back and review the domain model. For checked mementos, there are three versions of model state:
    - 1. the model itself, which is the real *current* state
    - 2. the cache, which is the desired state which the memento will attempt to push all at once on commit
    - 3. the original, which is the memento's copy of the model state at the time the memento was created. This will be used before committing to make sure the model state hasn't changed elsewhere because otherwise committing might intentionally overwrite/destroy needed data.
- The motivating problem with the *original*, which inspired all this copying, is that, if a field references a collection, and we hold onto that actual collection, and the elements in the collection are changed from the outside, our "original" will also change and validation will never fail and so offers no protection.
    - {{gtMethod:MACheckedMementoTest>>testValidateFailsOnReferencedCollectionChange}} tests for this. If we comment out the `#copy` in {{gtMethod:MACheckedMemento>>reset}} it will fail.
    - Interestingly, outside changes also "bleed" into the cache, but it seems not to matter. If a user was worried about outside changes, they would use an {{gtClass:MACheckedMemento}} which would flag the problem during validation, not an {{gtClass:MACachedMemento}}. Choosing that memento type means we are specifically *not* checking for whether the model has changed elsewhere. Since the cache is changing with the model, there will be nothing to commit unless we explicitly change the field in the memento, which seems like the expected behavior.
- There are a bunch of seemingly related GH issues and PRs:
    - 2019-09-04 - [Mementos Should Ignore Default values](#120) - claims to be fixed by the "...Copy Collections" fix below, but I don't see how
    - 2022-05-31 - [Cached Memento Should Copy ToMany Collections](#281) - this first fix led to a lot of future pain. The primary mistake seems to have been that it was applied to all pulls by cached mementos, instead of just pulls to the original dictionary by checked mementos only. The issue talks about "the protection of the cache", but I think I meant "the protection of the original dictionary" because I don't see what damage could be caused by the cache changing underneath you. If you explicitly change a field, it will overwrite the cache, and if not it will be ignored because it is equivalent to the real live model state.
    - 2022-08-22 - [Checked Memento "Original" Should Copy Collections](#295) - the description states "Otherwise changes to the model can bleed through to the "original" dictionary". However, the fix is applied to cached memento, not checked memento only
    - 2022-08-23 - [Bloc Form To-One Tokens Pointing to Copy](#304) - tried to workaround ramifications of the overly broad copy problem fix
    - 2022-08-23 - [Mementos - Only Copy Checked Original](https://github.com/magritte-metamodel/magritte/pull/305/files) attempted to improve the situation by replacing the original behavior - when pulling copy every value in every memento type - with a more targeted approach - copy only when setting the original of a checked memento. However, this still copied *all* values, not just the problematic referenced collections. It also missed the fact that cached mementos were copying collections during all pulls via `#cookPullRaw:`, not just when pulling to the original dictionary. It also seemingly undid some of the fix above
    - 2023-11-18 Checked Memento raises errors for Pier components - there is a now-passing test for just this scenario - MAMementoTest>>testSingletonValue

source/Magritte-Model/MACachedMemento.class.st

@@ -27,23 +27,11 @@ MACachedMemento >> commit [
 	self reset
 ]
 
-{ #category : #private }
-MACachedMemento >> cookRawPull: aDictionary [
-
-	super cookRawPull: aDictionary.
-	aDictionary keysAndValuesDo: [ :key :value |
-		| isCollectionOfRelations |
-		self flag: 'duplicate logic with cookRawPull:'.
-		isCollectionOfRelations := value isCollection and: [ key isKindOf: MAToManyRelationDescription ].
-		isCollectionOfRelations ifTrue: [ 
-			aDictionary at: key put: value copy ] ].
-]
-
 { #category : #testing }
 MACachedMemento >> hasChanges [
 	"Answer ==true==, if the cached data is different to the data in the model."
 
-	^ self isDifferent: self cache to: self pullRaw
+	^ self has: self cache changedFrom: self pullRaw
 ]
 
 { #category : #private }

source/Magritte-Model/MACheckedMemento.class.st

@@ -19,7 +19,7 @@ MACheckedMemento >> hasConflict [
 
 { #category : #testing }
 MACheckedMemento >> hasModelChangedElsewhere [
-	^ self isDifferent: self original to: self pullRaw
+	^ self has: self original changedFrom: self pullRaw
 ]
 
 { #category : #accessing }
@@ -29,10 +29,24 @@ MACheckedMemento >> original [
 
 { #category : #actions }
 MACheckedMemento >> reset [
+
+	| dict |
 	super reset.
-	self setOriginal: (self pullRawTransforming: [ :e | e copy ]).
 
-	"Implementation note: We copy the field values because checked mementos compare this to the current object to see if it has changed elsewhere. Unless we make a copy each time, this comparison would not be possible for complex objects, because any changes to them from outside will be reflected equally in this `original` dictionary. E.g. if `original at: #person == self model person` and outside someone does `self model person age: 25`, the check above would pass even though it should fail."
+	dict := self pullRawTransforming: [ :value :desc |
+		| isCollectionOfRelations |
+		isCollectionOfRelations := value isCollection and: [ (desc isKindOf: MAReferenceDescription) and: [ desc isMultiple ] ].
+		isCollectionOfRelations 
+			ifTrue: [ value copy ]
+			ifFalse: [ value ] ].
+
+	self setOriginal: dict.
+
+	"Implementation note: We copy some field values because checked mementos compare them to the current object to see if it has changed elsewhere. If a field references a collection, and we hold onto that actual collection, and the elements in the collection are changed from the outside, our 'original' will also change and validation will never fail and so offers no protection. We limit the copying to just this case because copying can cause other unforeseen problems.
+	
+	One example is illustrated in MAMementoTest>>testSingletonValue.
+	
+	Another is that we had at one time done the copying in MACachedMemento>>#cookPullRaw:, but it proved too dangerous because the *cache* also contained copies, not just the *original* as here. For example (ignoring the question of whether this is good design), what if the model required that a field point to a *particular* collection? We might replace that particular collection with a copy, which then goes out of sync with the 'real' collection. Now, outside changes also 'bleed' into caches, but it seems not to matter. If a user was worried about outside changes, they would use an MACheckedMemento which would flag the problem during validation, not an MACachedMemento. Choosing a cached memento means we are specifically *not* checking for whether the model has changed elsewhere. Since the cache is changing with the model, there will be nothing to commit unless we explicitly change the field in the memento, which seems like the expected behavior."
 ]
 
 { #category : #initialization }
@@ -43,10 +57,13 @@ MACheckedMemento >> setOriginal: aDictionary [
 { #category : #'private-testing' }
 MACheckedMemento >> shouldPush: anObject using: aDescription [
 
-	| originalValue cachedValue |
+	| originalValue cachedValue didChangeHere |
 	originalValue := self original at: aDescription.
 	cachedValue := self cache at: aDescription.
-	^ (originalValue = cachedValue) not and: [ super shouldPush: anObject using: aDescription ]
+
+	didChangeHere := aDescription shouldWrite: cachedValue over: originalValue.
+
+	^ didChangeHere and: [ super shouldPush: anObject using: aDescription ]
 ]
 
 { #category : #actions }

source/Magritte-Model/MAElementDescription.class.st

@@ -121,6 +121,34 @@ MAElementDescription >> printFor: anObject on: aWriteStream [
 	(self read: anObject) ifNotNil: [ :value | aWriteStream nextPutAll: (self toString: value) ]
 ]
 
+{ #category : #utility }
+MAElementDescription >> shouldWrite: anObject over: anotherObject [
+
+	| defaultValues areBothDefaultValues isIgnorableDefault |
+
+	self isVisible ifFalse: [ ^ false ].
+	self isReadOnly ifTrue: [ ^ false ].
+
+	defaultValues := OrderedCollection
+		with: nil
+		with: self undefinedValue.
+
+	isIgnorableDefault := self shouldCacheDefault not and: [ anObject = self default ].
+	isIgnorableDefault ifTrue: [ defaultValues add: self default ].
+
+	areBothDefaultValues := { anObject. anotherObject } allSatisfy: [ :obj | defaultValues includes: obj ].
+
+	areBothDefaultValues ifTrue: [ ^ false ].
+	(anObject == anotherObject or: [ anObject = anotherObject ])
+		ifTrue: [ ^ false ].
+
+	^ true
+
+	"Implementation note: We compare via both #== and #= to cover two scenarios:
+		1) a referenced object that changes on the outside. From our perspective, as long as we are still refering to the same object there is no relevant change. Unless we accept identity equality, any changes to complex objects from outside will bleed into this object. E.g. if outside someone does `self person age: 25`, this object will appear to be changed. This would wreak havoc with mementos, forms, etc.
+		2) objects (e.g. strings and other value objects) that override #= to mean something other than identity comparison."
+]
+
 { #category : #printing }
 MAElementDescription >> storeOn: aStream [
 	aStream 

source/Magritte-Model/MAMemento.class.st

@@ -35,10 +35,13 @@ MAMemento >> commit [
 
 { #category : #private }
 MAMemento >> cookRawPull: aDictionary [
+	"The reason for the somewhat cryptic message name is that each subclass is free to perform any needed actions. Here we just replace undefinedValues with default values"
 
-	aDictionary keysAndValuesDo: [ :key :value |
-		value isNil
-			ifTrue: [ aDictionary at: key put: key default yourself ] ]
+	aDictionary keysAndValuesDo: [ :elemDescription :value |
+		value = elemDescription undefinedValue ifTrue: [ 
+			aDictionary 
+				at: elemDescription 
+				put: elemDescription default ] ]
 ]
 
 { #category : #'reflective operations' }
@@ -50,13 +53,14 @@ MAMemento >> doesNotUnderstand: aMessage [
 ]
 
 { #category : #private }
-MAMemento >> isDifferent: firstDictionary to: secondDictionary [
-	| firstValue secondValue |
-	self magritteDescription do: [ :each |
-		(each isVisible and: [ each isReadOnly not ]) ifTrue: [
-			firstValue := firstDictionary at: each ifAbsent: [ nil ].
-			secondValue := secondDictionary at: each ifAbsent: [ nil ].
-			firstValue = secondValue ifFalse: [ ^ true ] ] ].
+MAMemento >> has: firstDictionary changedFrom: secondDictionary [
+
+	self magritteDescription do: [ :desc |
+		| firstValue secondValue hasFieldChanged |
+		firstValue := firstDictionary at: desc ifAbsent: [ nil ].
+		secondValue := secondDictionary at: desc ifAbsent: [ nil ].
+		hasFieldChanged := desc shouldWrite: firstValue over: secondValue.
+		hasFieldChanged ifTrue: [ ^ true ] ].
 	^ false
 ]
 
@@ -97,11 +101,11 @@ MAMemento >> pullRaw [
 MAMemento >> pullRawTransforming: aBlock [
 	| result |
 	result := Dictionary new.
-	self magritteDescription do: [ :each |
+	self magritteDescription do: [ :elemDescription |
 		| value transformedValue |
-		value := self model readUsing: each.
-		transformedValue := aBlock value: value.
-		result at: each put: transformedValue ].
+		value := self model readUsing: elemDescription.
+		transformedValue := aBlock cull: value cull: elemDescription.
+		result at: elemDescription put: transformedValue ].
 	^ result
 ]
 
@@ -136,7 +140,10 @@ MAMemento >> setModel: aModel [
 
 { #category : #'private-testing' }
 MAMemento >> shouldPush: anObject using: aDescription [
-	^ aDescription isVisible and: [ aDescription isReadOnly not ]
+
+	| modelValue |
+	modelValue := self model readUsing: aDescription.
+	^ aDescription shouldWrite: anObject over: modelValue.
 ]
 
 { #category : #actions }

source/Magritte-Model/MAOptionDescription.class.st

@@ -133,11 +133,6 @@ MAOptionDescription >> isExtensible [
 	^ self extensible
 ]
 
-{ #category : #testing }
-MAOptionDescription >> isMultiple [
-	^false
-]
-
 { #category : #testing }
 MAOptionDescription >> isSorted [
 	^ self sorted

source/Magritte-Model/MAReferenceDescription.class.st

@@ -112,6 +112,11 @@ MAReferenceDescription >> initializer: valuable [
 	self propertyAt: #initializer put: valuable
 ]
 
+{ #category : #testing }
+MAReferenceDescription >> isMultiple [
+	^false
+]
+
 { #category : #copying }
 MAReferenceDescription >> postCopy [
 	super postCopy.

source/Magritte-Model/MAStraightMemento.class.st

@@ -4,7 +4,7 @@ I am a memento that forwards read- and write-access directly to the model. I can
 Class {
 	#name : #MAStraightMemento,
 	#superclass : #MAMemento,
-	#category : 'Magritte-Model-Memento'
+	#category : #'Magritte-Model-Memento'
 }
 
 { #category : #testing }
@@ -20,5 +20,6 @@ MAStraightMemento >> readUsing: aDescription [
 
 { #category : #private }
 MAStraightMemento >> write: anObject using: aDescription [
+	(self shouldPush: anObject using: aDescription) ifFalse: [ ^ self ].
 	self model write: anObject using: aDescription
 ]

source/Magritte-Model/MAToManyRelationDescription.class.st

@@ -129,6 +129,11 @@ MAToManyRelationDescription >> isDefinitive [
 	^ self definitive.
 ]
 
+{ #category : #accessing }
+MAToManyRelationDescription >> isMultiple [
+	^true
+]
+
 { #category : #testing }
 MAToManyRelationDescription >> isOrdered [
 	^ self ordered

source/Magritte-Tests-Model/MACheckedMementoTest.class.st

@@ -80,3 +80,26 @@ MACheckedMementoTest >> testValidateConflictReset [
 	self memento reset.
 	self shouldnt: [ self memento validate ] raise: MAValidationError
 ]
+
+{ #category : #'tests-actions' }
+MACheckedMementoTest >> testValidateFailsOnReferencedCollectionChange [
+
+	| occupants obj |
+	occupants := #(Bill Fred) asOrderedCollection.
+
+	obj := MAMockAddress new
+		occupants: occupants;
+		yourself.
+
+	memento := self actualClass
+		model: obj
+		description: obj magritteDescription.
+
+	"Field-referenced collection changes outside of memento"
+	obj occupants add: 'Jim'.
+
+	"Now we change the same field via the memento"
+	memento write: #(Tom) using: obj occupantsDescription.
+
+	self should: [ memento validate ] raise: MAConflictError.
+]

source/Magritte-Tests-Model/MADescriptionBuilderTest.class.st

@@ -1,7 +1,7 @@
 Class {
 	#name : #MADescriptionBuilderTest,
 	#superclass : #TestCase,
-	#category : 'Magritte-Tests-Model-Utility'
+	#category : #'Magritte-Tests-Model-Utility'
 }
 
 { #category : #'acessing-magritte' }
@@ -85,7 +85,7 @@ MADescriptionBuilderTest >> testExtension [
 MADescriptionBuilderTest >> testNilled [
 	| description |
 	description := MAMockAddress new magritteDescription.
-	self assert: description size = 3
+	self assert: description size = 5
 ]
 
 { #category : #tests }

source/Magritte-Tests-Model/MAMementoTest.class.st

@@ -6,7 +6,7 @@ Class {
 		'value',
 		'description'
 	],
-	#category : 'Magritte-Tests-Model-Memento'
+	#category : #'Magritte-Tests-Model-Memento'
 }
 
 { #category : #testing }
@@ -94,6 +94,31 @@ MAMementoTest >> setUp [
 	memento := self mementoInstance
 ]
 
+{ #category : #'tests-actions' }
+MAMementoTest >> testCachedDefaultValues [
+
+	| obj plzDescription |
+	obj := MAMockAddress new.
+
+	memento := self actualClass
+		model: obj
+		description: obj magritteDescription.
+
+	memento := self actualClass
+		model: obj
+		description: obj magritteDescription.
+
+	plzDescription := obj descriptionPlz
+		default: 1;
+		shouldCacheDefault: true;
+		yourself.
+
+	memento push: {
+		plzDescription -> plzDescription default } asDictionary.
+
+	self assert: obj plz equals: plzDescription default
+]
+
 { #category : #'tests-actions' }
 MAMementoTest >> testCommit [
 	self subclassResponsibility
@@ -120,6 +145,41 @@ MAMementoTest >> testReset [
 	self subclassResponsibility
 ]
 
+{ #category : #'tests-actions' }
+MAMementoTest >> testSingletonValue [
+
+	| obj |
+	obj := MAMockAddress new
+		plzType: Number;
+		yourself.
+
+	memento := obj mementoClass
+		model: obj
+		description: obj magritteDescription.
+
+	self assert: (memento original at: obj plzTypeDescription) == obj plzType.
+]
+
+{ #category : #'tests-actions' }
+MAMementoTest >> testUncachedDefaultValues [
+
+	| obj plzDescription |
+	obj := MAMockAddress new.
+
+	memento := self actualClass
+		model: obj
+		description: obj magritteDescription.
+
+	plzDescription := obj descriptionPlz
+		default: 1;
+		yourself.
+
+	memento push: {
+		plzDescription -> plzDescription default } asDictionary.
+
+	self assert: obj plz equals: nil
+]
+
 { #category : #'tests-actions' }
 MAMementoTest >> testValidateIncluded [
 	self write: self includedInstance.