Smalltalk current createPackage: 'Trapped-Backend'! Object subclass: #EavModel instanceVariableNames: 'getBlock putBlock' package: 'Trapped-Backend'! !EavModel commentStamp! External actor value model.! !EavModel methodsFor: 'accessing'! getBlock: aBlock getBlock := aBlock ! on: anObject "Returns value of model applied on object" ^getBlock value: anObject ! on: anObject put: anObject2 "Puts a value via model applied on object" ^putBlock value: anObject value: anObject2 ! putBlock: aBlock putBlock := aBlock ! ! !EavModel methodsFor: 'initialization'! initialize super initialize. getBlock := [ self error: 'No getter block.' ]. putBlock := [ self error: 'No putter block.' ]. ! ! Object subclass: #Isolator instanceVariableNames: 'root' package: 'Trapped-Backend'! !Isolator methodsFor: 'accessing'! root ^root ! root: anObject root := anObject ! ! !Isolator methodsFor: 'action'! model: anEavModel modify: aBlock | newValue | newValue := aBlock value: (anEavModel on: self). anEavModel on: self put: newValue deepCopy ! model: anEavModel read: aBlock aBlock value: (anEavModel on: self) deepCopy ! ! !Isolator class methodsFor: 'instance creation'! on: anObject ^self new root: anObject ! ! Object subclass: #KeyedPubSubBase instanceVariableNames: 'factory' package: 'Trapped-Backend'! !KeyedPubSubBase commentStamp! I represent a pub-sub based on a key. I manage key-block subscriptions as well as running blocks that are dirty. The subscription objects are reponsible of decision if the change is relevant for them. Subscription object must be subclasses of KeyedSubscriptionBase. My subclasses must provide implementation for: add: do: clean (optionally) run and issue this call before actual use: subscritionFactory: (setting [:key:block|...] factory that creates appropriate subscription)! !KeyedPubSubBase methodsFor: 'action'! changed: key | needsToRun | needsToRun := false. self do: [ :each | (each accepts: key) ifTrue: [ each flag. needsToRun := true. ] ]. self dirty: needsToRun ! dirty: aBoolean aBoolean ifTrue: [[ self run ] fork] ! on: key hook: aBlock self add: (factory value: key value: aBlock) flag. self dirty: true ! run [ | needsClean | needsClean := false. self do: [ :each | each isFlagged ifTrue: [ each run ]. each isEnabled ifFalse: [ needsClean := true ] ]. needsClean ifTrue: [ self clean ] ] on: Error do: [ self dirty: true ] ! subscriptionFactory: aBlock factory := aBlock ! ! KeyedPubSubBase subclass: #SimpleKeyedPubSub instanceVariableNames: 'queue' package: 'Trapped-Backend'! !SimpleKeyedPubSub methodsFor: 'accessing'! add: aSubscription queue add: aSubscription. ! ! !SimpleKeyedPubSub methodsFor: 'bookkeeping'! clean queue := queue select: [ :each | each isEnabled ] ! ! !SimpleKeyedPubSub methodsFor: 'enumeration'! do: aBlock queue do: aBlock ! ! !SimpleKeyedPubSub methodsFor: 'initialization'! initialize super initialize. queue := OrderedCollection new ! ! Error subclass: #KeyedPubSubUnsubscribe instanceVariableNames: '' package: 'Trapped-Backend'! !KeyedPubSubUnsubscribe commentStamp! SIgnal me from the subscription block to unsubscribe it.! Object subclass: #KeyedSubscriptionBase instanceVariableNames: 'key actionBlock flagged' package: 'Trapped-Backend'! !KeyedSubscriptionBase methodsFor: 'accessing'! flag flagged := true ! key: anObject block: aBlock key := anObject. actionBlock := aBlock ! ! !KeyedSubscriptionBase methodsFor: 'action'! run [ flagged := false. actionBlock value ] on: KeyedPubSubUnsubscribe do: [ actionBlock := nil ] ! ! !KeyedSubscriptionBase methodsFor: 'initialization'! initialize super initialize. key := nil. actionBlock := nil. flagged := false. ! ! !KeyedSubscriptionBase methodsFor: 'testing'! accepts: aKey "Should return true if change for aKey is relevant for this subscription" self subclassResponsibility ! isEnabled ^actionBlock notNil ! isFlagged ^flagged ! ! KeyedSubscriptionBase subclass: #ListKeyedSubscription instanceVariableNames: '' package: 'Trapped-Backend'! !ListKeyedSubscription methodsFor: 'testing'! accepts: aKey ^aKey size <= key size and: [aKey = (key copyFrom: 1 to: aKey size)] ! ! KeyedSubscriptionBase subclass: #TwoWayListKeyedSubscription instanceVariableNames: '' package: 'Trapped-Backend'! !TwoWayListKeyedSubscription methodsFor: 'testing'! accepts: aKey ^aKey size <= key size ifTrue: [aKey = (key copyFrom: 1 to: aKey size)] ifFalse: [key = (aKey copyFrom: 1 to: key size)] ! ! Object subclass: #ListKeyedEntity instanceVariableNames: 'dispatcher payload' package: 'Trapped-Backend'! !ListKeyedEntity commentStamp! I am base class for #('string-at-index' #selector numeric-at-index)-array-path-keyed entities, that moderate access to the wrapped model object via read;do and modify:do: and allow pub-sub via watch:do:. This wrapped model can be any smalltalk object. My subclasses need to provide implementation for: read:do: modify:do: and must issue these calls when initializing: model: (with a wrapped object) dispatcher: (with a subclass of KeyedPubSubBase)! !ListKeyedEntity methodsFor: 'accessing'! dispatcher ^dispatcher ! dispatcher: aDispatcher dispatcher := aDispatcher subscriptionFactory: [ :key :block | (key notEmpty and: [ key last isNil ]) ifTrue: [ TwoWayListKeyedSubscription new key: key allButLast block: block; yourself ] ifFalse: [ ListKeyedSubscription new key: key block: block; yourself ]]; yourself ! model: anObject payload := anObject. self dispatcher changed: #() ! ! !ListKeyedEntity methodsFor: 'action'! watch: path do: aBlock self dispatcher on: path hook: [ self read: path do: aBlock ] ! ! ListKeyedEntity subclass: #ListKeyedDirectEntity instanceVariableNames: '' package: 'Trapped-Backend'! !ListKeyedDirectEntity commentStamp! I am ListKeyedEntity that directly manipulate the wrapped model object.! !ListKeyedDirectEntity methodsFor: 'action'! modify: path do: aBlock | newValue eavModel | eavModel := path asEavModel. newValue := aBlock value: (eavModel on: payload). [ eavModel on: payload put: newValue ] ensure: [ self dispatcher changed: path ] ! read: path do: aBlock | eavModel | eavModel := path asEavModel. aBlock value: (eavModel on: payload) ! ! ListKeyedEntity subclass: #ListKeyedIsolatedEntity instanceVariableNames: '' package: 'Trapped-Backend'! !ListKeyedIsolatedEntity commentStamp! I am ListKeyedEntity that guards access to the wrapped model object via Isolator.! !ListKeyedIsolatedEntity methodsFor: 'accessing'! model: anObject super model: (Isolator on: anObject) ! ! !ListKeyedIsolatedEntity methodsFor: 'action'! modify: path do: aBlock | eavModel | eavModel := ({{#root}},path) asEavModel. [ payload model: eavModel modify: aBlock ] ensure: [ self dispatcher changed: path ] ! read: path do: aBlock | eavModel | eavModel := ({{#root}},path) asEavModel. payload model: eavModel read: aBlock ! ! !Object methodsFor: '*Trapped-Backend'! asTrapAtPut: value sendTo: anObject self error: 'Trapped cannot put at ', self class name, ' type key.' ! asTrapAtSendTo: anObject ^nil ! ! !Number methodsFor: '*Trapped-Backend'! asTrapAtPut: value sendTo: anObject ^anObject at: self put: value ! asTrapAtSendTo: anObject ^anObject ifNotNil: [ anObject at: self ifAbsent: [nil] ] ! ! !SequenceableCollection methodsFor: '*Trapped-Backend'! asEavModel | model | model := EavModel new. model getBlock: [ :anObject | self inject: anObject into: [ :soFar :segment | segment asTrapAtSendTo: soFar ]]. self isEmpty ifFalse: [ model putBlock: [ :anObject :value | | penultimate | penultimate := self allButLast inject: anObject into: [ :soFar :segment | soFar ifNotNil: [ segment asTrapAtSendTo: soFar ]]. self last asTrapAtPut:value sendTo: penultimate ]]. ^model ! ! !String methodsFor: '*Trapped-Backend'! asTrapAtPut: value sendTo: anObject ^anObject at: self put: value ! asTrapAtSendTo: anObject ^anObject ifNotNil: [ anObject at: self ifAbsent: [nil] ] ! ! !Array methodsFor: '*Trapped-Backend'! asTrapAtPut: value sendTo: anObject ^anObject perform: (self first, ':') asSymbol withArguments: { value } ! asTrapAtSendTo: anObject ^[anObject perform: self first] on: MessageNotUnderstood do: [^nil] ! !