diff --git a/modules/Development/BeginningCondition.st b/modules/Development/BeginningCondition.st new file mode 100644 index 0000000..de84d6f --- /dev/null +++ b/modules/Development/BeginningCondition.st @@ -0,0 +1,21 @@ +" + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #BeginningCondition, + #superclass : #CodeSearchCondition, + #category : #Development +} + +{#category : #private} +BeginningCondition >> compare: aString [ + ^aString beginsWith: text +] + +{#category : #private} +BeginningCondition >> proposition [ + ^'begins with' +] + diff --git a/modules/Development/ClassSearch.st b/modules/Development/ClassSearch.st new file mode 100644 index 0000000..0b41291 --- /dev/null +++ b/modules/Development/ClassSearch.st @@ -0,0 +1,19 @@ +" + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #ClassSearch, + #superclass : #CodeSearch, + #category : #Development +} + +{#category : #services} +ClassSearch >> search [ + self reset. + Kernel namespace keysAndValuesDo: [:name :global | + (global isClass and: [self includes: name]) + ifTrue: [results add: (CodeSearchResult class: global)]] +] + diff --git a/modules/Development/CodeSearch.st b/modules/Development/CodeSearch.st new file mode 100644 index 0000000..0242c2b --- /dev/null +++ b/modules/Development/CodeSearch.st @@ -0,0 +1,165 @@ +" + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #CodeSearch, + #superclass : #Object, + #instVars : [ + 'condition', + 'results', + 'sorter' + ], + #category : #Development +} + +{#category : #services} +CodeSearch class >> search: aString [ + " + SelectorSearch search: 'abc' + " + ^self new search: aString +] + +{#category : #services} +CodeSearch class >> search: text in: type [ + " + CodeSearch search: 'abc' in: 'all' + " + ^self search: text in: type ignoreCase: false conditionType: #beginning +] + +{#category : #services} +CodeSearch class >> search: text +in: type +ignoreCase: ignoreCase +conditionType: conditionType [ + " + CodeSearch search: 'a' in: 'all' ignoreCase: true position: #beginning + " + ^(self searchClassesFor: type) gather: [:c | + c new + ignoreCase: ignoreCase; + conditionType: conditionType; + search: text] +] + +{#category : #private} +CodeSearch class >> searchClassesFor: type [ + " + CodeSearch searchClassesFor: 'all' + CodeSearch searchClassesFor: 'implementors' + " + ^type = 'all' + ifTrue: [{ClassSearch. SelectorSearch. ProjectSearch. PoolSearch}] + ifFalse: [self subclasses select: [:c | c type = type]] +] + +{#category : #services} +CodeSearch class >> subclassesToSearch [ + ^subclasses copyWithout: ImplementorSearch +] + +{#category : #private} +CodeSearch class >> type [ + " + CodeSearch type => 'all' + ClassSearch type => 'classes' + " + ^self == CodeSearch + ifTrue: ['all'] + ifFalse: [(self name trimTail: 'Search') asLowercase] +] + +{#category : #accessing} +CodeSearch >> condition [ + ^condition +] + +{#category : #condition} +CodeSearch >> conditionType: aSymbol [ + | case | + case := condition matchesCase. + condition := CodeSearchCondition perform: aSymbol asSymbol. + condition matchCase: case +] + +{#category : #private} +CodeSearch >> defaultCondition [ + ^CodeSearchCondition beginning matchCase: true +] + +{#category : #condition} +CodeSearch >> ignoreCase: aBoolean [ + condition matchCase: aBoolean not +] + +{#category : #private} +CodeSearch >> includes: aString [ + ^condition evaluateWith: aString +] + +{#category : #initialization} +CodeSearch >> initialize [ + super initialize. + condition := self defaultCondition. + results := OrderedCollection new. + self sortBySize +] + +{#category : #condition} +CodeSearch >> matchCase: aBoolean [ + condition matchCase: aBoolean +] + +{#category : #condition} +CodeSearch >> pattern: aString [ + condition := CodeSearchCondition matching: aString +] + +{#category : #inquiries} +CodeSearch >> rawResults [ + ^results +] + +{#category : #private} +CodeSearch >> reset [ + results removeAll +] + +{#category : #services} +CodeSearch >> search [ + self subclassResponsibility +] + +{#category : #services} +CodeSearch >> search: aString [ + condition text: aString. + self reset; search. + condition isSimilarity + ifTrue: [sorter := [:r1 :r2 | (condition text editDistanceTo: r1 text) + <= (condition text editDistanceTo: r2 text)]]. + ^self sortedResults +] + +{#category : #accessing} +CodeSearch >> sortAlphabetically [ + sorter := [:r1 :r2 | r1 text <= r2 text] +] + +{#category : #accessing} +CodeSearch >> sortBySize [ + sorter := [:r1 :r2 | r1 text size <= r2 text size] +] + +{#category : #inquiries} +CodeSearch >> sortedResults [ + ^sorter ifNil: [results] ifNotNil: [results sortBy: sorter] +] + +{#category : #condition} +CodeSearch >> text: aString [ + condition text: aString +] + diff --git a/modules/Development/CodeSearchCondition.st b/modules/Development/CodeSearchCondition.st new file mode 100644 index 0000000..f01a96c --- /dev/null +++ b/modules/Development/CodeSearchCondition.st @@ -0,0 +1,124 @@ +" + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #CodeSearchCondition, + #superclass : #Object, + #instVars : [ + 'text', + 'matchCase' + ], + #category : #Development +} + +{#category : #'instance creation'} +CodeSearchCondition class >> beginning [ + ^BeginningCondition new +] + +{#category : #'instance creation'} +CodeSearchCondition class >> beginningWith: aString [ + ^self beginning text: aString +] + +{#category : #'instance creation'} +CodeSearchCondition class >> ending [ + ^EndingCondition new +] + +{#category : #'instance creation'} +CodeSearchCondition class >> endingWith: aString [ + ^self ending text: aString +] + +{#category : #'instance creation'} +CodeSearchCondition class >> exact [ + ^ExactMatchCondition new +] + +{#category : #'instance creation'} +CodeSearchCondition class >> including [ + ^IncludingCondition new +] + +{#category : #'instance creation'} +CodeSearchCondition class >> including: aString [ + ^self including text: aString +] + +{#category : #'instance creation'} +CodeSearchCondition class >> matching: aString [ + ^PatternCondition new text: aString +] + +{#category : #'instance creation'} +CodeSearchCondition class >> similar [ + ^SimilarityCondition new +] + +{#category : #private} +CodeSearchCondition >> compare: aString [ + self subclassResponsibility +] + +{#category : #evaluating} +CodeSearchCondition >> evaluateWith: aString [ + | string | + string := matchCase ifTrue: [aString] ifFalse: [aString asLowercase]. + ^self compare: string +] + +{#category : #initialization} +CodeSearchCondition >> initialize [ + super initialize. + matchCase := true +] + +{#category : #testing} +CodeSearchCondition >> isEmpty [ + ^text isEmptyOrNil +] + +{#category : #testing} +CodeSearchCondition >> isExactMatch [ + ^false +] + +{#category : #testing} +CodeSearchCondition >> isSimilarity [ + ^false +] + +{#category : #accessing} +CodeSearchCondition >> matchCase: aBoolean [ + matchCase := aBoolean +] + +{#category : #testing} +CodeSearchCondition >> matchesCase [ + ^matchCase +] + +{#category : #printing} +CodeSearchCondition >> printOn: aStream [ + | case | + case := matchCase ifTrue: ['sensitive'] ifFalse: ['insensitive']. + aStream + nextPutAll: self proposition; + space; + nextPutAll: (text ifNil: ''); + nextPutAll: ' (case ' , case , ')' +] + +{#category : #accessing} +CodeSearchCondition >> text [ + ^text +] + +{#category : #accessing} +CodeSearchCondition >> text: aString [ + text := matchCase ifTrue: [aString] ifFalse: [aString asLowercase] +] + diff --git a/modules/Development/CodeSearchResult.st b/modules/Development/CodeSearchResult.st new file mode 100644 index 0000000..2867ce5 --- /dev/null +++ b/modules/Development/CodeSearchResult.st @@ -0,0 +1,74 @@ +" + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #CodeSearchResult, + #superclass : #Object, + #instVars : [ + 'type', + 'contents' + ], + #category : #Development +} + +{#category : #'instance creation'} +CodeSearchResult class >> class: aClass [ + ^self new type: #class; contents: aClass +] + +{#category : #'instance creation'} +CodeSearchResult class >> method: aCompiledMethod [ + ^self new type: #method; contents: aCompiledMethod +] + +{#category : #'instance creation'} +CodeSearchResult class >> pool: aString [ + ^self new type: #pool; contents: aString +] + +{#category : #'instance creation'} +CodeSearchResult class >> project: aBeeProject [ + ^self new type: #project; contents: aBeeProject +] + +{#category : #'instance creation'} +CodeSearchResult class >> selector: aSymbol [ + ^self new type: #selector; contents: aSymbol +] + +{#category : #accessing} +CodeSearchResult >> contents [ + ^contents +] + +{#category : #accessing} +CodeSearchResult >> contents: anObject [ + contents := anObject +] + +{#category : #printing} +CodeSearchResult >> printOn: aStream [ + aStream + print: type; + nextPut: $:; + space; + print: contents +] + +{#category : #inquiries} +CodeSearchResult >> text [ + ^contents asString +] + +{#category : #accessing} +CodeSearchResult >> type [ + ^type +] + +{#category : #accessing} +CodeSearchResult >> type: aSymbol [ + type := aSymbol +] + diff --git a/modules/Development/CompiledMethod.st b/modules/Development/CompiledMethod.st index a2e0204..5a29b09 100644 --- a/modules/Development/CompiledMethod.st +++ b/modules/Development/CompiledMethod.st @@ -1,11 +1,22 @@ " - Copyright (c) 2024 Quorum Software. + Copyright (c) 2024, Quorum Software. See (MIT) license in root directory. " Extension {#name : #CompiledMethod} -{#category : '*IDE'} + +{ #category : #'*Development' } +CompiledMethod class >> aspects [ + ^#(#treecodeString #disassembledText) +] + +{ #category : #'*Development' } +CompiledMethod >> ast [ + ^nil +] + +{#category : '*Development'} CompiledMethod >> references: anObject [ | literal | 1 to: self size do: [:i | @@ -15,9 +26,14 @@ CompiledMethod >> references: anObject [ ^false ] -{#category : '*IDE'} +{#category : '*Development'} CompiledMethod >> literal: literal includes: anObject [ ^literal class == Array and: [ (literal includes: anObject) or: [literal anySatisfy: [:l | self literal: l includes: anObject]]] +] + +{#category : '*Development'} +CompiledMethod >> treecodeString [ + ^treecodes printString ] \ No newline at end of file diff --git a/modules/Development/DevelopmentModule.st b/modules/Development/DevelopmentModule.st new file mode 100644 index 0000000..aeaf629 --- /dev/null +++ b/modules/Development/DevelopmentModule.st @@ -0,0 +1,23 @@ +" + Copyright (c) 2025, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #DevelopmentModule, + #superclass : #Module, + #category : #Webside +} + +{ #category : #spec } +DevelopmentModule >> imports [ + ^{ + #Kernel -> #(ProtoObject) + } +] + +{ #category : #initializing } +DevelopmentModule >> main: arguments [ + +] + diff --git a/modules/Development/EndingCondition.st b/modules/Development/EndingCondition.st new file mode 100644 index 0000000..7c0d22c --- /dev/null +++ b/modules/Development/EndingCondition.st @@ -0,0 +1,21 @@ +" + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #EndingCondition, + #superclass : #CodeSearchCondition, + #category : #Development +} + +{#category : #private} +EndingCondition >> compare: aString [ + ^aString endsWith: text +] + +{#category : #private} +EndingCondition >> proposition [ + ^'ends with' +] + diff --git a/modules/Development/ExactMatchCondition.st b/modules/Development/ExactMatchCondition.st new file mode 100644 index 0000000..df357de --- /dev/null +++ b/modules/Development/ExactMatchCondition.st @@ -0,0 +1,26 @@ +" + Copyright (c) 202, Quorum Software. + See (MIT) license in root directory. +" + +Class { + #name : #ExactMatchCondition, + #superclass : #CodeSearchCondition, + #category : #Development +} + +{#category : #private} +ExactMatchCondition >> compare: aString [ + ^aString = text +] + +{#category : #testing} +ExactMatchCondition >> isExactMatch [ + ^true +] + +{#category : #private} +ExactMatchCondition >> proposition [ + ^'equals' +] + diff --git a/modules/Development/IncludingCondition.st b/modules/Development/IncludingCondition.st new file mode 100644 index 0000000..e56c93c --- /dev/null +++ b/modules/Development/IncludingCondition.st @@ -0,0 +1,21 @@ +" + Copyright (c) 202,5 Quorum Software. + See (MIT) license in root directory. +" + +Class { + #name : #IncludingCondition, + #superclass : #CodeSearchCondition, + #category : #Development +} + +{#category : #private} +IncludingCondition >> compare: aString [ + ^aString includesString: text +] + +{#category : #private} +IncludingCondition >> proposition [ + ^'includes' +] + diff --git a/modules/Development/MethodSearch.st b/modules/Development/MethodSearch.st new file mode 100644 index 0000000..6bbc3ba --- /dev/null +++ b/modules/Development/MethodSearch.st @@ -0,0 +1,182 @@ +" + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #MethodSearch, + #superclass : #CodeSearch, + #instVars : [ + 'scope', + 'next' + ], + #category : #Development +} + +{#category : #'instance creation'} +MethodSearch class >> assigningVariable: aString [ + ^VariableAccessSearch new type: #assign; text: aString +] + +{#category : #'instance creation'} +MethodSearch class >> referencingClass: aClass [ + ^ClassReferenceSearch new text: aClass name +] + +{#category : #'instance creation'} +MethodSearch class >> referencingString: aString [ + ^StringReferenceSearch new text: aString +] + +{#category : #'instance creation'} +MethodSearch class >> referencingVariable: aString [ + ^VariableAccessSearch new type: #reference; text: aString +] + +{#category : #'instance creation'} +MethodSearch class >> sending: aSymbol [ + ^SenderSearch new text: aSymbol +] + +{#category : #'instance creation'} +MethodSearch class >> underCategory: aString [ + ^CategorySearch new text: aString +] + +{#category : #'instance creation'} +MethodSearch class >> usingVariable: aString [ + ^VariableAccessSearch new type: #use; text: aString +] + +{#category : #'instance creation'} +MethodSearch class >> withSelector: aSymbol [ + ^ImplementorSearch new text: aSymbol +] + +{#category : #'instance creation'} +MethodSearch class >> withSelectorMatching: aString [ + ^ImplementorSearch new pattern: aString +] + +{#category : #combining} +MethodSearch >> & aMethodSearch [ + self class == MethodSearch ifTrue: [ + scope isDefault ifFalse: [aMethodSearch scope: scope]. + ^aMethodSearch]. + next notNil ifTrue: [next & aMethodSearch] ifFalse: [next := aMethodSearch] +] + +{#category : #private} +MethodSearch >> addResult: aCompiledMethod [ + | m | + m := next notNil + ifTrue: [aCompiledMethod] + ifFalse: [CodeSearchResult method: aCompiledMethod]. + results add: m +] + +{#category : #scope} +MethodSearch >> amongMethods: aCollection [ + scope := aCollection +] + +{#category : #combining} +MethodSearch >> assigningVariable: aString [ + ^self & (self class assigningVariable: aString) +] + +{#category : #private} +MethodSearch >> defaultScope [ + ^MethodSearchScope default +] + +{#category : #private} +MethodSearch >> doSearch [ + scope methods do: [:m | self addResult: m] +] + +{#category : #scope} +MethodSearch >> inClass: class [ + scope := MethodSearchScope class: class +] + +{#category : #scope} +MethodSearch >> includeClassSide: aBoolean [ + scope includeClassSide: aBoolean +] + +{#category : #initialization} +MethodSearch >> initialize [ + super initialize. + scope := self defaultScope +] + +{#category : #scope} +MethodSearch >> inProject: project [ + scope := MethodSearchScope project: project +] + +{#category : #combining} +MethodSearch >> referencingClass: aClass [ + ^self & (self class referencingClass: aClass) +] + +{#category : #combining} +MethodSearch >> referencingString: aString [ + ^self & (self class referencingString: aString) +] + +{#category : #combining} +MethodSearch >> referencingVariable: aString [ + ^self & (self class referencingVariable: aString) +] + +{#category : #initialization} +MethodSearch >> scope [ + ^scope +] + +{#category : #scope} +MethodSearch >> scope: aMethodSearchScope [ + scope := aMethodSearchScope +] + +{#category : #services} +MethodSearch >> search [ + self reset; doSearch. + ^next notNil + ifTrue: [next amongMethods: results; search] + ifFalse: [results] +] + +{#category : #private} +MethodSearch >> searchEvaluating: aBlock [ + scope do: [:m | (aBlock value: m) ifTrue: [self addResult: m]]. + ^results +] + +{#category : #combining} +MethodSearch >> sending: aSymbol [ + ^self & (self class sending: aSymbol) +] + +{#category : #combining} +MethodSearch >> underCategory: aString [ + ^self & (self class underCategory: aString) +] + +{#category : #combining} +MethodSearch >> usingVariable: aString [ + ^self & (self class usingVariable: aString) +] + +{#category : #combining} +MethodSearch >> withSelector: aSymbol [ + ^self & (self class withSelector: aSymbol) +] + +{#category : #combining} +MethodSearch >> withSelectorMatching: aString [ + ^self & (self class withSelectorMatching: aString) +] + diff --git a/modules/Development/MethodSearchScope.st b/modules/Development/MethodSearchScope.st new file mode 100644 index 0000000..5e04986 --- /dev/null +++ b/modules/Development/MethodSearchScope.st @@ -0,0 +1,175 @@ +" + Copyright (c) 2025, Quorum Software. + See (MIT) license in root directory. +" + +Class { + #name : #MethodSearchScope, + #superclass : #Object, + #instVars : [ + 'class', + 'hierarchy', + 'project', + 'classSide' + ], + #category : #Development +} + +{#category : #'instance creation'} +MethodSearchScope class >> class: aClass [ + ^self new class: aClass +] + +{#category : #'instance creation'} +MethodSearchScope class >> default [ + ^self hierarchy: ProtoObject +] + +{#category : #'instance creation'} +MethodSearchScope class >> hierarchy: aClass [ + ^self new hierarchy: aClass +] + +{#category : #'instance creation'} +MethodSearchScope class >> project: aBeeProject [ + ^self new project: aBeeProject +] + +{#category : #comparing} +MethodSearchScope >> = aMethodSearchScope [ + ^self class == aMethodSearchScope class + and: [class == aMethodSearchScope targetClass] + and: [hierarchy == aMethodSearchScope targetHierarchy] + and: [project == aMethodSearchScope targetProject] + and: [classSide == aMethodSearchScope includesClassSide] +] + +{#category : #accessing} +MethodSearchScope >> class: aClass [ + class := aClass. + hierarchy := project := nil +] + +{#category : #enumerating} +MethodSearchScope >> classesDo: aBlock [ + class notNil ifTrue: [^aBlock value: class]. + hierarchy notNil + ifTrue: [^hierarchy allSuperclasses reversed , hierarchy withAllSubclasses + do: aBlock]. + project notNil ifTrue: [^project classes do: aBlock] +] + +{#category : #enumerating} +MethodSearchScope >> collect: aBlock [ + | result | + result := OrderedCollection new. + self do: [:m | result add: (aBlock evaluateWith: m)]. + ^result +] + +{#category : #enumerating} +MethodSearchScope >> do: aBlock [ + self methodsDo: aBlock +] + +{#category : #comparing} +MethodSearchScope >> hash [ + ^self class hashWith: class with: hierarchy with: project with: classSide +] + +{#category : #accessing} +MethodSearchScope >> hierarchy: aClass [ + hierarchy := aClass. + class := project := nil +] + +{#category : #accessing} +MethodSearchScope >> includeClassSide: aBoolean [ + classSide := aBoolean +] + +{#category : #testing} +MethodSearchScope >> includesClassSide [ + ^classSide +] + +{#category : #initialization} +MethodSearchScope >> initialize [ + super initialize. + classSide := true. + hierarchy := ProtoObject +] + +{#category : #testing} +MethodSearchScope >> isDefault [ + ^self = self class default +] + +{#category : #inquiries} +MethodSearchScope >> methods [ + | methods | + methods := OrderedCollection new. + self methodsDo: [:m | methods add: m]. + ^methods +] + +{#category : #enumerating} +MethodSearchScope >> methodsDo: aBlock [ + project notNil ifTrue: [^project allMethods do: aBlock]. + self classesDo: [:c | + c methodDictionary values do: aBlock. + classSide ifTrue: [c class methodDictionary values do: aBlock]] +] + +{#category : #printing} +MethodSearchScope >> printOn: aStream [ + class notNil ifTrue: [ + aStream + nextPutAll: 'Methods in '; + print: class; + nextPutAll: ' class'. + ^self]. + hierarchy notNil ifTrue: [ + aStream + nextPutAll: 'Methods in '; + print: hierarchy; + nextPutAll: ' hierarhcy'. + ^self]. + project notNil ifTrue: [ + aStream + nextPutAll: 'Methods in '; + print: project; + nextPutAll: ' project'. + ^self]. + super printOn: aStream +] + +{#category : #accessing} +MethodSearchScope >> project: aBeeProject [ + project := aBeeProject. + hierarchy := class := nil +] + +{#category : #enumerating} +MethodSearchScope >> select: aBlock [ + | result | + result := OrderedCollection new. + self do: [:m | (aBlock evaluateWith: m) ifTrue: [result add: m]]. + ^result +] + +{#category : #accessing} +MethodSearchScope >> targetClass [ + ^class +] + +{#category : #accessing} +MethodSearchScope >> targetHierarchy [ + ^hierarchy +] + +{#category : #accessing} +MethodSearchScope >> targetProject [ + ^project +] + diff --git a/modules/Development/PatternCondition.st b/modules/Development/PatternCondition.st new file mode 100644 index 0000000..230b8c6 --- /dev/null +++ b/modules/Development/PatternCondition.st @@ -0,0 +1,31 @@ +" + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #PatternCondition, + #superclass : #CodeSearchCondition, + #category : #Development +} + +{#category : #private} +PatternCondition >> compare: aString [ + ^text match: aString +] + +{#category : #private} +PatternCondition >> proposition [ + ^'matches' +] + +{#category : #accessing} +PatternCondition >> text: aString [ + | string | + string := aString trimBlanks. + string := matchCase ifTrue: [aString] ifFalse: [aString asLowercase]. + string first != $* ifTrue: [string := '*' , string]. + string last != $* ifTrue: [string := string , '*']. + super text: string +] + diff --git a/modules/Development/SimilarityCondition.st b/modules/Development/SimilarityCondition.st new file mode 100644 index 0000000..6fe5afa --- /dev/null +++ b/modules/Development/SimilarityCondition.st @@ -0,0 +1,35 @@ +" + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #SimilarityCondition, + #superclass : #CodeSearchCondition, + #instVars : [ + 'tolerance' + ], + #category : #Development +} + +{#category : #private} +SimilarityCondition >> compare: aString [ + ^(aString editDistanceTo: text) <= tolerance +] + +{#category : #initialization} +SimilarityCondition >> initialize [ + super initialize. + tolerance := 3 +] + +{#category : #testing} +SimilarityCondition >> isSimilarity [ + ^true +] + +{#category : #private} +SimilarityCondition >> proposition [ + ^'is similar to' +] + diff --git a/modules/Development/package.st b/modules/Development/package.st deleted file mode 100644 index b75a73b..0000000 --- a/modules/Development/package.st +++ /dev/null @@ -1,12 +0,0 @@ -" - Copyright (c) 2024 Quorum Software. - See (MIT) license in root directory. -" - -Package { - #name : #Development, - #requires : [ - ], - #classes : [ - ] -} \ No newline at end of file diff --git a/modules/HTTP/CPPHTTPServer/HTTPMessage.st b/modules/HTTP/CPPHTTPServer/HTTPMessage.st new file mode 100644 index 0000000..f79aa21 --- /dev/null +++ b/modules/HTTP/CPPHTTPServer/HTTPMessage.st @@ -0,0 +1,20 @@ +" + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #HTTPMessage, + #superclass : #HTTPObject, + #category : #'CPPHTTPServer' +} + +{ #category : #spec } +HTTPMessage >> accept [ + ^self headersAt: 'Accept' +] + +{ #category : #spec } +HTTPMessage >> headersAt: aString [ + ^self subclassResponsibility +] \ No newline at end of file diff --git a/modules/HTTP/CPPHTTPServer/HTTPObject.st b/modules/HTTP/CPPHTTPServer/HTTPObject.st new file mode 100644 index 0000000..5fd7972 --- /dev/null +++ b/modules/HTTP/CPPHTTPServer/HTTPObject.st @@ -0,0 +1,11 @@ +" + Copyright (c) 2025, Javier Pimás. + See (MIT) license in root directory. +" + +Class { + #name : #HTTPObject, + #superclass : #ExternalObject, + #category : #'CPPHTTPServer' +} + diff --git a/modules/HTTP/CPPHTTPServer/HTTPRequest.st b/modules/HTTP/CPPHTTPServer/HTTPRequest.st index 74ab234..c0a95a4 100644 --- a/modules/HTTP/CPPHTTPServer/HTTPRequest.st +++ b/modules/HTTP/CPPHTTPServer/HTTPRequest.st @@ -21,3 +21,38 @@ HTTPRequest >> paramAt: aString [ "should do better and look at encoding" ^String fromMemory: addr pointedMemory ] + +{ #category : #spec } +HTTPRequest >> headersAt: aString [ + | addr | + addr := self class module library + request: handle asParameter + headersAt: aString externalCopy asParameter. + + addr = 0 ifTrue: [^nil]. + + "should do better and look at encoding" + ^String fromMemory: addr pointedMemory +] + +{ #category : #spec } +HTTPRequest >> path [ + | addr | + addr := self class module library + requestPath: handle asParameter. + + ^String fromMemory: addr pointedMemory +] + +{ #category : #spec } +HTTPRequest >> queryAt: aString [ + | addr | + addr := self class module library + request: handle asParameter + queryAt: aString externalCopy asParameter. + + addr = 0 ifTrue: [^nil]. + + "should do better and look at encoding" + ^String fromMemory: addr pointedMemory +] diff --git a/modules/HTTP/CPPHTTPServer/HTTPResponse.st b/modules/HTTP/CPPHTTPServer/HTTPResponse.st index fdd92ab..e36a39c 100644 --- a/modules/HTTP/CPPHTTPServer/HTTPResponse.st +++ b/modules/HTTP/CPPHTTPServer/HTTPResponse.st @@ -9,10 +9,32 @@ Class { #category : #'CPPHTTPServer' } +{ #category : #spec } +HTTPResponse >> notFound [ + self + status: 404; + setContents: 'The server has not found anything matching the requested URI (Uniform Resource Identifier).' type: 'text/plain'. +] + { #category : #spec } HTTPResponse >> setContents: aString type: anotherString [ - self class module library + self class module library response: handle asParameter setContents: aString externalCopy asParameter type: anotherString externalCopy asParameter ] + +{ #category : #spec } +HTTPResponse >> status: anInteger [ + self class module library + response: handle asParameter + status: anInteger asParameter +] + +{ #category : #spec } +HTTPResponse >> headersAt: aString put: anotherString [ + self class module library + response: handle asParameter + headersAt: aString externalCopy asParameter + put: anotherString externalCopy asParameter +] diff --git a/modules/HTTP/CPPHTTPServer/HTTPServerLibrary.st b/modules/HTTP/CPPHTTPServer/HTTPServerLibrary.st index 977b29b..19de1cd 100644 --- a/modules/HTTP/CPPHTTPServer/HTTPServerLibrary.st +++ b/modules/HTTP/CPPHTTPServer/HTTPServerLibrary.st @@ -55,12 +55,37 @@ HTTPServerLibrary >> stopServer: aServer [ ] +{ #category : #request } +HTTPServerLibrary >> request: aRequest headersAt: aString [ + +] + { #category : #request } HTTPServerLibrary >> request: aRequest paramAt: aString [ ] +{ #category : #request } +HTTPServerLibrary >> request: aRequest queryAt: aString [ + +] + +{ #category : #request } +HTTPServerLibrary >> requestPath: aRequest [ + +] + +{ #category : #response } +HTTPServerLibrary >> response: aResponse headersAt: aString put: anotherString [ + +] + { #category : #response } HTTPServerLibrary >> response: aResponse setContents: aString type: anotherString [ ] + +{ #category : #response } +HTTPServerLibrary >> response: aResponse status: anInteger [ + +] \ No newline at end of file diff --git a/modules/HTTP/CPPHTTPServer/lib/server.cpp b/modules/HTTP/CPPHTTPServer/lib/server.cpp index 4851d3d..112e2fc 100644 --- a/modules/HTTP/CPPHTTPServer/lib/server.cpp +++ b/modules/HTTP/CPPHTTPServer/lib/server.cpp @@ -27,6 +27,7 @@ void Server_Get(void *cserver, char *url, void *ccallback) void Server_Start(void *cserver) { httplib::Server *server = reinterpret_cast(cserver); + server->new_task_queue = []() { return new httplib::ThreadPool(1); }; // assure no multithreading goes on, as egg does not support it server->listen("0.0.0.0", 8080); } @@ -35,20 +36,60 @@ void Server_Delete(void *cserver) { delete server; } -char* Request_ParamAt(void *creq, char *key, char *type) +char* Request_HeadersAt(void *creq, char *key, char *type) { httplib::Request *req = reinterpret_cast(creq); + auto &headers = req->headers; + auto it = headers.find(key); + if (it == headers.end()) + return nullptr; + + return const_cast(it->second.c_str()); +} + +char* Request_ParamAt(void *creq, char *key, char *type) +{ + httplib::Request *req = reinterpret_cast(creq); auto ¶ms = req->path_params; auto it = params.find(key); return it != params.end() ? (char*)it->second.c_str() : nullptr; } +char* Request_QueryAt(void *creq, char *key, char *type) +{ + httplib::Request *req = reinterpret_cast(creq); + auto ¶ms = req->params; + auto it = params.find(key); + return it != params.end() ? (char*)it->second.c_str() : nullptr; +} + +char* Request_Path(void *creq) +{ + httplib::Request *req = reinterpret_cast(creq); + + return (char*)req->path.c_str(); +} + + +void Response_HeadersAtPut(void *cres, char *key, char *value) +{ + httplib::Response *res = reinterpret_cast(cres); + res->set_header(key, value); +} + void Response_SetContent(void *cres, char *content, char *type) { httplib::Response *res = reinterpret_cast(cres); res->set_content(content, type); } +void Response_SetStatus(void *cres, int status) +{ + httplib::Response *res = reinterpret_cast(cres); + res->status = status; +} + + } diff --git a/modules/Kernel/CompiledMethod.st b/modules/Kernel/CompiledMethod.st index 5afdf33..adbc043 100644 --- a/modules/Kernel/CompiledMethod.st +++ b/modules/Kernel/CompiledMethod.st @@ -22,11 +22,6 @@ Class { #category : #Kernel } -{ #category : #inspecting } -CompiledMethod class >> aspects [ - ^#(#treecodeString #disassembledText) -] - { #category : #accessing } CompiledMethod >> author [ ^'Unknown' diff --git a/modules/Kernel/Metaclass.st b/modules/Kernel/Metaclass.st index 9e66bef..d565f00 100644 --- a/modules/Kernel/Metaclass.st +++ b/modules/Kernel/Metaclass.st @@ -38,6 +38,11 @@ Metaclass >> classVarNames [ ^class classVarNames ] +{ #category : #accessing } +Metaclass >> comment [ + ^class comment +] + { #category : #services } Metaclass >> duplicateHierarchyFrom: aClass with: aClassCopy [ ^(class duplicateHierarchyFrom: aClass with: aClassCopy) class diff --git a/modules/Webside/ByteArray.st b/modules/Webside/ByteArray.st new file mode 100644 index 0000000..0c2a7c3 --- /dev/null +++ b/modules/Webside/ByteArray.st @@ -0,0 +1,25 @@ +" + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +" + +Extension { #name : #ByteArray } + +{ #category : #'*webside' } +ByteArray >> asBase64 [ + | alphabet result size triple | + alphabet := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'. + result := '' writeStream. + size := self size. + 1 to: size by: 3 do: [:i | + triple := (self at: i) << 16. + triple := triple bitOr: (self at: i+1 ifAbsent: [ 0 ]) << 8. + triple := triple bitOr: (self at: i+2 ifAbsent: [ 0 ]). + result + nextPut: (alphabet at: (triple >> 18 bitAnd: 63) + 1); + nextPut: (alphabet at: (triple >> 12 bitAnd: 63) + 1); + nextPut: (i+1 <= size ifTrue: [ alphabet at: ((triple >> 6 bitAnd: 63) + 1) ] ifFalse: [ $= ]); + nextPut: (i+2 <= size ifTrue: [ alphabet at: ((triple bitAnd: 63) + 1) ] ifFalse: [ $= ]) + ]. + ^result contents +] diff --git a/modules/Webside/Collection.st b/modules/Webside/Collection.st new file mode 100644 index 0000000..df0b3c2 --- /dev/null +++ b/modules/Webside/Collection.st @@ -0,0 +1,29 @@ +" + Copyright (c) 2025, Quorum Software. + See (MIT) license in root directory. +" + +Extension { #name : #Object } + +{ #category : #'*webside' } +Object >> groupBy: aspect [ + | answer key copy remove | + answer := Dictionary new. + (aspect arity = 0 or: [aspect isClosure and: [aspect arity = 1]]) ifTrue: [ + self do: [:each | + key := aspect evaluateWith: each. + (answer at: key ifAbsentPut: [OrderedCollection new]) add: each]. + ^answer]. + copy := IdentitySet withAll: self. + remove := IdentitySet new. + self do: [:each | + copy do: [:e | + (aspect evaluateWith: each with: e) ifTrue: [ + remove add: e. + (answer at: each ifAbsentPut: [OrderedCollection new]) add: e]]. + copy removeAll: remove. + remove removeAll]. + ^answer + +] + diff --git a/modules/Webside/CompiledMethod.st b/modules/Webside/CompiledMethod.st new file mode 100644 index 0000000..813715c --- /dev/null +++ b/modules/Webside/CompiledMethod.st @@ -0,0 +1,31 @@ +" + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +" + +Extension { #name : #CompiledMethod } + +{ #category : #'*webside' } +CompiledMethod >> asWebsideJson [ + | json status | + json := super asWebsideJson. + json + at: 'selector' put: selector; + at: 'methodClass' put: class name; + at: 'category' put: self category; + at: 'source' put: self sourceObject; + at: 'author' put: self author; + at: 'timestamp' put: self timestamp; + at: 'package' put: self module name; + at: 'needsRecompilation' put: self needsRecompilation. + "self isTest ifTrue: [ + status := self propertyAt: #status ifAbsent: ['unknown']. + json at: 'status' put: status asString]." + ^json +] + +{ #category : #'*webside' } +CompiledMethod >> needsRecompilation [ + "FIXME: to be implemented" + ^false +] diff --git a/modules/Webside/WebsideAPI.st b/modules/Webside/WebsideAPI.st index b0df205..13b142c 100644 --- a/modules/Webside/WebsideAPI.st +++ b/modules/Webside/WebsideAPI.st @@ -1,5 +1,5 @@ " - Copyright (c) 2025, Javier Pimás. + Copyright (c) 2025, Javier Pimás, Guillermo Amaral. See (MIT) license in root directory. " @@ -86,9 +86,7 @@ WebsideAPI class >> addGeneralRoutesTo: aWebApplication [ aWebApplication routeGET: '/dialect' to: #dialect; routeGET: '/logo' to: #logo; - routeGET: '/colors' to: #colors; - routePOST: '/save' to: #saveImage; - routeGET: '/themes' to: #themes + routeGET: '/colors' to: #colors ] @@ -101,6 +99,27 @@ WebsideAPI class >> addRoutesTo: aWebApplication [ addChangesRoutesTo: aWebApplication ] +{ #category : #spec } +WebsideAPI >> annotationsForMethod: method [ + ^OrderedCollection new +] + +{ #category : #spec } +WebsideAPI >> categories [ + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^class categories +] + +{ #category : #spec } +WebsideAPI >> classDefinition [ + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^class asWebsideJson +] + { #category : #spec } WebsideAPI >> classes [ | root tree classes names depth json | @@ -126,16 +145,239 @@ WebsideAPI >> classNamed: aString [ name := aString. metaclass := name endsWith: ' class'. metaclass ifTrue: [name := name trimTail: ' class']. - class := Kernel at: name asSymbol ifAbsent: [^nil]. + class := Kernel namespace at: name asSymbol ifAbsent: [^nil]. class isSpecies ifFalse: [^nil]. ^metaclass ifTrue: [class class] ifFalse: [class] ] +{ #category : #spec } +WebsideAPI >> classTreeFrom: aClass depth: anInteger [ + | json subclasses depth names | + names := self queryAt: 'names'. + json := names = 'true' + ifTrue: [ + self newJsonObject + at: 'name' put: aClass name; + at: 'superclass' + put: (aClass superclass ifNotNil: [:c | c name]); + yourself] + ifFalse: [aClass asWebsideJson]. + (anInteger notNil and: [anInteger = 0]) ifTrue: [^json]. + depth := anInteger notNil ifTrue: [anInteger - 1]. + subclasses := (aClass subclasses sortBy: #name) + collect: [:c | self classTreeFrom: c depth: depth]. + json at: 'subclasses' put: subclasses. + ^json +] + +{ #category : #spec } +WebsideAPI >> classVariables [ + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^class withAllSuperclasses gather: [:c | + c classVarNames asArray sort collect: [:v | + self newJsonObject + at: 'name' put: v; + at: 'class' put: c name , ' class'; + at: 'type' put: 'class'; + yourself]] +] + +{ #category : #spec } +WebsideAPI >> colors [ + ^JsonObject new + at: 'primary' put: '#81C784'; + at: 'secondary' put: '#2E7D32'; + yourself +] + { #category : #spec } WebsideAPI >> defaultRootClass [ ^ProtoObject ] +{ #category : #spec } +WebsideAPI >> dialect [ + ^'Egg' +] + +{ #category : #spec } +WebsideAPI >> instanceVariables [ + | class | + class := self requestedClass. + class isNil ifTrue: [^self notFound]. + ^class withAllSuperclasses + gather: [:c | + c instVarNames collect: [:n | + self newJsonObject + at: 'name' put: n; + at: 'class' put: c name; + at: 'type' put: 'instance'; + yourself]] + in: OrderedCollection new +] + +{ #category : #spec } +WebsideAPI >> jsonFromMethods: aCollection [ + | bytecodes disassembly ast annotations overriding overriden | + (self queryAt: 'basic') = 'true' ifTrue: [ + ^aCollection collect: [:m | + self newJsonObject + at: 'selector' put: m selector; + at: 'methodClass' put: m classBinding name; + at: 'category' put: m category; + at: 'package' put: m module name; + at: 'source' put: m sourceCode; + yourself]]. + bytecodes := (self queryAt: 'bytecodes') = 'true'. + disassembly := (self queryAt: 'disassembly') = 'true'. + ast := (self queryAt: 'ast') = 'true'. + annotations := (self queryAt: 'annotations') = 'true'. + overriding := self methodsRedefiningFrom: aCollection. + overriden := self methodsRedefinedFrom: aCollection. + ^aCollection collect: [:m | | json bcs | + json := m asWebsideJson. + json + at: 'overriding' put: (overriding includes: m); + at: 'overriden' put: (overriden includes: m). + bytecodes ifTrue: [ + bcs := [m treecodeString asString] on: Error do: ['']. + json at: 'bytecodes' put: bcs]. + + ast ifTrue: [json at: 'ast' put: m ast asWebsideJson]. + annotations + ifTrue: [json at: 'annotations' put: (self annotationsForMethod: m)]. + json] +] + +{ #category : #spec } +WebsideAPI >> logo [ + ^(Kernel host readFile: 'logo.png') asByteArray asBase64 -> 'image/png' +] + +{#category : #'code endpoints'} +WebsideAPI >> method [ + | method json | + method := self requestedMethod. + method ifNil: [^self notFound]. + json := self jsonFromMethods: (Array with: method). + ^json anyone +] + +{ #category : #spec } +WebsideAPI >> methods [ + | search methods | + search := self methodSearch. + search ifNil: [^#()]. + methods := search search collect: #contents. + (self queryAt: 'count') = 'true' ifTrue: [^methods size]. + ^self jsonFromMethods: methods +] + +{ #category : #spec } +WebsideAPI >> methodSearch [ + | scope search class | + scope := self methodSearchScope. + scope ifNil: [^nil]. + search := MethodSearch new. + search scope: scope. + self + queryAt: 'selector' + ifPresent: [:s | search := search withSelector: s asSymbol]; + queryAt: 'selectorMatching' + ifPresent: [:s | search := search withSelectorMatching: s asSymbol]. + self + queryAt: 'sending' + ifPresent: [:s | search := search sending: s asSymbol]. + self queryAt: 'referencingClass' ifPresent: [:n | + class := self classNamed: n. + class ifNil: [^nil]. + search := search referencingClass: class]. + self + queryAt: 'referencingString' + ifPresent: [:s | search := search referencingString: s]. + self queryAt: 'class' ifPresent: [:n | + class := self classNamed: n. + class ifNil: [^nil]. + search := search inClass: class; includeClassSide: false]. + self + queryAt: 'category' + ifPresent: [:c | search := search underCategory: c asSymbol]. + self + queryAt: 'accessing' + ifPresent: [:v | search := search referencingVariable: v]. + self queryAt: 'using' ifPresent: [:v | search := search usingVariable: v]. + self + queryAt: 'assigning' + ifPresent: [:v | search := search assigningVariable: v]. + ^search +] + +{ #category : #spec } +WebsideAPI >> methodsRedefinedFrom: aCollection [ + " + [WebsideAPI new methodsRedefinedFrom: Object methodDictionary values asArray] timeToRun + " + | redefined grouped | + redefined := OrderedCollection new. + grouped := aCollection groupBy: #classBinding. + grouped keysAndValuesDo: [:class :methods | + class allSubclassesDo: [:subclass | + methods removeAllSuchThat: [:m | | found | + found := subclass includesSelector: m selector. + found ifTrue: [redefined add: m]. + found]]]. + ^redefined +] + +{ #category : #spec } +WebsideAPI >> methodsRedefiningFrom: aCollection [ + " + WebsideAPI new methodsRedefiningFrom: Object methodDictionary values asArray + " + | redefining grouped | + redefining := OrderedCollection new. + grouped := aCollection groupBy: #classBinding. + grouped keysAndValuesDo: [:class :methods | + class allSuperclassesDo: [:subclass | + methods copy + select: [:m | subclass includesSelector: m selector] + thenDo: [:m | + redefining add: m. + methods remove: m]]]. + ^redefining +] + +{ #category : #spec } +WebsideAPI >> methodSearchScope [ + | name class | + name := (self urlAt: 'name') ifNil: [self queryAt: 'class']. + name ifNotNil: [ + class := self classNamed: name. + ^class + ifNotNil: [(MethodSearchScope class: class) includeClassSide: false] + ifNil: nil]. + self queryAt: 'hierarchy' ifPresent: [:h | + class := self classNamed: h. + ^class ifNotNil: [MethodSearchScope hierarchy: class] ifNil: nil]. + self queryAt: 'package' ifPresent: [:n | | project | + project := self packageNamed: n. + ^project ifNotNil: [MethodSearchScope project: project] ifNil: nil]. + ^MethodSearchScope new +] + +{ #category : #spec } +WebsideAPI >> newJsonObject [ + ^JsonObject new +] + +{ #category : #spec } +WebsideAPI >> notFound [ + response notFound. + ^nil +] + { #category : #spec } WebsideAPI >> queryAt: aString [ ^self queryAt: aString ifAbsent: nil @@ -146,10 +388,15 @@ WebsideAPI >> queryAt: aString ifAbsent: aBlock [ ^self queryAt: aString ifPresent: nil ifAbsent: aBlock ] +{ #category : #spec } +WebsideAPI >> queryAt: aString ifPresent: aBlock [ + ^self queryAt: aString ifPresent: aBlock ifAbsent: nil +] + { #category : #spec } WebsideAPI >> queryAt: aString ifPresent: aBlock ifAbsent: anotherBlock [ | value | - value := request paramAt: aString. + value := request queryAt: aString. (value isNil or: [value isEmpty]) ifTrue: [^anotherBlock value]. ^aBlock notNil ifTrue: [aBlock evaluateWith: value] ifFalse: [value]] @@ -158,8 +405,92 @@ WebsideAPI >> request: aRequest [ request := aRequest ] +{ #category : #spec } +WebsideAPI >> requestedClass [ + | name | + name := self urlAt: 'name'. + ^name ifNotNil: [self classNamed: name] +] + +{#category : #private} +WebsideAPI >> requestedMethod [ + | class selector json | + class := self requestedClass. + class ifNil: [^nil]. + selector := self requestedSelector. + selector ifNil: [^nil]. + ^class >> selector +] + +{#category : #private} +WebsideAPI >> requestedSelector [ + | selector | + selector := self urlAt: 'selector'. + ^selector ifNotNil: [selector asSymbol] +] + { #category : #spec } WebsideAPI >> response: aResponse [ response := aResponse ] +{ #category : #spec } +WebsideAPI >> search [ + | text ignoreCase position type results | + text := self queryAt: 'text' ifAbsent: [^self badRequest: 'missing text']. + ignoreCase := (self queryAt: 'ignoreCase') = 'true'. + position := (self queryAt: 'condition' ifAbsent: [#beginning]) asSymbol. + type := self queryAt: 'type' ifAbsent: 'all'. + results := CodeSearch + search: text + in: type + ignoreCase: ignoreCase + conditionType: position. + ^results collect: #asWebsideJson +] + +{ #category : #spec } +WebsideAPI >> subclasses [ + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^class subclasses collect: [:c | c asWebsideJson] +] + +{ #category : #spec } +WebsideAPI >> superclasses [ + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^class allSuperclasses collect: [:c | c asWebsideJson] +] + +{ #category : #spec } +WebsideAPI >> urlAt: aString [ + ^request paramAt: aString +] + +{ #category : #spec } +WebsideAPI >> usedCategories [ + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^self instanceVariables , self classVariables +] + +{ #category : #spec } +WebsideAPI >> usualCategories [ + | meta | + meta := self queryAt: 'meta'. + ^meta = 'true' + ifTrue: [#(#'instance creation' #accessing #validation #initialization #testing #'gui support' #constants #private #defaults #events #services #examples)] + ifFalse: [#(#accessing #actions #construction #'event handlers' #initialization #inquiries #printing #private #services #testing #updating #validation)] +] + +{#category : #'code endpoints'} +WebsideAPI >> variables [ + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^self instanceVariables , self classVariables +] diff --git a/modules/Webside/WebsideApplication.st b/modules/Webside/WebsideApplication.st index b9e9ae8..356a555 100644 --- a/modules/Webside/WebsideApplication.st +++ b/modules/Webside/WebsideApplication.st @@ -57,14 +57,34 @@ WebsideApplication >> configure: anHttpServer [ WebsideAPI addRoutesTo: self ] +{#category : #queries} +WebsideApplication >> expectsJson: anHttpRequest [ + | accept | + accept := anHttpRequest headersAt: 'Accept'. + ^accept notNil and: [accept includesString: 'application/json'] +] + {#category : #initialization} WebsideApplication >> handleGET: request into: response with: anEvaluable [ - | api result | + | api result type contents | api := WebsideAPI new request: request; response: response. result := anEvaluable evaluateWith: api. - response setContents: result printString type: 'text/html' + result isAssociation + ifTrue: [ + type := result value. + result := result key] + ifFalse: [ + (self expectsJson: request) + ifTrue: [ + type := 'application/json'. + result := JsonWriter write: result] + ifFalse: [type := 'text/html']]. + + contents := result isString ifTrue: [result] ifFalse: [result printString]. + result ifNotNil: [response setContents: contents type: type]. + response headersAt: 'Access-Control-Allow-Origin' put: '*' ] {#category : #initialization} diff --git a/modules/Webside/WebsideModule.st b/modules/Webside/WebsideModule.st index b528839..fd3b01e 100644 --- a/modules/Webside/WebsideModule.st +++ b/modules/Webside/WebsideModule.st @@ -12,10 +12,11 @@ Class { { #category : #spec } WebsideModule >> imports [ ^{ + #Development -> #(CodeSearch MethodSearch MethodSearchScope). #FFI -> #(ExternalLibrary). #'HTTP.CPPHTTPServer' -> #(HTTPServer). - #Json -> #(JsonObject). - #Kernel -> #(Error OrderedDictionary ProtoObject ReadStream Species) + #Json -> #(JsonObject JsonWriter). + #Kernel -> #(ByteArray Error IdentitySet OrderedDictionary ProtoObject ReadStream Species) } ] diff --git a/modules/Webside/logo.png b/modules/Webside/logo.png new file mode 100644 index 0000000..e1c5226 Binary files /dev/null and b/modules/Webside/logo.png differ diff --git a/runtime/cpp/Allocator/AllocationZone.cpp b/runtime/cpp/Allocator/AllocationZone.cpp index fde08e8..0205877 100644 --- a/runtime/cpp/Allocator/AllocationZone.cpp +++ b/runtime/cpp/Allocator/AllocationZone.cpp @@ -170,7 +170,7 @@ void AllocationZone::releaseEvacuated_(std::vector *evacuated) space->_next = base; space->_committedLimit = base; space->_softLimit = base; - DecommitMemory(base, size * 2); + DecommitMemory(base, (*evacuated)[i-1] ? size * 2 : size); this->recycleSpace_(space); } } diff --git a/runtime/cpp/Evaluator/Evaluator.cpp b/runtime/cpp/Evaluator/Evaluator.cpp index 37653c2..60c62d5 100644 --- a/runtime/cpp/Evaluator/Evaluator.cpp +++ b/runtime/cpp/Evaluator/Evaluator.cpp @@ -27,6 +27,7 @@ #include #include #include +#include using namespace Egg; @@ -163,6 +164,7 @@ void Evaluator::initializePrimitives() this->addPrimitive("HostPlatformName", &Evaluator::primitiveHostPlatformName); this->addPrimitive("HostCurrentMilliseconds", &Evaluator::primitiveHostCurrentMilliseconds); this->addPrimitive("HostLog", &Evaluator::primitiveHostLog); + this->addPrimitive("HostReadFile", &Evaluator::primitiveHostReadFile); /* this->addPrimitive("PrepareForExecution", &Evaluator::primitivePrepareForExecution); @@ -715,6 +717,17 @@ Object* Evaluator::primitiveHostLog() { return this->_regR; } +Object* Evaluator::primitiveHostReadFile() { + auto filename = this->_context->firstArgument(); + std::ifstream file(filename->asHeapObject()->asLocalString(), std::ios::binary); + if (!file) + return this->failPrimitive(); + std::stringstream buffer; + buffer << file.rdbuf(); + + return (Object*)this->_runtime->newString_(buffer.str()); +} + Object* Evaluator::primitiveHostInitializeFFI() { auto library = this->_context->firstArgument()->asHeapObject(); auto handle = library->slotAt_(1); @@ -951,7 +964,13 @@ void Evaluator::initializeCIF(HeapObject *method, int argCount) { FFIDescriptorImpl *descriptor_impl = new FFIDescriptorImpl; descriptor_impl->cif = new ffi_cif(); descriptor_impl->argTypes = new ffi_type*[argCount + 1]; - descriptor_impl->fnAddr = (void(*)())FindSymbol(*(uintptr_t*)handle, (char*)fnName);; + descriptor_impl->fnAddr = (void(*)())FindSymbol(*(uintptr_t*)handle, (char*)fnName); + + if (descriptor_impl->fnAddr == nullptr) + { + delete descriptor_impl; + error_("could not find FFI method " + method->printString()); + } HeapObject *descriptor = _runtime->ffiMethodDescriptor_(method); diff --git a/runtime/cpp/Evaluator/Evaluator.h b/runtime/cpp/Evaluator/Evaluator.h index 22964bb..2c62e6f 100644 --- a/runtime/cpp/Evaluator/Evaluator.h +++ b/runtime/cpp/Evaluator/Evaluator.h @@ -209,6 +209,7 @@ class Evaluator : public SExpressionVisitor { Object* primitiveHostLoadModule(); Object* primitiveHostLog(); Object* primitiveHostPlatformName(); + Object* primitiveHostReadFile(); Object* primitiveNew(); Object* primitiveNewBytes(); Object* primitiveNewObjectHeap(); diff --git a/runtime/cpp/Evaluator/SExpressionLinearizer.cpp b/runtime/cpp/Evaluator/SExpressionLinearizer.cpp index 89c94f3..b1a4d89 100644 --- a/runtime/cpp/Evaluator/SExpressionLinearizer.cpp +++ b/runtime/cpp/Evaluator/SExpressionLinearizer.cpp @@ -119,9 +119,9 @@ void SExpressionLinearizer::inline_ifNil_(SMessage *anSMessage, bool aBoolean) auto branch = this->branchIf_(!aBoolean); if (arg->isBlock()) - this->visitStatements(((SBlock*)arg)->statements()); + this->visitStatements(((SBlock*)arg)->statements()); else - arg->acceptVisitor_(this); + arg->acceptVisitor_(this); this->dropToS(); @@ -147,10 +147,19 @@ void SExpressionLinearizer::inline_ifNilIfNotNil_(SMessage *anSMessage, bool aBo auto message = new SMessage(new SOpLoadRfromStack(0), _equalsEquals, {nilObj}, false); this->visitMessage(message); auto branch = this->branchIf_(!aBoolean); - this->visitStatements(((SBlock*)arguments[0])->statements()); + auto arg0 = arguments[0]; + if (arg0->isBlock()) + this->visitStatements(((SBlock*)arg0)->statements()); + else + arg0->acceptVisitor_(this); + auto end = this->jump(); this->branchTargetOf_(branch); - this->visitStatements(((SBlock*)arguments[1])->statements()); + auto arg1 = arguments[1]; + if (arg1->isBlock()) + this->visitStatements(((SBlock*)arg1)->statements()); + else + arg1->acceptVisitor_(this); this->branchTargetOf_(end); this->dropToS(); }