Merge pull request #107 from ba-st/find-limited

Find limited to max number of results
ba-st · Aug 12, 2024 · 7193725 · 7193725
2 parents 98fd2a5 + cd042d6
commit 7193725
Show file tree

Hide file tree

Showing 5 changed files with 85 additions and 9 deletions.
diff --git a/source/Sagan-Core-Tests/RepositoryBasedTest.class.st b/source/Sagan-Core-Tests/RepositoryBasedTest.class.st
@@ -232,6 +232,31 @@ RepositoryBasedTest >> testFindAllMatching [
 			equals: 2
 ]
 
+{ #category : 'tests - querying' }
+RepositoryBasedTest >> testFindAllMatchingLimitedToSortedByAscending [
+
+  | 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
+			sortedByAscending: #lastName.
+
+  self
+    assert: results size equals: 2;
+    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' }
 RepositoryBasedTest >> testFindAllMatchingSortedBy [
 

diff --git 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 [
 
@@ -62,6 +69,13 @@ InMemoryRepository >> findAllMatching: aCriteriaOrBlock [
 	^ contents select: ( self asMatchingCriteria: aCriteriaOrBlock )
 ]
 
+{ #category : 'querying' }
+InMemoryRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults sortedByAscending: aVariableName [
+
+  ^ ( ( self contentsSortedByAscending: aVariableName ) select:
+        ( self asMatchingCriteria: aCriteriaOrBlock ) ) copyFirst: aMaxNumberOfResults
+]
+
 { #category : 'querying' }
 InMemoryRepository >> findAllMatching: aCriteriaOrBlock sortedBy: aSortFunction [
 
@@ -130,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' }

diff --git 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 sortedByAscending: aVariableName [
+
+	^ 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
@@ -62,6 +62,27 @@ GemStoneRepository >> findAllMatching: aCriteriaOrBlock [
 	^ contents select: ( self asMatchingCriteria: aCriteriaOrBlock )
 ]
 
+{ #category : 'querying' }
+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
+]
+
 { #category : 'querying' }
 GemStoneRepository >> findAllMatching: aCriteriaOrBlock sortedBy: aSortFunction [
 

diff --git a/source/Sagan-RDBMS/RDBMSRepository.class.st b/source/Sagan-RDBMS/RDBMSRepository.class.st
@@ -91,6 +91,20 @@ RDBMSRepository >> findAllMatching: aCriteriaOrBlock [
 	^ self executeQuery: ( SimpleQuery read: modelObjectClass where: ( self asMatchingCriteria: aCriteriaOrBlock ) )
 ]
 
+{ #category : 'querying' }
+RDBMSRepository >> findAllMatching: aCriteriaOrBlock limitedTo: aMaxNumberOfResults sortedByAscending: aVariableName [
+
+  | query |
+  query := SimpleQuery
+             read: modelObjectClass
+             where: ( self asMatchingCriteria: aCriteriaOrBlock )
+             limit: aMaxNumberOfResults.
+
+  aVariableName ascending asSortFunction asOrderByIn: query.
+
+  ^ self executeQuery: query
+]
+
 { #category : 'querying' }
 RDBMSRepository >> findAllMatching: aCriteriaOrBlock sortedBy: aSortFunction [