From 8e8c31b9044c56d0c0a5815b83b990d89f507375 Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Mon, 29 Apr 2024 13:35:07 +0200 Subject: [PATCH] https://github.com/danieleteti/delphimvcframework/issues/693 --- ideexpert/DMVC.Expert.CodeGen.Commands.pas | 108 +++++++++++++++++- .../DMVC.Expert.CodeGen.NewControllerUnit.pas | 25 ++-- ideexpert/DMVC.Expert.Commands.Templates.pas | 9 ++ ideexpert/DMVC.Expert.Commons.pas | 2 + .../DMVC.Expert.Forms.NewProjectWizard.dfm | 31 +++-- .../DMVC.Expert.Forms.NewProjectWizard.pas | 2 + ideexpert/DMVC.Expert.ProjectWizardEx.pas | 30 ++++- .../activerecord_restful_crud.dpr | 20 ++-- 8 files changed, 193 insertions(+), 34 deletions(-) diff --git a/ideexpert/DMVC.Expert.CodeGen.Commands.pas b/ideexpert/DMVC.Expert.CodeGen.Commands.pas index ce251dac..55f7e9d4 100644 --- a/ideexpert/DMVC.Expert.CodeGen.Commands.pas +++ b/ideexpert/DMVC.Expert.CodeGen.Commands.pas @@ -140,6 +140,19 @@ type ); override; end; + TUnitMustacheHelpersDeclarationCommand = class(TCustomCommand) + public + procedure ExecuteInterface( + Section: TStringBuilder; + Model: TJSONObject + ); override; + procedure ExecuteImplementation( + Section: TStringBuilder; + Model: TJsonObject + ); override; + end; + + TUnitFooterCommand = class(TCustomCommand) public procedure ExecuteImplementation( @@ -273,7 +286,14 @@ begin .AppendLine(' Web.WebReq,') .AppendLine(' Web.WebBroker,') .AppendLine(' IdContext,') - .AppendLine(' IdHTTPWebBrokerBridge,') + .AppendLine(' IdHTTPWebBrokerBridge,'); + if Model.B[TConfigKey.program_ssv_mustache] then + begin + Section + .AppendLine(' MVCFramework.View.Renderers.Mustache,') + .AppendLine(' SynMustache,'); + end; + Section .AppendLine(' MVCFramework,') .AppendLine(' MVCFramework.Logger,') .AppendLine(' MVCFramework.DotEnv,') @@ -649,7 +669,13 @@ begin Section .AppendLine(' System.IOUtils,') - .AppendLine(' MVCFramework.Commons,') + .AppendLine(' MVCFramework.Commons,'); + if Model.B[TConfigKey.program_ssv_mustache] then + begin + Section + .AppendLine(' MVCFramework.View.Renderers.Mustache,') + end; + Section .AppendLine(' MVCFramework.Middleware.ActiveRecord,') .AppendLine(' MVCFramework.Middleware.StaticFiles,') .AppendLine(' MVCFramework.Middleware.Analytics,') @@ -692,8 +718,17 @@ begin .AppendLine(' // Controllers') .AppendLine(' FMVC.AddController(' + Model[TConfigKey.controller_classname] + ');') .AppendLine(' // Controllers - END') - .AppendLine - .AppendLine(' // Middleware'); + .AppendLine; + if Model.B[TConfigKey.program_ssv_mustache] then + begin + Section + .AppendLine(' // Server Side View') + .AppendLine(' FMVC.SetViewEngine(TMVCMustacheViewEngine);') + .AppendLine(' // Server Side View - END') + .AppendLine; + end; + Section + .AppendLine(' // Middleware'); if Model.B[TConfigKey.webmodule_middleware_analytics] then begin @@ -910,7 +945,19 @@ begin .AppendLine(' Profiler.WarningThreshold := dotEnv.Env(''dmvc.profiler.warning_threshold'', 2000);') .AppendLine(' end;') .AppendLine('{$ENDIF}') - .AppendLine + .AppendLine; + if Model.B[TConfigKey.program_ssv_mustache] then + begin + Section + .AppendLine(' // Project specific Mustache helpers') + .AppendLine(' TMVCMustacheHelpers.OnLoadCustomHelpers := procedure(var MustacheHelpers: TSynMustacheHelpers)') + .AppendLine(' begin') + .AppendLine(' TSynMustache.HelperAdd(MustacheHelpers, ''MyHelper1'', TMyMustacheHelpers.MyHelper1);') + .AppendLine(' TSynMustache.HelperAdd(MustacheHelpers, ''MyHelper2'', TMyMustacheHelpers.MyHelper2);') + .AppendLine(' end;') + .AppendLine; + end; + Section .AppendLine(' RunServer(dotEnv.Env(''dmvc.server.port'', ' + Model[TConfigKey.program_default_server_port] + '));') .AppendLine(' except') .AppendLine(' on E: Exception do') @@ -1044,4 +1091,55 @@ begin end; +{ TUnitMustacheHelpersDeclarationCommand } + +procedure TUnitMustacheHelpersDeclarationCommand.ExecuteImplementation( + Section: TStringBuilder; Model: TJsonObject); +begin + inherited; + Section + .AppendLine('implementation') + .AppendLine + .AppendLine('uses') + .AppendLine(' MVCFramework.View.Renderers.Mustache, System.SysUtils;') + .AppendLine + .AppendLine('{ TMyMustacheHelpers }') + .AppendLine + .AppendLine('class procedure TMyMustacheHelpers.MyHelper1(const Value: variant; out Result: variant);') + .AppendLine('begin') + .AppendLine(' Result := Value + '' (I''''m The MyHelper1)'';') + .AppendLine('end;') + .AppendLine + .AppendLine('class procedure TMyMustacheHelpers.MyHelper2(const Value: variant; out Result: variant);') + .AppendLine('begin') + .AppendLine(' Result := Value + '' (I''''m The MyHelper2)'';') + .AppendLine('end;') + .AppendLine + .AppendLine + .AppendLine('end.'); +end; + +procedure TUnitMustacheHelpersDeclarationCommand.ExecuteInterface( + Section: TStringBuilder; Model: TJSONObject); +begin + inherited; + CheckFor(TConfigKey.program_ssv_mustache, Model); + CheckFor(TConfigKey.mustache_helpers_unit_name, Model); + Section + .AppendLine('unit ' + Model[TConfigKey.mustache_helpers_unit_name] + ';') + .AppendLine + .AppendLine('interface') + .AppendLine + .AppendLine('uses') + .AppendLine(' SynMustache;') + .AppendLine + .AppendLine('type') + .AppendLine(' TMyMustacheHelpers = class sealed') + .AppendLine(' public') + .AppendLine(' class procedure MyHelper1(const Value: variant; out Result: variant);') + .AppendLine(' class procedure MyHelper2(const Value: variant; out Result: variant);') + .AppendLine(' end;') + .AppendLine; +end; + end. diff --git a/ideexpert/DMVC.Expert.CodeGen.NewControllerUnit.pas b/ideexpert/DMVC.Expert.CodeGen.NewControllerUnit.pas index 71608cef..78b7467c 100644 --- a/ideexpert/DMVC.Expert.CodeGen.NewControllerUnit.pas +++ b/ideexpert/DMVC.Expert.CodeGen.NewControllerUnit.pas @@ -38,7 +38,7 @@ uses ToolsApi, System.IOUtils, DMVC.Expert.CodeGen.NewUnit, - JsonDataObjects; + JsonDataObjects, DMVC.Expert.CodeGen.Executor; type TNewControllerUnitEx = class(TNewUnit) @@ -51,13 +51,20 @@ type const APersonality: string = ''); reintroduce; end; - TNewJSONRPCUnitEx = class(TNewUnit) + TTemplateLoadProcedure = procedure(Gen: TMVCCodeGenerator); + + TNewGenericUnitFromTemplate = class(TNewUnit) + private + fTemplateLoadProcedure: TTemplateLoadProcedure; + fUnitIdentKeyName: string; protected function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string) : IOTAFile; override; public constructor Create( const ConfigModelRef: TJSONObject; + const TemplateLoadProcedure: TTemplateLoadProcedure; + const UnitIdentKeyName: String; const APersonality: string = '');reintroduce; end; @@ -66,7 +73,6 @@ implementation uses System.SysUtils, DMVC.Expert.CodeGen.SourceFile, - DMVC.Expert.CodeGen.Executor, DMVC.Expert.Commands.Templates, DMVC.Expert.Commons; @@ -103,15 +109,19 @@ end; { TNewJSONRPCUnitEx } -constructor TNewJSONRPCUnitEx.Create( +constructor TNewGenericUnitFromTemplate.Create( const ConfigModelRef: TJSONObject; + const TemplateLoadProcedure: TTemplateLoadProcedure; + const UnitIdentKeyName: String; const APersonality: string); begin inherited Create(ConfigModelRef); + fTemplateLoadProcedure := TemplateLoadProcedure; + fUnitIdentKeyName := UnitIdentKeyName; Personality := aPersonality; end; -function TNewJSONRPCUnitEx.NewImplSource(const ModuleIdent, FormIdent, +function TNewGenericUnitFromTemplate.NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile; var lUnitIdent: string; @@ -123,11 +133,12 @@ begin lFileName := ''; (BorlandIDEServices as IOTAModuleServices).GetNewModuleAndClassName('', lUnitIdent, lDummy, lFileName); - fConfigModelRef.S[TConfigKey.jsonrpc_unit_name] := lUnitIdent; + fConfigModelRef.S[fUnitIdentKeyName] := lUnitIdent; Result := TSourceFile.Create( procedure (Gen: TMVCCodeGenerator) begin - FillJSONRPCTemplates(Gen); + //FillJSONRPCTemplates(Gen); + fTemplateLoadProcedure(Gen); end, fConfigModelRef); end; diff --git a/ideexpert/DMVC.Expert.Commands.Templates.pas b/ideexpert/DMVC.Expert.Commands.Templates.pas index 0b235ccb..7d6187ce 100644 --- a/ideexpert/DMVC.Expert.Commands.Templates.pas +++ b/ideexpert/DMVC.Expert.Commands.Templates.pas @@ -34,6 +34,7 @@ procedure FillControllerTemplates(Gen: TMVCCodeGenerator); procedure FillWebModuleTemplates(Gen: TMVCCodeGenerator); procedure FillWebModuleDFMTemplates(Gen: TMVCCodeGenerator); procedure FillJSONRPCTemplates(Gen: TMVCCodeGenerator); +procedure FillMustacheTemplates(Gen: TMVCCodeGenerator); implementation @@ -82,4 +83,12 @@ begin end; + +procedure FillMustacheTemplates(Gen: TMVCCodeGenerator); +begin + Gen.Commands.AddRange([ + TUnitMustacheHelpersDeclarationCommand.Create + ]); +end; + end. diff --git a/ideexpert/DMVC.Expert.Commons.pas b/ideexpert/DMVC.Expert.Commons.pas index b0063b51..a772b221 100644 --- a/ideexpert/DMVC.Expert.Commons.pas +++ b/ideexpert/DMVC.Expert.Commons.pas @@ -57,6 +57,8 @@ type program_default_server_port= 'program.default_server_port'; program_msheap='program.msheap'; program_dotenv='program.dotenv'; + program_ssv_mustache='program.ssv.mustache'; + mustache_helpers_unit_name = 'mustache.helpers_unit_name'; controller_unit_name='controller.unit_name'; controller_classname= 'controller.classname'; controller_index_methods_generate= 'controller.index_methods.generate'; diff --git a/ideexpert/DMVC.Expert.Forms.NewProjectWizard.dfm b/ideexpert/DMVC.Expert.Forms.NewProjectWizard.dfm index 03704bca..54188e6f 100644 --- a/ideexpert/DMVC.Expert.Forms.NewProjectWizard.dfm +++ b/ideexpert/DMVC.Expert.Forms.NewProjectWizard.dfm @@ -3,7 +3,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject Top = 0 BorderStyle = bsDialog Caption = 'DelphiMVCFramework :: New Project Wizard' - ClientHeight = 576 + ClientHeight = 598 ClientWidth = 729 Color = clBtnFace Constraints.MinHeight = 145 @@ -18,7 +18,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject OnDestroy = FormDestroy DesignSize = ( 729 - 576) + 598) TextHeight = 13 object Shape1: TShape Left = 0 @@ -400,7 +400,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject object lblBook: TLabel AlignWithMargins = True Left = 15 - Top = 542 + Top = 563 Width = 259 Height = 16 Cursor = crHandPoint @@ -458,7 +458,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject end object btnOK: TButton Left = 549 - Top = 541 + Top = 563 Width = 77 Height = 27 Anchors = [akRight, akBottom] @@ -467,10 +467,11 @@ object frmDMVCNewProject: TfrmDMVCNewProject ModalResult = 1 TabOrder = 3 OnClick = btnOKClick + ExplicitTop = 541 end object btnCancel: TButton Left = 632 - Top = 541 + Top = 563 Width = 77 Height = 27 Anchors = [akRight, akBottom] @@ -478,6 +479,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject Caption = 'Cancel' ModalResult = 2 TabOrder = 4 + ExplicitTop = 541 end object chkAddToProjectGroup: TCheckBox Left = 24 @@ -506,7 +508,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject end object Panel2: TPanel Left = 0 - Top = 320 + Top = 342 Width = 308 Height = 215 Anchors = [akLeft, akBottom] @@ -516,6 +518,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject ParentCtl3D = False ShowCaption = False TabOrder = 5 + ExplicitTop = 320 DesignSize = ( 308 215) @@ -726,12 +729,13 @@ object frmDMVCNewProject: TfrmDMVCNewProject end object GroupBoxJSONRPC: TGroupBox Left = 314 - Top = 349 + Top = 371 Width = 396 Height = 105 Anchors = [akLeft, akRight, akBottom] Caption = 'JSON-RPC 2.0' TabOrder = 7 + ExplicitTop = 349 DesignSize = ( 396 105) @@ -765,7 +769,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject end object chkMSHeap: TCheckBox Left = 24 - Top = 288 + Top = 286 Width = 225 Height = 17 Anchors = [akLeft, akRight, akBottom] @@ -774,13 +778,22 @@ object frmDMVCNewProject: TfrmDMVCNewProject end object chkCustomConfigDotEnv: TCheckBox Left = 24 - Top = 268 + Top = 267 Width = 225 Height = 17 Anchors = [akLeft, akRight, akBottom] Caption = 'Generate custom .env configuration' TabOrder = 9 end + object chkMustache: TCheckBox + Left = 24 + Top = 306 + Width = 225 + Height = 17 + Anchors = [akLeft, akRight, akBottom] + Caption = 'Use Mustache as Server Side View engine' + TabOrder = 10 + end object ApplicationEvents: TApplicationEvents OnIdle = ApplicationEventsIdle Left = 232 diff --git a/ideexpert/DMVC.Expert.Forms.NewProjectWizard.pas b/ideexpert/DMVC.Expert.Forms.NewProjectWizard.pas index 8f233530..90c2d661 100644 --- a/ideexpert/DMVC.Expert.Forms.NewProjectWizard.pas +++ b/ideexpert/DMVC.Expert.Forms.NewProjectWizard.pas @@ -97,6 +97,7 @@ type chkCustomConfigDotEnv: TCheckBox; chkProfileActions: TCheckBox; lblPATREON: TLabel; + chkMustache: TCheckBox; procedure chkCreateControllerUnitClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Image1Click(Sender: TObject); @@ -339,6 +340,7 @@ begin fModel.S[TConfigKey.program_default_server_port] := GetServerPort.ToString; fModel.B[TConfigKey.program_msheap] := chkMSHeap.Checked; fModel.B[TConfigKey.program_dotenv] := chkCustomConfigDotEnv.Checked; + fModel.B[TConfigKey.program_ssv_mustache] := chkMustache.Checked; fModel.S[TConfigKey.controller_unit_name] := 'TBA'; fModel.S[TConfigKey.controller_classname] := GetControllerClassName; fModel.B[TConfigKey.controller_index_methods_generate] := chkCreateIndexMethod.Checked; diff --git a/ideexpert/DMVC.Expert.ProjectWizardEx.pas b/ideexpert/DMVC.Expert.ProjectWizardEx.pas index 095aaa22..32ac2dae 100644 --- a/ideexpert/DMVC.Expert.ProjectWizardEx.pas +++ b/ideexpert/DMVC.Expert.ProjectWizardEx.pas @@ -65,7 +65,8 @@ uses DMVC.Expert.CodeGen.NewWebModuleUnit, ExpertsRepository, JsonDataObjects, - DMVC.Expert.Commons; + DMVC.Expert.Commons, DMVC.Expert.CodeGen.SourceFile, + DMVC.Expert.Commands.Templates; resourcestring sNewDMVCProjectCaption = 'DelphiMVCFramework Project'; @@ -92,12 +93,15 @@ begin ControllerUnit: IOTAModule; JSONRPCUnit: IOTAModule; WebModuleUnit: IOTAModule; + MustacheHelperUnit: IOTAModule; ControllerCreator: IOTACreator; JSONRPCUnitCreator: IOTACreator; + MustacheHelpersUnitCreator: IOTACreator; WebModuleCreator: IOTAModuleCreator; lProjectSourceCreator: IOTACreator; lJSONRPCUnitName: string; lJSON: TJSONObject; + lMustacheHelpersUnitName: string; begin WizardForm := TfrmDMVCNewProject.Create(Application); try @@ -135,8 +139,10 @@ begin // Create JSONRPC Unit if lJSON.B[TConfigKey.jsonrpc_generate] then begin - JSONRPCUnitCreator := TNewJSONRPCUnitEx.Create( + JSONRPCUnitCreator := TNewGenericUnitFromTemplate.Create( lJSON, + FillJSONRPCTemplates, + TConfigKey.jsonrpc_unit_name, APersonality); JSONRPCUnit := ModuleServices.CreateModule(JSONRPCUnitCreator); ChangeIOTAModuleFileNamePrefix(JSONRPCUnit, 'JSONRPC.' + lJSON.S[TConfigKey.jsonrpc_classname].Substring(1)); @@ -148,6 +154,26 @@ begin end; end; + + lMustacheHelpersUnitName := ''; + // Create Mustache Helpers Unit + if lJSON.B[TConfigKey.program_ssv_mustache] then + begin + MustacheHelpersUnitCreator := TNewGenericUnitFromTemplate.Create( + lJSON, + FillMustacheTemplates, + TConfigKey.mustache_helpers_unit_name, + APersonality); + MustacheHelperUnit := ModuleServices.CreateModule(MustacheHelpersUnitCreator); + ChangeIOTAModuleFileNamePrefix(MustacheHelperUnit, 'MustacheHelpers'); + lMustacheHelpersUnitName := GetUnitName(MustacheHelperUnit.FileName); + lJSON.S[TConfigKey.mustache_helpers_unit_name] := lMustacheHelpersUnitName; + if Project <> nil then + begin + Project.AddFile(MustacheHelperUnit.FileName, True); + end; + end; + // Create Webmodule Unit WebModuleCreator := TNewWebModuleUnitEx.Create( lJSON, diff --git a/samples/activerecord_restful_crud/activerecord_restful_crud.dpr b/samples/activerecord_restful_crud/activerecord_restful_crud.dpr index f0b0f136..d9427d22 100644 --- a/samples/activerecord_restful_crud/activerecord_restful_crud.dpr +++ b/samples/activerecord_restful_crud/activerecord_restful_crud.dpr @@ -15,19 +15,17 @@ uses Web.WebBroker, IdHTTPWebBrokerBridge, MVCFramework.Signal, + MVCFramework.Logger, MVCFramework.SQLGenerators.PostgreSQL, MVCFramework.SQLGenerators.Firebird, MVCFramework.SQLGenerators.Interbase, MVCFramework.SQLGenerators.MSSQL, MVCFramework.SQLGenerators.MySQL, - WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule} , + WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule}, Entities in 'Entities.pas', - MVCFramework.ActiveRecordController in '..\..\sources\MVCFramework.ActiveRecordController.pas', - MVCFramework.ActiveRecord in '..\..\sources\MVCFramework.ActiveRecord.pas', EntitiesProcessors in 'EntitiesProcessors.pas', FDConnectionConfigU in '..\activerecord_showcase\FDConnectionConfigU.pas', - OtherControllerU in 'OtherControllerU.pas', - MVCFramework.SysControllers in '..\..\sources\MVCFramework.SysControllers.pas'; + OtherControllerU in 'OtherControllerU.pas'; {$R *.res} @@ -36,7 +34,7 @@ var lServer: TIdHTTPWebBrokerBridge; lCmd: string; begin - Writeln('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION); + LogI('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION); if ParamCount >= 1 then lCmd := ParamStr(1) else @@ -56,7 +54,7 @@ begin CreatePostgreSQLPrivateConnDef(True); end; - WriteLn('Using ' + lCmd.Substring(1)); + LogI('Using ' + lCmd.Substring(1)); lServer := TIdHTTPWebBrokerBridge.Create(nil); try @@ -65,8 +63,8 @@ begin lServer.MaxConnections := 0; lServer.ListenQueue := 200; lServer.Active := True; - WriteLn('Running on port ', APort); - Write('CTRL+C to Quit'); + LogI('Running on port ' + APort.ToString); + LogI('CTRL+C to Quit'); WaitForTerminationSignal; EnterInShutdownState; finally @@ -81,10 +79,10 @@ begin if WebRequestHandler <> nil then WebRequestHandler.WebModuleClass := WebModuleClass; WebRequestHandlerProc.MaxConnections := 1024; - RunServer(8080); + RunServer(dotEnv.Env('dmvc.server.port', 8080)); except on E: Exception do - Writeln(E.ClassName, ': ', E.Message); + LogI(E.ClassName + ': ' + E.Message); end; end.