paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+TypeScript generation.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9600 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2025-01-23 18:13:16 +00:00
parent c8133ba5ee
commit bf962826cf
5 changed files with 920 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
wst/trunk/ws_helper/command_line_parser.pas
View File

@ -22,6 +22,7 @@ Type
TComandLineOption = (
cloInterface, cloProxy, cloImp, cloBinder, cloWsdl, cloXsd, cloJava,
cloTypeScript,
cloOutPutDirRelative, cloOutPutDirAbsolute, cloHandleWrappedParameters,
cloGenerateDocAsComments, cloGenerateObjectCollection,
cloFileRenaming, cloPrefixEnum, cloParserCaseSensitive,
@ -50,7 +51,7 @@ begin
AAppOptions := [];
c := #0;
repeat
c := GetOpt('u:pibo:a:wxydg:f:c:j');
c := GetOpt('u:pibo:a:wxydg:f:c:jt');
case c of
'u' :
begin
@ -100,7 +101,8 @@ begin
Include(AAppOptions,cloParserCaseSensitive);
OptionsArgsMAP[cloParserCaseSensitive] := OptArg;
end;
'j' : Include(AAppOptions,cloJava);
'j' : Include(AAppOptions,cloJava);
't' : Include(AAppOptions,cloTypeScript);
end;
until ( c = EndOfOptions );
Result := OptInd;

623
wst/trunk/ws_helper/generatorts.pas Normal file
View File

@ -0,0 +1,623 @@
{
This file is part of the Web Service Toolkit
Copyright (c) 2020 by Inoussa OUEDRAOGO
This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL).
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.
}
{$INCLUDE wst_global.inc}
unit generatorts;
interface
uses
Classes, SysUtils,
PasTree,
pascal_parser_intf, source_utils, wst_types, generatorbase;
type
{$SCOPEDENUMS ON}
TSimpleTypeItem = (Simple, Extendable);
TTypeScriptOption = (GenerateProxy);
TTypeScriptOptions = set of TTypeScriptOption;
{ TInftGenerator }
TInftGenerator = class(TBaseGenerator)
private
FStream : ISourceStream;
FOptionsEx : TTypeScriptOptions;
private
function GenerateIntfName(AIntf : TPasElement):string;
function GenerateTypeText(AType : TPasType; const AItem : TSimpleTypeItem = TSimpleTypeItem.Simple) : string;
procedure GenerateIntf(AIntf : TPasClassType);
procedure GenerateIntfProxy(AIntf : TPasClassType);
procedure GenerateClass(ASymbol : TPasClassType);
procedure GenerateEnum(ASymbol : TPasEnumType);
function GetDestUnitName():string;
procedure GenerateEnums();
procedure PrepareModule();
procedure InternalExecute();
public
procedure Execute();override;
property OptionsEx : TTypeScriptOptions read FOptionsEx write FOptionsEx;
end;
implementation
uses
contnrs,
parserutils, logger_intf;
const
TS_PROXY_BASE_CODE =
'type ReadOnlyUnknownArray = readonly unknown[];' + sLineBreak +
'' + sLineBreak +
'function buildCallData<T extends ReadOnlyUnknownArray>(aMethod : string, aArgs : T) : string {' + sLineBreak +
' return JSON.stringify({version: "1.1", method : aMethod, params : aArgs});' + sLineBreak +
'}' + sLineBreak +
'' + sLineBreak +
'export interface DataTransporter {' + sLineBreak +
' execute(' + sLineBreak +
' aUrl : string,' + sLineBreak +
' aData : string,' + sLineBreak +
' aCallback : (e? : Error, result? : string) => void' + sLineBreak +
' ) : void;' + sLineBreak +
'}' + sLineBreak +
'' + sLineBreak +
'export interface JsonRpcError {' + sLineBreak +
' name : string;' + sLineBreak +
' code : number;' + sLineBreak +
' message : string;' + sLineBreak +
'}' + sLineBreak +
'' + sLineBreak +
'interface JsonRpcEnv<T> {' + sLineBreak +
' version : string;' + sLineBreak +
' error : JsonRpcError;' + sLineBreak +
' result : T;' + sLineBreak +
'}' + sLineBreak +
'' + sLineBreak +
'function toJsonRpcError(e : Error) : JsonRpcError {' + sLineBreak +
' return {name: e.name, message: (e.message+(e.stack? ''\n''+e.stack:"")), code: 0};' + sLineBreak +
'}' + sLineBreak +
'' + sLineBreak +
'type JsonRpcProxyCallback<T> = (e? : JsonRpcError, r? : T) => void;' + sLineBreak +
'' + sLineBreak +
'export class JsonRpcProxyBase {' + sLineBreak +
' serviceUrl : string;' + sLineBreak +
' transporter : DataTransporter;' + sLineBreak +
'' + sLineBreak +
' constructor(aServiceUrl : string, aTransporter : DataTransporter){' + sLineBreak +
' this.serviceUrl = aServiceUrl;' + sLineBreak +
' this.transporter = aTransporter;' + sLineBreak +
' }' + sLineBreak +
'' + sLineBreak +
' executeRPC<T>(' + sLineBreak +
' aMethod : string,' + sLineBreak +
' aParams : ReadOnlyUnknownArray,' + sLineBreak +
' aCallback : JsonRpcProxyCallback<T>' + sLineBreak +
' ) : void' + sLineBreak +
' {' + sLineBreak +
' const requestBuffer = buildCallData(aMethod,aParams);' + sLineBreak +
' this.transporter.execute(this.serviceUrl, requestBuffer, (e,r) => {' + sLineBreak +
' if(e){' + sLineBreak +
' aCallback(toJsonRpcError(e));' + sLineBreak +
' return;' + sLineBreak +
' }' + sLineBreak +
' if(!r){' + sLineBreak +
' aCallback(toJsonRpcError(new Error("Empty response from network.")));' + sLineBreak +
' return;' + sLineBreak +
' }' + sLineBreak +
' let rt = JSON.parse(r!) as JsonRpcEnv<T>;' + sLineBreak +
' if(rt?.error?.message || rt?.error?.code){' + sLineBreak +
' aCallback(rt.error);' + sLineBreak +
' return;' + sLineBreak +
' }' + sLineBreak +
' aCallback(undefined,rt.result)' + sLineBreak +
' });' + sLineBreak +
' }' + sLineBreak +
'}' + sLineBreak +
'' + sLineBreak +
'export class XhrDataTransporter implements DataTransporter {' + sLineBreak +
' execute(' + sLineBreak +
' aUrl : string,' + sLineBreak +
' aData : string,' + sLineBreak +
' aCallback : (e? : Error, result? : string) => void' + sLineBreak +
' ) : void' + sLineBreak +
' {' + sLineBreak +
' let transport = new XMLHttpRequest();' + sLineBreak +
' transport.onreadystatechange = () => {' + sLineBreak +
' if(transport.readyState === XMLHttpRequest.DONE){' + sLineBreak +
' const status = transport.status;' + sLineBreak +
' if( (status === 0) || (status >= 200 && status <= 400) ){' + sLineBreak +
' aCallback(undefined,transport.responseText);' + sLineBreak +
' } else {' + sLineBreak +
' let e = new Error(transport.statusText);' + sLineBreak +
' e.name = status.toString();' + sLineBreak +
' aCallback(e)' + sLineBreak +
' }' + sLineBreak +
' };' + sLineBreak +
' }' + sLineBreak +
' transport.open("post",aUrl,true);' + sLineBreak +
' transport.setRequestHeader(''Content-Type'', ''application/json'');' + sLineBreak +
' transport.send(aData);' + sLineBreak +
' }' + sLineBreak +
'}';
{ TInftGenerator }
function TInftGenerator.GenerateIntfName(AIntf : TPasElement) : string;
begin
Result := AIntf.Name;
end;
function TInftGenerator.GenerateTypeText(AType : TPasType; const AItem : TSimpleTypeItem) : string;
var
t : TPasType;
begin
t := GetUltimeType(AType);
if not t.InheritsFrom(TPasArrayType) then begin
if (AItem = TSimpleTypeItem.Extendable) and
t.InheritsFrom(TPasNativeSimpleType) and
(TPasNativeSimpleType(t).ExtendableType <> nil)
then begin
t := TPasNativeSimpleType(t).ExtendableType;
end;
Result := SymbolTable.GetExternalName(t);
end else begin
t := GetUltimeType(TPasArrayType(t).ElType);
if t.InheritsFrom(TPasNativeSimpleType) and
Assigned(TPasNativeSimpleType(t).ExtendableType)
then begin
t := TPasNativeSimpleType(t).ExtendableType;
end;
Result := Format('Array<%s>',[SymbolTable.GetExternalName(t)]);
end;
end;
procedure TInftGenerator.GenerateIntf(AIntf : TPasClassType);
var
locName : string;
procedure WriteMethod(AMthd : TPasProcedure);
var
prmCnt,k : Integer;
prm : TPasArgument;
prms : TList2;
pt : TPasType;
s : string;
begin
Indent();
prms := AMthd.ProcType.Args;
prmCnt := prms.Count;
Write('%s(',[SymbolTable.GetExternalName(AMthd)]);
IncIndent();
if ( prmCnt > 0 ) then begin
for k := 0 to Pred(prmCnt) do begin
prm := TPasArgument(prms[k]);
NewLine();
Indent();
Write('%s : %s,',[prm.Name,GenerateTypeText(prm.ArgType)]);
end;
end;
if AMthd.InheritsFrom(TPasFunction) then begin
pt := TPasFunctionType(AMthd.ProcType).ResultEl.ResultType;
s := GenerateTypeText(pt);
end else begin
s := 'void';
end;
NewLine();
Indent();
WriteLn('aCallback : JsonRpcProxyCallback<%s>',[s]);
DecIndent();
Indent();
WriteLn(') : void;',[s]);
end;
procedure WriteMethods();
var
k, kc : Integer;
mbrs : TList2;
elt : TPasElement;
begin
IncIndent();
mbrs := AIntf.Members;
kc := 0;
for k := 0 to Pred(mbrs.Count) do begin
elt := TPasElement(mbrs[k]);
if elt.InheritsFrom(TPasProcedure) then begin
if (kc > 0) then
NewLine();
kc := kc+1;
WriteMethod(TPasProcedure(elt));
end;
end;
DecIndent();
end;
begin
NewLine();
locName := GenerateIntfName(AIntf);
WriteLn('export interface %s {',[locName]);
IncIndent();
WriteMethods();
DecIndent();
WriteLn('}');
end;
procedure TInftGenerator.GenerateIntfProxy(AIntf : TPasClassType);
var
locProxyName : string;
procedure WriteMethod(AMthd : TPasProcedure);
var
prmCnt,k : Integer;
prm : TPasArgument;
prms : TList2;
pt : TPasType;
callParams, s : string;
begin
Indent();
prms := AMthd.ProcType.Args;
prmCnt := prms.Count;
Write('%s(',[SymbolTable.GetExternalName(AMthd)]);
callParams := '';
IncIndent();
if ( prmCnt > 0 ) then begin
for k := 0 to Pred(prmCnt) do begin
prm := TPasArgument(prms[k]);
NewLine();
Indent();
Write('%s : %s,',[prm.Name,GenerateTypeText(prm.ArgType)]);
callParams := callParams + prm.Name + ',';
end;
Delete(callParams,Length(callParams),1);
end;
if AMthd.InheritsFrom(TPasFunction) then begin
pt := TPasFunctionType(AMthd.ProcType).ResultEl.ResultType;
s := GenerateTypeText(pt);
end else begin
s := 'void';
end;
NewLine();
Indent();
WriteLn('aCallback : JsonRpcProxyCallback<%s>',[s]);
DecIndent();
Indent();
WriteLn(') : void {',[s]);
IncIndent();
Indent();
WriteLn('this.executeRPC("%s",[%s],aCallback);',[SymbolTable.GetExternalName(AMthd),callParams]);
DecIndent();
Indent();
WriteLn('}',[s]);
end;
procedure WriteMethods();
var
k : Integer;
mbrs : TList2;
elt : TPasElement;
begin
IncIndent();
mbrs := AIntf.Members;
for k := 0 to Pred(mbrs.Count) do begin
elt := TPasElement(mbrs[k]);
if elt.InheritsFrom(TPasProcedure) then begin
NewLine();
WriteMethod(TPasProcedure(elt));
end;
end;
DecIndent();
end;
begin
locProxyName := ExtractserviceName(AIntf);
locProxyName := Format('%sProxy',[locProxyName]);
NewLine();
WriteLn('export class %s extends JsonRpcProxyBase implements %s {',[locProxyName,AIntf.Name]);
WriteMethods();
WriteLn('}');
end;
procedure TInftGenerator.GenerateClass(ASymbol : TPasClassType);
procedure WriteDec();
var
decBuffer, s : string;
elt : TPasElement;
trueAncestor : TPasType;
begin
s := '';
if Assigned(ASymbol.AncestorType) then begin
trueAncestor := ASymbol.AncestorType;
if trueAncestor.InheritsFrom(TPasUnresolvedTypeRef) then begin
elt := SymbolTable.FindElement(SymbolTable.GetExternalName(trueAncestor));
if (elt = nil) or (not elt.InheritsFrom(TPasType)) then
trueAncestor := nil
else
trueAncestor := TPasType(elt);
end;
if (trueAncestor <> nil) then begin
trueAncestor := GetUltimeType(trueAncestor);
if trueAncestor.InheritsFrom(TPasNativeSimpleType) and
Assigned(TPasNativeSimpleType(trueAncestor).ExtendableType)
then begin
trueAncestor := TPasNativeSimpleType(trueAncestor).ExtendableType;
end;
if not(trueAncestor.InheritsFrom(TPasNativeClassType)) or (trueAncestor.Name <> 'Object') then
s := Format('%s',[trueAncestor.Name]);
end;
end;
if IsStrEmpty(s) then
decBuffer := ''
else
decBuffer := Format(' extends %s',[s]);
Indent();
Write('export class %s%s {',[SymbolTable.GetExternalName(ASymbol),decBuffer]);
end;
procedure WriteProperty(AProp : TPasProperty; AActualPropType : TPasType);
var
locLine, locTypeStr, ks : string;
locType : TPasType;
locIsArray, locOptional : Boolean;
begin
locType := GetUltimeType(AActualPropType);
locTypeStr := GenerateTypeText(locType);
locIsArray := SymbolTable.IsOfType(locType,TPasArrayType);
if locIsArray then begin
locLine := Format('%s : %s = [];',[SymbolTable.GetExternalName(AProp),locTypeStr]);
end else begin
locLine := SymbolTable.GetExternalName(AProp);
locOptional := AnsiSameText(sWST_PROP_STORE_PREFIX,Copy(AProp.StoredAccessorName,1,Length(sWST_PROP_STORE_PREFIX)));
if locOptional then
locLine := locLine + '?';
locLine := locLine + ' : ' + locTypeStr;
if not locOptional then begin
if locType.InheritsFrom(TPasClassType) then
locLine := Format('%s = new %s()',[locLine,locTypeStr])
else if locType.InheritsFrom(TPasEnumType) then begin
if (TPasEnumType(locType).Values.Count > 0) then
ks := TPasEnumValue(TPasEnumType(locType).Values[0]).Name
else
ks := 'This Enum does not contain elements.';
locLine := Format('%s = %s.%s',[locLine,locTypeStr,ks]);
end else begin
locTypeStr := LowerCase(locTypeStr);
if (locTypeStr = 'boolean') then
locLine := Format('%s = false',[locLine])
else if (locTypeStr = 'number') then
locLine := Format('%s = 0',[locLine])
else if (locTypeStr = 'string') then
locLine := Format('%s = ""',[locLine])
end;
end;
locLine := locLine + ';'
end;
Indent(); WriteLn(locLine);
end;
procedure WriteProperties();
var
k : Integer;
p : TPasProperty;
elt : TPasElement;
begin
if (ASymbol.Members.Count > 0) then
WriteLn('');
Indent();
IncIndent();
for k := 0 to Pred(ASymbol.Members.Count) do begin
elt := TPasElement(ASymbol.Members[k]);
if elt.InheritsFrom(TPasProperty) then begin
p := TPasProperty(elt);
WriteProperty(p,FindActualType(p.VarType,SymbolTable));
end;
end;
DecIndent();
end;
begin
try
NewLine();
WriteDec();
WriteProperties();
WriteLn('}');
except
on e : Exception do begin
GetLogger.Log(mtError,'TInftGenerator.GenerateClass()=',[ASymbol.Name, ' ;; ', e.Message]);
raise;
end;
end;
end;
procedure TInftGenerator.GenerateEnum(ASymbol : TPasEnumType);
var
i : Integer;
itm : TPasEnumValue;
extName, s : string;
begin
NewLine();
extName := SymbolTable.GetExternalName(ASymbol);
WriteLn('export enum %s {',[extName]);
IncIndent();
for i := 0 to ASymbol.Values.Count-2 do begin
itm := TPasEnumValue(ASymbol.Values[i]);
s := SymbolTable.GetExternalName(itm);
Indent();
WriteLn('%s = "%s",',[s,s])
end;
i := ASymbol.Values.Count-1;
itm := TPasEnumValue(ASymbol.Values[i]);
s := SymbolTable.GetExternalName(itm);
Indent();
WriteLn('%s = "%s"',[s,s]);
DecIndent();
WriteLn('}'); ///const SexeOrdinals : Sexe[] = [Sexe.Inconnue, Sexe.Femme, Sexe.Homme];
WriteLn('export const %s_VALUES : %s[] = [',[extName,extName]);
IncIndent();
for i := 0 to ASymbol.Values.Count-2 do begin
itm := TPasEnumValue(ASymbol.Values[i]);
s := SymbolTable.GetExternalName(itm);
Indent();
WriteLn('%s.%s,',[extName,s]);
end;
i := ASymbol.Values.Count-1;
itm := TPasEnumValue(ASymbol.Values[i]);
s := SymbolTable.GetExternalName(itm);
Indent();
WriteLn('%s.%s,',[extName,s]);
DecIndent();
WriteLn(']');
end;
function TInftGenerator.GetDestUnitName(): string;
begin
Result := SymbolTable.CurrentModule.Name;
end;
procedure TInftGenerator.GenerateEnums();
var
typeList : TList2;
i, c : Integer;
elt : TPasElement;
begin
typeList := SymbolTable.CurrentModule.InterfaceSection.Declarations;
c := typeList.Count;
for i := 0 to c-1 do begin
elt := TPasElement(typeList[i]);
if elt.InheritsFrom(TPasEnumType) then
GenerateEnum(TPasEnumType(elt));
end;
end;
procedure TInftGenerator.PrepareModule();
var
s : string;
begin
s := GetDestUnitName() + '.ts';
FStream := SrcMngr.CreateItem(s);
SetCurrentStream(FStream);
WriteLn('/*');
WriteLn('This file has been produced by ws_helper.');
WriteLn(' Input unit name : "%s".',[SymbolTable.CurrentModule.Name]);
WriteLn(' This unit name : "%s".',[s]);
WriteLn(' Date : "%s".',[DateTimeToStr(Now())]);
WriteLn('*/');
end;
procedure TInftGenerator.InternalExecute();
var
i, c, j, k : Integer;
clssTyp : TPasClassType;
gnrClssLst : TObjectList;
objLst : TObjectList;
typeList : TList2;
elt : TPasElement;
classAncestor : TPasElement;
begin
GenerateEnums();
objLst := nil;
gnrClssLst := TObjectList.Create(False);
try
typeList := SymbolTable.CurrentModule.InterfaceSection.Declarations;
c := Pred(typeList.Count);
objLst := TObjectList.Create();
objLst.OwnsObjects := False;
for i := 0 to c do begin
elt := TPasElement(typeList[i]);
if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okClass ) then begin
clssTyp := TPasClassType(elt);
if ( gnrClssLst.IndexOf(clssTyp) = -1 ) then begin
objLst.Clear();
while Assigned(clssTyp) and ( objLst.IndexOf(clssTyp) = -1 ) do begin
objLst.Add(clssTyp);
classAncestor := clssTyp.AncestorType;
if Assigned(classAncestor) and classAncestor.InheritsFrom(TPasUnresolvedTypeRef) then begin
classAncestor := SymbolTable.FindElement(SymbolTable.GetExternalName(classAncestor));
end;
if Assigned(classAncestor) and classAncestor.InheritsFrom(TPasClassType) then begin
clssTyp := classAncestor as TPasClassType;
end else begin
clssTyp := nil;
end;
end;
k := Pred(objLst.Count);
for j := 0 to k do begin
clssTyp := objLst[k-j] as TPasClassType;
if (gnrClssLst.IndexOf(clssTyp) = -1) then begin
if (SymbolTable.CurrentModule.InterfaceSection.Declarations.IndexOf(clssTyp) <> -1) then begin
GenerateClass(clssTyp);
gnrClssLst.Add(clssTyp);
end;
end;
end;
end;
end;
end;
if (TTypeScriptOption.GenerateProxy in Self.OptionsEx) then begin
NewLine();
WriteLn(TS_PROXY_BASE_CODE);
end;
for i := 0 to c do begin
elt := TPasElement(typeList[i]);
if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okInterface ) then begin
GenerateIntf(TPasClassType(elt));
if (TTypeScriptOption.GenerateProxy in Self.OptionsEx) then
GenerateIntfProxy(TPasClassType(elt));
end;
end;
finally
FreeAndNil(objLst);
FreeAndNil(gnrClssLst);
end;
end;
procedure TInftGenerator.Execute();
var
oldCurrent, mdl : TPasModule;
i : Integer;
mdlList : TList2;
oldCS : Boolean;
oldNamesKinds : TElementNameKinds;
begin
oldCS := SymbolTable.CaseSensitive;
oldNamesKinds := SymbolTable.DefaultSearchNameKinds;
oldCurrent := SymbolTable.CurrentModule;
try
SymbolTable.CaseSensitive := True;
SymbolTable.DefaultSearchNameKinds := [elkDeclaredName];
mdlList := SymbolTable.Package.Modules;
for i := 0 to Pred(mdlList.Count) do begin
mdl := TPasModule(mdlList[i]);
if not mdl.InheritsFrom(TPasNativeModule) then begin
SymbolTable.SetCurrentModule(mdl);
PrepareModule();
InternalExecute();
end;
end;
finally
SymbolTable.SetCurrentModule(oldCurrent);
SymbolTable.CaseSensitive := oldCS;
SymbolTable.DefaultSearchNameKinds := oldNamesKinds;
end;
end;
end.

120
wst/trunk/ws_helper/pascal_parser_intf.pas
View File

@ -40,6 +40,8 @@ const
CASE_SENSITIVE_DEFAULT = True;
sBASE_SERVICE_INTF = 'base_service_intf';
{$IF not Declared(TInterfaceSection) }
type
TInterfaceSection = TPasSection;
@ -262,7 +264,8 @@ type
function MakeInternalSymbolNameFrom(const AName : string) : string ;
function CreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule;
function JavaCreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule;
function JavaCreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule;
function TypeScriptCreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule;
procedure CreateDefaultBindingForIntf(ATree : TwstPasTreeContainer);
implementation
@ -319,6 +322,13 @@ const
//('java.time.OffsetTime', '', 'time') ,
//('java.time.Duration', '', 'duration') ,
('java.math.BigDecimal', '', 'decimal')
);
// TYPESCRIPT
TYPESCRIPT_SIMPLE_TYPES_COUNT = 3;
TYPESCRIPT_SIMPLE_TYPES : Array[0..Pred(TYPESCRIPT_SIMPLE_TYPES_COUNT)] Of array[0..2] of string = (
('number', 'Number', ''),
('boolean', 'Boolean', ''),
('String', '', 'string')
);
@ -373,6 +383,57 @@ begin
end;
end;
procedure TypeScriptRegisterSimpleTypes(
ADest : TPasModule;
AContainer : TwstPasTreeContainer
);
var
i : Integer;
splTyp : TPasNativeSimpleType;
syb : TPasNativeSimpleContentClassType;
s : string;
typlst : array[0..Pred(TYPESCRIPT_SIMPLE_TYPES_COUNT)] of TPasNativeSimpleType;
begin
for i := Low(TYPESCRIPT_SIMPLE_TYPES) to High(TYPESCRIPT_SIMPLE_TYPES) do begin
splTyp := TPasNativeSimpleType(
AContainer.CreateElement(
TPasNativeSimpleType,TYPESCRIPT_SIMPLE_TYPES[i][0],
ADest.InterfaceSection,visPublic,'',0
)
);
ADest.InterfaceSection.Declarations.Add(splTyp);
ADest.InterfaceSection.Types.Add(splTyp);
typlst[i] := splTyp;
end;
for i := Low(TYPESCRIPT_SIMPLE_TYPES) to High(TYPESCRIPT_SIMPLE_TYPES) do begin
s := TYPESCRIPT_SIMPLE_TYPES[i][1];
if not IsStrEmpty(s) then begin
syb := AContainer.FindElementInModule(TYPESCRIPT_SIMPLE_TYPES[i][1],ADest)
as TPasNativeSimpleContentClassType;
if not Assigned(syb) then begin
syb := TPasNativeSimpleContentClassType(
AContainer.CreateElement(
TPasNativeSimpleContentClassType,s,
ADest.InterfaceSection,visDefault,'',0
)
);
ADest.InterfaceSection.Declarations.Add(syb);
ADest.InterfaceSection.Types.Add(syb);
end;
typlst[i].SetExtendableType(syb);
end;
end;
for i := Low(TYPESCRIPT_SIMPLE_TYPES) to High(TYPESCRIPT_SIMPLE_TYPES) do begin
splTyp := typlst[i];
if not IsStrEmpty(TYPESCRIPT_SIMPLE_TYPES[i][2]) then begin
AContainer.RegisterExternalAlias(splTyp,TYPESCRIPT_SIMPLE_TYPES[i][2]);
if ( splTyp.ExtendableType <> nil ) then begin
AContainer.RegisterExternalAlias(splTyp.ExtendableType,TYPESCRIPT_SIMPLE_TYPES[i][2]);
end;
end;
end;
end;
procedure AddSystemSymbol(
ADest : TPasModule;
AContainer : TwstPasTreeContainer;
@ -562,7 +623,7 @@ begin
locOldNameKinds := AContainer.DefaultSearchNameKinds;
AContainer.DefaultSearchNameKinds := [elkDeclaredName,elkName];
try
Result := TPasNativeModule(AContainer.CreateElement(TPasNativeModule,'base_service_intf',AContainer.Package,visPublic,'',0));
Result := TPasNativeModule(AContainer.CreateElement(TPasNativeModule,sBASE_SERVICE_INTF,AContainer.Package,visPublic,'',0));
try
AContainer.Package.Modules.Add(Result);
AContainer.RegisterExternalAlias(Result,sXSD_NS);
@ -593,6 +654,58 @@ begin
finally
AContainer.DefaultSearchNameKinds := locOldNameKinds;
end;
end;
function TypeScriptCreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule;
var
locOldNameKinds : TElementNameKinds;
begin
Result := AContainer.FindModule(sBASE_SERVICE_INTF);
if (Result <> nil) then
exit;
locOldNameKinds := AContainer.DefaultSearchNameKinds;
AContainer.DefaultSearchNameKinds := [elkDeclaredName,elkName];
try
Result := TPasNativeModule(AContainer.CreateElement(TPasNativeModule,sBASE_SERVICE_INTF,AContainer.Package,visPublic,'',0));
try
AContainer.Package.Modules.Add(Result);
AContainer.RegisterExternalAlias(Result,sXSD_NS);
Result.InterfaceSection := TInterfaceSection(AContainer.CreateElement(TInterfaceSection,'',Result,visDefault,'',0));
TypeScriptRegisterSimpleTypes(Result,AContainer);
AddClassDef(AContainer,Result,'Object','',TPasNativeClassType);
AddClassDef(AContainer,Result,'Date','',TPasNativeClassType);
AddAlias(AContainer,'TBaseComplexRemotable','Object',Result);
AddAlias(AContainer,'UnicodeString','string',Result);
AddAlias(AContainer,'token','string',Result);
AddAlias(AContainer,'language','string',Result);
AddAlias(AContainer,'anyURI','string',Result);
AddAlias(AContainer,'ID','string',Result);
AddAlias(AContainer,'base64Binary','string',Result);
AddAlias(AContainer,'hexBinary','string',Result);
AddAlias(AContainer,'byte','number',Result);
AddAlias(AContainer,'decimal','number',Result);
AddAlias(AContainer,'int','number',Result);
AddAlias(AContainer,'integer','number',Result);
AddAlias(AContainer,'long','number',Result);
AddAlias(AContainer,'negativeInteger','number',Result);
AddAlias(AContainer,'nonNegativeInteger','number',Result);
AddAlias(AContainer,'positiveInteger','number',Result);
AddAlias(AContainer,'nonPositiveInteger','number',Result);
AddAlias(AContainer,'short','number',Result);
AddAlias(AContainer,'unsignedInt','number',Result);
AddAlias(AContainer,'unsignedByte','number',Result);
AddAlias(AContainer,'unsignedShort','number',Result);
AddAlias(AContainer,'unsignedLong','number',Result);
AddAlias(AContainer,'Currency','number',Result);
AddAlias(AContainer,'date','string',Result);
AddAlias(AContainer,'dateTime','string',Result);
except
FreeAndNil(Result);
raise;
end;
finally
AContainer.DefaultSearchNameKinds := locOldNameKinds;
end;
end;
function CreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule;
@ -600,6 +713,9 @@ var
loc_TBaseComplexSimpleContentRemotable : TPasClassType;
locOldNameKinds : TElementNameKinds;
begin
Result := AContainer.FindModule(sBASE_SERVICE_INTF);
if (Result <> nil) then
exit;
locOldNameKinds := AContainer.DefaultSearchNameKinds;
AContainer.DefaultSearchNameKinds := [elkDeclaredName,elkName];
try

2
wst/trunk/ws_helper/ws_helper.pas
View File

@ -20,7 +20,7 @@ uses
Classes,
SysUtils,
wst_resources_utils,
generatorbase, generatorj, generator,
generatorbase, generatorj, generator, generatorts,
parserutils,
source_utils,
command_line_parser,

284
wst/trunk/ws_helper/ws_helper_prog.inc
View File

@ -35,25 +35,47 @@ resourcestring
' -c Indicate the parser''s case sensitivity : ' + sNEW_LINE +
' S : the paser is case sensitive' + sNEW_LINE +
' I : the paser is not case sensitive' + sNEW_LINE +
' -j Generate Java Language interface files for' + sNEW_LINE +
' -j Generate Java Language interface files for' + sNEW_LINE +
' -t Generate TypeScript Language interface files ' + sNEW_LINE +
' -f Specify unit(s) renaming option : oldName= NewName(;oldName= NewName)* ';
sCOPYRIGHT = 'ws_helper, Web Service Toolkit 0.7 Copyright (c) 2006-2017 by Inoussa OUEDRAOGO';
type
TSourceFileType = ( sftPascal, sftWSDL, sftXsd );
TExportLanguage = (exlgPascal, exlgWSDL, exlgXSD, exlgJava, exlgTypeScript);
TExportLanguages = set of TExportLanguage;
var
inFileName,outPath,errStr : string;
srcMngr : ISourceManager;
AppOptions : TComandLineOptions;
exportLanguages : TExportLanguages;
NextParam : Integer;
sourceType : TSourceFileType;
symtable : TwstPasTreeContainer;
parserMode : TParserMode;
osParam, targetParam : string;
function DetermineExportedLanguages(AAppOptions : TComandLineOptions) : TExportLanguages;
var
r : TExportLanguages;
begin
r := [];
if ([cloInterface, cloProxy, cloImp, cloBinder]*AAppOptions <> []) then
r := r + [exlgPascal];
if (cloWsdl in AAppOptions) then
r := r + [exlgWSDL];
if (cloXsd in AAppOptions) then
r := r + [exlgXSD];
if (cloJava in AAppOptions) then
r := r + [exlgJava];
if (cloTypeScript in AAppOptions) then
r := r + [exlgTypeScript];
if (r = []) then
r := r + [exlgPascal];
Result := r;
end;
function ProcessCmdLine():boolean;
begin
NextParam := ParseCmdLineOptions(AppOptions);
@ -110,15 +132,52 @@ var
if AnsiSameText('FN',Trim(GetOptionArg(cloCreateChoiceFields))) then
Exclude(AppOptions,cloCreateChoiceFields);
end;
exportLanguages := DetermineExportedLanguages(AppOptions);
end;
procedure Error(const AMsg : string);
begin
raise Exception.Create(AMsg);
end;
function GenerateSymbolTable() : Boolean ;
function CreateSymboleTable(const ALangage : TExportLanguage) : TwstPasTreeContainer;
var
tmpString : string;
begin
Result := TwstPasTreeContainer.Create();
try
Result.CaseSensitive :=
(ALangage in [exlgJava,exlgTypeScript]) or
(cloParserCaseSensitive in AppOptions);
if (ALangage = exlgJava) then
JavaCreateWstInterfaceSymbolTable(Result)
else if (ALangage = exlgTypeScript) then
TypeScriptCreateWstInterfaceSymbolTable(Result)
else if(ALangage = exlgPascal) then begin
if (cloStringMaping in AppOptions) then begin
tmpString := Trim(GetOptionArg(cloStringMaping));
tmpString := UpperCase(Copy(tmpString,2,Length(tmpString)));
if (tmpString = 'S') then
Result.XsdStringMaping := xsmString
else if (tmpString = 'U') then
Result.XsdStringMaping := xsmUnicodeString
else
Error('Invalid argument for "-gS" option: "' + tmpString + '".');
end;
end;
except
Result.Free();
raise;
end;
end;
function GenerateSymbolTable(ASymtable : TwstPasTreeContainer) : Boolean ;
procedure ParsePascalFile();
begin
ParseSource(symtable,inFileName,osParam,targetParam);
if ( symtable <> nil ) then
CreateDefaultBindingForIntf(symtable);
ParseSource(ASymtable,inFileName,osParam,targetParam);
if ( ASymtable <> nil ) then
CreateDefaultBindingForIntf(ASymtable);
end;
function GetParserSimpleOptions( ) : TParserOptions;
@ -140,7 +199,7 @@ var
{$IFNDEF WST_INTF_DOM}
try
{$ENDIF}
prsrW := TWsdlParser.Create(locDoc,symtable);// as IParser;
prsrW := TWsdlParser.Create(locDoc,ASymtable);// as IParser;
prsrCtx := prsrW as IParserContext;
prsrCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(ExpandFileName(inFileName))));
prsrCtx.SetSimpleOptions(GetParserSimpleOptions());
@ -164,7 +223,7 @@ var
{$IFNDEF WST_INTF_DOM}
try
{$ENDIF}
prsr := TXsdParser.Create(locDoc,symtable,ChangeFileExt(ExtractFileName(inFileName),'')) as IXsdPaser;
prsr := TXsdParser.Create(locDoc,ASymtable,ChangeFileExt(ExtractFileName(inFileName),'')) as IXsdPaser;
prsrCtx := prsr as IParserContext;
prsrCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(ExpandFileName(inFileName))));
prsrCtx.SetSimpleOptions(GetParserSimpleOptions());
@ -179,7 +238,7 @@ var
begin
try
WriteLn('Parsing the file : ', inFileName);
if symtable.CaseSensitive then
if ASymtable.CaseSensitive then
WriteLn('The parser is case sensitive');
case sourceType of
sftPascal : ParsePascalFile();
@ -225,7 +284,7 @@ var
end;
end;
procedure HandleUnitRenaming();
procedure HandleUnitRenaming(ASymtable : TwstPasTreeContainer);
var
namesSpecif, strBuffer, oldName, newName : string;
k : Integer;
@ -236,7 +295,7 @@ var
namesSpecif := Trim(GetOptionArg(cloFileRenaming));
Write('Handling unit renaming ... ');
WriteLn(namesSpecif);
mdlList := symtable.Package.Modules;
mdlList := ASymtable.Package.Modules;
strBuffer := namesSpecif;
while True do begin
oldName := GetToken(strBuffer,'=');
@ -271,8 +330,9 @@ var
end;
end;
function ProcessFile():Boolean;
Var
function GenerateForLangage(ASymtable : TwstPasTreeContainer; const ALanguage : TExportLanguage) : Boolean;
Var
srcMngr : ISourceManager;
mtdaFS: TMemoryStream;
g : TBaseGenerator;
mg : TMetadataGenerator;
@ -280,8 +340,9 @@ var
strStream : TStringStream;
wrappedParams : Boolean;
begin
Result := False;
HandleUnitRenaming();
Result := False;
srcMngr := CreateSourceManager();
HandleUnitRenaming(ASymtable);
wrappedParams := ( cloHandleWrappedParameters in AppOptions );
strStream := nil;
rsrcStrm := nil;
@ -290,84 +351,105 @@ var
g := Nil;
try
try
if ( cloInterface in AppOptions ) then begin
WriteLn('Interface file generation...');
g := TInftGenerator.Create(symtable,srcMngr);
if wrappedParams then
g.Options := g.Options + [goDocumentWrappedParameter];
if ( cloGenerateObjectCollection in AppOptions ) then
g.Options := g.Options + [goGenerateObjectCollection];
if ( cloCreateChoiceFields in AppOptions ) then
g.Options := g.Options + [goCreateChoiceFieldsInConstructor];
g.Execute();
FreeAndNil(g);
if (ALanguage = exlgPascal) then begin
if ( cloInterface in AppOptions ) then begin
WriteLn('Interface file generation...');
g := generator.TInftGenerator.Create(ASymtable,srcMngr);
if wrappedParams then
g.Options := g.Options + [goDocumentWrappedParameter];
if ( cloGenerateObjectCollection in AppOptions ) then
g.Options := g.Options + [goGenerateObjectCollection];
if ( cloCreateChoiceFields in AppOptions ) then
g.Options := g.Options + [goCreateChoiceFieldsInConstructor];
g.Execute();
FreeAndNil(g);
end;
If ( cloProxy in AppOptions ) Then Begin
WriteLn('Proxy file generation...');
g := generator.TProxyGenerator.Create(ASymtable,srcMngr);
if wrappedParams then
g.Options := g.Options + [goDocumentWrappedParameter];
g.Execute();
FreeAndNil(g);
End;
If ( cloBinder in AppOptions ) Then Begin
WriteLn('Binder file generation...');
g := generator.TBinderGenerator.Create(ASymtable,srcMngr);
if wrappedParams then
g.Options := g.Options + [goDocumentWrappedParameter];
g.Execute();
FreeAndNil(g);
End;
If ( cloImp in AppOptions ) Then Begin
WriteLn('Implementation file generation...');
g := generator.TImplementationGenerator.Create(ASymtable,srcMngr);
if wrappedParams then
g.Options := g.Options + [goDocumentWrappedParameter];
g.Execute();
FreeAndNil(g);
End;
if ( [cloBinder,cloProxy]*AppOptions <> [] ) then begin
WriteLn('Metadata file generation...');
mtdaFS := TMemoryStream.Create();
mg := TMetadataGenerator.Create(ASymtable,CreateBinaryWriter(mtdaFS));
mg.Execute();
//mtdaFS.SaveToFile(ChangeFileExt(inFileName,'.' + sWST_META));
rsrcStrm := TMemoryStream.Create();
mtdaFS.Position := 0;
BinToWstRessource(UpperCase(ASymtable.CurrentModule.Name),mtdaFS,rsrcStrm);
rsrcStrm.SaveToFile(outPath + ChangeFileExt(ExtractFileName(ASymtable.CurrentModule.Name),'.' + sWST_EXTENSION));
end;
end;
If ( cloProxy in AppOptions ) Then Begin
WriteLn('Proxy file generation...');
g := TProxyGenerator.Create(symtable,srcMngr);
if wrappedParams then
g.Options := g.Options + [goDocumentWrappedParameter];
g.Execute();
FreeAndNil(g);
End;
If ( cloBinder in AppOptions ) Then Begin
WriteLn('Binder file generation...');
g := TBinderGenerator.Create(symtable,srcMngr);
if wrappedParams then
g.Options := g.Options + [goDocumentWrappedParameter];
g.Execute();
FreeAndNil(g);
End;
If ( cloImp in AppOptions ) Then Begin
WriteLn('Implementation file generation...');
g := TImplementationGenerator.Create(symtable,srcMngr);
if wrappedParams then
g.Options := g.Options + [goDocumentWrappedParameter];
g.Execute();
FreeAndNil(g);
End;
if ( [cloBinder,cloProxy]*AppOptions <> [] ) then begin
WriteLn('Metadata file generation...');
mtdaFS := TMemoryStream.Create();
mg := TMetadataGenerator.Create(symtable,CreateBinaryWriter(mtdaFS));
mg.Execute();
//mtdaFS.SaveToFile(ChangeFileExt(inFileName,'.' + sWST_META));
rsrcStrm := TMemoryStream.Create();
mtdaFS.Position := 0;
BinToWstRessource(UpperCase(symtable.CurrentModule.Name),mtdaFS,rsrcStrm);
rsrcStrm.SaveToFile(outPath + ChangeFileExt(ExtractFileName(symtable.CurrentModule.Name),'.' + sWST_EXTENSION));
end;
if ( cloWsdl in AppOptions ) then begin
if (ALanguage = exlgWSDL) then begin
strStream := TStringStream.Create('');
GenerateWSDLFromTree(symtable,strStream);
GenerateWSDLFromTree(ASymtable,strStream);
if not IsStrEmpty(strStream.DataString) then begin
strStream.Position := 0;
srcMngr.CreateItem(ChangeFileExt(ExtractFileName(inFileName),'.wsdl')).Write(strStream.DataString);
end;
end;
if ( cloXsd in AppOptions ) then begin
if (ALanguage = exlgXSD) then begin
strStream := TStringStream.Create('');
GenerateXsdFromTree(symtable,strStream);
GenerateXsdFromTree(ASymtable,strStream);
if not IsStrEmpty(strStream.DataString) then begin
strStream.Position := 0;
srcMngr.CreateItem(ChangeFileExt(ExtractFileName(inFileName),'.xsd')).Write(strStream.DataString);
end;
end;
If ( cloJava in AppOptions ) Then Begin
if (ALanguage = exlgJava) then begin
WriteLn('Java file generation...');
g := generatorj.TInftGenerator.Create(symtable,srcMngr);
g := generatorj.TInftGenerator.Create(ASymtable,srcMngr);
//if wrappedParams then
//g.Options := g.Options + [goDocumentWrappedParameter];
g.Execute();
FreeAndNil(g);
End;
end;
if (ALanguage = exlgTypeScript) then begin
WriteLn('TypeScript file generation...');
g := generatorts.TInftGenerator.Create(ASymtable,srcMngr);
if (cloProxy in AppOptions) then begin
generatorts.TInftGenerator(g).OptionsEx :=
generatorts.TInftGenerator(g).OptionsEx +
[TTypeScriptOption.GenerateProxy];
end;
g.Execute();
FreeAndNil(g);
end;
srcMngr.SaveToFile(outPath);
if ( GetLogger().GetMessageCount(mtError) = 0 ) then begin
WriteLn(Format('File "%s" parsed succesfully.',[inFileName]));
end else begin
WriteLn(Format('Parsing complete with %d error(s).',[GetLogger().GetMessageCount(mtError)]));
end;
Result := True;
except
@ -385,13 +467,10 @@ var
end;
end;
procedure Error(const AMsg : string);
begin
raise Exception.Create(AMsg);
end;
var
tmpString : string;
symtable : TwstPasTreeContainer;
exportlanguage : TExportLanguage;
parserModeKeep : TParserMode;
begin
{$IFDEF FPC}
{$IF Declared(SetHeapTraceOutput) }
@ -402,8 +481,6 @@ begin
targetParam := 'x86';
SetLogger(TSimpleConsoleLogger.Create());
symtable := nil;
try
try
Writeln(sCOPYRIGHT);
@ -414,39 +491,26 @@ begin
if not ProcessCmdLine() then begin
Error(errStr);
end;
symtable := TwstPasTreeContainer.Create();
symtable.CaseSensitive := (([cloParserCaseSensitive,cloJava]*AppOptions) <>[]);
if (cloJava in AppOptions) then
JavaCreateWstInterfaceSymbolTable(symtable);
if (cloStringMaping in AppOptions) then begin
tmpString := Trim(GetOptionArg(cloStringMaping));
tmpString := UpperCase(Copy(tmpString,2,Length(tmpString)));
if (tmpString = 'S') then
symtable.XsdStringMaping := xsmString
else if (tmpString = 'U') then
symtable.XsdStringMaping := xsmUnicodeString
else
Error('Invalid argument for "-gS" option: "' + tmpString + '".');
end;
srcMngr := CreateSourceManager();
end;
if not GenerateSymbolTable() then begin
Error(errStr);
for exportlanguage := Low(TExportLanguage) to High(TExportLanguage) do begin
if (exportlanguage in exportLanguages) then begin
parserModeKeep := parserMode;
symtable := CreateSymboleTable(exportlanguage);
try
parserMode := pmAllTypes;
if not GenerateSymbolTable(symtable) then
Error(errStr);
if not GenerateForLangage(symtable,exportlanguage) then
Error(errStr);
finally
FreeAndNil(symtable);
parserMode := parserModeKeep;
end;
end;
end;
If Not ProcessFile() Then Begin
Error(errStr);
End;
srcMngr.SaveToFile(outPath);
if ( GetLogger().GetMessageCount(mtError) = 0 ) then begin
WriteLn(Format('File "%s" parsed succesfully.',[inFileName]));
end else begin
WriteLn(Format('Paring complete with %d error(s).',[GetLogger().GetMessageCount(mtError)]));
end;
finally
FreeAndNil(symtable);
SetLogger(nil);
end;
except