source upload
This commit is contained in:
Razor12911
@@ -0,0 +1,42 @@
|
||||
|
||||
Practical Domain Driven Design
|
||||
================================
|
||||
|
||||
Welcome to the Progressive samples folders!
|
||||
|
||||
In the sub-folders, we will write a almost-complete DDD sample, using TDD.
|
||||
Folders are enumerated to follow the iterations on the project: 01, 02, 03...
|
||||
|
||||
Since it was started during EKON 21 conferences, it will modelize a conference booking system.
|
||||
|
||||
Don't forget to check out the associated Slides from https://synopse.info/files/ekon21
|
||||
|
||||
|
||||
01 Iteration
|
||||
------------
|
||||
|
||||
Contains the core units, following the "Clean Architecture" patterns.
|
||||
|
||||
Implements
|
||||
* TestAll.dpr to run the regression tests;
|
||||
* ServBook.dpr to run a Booking service, using the Conference Domain objects.
|
||||
|
||||
|
||||
02 Iteration
|
||||
------------
|
||||
|
||||
We added some Domain objects, and a basic booking service.
|
||||
This has been implemented via the participation of all attendees to the EKON 21 Conference, just after the slides.
|
||||
Nice first attempt, even it may be really mind-breaking from a classical DB-centric approach! ;)
|
||||
|
||||
Introduces a Repository dependency contract, which will be implemented in the test with a `TSynStub`, to let the test pass.
|
||||
|
||||
|
||||
03 Iteration
|
||||
------------
|
||||
|
||||
Minor refactoring:
|
||||
* Cleaning the code to use mORMot registration for interface TypeInfo();
|
||||
* Refactored IConferenceBooking for a more realistic use of parameters;
|
||||
* Include session days to the regression tests.
|
||||
|
||||
@@ -0,0 +1,31 @@
|
||||
/// Conference Domain dependencies interface definition
|
||||
unit DomConferenceDepend;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Classes,
|
||||
SynCommons,
|
||||
mORMot,
|
||||
DomConferenceTypes;
|
||||
|
||||
type
|
||||
TBookingRepositoryError = (
|
||||
brSuccess, brDuplicatedInfo, brWriteFailure);
|
||||
|
||||
IBookingRepository = interface(IInvokable)
|
||||
['{8E121C97-7E53-4208-BE05-1660EAD8AB43}']
|
||||
function SaveNewRegistration(const Attendee: TAttendee;
|
||||
out RegistrationNumber: TAttendeeRegistrationNumber): TBookingRepositoryError;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
initialization
|
||||
TJSONSerializer.RegisterObjArrayForJSON([
|
||||
]);
|
||||
TInterfaceFactory.RegisterInterfaces([
|
||||
TypeInfo(IBookingRepository)
|
||||
]);
|
||||
end.
|
||||
@@ -0,0 +1,35 @@
|
||||
/// Conference Domain services interfaces definition
|
||||
unit DomConferenceInterfaces;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Classes,
|
||||
SynCommons,
|
||||
mORMot,
|
||||
DomConferenceTypes;
|
||||
|
||||
{ Conference Domain Services }
|
||||
|
||||
type
|
||||
TRegisterAttendee = (raSuccess, raMissingField, raInvalidField,
|
||||
raAlreadyRegistered, raPersistenceError);
|
||||
|
||||
IConferenceBooking = interface(IInvokable)
|
||||
['{0A128982-38E3-406E-B7B4-7FE212552BBF}']
|
||||
function RegisterAttendee(const Name: TAttendeeName;
|
||||
FirstName: TAttendeeFirstName; const Days: TSessionDays;
|
||||
out Attendee: TAttendee): TRegisterAttendee;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
initialization
|
||||
TJSONSerializer.RegisterObjArrayForJSON([
|
||||
]);
|
||||
TInterfaceFactory.RegisterInterfaces([
|
||||
TypeInfo(IConferenceBooking)
|
||||
]);
|
||||
end.
|
||||
@@ -0,0 +1,65 @@
|
||||
/// Conference Domain services implementation
|
||||
unit DomConferenceServices;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Classes,
|
||||
SynCommons,
|
||||
mORMot,
|
||||
DomConferenceTypes,
|
||||
DomConferenceInterfaces,
|
||||
DomConferenceDepend;
|
||||
|
||||
type
|
||||
TConferenceBooking = class(TInterfacedObject, IConferenceBooking)
|
||||
protected
|
||||
fRepository: IBookingRepository;
|
||||
public
|
||||
constructor Create(aRepository: IBookingRepository); reintroduce;
|
||||
// IConferenceBooking methods below
|
||||
function RegisterAttendee(const Name: TAttendeeName;
|
||||
FirstName: TAttendeeFirstName; const Days: TSessionDays;
|
||||
out Attendee: TAttendee): TRegisterAttendee;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TConferenceBooking }
|
||||
|
||||
constructor TConferenceBooking.Create(aRepository: IBookingRepository);
|
||||
begin
|
||||
inherited Create;
|
||||
fRepository := aRepository;
|
||||
end;
|
||||
|
||||
function TConferenceBooking.RegisterAttendee(const Name: TAttendeeName;
|
||||
FirstName: TAttendeeFirstName; const Days: TSessionDays;
|
||||
out Attendee: TAttendee): TRegisterAttendee;
|
||||
const
|
||||
// this kind of structures won't compile any more if you add items to
|
||||
// TBookingRepositoryError: so it is a safe way to enforce error coverage
|
||||
RepoToDomain: array[TBookingRepositoryError] of TRegisterAttendee =
|
||||
// brSuccess, brDuplicatedInfo, brWriteFailure
|
||||
(raSuccess, raAlreadyRegistered, raPersistenceError);
|
||||
var
|
||||
number: TAttendeeRegistrationNumber;
|
||||
res: TBookingRepositoryError;
|
||||
begin
|
||||
result := raMissingField;
|
||||
if Days = nil then
|
||||
exit;
|
||||
Attendee.Name := Name;
|
||||
Attendee.FirstName := FirstName;
|
||||
Attendee.CleanupName;
|
||||
if (Attendee.Name = '') or (Attendee.FirstName = '') then
|
||||
exit;
|
||||
res := fRepository.SaveNewRegistration(Attendee, number);
|
||||
result := RepoToDomain[res];
|
||||
if result = raSuccess then
|
||||
Attendee.RegistrationNumber := number;
|
||||
end;
|
||||
|
||||
initialization
|
||||
end.
|
||||
@@ -0,0 +1,84 @@
|
||||
/// Conference Domain unit tests
|
||||
unit DomConferenceTest;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Classes,
|
||||
SynCommons,
|
||||
SynTests,
|
||||
mORMot,
|
||||
DomConferenceTypes,
|
||||
DomConferenceInterfaces,
|
||||
DomConferenceServices,
|
||||
DomConferenceDepend;
|
||||
|
||||
type
|
||||
TTestConference = class(TSynTestCase)
|
||||
protected
|
||||
published
|
||||
procedure DomainTypes;
|
||||
procedure DomainBooking;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestConference }
|
||||
|
||||
procedure TTestConference.DomainTypes;
|
||||
var
|
||||
a: TAttendee;
|
||||
begin
|
||||
a := TAttendee.Create;
|
||||
try
|
||||
a.FirstName := ' abc';
|
||||
a.Name := 'def ';
|
||||
a.CleanupName;
|
||||
Check(a.FirstName = 'abc');
|
||||
Check(a.Name = 'def');
|
||||
finally
|
||||
a.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestConference.DomainBooking;
|
||||
var
|
||||
book: IConferenceBooking;
|
||||
a: TAttendee;
|
||||
days: TSessionDays;
|
||||
res: TRegisterAttendee;
|
||||
repo: IBookingRepository;
|
||||
begin
|
||||
TInterfaceStub.Create(IBookingRepository, repo);
|
||||
book := TConferenceBooking.Create(repo);
|
||||
a := TAttendee.Create;
|
||||
try
|
||||
res := book.RegisterAttendee('', '', nil, a);
|
||||
check(res = raMissingField);
|
||||
finally
|
||||
a.Free;
|
||||
end;
|
||||
a := TAttendee.Create;
|
||||
try
|
||||
res := book.RegisterAttendee('abc', ' def', nil, a);
|
||||
check(res = raMissingField);
|
||||
finally
|
||||
a.Free;
|
||||
end;
|
||||
a := TAttendee.Create;
|
||||
try
|
||||
days := TSessionDay.From([0, 1, 2]);
|
||||
res := book.RegisterAttendee('abc', ' def', days, a);
|
||||
check(res = raSuccess);
|
||||
check(a.Name = 'abc');
|
||||
check(a.FirstName = 'def');
|
||||
finally
|
||||
a.Free;
|
||||
ObjArrayClear(days);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
end.
|
||||
@@ -0,0 +1,82 @@
|
||||
/// entities, values, aggregates for the Conference domain
|
||||
unit DomConferenceTypes;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Classes,
|
||||
SynCommons,
|
||||
mORMot;
|
||||
|
||||
|
||||
{ Conference Domain Objects }
|
||||
|
||||
type
|
||||
|
||||
TAttendeeName = type RawUTF8;
|
||||
TAttendeeFirstName = type RawUTF8;
|
||||
TAttendeeRegistrationNumber = type cardinal;
|
||||
TSessionDate = type TDateTime;
|
||||
|
||||
TAttendee = class(TPersistent)
|
||||
private
|
||||
fName: TAttendeeName;
|
||||
fFirstName: TAttendeeFirstName;
|
||||
fRegistrationNumber: TAttendeeRegistrationNumber;
|
||||
public
|
||||
procedure CleanupName;
|
||||
published
|
||||
property RegistrationNumber: TAttendeeRegistrationNumber
|
||||
read fRegistrationNumber write fRegistrationNumber;
|
||||
property Name: TAttendeeName read fName write fName;
|
||||
property FirstName: TAttendeeFirstName read fFirstName write fFirstName;
|
||||
end;
|
||||
|
||||
TSessionDay = class;
|
||||
TSessionDays = array of TSessionDay;
|
||||
TSessionDay = class(TPersistent)
|
||||
private
|
||||
fDay: TSessionDate;
|
||||
public
|
||||
constructor Create(aDay: TSessionDate); overload; virtual;
|
||||
class function From(const Days: array of TSessionDate): TSessionDays;
|
||||
published
|
||||
property Day: TSessionDate read fDay write fDay;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TAttendee }
|
||||
|
||||
procedure TAttendee.CleanupName;
|
||||
begin
|
||||
fName := Trim(fName);
|
||||
fFirstName := Trim(fFirstName);
|
||||
end;
|
||||
|
||||
{ TSessionDay }
|
||||
|
||||
constructor TSessionDay.Create(aDay: TSessionDate);
|
||||
begin
|
||||
inherited Create;
|
||||
fDay := aDay;
|
||||
end;
|
||||
|
||||
class function TSessionDay.From(
|
||||
const Days: array of TSessionDate): TSessionDays;
|
||||
var
|
||||
i, n: integer;
|
||||
begin
|
||||
n := length(Days);
|
||||
SetLength(result, n);
|
||||
for i := 0 to n - 1 do
|
||||
result[i] := TSessionDay.Create(Days[i]);
|
||||
end;
|
||||
|
||||
initialization
|
||||
TJSONSerializer.RegisterObjArrayForJSON([
|
||||
TypeInfo(TSessionDays), TSessionDay]);
|
||||
end.
|
||||
@@ -0,0 +1,19 @@
|
||||
/// Conference Repository implementation
|
||||
unit InfraConferenceRepository;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Classes,
|
||||
SynCommons,
|
||||
mORMot,
|
||||
DomConferenceTypes,
|
||||
DomConferenceDepend;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
initialization
|
||||
// TDDDRepositoryRestFactory.ComputeSQLRecord(); from mORMotDDD
|
||||
end.
|
||||
@@ -0,0 +1,70 @@
|
||||
program ServBook;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
{$I SynDprUses.inc} // includes FastMM4
|
||||
SysUtils,
|
||||
SynLog,
|
||||
mORMot,
|
||||
SynSQLite3Static,
|
||||
mORMotSQLite3,
|
||||
mORMotService, // cross-platform service/daemon skeleton with settings
|
||||
// domain
|
||||
DomConferenceTypes in '..\dom\DomConferenceTypes.pas',
|
||||
DomConferenceInterfaces in '..\dom\DomConferenceInterfaces.pas',
|
||||
DomConferenceDepend in '..\dom\DomConferenceDepend.pas',
|
||||
DomConferenceServices in '..\dom\DomConferenceServices.pas',
|
||||
// infrastructure
|
||||
InfraConferenceRepository in '..\infra\InfraConferenceRepository.pas',
|
||||
// servers
|
||||
ServBookMain in '..\serv\ServBookMain.pas';
|
||||
|
||||
type
|
||||
TBookSettings = class(TSynDaemonSettings)
|
||||
private
|
||||
fProcess: TBookProcessSettings;
|
||||
public
|
||||
constructor Create; override;
|
||||
published
|
||||
property Process: TBookProcessSettings read fProcess;
|
||||
end;
|
||||
|
||||
TBookDaemon = class(TSynDaemon)
|
||||
protected
|
||||
fProcess: TBookProcess;
|
||||
public
|
||||
procedure Start; override;
|
||||
procedure Stop; override;
|
||||
end;
|
||||
|
||||
|
||||
{ TBookDaemon }
|
||||
|
||||
procedure TBookDaemon.Start;
|
||||
begin
|
||||
if fProcess = nil then
|
||||
fProcess := TBookProcess.Create((fSettings as TBookSettings).Process);
|
||||
end;
|
||||
|
||||
procedure TBookDaemon.Stop;
|
||||
begin
|
||||
FreeAndNil(fProcess);
|
||||
end;
|
||||
|
||||
{ TBookSettings }
|
||||
|
||||
constructor TBookSettings.Create;
|
||||
begin
|
||||
inherited;
|
||||
fServiceDisplayName := 'My Long Name for Service';
|
||||
end;
|
||||
|
||||
begin
|
||||
with TBookDaemon.Create(TBookSettings, '', '', '') do
|
||||
try
|
||||
CommandLine(true);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end.
|
||||
@@ -0,0 +1,40 @@
|
||||
/// Booking server implementation
|
||||
unit ServBookMain;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Classes,
|
||||
SynCommons,
|
||||
mORMot,
|
||||
DomConferenceTypes,
|
||||
DomConferenceInterfaces,
|
||||
DomConferenceServices,
|
||||
InfraConferenceRepository;
|
||||
|
||||
type
|
||||
TBookProcessSettings = class(TSynAutoCreateFields)
|
||||
published
|
||||
end;
|
||||
|
||||
TBookProcess = class(TSynPersistent)
|
||||
protected
|
||||
fSettings: TBookProcessSettings;
|
||||
public
|
||||
constructor Create(aSettings: TBookProcessSettings); reintroduce;
|
||||
property Settings: TBookProcessSettings read fSettings;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TBookProcess }
|
||||
|
||||
constructor TBookProcess.Create(aSettings: TBookProcessSettings);
|
||||
begin
|
||||
inherited Create;
|
||||
fSettings := aSettings;
|
||||
end;
|
||||
|
||||
initialization
|
||||
end.
|
||||
@@ -0,0 +1,46 @@
|
||||
/// unit tests for the Booking server
|
||||
unit ServBookTest;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Classes,
|
||||
SynCommons,
|
||||
SynTests,
|
||||
mORMot,
|
||||
DomConferenceTypes,
|
||||
DomConferenceInterfaces,
|
||||
DomConferenceServices,
|
||||
InfraConferenceRepository,
|
||||
ServBookMain;
|
||||
|
||||
type
|
||||
TTestBookingApplication = class(TSynTestCase)
|
||||
published
|
||||
procedure RunService;
|
||||
procedure ApplicationTest;
|
||||
procedure ShutdownService;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestBookingApplication }
|
||||
|
||||
procedure TTestBookingApplication.RunService;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestBookingApplication.ApplicationTest;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestBookingApplication.ShutdownService;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
end.
|
||||
@@ -0,0 +1,28 @@
|
||||
program TestAll;
|
||||
|
||||
uses
|
||||
{$I SynDprUses.inc} // cross-platform, cross-compiler (includes FastMM4)
|
||||
SynCommons, // shared types for the whole framework
|
||||
SynLog, // logging
|
||||
SynTests, // unitary tests
|
||||
mORMot, // ORM + SOA
|
||||
SynSQLite3Static, // statically linked SQLite3 engine
|
||||
mORMotSQLite3, // use SQlite3 as ORM core
|
||||
// domain
|
||||
DomConferenceTypes in '..\dom\DomConferenceTypes.pas',
|
||||
DomConferenceInterfaces in '..\dom\DomConferenceInterfaces.pas',
|
||||
DomConferenceDepend in '..\dom\DomConferenceDepend.pas',
|
||||
DomConferenceServices in '..\dom\DomConferenceServices.pas',
|
||||
DomConferenceTest in '..\dom\DomConferenceTest.pas',
|
||||
// infrastructure
|
||||
InfraConferenceRepository in '..\infra\InfraConferenceRepository.pas',
|
||||
// servers
|
||||
ServBookMain in '..\serv\ServBookMain.pas',
|
||||
ServBookTest in '..\serv\ServBookTest.pas',
|
||||
// tests
|
||||
TestAllMain in 'TestAllMain.pas';
|
||||
|
||||
begin
|
||||
TSynLogTestLog := TSQLLog; // share the same log file with the whole mORMot
|
||||
TTestEKON.RunAsConsole('EKON Automated Tests', LOG_VERBOSE);
|
||||
end.
|
||||
@@ -0,0 +1,38 @@
|
||||
unit TestAllMain;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SynCommons,
|
||||
SynTests,
|
||||
DomConferenceTest,
|
||||
ServBookTest;
|
||||
|
||||
type
|
||||
TTestEkon = class(TSynTestsLogged)
|
||||
published
|
||||
procedure Infrastructure;
|
||||
procedure Domain;
|
||||
procedure Applications;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestEkon }
|
||||
|
||||
procedure TTestEkon.Infrastructure;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestEkon.Domain;
|
||||
begin
|
||||
AddCase([TTestConference]);
|
||||
end;
|
||||
|
||||
procedure TTestEkon.Applications;
|
||||
begin
|
||||
AddCase([TTestBookingApplication]);
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user