/// generate cross-platform clients code and documentation from a mORMot server
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit mORMotWrappers;

{
    This file is part of Synopse mORMot framework.

    Synopse mORMot framework. Copyright (c) Arnaud Bouchez
      Synopse Informatique - https://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse mORMot framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (c)
  the Initial Developer. All Rights Reserved.

  Contributor(s) (for this unit and the .mustache templates):
  - EMartin
  - Sabbiolina
  - Sevo
  - Stefan Diestelmann


  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

}

{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER

interface

uses
  {$ifdef ISDELPHIXE2}System.SysUtils,{$else}SysUtils,{$endif}
  Classes,
  Contnrs,
  Variants,
  SynCommons,
  SynTable,
  mORMot,
  SynLZ,
  SynMustache;

/// compute the Model information, ready to be exported as JSON
// - will publish the ORM and SOA properties
// - to be used e.g. for client code generation via Mustache templates
// - optional aSourcePath parameter may be used to retrieve additional description
// from the comments of the source code of the unit - this text content may
// also be injected by WRAPPER_RESOURCENAME
// - you may specify a description file (as generated by FillDescriptionFromSource)
function ContextFromModel(aServer: TSQLRestServer;
  const aSourcePath: TFileName=''; const aDescriptions: TFileName=''): variant;

/// compute the information of an interface method, ready to be exported as JSON
// - to be used e.g. for the implementation of the MVC controller via interfaces
// - no description text will be included - use ContextFromModel() if needed
function ContextFromMethod(const method: TServiceMethod): variant;

/// compute the information of an interface, ready to be exported as JSON
// - to be used e.g. for the implementation of the MVC controller via interfaces
// - no description text will be included - use ContextFromModel() if needed
function ContextFromMethods(int: TInterfaceFactory): variant;

/// generate a code/doc wrapper for a given Model and Mustache template content
// - will use all ORM and SOA properties of the supplied server
// - aFileName will be transmitted as {{filename}}, e.g. 'mORMotClient'
// - you should also specify a "fake" HTTP port e.g. 888
// - the template content could be retrieved from a file via StringFromFile()
// - you may optionally retrieve a copy of the data context as TDocVariant
// - this function may be used to generate the client at build time, directly
// from a just built server, in an automated manner
// - you may specify custom helpers (e.g. via TSynMustache.HelpersGetStandardList)
// and retrieve the generated data context after generation (if aContext is
// a TDocVariant object, its fields would be added to the rendering context),
// or a custom description file (as generated by FillDescriptionFromSource)
function WrapperFromModel(aServer: TSQLRestServer;
  const aMustacheTemplate, aFileName: RawUTF8; aPort: integer;
  aHelpers: TSynMustacheHelpers=nil; aContext: PVariant=nil;
  const aDescriptions: TFileName=''): RawUTF8;

/// generate a code/doc wrapper for a given set of types and Mustache template content
// - will use aTables[] to define the ORM information, and supplied aSharedServices[]
// aSharedServicesContract[] for SOA definition of a shared API (expected to
// be called from TSQLRestClientURI.ServiceDefineSharedAPI)
// - aFileName will be transmitted as {{filename}}, e.g. 'mORMotClient'
// - you should also specify a "fake" HTTP port e.g. 888
// - the template content could be retrieved from a file via StringFromFile()
// - you may optionally retrieve a copy of the data context as TDocVariant
// - this function may be used to generate the client at build time, directly
// from a just built server, in an automated manner
// - you may specify custom helpers (e.g. via TSynMustache.HelpersGetStandardList)
// and retrieve the generated data context after generation (if aContext is
// a TDocVariant object, its fields would be added to the rendering context),
// or a custom description file (as generated by FillDescriptionFromSource)
function WrapperForPublicAPI(const aTables: array of TSQLRecordClass;
  const aRoot, aMustacheTemplate, aFileName: RawUTF8; const aSharedServices: array of TGUID;
  const aSharedServicesContract: array of RawUTF8; aResultAsJSONObjectWithoutResult: boolean;
  aPort: integer; aHelpers: TSynMustacheHelpers=nil; aContext: PVariant=nil;
  const aDescriptions: TFileName=''): RawUTF8;

/// instantiate a TSQLRest server instance, including supplied ORM and SOA definitions
// - will use aTables[] to define the ORM information, and supplied aSharedServices[]
// aSharedServicesContract[] for SOA definition of a shared API, implemented as
// abstract classes using TInterfaceStub
// - as used e.g. by WrapperForPublicAPI() to generate some code/doc wrappers
function WrapperFakeServer(const aTables: array of TSQLRecordClass; const aRoot: RawUTF8;
  const aSharedServices: array of TGUID; const aSharedServicesContract: array of RawUTF8;
  aResultAsJSONObjectWithoutResult: boolean): TSQLRestServerFullMemory;

/// you can call this procedure within a method-based service allow
// code-generation of an ORM and SOA client from a web browser
// - you have to specify one or several client *.mustache file paths
// - the first path containing any *.mustache file will be used as templates
// - for instance:
// ! procedure TCustomServer.Wrapper(Ctxt: TSQLRestServerURIContext);
// ! begin // search in the current path
// !   WrapperMethod(Ctxt,['.']);
// ! end;
// - optional SourcePath parameter may be used to retrieve additional description
// from the comments of the source code of the unit
// - you may specify a description file (as generated by FillDescriptionFromSource)
procedure WrapperMethod(Ctxt: TSQLRestServerURIContext; const Path: array of TFileName;
  const SourcePath: TFileName=''; const Descriptions: TFileName='');

/// you can call this procedure to add a 'Wrapper' method-based service
//  to a given server, to allow code-generation of an ORM and SOA client
// - you have to specify one or several client *.mustache file paths
// - the first path containing any *.mustache file will be used as templates
// - if no path is specified (i.e. as []), it will search in the .exe folder
// - the root/wrapper URI will be accessible without authentication (i.e.
// from any plain browser)
// - for instance:
// ! aServer := TSQLRestServerFullMemory.Create(aModel,'test.json',false,true);
// ! AddToServerWrapperMethod(aServer,['..']);
// - optional SourcePath parameter may be used to retrieve additional description
// from the comments of the source code of the unit
procedure AddToServerWrapperMethod(Server: TSQLRestServer; const Path: array of TFileName;
  const SourcePath: TFileName='');

/// you can call this procedure to generate the mORMotServer.pas unit needed
// to compile a given server source code using FPC
// - will locate FPCServer-mORMotServer.pas.mustache in the given Path[] array
// - will write the unit using specified file name or to mORMotServer.pas in the
// current directory if DestFileName is '', or to a sub-folder of the matching
// Path[] if DestFileName starts with '\' (to allow relative folder use)
// - the missing RTTI for records and interfaces would be defined, together
// with some patch comments for published record support (if any) for the ORM
procedure ComputeFPCServerUnit(Server: TSQLRestServer; const Path: array of TFileName;
  DestFileName: TFileName='');

/// you can call this procedure to generate the mORMotInterfaces.pas unit needed
// to register all needed interface RTTI for FPC
// - to circumvent http://bugs.freepascal.org/view.php?id=26774 unresolved issue
// - will locate FPC-mORMotInterfaces.pas.mustache in the given Path[] array
// - will write the unit using specified file name or to mORMotInterfaces.pas in
// the current directory if DestFileName is '', or to a sub-folder of the
// matching Path[] if DestFileName starts with '\' (to allow relative folder use)
// - all used interfaces will be exported, including SOA and mocking/stubing
// types: so you may have to run this function AFTER all process is done
procedure ComputeFPCInterfacesUnit(const Path: array of TFileName;
  DestFileName: TFileName='');

/// rough parsing of the supplied .pas unit, adding the /// commentaries
// into a TDocVariant content
procedure FillDescriptionFromSource(var Descriptions: TDocVariantData;
  const SourceFileName: TFileName);

/// rough parsing of the supplied .pas unit, adding the /// commentaries
// into a compressed binary resource
// - could be then compiled into a WRAPPER_RESOURCENAME resource, e.g. via the
// following .rc source file, assuming ResourceDestFileName='wrapper.desc':
// $ WrappersDescription 10 "wrapper.desc"
// - you may specify a .json file name, for debugging/validation purposes
// - calls internally FillDescriptionFromSource
// - returns the TDocVariant JSON object corresponding to all decriptions
function ResourceDescriptionFromSource(const ResourceDestFileName: TFileName;
  const SourceFileNames: array of TFileName;
  const JsonDestFileName: TFileName = ''): variant;

const
  /// internal Resource name used for bounded description
  // - as generated by FillDescriptionFromSource/ResourceDescriptionFromSource
  // - would be used e.g. by TWrapperContext.Create to inject the available
  // text description from any matching resource
  WRAPPER_RESOURCENAME = 'WrappersDescription';

var
  /// how FillDescriptionFromSource() handles trailing '-' in parsed comments
  // - default is [*], as expected by buggy AsciiDoc format
  DESCRIPTION_ITEM_PREFIX: RawUTF8 = ' [*]';

/// this function would generate a pascal unit defining asynchronous
// (non-blocking) types from a DDD's blocking dual-phase Select/Command service
// - you should specify the services to be converted, as an array - note that
// due to how RTTI is stored by the compiler, all "pure input" parameters should
// be defined explicitly as "const", otherwise the generated class won't match
// - optionally, the TCQRSServiceClass implementing the first Select() phase of
// the blocking service may be specified in queries array; a set of unit names
// in which those TCQRSServiceClass are defined may be specified
// - a Mustache template content should be provided - e.g. asynch.pas.mustache
// as published in SQLite3\DDD\dom folder of the source code repository
// - FileName would contain the resulting unit filename (without the .pas)
// - ProjectName would be written in the main unit comment
// - CallType should be the type used at Domain level to identify each
// asynchronous call - this type should be an integer, or a function may be
// supplied as CallFunction (matching VariantToInteger signature)
// - the first phase of the service should have set Key: KeyType, which would be
// used to create a single shared asynchronous service instance for all keys
// - ExceptionType may be customize, mainly to use a Domain-specific class
// - blocking execution may reach some timeout waiting for the asynchronous
// acknowledgement: a default delay (in ms) is to be supplied, and some custom
// delays may be specified as trios, e.g. ['IMyInterface', 'Method', 10000, ...]
function GenerateAsynchServices(const services: array of TGUID;
  const queries: array of TClass; const units: array of const;
  const additionalcontext: array of const; Template, FileName, ProjectName,
  CallType, CallFunction, Key, KeyType, ExceptionType: RawUTF8;
  DefaultDelay: integer; const CustomDelays: array of const): RawUTF8;


type
  /// the options retrieved during a ExecuteFromCommandLine() call
  TServiceClientCommandLineOptions = set of (cloPrompt,
    cloNoColor, cloPipe, cloHeaders, cloVerbose, cloNoExpand, cloNoBody);

  /// event handler to let ExecuteFromCommandLine call a remote server
  // - before call, aParams.InBody will be set with the expected JSON content
  TOnCommandLineCall = procedure(aOptions: TServiceClientCommandLineOptions;
    const aService: TInterfaceFactory; aMethod: PServiceMethod;
    var aParams: TSQLRestURIParams) of object;

const
  /// help information displayed by ExecuteFromCommandLine() with no command
  EXECUTEFROMCOMMANDLINEHELP =
   ' % help  -> show all services (interfaces)'#13#10 +
   ' % [service] [help]  -> show all methods of a given service'#13#10 +
   ' % [service] [method] help -> show parameters of a given method'#13#10 +
   ' % [options] [service] [method] [parameters] -> call a given method ' +
   {$ifdef MSWINDOWS}
   'with [parameters] being name=value or name=""value with spaces"" or ' +
   'name:={""some"":""json""}' +
   ' and [options] as /nocolor /pipe /headers /verbose /noexpand /nobody';
   {$else}
   'with [parameters] being name=value or name=''"value with spaces"'' or ' +
   'name:=''{"some":"json"}''' +
   ' and [options] as --nocolor --pipe --headers --verbose --noexpand --nobody';
   {$endif MSWINDOWS}

/// command-line SOA remote access to mORMot interface-based services
// - supports the following EXECUTEFROMCOMMANDLINEHELP commands
// - you shall have registered the aServices interface(s) by a previous call to
// the overloaded Get(TypeInfo(IMyInterface)) method or RegisterInterfaces()
// - you may specify an optional description file, as previously generated
// by mORMotWrappers' FillDescriptionFromSource function - a local
// 'WrappersDescription' resource will also be checked
// - to actually call the remote server, aOnGetClient should be supplied
procedure ExecuteFromCommandLine(const aServices: array of TGUID;
  const aOnCall: TOnCommandLineCall; const aDescriptions: TFileName = '');


implementation

type
  /// a cross-platform published property kind
  // - does not match mORMot.pas TSQLFieldType: here we recognize only types
  // which may expect a special behavior in SynCrossPlatformREST.pas unit
  // - should match TSQLFieldKind order in SynCrossPlatformREST.pas
  TCrossPlatformSQLFieldKind = (
    cpkDefault, cpkDateTime, cpkTimeLog, cpkBlob, cpkModTime, cpkCreateTime,
    cpkRecord, cpkVariant);

const
  /// those text values should match TSQLFieldKind in SynCrossPlatformREST.pas
  CROSSPLATFORMKIND_TEXT: array[TCrossPlatformSQLFieldKind] of RawUTF8 = (
    'sftUnspecified', 'sftDateTime', 'sftTimeLog', 'sftBlob', 'sftModTime',
    'sftCreateTime', 'sftRecord', 'sftVariant');

type
  /// types recognized and handled by this mORMotWrappers unit
  TWrapperType = (
    wUnknown,
    wBoolean, wEnum, wSet,
    wByte, wWord, wInteger, wCardinal,
    wInt64, wQWord, wID, wReference, wTimeLog, wModTime, wCreateTime,
    wCurrency, wSingle, wDouble, wDateTime,
    wRawUTF8, wString, wRawJSON, wBlob,
    wGUID, wCustomAnswer, wRecord, wArray, wVariant,
    wObject, wSQLRecord, wInterface, wRecordVersion);
  /// supported languages typesets
  TWrapperLanguage = (
    lngDelphi, lngPascal, lngCS, lngJava, lngTypeScript, lngSwagger);

const
  CROSSPLATFORM_KIND: array[TSQLFieldType] of TCrossPlatformSQLFieldKind = (
 // sftUnknown, sftAnsiText, sftUTF8Text, sftEnumerate, sftSet,    sftInteger,
    cpkDefault, cpkDefault,  cpkDefault,  cpkDefault,   cpkDefault,cpkDefault,
 // sftID,     sftRecord, sftBoolean,sftFloat,  sftDateTime,
    cpkDefault,cpkDefault,cpkDefault,cpkDefault,cpkDateTime,
 // sftTimeLog,sftCurrency,
    cpkTimeLog,cpkDefault,
 // sftObject,  sftVariant, sftNullable, sftBlob, sftBlobDynArray, sftBlobCustom,
    cpkDefault, cpkVariant, cpkVariant,  cpkBlob, cpkDefault,      cpkDefault,
 // sftUTF8Custom,sftMany, sftModTime, sftCreateTime, sftTID,   sftRecordVersion
    cpkRecord,  cpkDefault,cpkModTime, cpkCreateTime, cpkDefault, cpkDefault,
 // sftSessionUserID, sftDateTimeMS, sftUnixTime, sftUnixMStime
    cpkDefault, cpkDateTime, cpkDefault, cpkDefault);

  SIZETODELPHI: array[0..8] of string[7] = (
    'integer','byte','word','integer','integer','int64','int64','int64','int64');

  TYPES_SIZE: array[0..8] of TWrapperType = (
    wInteger,wByte,wWord,wInteger,wInteger,wInt64,wInt64,wInt64,wInt64);

  SWI32 = '{"type":"integer"}';
  SWI64 = '{"type":"integer","format":"int64"}';
  SWD32 = '{"type":"number","format":"float"}';
  SWD64 = '{"type":"number","format":"double"}';

  { TODO: refactor TID and Int64 for JavaScript (integers truncated to 53-bit) }
  TYPES_LANG: array[TWrapperLanguage,TWrapperType] of RawUTF8 = (
   // lngDelphi
   ('', 'Boolean', '', '', 'Byte', 'Word', 'Integer', 'Cardinal', 'Int64',
    'UInt64', 'TID', 'TRecordReference', 'TTimeLog', 'TModTime', 'TCreateTime',
    'Currency', 'Single', 'Double', 'TDateTime', 'RawUTF8','String', 'RawJSON',
    'TSQLRawBlob', 'TGUID', 'TServiceCustomAnswer', '', '', 'Variant', '', '', '',
    'TRecordVersion'),
   // lngPascal
   ('', 'Boolean', '', '', 'Byte', 'Word', 'Integer', 'Cardinal', 'Int64',
    'UInt64', 'TID', 'TRecordReference', 'TTimeLog', 'TModTime', 'TCreateTime',
    'Currency', 'Single', 'Double', 'TDateTime', 'String', 'String', 'Variant',
    'TSQLRawBlob', 'TGUID', 'THttpBody', '', '', 'Variant', '', 'TID', '',
    'TRecordVersion'),
   // lngCS
   ('', 'bool', '', '', 'byte', 'word', 'integer', 'uint', 'long', 'ulong',
    'TID', 'TRecordReference', 'TTimeLog', 'TModTime', 'TCreateTime',
    'decimal', 'single', 'double', 'double', 'string', 'string', 'dynamic',
    'byte[]', 'Guid', 'byte[]', '', '', 'dynamic', '', 'TID', '',
    'TRecordVersion'),
   // lngJava
   ('', 'boolean', '', '', 'byte', 'int', 'int', 'long', 'long', 'long', 'TID',
    'TRecordReference', 'TTimeLog', 'TModTime', 'TCreateTime', 'BigDecimal',
    'single', 'double', 'double', 'String', 'String', 'Object', 'byte[]',
    'String', 'byte[]', '', '', 'Object', '', 'TID', '', 'TRecordVersion'),
   // lngTypeScript
   ('', 'boolean', '', '', 'number', 'number', 'number', 'number', 'number',
    'number', 'mORMot.TID', 'mORMot.TRecordReference', 'mORMot.TTimeLog',
    'mORMot.TModTime', 'mORMot.TCreateTime', 'number', 'number', 'number',
    'mORMot.TDateTime', 'string', 'string', 'any', 'mORMot.TSQLRawBlob',
    'mORMot.TGUID', 'mORMot.THttpBody', '', '', 'any', '', '', '',
    'mORMot.TRecordVersion'),
   // lngSwagger
   ('', '{"type":"boolean"}', '', '', SWI32, SWI32, SWI32, SWI32, SWI64,
    SWI64, SWI64, SWI64, SWI64, SWI64,  SWI64,  SWD64, SWD32, SWD64,
    '{"type":"string","format":"date-time"}', // wDateTime
    '{"type":"string"}','{"type":"string"}',
    '{"type":"object"}', //FIXME! //wRawJSON
    '{"type":"string","format":"binary"}','{"type":"string"}', //wBlob,wGUID
    '', '', '', '', //wCustomAnswer, wRecord, wArray, wVariant
    '', SWI64, '', '' //wObject, wSQLRecord, wInterface, wRecordVersion
   ));
  TYPES_ORM: array[TSQLFieldType] of TWrapperType =
    (wUnknown,        // sftUnknown
     wString,         // sftAnsiText
     wRawUTF8,        // sftUTF8Text
     wEnum,           // sftEnumerate
     wSet,            // sftSet
     wUnknown,        // sftInteger - wUnknown to force exact type
     wSQLRecord,      // sftID
     wReference,      // sftRecord
     wBoolean,        // sftBoolean
     wUnknown,        // sftFloat - wUnknown to force exact type
     wDateTime,       // sftDateTime
     wTimeLog,        // sftTimeLog
     wCurrency,       // sftCurrency
     wObject,         // sftObject
     wVariant,        // sftVariant
     wVariant,        // sftNullable
     wBlob,           // sftBlob
     wBlob,           // sftBlobDynArray
     wRecord,         // sftBlobCustom
     wRecord,         // sftUTF8Custom
     wUnknown,        // sftMany
     wModTime,        // sftModTime
     wCreateTime,     // sftCreateTime
     wID,             // sftID
     wRecordVersion,  // sftRecordVersion
     wID,             // sftSessionUserID
     wDateTime,       // sftDateTimeMS
     wUnknown,        // sftUnixTime
     wUnknown);       // sftUnixMSTime

  TYPES_SIMPLE: array[TJSONCustomParserRTTIType] of TWrapperType = (
  //ptArray, ptBoolean, ptByte, ptCardinal, ptCurrency, ptDouble, ptExtended,
    wArray, wBoolean,   wByte,  wCardinal,  wCurrency,  wDouble,  wDouble,
  //ptInt64, ptInteger, ptQWord, ptRawByteString, ptRawJSON, ptRawUTF8, ptRecord,
    wInt64,  wInteger,  wQWord,  wBlob,           wRawJSON,  wRawUTF8,  wRecord,
  //ptSingle, ptString, ptSynUnicode, ptDateTime, ptDateTimeMS,
    wSingle,  wString,  wRawUTF8,     wDateTime,  wDateTime,
  //ptGUID, ptID, ptTimeLog, ptUnicodeString,
    wGUID,  wID, wTimeLog,   {$ifdef HASVARUSTRING} wRawUTF8, {$endif}
  //ptVariant, ptWideString, ptWord, ptCustom
    wVariant,  wRawUTF8,     wWord,  wUnknown);

  TYPES_SOA: array[TServiceMethodValueType] of TWrapperType = (
    wUnknown,wUnknown,wBoolean,wEnum,wSet,wUnknown,wUnknown,wUnknown,
    wDouble,wDateTime,wCurrency,wRawUTF8,wString,wRawUTF8,wRawUTF8,wRawUTF8,
    wRecord,wVariant,wObject,wRawJSON,wArray,
    wUnknown); // integers are wUnknown to force best type

type
  EWrapperContext = class(ESynException);

  TWrapperContext = class
  protected
    fServer: TSQLRestServer;
    fORM, fRecords,fEnumerates,fSets,fArrays,fUnits,fDescriptions: TDocVariantData;
    fSOA: variant;
    fSourcePath: TFileNameDynArray;
    fHasAnyRecord: boolean;
    function ContextFromInfo(typ: TWrapperType; typName: RawUTF8='';
      typInfo: PTypeInfo=nil): variant;
    function ContextNestedProperties(rtti: TJSONCustomParserRTTI): variant;
    function ContextOneProperty(prop: TJSONCustomParserRTTI): variant;
    function ContextFromMethods(int: TInterfaceFactory): variant;
    function ContextFromMethod(const meth: TServiceMethod): variant;
    function ContextArgsFromMethod(const meth: TServiceMethod): variant;
    procedure AddUnit(const aUnitName: ShortString; addAsProperty: PVariant);
  public
    constructor Create(const aDescriptions: TFileName);
    constructor CreateFromModel(aServer: TSQLRestServer; const aSourcePath: TFileName;
      const aDescriptions: TFileName);
    constructor CreateFromUsedInterfaces(const aDescriptions: TFileName);
    function Context: variant;
  end;

{ TWrapperContext }

constructor TWrapperContext.Create(const aDescriptions: TFileName);
var desc: RawByteString;
begin
  TDocVariant.NewFast([@fORM,@fRecords,@fEnumerates,@fSets,@fArrays,
    @fUnits,@fDescriptions]);
  if aDescriptions<>'' then
    desc := StringFromFile(aDescriptions);
  if desc='' then
    ResourceSynLZToRawByteString(WRAPPER_RESOURCENAME,desc);
  if desc<>'' then
    fDescriptions.InitJSONInPlace(Pointer(desc),JSON_OPTIONS_FAST);
end;

constructor TWrapperContext.CreateFromModel(aServer: TSQLRestServer;
  const aSourcePath, aDescriptions: TFileName);
var t,f,s,n: integer;
    nfoList: TSQLPropInfoList;
    nfo: TSQLPropInfo;
    nfoSQLFieldRTTITypeName: RawUTF8;
    kind: TCrossPlatformSQLFieldKind;
    hasRecord: boolean;
    fields,services: TDocVariantData;
    field,rec: variant;
    srv: TServiceFactoryServer;
    uri: RawUTF8;
    source: TFileName;
    src: PChar;
begin
  Create(aDescriptions);
  if aSourcePath<>'' then begin
    src := pointer(aSourcePath);
    n := 0;
    repeat
      source := GetNextItemString(src,';');
      if (source<>'') and DirectoryExists(source) then begin
        SetLength(fSourcePath,n+1);
        fSourcePath[n] := IncludeTrailingPathDelimiter(source);
        inc(n);
      end;
    until src=nil;
  end;
  fServer := aServer;
  TDocVariant.NewFast([@fields,@services]);
  // compute ORM information
  for t := 0 to fServer.Model.TablesMax do begin
    nfoList := fServer.Model.TableProps[t].Props.Fields;
    fields.Clear;
    fields.Init;
    hasRecord := false;
    for f := 0 to nfoList.Count-1 do begin
      nfo := nfoList.List[f];
      nfoSQLFieldRTTITypeName := nfo.SQLFieldRTTITypeName;
      if nfo.InheritsFrom(TSQLPropInfoRTTI) then
        field := ContextFromInfo(TYPES_ORM[nfo.SQLFieldType],nfoSQLFieldRTTITypeName,
          TSQLPropInfoRTTI(nfo).PropType) else
      if nfo.InheritsFrom(TSQLPropInfoRecordTyped) then begin
        hasRecord := true;
        fHasAnyRecord := true;
        field := ContextFromInfo(wRecord,nfoSQLFieldRTTITypeName,
          TSQLPropInfoRecordTyped(nfo).TypeInfo);
      end else
        raise EWrapperContext.CreateUTF8('Unexpected type % for %.%',
          [nfo,fServer.Model.Tables[t],nfo.Name]);
      kind := CROSSPLATFORM_KIND[nfo.SQLFieldType];
      _ObjAddProps(['index',f+1,'name',nfo.Name,'sql',ord(nfo.SQLFieldType),
        'sqlName',nfo.SQLFieldTypeName^,'typeKind',ord(kind),
        'typeKindName',CROSSPLATFORMKIND_TEXT[kind],'attr',byte(nfo.Attributes)],field);
      if aIsUnique in nfo.Attributes then
        _ObjAddProps(['unique',true],field);
      if nfo.FieldWidth>0 then
        _ObjAddProps(['width',nfo.FieldWidth],field);
      if f<nfoList.Count-1 then
        _ObjAddProps(['comma',','],field) else
        _ObjAddProps(['comma',null],field); // may conflict with rec.comma otherwise
      fields.AddItem(field);
    end;
    with fServer.Model.TableProps[t] do
      rec := _JsonFastFmt(
        '{tableName:?,className:?,classParent:?,fields:?,isInMormotPas:%,unitName:?,comma:%}',
        [NULL_OR_TRUE[(Props.Table=TSQLAuthGroup) or (Props.Table=TSQLAuthUser)],
         NULL_OR_COMMA[t<fServer.Model.TablesMax]],
        [Props.SQLTableName,Props.Table.ClassName,
         Props.Table.ClassParent.ClassName,Variant(fields),
         Props.TableClassType^.UnitName]);
    if hasRecord then
      rec.hasRecords := true;
    fORM.AddItem(rec);
  end;
  // compute SOA information
  if fServer.Services.Count>0 then begin
    for s := 0 to fServer.Services.Count-1 do begin
      srv := fServer.Services.Index(s) as TServiceFactoryServer;
      if fServer.Services.ExpectMangledURI then
        uri := srv.InterfaceMangledURI else
        uri := srv.InterfaceURI;
      with srv do
        rec := _ObjFast(['uri',uri,'interfaceURI',InterfaceURI,
          'interfaceMangledURI',InterfaceMangledURI,
          'interfaceName',InterfaceFactory.InterfaceTypeInfo^.Name,
          'GUID',GUIDToRawUTF8(InterfaceFactory.InterfaceIID),
          'contractExpected',UnQuoteSQLString(ContractExpected),
          'instanceCreation',ord(InstanceCreation),
          'instanceCreationName',GetEnumNameTrimed(
            TypeInfo(TServiceInstanceImplementation),InstanceCreation),
          'methods',ContextFromMethods(InterfaceFactory),
          'bypassAuthentication',ByPassAuthentication,
          'resultAsJSONObject',ResultAsJSONObject,
          'resultAsJSONObjectWithoutResult',ResultAsJSONObjectWithoutResult and
            (InstanceCreation in SERVICE_IMPLEMENTATION_NOID),
          'resultAsXMLObject',ResultAsXMLObject,
          'timeoutSec',TimeoutSec,
          'serviceDescription',fDescriptions.GetValueOrNull(InterfaceFactory.InterfaceName)]);
      if srv.InstanceCreation=sicClientDriven then
        rec.isClientDriven := true;
      services.AddItem(rec);
    end;
    fSOA := _ObjFast(['enabled',True,'services',variant(services),
      'expectMangledURI',fServer.Services.ExpectMangledURI]);
  end;
end;

constructor TWrapperContext.CreateFromUsedInterfaces(const aDescriptions: TFileName);
var interfaces: TSynObjectListLocked;
    services: TDocVariantData;
    i: Integer;
begin
  Create(aDescriptions);
  interfaces := TInterfaceFactory.GetUsedInterfaces;
  if interfaces=nil then
    exit;
  services.InitFast;
  for i := 0 to interfaces.Count-1 do
    services.AddItem(_ObjFast([
      'interfaceName',TInterfaceFactory(interfaces.List[i]).InterfaceTypeInfo^.Name,
      'methods',ContextFromMethods(interfaces.List[i])]));
  fSOA := _ObjFast(['enabled',True,'services',variant(services)]);
end;

function TWrapperContext.ContextArgsFromMethod(const meth: TServiceMethod): variant;
const
  DIRTODELPHI: array[TServiceMethodValueDirection] of string[7] = (
    'const','var','out','result');
  DIRTOSMS: array[TServiceMethodValueDirection] of string[7] = (
    'const','var','var','result');
var a,r: integer;
    arg: variant;
begin
  TDocVariant.NewFast(result);
  r := 0;
  for a := 1 to high(meth.Args) do begin
    with meth.Args[a] do begin
      arg := ContextFromInfo(TYPES_SOA[ValueType],'',ArgTypeInfo);
      arg.argName := ParamName^;
      arg.argType := ArgTypeName^;							  
      arg.dir := ord(ValueDirection);
      arg.dirName := DIRTODELPHI[ValueDirection];
      arg.dirNoOut := DIRTOSMS[ValueDirection]; // no OUT in DWS/SMS -> VAR instead
      if ValueDirection in [smdConst,smdVar] then
        arg.dirInput := true;
      if ValueDirection in [smdVar,smdOut,smdResult] then
        arg.dirOutput := true;
      if ValueDirection=smdResult then
        arg.dirResult := true;
    end;
    if a<meth.ArgsNotResultLast then
      _ObjAddProps(['commaArg','; '],arg);
    if a=high(meth.Args) then
      _ObjAddProps(['isArgLast',true],arg);
    if (meth.args[a].ValueDirection in [smdConst,smdVar]) and (a<meth.ArgsInLast) then
      _ObjAddProps(['commaInSingle',','],arg);
    if (meth.args[a].ValueDirection in [smdVar,smdOut]) and (a<meth.ArgsOutNotResultLast) then
      _ObjAddProps(['commaOut','; '],arg);
    if meth.args[a].ValueDirection in [smdVar,smdOut,smdResult] then begin
      _ObjAddProps(['indexOutResult',UInt32ToUtf8(r)+']'],arg);
      inc(r);
      if a<meth.ArgsOutLast then
        _ObjAddProps(['commaOutResult','; '],arg);
    end;
    TDocVariantData(result).AddItem(arg);
  end;
end;

function TWrapperContext.ContextFromMethod(const meth: TServiceMethod): variant;
const
  VERB_DELPHI: array[boolean] of string[9] = ('procedure','function');
var d: variant;
begin
  with meth do begin
    result := _ObjFast(['methodName',URI, 'methodIndex',ExecutionMethodIndex,
      'verb',VERB_DELPHI[ArgsResultIndex>=0],
      'args',ContextArgsFromMethod(meth),
      'argsOutputCount',ArgsOutputValuesCount]);
    if self<>nil then  begin// can be called as TWraperContext(nil).ContextFromMethod
      d := fDescriptions.GetValueOrNull(InterfaceDotMethodName);
      if VarIsEmptyOrNull(d) then
        RawUTF8ToVariant(InterfaceDotMethodName,d);
      result.methodDescription := d;
    end;
    if ArgsInFirst>=0 then
      result.hasInParams := true;
    if ArgsOutFirst>=0 then begin
      result.hasOutParams := true;
      if ArgsOutNotResultLast>0 then
        result.hasOutNotResultParams := true;
    end;
    if ArgsResultIsServiceCustomAnswer then
      result.resultIsServiceCustomAnswer := true;
    if IsInherited then
      result.isInherited := true;
  end;
end;

function ResourceDescriptionFromSource(const ResourceDestFileName: TFileName;
  const SourceFileNames: array of TFileName; const JsonDestFileName: TFileName): variant;
var desc: TDocVariantData absolute result;
    i: integer;
    json: RawUTF8;
begin
  VarClear(result);
  desc.InitFast;
  for i := 0 to high(SourceFileNames) do
    FillDescriptionFromSource(desc,SourceFileNames[i]);
  json := desc.ToJSON;
  if JsonDestFileName <> '' then
    JSONReformatToFile(json, JsonDestFileName);
  FileFromString(SynLZCompress(json),ResourceDestFileName);
end;

procedure FillDescriptionFromSource(var Descriptions: TDocVariantData;
  const SourceFileName: TFileName);
var desc,typeName,interfaceName: RawUTF8;
    P: PUTF8Char;
    withinCode: boolean;
begin
  P := pointer(StringFromFile(SourceFileName));
  if P=nil then
    exit;
  withinCode := false;
  repeat // rough parsing of the .pas unit file to extract /// description
    P := GotoNextNotSpace(P);
    if IdemPChar(P,'IMPLEMENTATION') then
      break; // only the "interface" section is parsed
    if IdemPChar(P,'{$IFDEF ') then begin
      repeat // just ignore any $ifdef ... $endif
        P := GotoNextLine(P);
        if P=nil then exit;
      until IdemPChar(GotoNextNotSpace(P),'{$ENDIF');
      P := GotoNextLine(P);
      P := GotoNextNotSpace(P);
    end;
    if (P[0]='/') and (P[1]='/') and (P[2]='/') then begin
      desc := GetNextLine(GotoNextNotSpace(P+3),P);
      if desc='' then
        break;
      desc[1] := UpCase(desc[1]);
      repeat
        if P=nil then
          exit;
        P := GotoNextNotSpace(P);
        if IdemPChar(P,'{$IFDEF ') then begin
          repeat // just ignore any $ifdef ... $endif
            P := GotoNextLine(P);
            if P=nil then exit;
          until IdemPChar(GotoNextNotSpace(P),'{$ENDIF');
          P := GotoNextLine(P);
        end else
        if (P[0]='/') and (P[1]='/') then begin
          if P[2]='/' then inc(P,3) else inc(P,2);
          P := GotoNextNotSpace(P);
          if P^ in ['$','!'] then begin
            if not withinCode then begin
              withinCode := true;
              desc := desc+#13#10#13#10'----'; // AsciiDoc source code block
            end;
            desc := desc+#13#10;
            inc(P);
          end else
          if P^='-' then begin
            desc := desc+#13#10#13#10'-'+ DESCRIPTION_ITEM_PREFIX;
            inc(P);
          end else
            desc := desc+' ';
          desc := desc+GetNextLine(P,P);
        end else
          break;
      until false;
      if withinCode then begin
        desc := desc+#13#10'----'; // code block should end the description
        withinCode := false;
      end;
      GetNextItem(P,' ',typeName);
      if P=nil then
        exit;
      if typeName<>'' then
        if P^='=' then begin // simple type (record, array, enumeration, set)
          if Descriptions.GetValueIndex(typeName)<0 then begin
            Descriptions.AddValue(typeName,RawUTF8ToVariant(desc));
            if typeName[1]='I' then
              interfaceName := Copy(typeName,2,128) else
              interfaceName := '';
          end;
        end else
          if interfaceName<>'' then
          if IdemPropNameU(typeName,'function') or
             IdemPropNameU(typeName,'procedure') then
            if GetNextFieldProp(P,typeName) then
              Descriptions.AddValue(interfaceName+'.'+typeName,RawUTF8ToVariant(desc));
    end else
      P := GotoNextLine(P);
  until (P=nil);
end;

procedure TWrapperContext.AddUnit(const aUnitName: ShortString;
  addAsProperty: PVariant);
var unitName: variant;
    i: Integer;
begin
  if (aUnitName='') or IdemPropName(aUnitName,'mORMot') then
    exit;
  RawUTF8ToVariant(@aUnitName[1],ord(aUnitName[0]),unitName);
  if addAsProperty<>nil then
    _ObjAddProps(['unitName',unitName],addAsProperty^);
  if (self=nil) or (fUnits.SearchItemByValue(unitName)>=0) then
    exit; // already registered
  fUnits.AddItem(unitName);
  if fSourcePath=nil then
    exit;
  for i := 0 to high(fSourcePath) do
    FillDescriptionFromSource(fDescriptions,format('%s%s.pas',[fSourcePath[i], aUnitName]));
end;

function TWrapperContext.ContextFromMethods(int: TInterfaceFactory): variant;
var m: integer;
    methods: TDocVariantData; // circumvent FPC -O2 memory leak
begin
  AddUnit(int.InterfaceTypeInfo^.InterfaceUnitName^,nil);
  methods.InitFast;
  for m := 0 to int.MethodsCount-1 do
    methods.AddItem(ContextFromMethod(int.Methods[m]));
  result := variant(methods);
end;

function TWrapperContext.ContextOneProperty(prop: TJSONCustomParserRTTI): variant;
var typ: pointer;
    l,level: integer;
begin
  if prop.InheritsFrom(TJSONCustomParserCustom) then begin
    typ := TJSONCustomParserCustom(prop).CustomTypeInfo;
    if (typ=nil) and (prop.ClassType=TJSONCustomParserCustomSimple) then
      case TJSONCustomParserCustomSimple(prop).KnownType of
        ktBinary: typ := TypeInfo(RawUTF8);
      end;
  end else
    typ := nil;
  result := ContextFromInfo(TYPES_SIMPLE[prop.PropertyType],prop.CustomTypeName,typ);
  if prop.PropertyName<>'' then
    _ObjAddProps(['propName',prop.PropertyName,'fullPropName',prop.FullPropertyName],result);
  level := 0;
  for l := 1 to length(prop.FullPropertyName) do
    if prop.FullPropertyName[l]='.' then
      inc(level);
  if level>0 then
    result.nestedIdentation := StringOfChar(' ',level*2);
  case prop.PropertyType of
  ptRecord: begin
    result.isSimple := null;
    result.nestedRecord := _ObjFast(
      ['nestedRecord',null,'fields',ContextNestedProperties(prop)]);
  end;
  ptArray: begin
    result.isSimple := null;
    if prop.NestedProperty[0].PropertyName='' then
      result.nestedSimpleArray := ContextOneProperty(prop.NestedProperty[0]) else
      result.nestedRecordArray := _ObjFast(
        ['nestedRecordArray',null,'fields',ContextNestedProperties(prop)]);
  end;
  else
    if TDocVariantData(result).GetValueIndex('toVariant')<0 then
      result.isSimple := true else
      result.isSimple := null;
  end;
end;

function TWrapperContext.ContextNestedProperties(rtti: TJSONCustomParserRTTI): variant;
var i: integer;
begin
  SetVariantNull(result);
  if rtti.PropertyType in [ptRecord,ptArray] then begin
    TDocVariant.NewFast(result);
    for i := 0 to high(rtti.NestedProperty) do
      TDocVariantData(result).AddItem(ContextOneProperty(rtti.NestedProperty[i]));
  end;
end;

function TWrapperContext.ContextFromInfo(typ: TWrapperType; typName: RawUTF8;
  typInfo: PTypeInfo): variant;
var typeWrapper: PShortString;
function VarName(lng: TWrapperLanguage): variant;
begin
  if TYPES_LANG[lng,typ]<>'' then
    RawUTF8ToVariant(TYPES_LANG[lng,typ],result) else
    if typName='' then
      SetVariantNull(result) else
      RawUTF8ToVariant(typName,result);
end;
procedure RegisterType(var list: TDocVariantData);
var info: variant;
    item: PTypeInfo;
    itemSize: integer;
    objArray: PClassInstance;
    objArrayType: TWrapperType;
    parser: TJSONRecordAbstract;
begin
  if list.SearchItemByProp('name',typName,false)>=0 then
   exit; // already registered
  if typInfo=nil then
    raise EWrapperContext.CreateUTF8('%.RegisterType(%): no RTTI',[typeWrapper^,typName]);
  case typ of
  wEnum: // full (untrimed) identifier: values[] may be trimmed at mustache level
    info := _JsonFastFmt('{name:?,values:%}',
      [typInfo^.EnumBaseType^.GetEnumNameAllAsJSONArray(false)],[typName]);
  wSet:  // full (untrimed) identifier: values[] may be trimmed at mustache level
    info := _JsonFastFmt('{name:?,values:%}',
      [typInfo^.SetEnumType^.GetEnumNameAllAsJSONArray(false)],[typName]);
  wRecord: begin
    parser := TTextWriter.RegisterCustomJSONSerializerFindParser(typInfo,true);
    if (parser<>nil) and (parser.Root<>nil) and (parser.Root.CustomTypeName<>'') then
      info := _ObjFast(['name',typName,'fields',ContextNestedProperties(parser.Root)]);
  end;
  wArray: begin
    item := typInfo^.DynArrayItemType(@itemSize);
    if item=nil then begin
      if itemSize=SizeOf(pointer) then begin
        objArray := TJSONSerializer.RegisterObjArrayFindType(typInfo);
        if objArray<>nil then begin
          // T*ObjArray -> retrieve item information
          if objArray.ItemCreate=cicTSQLRecord then
            objArrayType := wSQLRecord else
            objArrayType := wObject;
          info := ContextFromInfo(objArrayType,'',objArray^.ItemClass.ClassInfo);
          _ObjAddProps(['isObjArray',true],info);
        end;
      end;
      if VarIsEmptyOrNull(info) and DynArrayItemTypeIsSimpleBinary(typName) then
        info := ContextFromInfo(wRawUTF8);
      if VarIsEmptyOrNull(info) then
        info := ContextFromInfo(TYPES_SIZE[itemSize]);
    end else
      info := ContextFromInfo(wUnknown,'',item);
    info.name := typName;
  end;
  end;
  if not VarIsEmptyOrNull(info) then // null e.g. for a record without custom text definition
    list.AddItem(info);
end;
var siz, i: integer;
    enum: PEnumType;
begin
  if typ=wUnknown then begin
    if typInfo=nil then
      raise EWrapperContext.CreateUTF8('No RTTI nor typ for [%]',[typName]);
    typ := TYPES_ORM[typInfo.GetSQLFieldType];
    if typ=wUnknown then begin
      typ := TYPES_SIMPLE[TJSONCustomParserRTTI.TypeInfoToSimpleRTTIType(typInfo)];
      if typ=wUnknown then
        case typInfo^.Kind of
        tkRecord{$ifdef FPC},tkObject{$endif}:
          typ := wRecord;
        tkInterface:
          typ := wInterface;
        else
          raise EWrapperContext.CreateUTF8('Not enough RTTI for [%]',[typInfo^.Name]);
        end;
    end;
  end;
  if typName='' then begin
    if typInfo<>nil then begin
      TypeInfoToQualifiedName(typInfo,typName);
      i := PosExChar('.',typName);
      if i>0 then
        trimcopy(typName,i+1,maxInt,typName); // trim unit name
    end else
      typName := TYPES_LANG[lngDelphi,typ];
  end;
  if (typ=wRecord) and IdemPropNameU(typName,'TGUID') then
    typ := wGUID else
  if (typ=wRecord) and IdemPropNameU(typName,'TServiceCustomAnswer') then
    typ := wCustomAnswer;
  typeWrapper := GetEnumName(TypeInfo(TWrapperType),ord(typ));
  result := _ObjFast([
    'typeWrapper',typeWrapper^,      'typeSource',typName,
    'typeDelphi',VarName(lngDelphi), 'typePascal',VarName(lngPascal),
    'typeCS',VarName(lngCS),         'typeJava',VarName(lngJava),
    'typeTS',VarName(lngTypeScript), 'typeSwagger',VarName(lngSwagger)]);
  if self=nil then
    exit; // no need to have full info if called e.g. from MVC
  if typInfo<>nil then
  case typInfo^.Kind of
  tkClass:
    AddUnit(typInfo^.ClassType^.UnitName,@result);
  end;
  case typ of
  wBoolean,wByte,wWord,wInteger,wCardinal,wInt64,wQWord,wID,wReference,wTimeLog,
  wModTime,wCreateTime,wSingle,wDouble,wRawUTF8,wString:
    ; // simple types have no special marshalling
  wDateTime:
    _ObjAddProps(['isDateTime',true,'toVariant','DateTimeToIso8601',
      'fromVariant','Iso8601ToDateTime'],result);
  wRecordVersion:
    _ObjAddProps(['isRecordVersion',true],result);
  wCurrency:
    _ObjAddProps(['isCurrency',true],result);
  wVariant:
    _ObjAddProps(['isVariant',true],result);
  wRawJSON:
    _ObjAddProps(['isJson',true],result);
  wEnum: begin
    _ObjAddProps(['isEnum',true,'toVariant','ord','fromVariant','Variant2'+typName],result);
    if self<>nil then
      RegisterType(fEnumerates);
  end;
  wSet: begin
    enum := typInfo^.SetEnumType;
    if enum=nil then
      siz := 0 else
      siz := enum^.SizeInStorageAsSet;
    _ObjAddProps(['isSet',true,'toVariant',SIZETODELPHI[siz],'fromVariant',typName],result);
    if self<>nil then
      RegisterType(fSets);
  end;
  wGUID:
    _ObjAddProps(['toVariant','GUIDToVariant','fromVariant','VariantToGUID'],result);
  wCustomAnswer:
    _ObjAddProps(['toVariant','HttpBodyToVariant','fromVariant','VariantToHttpBody'],result);
  wRecord: begin
     _ObjAddProps(['isRecord',true],result);
     if typInfo<>nil then begin
      _ObjAddProps(['toVariant',typName+'2Variant','fromVariant','Variant2'+typName],result);
      if self<>nil then
        RegisterType(fRecords);
    end;
  end;
  wSQLRecord:
    if fServer.Model.GetTableIndexInheritsFrom(TSQLRecordClass(typInfo^.ClassType^.ClassType))<0 then
      raise EWrapperContext.CreateUTF8('% should be part of the model',[typName]) else
      _ObjAddProps(['isSQLRecord',true],result);
  wObject: begin
   _ObjAddProps(['isObject',true],result);
   if typInfo<>nil then
     _ObjAddProps(['toVariant','ObjectToVariant','fromVariant',typName+'.CreateFromVariant'],result);
  end;
  wArray: begin
    _ObjAddProps(['isArray',true],result);
    if typInfo<>nil then begin
      _ObjAddProps(['toVariant',typName+'2Variant','fromVariant','Variant2'+typName],result);
      if self<>nil then
        RegisterType(fArrays);
    end;
  end;
  wBlob:
    _ObjAddProps(['isBlob',true,
      'toVariant','BlobToVariant','fromVariant','VariantToBlob'],result);
  wInterface:
    _ObjAddProps(['isInterface',true],result);
  else raise EWrapperContext.CreateUTF8('Unexpected type % (%) for [%]',
    [typeWrapper^,ord(typ),typName]);
  end;
end;

function TWrapperContext.Context: variant;
procedure AddDescription(var list: TDocVariantData; const propName,descriptionName: RawUTF8);
var i: integer;
    propValue: RawUTF8;
begin
  if (list.Kind<>dvArray) or (fDescriptions.Count=0) then
    exit;
  for i := 0 to list.Count-1 do
    with _Safe(list.Values[i])^ do
    if GetAsRawUTF8(propName,propValue) then
      AddValue(descriptionName,fDescriptions.GetValueOrNull(propValue));
end;
var s: integer;
    authClass: TClass;
begin
  // compute the Model information as JSON
  result := _ObjFast(['time',NowToString, 'year',CurrentYear,
    'mORMotVersion',SYNOPSE_FRAMEWORK_VERSION,
    'exeVersion',VarStringOrNull(StringToUTF8(ExeVersion.Version.DetailedOrVoid)),
    'exeInfo',ExeVersion.Version.VersionInfo,
    'exeName',ExeVersion.ProgramName,
    'hasorm',fORM.Count>0, 'orm',variant(fORM),
    'soa',fSOA]);
  if fServer<>nil then
    _ObjAddProps(['root',fServer.Model.Root],result);
  if fHasAnyRecord then
    result.ORMWithRecords := true;
  if fRecords.Count>0 then begin
    AddDescription(fRecords,'name','recordDescription');
    result.records := variant(fRecords);
    result.withRecords := true;
    result.withHelpers := true;
  end;
  if fEnumerates.Count>0 then begin
    AddDescription(fEnumerates,'name','enumDescription');
    result.enumerates := variant(fEnumerates);
    result.withEnumerates := true;
    result.withHelpers := true;
  end;
  if fSets.Count>0 then begin
    AddDescription(fSets,'name','setDescription');
    result.sets := variant(fSets);
    result.withsets := true;
    result.withHelpers := true;
  end;
  if fArrays.Count>0 then begin
    result.arrays := variant(fArrays);
    result.withArrays := true;
    result.withHelpers := true;
  end;
  if fUnits.Count>0 then
    result.units := variant(fUnits);
  // add the first registered supported authentication class type as default
  if fServer<>nil then
    for s := 0 to fServer.AuthenticationSchemesCount-1 do begin
      authClass := fServer.AuthenticationSchemes[s].ClassType;
      if (authClass=TSQLRestServerAuthenticationDefault) or
         (authClass=TSQLRestServerAuthenticationNone) then begin
        result.authClass := authClass.ClassName;
        break;
      end;
    end;
end;

function ContextFromModel(aServer: TSQLRestServer;
  const aSourcePath, aDescriptions: TFileName): variant;
begin
  with TWrapperContext.CreateFromModel(aServer,aSourcePath,aDescriptions) do
  try
    result := Context;
  finally
    Free;
  end;
end;

function ContextFromMethod(const method: TServiceMethod): variant;
begin
  result := TWrapperContext(nil).ContextFromMethod(method);
end;

function ContextFromMethods(int: TInterfaceFactory): variant;
begin
  result := TWrapperContext(nil).ContextFromMethods(int);
end;


procedure WrapperMethod(Ctxt: TSQLRestServerURIContext; const Path: array of TFileName;
  const SourcePath, Descriptions: TFileName);
var root, templateName, templateTitle, savedName, templateExt, unitName, template,
    result, host, uri, head: RawUTF8;
    context: variant;
    SR: TSearchRec;
    i, templateFound, port: integer;
begin // URI is e.g. GET http://localhost:888/root/wrapper/Delphi/UnitName.pas
  if (Ctxt.Method<>mGET) or (high(Path)<0) then
    exit;
  templateFound := -1;
  for i := 0 to high(Path) do
    if FindFirst(Path[i]+PathDelim+'*.mustache',faAnyFile,SR)=0 then begin
      templateFound := i;
      break;
    end;
  if templateFound<0 then
    Ctxt.Error('Please copy some .mustache files in the expected folder (e.g. %)',[Path[0]]) else
  try
    context := ContextFromModel(Ctxt.Server,SourcePath,Descriptions);
    context.uri := Ctxt.URIWithoutSignature;
    if llfHttps in Ctxt.Call^.LowLevelFlags then begin
      context.protocol := 'https';
      context.https := true;
    end else
      context.protocol := 'http';
    host := Ctxt.InHeader['host'];
    if host<>'' then
      context.host := host;
    port := GetInteger(pointer(split(host,':',host)));
    if port=0 then
      port := 80;
    context.port := port;
    if IdemPropNameU(Ctxt.URIBlobFieldName,'context') then begin
      Ctxt.ReturnsJson(context,200,{304=}true,twNone,{humanreadable=}true);
      exit;
    end;
    root := Ctxt.Server.Model.Root;
    if Ctxt.URIBlobFieldName='' then begin
      result := '<html><title>mORMot Wrappers</title>'+
        '<body style="font-family:verdana;"><h1>Generated Code/Doc Wrappers</h1>'+
        '<hr><h2>Available Templates:</h2><ul>';
      repeat
        Split(StringToUTF8(SR.Name),'.',templateName,templateExt);
        templateTitle := templateName;
        i := PosExChar('-',templateName);
        if i>0 then begin
          SetLength(templateTitle,i-1);
          savedName := copy(templateName,i+1,maxInt);
        end else
          savedName := 'mORMotClient';
        Split(templateExt,'.',templateExt);
        uri := FormatUTF8('<a href=/%/wrapper/%/%.%',
          [root,templateName,savedName,templateExt]);
        result := FormatUTF8(
         '%<li><b>%</b><br><i>%.%</i>  -  %>download as file</a>  -  '+
         '%.txt>see as text</a> - %.mustache>see template</a></li><br>',
         [result,templateTitle,savedName,templateExt,uri,uri,uri]);
      until FindNext(SR)<>0;
      result := FormatUTF8('%</ul><p>You can also retrieve the corresponding '+
        '<a href=/%/wrapper/context>template context</a>.<hr><p>Generated by a '+
        '<a href=http://mormot.net>Synopse <i>mORMot</i> '+SYNOPSE_FRAMEWORK_VERSION+
        '</a> server.',[result,root]);
      Ctxt.Returns(result,HTTP_SUCCESS,HTML_CONTENT_TYPE_HEADER);
      exit;
    end;
  finally
    FindClose(SR);
  end;
  Split(Ctxt.URIBlobFieldName,'/',templateName,unitName);
  Split(unitName,'.',unitName,templateExt);
  if PosExChar('.',templateExt)>0 then begin // see as text
    if IdemPropNameU(Split(templateExt,'.',templateExt),'mustache') then
      unitName := ''; // force return .mustache
    head := TEXT_CONTENT_TYPE_HEADER;
  end else // download as file
    head := HEADER_CONTENT_TYPE+'application/'+LowerCase(templateExt);
  templateName := templateName+'.'+templateExt+'.mustache';
  template := AnyTextFileToRawUTF8(
    Path[templateFound]+PathDelim+UTF8ToString(templateName),true);
  if template='' then begin
    Ctxt.Error(templateName,HTTP_NOTFOUND);
    exit;
  end;
  if unitName='' then
    result := template else begin
    context.templateName := templateName;
    context.filename := unitName;
    result := TSynMustache.Parse(template).Render(context,nil,
      TSynMustache.HelpersGetStandardList,nil,true);
  end;
  Ctxt.Returns(result,HTTP_SUCCESS,head);
end;

function WrapperFromModel(aServer: TSQLRestServer; const aMustacheTemplate,
  aFileName: RawUTF8; aPort: integer; aHelpers: TSynMustacheHelpers;
  aContext: PVariant; const aDescriptions: TFileName): RawUTF8;
var context: variant;
begin // no context.uri nor context.host here
  context := ContextFromModel(aServer,'',aDescriptions);
  with _Safe(context)^ do begin
    if aPort<>0 then
      I['port'] := aPort;
    U['filename'] := aFileName;
    if aContext<>nil then begin
      AddFrom(aContext^);
      aContext^ := context;
    end;
  end;
  if aHelpers=nil then
    aHelpers := TSynMustache.HelpersGetStandardList;
  result := TSynMustache.Parse(aMustacheTemplate).Render(context,nil,aHelpers,nil,true);
end;

function WrapperFakeServer(const aTables: array of TSQLRecordClass; const aRoot: RawUTF8;
  const aSharedServices: array of TGUID; const aSharedServicesContract: array of RawUTF8;
  aResultAsJSONObjectWithoutResult: boolean): TSQLRestServerFullMemory;
var contract: RawUTF8;
    fake: IInterface;
    i: integer;
begin
  result := TSQLRestServerFullMemory.CreateWithOwnModel(aTables,false,aRoot);
  for i := 0 to high(aSharedServices) do begin
    if i<=high(aSharedServicesContract) then
      contract := aSharedServicesContract[i] else
      contract := '';
    result.ServiceDefine(TInterfaceStub.Create(aSharedServices[i], fake).
       LastInterfacedObjectFake,[aSharedServices[i]],contract).
      ResultAsJSONObjectWithoutResult := aResultAsJSONObjectWithoutResult;
  end;
end;

function WrapperForPublicAPI(const aTables: array of TSQLRecordClass;
  const aRoot, aMustacheTemplate, aFileName: RawUTF8; const aSharedServices: array of TGUID;
  const aSharedServicesContract: array of RawUTF8; aResultAsJSONObjectWithoutResult: boolean;
  aPort: integer; aHelpers: TSynMustacheHelpers; aContext: PVariant; const aDescriptions: TFileName): RawUTF8;
var server: TSQLRestServer;
begin
  server := WrapperFakeServer(aTables,aRoot,aSharedServices,aSharedServicesContract,
    aResultAsJSONObjectWithoutResult);
  try
    result := WrapperFromModel(server,aMustacheTemplate,aFileName,aPort,aHelpers,
      aContext,aDescriptions);
  finally
    server.Free;
  end;
end;



{ TWrapperMethodHook }

type
  TWrapperMethodHook = class(TPersistent)
  public
    SearchPath: TFileNameDynArray;
    SourcePath: TFileName;
  published
    procedure Wrapper(Ctxt: TSQLRestServerURIContext);
  end;

procedure TWrapperMethodHook.Wrapper(Ctxt: TSQLRestServerURIContext);
begin
  WrapperMethod(Ctxt,SearchPath,SourcePath);
end;

procedure ComputeSearchPath(const Path: array of TFileName;
  out SearchPath: TFileNameDynArray);
var i: integer;
begin
  if length(Path)=0 then begin
    SetLength(SearchPath,1);
    SearchPath[0] := ExeVersion.ProgramFilePath; // use .exe path
  end else begin
    SetLength(SearchPath,length(Path));
    for i := 0 to high(Path) do
      SearchPath[i] := ExpandFileName(Path[i]); // also convert \ if needed on FPC
  end;
end;

procedure AddToServerWrapperMethod(Server: TSQLRestServer; const Path: array of TFileName;
  const SourcePath: TFileName);
var hook: TWrapperMethodHook;
begin
  if Server=nil then
    exit;
  hook := TWrapperMethodHook.Create;
  Server.PrivateGarbageCollector.Add(hook); // Server.Free will call hook.Free
  ComputeSearchPath(Path,hook.SearchPath);
  hook.SourcePath := SourcePath;
  Server.ServiceMethodRegisterPublishedMethods('',hook);
  Server.ServiceMethodByPassAuthentication('wrapper');
end;


function FindTemplate(const TemplateName: TFileName; const Path: array of TFileName): TFileName;
var SearchPath: TFileNameDynArray;
    i: integer;
begin
  ComputeSearchPath(Path,SearchPath);
  for i := 0 to High(SearchPath) do begin
    result := IncludeTrailingPathDelimiter(SearchPath[i])+TemplateName;
    if FileExists(result) then
      exit;
  end;
  result := '';
end;

procedure ComputeFPCServerUnit(Server: TSQLRestServer; const Path: array of TFileName;
  DestFileName: TFileName);
var TemplateName: TFileName;
begin
  TemplateName := FindTemplate('FPCServer-mORMotServer.pas.mustache',Path);
  if TemplateName='' then
    exit;
  if DestFileName='' then
    DestFileName := 'mORMotServer.pas' else
    if DestFileName[1]=PathDelim then
      DestFileName := ExtractFilePath(TemplateName)+DestFileName;
  FileFromString(WrapperFromModel(Server,AnyTextFileToRawUTF8(TemplateName,true),
    StringToUTF8(ExtractFileName(DestFileName)),0),DestFileName);
end;

procedure ComputeFPCInterfacesUnit(const Path: array of TFileName;
  DestFileName: TFileName);
const TEMPLATE_NAME = 'FPC-mORMotInterfaces.pas.mustache';
var TemplateName: TFileName;
    ctxt: variant;
begin
  TemplateName := FindTemplate(TEMPLATE_NAME,Path);
  if TemplateName='' then
    exit;
  if DestFileName='' then
    DestFileName := 'mORMotInterfaces.pas' else
    if DestFileName[1]=PathDelim then
      DestFileName := ExtractFilePath(TemplateName)+DestFileName;
  with TWrapperContext.CreateFromUsedInterfaces('') do
  try
    ctxt := Context;
  finally
    Free;
  end;
  ctxt.fileName := GetFileNameWithoutExt(ExtractFileName(DestFileName));
  FileFromString(TSynMustache.Parse(AnyTextFileToRawUTF8(TemplateName,true)).
    Render(ctxt,nil,nil,nil,true),DestFileName);
end;

{$ifdef ISDELPHI20062007}
  {$WARNINGS OFF} // circument Delphi 2007 false positive warning
{$endif}

function GenerateAsynchServices(const services: array of TGUID;
  const queries: array of TClass; const units: array of const;
  const additionalcontext: array of const; Template, FileName, ProjectName,
  CallType, CallFunction, Key, KeyType, ExceptionType: RawUTF8;
  DefaultDelay: integer; const CustomDelays: array of const): RawUTF8;
var
  server: TSQLRestServerFullMemory;
  stub: IInvokable;
  context: variant;
  service, method: PDocVariantData;
  pas, intf, meth: RawUTF8;
  delay: Int64;
  i: integer;
begin
  result := '';
  if high(services) < 0 then
    exit;
  if FileName = '' then
    FileName := 'ServicesAsynch';
  if CallType = '' then
    CallType := 'TBlockingProcessPoolCall';
  if ExceptionType = '' then
    ExceptionType := 'EServiceException';
  server := TSQLRestServerFullMemory.CreateWithOwnModel([]);
  try
    for i := 0 to high(services) do
      server.ServiceDefine(TInterfaceStub.Create(services[i], stub).
        LastInterfacedObjectFake, [services[i]]);
    context := ContextFromModel(server);
    _Safe(context)^.AddNameValuesToObject(['filename', FileName,
      'projectname', ProjectName, 'exeName', ExeVersion.ProgramName,
      'User', ExeVersion.User, 'calltype', CallType, 'callfunction', CallFunction,
      'exception', ExceptionType, 'defaultdelay', DefaultDelay]);
    if high(units) >= 0 then
      _Safe(context.units)^.AddItems(units);
    if Key <> '' then
      _Safe(context)^.AddNameValuesToObject(['asynchkey', Key, 'asynchkeytype', KeyType]);
    _Safe(context)^.AddNameValuesToObject(additionalcontext);
    for i := 0 to high(services) do
      if i < length(queries) then begin
        intf := ToUTF8(TInterfaceFactory.GUID2TypeInfo(services[i])^.Name);
        if _Safe(context.soa.services)^.GetDocVariantByProp(
           'interfaceName', intf, false, service) then
          service^.AddValue('query', queries[i].ClassName)
        else
          raise EWrapperContext.CreateUTF8('CustomDelays: unknown %', [intf]);
      end;
    i := 0;
    while i + 2 <= high(CustomDelays) do begin
      if VarRecToUTF8IsString(CustomDelays[i], intf) and
         VarRecToUTF8IsString(CustomDelays[i + 1], meth) and
         VarRecToInt64(CustomDelays[i + 2], delay) then
        if _Safe(context.soa.services)^.GetDocVariantByProp(
            'interfaceName',intf, false, service) and
           service^.GetAsDocVariantSafe('methods')^.GetDocVariantByProp(
            'methodName', meth, false, method) then
          method^.I['asynchdelay'] := delay
        else
          raise EWrapperContext.CreateUTF8('CustomDelays: unknown %.%', [intf, meth]);
      inc(i, 3);
    end;
    pas := TSynMustache.Parse(Template).Render(context, nil, TSynMustache.HelpersGetStandardList);
    result := StringReplaceAll(pas, ['();', ';', '():', ':']);
//FileFromString(_Safe(context)^.ToJSON('','',jsonUnquotedPropName),FileName+'.json');
  finally
    server.Free;
  end;
end;

{$ifdef ISDELPHI20062007}
  {$WARNINGS ON} // circument Delphi 2007 false positive warning
{$endif}

{ TServiceClientCommandLine }

type
  /// a class implementing ExecuteFromCommandLine()
  TServiceClientCommandLine = class(TSynPersistent)
  protected
    fExe: RawUTF8;
    fOptions: TServiceClientCommandLineOptions;
    fServices: array of TInterfaceFactory;
    fDescriptions: TDocVariantData;
    fOnCall: TOnCommandLineCall;
    procedure ToConsole(const Fmt: RawUTF8; const Args: array of const;
      Color: TConsoleColor = ccLightGray; NoLineFeed: boolean = false);
    function Find(const name: RawUTF8; out service: TInterfaceFactory): boolean;
    procedure WriteDescription(desc: RawUTF8; color: TConsoleColor; firstline: boolean);
    procedure ShowHelp;
    procedure ShowAllServices;
    procedure ShowService(service: TInterfaceFactory);
    procedure ShowMethod(service: TInterfaceFactory; method: PServiceMethod);
    procedure ExecuteMethod(service: TInterfaceFactory; method: PServiceMethod;
      firstparam: integer);
  public
    constructor Create(const aServices: array of TGUID;
      const aOnCall: TOnCommandLineCall;
  const aDescriptions: TFileName); reintroduce;
    procedure Execute;
    destructor Destroy; override;
  end;

{$I-}

procedure TServiceClientCommandLine.ToConsole(const Fmt: RawUTF8;
  const Args: array of const; Color: TConsoleColor; NoLineFeed: boolean);
begin
  ConsoleWrite(FormatUTF8(Fmt, Args), Color, NoLineFeed, cloNoColor in fOptions);
end;

function TServiceClientCommandLine.Find(const name: RawUTF8;
  out service: TInterfaceFactory): boolean;
var
  s: integer;
begin
  for s := 0 to high(fServices) do
    if IdemPropNameU(fServices[s].InterfaceURI, name) then begin
      service := fServices[s];
      result := true;
      exit;
    end;
  result := false;
end;

procedure TServiceClientCommandLine.WriteDescription(desc: RawUTF8;
  color: TConsoleColor; firstline: boolean);
var
  line: RawUTF8;
  P: PUTF8Char;
  i, j, k, l: integer;
begin
  if not(cloNoColor in fOptions) then
    TextColor(color);
  if firstline then
    SetLength(desc, PosExChar(#13, desc) - 1);
  if desc = '' then
    exit;
  P := pointer(desc);
  repeat
    line := GetNextLine(P,P);
    if line = '' then
      continue;
    if line = '----' then begin
      if not(cloNoColor in fOptions) then
        TextColor(ccBrown);
    end
    else begin
      line := StringReplaceAll(line, ['`','', '<<','', '>>','']);
      i := 1;
      repeat
        j := PosEx('[', line, i);
        if j = 0 then
          break;
        k := PosEx('](', line, j + 1);
        if k = 0 then
          break;
        l := PosEx(')', line, k + 2);
        if l = 0 then
          break;
        delete(line, k, l - k + 1);
        delete(line, j, 1);
        i := k;
      until false;
      writeln(line);
    end;
  until P = nil;
end;

procedure TServiceClientCommandLine.ShowHelp;
begin
  ToConsole('% %'#13#10, [fExe, ExeVersion.Version.DetailedOrVoid], ccLightGreen);
  ToConsole(EXECUTEFROMCOMMANDLINEHELP, [fExe, fExe, fExe, fExe]);
end;

procedure TServiceClientCommandLine.ShowAllServices;
var
  i: integer;
begin
  for i := 0 to high(fServices) do begin
    ToConsole('% %', [fExe, fServices[i].InterfaceURI], ccWhite);
    WriteDescription(fDescriptions.U[fServices[i].InterfaceName], ccLightGray, true);
  end;
end;

procedure TServiceClientCommandLine.ShowService(service: TInterfaceFactory);
var
  m: integer;
begin
  ToConsole('% %', [fExe, service.InterfaceURI], ccWhite);
  WriteDescription(fDescriptions.U[service.InterfaceName], ccLightGray, false);
  for m := 0 to service.MethodsCount - 1 do
    with service.Methods[m] do begin
      ToConsole('% % % [parameters]', [fExe, service.InterfaceURI, URI], ccWhite);
      WriteDescription(fDescriptions.U[InterfaceDotMethodName], ccLightGray, true);
    end;
end;

procedure TServiceClientCommandLine.ShowMethod(service: TInterfaceFactory;
  method: PServiceMethod);

  procedure Arguments(input: boolean);
  const IN_OUT: array[boolean] of RawUTF8 = ('OUT', ' IN');
  var
    i: integer;
    line, typ: RawUTF8;
  begin
    ToConsole('%', [IN_OUT[input]], ccDarkGray, {nolinefeed=}true);
    if not input and method^.ArgsResultIsServiceCustomAnswer then
      line := ' is undefined'
    else begin
      line := ' { ';
      i := 0;
      while method^.ArgNext(i, input) do
        with method^.Args[i] do begin
          typ := TYPES_LANG[lngCS, TYPES_SOA[ValueType]];
          if typ = '' then
            ShortStringToAnsi7String(ArgTypeName^, typ);
          line := FormatUTF8('%"%":%, ', [line, ParamName^,  typ]);
        end;
      i := length(line);
      line[i - 1] := ' ';
      line[i] := '}';
    end;
    ToConsole('%', [line], ccDarkGray);
  end;

begin
  ToConsole('% % % [parameters]', [fExe, service.InterfaceURI, method.URI], ccWhite);
  WriteDescription(fDescriptions.U[method.InterfaceDotMethodName], ccLightGray, false);
  if method.ArgsInputValuesCount <> 0 then
    Arguments({input=}true);
  if method.ArgsOutputValuesCount <> 0 then
    Arguments({input=}false);
end;

procedure TServiceClientCommandLine.ExecuteMethod(service: TInterfaceFactory;
  method: PServiceMethod; firstparam: integer);
var
  params, result: RawUTF8;
  i: integer;
  cc: TConsoleColor;
  call: TSQLRestURIParams;
begin
  call.Init;
  if cloPipe in fOptions then
    call.InBody := ConsoleReadBody
  else begin
    for i := firstparam to ParamCount do
      params := FormatUTF8('% %', [params, ParamStr(i)]);
    //writeln(params); // for debugging
    call.InBody := method^.ArgsCommandLineToObject(pointer(params), {input=}true, true);
  end;
  // writeln(call.InBody); exit;
  if [cloVerbose, cloHeaders] * fOptions <> [] then
    ToConsole('POST %', [method.InterfaceDotMethodName], ccLightGray);
  if cloVerbose in fOptions then
    ToConsole('%', [call.InBody], ccLightBlue);
  if not Assigned(fOnCall) then
    raise EServiceException.CreateUTF8('No Client available to call %',
      [method.InterfaceDotMethodName]);
  fOnCall(fOptions, service, method, call); // will set URI + Bearer
  if [cloVerbose, cloHeaders] * fOptions <> [] then
    ToConsole('HTTP %'#13#10'%', [call.OutStatus, call.OutHead], ccLightGray);
  if (call.OutBody <> '') and (call.OutBody[1] = '[') then
    call.OutBody := method^.ArgsArrayToObject(pointer(call.OutBody), false);
  if cloNoBody in fOptions then
    FormatUTF8('% bytes received', [length(call.OutBody)], result)
  else if (cloNoExpand in fOptions) or not call.OutBodyTypeIsJson then
    result := call.OutBody
  else
    JSONBufferReformat(pointer(call.OutBody), result);
  cc := ccWhite;
  if not StatusCodeIsSuccess(call.OutStatus) then
    cc := ccLightRed;
  ToConsole('%', [result], cc, {nofeed=}true);
end;

constructor TServiceClientCommandLine.Create(const aServices: array of TGUID;
  const aOnCall: TOnCommandLineCall; const aDescriptions: TFileName);
var
  desc: RawByteString;
  n, s, i: integer;
begin
  inherited Create;
  fExe := {$ifndef MSWINDOWS}'./' + {$endif} ExeVersion.ProgramName;
  n := length(aServices);
  SetLength(fServices, n);
  s := 0;
  for i := 0 to n - 1 do begin
    fServices[s] := TInterfaceFactory.Get(aServices[i]);
    if fServices[s] <> nil then
      inc(s);
  end;
  if s = 0 then
    raise EServiceException.Create('ExecuteFromCommandLine: no service - did you call RegisterInterfaces()?');
  if s <> n then
    SetLength(fServices, s);
  fOnCall := aOnCall;
  TDocVariant.NewFast([@fDescriptions]);
  if aDescriptions <> '' then
    desc := StringFromFile(aDescriptions);
  if desc = '' then
    ResourceSynLZToRawByteString(WRAPPER_RESOURCENAME, desc);
  if desc <> '' then
    fDescriptions.InitJSONInPlace(pointer(desc), JSON_OPTIONS_FAST);
end;

procedure TServiceClientCommandLine.Execute;
var
  p: array[0..3] of RawUTF8;
  a: PUTF8Char;
  i, j, n, first: integer;
  s: TInterfaceFactory;
  m: PServiceMethod;
begin
  first := 3;
  n := 0;
  for i := 1 to ParamCount do begin
    StringToUTF8(ParamStr(i), p[n]);
    a := pointer(p[n]);
    if a^ in ['-', '/'] then begin
      inc(a);
      if a^ = '-' then
        inc(a);
      j := PTypeInfo(TypeInfo(TServiceClientCommandLineOptions))^.SetEnumType^.
        GetEnumNameTrimedValue(a);
      if j >= 0 then begin
        SetBitPtr(@fOptions, j);
        if n < high(p) then
          inc(first);
        continue;
      end;
      raise EServiceException.CreateUTF8('%.Execute: unknown option [%]', [self, p[n]]);
    end;
    if n < high(p) then
      inc(n);
  end;
  case n of
  0:
    ShowHelp;
  1:
    if Find(p[0], s) then
      ShowService(s)
    else
      ShowAllServices;
  else
    if Find(p[0], s) then begin
      m := s.FindMethod(p[1]);
      if m = nil then
        ShowService(s)
      else
        if IdemPropNameU(p[2], 'help') or
            ((m^.ArgsInputValuesCount <> 0) and (PosExChar('=', p[2]) = 0)) then
          ShowMethod(s, m)
        else
          ExecuteMethod(s, m, first);
    end
    else
      ShowAllServices;
  end;
  ToConsole('', [], ccDarkGray);
end;

destructor TServiceClientCommandLine.Destroy;
begin
  inherited Destroy;
end;

{$I+}

procedure ExecuteFromCommandLine(const aServices: array of TGUID;
  const aOnCall: TOnCommandLineCall; const aDescriptions: TFileName);
begin
  with TServiceClientCommandLine.Create(aServices, aOnCall, aDescriptions) do
    try
      try
        Execute;
      except
        on E: Exception do
          ConsoleShowFatalException(E, {waitforkey=}false);
      end;
    finally
      Free;
    end;
end;

end.

