YOUSEFUL / DELPHI / SAMPLE PROJECTS

Kanban model in a console

Console program Self-checking Product: Atlas UI · Components: TAtlasKanbanModel

A console program that uses TAtlasKanbanModel without any window, to show that the Kanban data model is independent of the board control. It:

builds a board of four columns, one of them with a work-in-progress limit of 2, and four cards, and counts the OnChange notifications;
shows that duplicate ids, a full column, a destination index out of range and an unknown card are all refused with EAtlasKanban, and that the board is unchanged afterwards;
moves cards with a BeforeMove rule (cards enter Done only from Review), shows a vetoed move returning False, reorders a card inside its column with an explicit index, and shows that the callback cannot change the board while a move is in progress;
saves the board with ToJSON, loads it into a second model, and shows that a wrong schema, text that is not JSON and a card without a detail field are refused without touching the existing board;
replaces a card to change its title (there is no rename), removes a card, and clears the board by loading an empty document.

Every step checks its own result. The program prints what it did and exits with code 0 when all checks pass, or prints the failed check and exits with code 1. It needs no input, files or network.

Build and run

Open KanbanModelConsole.dpr in Delphi 13; the IDE creates the project file. Add the Atlas UI src folder and the Atlas VCL src folder to the project's search path, then build and run for Win32 or Win64. No packages need to be installed. The program needs no input. It checks its own results and stops with an error if any of them differs from the output below.

Only Atlas.Kanban is used; the model itself needs no form, although the unit links the VCL because the board control lives in the same unit.

Expected output

Building the board
  To do (2)
    order-42: Prepare customer order
    invoice-7: Send invoice 7
  In progress (2/2)
    audit: Stock audit
    catalog: Update the catalog
  Review (0)
  Done (0)
  ok: four columns, two cards waiting
  ok: OnChange fired once per column and card
Validation
  ok: duplicate column id refused
  ok: duplicate card id refused
  ok: work limit refuses a third card
  ok: work limit refuses a move into a full column
  ok: destination index out of range
  ok: unknown card refused
  ok: refused operations leave the board unchanged
Moving cards
  ok: audit goes to review
  ok: BeforeMove cannot mutate the board
  ok: the freed slot accepts order-42
  ok: veto: catalog cannot skip review
  ok: vetoed card stays where it was
  ok: audit may finish from review
  ok: explicit index reorders inside a column
  ok: order-42 is first in progress
  ok: a move to the same place succeeds
  ok: only real moves fire OnChange
  To do (1)
    invoice-7: Send invoice 7
  In progress (2/2)
    order-42: Prepare customer order
    catalog: Update the catalog
  Review (0)
  Done (1)
    audit: Stock audit
JSON round trip
  {"schema":1,"columns":[{"id":"todo","title":"To do","limit":0,"cards":[{"id":"invoice-7","title":"Send invoice 7","detail":""}]},{"id":"active","title":"In progress","limit":2,"cards":[{"id":"order-42","title":"Prepare customer order","detail":"Pick, pack and label"},{"id":"catalog","title":"Update the catalog","detail":""}]},{"id":"review","title":"Review","limit":0,"cards":[]},{"id":"done","title":"Done","limit":0,"cards":[{"id":"audit","title":"Stock audit","detail":""}]}]}
  ok: a second model loads the same board
  ok: unknown schema refused
  ok: invalid text refused
  ok: a card without "detail" fails in the JSON reader
  ok: failed imports leave the board intact
Editing and clearing
  ok: the replacement goes back to the top
  ok: same id, new title and detail
  ok: removed card is gone
  ok: loading an empty document clears the board
All checks passed.

Six moves are attempted in "Moving cards" but only four fire OnChange: the vetoed move changes nothing, and the last move puts order-42 where it already is, which MoveCard reports as success without a notification. A missing JSON field raises the RTL's EJSONException rather than EAtlasKanban, so code that loads boards from files should catch both.

Adapting it

Replace TRules.BeforeMove with your own rule. It must only read the model: adding, removing or moving cards there raises EAtlasKanban (Cannot mutate the board during a move callback).
Save ToJSON to a file or a database column and restore it with LoadJSON; the text is plain UTF-16 in memory, so choose the encoding when you write it (UTF-8 is a good default).
To show the same model on screen, assign it to a TAtlasKanban board's Model; see the Kanban board sample.

Project files

Download all 34 projects

The ZIP contains every sample project with its README. See getting started for the search path to add.

Source

KanbanModelConsole.dpr

program KanbanModelConsole;

// Exercises TAtlasKanbanModel without a window: columns, cards, work limits,
// moves, a veto rule, change notifications and the JSON round trip.
// Every step verifies its own result; the exit code is 0 when all pass.

{$APPTYPE CONSOLE}

uses
  System.SysUtils, Atlas.Kanban;

type
  TRules = class
    Vetoes, Changes: Integer;
    ReentryRefused: Boolean;
    procedure BeforeMove(Sender: TObject; const CardID, FromColumn, ToColumn: string; var Allow: Boolean);
    procedure Changed(Sender: TObject);
  end;

// Cards may enter "done" only from "review". The callback also tries to
// mutate the board, which the model refuses while a move is in progress.
procedure TRules.BeforeMove(Sender: TObject; const CardID, FromColumn, ToColumn: string; var Allow: Boolean);
begin
  Allow := (ToColumn <> 'done') or (FromColumn = 'review');
  if not Allow then
    Inc(Vetoes);
  try
    TAtlasKanbanModel(Sender).RemoveCard(CardID);
  except
    on EAtlasKanban do
      ReentryRefused := True;
  end;
end;

procedure TRules.Changed(Sender: TObject);
begin
  Inc(Changes);
end;

procedure Check(Value: Boolean; const Message: string);
begin
  if not Value then
    raise Exception.Create('Check failed: ' + Message);
  Writeln('  ok: ', Message);
end;

// True when Action raises EAtlasKanban.
function Refused(const Action: TProc): Boolean;
begin
  Result := False;
  try
    Action;
  except
    on EAtlasKanban do
      Result := True;
  end;
end;

// The class name of the exception Action raises, or '' when it succeeds.
function ErrorClass(const Action: TProc): string;
begin
  Result := '';
  try
    Action;
  except
    on E: Exception do
      Result := E.ClassName;
  end;
end;

procedure PrintBoard(Model: TAtlasKanbanModel);
var
  C, I: Integer;
  Card: TAtlasKanbanCard;
begin
  for C := 0 to Model.ColumnCount - 1 do
  begin
    Write('  ', Model.ColumnTitle(C), ' (', Model.CardCount(C));
    if Model.ColumnLimit(C) > 0 then
      Write('/', Model.ColumnLimit(C));
    Writeln(')');
    for I := 0 to Model.CardCount(C) - 1 do
    begin
      Card := Model.Card(C, I);
      Writeln('    ', Card.ID, ': ', Card.Title);
    end;
  end;
end;

var
  Model, Copy: TAtlasKanbanModel;
  Rules: TRules;
  Before: string;
  Changes: Integer;

begin
  try
    Model := TAtlasKanbanModel.Create(nil);
    Copy := TAtlasKanbanModel.Create(nil);
    Rules := TRules.Create;
    try
      Model.BeforeMove := Rules.BeforeMove;
      Model.OnChange := Rules.Changed;

      Writeln('Building the board');
      Model.AddColumn('todo', 'To do');
      Model.AddColumn('active', 'In progress', 2);
      Model.AddColumn('review', 'Review');
      Model.AddColumn('done', 'Done');
      Model.AddCard('todo', 'order-42', 'Prepare customer order', 'Pick, pack and label');
      Model.AddCard('todo', 'invoice-7', 'Send invoice 7');
      Model.AddCard('active', 'audit', 'Stock audit');
      Model.AddCard('active', 'catalog', 'Update the catalog');
      PrintBoard(Model);
      Check((Model.ColumnCount = 4) and (Model.CardCount(0) = 2), 'four columns, two cards waiting');
      Check(Rules.Changes = 8, 'OnChange fired once per column and card');

      Writeln('Validation');
      Before := Model.ToJSON;
      Check(Refused(procedure begin Model.AddColumn('todo', 'Again'); end), 'duplicate column id refused');
      Check(Refused(procedure begin Model.AddCard('todo', 'audit', 'Duplicate'); end), 'duplicate card id refused');
      Check(Refused(procedure begin Model.AddCard('active', 'extra', 'Over the limit'); end), 'work limit refuses a third card');
      Check(Refused(procedure begin Model.MoveCard('order-42', 'active'); end), 'work limit refuses a move into a full column');
      Check(Refused(procedure begin Model.MoveCard('order-42', 'review', 5); end), 'destination index out of range');
      Check(Refused(procedure begin Model.RemoveCard('nobody'); end), 'unknown card refused');
      Check(Model.ToJSON = Before, 'refused operations leave the board unchanged');

      Writeln('Moving cards');
      Changes := Rules.Changes;
      Check(Model.MoveCard('audit', 'review'), 'audit goes to review');
      Check(Rules.ReentryRefused, 'BeforeMove cannot mutate the board');
      Check(Model.MoveCard('order-42', 'active'), 'the freed slot accepts order-42');
      Check(not Model.MoveCard('catalog', 'done'), 'veto: catalog cannot skip review');
      Check((Rules.Vetoes = 1) and (Model.Card(1, 0).ID = 'catalog'), 'vetoed card stays where it was');
      Check(Model.MoveCard('audit', 'done'), 'audit may finish from review');
      Check(Model.MoveCard('order-42', 'active', 0), 'explicit index reorders inside a column');
      Check((Model.Card(1, 0).ID = 'order-42') and (Model.Card(1, 1).ID = 'catalog'), 'order-42 is first in progress');
      Check(Model.MoveCard('order-42', 'active', 0), 'a move to the same place succeeds');
      Check(Rules.Changes = Changes + 4, 'only real moves fire OnChange');
      PrintBoard(Model);

      Writeln('JSON round trip');
      Before := Model.ToJSON;
      Writeln('  ', Before);
      Copy.LoadJSON(Before);
      Check(Copy.ToJSON = Before, 'a second model loads the same board');
      Check(Refused(procedure begin Model.LoadJSON('{"schema":2,"columns":[]}'); end), 'unknown schema refused');
      Check(Refused(procedure begin Model.LoadJSON('not json'); end), 'invalid text refused');
      Check(ErrorClass(procedure begin Model.LoadJSON('{"schema":1,"columns":[{"id":"x","title":"X","limit":0,' +
        '"cards":[{"id":"c","title":"C"}]}]}'); end) = 'EJSONException', 'a card without "detail" fails in the JSON reader');
      Check(Model.ToJSON = Before, 'failed imports leave the board intact');

      Writeln('Editing and clearing');
      // There is no rename: replace the card and put it back where it was.
      Model.RemoveCard('catalog');
      Model.AddCard('active', 'catalog', 'Update the autumn catalog', 'New prices');
      Check(Model.MoveCard('catalog', 'active', 0), 'the replacement goes back to the top');
      Check((Model.Card(1, 0).ID = 'catalog') and (Model.Card(1, 0).Detail = 'New prices'), 'same id, new title and detail');
      Model.RemoveCard('invoice-7');
      Check(Model.CardCount(0) = 0, 'removed card is gone');
      Model.LoadJSON('{"schema":1,"columns":[]}');
      Check(Model.ColumnCount = 0, 'loading an empty document clears the board');
      Writeln('All checks passed.');
    finally
      Rules.Free;
      Copy.Free;
      Model.Free;
    end;
  except
    on E: Exception do
    begin
      Writeln(E.ClassName, ': ', E.Message);
      Halt(1);
    end;
  end;
end.