unit XData.XmlDoc.Builder;

interface

uses
  System.SysUtils, System.Types, System.StrUtils, System.Variants,
  Xml.XmlIntf,
  Xml.XmlDoc,
  XData.XmlDoc;

type
  TXmlDocBuilder = class
  strict private
    FInfo: TXmlDocInfo;
    FXmlFolder: string;
    procedure AddField(XmlClass: TXmlDocClass; Node: IXmlNode);
    procedure AddProperty(XmlClass: TXmlDocClass; Node: IXmlNode);
    procedure AddClass(XmlUnit: TXmlDocUnit; Node: IXmlNode);
    procedure AddInterface(XmlUnit: TXmlDocUnit; Node: IXmlNode);
    procedure AddMethod(XmlIntf: TXmlDocInterface; Node: IXmlNode);
    procedure AddDevNotes(Notes: TXmlDocNotes; Node: IXmlNode);
    procedure LoadUnit(XmlUnit: TXmlDocUnit; Nodes: IXmlNodeList);
    function NodeContent(Node: IXmlNode): string;
  protected
    property Info: TXmlDocInfo read FInfo;
    property XmlFolder: string read FXmlFolder;
  public
    constructor Create(const AXmlFolder: string; AInfo: TXmlDocInfo);
    function AddUnit(const AName: string): TXmlDocUnit;
  end;

implementation

uses
  System.IOUtils;

{ TXmlDocBuilder }

procedure TXmlDocBuilder.AddClass(XmlUnit: TXmlDocUnit; Node: IXmlNode);
var
  Clazz: TXmlDocClass;
  ChildNode: IXmlNode;
  I: Integer;
begin
  if Node = nil then Exit;

  Clazz := TXmlDocClass.Create;
  XmlUnit.Classes.Add(Clazz);
  Clazz.Name := VarToStr(Node.Attributes['name']);
  AddDevNotes(Clazz.Notes, Node);
  if Node.ChildNodes = nil then Exit;
  Node := Node.ChildNodes.FindNode('members');
  if Node = nil then Exit;
  if Node.ChildNodes = nil then Exit;

  for I := 0 to Node.ChildNodes.Count - 1 do
  begin
    ChildNode := Node.ChildNodes[I];
    if ChildNode.LocalName = 'field' then
      AddField(Clazz, ChildNode);
    if ChildNode.LocalName = 'property' then
      AddProperty(Clazz, ChildNode);
  end;
end;

procedure TXmlDocBuilder.AddDevNotes(Notes: TXmlDocNotes; Node: IXmlNode);
var
  ChildNode: IXmlNode;
  I: Integer;
  DefaultSummary: string;
begin
  if (Node = nil) or (Node.ChildNodes = nil) then Exit;
  Node := Node.ChildNodes.FindNode('devnotes');
  if (Node = nil) or (Node.ChildNodes = nil) then Exit;

  DefaultSummary := '';
  for I := 0 to Node.ChildNodes.Count - 1 do
  begin
    ChildNode := Node.ChildNodes[I];
    if ChildNode.LocalName = 'summary' then
      Notes.Summary := NodeContent(ChildNode)
    else
    if ChildNode.LocalName = 'remarks' then
      Notes.Remarks := NodeContent(ChildNode)
    else
    if ChildNode.LocalName = 'param' then
      Notes.Params.Add(TXmlDocNotesItem.Create(
        VarToStr(ChildNode.Attributes['name']), NodeContent(ChildNode)))
    else
    if ChildNode.LocalName = 'swagger' then
      Notes.SwaggerItems.Add(TXmlDocNotesItem.Create(
        VarToStr(ChildNode.Attributes['name']), NodeContent(ChildNode)))
    else
    if (DefaultSummary = '') and {(ChildNode.LocalName = '') and}
      (ChildNode.IsTextElement or (ChildNode.NodeType = TNodeType.ntText)) then
      DefaultSummary := NodeContent(ChildNode);
  end;
  if Notes.Summary = '' then
    Notes.Summary := DefaultSummary;
end;

procedure TXmlDocBuilder.AddField(XmlClass: TXmlDocClass; Node: IXmlNode);
var
  Member: TXmlDocMember;
begin
  if Node = nil then Exit;

  Member := TXmlDocMember.Create;
  XmlClass.Members.Add(Member);
  Member.Name := VarToStr(Node.Attributes['name']);
  AddDevNotes(Member.Notes, Node);
end;

procedure TXmlDocBuilder.AddInterface(XmlUnit: TXmlDocUnit; Node: IXmlNode);
var
  Intf: TXmlDocInterface;
  ChildNode: IXmlNode;
  I: Integer;
begin
  if Node = nil then Exit;

  Intf := TXmlDocInterface.Create;
  XmlUnit.Interfaces.Add(Intf);
  Intf.Name := VarToStr(Node.Attributes['name']);
  AddDevNotes(Intf.Notes, Node);
  if Node.ChildNodes = nil then Exit;
  for I := 0 to Node.ChildNodes.Count - 1 do
  begin
    ChildNode := Node.ChildNodes[I];
    if ChildNode.LocalName = 'function' then
      AddMethod(Intf, ChildNode);
    if ChildNode.LocalName = 'procedure' then
      AddMethod(Intf, ChildNode);
  end;
end;

procedure TXmlDocBuilder.AddMethod(XmlIntf: TXmlDocInterface; Node: IXmlNode);
var
  Meth: TXmlDocMethod;
begin
  if Node = nil then Exit;

  Meth := TXmlDocMethod.Create;
  XmlIntf.Methods.Add(Meth);
  Meth.Name := VarToStr(Node.Attributes['name']);
  AddDevNotes(Meth.Notes, Node);
end;

procedure TXmlDocBuilder.AddProperty(XmlClass: TXmlDocClass; Node: IXmlNode);
var
  Member: TXmlDocMember;
begin
  if Node = nil then Exit;

  Member := TXmlDocMember.Create;
  XmlClass.Members.Add(Member);
  Member.Name := VarToStr(Node.Attributes['name']);
  AddDevNotes(Member.Notes, Node);
end;

function TXmlDocBuilder.AddUnit(const AName: string): TXmlDocUnit;
var
  Doc: IXmlDocument;
  FileName: string;
  NamespaceNode: IXmlNode;
begin
  Result := Info.UnitByName(AName);
  if Result <> nil then Exit;
  Result := TXmlDocUnit.Create;
  Info.Units.Add(Result);
  Result.Name := AName;

  FileName := TPath.Combine(XmlFolder, AName + '.xml');
  if not FileExists(FileName) then Exit;
  Doc := LoadXMLDocument(FileName);
  if (Doc.Node = nil) or (Doc.Node.ChildNodes = nil) then
    Exit;
  NamespaceNode := Doc.Node.ChildNodes.FindNode('namespace');
  if (NamespaceNode = nil) or (NamespaceNode.ChildNodes = nil) then
    Exit;
  LoadUnit(Result, NamespaceNode.ChildNodes);
end;

constructor TXmlDocBuilder.Create(const AXmlFolder: string; AInfo: TXmlDocInfo);
begin
  inherited Create;
  FXmlFolder := AXmlFolder;
  if FXmlFolder = '' then
    FXmlFolder := ExtractFilePath(ParamStr(0));
  FInfo := AInfo;
end;

procedure TXmlDocBuilder.LoadUnit(XmlUnit: TXmlDocUnit; Nodes: IXmlNodeList);
var
  I: Integer;
  Node: IXmlNode;
begin
  for I := 0 to Nodes.Count - 1 do
  begin
    Node := Nodes[I];
    if Node.LocalName = 'interface' then
      AddInterface(XmlUnit, Node)
    else
    if Node.LocalName = 'class' then
      AddClass(XmlUnit, Node);
  end;
end;

function TXmlDocBuilder.NodeContent(Node: IXmlNode): string;

  function SkipBom(const S: string): string;
  begin
    // workaround for adomxmldom which includs BOM ($FEFF) in beginning of string
    if (Length(S) > 0) and (Ord(S[1]) = $FEFF) then
      Result := Copy(S, 2)
    else
      Result := S;
  end;

var
  I: Integer;
  Lines: TStringDynArray;
  MinSpace: Integer;
  Line: string;
  Len: Integer;
  P: Integer;
begin
  Result := '';
  if Node = nil then Exit;

  if Node.ChildNodes.Count > 0 then
  begin
    for I := 0 to Node.ChildNodes.Count - 1 do
      Result := Result + SkipBOM(Node.ChildNodes[I].XML);
  end
  else
    Result := SkipBOM(Node.Text);

  // normalize trailing spaces
  Lines := SplitString(Result, #10);
  MinSpace := MaxInt;
  for Line in Lines do
    if Trim(Line) <> '' then
    begin
      Len := Length(Line);
      P := 1;
      while (P <= Len) and (Line[P] <= ' ') do
        Inc(P);
      if P < MinSpace then
        MinSpace := P;
    end;

  // Remove empty leading lines
  I := 0;
  while (I < Length(Lines)) and (Trim(Lines[I]) = '') do
    Inc(I);
  Lines := Copy(Lines, I);

  // Rebuild the text removing the common trailing spaces
  Result := '';
  for Line in Lines do
    if Trim(Line) = '' then
      Result := Result + #13#10
    else
      Result := Result + Copy(Line, MinSpace) + #10;
  Result := Trim(Result);
end;

end.
