unit Myc.Data.Types; interface uses System.Generics.Collections, System.SysUtils; type TDataKind = (dkOrdinal, dkFloat, dkText, dkTimestamp, dkRecord, dkTuple, dkArray); IDataType = interface function GetName: String; function GetKind: TDataKind; property Name: String read GetName; property Kind: TDataKind read GetKind; end; IDataValue = interface function GetDataType: IDataType; property DataType: IDataType read GetDataType; end; IDataOrdinalValue = interface(IDataValue) function GetValue: Int64; property Value: Int64 read GetValue; end; IDataOrdinalType = interface(IDataType) function CreateValue(Init: Int64): IDataOrdinalValue; end; IDataFloatValue = interface(IDataValue) function GetValue: Double; property Value: Double read GetValue; end; IDataFloatType = interface(IDataType) function CreateValue(Init: Double): IDataFloatValue; end; IDataTextValue = interface(IDataValue) function GetValue: string; property Value: string read GetValue; end; IDataTextType = interface(IDataType) function CreateValue(const AValue: string): IDataTextValue; end; IDataTimestampValue = interface(IDataValue) function GetValue: TDateTime; property Value: TDateTime read GetValue; end; IDataTimestampType = interface(IDataType) function CreateValue(const AValue: TDateTime): IDataTimestampValue; end; IDataRecordValue = interface(IDataValue) function GetItem(Idx: Integer): IDataValue; property Items[Idx: Integer]: IDataValue read GetItem; default; end; TRecordField = record Name: string; DataType: IDataType; constructor Create(const AName: string; const ADataType: IDataType); end; IDataRecordType = interface(IDataType) function GetFieldCount: Integer; function GetField(Idx: Integer): TRecordField; function IndexOf(const AName: string): Integer; function CreateValue(const AItems: array of IDataValue): IDataRecordValue; property FieldCount: Integer read GetFieldCount; property Fields[Idx: Integer]: TRecordField read GetField; default; end; IDataTupleValue = interface(IDataValue) function GetItemCount: Integer; function GetItem(Idx: Integer): IDataValue; property ItemCount: Integer read GetItemCount; property Items[Idx: Integer]: IDataValue read GetItem; default; end; IDataTupleType = interface(IDataType) function CreateValue(const AItems: array of IDataValue): IDataTupleValue; end; IDataArrayValue = interface(IDataValue) function GetElementCount: Integer; function GetItem(Idx: Integer): IDataValue; property ElementCount: Integer read GetElementCount; property Items[Idx: Integer]: IDataValue read GetItem; default; end; IDataArrayType = interface(IDataType) function GetElementType: IDataType; function CreateValue(const AItems: array of IDataValue): IDataArrayValue; property ElementType: IDataType read GetElementType; end; TDataType = record strict private FDataType: IDataType; function GetName: String; inline; class var FArrayTypeRegistry: TDictionary; class var FRecordTypeRegistry: TDictionary, IDataRecordType>; class constructor CreateClass; class destructor DestroyClass; public constructor Create(const ADataType: IDataType); class operator Implicit(const A: IDataType): TDataType; overload; class operator Implicit(const A: TDataType): IDataType; overload; // Type factories class function Ordinal: IDataOrdinalType; static; class function Float: IDataFloatType; static; class function Text: IDataTextType; static; class function Timestamp: IDataTimestampType; static; class function Tuple: IDataTupleType; static; class function ArrayOfType(const AElementType: IDataType): IDataArrayType; static; class function RecordOf(const Fields: TArray): IDataRecordType; overload; static; class function RecordOf(const Fields: array of TRecordField): IDataRecordType; overload; static; property DataType: IDataType read FDataType; property Name: String read GetName; end; TDataValue = record private FDataValue: IDataValue; function GetDataType: IDataType; inline; public constructor Create(const ADataValue: IDataValue); // Casting function AsOrdinal: IDataOrdinalValue; function AsFloat: IDataFloatValue; function AsText: IDataTextValue; function AsTimestamp: IDataTimestampValue; function AsRecord: IDataRecordValue; function AsTuple: IDataTupleValue; function AsArray: IDataArrayValue; class operator Implicit(const A: IDataValue): TDataValue; overload; class operator Implicit(const A: TDataValue): IDataValue; overload; // Value factories class function FromOrdinal(const AValue: Int64): IDataOrdinalValue; static; class function FromFloat(const AValue: Double): IDataFloatValue; static; class function FromText(const AValue: string): IDataTextValue; static; class function FromTimestamp(const AValue: TDateTime): IDataTimestampValue; static; class function FromTuple(const AItems: array of IDataValue): IDataTupleValue; static; property DataValue: IDataValue read FDataValue; property DataType: IDataType read GetDataType; end; implementation uses System.SyncObjs, System.Generics.Defaults, Myc.Data.Types.Ordinal, Myc.Data.Types.Float, Myc.Data.Types.Text, Myc.Data.Types.Timestamp, Myc.Data.Types.Arrays, Myc.Data.Types.Records, Myc.Data.Types.Tuple; { TRecordField } constructor TRecordField.Create(const AName: string; const ADataType: IDataType); begin Name := AName; DataType := ADataType; end; { TDataType } constructor TDataType.Create(const ADataType: IDataType); begin FDataType := ADataType; end; class constructor TDataType.CreateClass; begin FArrayTypeRegistry := TDictionary.Create; FRecordTypeRegistry := TDictionary, IDataRecordType>.Create(TRecordFieldComparer.Create); end; class destructor TDataType.DestroyClass; begin FArrayTypeRegistry.Free; FRecordTypeRegistry.Free; end; class function TDataType.ArrayOfType(const AElementType: IDataType): IDataArrayType; begin if not Assigned(AElementType) then raise EArgumentException.Create('Cannot create an array type with a nil element type.'); TMonitor.Enter(FArrayTypeRegistry); try if not FArrayTypeRegistry.TryGetValue(AElementType, Result) then begin Result := TImplDataArrayType.Create(AElementType); FArrayTypeRegistry.Add(AElementType, Result); end; finally TMonitor.Exit(FArrayTypeRegistry); end; end; class function TDataType.Float: IDataFloatType; begin Result := TImplDataFloatType.Singleton; end; function TDataType.GetName: String; begin if Assigned(FDataType) then Result := FDataType.Name else Result := ''; end; class function TDataType.Ordinal: IDataOrdinalType; begin Result := TImplDataOrdinalType.Singleton; end; class function TDataType.RecordOf(const Fields: TArray): IDataRecordType; begin TMonitor.Enter(FRecordTypeRegistry); try if not FRecordTypeRegistry.TryGetValue(Fields, Result) then begin Result := TImplDataRecordType.Create(Fields); FRecordTypeRegistry.Add(Fields, Result); end; finally TMonitor.Exit(FRecordTypeRegistry); end; end; class function TDataType.RecordOf(const Fields: array of TRecordField): IDataRecordType; var tFields: TArray; i: Integer; begin SetLength(tFields, Length(Fields)); for i := 0 to High(Fields) do tFields[i] := Fields[i]; Result := RecordOf(tFields); end; class function TDataType.Text: IDataTextType; begin Result := TImplDataTextType.Singleton; end; class function TDataType.Timestamp: IDataTimestampType; begin Result := TImplDataTimestampType.Singleton; end; class function TDataType.Tuple: IDataTupleType; begin Result := TImplDataTupleType.Singleton; end; class operator TDataType.Implicit(const A: TDataType): IDataType; begin Result := A.FDataType; end; class operator TDataType.Implicit(const A: IDataType): TDataType; begin Result.FDataType := A; end; { TDataValue } constructor TDataValue.Create(const ADataValue: IDataValue); begin FDataValue := ADataValue; end; function TDataValue.AsArray: IDataArrayValue; begin if FDataValue.DataType.Kind <> dkArray then raise EInvalidCast.Create('Array expected'); Result := IDataArrayValue(FDataValue); end; function TDataValue.AsFloat: IDataFloatValue; begin if FDataValue.DataType.Kind <> dkFloat then raise EInvalidCast.Create('Float expected'); Result := IDataFloatValue(FDataValue); end; function TDataValue.AsText: IDataTextValue; begin if FDataValue.DataType.Kind <> dkText then raise EInvalidCast.Create('Text expected'); Result := IDataTextValue(FDataValue); end; function TDataValue.AsTimestamp: IDataTimestampValue; begin if FDataValue.DataType.Kind <> dkTimestamp then raise EInvalidCast.Create('Timestamp expected'); Result := IDataTimestampValue(FDataValue); end; function TDataValue.AsOrdinal: IDataOrdinalValue; begin if FDataValue.DataType.Kind <> dkOrdinal then raise EInvalidCast.Create('Ordinal expected'); Result := IDataOrdinalValue(FDataValue); end; function TDataValue.AsRecord: IDataRecordValue; begin if FDataValue.DataType.Kind <> dkRecord then raise EInvalidCast.Create('Record expected'); Result := IDataRecordValue(FDataValue); end; function TDataValue.AsTuple: IDataTupleValue; begin if FDataValue.DataType.Kind <> dkTuple then raise EInvalidCast.Create('Tuple expected'); Result := IDataTupleValue(FDataValue); end; class function TDataValue.FromOrdinal(const AValue: Int64): IDataOrdinalValue; begin Result := TImplDataOrdinalType.Singleton.CreateValue(AValue); end; class function TDataValue.FromFloat(const AValue: Double): IDataFloatValue; begin Result := TImplDataFloatType.Singleton.CreateValue(AValue); end; class function TDataValue.FromText(const AValue: string): IDataTextValue; begin Result := TImplDataTextType.Singleton.CreateValue(AValue); end; class function TDataValue.FromTimestamp(const AValue: TDateTime): IDataTimestampValue; begin Result := TImplDataTimestampType.Singleton.CreateValue(AValue); end; class function TDataValue.FromTuple(const AItems: array of IDataValue): IDataTupleValue; begin Result := TImplDataTupleType.Singleton.CreateValue(AItems); end; function TDataValue.GetDataType: IDataType; begin if Assigned(FDataValue) then Result := FDataValue.DataType else Result := nil; end; class operator TDataValue.Implicit(const A: TDataValue): IDataValue; begin Result := A.FDataValue; end; class operator TDataValue.Implicit(const A: IDataValue): TDataValue; begin Result.FDataValue := A; end; end.