event-sourcing.st

Object subclass: #BaseObject
	instanceVariableNames: ''
	classVariableNames: 'registry'
	poolDictionaries: ''
	category: 'EventSourcing'!

!BaseObject methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 11:29'!
logg: aString
	Transcript show: aString ; cr .! !

!BaseObject methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 11:15'!
registry
	^ self class registry! !

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

BaseObject class
	instanceVariableNames: ''!

!BaseObject class methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 11:13'!
initialize
	registry := Registry new! !

!BaseObject class methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 11:14'!
registry
  	^ registry
! !


BaseObject subclass: #App
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!App methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 21:30'!
start
	| recordingId releaseId command handler releaseProjection |
	App initialize .
	releaseProjection := ReleaseProjection new .

	recordingId := UUID new .
	command := CreateRecording
	 	id: recordingId
	 	artist: 'Peter Gabriel'
		title: 'Sledgehammer'
		duration: 300 .
	handler := registry commandHandlerFor: Recording .
	handler handle: command .

	releaseId := UUID new .
	command := CreateRelease
	 	id: releaseId
		title: 'So' .
	handler := registry commandHandlerFor: Release .
	handler handle: command .

	self logg: ( releaseProjection find: releaseId ) storeString .! !

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

App class
	instanceVariableNames: ''!

!App class methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 17:56'!
initialize
	BaseObject initialize .
	Registry initialize .! !


BaseObject subclass: #CommandHandler
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!CommandHandler methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 13:22'!
handle: aCommand

	 self perform: ('on', aCommand className, ':') asSymbol with: aCommand! !


BaseObject subclass: #Decorator
	instanceVariableNames: 'decoratedObj'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!Decorator methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 18:03'!
decoratedObj: anObject
	decoratedObj := anObject .! !


BaseObject subclass: #EventStore
	instanceVariableNames: 'streams'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!EventStore methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 22:44'!
eventStreamFor: id
	^ streams at: id .! !

!EventStore methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 22:45'!
eventStreamVersionFor: id
	^ ( streams at: id ) version! !

!EventStore methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 18:24'!
create: id
	self logg: 'Creating event stream for ' , id asString .
	streams add: id -> EventStream new .! !

!EventStore methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/20/2017 21:37'!
appendTo: id events: aCollection
	"Append events to EventStream identified by given id"

	(streams at: id) append: aCollection ! !


!EventStore methodsFor: 'initialization' stamp: 'KjellMagneOierud 1/22/2017 22:42'!
initialize
	streams := Dictionary new .! !


BaseObject subclass: #EventStoreRepository
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!EventStoreRepository methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 22:48'!
build: anEventStream
	^ self! !

!EventStoreRepository methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 22:48'!
find: id
	| stream |
	stream := self registry eventStore eventStreamFor: id .
	self build: stream .! !


BaseObject subclass: #EventStream
	instanceVariableNames: 'eventSequence'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!EventStream methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/20/2017 21:21'!
initialize
	eventSequence := {  } .! !

!EventStream methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/20/2017 21:47'!
append: aCollection
	""
	eventSequence := eventSequence , aCollection .! !

!EventStream methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 22:42'!
version
	eventSequence length .! !


Decorator subclass: #PubSubEventStoreDecorator
	instanceVariableNames: 'subscribers'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!PubSubEventStoreDecorator methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 21:13'!
appendTo: id events: aCollection
	decoratedObj appendTo: id events: aCollection .
	self publish: aCollection .! !

!PubSubEventStoreDecorator methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 18:12'!
publish: events
	events do: [ :event | subscribers do: [ :sub | sub apply: event ] ] .! !

!PubSubEventStoreDecorator methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 18:14'!
subscribe: anObject
	subscribers add: anObject .! !

!PubSubEventStoreDecorator methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 21:23'!
initialize
	subscribers := OrderedCollection new .! !

!PubSubEventStoreDecorator methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 18:05'!
create: id
	decoratedObj create: id! !


CommandHandler subclass: #RecordingCommandHandler
	instanceVariableNames: 'eventStore'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!RecordingCommandHandler methodsFor: 'initialization' stamp: 'KjellMagneOierud 1/22/2017 18:19'!
initialize
	eventStore := self registry eventStore .! !


!RecordingCommandHandler methodsFor: 'handling' stamp: 'KjellMagneOierud 1/22/2017 21:41'!
onCreateRecording: aCommand
	| events |
	self logg: aCommand storeString .
	events := { RecordingCreated new } .
	eventStore create: aCommand id ;
		appendTo: aCommand id events: events .! !


BaseObject subclass: #RecordingStruct
	instanceVariableNames: 'id artist title duration'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!RecordingStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/22/2017 19:57'!
title
	^ title .! !

!RecordingStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/20/2017 22:34'!
artist: aString
	artist := aString! !

!RecordingStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/20/2017 22:33'!
id: anInteger
	id := anInteger! !

!RecordingStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/22/2017 16:47'!
id
	^ id .! !

!RecordingStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/22/2017 19:56'!
artist
	^ artist! !

!RecordingStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/20/2017 22:36'!
title: aString
	title := aString! !

!RecordingStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/22/2017 19:57'!
duration
	^ duration! !

!RecordingStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/20/2017 22:35'!
duration: anInteger
	"comment stating purpose of message"

	duration := anInteger ! !

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

RecordingStruct class
	instanceVariableNames: ''!

!RecordingStruct class methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/20/2017 22:26'!
id: anID artist: artistString title: titleString duration: anInteger
	"comment stating purpose of message"

	^self new
	   id: anID ;
		artist: artistString ;
		title: titleString ;
		duration: anInteger .! !

!RecordingStruct class methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 19:53'!
variables
	^ 'id artist title duration'! !


RecordingStruct subclass: #CreateRecording
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

RecordingStruct subclass: #Recording
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

RecordingStruct subclass: #RecordingCreated
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

BaseObject subclass: #Registry
	instanceVariableNames: ''
	classVariableNames: 'CommandHandlers Repositories TheEventStore'
	poolDictionaries: ''
	category: 'EventSourcing'!

!Registry methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 20:27'!
commandHandlerFor: aClass
	^ self class commandHandlers at: aClass
! !

!Registry methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 16:43'!
eventStore
	^ self class eventStore .! !

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

Registry class
	instanceVariableNames: ''!

!Registry class methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 20:26'!
initialize
	CommandHandlers := Dictionary new .
	CommandHandlers add: Recording -> RecordingCommandHandler new ;
		add: Release -> ReleaseCommandHandler  new .
	TheEventStore := PubSubEventStoreDecorator new
		decoratedObj: EventStore new .
	! !

!Registry class methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 17:12'!
commandHandlers
  ^ CommandHandlers ! !

!Registry class methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 16:37'!
eventStore
	^ TheEventStore! !


CommandHandler subclass: #ReleaseCommandHandler
	instanceVariableNames: 'eventStore'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!ReleaseCommandHandler methodsFor: 'handling' stamp: 'KjellMagneOierud 1/22/2017 22:20'!
onCreateRelease: aCommand
	| events |
	self logg: aCommand storeString .
	events := { ReleaseCreated id: aCommand id title: aCommand title } .
	eventStore create: aCommand id ;
		appendTo: aCommand id events: events .! !


!ReleaseCommandHandler methodsFor: 'initialization' stamp: 'KjellMagneOierud 1/22/2017 20:17'!
initialize
	eventStore := self registry eventStore .! !


BaseObject subclass: #ReleaseStruct
	instanceVariableNames: 'id title'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!ReleaseStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/22/2017 20:23'!
title
	^ title
! !

!ReleaseStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/22/2017 20:13'!
id: anInteger
	id := anInteger! !

!ReleaseStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/22/2017 20:13'!
id
	^ id .! !

!ReleaseStruct methodsFor: 'accessing' stamp: 'KjellMagneOierud 1/22/2017 20:24'!
title: aString
	title := aString! !

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

ReleaseStruct class
	instanceVariableNames: ''!

!ReleaseStruct class methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 20:24'!
id: anID title: titleString
	^ self new
	   id: anID ;
		title: titleString .
! !


ReleaseStruct subclass: #CreateRelease
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

ReleaseStruct subclass: #Release
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

ReleaseStruct subclass: #ReleaseCreated
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

BaseObject subclass: #RepositoryProjection
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

BaseObject subclass: #SubscriberProjection
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!SubscriberProjection methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 20:35'!
initialize
	self registry eventStore subscribe: self .! !

!SubscriberProjection methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 20:44'!
apply: anEvent
	| selector |
	selector := ('when', anEvent className, ':') asSymbol .
	( self class canUnderstand: selector )
		ifTrue: [ self perform: selector with: anEvent ] .! !


SubscriberProjection subclass: #ReleaseProjection
	instanceVariableNames: 'releases'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!

!ReleaseProjection methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 21:20'!
initialize
	super initialize .
	releases := Dictionary new! !

!ReleaseProjection methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 21:30'!
find: id
	^ releases at: id! !

!ReleaseProjection methodsFor: 'as yet unclassified' stamp: 'KjellMagneOierud 1/22/2017 21:51'!
whenReleaseCreated: anEvent
	releases add: (anEvent id -> ( STON toString: anEvent ) ) .! !


BaseObject subclass: #UnitOfWork
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EventSourcing'!
BaseObject initialize!
App initialize!
Registry initialize!