From 85ec9b008a236078a5389255a6336f30112fe998 Mon Sep 17 00:00:00 2001 From: Mariano Saura Date: Fri, 9 Aug 2024 22:47:45 -0300 Subject: [PATCH 1/4] Find limited to max number of results --- .../RepositoryBasedTest.class.st | 20 +++++++++++++++++++ source/Sagan-Core/InMemoryRepository.class.st | 15 ++++++++++++++ source/Sagan-Core/RepositoryBehavior.class.st | 6 ++++++ .../GemStoneRepository.class.st | 15 ++++++++++++++ source/Sagan-RDBMS/RDBMSRepository.class.st | 9 +++++++++ 5 files changed, 65 insertions(+) diff --git a/source/Sagan-Core-Tests/RepositoryBasedTest.class.st b/source/Sagan-Core-Tests/RepositoryBasedTest.class.st index e3cf04a..036db82 100644 --- a/source/Sagan-Core-Tests/RepositoryBasedTest.class.st +++ b/source/Sagan-Core-Tests/RepositoryBasedTest.class.st @@ -232,6 +232,26 @@ RepositoryBasedTest >> testFindAllMatching [ equals: 2 ] +{ #category : 'tests - querying' } +RepositoryBasedTest >> testFindAllMatchingLimitedTo [ + + | results | + self extraterrestrials + store: self silvesterStallone; + store: self silvesterMcCoy; + store: self johnTravolta; + store: self johnLock. + + results := self extraterrestrials + findAllMatching: [ :extraterrestrial :criteria | + criteria does: extraterrestrial lastName asUppercase includeSubstring: 'L' ] + limitedTo: 2. + + self + assert: results size equals: 2; + assert: ( results allSatisfy: [ :result | result lastName asUppercase includesSubstring: 'L' ] ) +] + { #category : 'tests - querying' } RepositoryBasedTest >> testFindAllMatchingSortedBy [ diff --git a/source/Sagan-Core/InMemoryRepository.class.st b/source/Sagan-Core/InMemoryRepository.class.st index f6beeaa..36c2b6e 100644 --- a/source/Sagan-Core/InMemoryRepository.class.st +++ b/source/Sagan-Core/InMemoryRepository.class.st @@ -62,6 +62,21 @@ InMemoryRepository >> findAllMatching: aCriteriaOrBlock [ ^ contents select: ( self asMatchingCriteria: aCriteriaOrBlock ) ] +{ #category : 'querying' } +InMemoryRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults [ + + | results | + results := Set new. + contents do: [ :element | + results size < aMaxNumberOfResults + ifTrue: [ + ( ( self asMatchingCriteria: aCriteriaOrBlock ) value: element ) ifTrue: [ + results add: element ] ] + ifFalse: [ ^ results ] + ]. + ^ results +] + { #category : 'querying' } InMemoryRepository >> findAllMatching: aCriteriaOrBlock sortedBy: aSortFunction [ diff --git a/source/Sagan-Core/RepositoryBehavior.class.st b/source/Sagan-Core/RepositoryBehavior.class.st index c94bcb6..d99f4c0 100644 --- a/source/Sagan-Core/RepositoryBehavior.class.st +++ b/source/Sagan-Core/RepositoryBehavior.class.st @@ -107,6 +107,12 @@ RepositoryBehavior >> findAllMatching: aCriteria [ ^ self subclassResponsibility ] +{ #category : 'querying' } +RepositoryBehavior >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults [ + + ^ self subclassResponsibility +] + { #category : 'querying' } RepositoryBehavior >> findAllMatching: aCriteria sortedBy: aSortCriteria [ diff --git a/source/Sagan-GemStone/GemStoneRepository.class.st b/source/Sagan-GemStone/GemStoneRepository.class.st index 4035c8c..fd6ffd0 100644 --- a/source/Sagan-GemStone/GemStoneRepository.class.st +++ b/source/Sagan-GemStone/GemStoneRepository.class.st @@ -62,6 +62,21 @@ GemStoneRepository >> findAllMatching: aCriteriaOrBlock [ ^ contents select: ( self asMatchingCriteria: aCriteriaOrBlock ) ] +{ #category : 'querying' } +GemStoneRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults [ + + | results | + results := Set new. + contents do: [ :element | + results size < aMaxNumberOfResults + ifTrue: [ + ( ( self asMatchingCriteria: aCriteriaOrBlock ) value: element ) ifTrue: [ + results add: element ] ] + ifFalse: [ ^ results ] + ]. + ^ results +] + { #category : 'querying' } GemStoneRepository >> findAllMatching: aCriteriaOrBlock sortedBy: aSortFunction [ diff --git a/source/Sagan-RDBMS/RDBMSRepository.class.st b/source/Sagan-RDBMS/RDBMSRepository.class.st index 7cbee9d..109db84 100644 --- a/source/Sagan-RDBMS/RDBMSRepository.class.st +++ b/source/Sagan-RDBMS/RDBMSRepository.class.st @@ -91,6 +91,15 @@ RDBMSRepository >> findAllMatching: aCriteriaOrBlock [ ^ self executeQuery: ( SimpleQuery read: modelObjectClass where: ( self asMatchingCriteria: aCriteriaOrBlock ) ) ] +{ #category : 'querying' } +RDBMSRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults [ + + ^ self executeQuery: ( SimpleQuery + read: modelObjectClass + where: ( self asMatchingCriteria: aCriteriaOrBlock ) + limit: aMaxNumberOfResults ) +] + { #category : 'querying' } RDBMSRepository >> findAllMatching: aCriteriaOrBlock sortedBy: aSortFunction [ From 30b0397f56b243f00b58d65529f71df9e2b9301b Mon Sep 17 00:00:00 2001 From: Mariano Saura Date: Mon, 12 Aug 2024 13:14:59 -0300 Subject: [PATCH 2/4] Sorting added, improved GS implementation --- .../RepositoryBasedTest.class.st | 11 ++++++-- source/Sagan-Core/InMemoryRepository.class.st | 17 ++++------- source/Sagan-Core/RepositoryBehavior.class.st | 2 +- .../GemStoneRepository.class.st | 28 +++++++++++-------- source/Sagan-RDBMS/RDBMSRepository.class.st | 15 ++++++---- 5 files changed, 41 insertions(+), 32 deletions(-) diff --git a/source/Sagan-Core-Tests/RepositoryBasedTest.class.st b/source/Sagan-Core-Tests/RepositoryBasedTest.class.st index 036db82..d20e6c8 100644 --- a/source/Sagan-Core-Tests/RepositoryBasedTest.class.st +++ b/source/Sagan-Core-Tests/RepositoryBasedTest.class.st @@ -233,7 +233,7 @@ RepositoryBasedTest >> testFindAllMatching [ ] { #category : 'tests - querying' } -RepositoryBasedTest >> testFindAllMatchingLimitedTo [ +RepositoryBasedTest >> testFindAllMatchingLimitedToSortedByAscending [ | results | self extraterrestrials @@ -245,11 +245,16 @@ RepositoryBasedTest >> testFindAllMatchingLimitedTo [ results := self extraterrestrials findAllMatching: [ :extraterrestrial :criteria | criteria does: extraterrestrial lastName asUppercase includeSubstring: 'L' ] - limitedTo: 2. + limitedTo: 2 + sortedByAscending: #lastName. self assert: results size equals: 2; - assert: ( results allSatisfy: [ :result | result lastName asUppercase includesSubstring: 'L' ] ) + assert: ( results anySatisfy: [ :result | result lastName = 'Lock' ] ); + deny: ( results anySatisfy: [ :result | result lastName = 'McCoy' ] ); + assert: ( results anySatisfy: [ :result | result lastName = 'Stallone' ] ); + deny: ( results anySatisfy: [ :result | result lastName = 'Travolta' ] ) + ] { #category : 'tests - querying' } diff --git a/source/Sagan-Core/InMemoryRepository.class.st b/source/Sagan-Core/InMemoryRepository.class.st index 36c2b6e..f645ea7 100644 --- a/source/Sagan-Core/InMemoryRepository.class.st +++ b/source/Sagan-Core/InMemoryRepository.class.st @@ -63,18 +63,11 @@ InMemoryRepository >> findAllMatching: aCriteriaOrBlock [ ] { #category : 'querying' } -InMemoryRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults [ - - | results | - results := Set new. - contents do: [ :element | - results size < aMaxNumberOfResults - ifTrue: [ - ( ( self asMatchingCriteria: aCriteriaOrBlock ) value: element ) ifTrue: [ - results add: element ] ] - ifFalse: [ ^ results ] - ]. - ^ results +InMemoryRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults sortedByAscending: aVariableName [ + + ^ ( ( contents sorted: [ :a :b | + ( self valueOf: aVariableName in: a ) <= ( self valueOf: aVariableName in: b ) ] ) + select: ( self asMatchingCriteria: aCriteriaOrBlock ) ) copyUpTo: aMaxNumberOfResults ] { #category : 'querying' } diff --git a/source/Sagan-Core/RepositoryBehavior.class.st b/source/Sagan-Core/RepositoryBehavior.class.st index d99f4c0..48a8897 100644 --- a/source/Sagan-Core/RepositoryBehavior.class.st +++ b/source/Sagan-Core/RepositoryBehavior.class.st @@ -108,7 +108,7 @@ RepositoryBehavior >> findAllMatching: aCriteria [ ] { #category : 'querying' } -RepositoryBehavior >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults [ +RepositoryBehavior >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults sortedByAscending: aVariableName [ ^ self subclassResponsibility ] diff --git a/source/Sagan-GemStone/GemStoneRepository.class.st b/source/Sagan-GemStone/GemStoneRepository.class.st index fd6ffd0..5481bc8 100644 --- a/source/Sagan-GemStone/GemStoneRepository.class.st +++ b/source/Sagan-GemStone/GemStoneRepository.class.st @@ -63,17 +63,23 @@ GemStoneRepository >> findAllMatching: aCriteriaOrBlock [ ] { #category : 'querying' } -GemStoneRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults [ - - | results | - results := Set new. - contents do: [ :element | - results size < aMaxNumberOfResults - ifTrue: [ - ( ( self asMatchingCriteria: aCriteriaOrBlock ) value: element ) ifTrue: [ - results add: element ] ] - ifFalse: [ ^ results ] - ]. +GemStoneRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults sortedByAscending: aVariableName [ + + | results matchingCriteria | + results := OrderedCollection new. + matchingCriteria := self asMatchingCriteria: aCriteriaOrBlock. + self + withQueryFrom: ( 'each.<1s> >= ''''' expandMacrosWith: aVariableName asString ) + do: [ :query | + | stream current | + stream := query readStream. + [ stream atEnd ] whileFalse: [ + current := stream next. + results size < aMaxNumberOfResults + ifTrue: [ ( matchingCriteria value: current ) ifTrue: [ results add: current ] ] + ifFalse: [ ^ results ] + ] + ]. ^ results ] diff --git a/source/Sagan-RDBMS/RDBMSRepository.class.st b/source/Sagan-RDBMS/RDBMSRepository.class.st index 109db84..44914e8 100644 --- a/source/Sagan-RDBMS/RDBMSRepository.class.st +++ b/source/Sagan-RDBMS/RDBMSRepository.class.st @@ -92,12 +92,17 @@ RDBMSRepository >> findAllMatching: aCriteriaOrBlock [ ] { #category : 'querying' } -RDBMSRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults [ +RDBMSRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults sortedByAscending: aVariableName [ - ^ self executeQuery: ( SimpleQuery - read: modelObjectClass - where: ( self asMatchingCriteria: aCriteriaOrBlock ) - limit: aMaxNumberOfResults ) + | query | + query := SimpleQuery + read: modelObjectClass + where: ( self asMatchingCriteria: aCriteriaOrBlock ) + limit: aMaxNumberOfResults. + + aVariableName ascending asSortFunction asOrderByIn: query. + + ^ self executeQuery: query ] { #category : 'querying' } From 66e39f441a5d2354cd6a28c1702a60d46bd29034 Mon Sep 17 00:00:00 2001 From: Mariano Saura Date: Mon, 12 Aug 2024 13:24:36 -0300 Subject: [PATCH 3/4] InMemoryRepository refactoring --- source/Sagan-Core/InMemoryRepository.class.st | 26 ++++++++++--------- 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/source/Sagan-Core/InMemoryRepository.class.st b/source/Sagan-Core/InMemoryRepository.class.st index f645ea7..1a1da58 100644 --- a/source/Sagan-Core/InMemoryRepository.class.st +++ b/source/Sagan-Core/InMemoryRepository.class.st @@ -38,6 +38,13 @@ InMemoryRepository >> conflictCheckingStrategy [ ^ conflictCheckingStrategy ] +{ #category : 'private - querying' } +InMemoryRepository >> contentsSortedByAscending: aVariableName [ + + ^ contents sorted: [ :a :b | + ( self valueOf: aVariableName in: a ) <= ( self valueOf: aVariableName in: b ) ] +] + { #category : 'querying' } InMemoryRepository >> countAll [ @@ -65,9 +72,8 @@ InMemoryRepository >> findAllMatching: aCriteriaOrBlock [ { #category : 'querying' } InMemoryRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults sortedByAscending: aVariableName [ - ^ ( ( contents sorted: [ :a :b | - ( self valueOf: aVariableName in: a ) <= ( self valueOf: aVariableName in: b ) ] ) - select: ( self asMatchingCriteria: aCriteriaOrBlock ) ) copyUpTo: aMaxNumberOfResults + ^ ( ( self contentsSortedByAscending: aVariableName ) select: + ( self asMatchingCriteria: aCriteriaOrBlock ) ) copyUpTo: aMaxNumberOfResults ] { #category : 'querying' } @@ -138,17 +144,13 @@ InMemoryRepository >> updateAfterCheckingConflicts: aDomainObject with: anUpdate { #category : 'private - querying' } InMemoryRepository >> validatedFindAllFrom: aStartingPosition upTo: aMaximumPosition sortedByAscending: aVariableName [ - | from to | - - ( contents isEmpty or: [ aStartingPosition > contents size ] ) ifTrue: [ ^ Set new ]. + | from to | + ( contents isEmpty or: [ aStartingPosition > contents size ] ) ifTrue: [ ^ Set new ]. - from := aStartingPosition max: 1. - to := ( aMaximumPosition min: contents size ) max: 1. + from := aStartingPosition max: 1. + to := ( aMaximumPosition min: contents size ) max: 1. - ^ ( contents sorted: [ :a :b | - ( self valueOf: aVariableName in: a ) <= ( self valueOf: aVariableName in: b ) ] ) - copyFrom: from - to: to + ^ ( self contentsSortedByAscending: aVariableName ) copyFrom: from to: to ] { #category : 'private - accessing' } From cd042d6b5cb445572f17f505ff79d0e7b11ef9f5 Mon Sep 17 00:00:00 2001 From: Mariano Saura Date: Mon, 12 Aug 2024 14:05:37 -0300 Subject: [PATCH 4/4] Bugfix --- source/Sagan-Core/InMemoryRepository.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/Sagan-Core/InMemoryRepository.class.st b/source/Sagan-Core/InMemoryRepository.class.st index 1a1da58..cfc8b91 100644 --- a/source/Sagan-Core/InMemoryRepository.class.st +++ b/source/Sagan-Core/InMemoryRepository.class.st @@ -73,7 +73,7 @@ InMemoryRepository >> findAllMatching: aCriteriaOrBlock [ InMemoryRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults sortedByAscending: aVariableName [ ^ ( ( self contentsSortedByAscending: aVariableName ) select: - ( self asMatchingCriteria: aCriteriaOrBlock ) ) copyUpTo: aMaxNumberOfResults + ( self asMatchingCriteria: aCriteriaOrBlock ) ) copyFirst: aMaxNumberOfResults ] { #category : 'querying' }