Big Glorp problem w/ type coercion, pls help

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
4 messages Options
Reply | Threaded
Open this post in threaded view
|

Big Glorp problem w/ type coercion, pls help

Herby Vojčík
Hello!

I encountered a problem with OneToOneMapping and type coercion. When
writing data, thing work; when reading data, the right child of relation
fails to convert.

I tried everything possible to inject converters (even subclassing
GlorpBlobType), but to no avail. RelationExpression passes conversion to
its left child:

convertedDbValueOf: anObject
        "Assume that our types match, so we can ask either child to do the
conversion. That isn't guaranteed, but should at least work for the
common cases."
        ^leftChild convertedDbValueOf: anObject.

but the left child is FieldExpression in case of OneToOneMapping, which:

convertedDbValueOf: anObject
        "We don't do any conversion"
        ^anObject

What is strange, writing works (even the OneToOneMapping, I opened the
sqlite file with an explorer), but second SELECT, one using the relation
(`state := self dao findStateByAgent: agent` in clientSync), fails with
"GlorpDatabaseReadError: Could not coerce arguments". FWIW, the first
one _does_ convert when creating bindings, as it uses MappingExpression
as left child (stepped over it in debugger).



Is it meant to be a strange case that primary key is something
non-primitive needing coercion (in this case, it is a UUID which needs
coercion to ByteArray, even if it is its subclass)?



Here's the stack of running the test which fails:

PharoDatabaseAccessor(DatabaseAccessor)>>handleError:for:
[ :ex | self handleError: ex for: command ] in [ | result |
self checkPermissionFor: command.
result := [ (self useBinding and: [ command useBinding ])
        ifTrue: [ command executeBoundIn: self ]
        ifFalse: [ command executeUnboundIn: self ] ]
        on: Dialect error
        do: [ :ex | self handleError: ex for: command ].
aBoolean
        ifTrue: [ result ]
        ifFalse: [ result upToEnd ] ] in
PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
BlockClosure>>cull:
Context>>evaluateSignal:
Context>>handleSignal:
Error(Exception)>>signal
Error(Exception)>>signal:
ExternalLibraryFunction(Object)>>error:
ExternalLibraryFunction(Object)>>externalCallFailed
ExternalLibraryFunction(ExternalFunction)>>invokeWithArguments:
UDBCSQLite3Library>>apiBindBlob:atColumn:with:with:with:
UDBCSQLite3Library>>with:at:putBlob:
UDBCSQLite3Statement>>at:putByteArray:
UDBCSQLite3ResultSet>>execute:withIndex:withValue:
[ :v | i := self execute: statement withIndex: i withValue: v ] in
UDBCSQLite3ResultSet>>execute:withCollection:
OrderedCollection>>do:
UDBCSQLite3ResultSet>>execute:withCollection:
UDBCSQLite3ResultSet>>execute:with:on:
UDBCSQLite3Connection>>execute:with:
GlorpSQLite3Driver>>basicExecuteSQLString:binding:
PharoDatabaseAccessor>>executeCommandBound:
QuerySelectCommand(DatabaseCommand)>>executeBoundIn:
[ (self useBinding and: [ command useBinding ])
        ifTrue: [ command executeBoundIn: self ]
        ifFalse: [ command executeUnboundIn: self ] ] in [ | result |
self checkPermissionFor: command.
result := [ (self useBinding and: [ command useBinding ])
        ifTrue: [ command executeBoundIn: self ]
        ifFalse: [ command executeUnboundIn: self ] ]
        on: Dialect error
        do: [ :ex | self handleError: ex for: command ].
aBoolean
        ifTrue: [ result ]
        ifFalse: [ result upToEnd ] ] in
PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
BlockClosure>>on:do:
[ | result |
self checkPermissionFor: command.
result := [ (self useBinding and: [ command useBinding ])
        ifTrue: [ command executeBoundIn: self ]
        ifFalse: [ command executeUnboundIn: self ] ]
        on: Dialect error
        do: [ :ex | self handleError: ex for: command ].
aBoolean
        ifTrue: [ result ]
        ifFalse: [ result upToEnd ] ] in
PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
[ caught := true.
self wait.
blockValue := mutuallyExcludedBlock value ] in Semaphore>>critical:
BlockClosure>>ensure:
Semaphore>>critical:
PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
[ session accessor executeCommand: command returnCursor: true ] in
SimpleQuery>>rowsFromDatabaseWithParameters:
BlockClosure>>on:do:
SimpleQuery>>rowsFromDatabaseWithParameters:
SimpleQuery(AbstractReadQuery)>>readFromDatabaseWithParameters:
SimpleQuery(AbstractReadQuery)>>executeWithParameters:in:
GlorpSession>>execute:
GlorpSession>>readOneOf:where:
TowergameDao>>findStateByAgent:
[ | agent state |
agent := self dao findAgentById: anObject agentId.
state := self dao findStateByAgent: agent.
^ NeoJSONObject new
        agentId: agent id;
        stateVersion: state version;
        totalAnsweredQuestions:
                (NeoJSONObject new
                        good: 0;
                        bad: 0;
                        yourself);
        yourself ] in Towergame>>clientSync:
[ myUnitOfWork := self hasUnitOfWork not.
myUnitOfWork
        ifTrue: [ self beginUnitOfWork ].
result := aBlock numArgs = 1
        ifTrue: [ aBlock value: self ]
        ifFalse: [ aBlock value ].
myUnitOfWork
        ifTrue: [ self commitUnitOfWork ] ] in GlorpSession>>inUnitOfWorkDo:
BlockClosure>>ifCurtailed:
GlorpSession>>inUnitOfWorkDo:
TowergameDao>>inUnitOfWorkDo:
Towergame>>clientSync:
TowergameSyncTests>>testPlayerChecksStateVersion
TowergameSyncTests(TestCase)>>performTest
[ self setUp.
self performTest ] in TowergameSyncTests(TestCase)>>runCase
BlockClosure>>ensure:
TowergameSyncTests(TestCase)>>runCase
[ aTestCase runCase ] in [ [ aTestCase runCase ]
        on: Halt
        do: [ :halt |
                "if test was halted we should resume all background failures
                        to debug all of them together with test process"
                failedProcesses keysDo: #resume.
                halt pass ] ] in TestExecutionEnvironment>>runTestCaseSafelly:
BlockClosure>>on:do:
[ [ aTestCase runCase ]
        on: Halt
        do: [ :halt |
                "if test was halted we should resume all background failures
                        to debug all of them together with test process"
                failedProcesses keysDo: #resume.
                halt pass ] ] in TestExecutionEnvironment>>runTestCaseSafelly:
BlockClosure>>on:do:
TestExecutionEnvironment>>runTestCaseSafelly:
[ self runTestCaseSafelly: aTestCase ] in [ [ self runTestCaseSafelly:
aTestCase ]
        ensure: [ testCompleted := true.
                watchDogSemaphore signal ]. "signal that test case completes"
self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase:
BlockClosure>>ensure:
[ [ self runTestCaseSafelly: aTestCase ]
        ensure: [ testCompleted := true.
                watchDogSemaphore signal ]. "signal that test case completes"
self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase:
BlockClosure>>ifCurtailed:
TestExecutionEnvironment>>runTestCase:
[ testEnv runTestCase: aTestCase ] in
DefaultExecutionEnvironment>>runTestCase:
[ self value: anExecutionEnvironment.
anExecutionEnvironment activated.
aBlock value ] in CurrentExecutionEnvironment class>>activate:for:
BlockClosure>>ensure:
CurrentExecutionEnvironment class>>activate:for:
TestExecutionEnvironment(ExecutionEnvironment)>>beActiveDuring:
DefaultExecutionEnvironment>>runTestCase:
CurrentExecutionEnvironment class>>runTestCase:
TowergameSyncTests(TestCase)>>runCaseManaged
[ aTestCase announce: TestCaseStarted withResult: self.
aTestCase runCaseManaged.
aTestCase announce: TestCaseEnded withResult: self.
self addPass: aTestCase ] in TestResult>>runCaseForDebug:
BlockClosure>>on:do:
TestResult>>runCaseForDebug:
[ result runCaseForDebug: self ] in TowergameSyncTests(TestCase)>>debug
BlockClosure>>ensure:
TowergameSyncTests(TestCase)>>debug
[ :each |
each debug.
self announceTest: each.
self changed: each ] in [ self tests
        do: [ :each |
                each debug.
                self announceTest: each.
                self changed: each ] ] in TestSuite>>debug
OrderedCollection>>do:
[ self tests
        do: [ :each |
                each debug.
                self announceTest: each.
                self changed: each ] ] in TestSuite>>debug
BlockClosure>>ensure:
TestSuite>>debug
[ :aSuite | aSuite debug ] in TestRunner>>debugSuite:
BlockClosure>>cull:
BlockClosure>>cull:cull:
[ aBlock cull: aTestSuite cull: result ] in TestRunner>>executeSuite:as:
BlockClosure>>ensure:
TestRunner>>executeSuite:as:
TestRunner>>debugSuite:
TestRunner>>debug:
TestRunner>>errorSelected:
PluggableListMorph>>changeModelSelection:
PluggableListMorph>>mouseUpOnSingle:
PluggableListMorph>>mouseUp:
PluggableListMorph(Morph)>>handleMouseUp:
MouseButtonEvent>>sentTo:
PluggableListMorph(Morph)>>handleEvent:
MorphicEventDispatcher>>dispatchDefault:with:
MorphicEventDispatcher>>handleMouseUp:
MouseButtonEvent>>sentTo:
[ ^ anEvent sentTo: self ] in MorphicEventDispatcher>>dispatchEvent:with:
BlockClosure>>ensure:
MorphicEventDispatcher>>dispatchEvent:with:
PluggableListMorph(Morph)>>processEvent:using:
PluggableListMorph(Morph)>>processEvent:
PluggableListMorph>>handleFocusEvent:
[ ActiveHand := self.
ActiveEvent := anEvent.
result := focusHolder
        handleFocusEvent: (anEvent transformedBy: (focusHolder transformedFrom:
self)) ] in HandMorph>>sendFocusEvent:to:clear:
BlockClosure>>on:do:
WorldMorph(PasteUpMorph)>>becomeActiveDuring:
HandMorph>>sendFocusEvent:to:clear:
HandMorph>>sendEvent:focus:clear:
HandMorph>>sendMouseEvent:
HandMorph>>handleEvent:
HandMorph>>processEventsFromQueue:
HandMorph>>processEvents
[ :h |
self activeHand: h.
h processEvents.
self activeHand: nil ] in WorldState>>doOneCycleNowFor:
Array(SequenceableCollection)>>do:
WorldState>>handsDo:
WorldState>>doOneCycleNowFor:
WorldState>>doOneCycleFor:
WorldMorph>>doOneCycle
WorldMorph class>>doOneCycle
[ [ WorldMorph doOneCycle.
Processor yield.
false ] whileFalse: [  ] ] in MorphicUIManager>>spawnNewProcess
[ self value.
Processor terminateActive ] in BlockClosure>>newProcess



And here's the code:


Towergame.st:

GlorpBlobType subclass: #GlorpBlob2Type
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!

!GlorpBlob2Type methodsFor: 'types' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
converterForStType: aClass
        aClass = UUID ifTrue: [ ^ UuidConverter new ].
        ^ super converterForStType: aClass! !


Object subclass: #TgAct
        instanceVariableNames: 'agent tool timestamp'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!
!TgAct commentStamp: 'HerbyVojcik 8/5/2017 19:23' prior: 0!
I represent a relationship between a player (TgAgent)
and a device (TgTool).

In particular, I am created whenever a player logs in to the game from
different device
than it was last time (or first time, ever).!


!TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017 18:09:53'!
agent
        ^ agent! !

!TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017 18:09:53'!
agent: anObject
        agent := anObject! !

!TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017 18:09:53'!
timestamp: anObject
        timestamp := anObject! !

!TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017 18:09:53'!
tool
        ^ tool! !

!TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017 18:09:53'!
tool: anObject
        tool := anObject! !

!TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017 18:09:53'!
timestamp
        ^ timestamp! !


!TgAct methodsFor: 'initialization' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
initialize

        super initialize.

        agent := nil.
        timestamp := DateAndTime now asUTC.
        tool := nil.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TgAct class
        instanceVariableNames: ''!

!TgAct class methodsFor: 'instance creation' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
agent: aTgAgent tool: aTgTool
        ^ self new
                agent: aTgAgent;
                tool: aTgTool;
                yourself! !


Object subclass: #TgAgent
        instanceVariableNames: 'id'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!
!TgAgent commentStamp: 'HerbyVojcik 8/5/2017 19:22' prior: 0!
I represent a towergame player.

I only contain player-related information;
the game state itself is in TgState.!


!TgAgent methodsFor: 'initialization' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
initialize

        super initialize.

        id := nil.! !


!TgAgent methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
id: anObject
        id := anObject! !

!TgAgent methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
id
        ^ id! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TgAgent class
        instanceVariableNames: ''!

!TgAgent class methodsFor: 'instance creation' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
id: aString
        ^ self new
                id: aString;
                yourself! !


Object subclass: #TgAnswers
        instanceVariableNames: 'good bad'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!
!TgAnswers commentStamp: 'HerbyVojcik 8/5/2017 20:23' prior: 0!
I represent the answered question stats.

I know how many good / bad answered questions there is.!


!TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
good
        ^ good! !

!TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
bad: anObject
        bad := anObject! !

!TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
bad
        ^ bad! !

!TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
good: anObject
        good := anObject! !


!TgAnswers methodsFor: 'initialization' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
initialize

        super initialize.

        bad := 0.
        good := 0.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TgAnswers class
        instanceVariableNames: ''!

!TgAnswers class methodsFor: 'instance creation' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
good: anInteger bad: anInteger2
        ^ self new
                good: anInteger;
                bad: anInteger2;
                yourself! !


Object subclass: #TgFloors
        instanceVariableNames: 'total reinforced'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!
!TgFloors commentStamp: 'HerbyVojcik 8/5/2017 20:22' prior: 0!
I represent the floor building status.

I know how many floors are build and how many of them is reinforced.!


!TgFloors methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
total
        ^ total! !

!TgFloors methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
total: anObject
        total := anObject! !

!TgFloors methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
reinforced
        ^ reinforced! !

!TgFloors methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
reinforced: anObject
        reinforced := anObject! !


!TgFloors methodsFor: 'initialization' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
initialize

        super initialize.

        reinforced := 0.
        total := 0.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TgFloors class
        instanceVariableNames: ''!

!TgFloors class methodsFor: 'instance creation' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
total: anInteger
        ^ self total: anInteger reinforced: 0! !

!TgFloors class methodsFor: 'instance creation' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
total: anInteger reinforced: anInteger2
        ^ self new
                total: anInteger;
                reinforced: anInteger2;
                yourself! !


Object subclass: #TgState
        instanceVariableNames: 'agent version packs valuables score bestScore
answers'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!
!TgState commentStamp: 'HerbyVojcik 8/5/2017 20:20' prior: 0!
I represent the game state.

I have relation to a player (TgAgent) and have a version.
Then, I contain (directly or indirectly) other parts that
make up the player's game state.

Whenever I am changed by game progress, my version is changed as well.!


!TgState methodsFor: 'initialization' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
initialize

        super initialize.

        agent := nil.
        answers := nil.
        bestScore := nil.
        packs := Set new.
        score := nil.
        valuables := nil.
        version := nil.! !


!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
score: anObject
        score := anObject! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
bestScore: anObject
        bestScore := anObject! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
agent: anObject
        agent := anObject! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
score
        ^ score! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
packs
        ^ packs! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
version
        ^ version! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
bestScore
        ^ bestScore! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
agent
        ^ agent! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
answers: anObject
        answers := anObject! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
valuables: anObject
        valuables := anObject! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
valuables
        ^ valuables! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
version: anObject
        version := anObject! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
answers
        ^ answers! !

!TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
packs: anObject
        packs := anObject! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TgState class
        instanceVariableNames: ''!

!TgState class methodsFor: 'instance creation' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
agent: aTgAgent version: aString
        ^ self new
                agent: aTgAgent;
                version: aString;
                yourself! !


Object subclass: #TgTool
        instanceVariableNames: 'id'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!
!TgTool commentStamp: 'HerbyVojcik 8/5/2017 19:26' prior: 0!
I represent the device (mobile phone,  web browser, ..)
that player uses to connect to game.!


!TgTool methodsFor: 'initialization' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
initialize

        super initialize.

        id := nil.! !


!TgTool methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017 18:09:53'!
id: anObject
        id := anObject! !

!TgTool methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017 18:09:53'!
id
        ^ id! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TgTool class
        instanceVariableNames: ''!

!TgTool class methodsFor: 'instance creation' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
id: aString
        ^ self new
                id: aString;
                yourself! !


Object subclass: #TgValuables
        instanceVariableNames: 'coins gems'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!
!TgValuables commentStamp: 'HerbyVojcik 8/5/2017 20:22' prior: 0!
I represent a purse.

I know how many coins and gems there is.!


!TgValuables methodsFor: 'initialization' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
initialize

        super initialize.

        coins := 0.
        gems := 0.! !


!TgValuables methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
gems: anObject
        gems := anObject! !

!TgValuables methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
coins: anObject
        coins := anObject! !

!TgValuables methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
gems
        ^ gems! !

!TgValuables methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
coins
        ^ coins! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TgValuables class
        instanceVariableNames: ''!

!TgValuables class methodsFor: 'instance creation' stamp:
'HerbertVojčík 8/14/2017 18:09:53'!
coins: anInteger gems: anInteger2
        ^ self new
                coins: anInteger;
                gems: anInteger2;
                yourself! !


Object subclass: #Towergame
        instanceVariableNames: 'dao'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!
!Towergame commentStamp: 'HerbyVojcik 5/17/2017 17:19' prior: 0!
I am the Towergame app class.

I configure and start towergame server processing.!


!Towergame methodsFor: 'actions' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
clientSync: anObject
        self dao inUnitOfWorkDo: [
                | agent state |
                agent := self dao findAgentById: anObject agentId.
                state := self dao findStateByAgent: agent.
                ^ NeoJSONObject new
                        agentId: agent id;
                        stateVersion: state version;
                        totalAnsweredQuestions: (NeoJSONObject new good: 0; bad: 0; yourself);
                        yourself ]! !


!Towergame methodsFor: 'initialization' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
initialize

        super initialize.

        dao := nil.
! !


!Towergame methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
dao: anObject
        dao := anObject! !

!Towergame methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
dao
        ^ dao! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Towergame class
        instanceVariableNames: 'default'!

!Towergame class methodsFor: 'instance creation' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
dao: aDao
        ^ self new
                dao: aDao;
                yourself! !


!Towergame class methodsFor: 'accessing' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
defaultDbLogin
        | databaseFile |
        databaseFile := Smalltalk imageDirectory asFileReference / 'towergame.db'.
        ^ Login new
                        database: UDBCSQLite3Platform new;
                        host: '';
                        port: '';
                        username: '';
                        password: '';
                        databaseName: databaseFile fullPath asZnUrl asString;
                        yourself ! !

!Towergame class methodsFor: 'accessing' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
default
        ^ default ifNil: [ default := self
                dao: (self daoForLogin: self defaultDbLogin)
        ]! !

!Towergame class methodsFor: 'accessing' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
defaultPort
        ^ 4998! !


!Towergame class methodsFor: 'configuration' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
configureServer
        (self serverFor: self default on: self defaultPort) start; register
! !

!Towergame class methodsFor: 'configuration' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
configureSqlite3

        PharoDatabaseAccessor DefaultDriver: GlorpSQLite3Driver! !

!Towergame class methodsFor: 'configuration' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
configure
        self configureSqlite3.
        self configureServer.! !


!Towergame class methodsFor: 'factory' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
daoForLogin: aLogin
        ^ TowergameDao forLogin: aLogin! !

!Towergame class methodsFor: 'factory' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
serverFor: aTowergame on: port
        ^ (ZnServer on: port)
                        delegate: (TowergameDelegate on: aTowergame);
                        yourself! !


Object subclass: #TowergameDao
        instanceVariableNames: 'glorpSession glorpLogin'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!

!TowergameDao methodsFor: 'transactions' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
inUnitOfWorkDo: aBlock
        ^ self glorpSession inUnitOfWorkDo: aBlock! !


!TowergameDao methodsFor: 'initialization' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
initialize

        super initialize.

        glorpLogin := nil.
        glorpSession := nil.! !


!TowergameDao methodsFor: 'initialize-release' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
reset
        glorpSession := nil.! !


!TowergameDao methodsFor: 'query' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
findStateByAgent: anAgent
        ^ self glorpSession readOneOf: TgState where: [ :one | one agent =
anAgent ]! !

!TowergameDao methodsFor: 'query' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
findAgentById: anUUID
        ^ self glorpSession readOneOf: TgAgent where: [ :one | one id = anUUID ]! !


!TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
glorpLogin: anObject
        glorpLogin := anObject! !

!TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
glorpLogin
        ^ glorpLogin! !

!TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
glorpSession
        glorpSession ifNil: [
                glorpSession := TowergameDescriptorSystem sessionForLogin: self
glorpLogin ].
        glorpSession accessor isLoggedIn ifFalse: [
                glorpSession accessor login ].
        ^ glorpSession! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TowergameDao class
        instanceVariableNames: ''!

!TowergameDao class methodsFor: 'instance creation' stamp:
'HerbertVojčík 8/14/2017 18:09:53'!
forLogin: aLogin
        ^ self new
                glorpLogin: aLogin;
                yourself! !


ZnDispatcherDelegate subclass: #TowergameDelegate
        instanceVariableNames: 'towergame'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!

!TowergameDelegate methodsFor: 'accessing' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
towergame
        ^ towergame! !

!TowergameDelegate methodsFor: 'accessing' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
towergame: anObject
        towergame := anObject! !


!TowergameDelegate methodsFor: 'initialization' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
initialize
        super initialize.
        towergame := nil.
        self
                map: '/api/v1/sync'
                to: [ :request :response | self syncRequest: request toResponse:
response ]! !


!TowergameDelegate methodsFor: 'action' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
syncRequest: request toResponse: response
        | requestPayload responsePayload uuidKeys |
        uuidKeys := #(agentId stateVersion deviceId).
        request method == #POST ifFalse: [ ^ ZnResponse methodNotAllowed:
request ].
        requestPayload := NeoJSONObject fromString: request contents.
        requestPayload ifNotNil: [
                uuidKeys do: [ :each | requestPayload at: each ifPresentPut: [ :s |
UUID fromString: s ] ] ].
        responsePayload := self towergame clientSync: requestPayload.
        responsePayload ifNotNil: [
                uuidKeys do: [ :each | responsePayload at: each ifPresentPut:
#asString ] ].
        ^ response
                entity: (ZnEntity
                        with: (NeoJSONWriter toString: responsePayload)
                        type: ZnMimeType applicationJson);
                yourself! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TowergameDelegate class
        instanceVariableNames: ''!

!TowergameDelegate class methodsFor: 'instance creation' stamp:
'HerbertVojčík 8/14/2017 18:09:53'!
on: aTowergame
        ^ self new towergame: aTowergame; yourself! !


DescriptorSystem subclass: #TowergameDescriptorSystem
        instanceVariableNames: 'uuidConverter'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!

!TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
tableForAGENT: aTable

        (aTable createFieldNamed: 'id' type: platform blob2) bePrimaryKey.
! !

!TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
classModelForTgAgent: aClassModel
        aClassModel
                newAttributeNamed: #id type: UUID! !

!TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbyVojcik
8/14/2017 18:24'!
tableForSTATE: aTable

        (aTable createFieldNamed: 'agent' type: platform blob2) in: [ :agentField |
                agentField bePrimaryKey.
                aTable addForeignKeyFrom: agentField to: ((self tableNamed: 'AGENT')
fieldNamed: 'id')  ].
        (aTable createFieldNamed: 'version' type: platform blob) beIndexed.
! !

!TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
descriptorForTgAgent: aDescriptor
        | table |
        table := self tableNamed: 'AGENT'.
        aDescriptor table: table.
        (aDescriptor newMapping: DirectMapping)
                from: #id to: (table fieldNamed: 'id').! !

!TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
tableForACT: aTable

        (aTable createFieldNamed: 'agent' type: platform blob2) beIndexed.
        (aTable createFieldNamed: 'tool' type: platform blob2) beIndexed.
        (aTable createFieldNamed: 'timestamp' type: platform timestamp) beIndexed.
! !

!TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
descriptorForTgState: aDescriptor
        | table |
        table := self tableNamed: 'STATE'.
        aDescriptor table: table.
        (aDescriptor newMapping: OneToOneMapping) attributeName: #agent.
        (aDescriptor newMapping: DirectMapping)
                from: #version to: (table fieldNamed: 'version').! !

!TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
converterBetweenStType: aClass andField: aField
        (aClass = UUID and: [ aField impliedSmalltalkType = ByteArray])
                ifTrue: [ ^ self uuidConverter ].
        ^ super converterBetweenStType: aClass andField: aField! !

!TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
classModelForTgState: aClassModel
"agent version packs valuables score bestScore answers"
        aClassModel
                newAttributeNamed: #agent type: TgAgent;
                newAttributeNamed: #version type: UUID! !

!TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
classModelForTgTool: aClassModel
        aClassModel
                newAttributeNamed: #id
! !

!TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
classModelForTgAct: aClassModel
        aClassModel
                newAttributeNamed: #timestamp;
                newAttributeNamed: #agent type: TgAgent;
                newAttributeNamed: #tool type: TgTool! !


!TowergameDescriptorSystem methodsFor: 'accessing' stamp:
'HerbertVojčík 8/14/2017 18:09:53'!
uuidConverter
        ^ uuidConverter ifNil: [ uuidConverter := UuidConverter new name:
'uuid'; yourself ]! !


DatabaseConverter subclass: #UuidConverter
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame'!

!UuidConverter methodsFor: 'converting' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
convert: anObject toDatabaseRepresentationAs: aDatabaseType
        ^ anObject ifNotNil: [ ByteArray withAll: anObject ]! !

!UuidConverter methodsFor: 'converting' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
convert: anObject fromDatabaseRepresentationAs: aDatabaseType
        ^ anObject ifNotNil: [ UUID withAll: anObject ]! !
'From Pharo6.0 of 13 May 2016 [Latest update: #60510] on 14 August 2017
at 6:26:30.67905 pm'!

!DatabasePlatform methodsFor: '*Towergame' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
blob2
        ^self typeNamed: #blob ifAbsentPut: [GlorpBlob2Type new].! !
'From Pharo6.0 of 13 May 2016 [Latest update: #60510] on 14 August 2017
at 6:26:30.68005 pm'!

!Dictionary methodsFor: '*Towergame' stamp: 'HerbertVojčík 8/14/2017
18:09:53'!
at: key ifPresentPut: aBlock
        "Lookup the given key in the receiver. If it is present, update it
with the value of evaluating the given block with the value associated
with the key. Otherwise, answer nil."

        ^ self at: key ifPresent: [ :value | self at: key put: (aBlock cull:
value) ]! !




TowergameTests.st:

TestCase subclass: #TowergameServerTests
        instanceVariableNames: 'randomPort towergame server'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame-Tests'!

!TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
uidy: aString
        ^ UUID fromString36: aString ! !

!TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
setUp
        randomPort := 1700 + 32 atRandom.
        towergame := Mock new.
        server := Towergame serverFor: towergame on: randomPort.
        server start.
        self
                assert: server isRunning & server isListening
                description: ('Failed to start server on port {1}. Is there one
already?' format: { server port })
! !

!TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
tearDown
        server stop! !


!TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
testEmptySyncRequest
        | znClient response |
        (towergame stub clientSync: Arg payload) willReturn: nil.
        znClient := self znClientForSync: 'null'.
        response := znClient timeout: 1; post; response.
        response should satisfy: #isSuccess.
        response contentType should equal: ZnMimeType applicationJson.
        (STON fromString: response entity contents) should equal: nil.
        Arg payload should equal: nil! !

!TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
testRejectEmptyGetSyncRequest
        | znClient response |
        (towergame stub clientSync: Arg payload) willReturn: nil.
        znClient := self znClientForSync: 'null'.
        response := znClient timeout: 1; get; response.
        response code should equal: ZnStatusLine methodNotAllowed code.
        towergame should not receive clientSync: Any! !

!TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
testNonEmptySyncRequest
        | znClient response |
        (towergame stub clientSync: Arg payload) willReturn: { #agentId ->
(self uidy: '007') } asDictionary.
        znClient := self znClientForSync:
                ('\{"deviceId":"{1}","agentAnsweredQuestions":\{"good":1,"bad":2\}\}'
format: { self uidy: 'Q' }).
        response := znClient timeout: 1; post; response.
        response should satisfy: #isSuccess.
        response contentType should equal: ZnMimeType applicationJson.
        (STON fromString: response entity contents) should equal: { 'agentId'
-> (self uidy: '007') asString } asDictionary.
        Arg payload in: [ :arg |
                arg deviceId should equal: (self uidy: 'Q').
                arg agentAnsweredQuestions should satisfy: #notNil.
                arg agentAnsweredQuestions good should equal: 1.
                arg agentAnsweredQuestions bad should equal: 2 ]
! !


!TowergameServerTests methodsFor: 'private' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
znClientForSync: jsonString
        ^ ZnClient new
                url: server localUrl;
                path: '/api/v1/sync';
                entity:
                        (ZnEntity
                                with: jsonString
                                type: ZnMimeType applicationJson)
! !


TestCase subclass: #TowergameSyncTests
        instanceVariableNames: 'towergame session dao'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Towergame-Tests'!

!TowergameSyncTests methodsFor: 'tests' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
testPlayerChecksStateVersionAndIsBehind
        | result payload |
        session createTables.
        session inUnitOfWorkDo: [
                | agent state |
                agent := TgAgent id: (self uidy: '007').
                state := (TgState agent: agent version: (self uidy: '18-eff'))
                        packs: #('foopack' 'barpack') asSet;
                        valuables: (TgValuables coins: 20 gems: 3);
                        score: (TgFloors total: 4 reinforced: 1);
                        bestScore: (TgFloors total: 18);
                        answers: (TgAnswers good: 2 bad: 3);
                        yourself.
                session registerAll: {state. TgAct agent: agent tool: (TgTool id:
(self uidy: 'Q7') ) } ].
        towergame := Towergame dao: dao.
        payload := NeoJSONObject new
                agentId: (self uidy: '007'); stateVersion: (self uidy: '23-fefe');
deviceId: (self uidy: 'Q7').
        result := towergame clientSync: payload.
        result where agentId should equal: (self uidy: '007').
        result where stateVersion should equal: (self uidy: '18-eff').
        result where purchasedPacks should satisfy: [ :x | x asSet should
equal: #('foopack' 'barpack') asSet ].
        result where valuables coins should equal: 20.
        result where valuables gems should equal: 3.
        result where floorsNumber current should equal: 4.
        result where floorsNumber best should equal: 18.
        result where floorsNumber reinforced should equal: 1.
        result where agentAnsweredQuestions good should equal: 2.
        result where agentAnsweredQuestions bad should equal: 3.
        result where totalAnsweredQuestions good should equal: 2.
        result where totalAnsweredQuestions bad should equal: 3! !

!TowergameSyncTests methodsFor: 'tests' stamp: 'HerbyVojcik 8/14/2017
18:18'!
testPlayerChecksStateVersion
        | result payload |
        session createTables.
        session inUnitOfWorkDo: [
                | agent state |
                agent := TgAgent id: (self uidy: '007').
                state := TgState agent: agent version: (self uidy: '23-fefe').
                session registerAll: {state. TgAct agent: agent tool: (TgTool id:
(self uidy: 'Q7') ) } ].
        towergame := Towergame dao: dao.
        payload := NeoJSONObject new
                agentId: (self uidy: '007'); stateVersion: (self uidy: '23-fefe');
deviceId: (self uidy: 'Q7').
        result := towergame clientSync: payload.
        result where agentId should equal: (self uidy: '007').
        result where stateVersion should equal: (self uidy: '23-fefe').
        result where totalAnsweredQuestions good should equal: 0.
        result where totalAnsweredQuestions bad should equal: 0! !


!TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
uidy: aString
        ^ UUID fromString36: aString ! !

!TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
setUp
        dao := Towergame daoForLogin: self loginToTemporaryDatabase.
        session := dao glorpSession.
! !

!TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
tearDown
        session logout! !

!TowergameSyncTests methodsFor: 'running' stamp: 'HerbyVojcik 8/14/2017
18:16'!
loginToTemporaryDatabase
        ^ Login new
                database: UDBCSQLite3Platform new;
                host: '';
                port: '';
                username: '';
                password: '';
                databaseName: '';
                yourself! !





BaselineOfTowergame.st:
BaselineOf subclass: #BaselineOfTowergame
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'BaselineOfTowergame'!

!BaselineOfTowergame methodsFor: 'baseline' stamp: 'HerbertVojčík
8/14/2017 18:09:53'!
baseline: spec
    <baseline>
        spec for: #common do: [ spec

                package: 'Towergame' with: [ spec
                        requires: #('GlorpSQLite' 'NeoJSON') ];
                package: 'Towergame-Tests' with: [ spec
                        requires: #('Towergame' 'Mocketry') ];

                configuration: 'GlorpSQLite' with: [ spec
                        version: #stable;
                        repository: 'http://smalltalkhub.com/mc/Pharo/MetaRepoForPharo60/main' ];
                configuration: 'NeoJSON' with: [ spec
                        version: #stable;
                        repository: 'http://smalltalkhub.com/mc/Pharo/MetaRepoForPharo60/main' ];
                baseline: 'Mocketry' with: [ spec
                        repository: 'github://dionisiydk/Mocketry:v4.0.x' ];

                group: 'default' with: #('Core');
                group: 'development' with: #('Core' 'Tests');
                group: 'Core' with: #('Towergame');
                group: 'Tests' with: #('Towergame-Tests') ]
! !


Reply | Threaded
Open this post in threaded view
|

Re: Big Glorp problem w/ type coercion, pls help

Esteban A. Maringolo
Do you have the code somewhere loadable? Reading chunk is something I
do only when everything crashed :D
Esteban A. Maringolo


2017-08-14 13:44 GMT-03:00 Herby Vojčík <[hidden email]>:

> Hello!
>
> I encountered a problem with OneToOneMapping and type coercion. When writing
> data, thing work; when reading data, the right child of relation fails to
> convert.
>
> I tried everything possible to inject converters (even subclassing
> GlorpBlobType), but to no avail. RelationExpression passes conversion to its
> left child:
>
> convertedDbValueOf: anObject
>         "Assume that our types match, so we can ask either child to do the
> conversion. That isn't guaranteed, but should at least work for the common
> cases."
>         ^leftChild convertedDbValueOf: anObject.
>
> but the left child is FieldExpression in case of OneToOneMapping, which:
>
> convertedDbValueOf: anObject
>         "We don't do any conversion"
>         ^anObject
>
> What is strange, writing works (even the OneToOneMapping, I opened the
> sqlite file with an explorer), but second SELECT, one using the relation
> (`state := self dao findStateByAgent: agent` in clientSync), fails with
> "GlorpDatabaseReadError: Could not coerce arguments". FWIW, the first one
> _does_ convert when creating bindings, as it uses MappingExpression as left
> child (stepped over it in debugger).
>
>
>
> Is it meant to be a strange case that primary key is something non-primitive
> needing coercion (in this case, it is a UUID which needs coercion to
> ByteArray, even if it is its subclass)?
>
>
>
> Here's the stack of running the test which fails:
>
> PharoDatabaseAccessor(DatabaseAccessor)>>handleError:for:
> [ :ex | self handleError: ex for: command ] in [ | result |
> self checkPermissionFor: command.
> result := [ (self useBinding and: [ command useBinding ])
>         ifTrue: [ command executeBoundIn: self ]
>         ifFalse: [ command executeUnboundIn: self ] ]
>         on: Dialect error
>         do: [ :ex | self handleError: ex for: command ].
> aBoolean
>         ifTrue: [ result ]
>         ifFalse: [ result upToEnd ] ] in
> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
> BlockClosure>>cull:
> Context>>evaluateSignal:
> Context>>handleSignal:
> Error(Exception)>>signal
> Error(Exception)>>signal:
> ExternalLibraryFunction(Object)>>error:
> ExternalLibraryFunction(Object)>>externalCallFailed
> ExternalLibraryFunction(ExternalFunction)>>invokeWithArguments:
> UDBCSQLite3Library>>apiBindBlob:atColumn:with:with:with:
> UDBCSQLite3Library>>with:at:putBlob:
> UDBCSQLite3Statement>>at:putByteArray:
> UDBCSQLite3ResultSet>>execute:withIndex:withValue:
> [ :v | i := self execute: statement withIndex: i withValue: v ] in
> UDBCSQLite3ResultSet>>execute:withCollection:
> OrderedCollection>>do:
> UDBCSQLite3ResultSet>>execute:withCollection:
> UDBCSQLite3ResultSet>>execute:with:on:
> UDBCSQLite3Connection>>execute:with:
> GlorpSQLite3Driver>>basicExecuteSQLString:binding:
> PharoDatabaseAccessor>>executeCommandBound:
> QuerySelectCommand(DatabaseCommand)>>executeBoundIn:
> [ (self useBinding and: [ command useBinding ])
>         ifTrue: [ command executeBoundIn: self ]
>         ifFalse: [ command executeUnboundIn: self ] ] in [ | result |
> self checkPermissionFor: command.
> result := [ (self useBinding and: [ command useBinding ])
>         ifTrue: [ command executeBoundIn: self ]
>         ifFalse: [ command executeUnboundIn: self ] ]
>         on: Dialect error
>         do: [ :ex | self handleError: ex for: command ].
> aBoolean
>         ifTrue: [ result ]
>         ifFalse: [ result upToEnd ] ] in
> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
> BlockClosure>>on:do:
> [ | result |
> self checkPermissionFor: command.
> result := [ (self useBinding and: [ command useBinding ])
>         ifTrue: [ command executeBoundIn: self ]
>         ifFalse: [ command executeUnboundIn: self ] ]
>         on: Dialect error
>         do: [ :ex | self handleError: ex for: command ].
> aBoolean
>         ifTrue: [ result ]
>         ifFalse: [ result upToEnd ] ] in
> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
> [ caught := true.
> self wait.
> blockValue := mutuallyExcludedBlock value ] in Semaphore>>critical:
> BlockClosure>>ensure:
> Semaphore>>critical:
> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
> [ session accessor executeCommand: command returnCursor: true ] in
> SimpleQuery>>rowsFromDatabaseWithParameters:
> BlockClosure>>on:do:
> SimpleQuery>>rowsFromDatabaseWithParameters:
> SimpleQuery(AbstractReadQuery)>>readFromDatabaseWithParameters:
> SimpleQuery(AbstractReadQuery)>>executeWithParameters:in:
> GlorpSession>>execute:
> GlorpSession>>readOneOf:where:
> TowergameDao>>findStateByAgent:
> [ | agent state |
> agent := self dao findAgentById: anObject agentId.
> state := self dao findStateByAgent: agent.
> ^ NeoJSONObject new
>         agentId: agent id;
>         stateVersion: state version;
>         totalAnsweredQuestions:
>                 (NeoJSONObject new
>                         good: 0;
>                         bad: 0;
>                         yourself);
>         yourself ] in Towergame>>clientSync:
> [ myUnitOfWork := self hasUnitOfWork not.
> myUnitOfWork
>         ifTrue: [ self beginUnitOfWork ].
> result := aBlock numArgs = 1
>         ifTrue: [ aBlock value: self ]
>         ifFalse: [ aBlock value ].
> myUnitOfWork
>         ifTrue: [ self commitUnitOfWork ] ] in GlorpSession>>inUnitOfWorkDo:
> BlockClosure>>ifCurtailed:
> GlorpSession>>inUnitOfWorkDo:
> TowergameDao>>inUnitOfWorkDo:
> Towergame>>clientSync:
> TowergameSyncTests>>testPlayerChecksStateVersion
> TowergameSyncTests(TestCase)>>performTest
> [ self setUp.
> self performTest ] in TowergameSyncTests(TestCase)>>runCase
> BlockClosure>>ensure:
> TowergameSyncTests(TestCase)>>runCase
> [ aTestCase runCase ] in [ [ aTestCase runCase ]
>         on: Halt
>         do: [ :halt |
>                 "if test was halted we should resume all background failures
>                         to debug all of them together with test process"
>                 failedProcesses keysDo: #resume.
>                 halt pass ] ] in
> TestExecutionEnvironment>>runTestCaseSafelly:
> BlockClosure>>on:do:
> [ [ aTestCase runCase ]
>         on: Halt
>         do: [ :halt |
>                 "if test was halted we should resume all background failures
>                         to debug all of them together with test process"
>                 failedProcesses keysDo: #resume.
>                 halt pass ] ] in
> TestExecutionEnvironment>>runTestCaseSafelly:
> BlockClosure>>on:do:
> TestExecutionEnvironment>>runTestCaseSafelly:
> [ self runTestCaseSafelly: aTestCase ] in [ [ self runTestCaseSafelly:
> aTestCase ]
>         ensure: [ testCompleted := true.
>                 watchDogSemaphore signal ].     "signal that test case
> completes"
> self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase:
> BlockClosure>>ensure:
> [ [ self runTestCaseSafelly: aTestCase ]
>         ensure: [ testCompleted := true.
>                 watchDogSemaphore signal ].     "signal that test case
> completes"
> self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase:
> BlockClosure>>ifCurtailed:
> TestExecutionEnvironment>>runTestCase:
> [ testEnv runTestCase: aTestCase ] in
> DefaultExecutionEnvironment>>runTestCase:
> [ self value: anExecutionEnvironment.
> anExecutionEnvironment activated.
> aBlock value ] in CurrentExecutionEnvironment class>>activate:for:
> BlockClosure>>ensure:
> CurrentExecutionEnvironment class>>activate:for:
> TestExecutionEnvironment(ExecutionEnvironment)>>beActiveDuring:
> DefaultExecutionEnvironment>>runTestCase:
> CurrentExecutionEnvironment class>>runTestCase:
> TowergameSyncTests(TestCase)>>runCaseManaged
> [ aTestCase announce: TestCaseStarted withResult: self.
> aTestCase runCaseManaged.
> aTestCase announce: TestCaseEnded withResult: self.
> self addPass: aTestCase ] in TestResult>>runCaseForDebug:
> BlockClosure>>on:do:
> TestResult>>runCaseForDebug:
> [ result runCaseForDebug: self ] in TowergameSyncTests(TestCase)>>debug
> BlockClosure>>ensure:
> TowergameSyncTests(TestCase)>>debug
> [ :each |
> each debug.
> self announceTest: each.
> self changed: each ] in [ self tests
>         do: [ :each |
>                 each debug.
>                 self announceTest: each.
>                 self changed: each ] ] in TestSuite>>debug
> OrderedCollection>>do:
> [ self tests
>         do: [ :each |
>                 each debug.
>                 self announceTest: each.
>                 self changed: each ] ] in TestSuite>>debug
> BlockClosure>>ensure:
> TestSuite>>debug
> [ :aSuite | aSuite debug ] in TestRunner>>debugSuite:
> BlockClosure>>cull:
> BlockClosure>>cull:cull:
> [ aBlock cull: aTestSuite cull: result ] in TestRunner>>executeSuite:as:
> BlockClosure>>ensure:
> TestRunner>>executeSuite:as:
> TestRunner>>debugSuite:
> TestRunner>>debug:
> TestRunner>>errorSelected:
> PluggableListMorph>>changeModelSelection:
> PluggableListMorph>>mouseUpOnSingle:
> PluggableListMorph>>mouseUp:
> PluggableListMorph(Morph)>>handleMouseUp:
> MouseButtonEvent>>sentTo:
> PluggableListMorph(Morph)>>handleEvent:
> MorphicEventDispatcher>>dispatchDefault:with:
> MorphicEventDispatcher>>handleMouseUp:
> MouseButtonEvent>>sentTo:
> [ ^ anEvent sentTo: self ] in MorphicEventDispatcher>>dispatchEvent:with:
> BlockClosure>>ensure:
> MorphicEventDispatcher>>dispatchEvent:with:
> PluggableListMorph(Morph)>>processEvent:using:
> PluggableListMorph(Morph)>>processEvent:
> PluggableListMorph>>handleFocusEvent:
> [ ActiveHand := self.
> ActiveEvent := anEvent.
> result := focusHolder
>         handleFocusEvent: (anEvent transformedBy: (focusHolder
> transformedFrom: self)) ] in HandMorph>>sendFocusEvent:to:clear:
> BlockClosure>>on:do:
> WorldMorph(PasteUpMorph)>>becomeActiveDuring:
> HandMorph>>sendFocusEvent:to:clear:
> HandMorph>>sendEvent:focus:clear:
> HandMorph>>sendMouseEvent:
> HandMorph>>handleEvent:
> HandMorph>>processEventsFromQueue:
> HandMorph>>processEvents
> [ :h |
> self activeHand: h.
> h processEvents.
> self activeHand: nil ] in WorldState>>doOneCycleNowFor:
> Array(SequenceableCollection)>>do:
> WorldState>>handsDo:
> WorldState>>doOneCycleNowFor:
> WorldState>>doOneCycleFor:
> WorldMorph>>doOneCycle
> WorldMorph class>>doOneCycle
> [ [ WorldMorph doOneCycle.
> Processor yield.
> false ] whileFalse: [  ] ] in MorphicUIManager>>spawnNewProcess
> [ self value.
> Processor terminateActive ] in BlockClosure>>newProcess
>
>
>
> And here's the code:
>
>
> Towergame.st:
>
> GlorpBlobType subclass: #GlorpBlob2Type
>         instanceVariableNames: ''
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
>
> !GlorpBlob2Type methodsFor: 'types' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> converterForStType: aClass
>         aClass = UUID ifTrue: [ ^ UuidConverter new ].
>         ^ super converterForStType: aClass! !
>
>
> Object subclass: #TgAct
>         instanceVariableNames: 'agent tool timestamp'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
> !TgAct commentStamp: 'HerbyVojcik 8/5/2017 19:23' prior: 0!
> I represent a relationship between a player (TgAgent)
> and a device (TgTool).
>
> In particular, I am created whenever a player logs in to the game from
> different device
> than it was last time (or first time, ever).!
>
>
> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017 18:09:53'!
> agent
>         ^ agent! !
>
> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017 18:09:53'!
> agent: anObject
>         agent := anObject! !
>
> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017 18:09:53'!
> timestamp: anObject
>         timestamp := anObject! !
>
> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017 18:09:53'!
> tool
>         ^ tool! !
>
> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017 18:09:53'!
> tool: anObject
>         tool := anObject! !
>
> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017 18:09:53'!
> timestamp
>         ^ timestamp! !
>
>
> !TgAct methodsFor: 'initialization' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> initialize
>
>         super initialize.
>
>         agent := nil.
>         timestamp := DateAndTime now asUTC.
>         tool := nil.! !
>
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>
> TgAct class
>         instanceVariableNames: ''!
>
> !TgAct class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> agent: aTgAgent tool: aTgTool
>         ^ self new
>                 agent: aTgAgent;
>                 tool: aTgTool;
>                 yourself! !
>
>
> Object subclass: #TgAgent
>         instanceVariableNames: 'id'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
> !TgAgent commentStamp: 'HerbyVojcik 8/5/2017 19:22' prior: 0!
> I represent a towergame player.
>
> I only contain player-related information;
> the game state itself is in TgState.!
>
>
> !TgAgent methodsFor: 'initialization' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> initialize
>
>         super initialize.
>
>         id := nil.! !
>
>
> !TgAgent methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> id: anObject
>         id := anObject! !
>
> !TgAgent methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> id
>         ^ id! !
>
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>
> TgAgent class
>         instanceVariableNames: ''!
>
> !TgAgent class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> id: aString
>         ^ self new
>                 id: aString;
>                 yourself! !
>
>
> Object subclass: #TgAnswers
>         instanceVariableNames: 'good bad'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
> !TgAnswers commentStamp: 'HerbyVojcik 8/5/2017 20:23' prior: 0!
> I represent the answered question stats.
>
> I know how many good / bad answered questions there is.!
>
>
> !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> good
>         ^ good! !
>
> !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> bad: anObject
>         bad := anObject! !
>
> !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> bad
>         ^ bad! !
>
> !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> good: anObject
>         good := anObject! !
>
>
> !TgAnswers methodsFor: 'initialization' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> initialize
>
>         super initialize.
>
>         bad := 0.
>         good := 0.! !
>
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>
> TgAnswers class
>         instanceVariableNames: ''!
>
> !TgAnswers class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> good: anInteger bad: anInteger2
>         ^ self new
>                 good: anInteger;
>                 bad: anInteger2;
>                 yourself! !
>
>
> Object subclass: #TgFloors
>         instanceVariableNames: 'total reinforced'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
> !TgFloors commentStamp: 'HerbyVojcik 8/5/2017 20:22' prior: 0!
> I represent the floor building status.
>
> I know how many floors are build and how many of them is reinforced.!
>
>
> !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> total
>         ^ total! !
>
> !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> total: anObject
>         total := anObject! !
>
> !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> reinforced
>         ^ reinforced! !
>
> !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> reinforced: anObject
>         reinforced := anObject! !
>
>
> !TgFloors methodsFor: 'initialization' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> initialize
>
>         super initialize.
>
>         reinforced := 0.
>         total := 0.! !
>
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>
> TgFloors class
>         instanceVariableNames: ''!
>
> !TgFloors class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> total: anInteger
>         ^ self total: anInteger reinforced: 0! !
>
> !TgFloors class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> total: anInteger reinforced: anInteger2
>         ^ self new
>                 total: anInteger;
>                 reinforced: anInteger2;
>                 yourself! !
>
>
> Object subclass: #TgState
>         instanceVariableNames: 'agent version packs valuables score
> bestScore answers'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
> !TgState commentStamp: 'HerbyVojcik 8/5/2017 20:20' prior: 0!
> I represent the game state.
>
> I have relation to a player (TgAgent) and have a version.
> Then, I contain (directly or indirectly) other parts that
> make up the player's game state.
>
> Whenever I am changed by game progress, my version is changed as well.!
>
>
> !TgState methodsFor: 'initialization' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> initialize
>
>         super initialize.
>
>         agent := nil.
>         answers := nil.
>         bestScore := nil.
>         packs := Set new.
>         score := nil.
>         valuables := nil.
>         version := nil.! !
>
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> score: anObject
>         score := anObject! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> bestScore: anObject
>         bestScore := anObject! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> agent: anObject
>         agent := anObject! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> score
>         ^ score! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> packs
>         ^ packs! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> version
>         ^ version! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> bestScore
>         ^ bestScore! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> agent
>         ^ agent! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> answers: anObject
>         answers := anObject! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> valuables: anObject
>         valuables := anObject! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> valuables
>         ^ valuables! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> version: anObject
>         version := anObject! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> answers
>         ^ answers! !
>
> !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> packs: anObject
>         packs := anObject! !
>
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>
> TgState class
>         instanceVariableNames: ''!
>
> !TgState class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> agent: aTgAgent version: aString
>         ^ self new
>                 agent: aTgAgent;
>                 version: aString;
>                 yourself! !
>
>
> Object subclass: #TgTool
>         instanceVariableNames: 'id'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
> !TgTool commentStamp: 'HerbyVojcik 8/5/2017 19:26' prior: 0!
> I represent the device (mobile phone,  web browser, ..)
> that player uses to connect to game.!
>
>
> !TgTool methodsFor: 'initialization' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> initialize
>
>         super initialize.
>
>         id := nil.! !
>
>
> !TgTool methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017 18:09:53'!
> id: anObject
>         id := anObject! !
>
> !TgTool methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017 18:09:53'!
> id
>         ^ id! !
>
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>
> TgTool class
>         instanceVariableNames: ''!
>
> !TgTool class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> id: aString
>         ^ self new
>                 id: aString;
>                 yourself! !
>
>
> Object subclass: #TgValuables
>         instanceVariableNames: 'coins gems'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
> !TgValuables commentStamp: 'HerbyVojcik 8/5/2017 20:22' prior: 0!
> I represent a purse.
>
> I know how many coins and gems there is.!
>
>
> !TgValuables methodsFor: 'initialization' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> initialize
>
>         super initialize.
>
>         coins := 0.
>         gems := 0.! !
>
>
> !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> gems: anObject
>         gems := anObject! !
>
> !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> coins: anObject
>         coins := anObject! !
>
> !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> gems
>         ^ gems! !
>
> !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> coins
>         ^ coins! !
>
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>
> TgValuables class
>         instanceVariableNames: ''!
>
> !TgValuables class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> coins: anInteger gems: anInteger2
>         ^ self new
>                 coins: anInteger;
>                 gems: anInteger2;
>                 yourself! !
>
>
> Object subclass: #Towergame
>         instanceVariableNames: 'dao'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
> !Towergame commentStamp: 'HerbyVojcik 5/17/2017 17:19' prior: 0!
> I am the Towergame app class.
>
> I configure and start towergame server processing.!
>
>
> !Towergame methodsFor: 'actions' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> clientSync: anObject
>         self dao inUnitOfWorkDo: [
>                 | agent state |
>                 agent := self dao findAgentById: anObject agentId.
>                 state := self dao findStateByAgent: agent.
>                 ^ NeoJSONObject new
>                         agentId: agent id;
>                         stateVersion: state version;
>                         totalAnsweredQuestions: (NeoJSONObject new good: 0;
> bad: 0; yourself);
>                         yourself ]! !
>
>
> !Towergame methodsFor: 'initialization' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> initialize
>
>         super initialize.
>
>         dao := nil.
> ! !
>
>
> !Towergame methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> dao: anObject
>         dao := anObject! !
>
> !Towergame methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> dao
>         ^ dao! !
>
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>
> Towergame class
>         instanceVariableNames: 'default'!
>
> !Towergame class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> dao: aDao
>         ^ self new
>                 dao: aDao;
>                 yourself! !
>
>
> !Towergame class methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> defaultDbLogin
>         | databaseFile |
>         databaseFile := Smalltalk imageDirectory asFileReference /
> 'towergame.db'.
>         ^ Login new
>                         database: UDBCSQLite3Platform new;
>                         host: '';
>                         port: '';
>                         username: '';
>                         password: '';
>                         databaseName: databaseFile fullPath asZnUrl
> asString;
>                         yourself        ! !
>
> !Towergame class methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> default
>         ^ default ifNil: [ default := self
>                 dao: (self daoForLogin: self defaultDbLogin)
>         ]! !
>
> !Towergame class methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> defaultPort
>         ^ 4998! !
>
>
> !Towergame class methodsFor: 'configuration' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> configureServer
>         (self serverFor: self default on: self defaultPort) start; register
> ! !
>
> !Towergame class methodsFor: 'configuration' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> configureSqlite3
>
>         PharoDatabaseAccessor DefaultDriver: GlorpSQLite3Driver! !
>
> !Towergame class methodsFor: 'configuration' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> configure
>         self configureSqlite3.
>         self configureServer.! !
>
>
> !Towergame class methodsFor: 'factory' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> daoForLogin: aLogin
>         ^ TowergameDao forLogin: aLogin! !
>
> !Towergame class methodsFor: 'factory' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> serverFor: aTowergame on: port
>         ^ (ZnServer on: port)
>                         delegate: (TowergameDelegate on: aTowergame);
>                         yourself! !
>
>
> Object subclass: #TowergameDao
>         instanceVariableNames: 'glorpSession glorpLogin'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
>
> !TowergameDao methodsFor: 'transactions' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> inUnitOfWorkDo: aBlock
>         ^ self glorpSession inUnitOfWorkDo: aBlock! !
>
>
> !TowergameDao methodsFor: 'initialization' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> initialize
>
>         super initialize.
>
>         glorpLogin := nil.
>         glorpSession := nil.! !
>
>
> !TowergameDao methodsFor: 'initialize-release' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> reset
>         glorpSession := nil.! !
>
>
> !TowergameDao methodsFor: 'query' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> findStateByAgent: anAgent
>         ^ self glorpSession readOneOf: TgState where: [ :one | one agent =
> anAgent ]! !
>
> !TowergameDao methodsFor: 'query' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> findAgentById: anUUID
>         ^ self glorpSession readOneOf: TgAgent where: [ :one | one id =
> anUUID ]! !
>
>
> !TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> glorpLogin: anObject
>         glorpLogin := anObject! !
>
> !TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> glorpLogin
>         ^ glorpLogin! !
>
> !TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> glorpSession
>         glorpSession ifNil: [
>                 glorpSession := TowergameDescriptorSystem sessionForLogin:
> self glorpLogin ].
>         glorpSession accessor isLoggedIn ifFalse: [
>                 glorpSession accessor login ].
>         ^ glorpSession! !
>
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>
> TowergameDao class
>         instanceVariableNames: ''!
>
> !TowergameDao class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> forLogin: aLogin
>         ^ self new
>                 glorpLogin: aLogin;
>                 yourself! !
>
>
> ZnDispatcherDelegate subclass: #TowergameDelegate
>         instanceVariableNames: 'towergame'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
>
> !TowergameDelegate methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> towergame
>         ^ towergame! !
>
> !TowergameDelegate methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> towergame: anObject
>         towergame := anObject! !
>
>
> !TowergameDelegate methodsFor: 'initialization' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> initialize
>         super initialize.
>         towergame := nil.
>         self
>                 map: '/api/v1/sync'
>                 to: [ :request :response | self syncRequest: request
> toResponse: response ]! !
>
>
> !TowergameDelegate methodsFor: 'action' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> syncRequest: request toResponse: response
>         | requestPayload responsePayload uuidKeys |
>         uuidKeys := #(agentId stateVersion deviceId).
>         request method == #POST ifFalse: [ ^ ZnResponse methodNotAllowed:
> request ].
>         requestPayload := NeoJSONObject fromString: request contents.
>         requestPayload ifNotNil: [
>                 uuidKeys do: [ :each | requestPayload at: each ifPresentPut:
> [ :s | UUID fromString: s ] ] ].
>         responsePayload := self towergame clientSync: requestPayload.
>         responsePayload ifNotNil: [
>                 uuidKeys do: [ :each | responsePayload at: each
> ifPresentPut: #asString ] ].
>         ^ response
>                 entity: (ZnEntity
>                         with: (NeoJSONWriter toString: responsePayload)
>                         type: ZnMimeType applicationJson);
>                 yourself! !
>
> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>
> TowergameDelegate class
>         instanceVariableNames: ''!
>
> !TowergameDelegate class methodsFor: 'instance creation' stamp: 'HerbertVojÄ
> ík 8/14/2017 18:09:53'!
> on: aTowergame
>         ^ self new towergame: aTowergame; yourself! !
>
>
> DescriptorSystem subclass: #TowergameDescriptorSystem
>         instanceVariableNames: 'uuidConverter'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
>
> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> tableForAGENT: aTable
>
>         (aTable createFieldNamed: 'id' type: platform blob2) bePrimaryKey.
> ! !
>
> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> classModelForTgAgent: aClassModel
>         aClassModel
>                 newAttributeNamed: #id type: UUID! !
>
> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbyVojcik 8/14/2017
> 18:24'!
> tableForSTATE: aTable
>
>         (aTable createFieldNamed: 'agent' type: platform blob2) in: [
> :agentField |
>                 agentField bePrimaryKey.
>                 aTable addForeignKeyFrom: agentField to: ((self tableNamed:
> 'AGENT') fieldNamed: 'id')  ].
>         (aTable createFieldNamed: 'version' type: platform blob) beIndexed.
> ! !
>
> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> descriptorForTgAgent: aDescriptor
>         | table |
>         table := self tableNamed: 'AGENT'.
>         aDescriptor table: table.
>         (aDescriptor newMapping: DirectMapping)
>                 from: #id to: (table fieldNamed: 'id').! !
>
> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> tableForACT: aTable
>
>         (aTable createFieldNamed: 'agent' type: platform blob2) beIndexed.
>         (aTable createFieldNamed: 'tool' type: platform blob2) beIndexed.
>         (aTable createFieldNamed: 'timestamp' type: platform timestamp)
> beIndexed.
> ! !
>
> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> descriptorForTgState: aDescriptor
>         | table |
>         table := self tableNamed: 'STATE'.
>         aDescriptor table: table.
>         (aDescriptor newMapping: OneToOneMapping) attributeName: #agent.
>         (aDescriptor newMapping: DirectMapping)
>                 from: #version to: (table fieldNamed: 'version').! !
>
> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> converterBetweenStType: aClass andField: aField
>         (aClass = UUID and: [ aField impliedSmalltalkType = ByteArray])
>                 ifTrue: [ ^ self uuidConverter ].
>         ^ super converterBetweenStType: aClass andField: aField! !
>
> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> classModelForTgState: aClassModel
> "agent version packs valuables score bestScore answers"
>         aClassModel
>                 newAttributeNamed: #agent type: TgAgent;
>                 newAttributeNamed: #version type: UUID! !
>
> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> classModelForTgTool: aClassModel
>         aClassModel
>                 newAttributeNamed: #id
> ! !
>
> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> classModelForTgAct: aClassModel
>         aClassModel
>                 newAttributeNamed: #timestamp;
>                 newAttributeNamed: #agent type: TgAgent;
>                 newAttributeNamed: #tool type: TgTool! !
>
>
> !TowergameDescriptorSystem methodsFor: 'accessing' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> uuidConverter
>         ^ uuidConverter ifNil: [ uuidConverter := UuidConverter new name:
> 'uuid'; yourself ]! !
>
>
> DatabaseConverter subclass: #UuidConverter
>         instanceVariableNames: ''
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame'!
>
> !UuidConverter methodsFor: 'converting' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> convert: anObject toDatabaseRepresentationAs: aDatabaseType
>         ^ anObject ifNotNil: [ ByteArray withAll: anObject ]! !
>
> !UuidConverter methodsFor: 'converting' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> convert: anObject fromDatabaseRepresentationAs: aDatabaseType
>         ^ anObject ifNotNil: [ UUID withAll: anObject ]! !
> 'From Pharo6.0 of 13 May 2016 [Latest update: #60510] on 14 August 2017 at
> 6:26:30.67905 pm'!
>
> !DatabasePlatform methodsFor: '*Towergame' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> blob2
>         ^self typeNamed: #blob ifAbsentPut: [GlorpBlob2Type new].! !
> 'From Pharo6.0 of 13 May 2016 [Latest update: #60510] on 14 August 2017 at
> 6:26:30.68005 pm'!
>
> !Dictionary methodsFor: '*Towergame' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> at: key ifPresentPut: aBlock
>         "Lookup the given key in the receiver. If it is present, update it
> with the value of evaluating the given block with the value associated
> with the key. Otherwise, answer nil."
>
>         ^ self at: key ifPresent: [ :value | self at: key put: (aBlock cull:
> value) ]! !
>
>
>
>
> TowergameTests.st:
>
> TestCase subclass: #TowergameServerTests
>         instanceVariableNames: 'randomPort towergame server'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame-Tests'!
>
> !TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> uidy: aString
>         ^ UUID fromString36: aString ! !
>
> !TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> setUp
>         randomPort := 1700 + 32 atRandom.
>         towergame := Mock new.
>         server := Towergame serverFor: towergame on: randomPort.
>         server start.
>         self
>                 assert: server isRunning & server isListening
>                 description: ('Failed to start server on port {1}. Is there
> one already?' format: { server port })
> ! !
>
> !TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> tearDown
>         server stop! !
>
>
> !TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> testEmptySyncRequest
>         | znClient response |
>         (towergame stub clientSync: Arg payload) willReturn: nil.
>         znClient := self znClientForSync: 'null'.
>         response := znClient timeout: 1; post; response.
>         response should satisfy: #isSuccess.
>         response contentType should equal: ZnMimeType applicationJson.
>         (STON fromString: response entity contents) should equal: nil.
>         Arg payload should equal: nil! !
>
> !TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> testRejectEmptyGetSyncRequest
>         | znClient response |
>         (towergame stub clientSync: Arg payload) willReturn: nil.
>         znClient := self znClientForSync: 'null'.
>         response := znClient timeout: 1; get; response.
>         response code should equal: ZnStatusLine methodNotAllowed code.
>         towergame should not receive clientSync: Any! !
>
> !TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> testNonEmptySyncRequest
>         | znClient response |
>         (towergame stub clientSync: Arg payload) willReturn: { #agentId ->
> (self uidy: '007') } asDictionary.
>         znClient := self znClientForSync:
>
> ('\{"deviceId":"{1}","agentAnsweredQuestions":\{"good":1,"bad":2\}\}'
> format: { self uidy: 'Q' }).
>         response := znClient timeout: 1; post; response.
>         response should satisfy: #isSuccess.
>         response contentType should equal: ZnMimeType applicationJson.
>         (STON fromString: response entity contents) should equal: {
> 'agentId' -> (self uidy: '007') asString } asDictionary.
>         Arg payload in: [ :arg |
>                 arg deviceId should equal: (self uidy: 'Q').
>                 arg agentAnsweredQuestions should satisfy: #notNil.
>                 arg agentAnsweredQuestions good should equal: 1.
>                 arg agentAnsweredQuestions bad should equal: 2 ]
> ! !
>
>
> !TowergameServerTests methodsFor: 'private' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> znClientForSync: jsonString
>         ^ ZnClient new
>                 url: server localUrl;
>                 path: '/api/v1/sync';
>                 entity:
>                         (ZnEntity
>                                 with: jsonString
>                                 type: ZnMimeType applicationJson)
> ! !
>
>
> TestCase subclass: #TowergameSyncTests
>         instanceVariableNames: 'towergame session dao'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Towergame-Tests'!
>
> !TowergameSyncTests methodsFor: 'tests' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> testPlayerChecksStateVersionAndIsBehind
>         | result payload |
>         session createTables.
>         session inUnitOfWorkDo: [
>                 | agent state |
>                 agent := TgAgent id: (self uidy: '007').
>                 state := (TgState agent: agent version: (self uidy:
> '18-eff'))
>                         packs: #('foopack' 'barpack') asSet;
>                         valuables: (TgValuables coins: 20 gems: 3);
>                         score: (TgFloors total: 4 reinforced: 1);
>                         bestScore: (TgFloors total: 18);
>                         answers: (TgAnswers good: 2 bad: 3);
>                         yourself.
>                 session registerAll: {state. TgAct agent: agent tool:
> (TgTool id: (self uidy: 'Q7') ) } ].
>         towergame := Towergame dao: dao.
>         payload := NeoJSONObject new
>                 agentId: (self uidy: '007'); stateVersion: (self uidy:
> '23-fefe'); deviceId: (self uidy: 'Q7').
>         result := towergame clientSync: payload.
>         result where agentId should equal: (self uidy: '007').
>         result where stateVersion should equal: (self uidy: '18-eff').
>         result where purchasedPacks should satisfy: [ :x | x asSet should
> equal: #('foopack' 'barpack') asSet ].
>         result where valuables coins should equal: 20.
>         result where valuables gems should equal: 3.
>         result where floorsNumber current should equal: 4.
>         result where floorsNumber best should equal: 18.
>         result where floorsNumber reinforced should equal: 1.
>         result where agentAnsweredQuestions good should equal: 2.
>         result where agentAnsweredQuestions bad should equal: 3.
>         result where totalAnsweredQuestions good should equal: 2.
>         result where totalAnsweredQuestions bad should equal: 3! !
>
> !TowergameSyncTests methodsFor: 'tests' stamp: 'HerbyVojcik 8/14/2017
> 18:18'!
> testPlayerChecksStateVersion
>         | result payload |
>         session createTables.
>         session inUnitOfWorkDo: [
>                 | agent state |
>                 agent := TgAgent id: (self uidy: '007').
>                 state := TgState agent: agent version: (self uidy:
> '23-fefe').
>                 session registerAll: {state. TgAct agent: agent tool:
> (TgTool id: (self uidy: 'Q7') ) } ].
>         towergame := Towergame dao: dao.
>         payload := NeoJSONObject new
>                 agentId: (self uidy: '007'); stateVersion: (self uidy:
> '23-fefe'); deviceId: (self uidy: 'Q7').
>         result := towergame clientSync: payload.
>         result where agentId should equal: (self uidy: '007').
>         result where stateVersion should equal: (self uidy: '23-fefe').
>         result where totalAnsweredQuestions good should equal: 0.
>         result where totalAnsweredQuestions bad should equal: 0! !
>
>
> !TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> uidy: aString
>         ^ UUID fromString36: aString ! !
>
> !TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> setUp
>         dao := Towergame daoForLogin: self loginToTemporaryDatabase.
>         session := dao glorpSession.
> ! !
>
> !TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojÄ Ã­k 8/14/2017
> 18:09:53'!
> tearDown
>         session logout! !
>
> !TowergameSyncTests methodsFor: 'running' stamp: 'HerbyVojcik 8/14/2017
> 18:16'!
> loginToTemporaryDatabase
>         ^ Login new
>                 database: UDBCSQLite3Platform new;
>                 host: '';
>                 port: '';
>                 username: '';
>                 password: '';
>                 databaseName: '';
>                 yourself! !
>
>
>
>
>
> BaselineOfTowergame.st:
> BaselineOf subclass: #BaselineOfTowergame
>         instanceVariableNames: ''
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'BaselineOfTowergame'!
>
> !BaselineOfTowergame methodsFor: 'baseline' stamp: 'HerbertVojÄ Ã­k
> 8/14/2017 18:09:53'!
> baseline: spec
>    <baseline>
>         spec for: #common do: [ spec
>
>                 package: 'Towergame' with: [ spec
>                         requires: #('GlorpSQLite' 'NeoJSON') ];
>                 package: 'Towergame-Tests' with: [ spec
>                         requires: #('Towergame' 'Mocketry') ];
>
>                 configuration: 'GlorpSQLite' with: [ spec
>                         version: #stable;
>                         repository:
> 'http://smalltalkhub.com/mc/Pharo/MetaRepoForPharo60/main' ];
>                 configuration: 'NeoJSON' with: [ spec
>                         version: #stable;
>                         repository:
> 'http://smalltalkhub.com/mc/Pharo/MetaRepoForPharo60/main' ];
>                 baseline: 'Mocketry' with: [ spec
>                         repository: 'github://dionisiydk/Mocketry:v4.0.x' ];
>
>                 group: 'default' with: #('Core');
>                 group: 'development' with: #('Core' 'Tests');
>                 group: 'Core' with: #('Towergame');
>                 group: 'Tests' with: #('Towergame-Tests') ]
> ! !
>
>

Reply | Threaded
Open this post in threaded view
|

Re: Big Glorp problem w/ type coercion, pls help

Herby Vojčík
Esteban A. Maringolo wrote:
> Do you have the code somewhere loadable? Reading chunk is something I
> do only when everything crashed :D
> Esteban A. Maringolo

I will attach the .st files... not loadable as its in private on-premise
git repo :-(

Thank you very much,

Herby

> 2017-08-14 13:44 GMT-03:00 Herby Vojčík<[hidden email]>:
>> Hello!
>>
>> I encountered a problem with OneToOneMapping and type coercion. When writing
>> data, thing work; when reading data, the right child of relation fails to
>> convert.
>>
>> I tried everything possible to inject converters (even subclassing
>> GlorpBlobType), but to no avail. RelationExpression passes conversion to its
>> left child:
>>
>> convertedDbValueOf: anObject
>>          "Assume that our types match, so we can ask either child to do the
>> conversion. That isn't guaranteed, but should at least work for the common
>> cases."
>>          ^leftChild convertedDbValueOf: anObject.
>>
>> but the left child is FieldExpression in case of OneToOneMapping, which:
>>
>> convertedDbValueOf: anObject
>>          "We don't do any conversion"
>>          ^anObject
>>
>> What is strange, writing works (even the OneToOneMapping, I opened the
>> sqlite file with an explorer), but second SELECT, one using the relation
>> (`state := self dao findStateByAgent: agent` in clientSync), fails with
>> "GlorpDatabaseReadError: Could not coerce arguments". FWIW, the first one
>> _does_ convert when creating bindings, as it uses MappingExpression as left
>> child (stepped over it in debugger).
>>
>>
>>
>> Is it meant to be a strange case that primary key is something non-primitive
>> needing coercion (in this case, it is a UUID which needs coercion to
>> ByteArray, even if it is its subclass)?
>>
>>
>>
>> Here's the stack of running the test which fails:
>>
>> PharoDatabaseAccessor(DatabaseAccessor)>>handleError:for:
>> [ :ex | self handleError: ex for: command ] in [ | result |
>> self checkPermissionFor: command.
>> result := [ (self useBinding and: [ command useBinding ])
>>          ifTrue: [ command executeBoundIn: self ]
>>          ifFalse: [ command executeUnboundIn: self ] ]
>>          on: Dialect error
>>          do: [ :ex | self handleError: ex for: command ].
>> aBoolean
>>          ifTrue: [ result ]
>>          ifFalse: [ result upToEnd ] ] in
>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>> BlockClosure>>cull:
>> Context>>evaluateSignal:
>> Context>>handleSignal:
>> Error(Exception)>>signal
>> Error(Exception)>>signal:
>> ExternalLibraryFunction(Object)>>error:
>> ExternalLibraryFunction(Object)>>externalCallFailed
>> ExternalLibraryFunction(ExternalFunction)>>invokeWithArguments:
>> UDBCSQLite3Library>>apiBindBlob:atColumn:with:with:with:
>> UDBCSQLite3Library>>with:at:putBlob:
>> UDBCSQLite3Statement>>at:putByteArray:
>> UDBCSQLite3ResultSet>>execute:withIndex:withValue:
>> [ :v | i := self execute: statement withIndex: i withValue: v ] in
>> UDBCSQLite3ResultSet>>execute:withCollection:
>> OrderedCollection>>do:
>> UDBCSQLite3ResultSet>>execute:withCollection:
>> UDBCSQLite3ResultSet>>execute:with:on:
>> UDBCSQLite3Connection>>execute:with:
>> GlorpSQLite3Driver>>basicExecuteSQLString:binding:
>> PharoDatabaseAccessor>>executeCommandBound:
>> QuerySelectCommand(DatabaseCommand)>>executeBoundIn:
>> [ (self useBinding and: [ command useBinding ])
>>          ifTrue: [ command executeBoundIn: self ]
>>          ifFalse: [ command executeUnboundIn: self ] ] in [ | result |
>> self checkPermissionFor: command.
>> result := [ (self useBinding and: [ command useBinding ])
>>          ifTrue: [ command executeBoundIn: self ]
>>          ifFalse: [ command executeUnboundIn: self ] ]
>>          on: Dialect error
>>          do: [ :ex | self handleError: ex for: command ].
>> aBoolean
>>          ifTrue: [ result ]
>>          ifFalse: [ result upToEnd ] ] in
>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>> BlockClosure>>on:do:
>> [ | result |
>> self checkPermissionFor: command.
>> result := [ (self useBinding and: [ command useBinding ])
>>          ifTrue: [ command executeBoundIn: self ]
>>          ifFalse: [ command executeUnboundIn: self ] ]
>>          on: Dialect error
>>          do: [ :ex | self handleError: ex for: command ].
>> aBoolean
>>          ifTrue: [ result ]
>>          ifFalse: [ result upToEnd ] ] in
>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>> [ caught := true.
>> self wait.
>> blockValue := mutuallyExcludedBlock value ] in Semaphore>>critical:
>> BlockClosure>>ensure:
>> Semaphore>>critical:
>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>> [ session accessor executeCommand: command returnCursor: true ] in
>> SimpleQuery>>rowsFromDatabaseWithParameters:
>> BlockClosure>>on:do:
>> SimpleQuery>>rowsFromDatabaseWithParameters:
>> SimpleQuery(AbstractReadQuery)>>readFromDatabaseWithParameters:
>> SimpleQuery(AbstractReadQuery)>>executeWithParameters:in:
>> GlorpSession>>execute:
>> GlorpSession>>readOneOf:where:
>> TowergameDao>>findStateByAgent:
>> [ | agent state |
>> agent := self dao findAgentById: anObject agentId.
>> state := self dao findStateByAgent: agent.
>> ^ NeoJSONObject new
>>          agentId: agent id;
>>          stateVersion: state version;
>>          totalAnsweredQuestions:
>>                  (NeoJSONObject new
>>                          good: 0;
>>                          bad: 0;
>>                          yourself);
>>          yourself ] in Towergame>>clientSync:
>> [ myUnitOfWork := self hasUnitOfWork not.
>> myUnitOfWork
>>          ifTrue: [ self beginUnitOfWork ].
>> result := aBlock numArgs = 1
>>          ifTrue: [ aBlock value: self ]
>>          ifFalse: [ aBlock value ].
>> myUnitOfWork
>>          ifTrue: [ self commitUnitOfWork ] ] in GlorpSession>>inUnitOfWorkDo:
>> BlockClosure>>ifCurtailed:
>> GlorpSession>>inUnitOfWorkDo:
>> TowergameDao>>inUnitOfWorkDo:
>> Towergame>>clientSync:
>> TowergameSyncTests>>testPlayerChecksStateVersion
>> TowergameSyncTests(TestCase)>>performTest
>> [ self setUp.
>> self performTest ] in TowergameSyncTests(TestCase)>>runCase
>> BlockClosure>>ensure:
>> TowergameSyncTests(TestCase)>>runCase
>> [ aTestCase runCase ] in [ [ aTestCase runCase ]
>>          on: Halt
>>          do: [ :halt |
>>                  "if test was halted we should resume all background failures
>>                          to debug all of them together with test process"
>>                  failedProcesses keysDo: #resume.
>>                  halt pass ] ] in
>> TestExecutionEnvironment>>runTestCaseSafelly:
>> BlockClosure>>on:do:
>> [ [ aTestCase runCase ]
>>          on: Halt
>>          do: [ :halt |
>>                  "if test was halted we should resume all background failures
>>                          to debug all of them together with test process"
>>                  failedProcesses keysDo: #resume.
>>                  halt pass ] ] in
>> TestExecutionEnvironment>>runTestCaseSafelly:
>> BlockClosure>>on:do:
>> TestExecutionEnvironment>>runTestCaseSafelly:
>> [ self runTestCaseSafelly: aTestCase ] in [ [ self runTestCaseSafelly:
>> aTestCase ]
>>          ensure: [ testCompleted := true.
>>                  watchDogSemaphore signal ].     "signal that test case
>> completes"
>> self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase:
>> BlockClosure>>ensure:
>> [ [ self runTestCaseSafelly: aTestCase ]
>>          ensure: [ testCompleted := true.
>>                  watchDogSemaphore signal ].     "signal that test case
>> completes"
>> self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase:
>> BlockClosure>>ifCurtailed:
>> TestExecutionEnvironment>>runTestCase:
>> [ testEnv runTestCase: aTestCase ] in
>> DefaultExecutionEnvironment>>runTestCase:
>> [ self value: anExecutionEnvironment.
>> anExecutionEnvironment activated.
>> aBlock value ] in CurrentExecutionEnvironment class>>activate:for:
>> BlockClosure>>ensure:
>> CurrentExecutionEnvironment class>>activate:for:
>> TestExecutionEnvironment(ExecutionEnvironment)>>beActiveDuring:
>> DefaultExecutionEnvironment>>runTestCase:
>> CurrentExecutionEnvironment class>>runTestCase:
>> TowergameSyncTests(TestCase)>>runCaseManaged
>> [ aTestCase announce: TestCaseStarted withResult: self.
>> aTestCase runCaseManaged.
>> aTestCase announce: TestCaseEnded withResult: self.
>> self addPass: aTestCase ] in TestResult>>runCaseForDebug:
>> BlockClosure>>on:do:
>> TestResult>>runCaseForDebug:
>> [ result runCaseForDebug: self ] in TowergameSyncTests(TestCase)>>debug
>> BlockClosure>>ensure:
>> TowergameSyncTests(TestCase)>>debug
>> [ :each |
>> each debug.
>> self announceTest: each.
>> self changed: each ] in [ self tests
>>          do: [ :each |
>>                  each debug.
>>                  self announceTest: each.
>>                  self changed: each ] ] in TestSuite>>debug
>> OrderedCollection>>do:
>> [ self tests
>>          do: [ :each |
>>                  each debug.
>>                  self announceTest: each.
>>                  self changed: each ] ] in TestSuite>>debug
>> BlockClosure>>ensure:
>> TestSuite>>debug
>> [ :aSuite | aSuite debug ] in TestRunner>>debugSuite:
>> BlockClosure>>cull:
>> BlockClosure>>cull:cull:
>> [ aBlock cull: aTestSuite cull: result ] in TestRunner>>executeSuite:as:
>> BlockClosure>>ensure:
>> TestRunner>>executeSuite:as:
>> TestRunner>>debugSuite:
>> TestRunner>>debug:
>> TestRunner>>errorSelected:
>> PluggableListMorph>>changeModelSelection:
>> PluggableListMorph>>mouseUpOnSingle:
>> PluggableListMorph>>mouseUp:
>> PluggableListMorph(Morph)>>handleMouseUp:
>> MouseButtonEvent>>sentTo:
>> PluggableListMorph(Morph)>>handleEvent:
>> MorphicEventDispatcher>>dispatchDefault:with:
>> MorphicEventDispatcher>>handleMouseUp:
>> MouseButtonEvent>>sentTo:
>> [ ^ anEvent sentTo: self ] in MorphicEventDispatcher>>dispatchEvent:with:
>> BlockClosure>>ensure:
>> MorphicEventDispatcher>>dispatchEvent:with:
>> PluggableListMorph(Morph)>>processEvent:using:
>> PluggableListMorph(Morph)>>processEvent:
>> PluggableListMorph>>handleFocusEvent:
>> [ ActiveHand := self.
>> ActiveEvent := anEvent.
>> result := focusHolder
>>          handleFocusEvent: (anEvent transformedBy: (focusHolder
>> transformedFrom: self)) ] in HandMorph>>sendFocusEvent:to:clear:
>> BlockClosure>>on:do:
>> WorldMorph(PasteUpMorph)>>becomeActiveDuring:
>> HandMorph>>sendFocusEvent:to:clear:
>> HandMorph>>sendEvent:focus:clear:
>> HandMorph>>sendMouseEvent:
>> HandMorph>>handleEvent:
>> HandMorph>>processEventsFromQueue:
>> HandMorph>>processEvents
>> [ :h |
>> self activeHand: h.
>> h processEvents.
>> self activeHand: nil ] in WorldState>>doOneCycleNowFor:
>> Array(SequenceableCollection)>>do:
>> WorldState>>handsDo:
>> WorldState>>doOneCycleNowFor:
>> WorldState>>doOneCycleFor:
>> WorldMorph>>doOneCycle
>> WorldMorph class>>doOneCycle
>> [ [ WorldMorph doOneCycle.
>> Processor yield.
>> false ] whileFalse: [  ] ] in MorphicUIManager>>spawnNewProcess
>> [ self value.
>> Processor terminateActive ] in BlockClosure>>newProcess
>>
>>
>>


BaselineOfTowergame.st (1K) Download Attachment
Towergame.st (28K) Download Attachment
Towergame-Tests.st (8K) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: Big Glorp problem w/ type coercion, pls help

Herby Vojčík
FYI, used a workaround:

TowergameDao >> findStateByAgent: anAgent
        | workaround |
        workaround := anAgent ifNotNil: [ ByteArray withAll: anAgent id ].
        ^ self glorpSession readOneOf: TgState where: [ :one | one agent id =
workaround ]

But it is _ugly_ (though, it actually generates the same short SQL; it
was RelationExpression >> condensePrimaryKeyComparison which inspired me
to do this). I am sure one of the points of Glorp is to be able to write
the original:

findStateByAgent: anAgent
        ^ self glorpSession readOneOf: TgState where: [ :one | one agent =
anAgent ]

Is it true (should this work)?

Herby

Herby Vojčík wrote:

> Esteban A. Maringolo wrote:
>> Do you have the code somewhere loadable? Reading chunk is something I
>> do only when everything crashed :D
>> Esteban A. Maringolo
>
> I will attach the .st files... not loadable as its in private on-premise
> git repo :-(
>
> Thank you very much,
>
> Herby
>
>> 2017-08-14 13:44 GMT-03:00 Herby Vojčík<[hidden email]>:
>>> Hello!
>>>
>>> I encountered a problem with OneToOneMapping and type coercion. When
>>> writing
>>> data, thing work; when reading data, the right child of relation
>>> fails to
>>> convert.
>>>
>>> I tried everything possible to inject converters (even subclassing
>>> GlorpBlobType), but to no avail. RelationExpression passes conversion
>>> to its
>>> left child:
>>>
>>> convertedDbValueOf: anObject
>>> "Assume that our types match, so we can ask either child to do the
>>> conversion. That isn't guaranteed, but should at least work for the
>>> common
>>> cases."
>>> ^leftChild convertedDbValueOf: anObject.
>>>
>>> but the left child is FieldExpression in case of OneToOneMapping, which:
>>>
>>> convertedDbValueOf: anObject
>>> "We don't do any conversion"
>>> ^anObject
>>>
>>> What is strange, writing works (even the OneToOneMapping, I opened the
>>> sqlite file with an explorer), but second SELECT, one using the relation
>>> (`state := self dao findStateByAgent: agent` in clientSync), fails with
>>> "GlorpDatabaseReadError: Could not coerce arguments". FWIW, the first
>>> one
>>> _does_ convert when creating bindings, as it uses MappingExpression
>>> as left
>>> child (stepped over it in debugger).
>>>
>>>
>>>
>>> Is it meant to be a strange case that primary key is something
>>> non-primitive
>>> needing coercion (in this case, it is a UUID which needs coercion to
>>> ByteArray, even if it is its subclass)?
>>>
>>>
>>>
>>> Here's the stack of running the test which fails:
>>>
>>> PharoDatabaseAccessor(DatabaseAccessor)>>handleError:for:
>>> [ :ex | self handleError: ex for: command ] in [ | result |
>>> self checkPermissionFor: command.
>>> result := [ (self useBinding and: [ command useBinding ])
>>> ifTrue: [ command executeBoundIn: self ]
>>> ifFalse: [ command executeUnboundIn: self ] ]
>>> on: Dialect error
>>> do: [ :ex | self handleError: ex for: command ].
>>> aBoolean
>>> ifTrue: [ result ]
>>> ifFalse: [ result upToEnd ] ] in
>>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>>> BlockClosure>>cull:
>>> Context>>evaluateSignal:
>>> Context>>handleSignal:
>>> Error(Exception)>>signal
>>> Error(Exception)>>signal:
>>> ExternalLibraryFunction(Object)>>error:
>>> ExternalLibraryFunction(Object)>>externalCallFailed
>>> ExternalLibraryFunction(ExternalFunction)>>invokeWithArguments:
>>> UDBCSQLite3Library>>apiBindBlob:atColumn:with:with:with:
>>> UDBCSQLite3Library>>with:at:putBlob:
>>> UDBCSQLite3Statement>>at:putByteArray:
>>> UDBCSQLite3ResultSet>>execute:withIndex:withValue:
>>> [ :v | i := self execute: statement withIndex: i withValue: v ] in
>>> UDBCSQLite3ResultSet>>execute:withCollection:
>>> OrderedCollection>>do:
>>> UDBCSQLite3ResultSet>>execute:withCollection:
>>> UDBCSQLite3ResultSet>>execute:with:on:
>>> UDBCSQLite3Connection>>execute:with:
>>> GlorpSQLite3Driver>>basicExecuteSQLString:binding:
>>> PharoDatabaseAccessor>>executeCommandBound:
>>> QuerySelectCommand(DatabaseCommand)>>executeBoundIn:
>>> [ (self useBinding and: [ command useBinding ])
>>> ifTrue: [ command executeBoundIn: self ]
>>> ifFalse: [ command executeUnboundIn: self ] ] in [ | result |
>>> self checkPermissionFor: command.
>>> result := [ (self useBinding and: [ command useBinding ])
>>> ifTrue: [ command executeBoundIn: self ]
>>> ifFalse: [ command executeUnboundIn: self ] ]
>>> on: Dialect error
>>> do: [ :ex | self handleError: ex for: command ].
>>> aBoolean
>>> ifTrue: [ result ]
>>> ifFalse: [ result upToEnd ] ] in
>>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>>> BlockClosure>>on:do:
>>> [ | result |
>>> self checkPermissionFor: command.
>>> result := [ (self useBinding and: [ command useBinding ])
>>> ifTrue: [ command executeBoundIn: self ]
>>> ifFalse: [ command executeUnboundIn: self ] ]
>>> on: Dialect error
>>> do: [ :ex | self handleError: ex for: command ].
>>> aBoolean
>>> ifTrue: [ result ]
>>> ifFalse: [ result upToEnd ] ] in
>>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>>> [ caught := true.
>>> self wait.
>>> blockValue := mutuallyExcludedBlock value ] in Semaphore>>critical:
>>> BlockClosure>>ensure:
>>> Semaphore>>critical:
>>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>>> [ session accessor executeCommand: command returnCursor: true ] in
>>> SimpleQuery>>rowsFromDatabaseWithParameters:
>>> BlockClosure>>on:do:
>>> SimpleQuery>>rowsFromDatabaseWithParameters:
>>> SimpleQuery(AbstractReadQuery)>>readFromDatabaseWithParameters:
>>> SimpleQuery(AbstractReadQuery)>>executeWithParameters:in:
>>> GlorpSession>>execute:
>>> GlorpSession>>readOneOf:where:
>>> TowergameDao>>findStateByAgent:
>>> [ | agent state |
>>> agent := self dao findAgentById: anObject agentId.
>>> state := self dao findStateByAgent: agent.
>>> ^ NeoJSONObject new
>>> agentId: agent id;
>>> stateVersion: state version;
>>> totalAnsweredQuestions:
>>> (NeoJSONObject new
>>> good: 0;
>>> bad: 0;
>>> yourself);
>>> yourself ] in Towergame>>clientSync:
>>> [ myUnitOfWork := self hasUnitOfWork not.
>>> myUnitOfWork
>>> ifTrue: [ self beginUnitOfWork ].
>>> result := aBlock numArgs = 1
>>> ifTrue: [ aBlock value: self ]
>>> ifFalse: [ aBlock value ].
>>> myUnitOfWork
>>> ifTrue: [ self commitUnitOfWork ] ] in GlorpSession>>inUnitOfWorkDo:
>>> BlockClosure>>ifCurtailed:
>>> GlorpSession>>inUnitOfWorkDo:
>>> TowergameDao>>inUnitOfWorkDo:
>>> Towergame>>clientSync:
>>> TowergameSyncTests>>testPlayerChecksStateVersion
>>> TowergameSyncTests(TestCase)>>performTest
>>> [ self setUp.
>>> self performTest ] in TowergameSyncTests(TestCase)>>runCase
>>> BlockClosure>>ensure:
>>> TowergameSyncTests(TestCase)>>runCase
>>> [ aTestCase runCase ] in [ [ aTestCase runCase ]
>>> on: Halt
>>> do: [ :halt |
>>> "if test was halted we should resume all background failures
>>> to debug all of them together with test process"
>>> failedProcesses keysDo: #resume.
>>> halt pass ] ] in
>>> TestExecutionEnvironment>>runTestCaseSafelly:
>>> BlockClosure>>on:do:
>>> [ [ aTestCase runCase ]
>>> on: Halt
>>> do: [ :halt |
>>> "if test was halted we should resume all background failures
>>> to debug all of them together with test process"
>>> failedProcesses keysDo: #resume.
>>> halt pass ] ] in
>>> TestExecutionEnvironment>>runTestCaseSafelly:
>>> BlockClosure>>on:do:
>>> TestExecutionEnvironment>>runTestCaseSafelly:
>>> [ self runTestCaseSafelly: aTestCase ] in [ [ self runTestCaseSafelly:
>>> aTestCase ]
>>> ensure: [ testCompleted := true.
>>> watchDogSemaphore signal ]. "signal that test case
>>> completes"
>>> self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase:
>>> BlockClosure>>ensure:
>>> [ [ self runTestCaseSafelly: aTestCase ]
>>> ensure: [ testCompleted := true.
>>> watchDogSemaphore signal ]. "signal that test case
>>> completes"
>>> self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase:
>>> BlockClosure>>ifCurtailed:
>>> TestExecutionEnvironment>>runTestCase:
>>> [ testEnv runTestCase: aTestCase ] in
>>> DefaultExecutionEnvironment>>runTestCase:
>>> [ self value: anExecutionEnvironment.
>>> anExecutionEnvironment activated.
>>> aBlock value ] in CurrentExecutionEnvironment class>>activate:for:
>>> BlockClosure>>ensure:
>>> CurrentExecutionEnvironment class>>activate:for:
>>> TestExecutionEnvironment(ExecutionEnvironment)>>beActiveDuring:
>>> DefaultExecutionEnvironment>>runTestCase:
>>> CurrentExecutionEnvironment class>>runTestCase:
>>> TowergameSyncTests(TestCase)>>runCaseManaged
>>> [ aTestCase announce: TestCaseStarted withResult: self.
>>> aTestCase runCaseManaged.
>>> aTestCase announce: TestCaseEnded withResult: self.
>>> self addPass: aTestCase ] in TestResult>>runCaseForDebug:
>>> BlockClosure>>on:do:
>>> TestResult>>runCaseForDebug:
>>> [ result runCaseForDebug: self ] in TowergameSyncTests(TestCase)>>debug
>>> BlockClosure>>ensure:
>>> TowergameSyncTests(TestCase)>>debug
>>> [ :each |
>>> each debug.
>>> self announceTest: each.
>>> self changed: each ] in [ self tests
>>> do: [ :each |
>>> each debug.
>>> self announceTest: each.
>>> self changed: each ] ] in TestSuite>>debug
>>> OrderedCollection>>do:
>>> [ self tests
>>> do: [ :each |
>>> each debug.
>>> self announceTest: each.
>>> self changed: each ] ] in TestSuite>>debug
>>> BlockClosure>>ensure:
>>> TestSuite>>debug
>>> [ :aSuite | aSuite debug ] in TestRunner>>debugSuite:
>>> BlockClosure>>cull:
>>> BlockClosure>>cull:cull:
>>> [ aBlock cull: aTestSuite cull: result ] in TestRunner>>executeSuite:as:
>>> BlockClosure>>ensure:
>>> TestRunner>>executeSuite:as:
>>> TestRunner>>debugSuite:
>>> TestRunner>>debug:
>>> TestRunner>>errorSelected:
>>> PluggableListMorph>>changeModelSelection:
>>> PluggableListMorph>>mouseUpOnSingle:
>>> PluggableListMorph>>mouseUp:
>>> PluggableListMorph(Morph)>>handleMouseUp:
>>> MouseButtonEvent>>sentTo:
>>> PluggableListMorph(Morph)>>handleEvent:
>>> MorphicEventDispatcher>>dispatchDefault:with:
>>> MorphicEventDispatcher>>handleMouseUp:
>>> MouseButtonEvent>>sentTo:
>>> [ ^ anEvent sentTo: self ] in
>>> MorphicEventDispatcher>>dispatchEvent:with:
>>> BlockClosure>>ensure:
>>> MorphicEventDispatcher>>dispatchEvent:with:
>>> PluggableListMorph(Morph)>>processEvent:using:
>>> PluggableListMorph(Morph)>>processEvent:
>>> PluggableListMorph>>handleFocusEvent:
>>> [ ActiveHand := self.
>>> ActiveEvent := anEvent.
>>> result := focusHolder
>>> handleFocusEvent: (anEvent transformedBy: (focusHolder
>>> transformedFrom: self)) ] in HandMorph>>sendFocusEvent:to:clear:
>>> BlockClosure>>on:do:
>>> WorldMorph(PasteUpMorph)>>becomeActiveDuring:
>>> HandMorph>>sendFocusEvent:to:clear:
>>> HandMorph>>sendEvent:focus:clear:
>>> HandMorph>>sendMouseEvent:
>>> HandMorph>>handleEvent:
>>> HandMorph>>processEventsFromQueue:
>>> HandMorph>>processEvents
>>> [ :h |
>>> self activeHand: h.
>>> h processEvents.
>>> self activeHand: nil ] in WorldState>>doOneCycleNowFor:
>>> Array(SequenceableCollection)>>do:
>>> WorldState>>handsDo:
>>> WorldState>>doOneCycleNowFor:
>>> WorldState>>doOneCycleFor:
>>> WorldMorph>>doOneCycle
>>> WorldMorph class>>doOneCycle
>>> [ [ WorldMorph doOneCycle.
>>> Processor yield.
>>> false ] whileFalse: [ ] ] in MorphicUIManager>>spawnNewProcess
>>> [ self value.
>>> Processor terminateActive ] in BlockClosure>>newProcess
>>>
>>>
>>>
>
>