Do you remember the discussion about a case statement for strings?

I got this flash idea after reading Jolyon Smith’s “The case for case[]”, and remembering a comment from Francisco Ruiz on Nick Hodges’ article on THTMLWriter which suggested using a default array property in a creative fashion.

Honestly, it is not really a true case statement, and it might not be as fast as an if then else, but here is how it looks when used. A bit ugly. but good fun 🙂

program TestGenericsSwitch;
{$apptype Console}
uses
  GenericsSwitch;
begin
  TStringSwitch.CaseOf('chARLie')
    ['Any', procedure begin
            Writeln('Definitively any case');
          end]
    ['B', procedure begin
            Writeln('B all you can B');
          end]
    ['Charlie', procedure begin
            Writeln('Checkpoint C');
          end]
    .ElseCase(procedure begin
            Writeln('Else what?');
          end)
    .EndCase;
end.

And here is how it is implemented.

unit GenericsSwitch;

/// Written by Lars Fosdal , December 1, 2010

interface
uses
  SysUtils, Generics.Collections;

type
  TSwitchProc = reference to procedure;
  TGenericSwitch = class(TObjectDictionary)
  private
    FTheElseCase: TSwitchProc;
    FTheTargetKey: KeyType;
    function AddSwitchCase(const name: KeyType; 
                           const value: TSwitchProc): TGenericSwitch;
    procedure SetTheElseCase(const Value: TSwitchProc);
    procedure SetTheTargetKey(const Value: KeyType);
  protected
    function ValidateKey(Key:KeyType):KeyType; virtual;
    property TheTargetKey:KeyType read FTheTargetKey write SetTheTargetKey;
    property TheElseCase:TSwitchProc read FTheElseCase write SetTheElseCase;
  public
    class function CaseOf(const Key: KeyType):TGenericSwitch;
    function ElseCase(const Action: TSwitchProc): TGenericSwitch;
    procedure EndCase;
    property Cases[const name:KeyType; const value:TSwitchProc]: TGenericSwitch
                  read AddSwitchCase; default;
  end;

  TStringSwitch = class(TGenericSwitch)
    function ValidateKey(key:String):String; override;
  end;

implementation

{ TGenericSwitch }

function TGenericSwitch.AddSwitchCase(const name: KeyType; const value: TSwitchProc): TGenericSwitch;
begin
  Result := Self;
  Add(ValidateKey(Name), Value);
end;

class function TGenericSwitch.CaseOf(const Key: KeyType): TGenericSwitch;
begin
  Result := Create;
  Result.TheTargetKey := Key;
end;

function TGenericSwitch.ElseCase(const Action: TSwitchProc): TGenericSwitch;
begin
  Result := Self;
  TheElseCase := Action;
end;

procedure TGenericSwitch.EndCase;
var
  DoIt : TSwitchProc;
begin
  if TryGetValue(TheTargetKey, DoIt)
  then DoIt
   else
   if Assigned(TheElseCase)
    then TheElseCase;
  Destroy;
end;

procedure TGenericSwitch.SetTheElseCase(const Value: TSwitchProc);
begin
  FTheElseCase := Value;
end;

procedure TGenericSwitch.SetTheTargetKey(const Value: KeyType);
begin
  FTheTargetKey := ValidateKey(Value);
end;

function TGenericSwitch.ValidateKey(Key: KeyType):KeyType;
begin
  Result := Key;
end;

{ TStringSwitch }

function TStringSwitch.ValidateKey(key: String): String;
begin
  Result := LowerCase(Key);
end;


end.