fpc/packages/fcl-js/examples/parsefiles.pas

{ *********************************************************************
    This file is part of the Free Component Library (FCL)
    Copyright (c) 2021 Michael Van Canneyt.

    Javascript & typescript parser demo

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

  **********************************************************************}

program parsefiles;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, CustApp, Math, jsTree, jsScanner, jsParser;

type
  TCounts = Record
    Total,OK,Failed : Integer;
    Stop : Boolean;
  end;

  { TParseTSApplication }

  TParseTSApplication = class(TCustomApplication)
  private
    FTypescript : Boolean;
    FStopOnError : Boolean;
    function ParseFile(const aFileName: string): Boolean;
    function ParseFiles(const aDirectory: string; RecurseLevel : Integer): TCounts;
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure Usage(Msg : string); virtual;
  end;

{ TParseTSApplication }

procedure TParseTSApplication.DoRun;

var
  ErrorMsg: String;
  Directory : String;
  Counts : TCounts;

begin
  Terminate;
  ErrorMsg:=CheckOptions('hd:srt', ['help','directory','stop-on-error','recurse','typescript']);
  if (ErrorMsg<>'') or HasOption('h','help') then
    begin
    Usage(ErrorMsg);
    Exit;
    end;
  FTypescript:=HasOption('t','typescript');
  Directory:=GetOptionValue('d','directory');
  FStopOnError:=HasOption('s','stop-on-error');
  If Directory='' then
    Directory:=GetCurrentDir;
  Counts:=ParseFiles(Directory,Ord(HasOption('r','recurse')));
  With Counts do
    Writeln('Statistics: ',Total,' Total, ',OK,' OK, ',Failed, ' Failed');
end;

Function TParseTSApplication.ParseFile(const aFileName : string) : Boolean;

Var
  aFile : TStrings;
  P : TJSParser;
  S : TStringStream;
  el : TJSElement;
  I : Integer;
  EP : EJSParser;
  Prefix : String;

begin
  Result:=False;
  Writeln('Parsing: ',aFileName);
  Flush(output);
  el:=nil;
  S:=Nil;
  aFile:=TStringList.Create;
  try
    aFile.LoadFromFile(aFileName);
    S:=TStringStream.Create('');
    S.LoadFromFile(aFileName);
    P:=TJSParser.Create(S,ecma2021,FTypescript,aFileName);
    try
      El:=P.Parse;
      Result:=True;
    except
      On E : Exception do
        begin
        writeln('Error ',E.ClassName,' parsing file ',aFileName,' : ',E.Message);
        if E is EJSParser then
          begin
          Writeln('Offending lines : ');
          EP:=EJSParser(E);
          For I:=Max(1,EP.ErrorRow-1) to Min(aFile.Count,EP.ErrorRow+1) do
            begin
            Prefix:=IntToStr(I);
            Writeln(Prefix,' : ',aFile[I-1]);
            if I=EP.ErrorRow then
              Writeln(StringOfChar(' ',EP.ErrorCol-1),StringOfChar('-',Length(Prefix)+3),'^');
            end;
          end;
        end;
    end;
  finally
    el.Free;
    aFile.Free;
    S.Free;
  end;
end;

Function TParseTSApplication.ParseFiles(Const aDirectory : string; RecurseLevel : Integer) : TCounts;

Var
  Info : TSearchRec;
  Res: TCounts;
  Ext : string;
begin
  Result:=Default(TCounts);
  if FTypeScript then
    Ext:='*.d.ts'
  else
    Ext:='*.js';
  If FindFirst(aDirectory+Ext,0,Info)=0 then
    try
      Repeat
        Inc(Result.Total);
        if ParseFile(aDirectory+Info.Name) then
          Inc(Result.OK)
        else
          begin
          Inc(Result.Failed);
          if FStopOnError then
            Result.Stop:=True;
          end;
      until (FindNext(Info)<>0) or Result.Stop;
    Finally
      FindClose(Info)
    end;
  if RecurseLevel=0 then
    exit;
  If FindFirst(aDirectory+'*',faDirectory,Info)=0 then
    try
      Repeat
        if (Info.Attr and faDirectory)=faDirectory then
          begin
          Res:=ParseFiles(aDirectory+Info.Name+PathDelim,RecurseLevel-1);
          Result.Total:=Result.Total+Res.Total;
          Result.OK:=Result.OK+Res.OK;
          Result.Failed:=Result.Failed+Res.Failed;
          Result.Stop:=Result.Stop or Res.Stop
          end
      until (FindNext(Info)<>0) or Res.Stop;
    Finally
      FindClose(Info)
    end;
end;

constructor TParseTSApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;

destructor TParseTSApplication.Destroy;
begin
  inherited Destroy;
end;

procedure TParseTSApplication.Usage(Msg: string);
begin
  if Msg<>'' then
    Writeln('Error : ',Msg);
  writeln('Usage: ', ExeName, ' [options]');
  Writeln('Where options is one or mote of:');
  Writeln('-h --help           Display this help text');
  Writeln('-d --directory      Parse all files in directory');
  Writeln('-s --stop-on-error  Stop parsing files after an error');
  Writeln('-t --typescript     Assume typscript');

end;

var
  Application: TParseTSApplication;
begin
  Application:=TParseTSApplication.Create(nil);
  Application.Title:='My Application';
  Application.Run;
  Application.Free;
end.