Lazy Relation

src/BaselineOfFame/BaselineOfFame.class.st

@@ -35,6 +35,14 @@ BaselineOfFame >> baseline: spec [
 			package: 'Fame-Deprecated'
 			with: [ spec requires: #( 'Fame-ImportExport' ) ].
 
+		"Lazyness"
+		spec
+			package: 'Fame-LazyRelations'
+			with: [ spec requires: #( 'Fame-Core' ) ].
+		spec
+			package: 'Fame-LazyRelations-Tests'
+			with: [ spec requires: #( 'Fame-LazyRelations' ) ].
+
 		spec for: #( #'pharo6.x' #'pharo7.x' #'pharo8.x' ) do: [
 			spec
 				package: 'Fame-GT'
@@ -47,9 +55,9 @@ BaselineOfFame >> baseline: spec [
 		"Groups"
 		spec
 			group: 'Core'
-			with: #( 'Fame-Core' 'Fame-ImportExport' 'Fame-Rules' );
+			with: #( 'Fame-Core' 'Fame-ImportExport' 'Fame-Rules' 'Fame-LazyRelations' );
 			group: 'Deprecated' with: #( 'Core' 'Fame-Deprecated' );
-			group: 'Tests' with: #( 'Fame-Tests' ) ]
+			group: 'Tests' with: #( 'Fame-Tests' 'Fame-LazyRelations-Tests' ) ]
 ]
 
 { #category : 'dependencies' }

src/Fame-LazyRelations-Tests/FMLazyRelationTest.class.st

@@ -0,0 +1,240 @@
+Class {
+	#name : 'FMLazyRelationTest',
+	#superclass : 'TestCase',
+	#category : 'Fame-LazyRelations-Tests',
+	#package : 'Fame-LazyRelations-Tests'
+}
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testAccessMaterializesRelation [
+
+	| entity loaded relation |
+	entity := RPGLazyHero new.
+
+	loaded := false.
+	FMLazyValue
+		makeRelation: #kills
+		of: entity
+		lazyUsing: [ :rel :entit | loaded := true ].
+
+	self deny: loaded.
+
+	relation := entity kills.
+
+	self assert: loaded.
+	self assert: relation class equals: FMSlotMultivalueLink
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testAddEntitiesInRelation [
+
+	| entity relation |
+	entity := RPGLazyHero new.
+
+	FMLazyValue
+		makeRelation: #kills
+		of: entity
+		lazyUsing: [ :rel :entit |
+			rel addAll: {
+					RPGLazyDragon new.
+					RPGLazyDragon new } ].
+
+	relation := entity kills.
+
+	self assert: relation size equals: 2.
+	self assert: relation anyOne killedBy anyOne equals: entity
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testAddToLazyRelation [
+
+	| entity dragon |
+	entity := RPGLazyHero new.
+
+	FMLazyValue
+		makeRelation: #kills
+		of: entity
+		lazyUsing: [ :rel :entit |
+			rel addAll: {
+					RPGLazyDragon new.
+					RPGLazyDragon new } ].
+
+	dragon := RPGLazyDragon new.
+
+	dragon killedBy: { entity }.
+
+	self assert: dragon killedBy size equals: 1.
+	self assert: dragon killedBy anyOne equals: entity.
+	self assert: entity kills size equals: 3.
+	self assert: entity kills last identicalTo: dragon
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testByPassByDirectlyAdding [
+
+	| entity dragon |
+	entity := RPGLazyHero new.
+
+	FMLazyValue
+		makeRelation: #kills
+		of: entity
+		lazyUsing: [ :rel :entit |
+			rel addAll: {
+					RPGLazyDragon new.
+					RPGLazyDragon new } ].
+
+	dragon := RPGLazyDragon new.
+
+	entity kills: { dragon }.
+
+	self assert: entity kills size equals: 1.
+	self assert: entity kills anyOne identicalTo: dragon
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testDefaultBehavior [
+
+	| entity dragon |
+	entity := RPGLazyHero new.
+	dragon := RPGLazyDragon new.
+	dragon killedBy: { entity }.
+
+	self assert: dragon killedBy size equals: 1.
+	self assert: dragon killedBy anyOne equals: entity.
+	self assert: entity kills size equals: 1.
+	self assert: entity kills anyOne equals: dragon
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testManyToOneWithlazyOne [
+
+	| entity hero hero2 |
+	self flag: #currentLimitation.
+	self skip.
+	entity := RPGLazyTalisman new.
+	hero := RPGLazyHero new.
+	hero2 := RPGLazyHero new.
+
+	FMLazyValue
+		makeRelation: #owner
+		of: entity
+		lazyUsing: [ :rel :entit | rel value: hero ].
+	hero2 talismans: { entity }.
+	self assert: entity owner identicalTo: hero2.
+	self assert: hero talismans size equals: 0.
+	self assert: hero2 talismans anyOne identicalTo: entity
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testOneToManyRelation [
+
+	| entity hero |
+	entity := RPGLazyTalisman new.
+	hero := RPGLazyHero new.
+
+	FMLazyValue
+		makeRelation: #owner
+		of: entity
+		lazyUsing: [ :rel :entit | rel value: hero ].
+
+	self assert: entity owner identicalTo: hero.
+	self assert: hero talismans size equals: 1.
+	self assert: hero talismans anyOne identicalTo: entity
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testOneToManyRelationTwiceCalled [
+
+	| entity hero count |
+	entity := RPGLazyTalisman new.
+	hero := RPGLazyHero new.
+	count := 0.
+
+	FMLazyValue
+		makeRelation: #owner
+		of: entity
+		lazyUsing: [ :rel :entit |
+			count := count + 1.
+			rel value: hero ].
+	entity owner.
+	entity owner.
+
+	self assert: count equals: 1
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testOneToOneRelation [
+
+	| weapon hero |
+	weapon := RPGLazyUniqueWeapon new.
+	hero := RPGLazyHero new.
+
+	FMLazyValue
+		makeRelation: #owner
+		of: weapon
+		lazyUsing: [ :rel :entit | rel value: hero ].
+
+	self assert: weapon owner identicalTo: hero
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testOneToOneRelationReverse [
+
+	| weapon weapon2 hero |
+	self flag: #currentLimitation.
+	self skip.
+	weapon := RPGLazyUniqueWeapon new.
+	hero := RPGLazyHero new.
+	weapon2 := RPGLazyUniqueWeapon new.
+
+	FMLazyValue
+		makeRelation: #owner
+		of: weapon
+		lazyUsing: [ :rel :entit | rel value: hero ].
+
+	hero uniqueWeapon: weapon2.
+
+	self assert: hero uniqueWeapon identicalTo: weapon2.
+	self assert: weapon owner isNil.
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testRelationIsLoadedOnlyOnce [
+
+	| entity count first second |
+	entity := RPGLazyHero new.
+	count := 0.
+
+	FMLazyValue
+		makeRelation: #kills
+		of: entity
+		lazyUsing: [ :relation :entit | count := count + 1 ].
+
+	first := entity kills.
+	second := entity kills.
+
+	self assert: count equals: 1.
+	self assert: first identicalTo: second
+]
+
+{ #category : 'tests' }
+FMLazyRelationTest >> testRelationIsNotAppliedToAllEntities [
+
+	| entity entity2 count first second first2 |
+	entity := RPGLazyHero new.
+	entity2 := RPGLazyHero new.
+	count := 0.
+
+	FMLazyValue
+		makeRelation: #kills
+		of: entity
+		lazyUsing: [ :relation :entit | count := count + 1 ].
+
+	first := entity kills.
+	second := entity kills.
+
+	first2 := entity2 kills.
+
+	self assert: count equals: 1.
+	self assert: first identicalTo: second
+]

src/Fame-LazyRelations-Tests/RPGLazyDragon.class.st

@@ -0,0 +1,22 @@
+Class {
+	#name : 'RPGLazyDragon',
+	#superclass : 'RPGLazyEntity',
+	#instVars : [
+		'#killedBy => FMMany type: #RPGLazyHero opposite: #kills'
+	],
+	#category : 'Fame-LazyRelations-Tests-Example',
+	#package : 'Fame-LazyRelations-Tests',
+	#tag : 'Example'
+}
+
+{ #category : 'accessing' }
+RPGLazyDragon >> killedBy [
+
+	^ killedBy
+]
+
+{ #category : 'accessing' }
+RPGLazyDragon >> killedBy: anObject [
+	"value when multimulti relation"
+	killedBy value: anObject
+]

src/Fame-LazyRelations-Tests/RPGLazyEntity.class.st

@@ -0,0 +1,14 @@
+Class {
+	#name : 'RPGLazyEntity',
+	#superclass : 'Object',
+	#category : 'Fame-LazyRelations-Tests-Example',
+	#package : 'Fame-LazyRelations-Tests',
+	#tag : 'Example'
+}
+
+{ #category : 'initialization' }
+RPGLazyEntity >> initialize [
+
+	super initialize.
+	self class initializeSlots: self
+]

src/Fame-LazyRelations-Tests/RPGLazyHero.class.st

@@ -0,0 +1,49 @@
+Class {
+	#name : 'RPGLazyHero',
+	#superclass : 'RPGLazyEntity',
+	#instVars : [
+		'#kills => FMMany type: #RPGLazyDragon opposite: #killedBy',
+		'#talismans => FMMany type: #RPGLazyTalisman opposite: #owner',
+		'#uniqueWeapon => FMOne type: #RPGLazyUniqueWeapon opposite: #owner'
+	],
+	#category : 'Fame-LazyRelations-Tests-Example',
+	#package : 'Fame-LazyRelations-Tests',
+	#tag : 'Example'
+}
+
+{ #category : 'accessing' }
+RPGLazyHero >> kills [
+
+	^ kills
+]
+
+{ #category : 'accessing' }
+RPGLazyHero >> kills: anObject [
+	"value when multimulti relation"
+
+	kills value: anObject
+]
+
+{ #category : 'accessing' }
+RPGLazyHero >> talismans [
+
+	^ talismans
+]
+
+{ #category : 'accessing' }
+RPGLazyHero >> talismans: anObject [
+
+	talismans := anObject
+]
+
+{ #category : 'accessing' }
+RPGLazyHero >> uniqueWeapon [
+
+	^ uniqueWeapon
+]
+
+{ #category : 'accessing' }
+RPGLazyHero >> uniqueWeapon: anObject [
+
+	uniqueWeapon := anObject
+]

src/Fame-LazyRelations-Tests/RPGLazyTalisman.class.st

@@ -0,0 +1,22 @@
+Class {
+	#name : 'RPGLazyTalisman',
+	#superclass : 'RPGLazyEntity',
+	#instVars : [
+		'#owner => FMOne type: #RPGLazyHero opposite: #talismans'
+	],
+	#category : 'Fame-LazyRelations-Tests-Example',
+	#package : 'Fame-LazyRelations-Tests',
+	#tag : 'Example'
+}
+
+{ #category : 'accessing' }
+RPGLazyTalisman >> owner [
+
+	^ owner
+]
+
+{ #category : 'accessing' }
+RPGLazyTalisman >> owner: anObject [
+
+	owner := anObject
+]