MycLib/Src/Data/Myc.Data.Types.Method.pas

unit Myc.Data.Types.Method;

interface

uses
    System.SysUtils,
    System.Rtti,
    Myc.Data.Types;

type
    // Implements the IDataMethodType interface.
    // This class is now instantiated for each unique method signature.
    TDataMethodType = class(TInterfacedObject, IDataMethodType)
    private
        FArgType: IDataType;
        FResultType: IDataType;
        function GetName: String;
        function GetKind: TDataKind;
        function GetArgType: IDataType;
        function GetResultType: IDataType;
        function CreateValue(const AValue: TMethodProc): IDataMethodValue;
    public
        // The constructor now takes the signature types.
        constructor Create(const AArgType, AResultType: IDataType);
    end;

implementation

uses
    System.Classes;

type
    // Implements the IDataMethodValue interface.
    TDataMethodValue = class(TInterfacedObject, IDataMethodValue)
    private
        FDataType: IDataMethodType;
        FValue: TMethodProc;
        function GetDataType: IDataType;
        function GetAsString: string;
        function AsTValue: TValue;
        function GetValue: TMethodProc;
    public
        constructor Create(const ADataType: IDataMethodType; const AValue: TMethodProc);
    end;

{ TDataMethodType }

constructor TDataMethodType.Create(const AArgType, AResultType: IDataType);
begin
    inherited Create;
    FArgType := AArgType;
    FResultType := AResultType;
end;

function TDataMethodType.CreateValue(const AValue: TMethodProc): IDataMethodValue;
begin
    if not Assigned(AValue) then
        raise EArgumentException.Create('AValue');

    // Pass Self to the value's constructor, so it knows its exact type
    Result := TDataMethodValue.Create(Self, AValue);
end;

function TDataMethodType.GetArgType: IDataType;
begin
    Result := FArgType;
end;

function TDataMethodType.GetResultType: IDataType;
begin
    Result := FResultType;
end;

function TDataMethodType.GetKind: TDataKind;
begin
    Result := dkMethod;
end;

function TDataMethodType.GetName: String;
var
    sb: TStringBuilder;
    argName, resultName: string;
begin
    if Assigned(FArgType) then
        argName := FArgType.Name
    else
        argName := 'Void';

    if Assigned(FResultType) then
        resultName := FResultType.Name
    else
        resultName := 'Void';

    sb := TStringBuilder.Create;
    try
        sb.Append('Method<');
        sb.Append(argName);
        sb.Append(' -> ');
        sb.Append(resultName);
        sb.Append('>');
        Result := sb.ToString;
    finally
        sb.Free;
    end;
end;

{ TDataMethodValue }

constructor TDataMethodValue.Create(const ADataType: IDataMethodType; const AValue: TMethodProc);
begin
    inherited Create;
    FDataType := ADataType;
    FValue := AValue;
end;

function TDataMethodValue.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TDataMethodValue.GetAsString: string;
begin
    Result := '<METHOD>';
end;

function TDataMethodValue.AsTValue: TValue;
begin
    Result := TValue.From<TMethodProc>(FValue);
end;

function TDataMethodValue.GetValue: TMethodProc;
begin
    Result := FValue;
end;

end.