型指定可能な CSV ローダー

uTypedCSV.pas

(*
 * Typed CSV Loader
 *
 * PLATFORMS
 *   Windows / macOS / Android / iOS
 *
 * LICENSE
 *   Copyright (c) 2026 HOSOKAWA Jun
 *   Released under the MIT license
 *   http://opensource.org/licenses/mit-license.php
 *
 * NOTE
 *   This unit is intended as a simple example of modern Delphi features.
 *
 *   - Not fully RFC 4180 compliant
 *   - Multiline quoted fields are not supported
 *   - Designed for simple CSV files (one record per line)
 *   - Performance tuning may be required for large files
 *
 * USAGE
 *   STEP 1:
 *     Create a class that represents one CSV row.
 *
 *     type
 *       TPerson = class
 *       private
 *         FName: string;
 *         FAge: Integer;
 *       public
 *         [CsvColumn(0, ctString)]
 *         property Name: string read FName write FName;
 *
 *         [CsvColumn(1, ctInteger)]
 *         property Age: Integer read FAge write FAge;
 *       end;
 *
 *   STEP 2:
 *     Call Deserialize().
 *
 *     var People := TTypedCSVSerializer.Deserialize<TPerson>('people.csv');
 *
 *   STEP 3:
 *     Access the loaded objects.
 *
 *     for var Person in People do
 *       WriteLn(Person.Name);
 *
 * HISTROY
 *   2026/05/18 Version 1.0.0
 *
 * Programmed by HOSOKAWA Jun (twitter: @pik)
 *)

unit uTypedCSV;

interface

uses
  System.SysUtils
  , System.Classes
  , System.Generics.Collections
  ;

type
  TCsvColumnType = (
    ctString,
    ctInteger,
    ctFloat,
    ctBoolean,
    ctDate,
    ctDateTime
  );

  TCsvColumnTypeHelper = record helper for TCsvColumnType
  public
    function ToString: String;
  end;

  CsvColumnAttribute = class(TCustomAttribute)
  private var
    FNo: Integer;
    FColumnType: TCsvColumnType;
  public
    constructor Create(
      const ANo: Integer;
      const AColumnType: TCsvColumnType);

    property No: Integer read FNo;
    property ColumnType: TCsvColumnType read FColumnType;
  end;

  ECSVException = class(Exception)
  private const
    INDEX_OUT_OF_RANGE = '''
Line %d: Column index out of range
  "%s" specifies column %d
''';

    PARSE_ERROR = '''
Line %d, column %d: Parse error
  "%s": %s = "%s" is invalid
''';
  end;

  TTypedCSVSerializerInterupterFunc =
    reference to function(const ALine: String): String;

  TTypedCSVSerializer = class
  private const
    DEFAULT_DELIMITER = ',';
    DEFAULT_COMMENT_CHAR = '#';
    DOUBLE_QUOTE = '"';
  private class var
    FHasHeader: Boolean;
    FDelimiter: Char;
    FCommentChar: Char;
  public
    class function Deserialize<T: class, constructor>(
      const AFileName: string;
      const AEncoding: TEncoding = nil;
      const AFunc: TTypedCSVSerializerInterupterFunc = nil
    ): TArray<T>; static;

    class property HasHeader: Boolean read FHasHeader write FHasHeader;
    class property Delimiter: Char read FDelimiter write FDelimiter;
    class property CommentChar: Char read FCommentChar write FCommentChar;
  end;

implementation

uses
  System.TypInfo
  , System.DateUtils
  , System.Rtti
  , System.Threading
  ;

{ TCsvColumnTypeHelper }

function TCsvColumnTypeHelper.ToString: String;
begin
  // 先頭の ct を外した型名を返す
  Result := GetEnumName(TypeInfo(TCsvColumnType), Ord(Self)).Substring(2);
end;

{ CsvColumnAttribute }

constructor CsvColumnAttribute.Create(
  const ANo: Integer;
  const AColumnType: TCsvColumnType);
begin
  inherited Create;

  FNo := ANo;
  FColumnType := AColumnType;
end;

{ TTypedCSVSerializer }

class function TTypedCSVSerializer.Deserialize<T>(
  const AFileName: string;
  const AEncoding: TEncoding = nil;
  const AFunc: TTypedCSVSerializerInterupterFunc = nil): TArray<T>;
begin
  Result := [];

  var Lines := TStringList.Create;
  try
    Lines.LoadFromFile(
      AFileName,
      if AEncoding = nil then TEncoding.Default else AEncoding
    );

    var LineCount := Lines.Count;

    if LineCount = 0 then
      Exit;

    SetLength(Result, LineCount);
    var ResultIndex := 0;

    // FMX.Types に SharedContext が定義されています
    // FMX ならそちらを使うと若干の節約になります
    var Context := TRttiContext.Create;
    var RttiType := Context.GetType(TypeInfo(T));

    var AttrProp := TDictionary<CsvColumnAttribute, TRttiProperty>.Create;
    try
      for var Prop in RttiType.GetProperties do
      begin
        if not Prop.IsWritable then
          Continue;

        for var Attr in Prop.GetAttributes do
        begin
          if Attr is CsvColumnAttribute then
            AttrProp.Add(CsvColumnAttribute(Attr), Prop);
        end;
      end;

      for var LineNo := 0 to LineCount - 1 do
      begin
        var Line := Lines[LineNo];
        var TrimmedLine := Line.Trim;
        if TrimmedLine.IsEmpty or (TrimmedLine.StartsWith(FCommentChar)) then
          Continue;

        var Items :=
          (if Assigned(AFunc) then AFunc(Line) else Line)
          .Split([FDelimiter], DOUBLE_QUOTE);

        if Length(Items) < 1 then
          Continue;

        var Instance := T.Create;
        Result[ResultIndex] := Instance;
        Inc(ResultIndex);

        for var Dic in AttrProp do
        begin
          var Attr := Dic.Key;
          var Prop := Dic.Value;

          if Attr.No >= Length(Items) then
          begin
            raise ECSVException.CreateFmt(
              ECSVException.INDEX_OUT_OF_RANGE,
              [LineNo, Prop.Name, Attr.No]
            );
          end;

          var S := Items[Attr.No].Trim.DeQuotedString(DOUBLE_QUOTE);
          var V := TValue.Empty;

          try
            case Attr.ColumnType of
              TCsvColumnType.ctString:
                V := S;

              TCsvColumnType.ctInteger:
                V := S.ToInteger;

              TCsvColumnType.ctFloat:
                V := Single.Parse(S);

              TCsvColumnType.ctBoolean:
              begin
                var A := S.ToLower;
                V := A.Equals('1') or A.Equals('true') or A.Equals('yes');
              end;

              TCsvColumnType.ctDate:
                V := StrToDate(S);

              TCsvColumnType.ctDateTime:
                V := StrToDateTime(S);
            end;
          except
            on E: Exception do
              raise ECSVException.CreateFmt(
                ECSVException.PARSE_ERROR,
                [
                  LineNo,
                  Attr.No,
                  Prop.Name,
                  Attr.ColumnType.ToString,
                  S
                ]
              );
          end;

          Prop.SetValue(Pointer(Instance), V);
        end;
      end;
    finally
      AttrProp.Free;
    end;

    Setlength(Result, ResultIndex);
  finally
    Lines.Free;
  end;
end;

initialization
begin
  TTypedCSVSerializer.FHasHeader := True;
  TTypedCSVSerializer.FDelimiter := TTypedCSVSerializer.DEFAULT_DELIMITER;
  TTypedCSVSerializer.FCommentChar := TTypedCSVSerializer.DEFAULT_COMMENT_CHAR;
end;

end.