source upload

contrib/mORMot/SQLite3/Samples/35 - Practical DDD/05/dom/DomConferenceDepend.pas

@@ -0,0 +1,34 @@
+/// 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; const Days: TSessionDays;
+      out RegistrationNumber: TAttendeeRegistrationNumber): TBookingRepositoryError;
+    function RetrieveRegistration(const Name: TAttendeeName;
+      const FirstName: TAttendeeFirstName; out Days: TSessionDays;
+      out Attendee: TAttendee): boolean;
+  end;
+
+implementation
+
+initialization
+  TJSONSerializer.RegisterObjArrayForJSON([
+    ]);
+  TInterfaceFactory.RegisterInterfaces([
+    TypeInfo(IBookingRepository)
+    ]);
+end.

contrib/mORMot/SQLite3/Samples/35 - Practical DDD/05/dom/DomConferenceInterfaces.pas

@@ -0,0 +1,39 @@
+/// Conference Domain services interfaces definition
+unit DomConferenceInterfaces;
+
+interface
+
+uses
+  SysUtils,
+  Classes,
+  SynCommons,
+  mORMot,
+  DomConferenceTypes;
+
+{ Conference Domain Services }
+
+type
+  TRegisterAttendee = (raSuccess, raMissingField, raInvalidField,
+    raAlreadyRegistered, raPersistenceError);
+  TSearchRegistration = (srNotFound, srFound);
+
+  IConferenceBooking = interface(IInvokable)
+    ['{0A128982-38E3-406E-B7B4-7FE212552BBF}']
+    function RegisterAttendee(const Name: TAttendeeName;
+      const FirstName: TAttendeeFirstName; const Days: TSessionDays;
+      out Attendee: TAttendee): TRegisterAttendee;
+    function SearchRegistration(const Name: TAttendeeName;
+      const FirstName: TAttendeeFirstName; out Days: TSessionDays;
+      out Attendee: TAttendee): TSearchRegistration;
+  end;
+
+
+implementation
+
+initialization
+  TJSONSerializer.RegisterObjArrayForJSON([
+    ]);
+  TInterfaceFactory.RegisterInterfaces([
+    TypeInfo(IConferenceBooking)
+    ]);
+end.

contrib/mORMot/SQLite3/Samples/35 - Practical DDD/05/dom/DomConferenceServices.pas

@@ -0,0 +1,78 @@
+/// 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;
+      const FirstName: TAttendeeFirstName; const Days: TSessionDays;
+      out Attendee: TAttendee): TRegisterAttendee;
+    function SearchRegistration(const Name: TAttendeeName;
+      const FirstName: TAttendeeFirstName; out Days: TSessionDays;
+      out Attendee: TAttendee): TSearchRegistration;
+  end;
+
+implementation
+
+{ TConferenceBooking }
+
+constructor TConferenceBooking.Create(aRepository: IBookingRepository);
+begin
+  inherited Create;
+  fRepository := aRepository;
+end;
+
+function TConferenceBooking.RegisterAttendee(const Name: TAttendeeName;
+  const 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, Days, number);
+  result := RepoToDomain[res];
+  if result = raSuccess then
+    Attendee.RegistrationNumber := number;
+end;
+
+function TConferenceBooking.SearchRegistration(const Name: TAttendeeName;
+  const FirstName: TAttendeeFirstName; out Days: TSessionDays;
+  out Attendee: TAttendee): TSearchRegistration;
+begin
+ if fRepository.RetrieveRegistration(Trim(Name), Trim(FirstName), Days, Attendee) then
+   result := srFound
+ else
+   result := srNotFound;
+end;
+
+initialization
+end.

contrib/mORMot/SQLite3/Samples/35 - Practical DDD/05/dom/DomConferenceTest.pas

@@ -0,0 +1,91 @@
+/// 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;
+  a := TAttendee.Create;
+  try // IBookingRepository.RetrieveRegistration stub will return default false
+    check(book.SearchRegistration('abc', 'def', days, a) = srNotFound);
+  finally
+    a.Free;
+    ObjArrayClear(days);
+  end;
+end;
+
+initialization
+end.

contrib/mORMot/SQLite3/Samples/35 - Practical DDD/05/dom/DomConferenceTypes.pas

@@ -0,0 +1,81 @@
+/// 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.