Initial version, Gemstone Repository is just a copy of the In Memory …

…implementation.

source/Sagan-Gemstone-Tests/GemstoneRepositoryProviderTest.class.st

@@ -0,0 +1,69 @@
+Class {
+	#name : 'GemstoneRepositoryProviderTest',
+	#superclass : 'RepositoryBasedTest',
+	#category : 'Sagan-Gemstone-Tests',
+	#package : 'Sagan-Gemstone-Tests'
+}
+
+{ #category : 'initialization' }
+GemstoneRepositoryProviderTest >> setUpRepositoryWith: aConflictCheckingStrategy [
+
+	extraterrestrials := GemstoneRepositoryProvider new
+		                     createRepositoryStoringObjectsOfType: Extraterrestrial
+		                     checkingConflictsAccordingTo: aConflictCheckingStrategy.
+	ships := GemstoneRepositoryProvider new
+		         createRepositoryStoringObjectsOfType: Spaceship
+		         checkingConflictsAccordingTo: aConflictCheckingStrategy
+]
+
+{ #category : 'tests' }
+GemstoneRepositoryProviderTest >> testSpaceshipQueryingForPositiveFirepower [
+
+	| solvalou solgrado zeodalley |
+
+	self setUpRepositoryWithNoConflictChecking.
+
+	solvalou := Spaceship withoutFirepowerNamed: 'Solvalou'.
+	solgrado := Spaceship named: 'Solgrado' firepower: 7650.
+	zeodalley := Spaceship withUnlimitedFirepowerNamed: 'Zeodalley'.
+
+	ships store: solvalou.
+	ships store: solgrado.
+	ships store: zeodalley.
+
+	self
+		withAllSpaceshipsMatching: [ :spaceship :builder |
+			builder isUndefined: spaceship firepower otherwiseSatisfy: spaceship firepower > 0 ]
+		do: [ :spaceships |
+			self assertCollection: spaceships hasSameElements: {
+					solgrado.
+					zeodalley }
+			]
+]
+
+{ #category : 'tests' }
+GemstoneRepositoryProviderTest >> testSpaceshipQueryingForZeroFirepower [
+
+	| solvalou solgrado zeodalley |
+
+	self setUpRepositoryWithNoConflictChecking.
+
+	solvalou := Spaceship withoutFirepowerNamed: 'Solvalou'.
+	solgrado := Spaceship named: 'Solgrado' firepower: 7650.
+	zeodalley := Spaceship withUnlimitedFirepowerNamed: 'Zeodalley'.
+
+	ships store: solvalou.
+	ships store: solgrado.
+	ships store: zeodalley.
+
+	self
+		withAllSpaceshipsMatching: [ :spaceship :builder |
+		builder satisfyingAny: { ( spaceship firepower = 0 ) } ]
+		do: [ :spaceships | self assertCollection: spaceships hasSameElements: { solvalou } ]
+]
+
+{ #category : 'utility' }
+GemstoneRepositoryProviderTest >> withAllSpaceshipsMatching: aMatchingCriteria do: aOneArgBlock [
+
+	aOneArgBlock value: ( ships findAllMatching: aMatchingCriteria )
+]

source/Sagan-Gemstone-Tests/package.st

@@ -0,0 +1 @@
+Package { #name : 'Sagan-Gemstone-Tests' }

source/Sagan-Gemstone/GemstoneRepository.class.st

@@ -0,0 +1,139 @@
+"
+I'm a Gemstone repository. I will keep the managed objects in an collections optimized for Gemstone indexes, and provide transactional semantics.
+
+I require a working Gemstone connection.
+"
+Class {
+	#name : 'GemstoneRepository',
+	#superclass : 'RepositoryBehavior',
+	#instVars : [
+		'conflictCheckingStrategy',
+		'contents'
+	],
+	#category : 'Sagan-Gemstone',
+	#package : 'Sagan-Gemstone'
+}
+
+{ #category : 'instance creation' }
+GemstoneRepository class >> checkingConflictsAccordingTo: aConflictCheckingStrategy [
+
+	^self new initializeCheckingConflictsAccordingTo: aConflictCheckingStrategy
+]
+
+{ #category : 'instance creation' }
+GemstoneRepository class >> withoutCheckingConflicts [
+
+	^ self checkingConflictsAccordingTo: DoNotCheckForConflictsStrategy new
+]
+
+{ #category : 'configuring' }
+GemstoneRepository >> configureMappingsIn: aBlock [
+
+
+]
+
+{ #category : 'private - accessing' }
+GemstoneRepository >> conflictCheckingStrategy [
+
+	^ conflictCheckingStrategy
+]
+
+{ #category : 'querying' }
+GemstoneRepository >> countMatching: aCriteriaOrBlockClosure [
+
+	^ contents count: ( self asMatchingCriteria: aCriteriaOrBlockClosure )
+]
+
+{ #category : 'querying' }
+GemstoneRepository >> findAll [
+
+	^ contents copy
+]
+
+{ #category : 'querying' }
+GemstoneRepository >> findAllMatching: aCriteriaOrBlock [
+
+	^ contents select: ( self asMatchingCriteria: aCriteriaOrBlock )
+]
+
+{ #category : 'querying' }
+GemstoneRepository >> findAllMatching: aCriteriaOrBlock sortedBy: aSortFunction [
+
+	^ ( self findAllMatching: aCriteriaOrBlock ) sorted: aSortFunction
+]
+
+{ #category : 'initialization' }
+GemstoneRepository >> initializeCheckingConflictsAccordingTo: aConflictCheckingStrategy [
+
+	conflictCheckingStrategy := aConflictCheckingStrategy.
+	contents := OrderedCollection new
+]
+
+{ #category : 'private - accessing' }
+GemstoneRepository >> matchingCriteriaBuilder [
+
+	^ GemstoneRepositoryMatchingCriteriaBuilder new
+]
+
+{ #category : 'private - management' }
+GemstoneRepository >> purgeAfterCheckingInclusion: aDomainObject [
+
+	contents remove: aDomainObject ifAbsent: [
+		DataInconsistencyFound signal:
+			( '<1p> was expected to be found in the contents, but it was not.' expandMacrosWith:
+				  aDomainObject )
+		].
+	^ aDomainObject
+]
+
+{ #category : 'management' }
+GemstoneRepository >> purgeAllMatching: aCriteriaOrBlock [
+
+	contents := contents reject: ( self asMatchingCriteria: aCriteriaOrBlock )
+]
+
+{ #category : 'private - management' }
+GemstoneRepository >> storeAfterCheckingConflicts: aDomainObject [
+
+	contents add: aDomainObject.
+	^ aDomainObject
+]
+
+{ #category : 'management' }
+GemstoneRepository >> transact: aBlock [
+
+	^ aBlock value
+]
+
+{ #category : 'management' }
+GemstoneRepository >> update: aMutableDomainObject executing: aBlock [
+
+	aBlock value: aMutableDomainObject
+]
+
+{ #category : 'private - management' }
+GemstoneRepository >> updateAfterCheckingConflicts: aDomainObject with: anUpdatedDomainObject [
+
+	self purgeAfterCheckingInclusion: aDomainObject.
+	[ aDomainObject synchronizeWith: anUpdatedDomainObject ] ensure: [
+		self storeAfterCheckingConflicts: aDomainObject ].
+	^ aDomainObject
+]
+
+{ #category : 'querying' }
+GemstoneRepository >> withOneMatching: aCriteriaOrBlock do: foundBlock else: noneBlock [
+
+	^ contents
+		  detect: ( self asMatchingCriteria: aCriteriaOrBlock )
+		  ifFound: foundBlock
+		  ifNone: noneBlock
+]
+
+{ #category : 'querying' }
+GemstoneRepository >> withOneMatching: aCriteriaOrBlock sortedBy: aSortFunction do: foundBlock else: noneBlock [
+
+	^ ( contents sorted: aSortFunction )
+		  detect: ( self asMatchingCriteria: aCriteriaOrBlock )
+		  ifFound: foundBlock
+		  ifNone: noneBlock
+]

source/Sagan-Gemstone/GemstoneRepositoryMatchingCriteriaBuilder.class.st

@@ -0,0 +1,66 @@
+"
+I'm an implementation for Gemstone Repositories.
+I will try to solve everything using plain messages without any DSL.
+"
+Class {
+	#name : 'GemstoneRepositoryMatchingCriteriaBuilder',
+	#superclass : 'RepositoryMatchingCriteriaBuilder',
+	#category : 'Sagan-Gemstone',
+	#package : 'Sagan-Gemstone'
+}
+
+{ #category : 'identity operations' }
+GemstoneRepositoryMatchingCriteriaBuilder >> does: anObjectInRepository equal: anObject [
+
+	^ anObjectInRepository = anObject
+]
+
+{ #category : 'string matching' }
+GemstoneRepositoryMatchingCriteriaBuilder >> does: aStringInRepository includeSubstring: aString [
+
+	^ aStringInRepository includesSubstring: aString
+]
+
+{ #category : 'identity operations' }
+GemstoneRepositoryMatchingCriteriaBuilder >> does: objectInRepository notEqual: objectInMemory [
+
+	^ objectInRepository ~= objectInMemory
+]
+
+{ #category : 'testing' }
+GemstoneRepositoryMatchingCriteriaBuilder >> is: anObject includedIn: aCollection [
+
+	^ aCollection includes: anObject
+]
+
+{ #category : 'testing' }
+GemstoneRepositoryMatchingCriteriaBuilder >> isUndefined: anObject otherwiseSatisfy: aBooleanExpression [
+	"It is assumed anObject will always be defined when in memory.
+	 By defined we refer to any object except nil."
+
+	^ aBooleanExpression
+]
+
+{ #category : 'boolean operations' }
+GemstoneRepositoryMatchingCriteriaBuilder >> satisfying: aBoolean and: aBlock [
+
+	^ aBoolean and: aBlock
+]
+
+{ #category : 'boolean operations' }
+GemstoneRepositoryMatchingCriteriaBuilder >> satisfying: aBoolean or: aBlock [
+
+	^ aBoolean or: aBlock
+]
+
+{ #category : 'boolean operations' }
+GemstoneRepositoryMatchingCriteriaBuilder >> satisfyingAll: aBooleanCollection [
+
+	^ aBooleanCollection allSatisfy: [ :each | each ]
+]
+
+{ #category : 'boolean operations' }
+GemstoneRepositoryMatchingCriteriaBuilder >> satisfyingAny: aBooleanCollection [
+
+	^ aBooleanCollection anySatisfy: [ :each | each ]
+]

source/Sagan-Gemstone/GemstoneRepositoryProvider.class.st

@@ -0,0 +1,37 @@
+Class {
+	#name : 'GemstoneRepositoryProvider',
+	#superclass : 'RepositoryProvider',
+	#category : 'Sagan-Gemstone',
+	#package : 'Sagan-Gemstone'
+}
+
+{ #category : 'building' }
+GemstoneRepositoryProvider >> createRepositoryStoringObjectsOfType: aBusinessObjectClass
+	checkingConflictsAccordingTo: aConflictCheckingStrategy [
+
+	^ GemstoneRepository checkingConflictsAccordingTo: aConflictCheckingStrategy
+]
+
+{ #category : 'controlling' }
+GemstoneRepositoryProvider >> destroyRepositories [
+
+	" In memory all repositories are destroyed once the system is shut down "
+]
+
+{ #category : 'controlling' }
+GemstoneRepositoryProvider >> prepareForInitialPersistence [
+
+
+]
+
+{ #category : 'controlling' }
+GemstoneRepositoryProvider >> prepareForShutDown [
+
+
+]
+
+{ #category : 'initialization' }
+GemstoneRepositoryProvider >> reset [
+
+
+]

source/Sagan-Gemstone/package.st

@@ -0,0 +1 @@
+Package { #name : 'Sagan-Gemstone' }