Improved WebStancils ViewEngine

sources/MVCFramework.View.Renderers.TemplatePro.pas

@@ -43,8 +43,8 @@ uses
   MVCFramework.Serializer.Defaults,
   MVCFramework.Serializer.Intf,
   MVCFramework.DuckTyping,
-  TemplatePro,
   MVCFramework.Cache,
+  TemplatePro,
   Data.DB,
   System.Rtti,
   JsonDataObjects;
@@ -136,7 +136,10 @@ begin
   if FUseViewCache then
   begin
     lCacheDir := TPath.Combine(TPath.GetDirectoryName(lViewFileName), '__cache__');
+    if not TDirectory.Exists(lCacheDir) then
+    begin
       TDirectory.CreateDirectory(lCacheDir);
+    end;
     lCompiledViewFileName := TPath.Combine(lCacheDir, TPath.ChangeExtension(TPath.GetFileName(lViewFileName), '.' + TEMPLATEPRO_VERSION + '.tpcu'));
 
     if not FileAge(lViewFileName, lActualFileTimeStamp) then

sources/MVCFramework.View.Renderers.WebStencils.pas

@@ -34,14 +34,19 @@ interface
 
 uses
   MVCFramework, System.Generics.Collections, System.SysUtils,
-  MVCFramework.Commons, System.IOUtils, System.Classes, Web.Stencils;
+  MVCFramework.Commons, System.IOUtils, System.Classes, Web.Stencils,
+  System.Rtti, MVCFramework.Nullables, System.DateUtils;
 
 type
   TMVCWebStencilsEvent = reference to procedure(const WebStencilsProcessor: TWebStencilsProcessor);
 
   { This class implements the WebStencils view engine for server side views }
   TMVCWebStencilsViewEngine = class(TMVCBaseViewEngine)
+  protected
+    procedure RegisterWSFunctions(WSProcessor: TWebStencilsProcessor);
+    procedure OnGetValue(Sender: TObject; const AObjectName, APropName: string; var AReplaceText: string; var AHandled: Boolean);
   public
+    class function GetTValueVarAsString(const Value: TValue; const VarName: string; const Processor: TWebStencilsProcessor): String;
     procedure Execute(const ViewName: string; const Builder: TStringBuilder); override;
   end;
 
@@ -68,7 +73,6 @@ uses
   System.Bindings.Methods,
   MVCFramework.Cache,
   Data.DB,
-  System.Rtti,
   JsonDataObjects;
 
 {$WARNINGS OFF}
@@ -81,7 +85,7 @@ function GetDataSetOrObjectListCount(const aValue: TValue; const aParameters: TA
 var
   lWrappedList: IMVCList;
 begin
-  if not aValue.IsObject then
+  if aValue.IsEmpty or  (not aValue.IsObject) then
   begin
     Result := False;
   end;
@@ -141,13 +145,32 @@ end;
 
 function MakeMethodJSON: IInvokable;
 begin
-  Result := MakeInvokable(function(Args: TArray<IValue>): IValue
+  Result :=
+    MakeInvokable(function(Args: TArray<IValue>): IValue
     begin
       Result := TValueWrapper.Create(DumpAsJSONString(Args[0].GetValue.AsObject, []));
-      end)
+    end);
 end;
 
-procedure RegisterWSFunctions(WSProcessor: TWebStencilsProcessor);
+
+procedure TMVCWebStencilsViewEngine.OnGetValue(Sender: TObject; const AObjectName, APropName: string; var AReplaceText: string; var AHandled: Boolean);
+var
+  lValue: TValue;
+begin
+  AHandled := False;
+  if ViewModel.TryGetValue(AObjectName, lValue) then
+  begin
+    AReplaceText := GetTValueVarAsString(lValue, AObjectName, TWebStencilsProcessor(Sender));
+    AHandled := True;
+  end
+  else
+  begin
+    AReplaceText := '';
+    AHandled := True;
+  end;
+end;
+
+procedure TMVCWebStencilsViewEngine.RegisterWSFunctions(WSProcessor: TWebStencilsProcessor);
 begin
   if gFunctionInitialized then Exit;
   TMonitor.Enter(gWSLock);
@@ -155,7 +178,6 @@ begin
     if gFunctionInitialized then Exit;
     gFunctionInitialized := True;
 
-
     TBindingMethodsFactory.RegisterMethod(
      TMethodDescription.Create(
       MakeInvokable(function(Args: TArray<IValue>): IValue
@@ -168,6 +190,18 @@ begin
       end) as IInvokable,
       'json', 'json', '', True, 'Serialize an object to JSON', nil));
 
+  TBindingMethodsFactory.RegisterMethod(
+   TMethodDescription.Create(
+    MakeInvokable(function(Args: TArray<IValue>): IValue
+    begin
+      if Length(Args) <> 1 then
+      begin
+        raise EWebStencilsException.Create('Expected 1 parameter, got ' + Length(Args).ToString);
+      end;
+      Result := TValueWrapper.Create(TMVCWebStencilsViewEngine.GetTValueVarAsString(Args[0].GetValue, '', nil));
+    end),
+    'ValueOf', 'ValueOf', '', True, 'ValueOf returns the inner value of a nullable as string - the non-nullable types are returned as-is', nil));
+
   finally
     TMonitor.Exit(gWSLock);
   end;
@@ -191,9 +225,10 @@ begin
       begin
         TMVCWebStencilsConfiguration.OnProcessorConfiguration(lWebStencilsProcessor);
       end;
-      //lWebStencilsProcessor.OnFile := Self.OnFile; {12.2, any filename starting with ..\ is not read correctly by the parser. Is it a feature? }
+      lWebStencilsProcessor.OnValue := OnGetValue;
       lWebStencilsProcessor.InputFileName := lViewFileName;
       lWebStencilsProcessor.PathTemplate := Config[TMVCConfigKey.ViewPath];
+      lWebStencilsProcessor.WebRequest := WebContext.Request.RawWebRequest;
       if Assigned(ViewModel) then
       begin
         for lPair in ViewModel do
@@ -202,6 +237,10 @@ begin
             lWebStencilsProcessor.AddVar(lPair.Key, ViewModel[lPair.Key].AsObject, False);
         end;
       end;
+      if Assigned(WebContext.LoggedUser) then
+      begin
+        lWebStencilsProcessor.UserRoles := WebContext.LoggedUser.Roles.ToString;
+      end;
       if Assigned(FBeforeRenderCallback) then
       begin
         FBeforeRenderCallback(lWebStencilsProcessor);
@@ -219,6 +258,159 @@ begin
   end;
 end;
 
+class function TMVCWebStencilsViewEngine.GetTValueVarAsString(const Value: TValue; const VarName: string; const Processor: TWebStencilsProcessor): String;
+var
+  lIsObject: Boolean;
+  lAsObject: TObject;
+  lNullableInt32: NullableInt32;
+  lNullableUInt32: NullableUInt32;
+  lNullableInt16: NullableInt16;
+  lNullableUInt16: NullableUInt16;
+  lNullableInt64: NullableInt64;
+  lNullableUInt64: NullableUInt64;
+  lNullableCurrency: NullableCurrency;
+  lNullableBoolean: NullableBoolean;
+  lNullableTDate: NullableTDate;
+  lNullableTTime: NullableTTime;
+  lNullableTDateTime: NullableTDateTime;
+begin
+  if Value.IsEmpty then
+  begin
+    Exit('');
+  end;
+
+  lIsObject := False;
+  lAsObject := nil;
+  if Value.IsObject then
+  begin
+    lIsObject := True;
+    lAsObject := Value.AsObject;
+  end;
+
+  if lIsObject then
+  begin
+    if lAsObject is TField then
+      Result := TField(Value.AsObject).AsString
+    else if lAsObject is TJsonBaseObject then
+      Result := TJsonBaseObject(lAsObject).ToJSON()
+    else
+      Result := lAsObject.ToString;
+  end
+  else
+  begin
+    if Value.TypeInfo.Kind = tkRecord then
+    begin
+      Result := '';
+      if Value.TypeInfo = TypeInfo(NullableInt32) then
+      begin
+        lNullableInt32 := Value.AsType<NullableInt32>;
+        if lNullableInt32.HasValue then
+          Result := lNullableInt32.Value.ToString
+      end
+      else if Value.TypeInfo = TypeInfo(NullableUInt32) then
+      begin
+        lNullableUInt32 := Value.AsType<NullableUInt32>;
+        if lNullableUInt32.HasValue then
+          Result := lNullableUInt32.Value.ToString
+      end
+      else if Value.TypeInfo = TypeInfo(NullableInt16) then
+      begin
+        lNullableInt16 := Value.AsType<NullableInt16>;
+        if lNullableInt16.HasValue then
+          Result := lNullableInt16.Value.ToString
+      end
+      else if Value.TypeInfo = TypeInfo(NullableUInt16) then
+      begin
+        lNullableUInt16 := Value.AsType<NullableUInt16>;
+        if lNullableUInt16.HasValue then
+          Result := lNullableUInt16.Value.ToString
+      end
+      else if Value.TypeInfo = TypeInfo(NullableInt64) then
+      begin
+        lNullableInt64 := Value.AsType<NullableInt64>;
+        if lNullableInt64.HasValue then
+          Result := lNullableInt64.Value.ToString
+      end
+      else if Value.TypeInfo = TypeInfo(NullableUInt64) then
+      begin
+        lNullableUInt64 := Value.AsType<NullableUInt64>;
+        if lNullableUInt64.HasValue then
+          Result := lNullableUInt64.Value.ToString
+      end
+      else if Value.TypeInfo = TypeInfo(NullableString) then
+      begin
+        Result := Value.AsType<NullableString>.ValueOrDefault;
+      end
+      else if Value.TypeInfo = TypeInfo(NullableCurrency) then
+      begin
+        lNullableCurrency := Value.AsType<NullableCurrency>;
+        if lNullableCurrency.HasValue then
+          Result := FloatToStr(lNullableCurrency.Value);
+          //Result := FloatToStr(lNullableCurrency.Value, fLocaleFormatSettings);
+      end
+      else if Value.TypeInfo = TypeInfo(NullableBoolean) then
+      begin
+        lNullableBoolean := Value.AsType<NullableBoolean>;
+        if lNullableBoolean.HasValue then
+          Result := BoolToStr(lNullableBoolean.Value, True);
+      end
+      else if Value.TypeInfo = TypeInfo(NullableTDate) then
+      begin
+        lNullableTDate := Value.AsType<NullableTDate>;
+        if lNullableTDate.HasValue then
+          Result := DateToISO8601(lNullableTDate.Value);
+      end
+      else if Value.TypeInfo = TypeInfo(NullableTTime) then
+      begin
+        lNullableTTime := Value.AsType<NullableTTime>;
+        if lNullableTTime.HasValue then
+          Result := DateToISO8601(lNullableTTime.Value);
+      end
+      else if Value.TypeInfo = TypeInfo(NullableTDateTime) then
+      begin
+        lNullableTDateTime := Value.AsType<NullableTDateTime>;
+        if lNullableTDateTime.HasValue then
+          Result := DateToISO8601(lNullableTDateTime.Value);
+      end
+      else
+      begin
+        raise EWebStencilsException.Create('Unsupported type for variable "' + VarName + '"');
+      end;
+    end
+    else
+    begin
+      case Value.Kind of
+        tkInteger: Result := Value.AsInteger.ToString;
+        tkInt64: Result := Value.AsInt64.ToString;
+        tkString, tkUString, tkWString, tkLString: Result := Value.AsString;
+        tkWChar, tkChar: Result := Value.AsType<Char>;
+        tkFloat: begin
+          if Value.TypeInfo.Name = 'TDate' then
+          begin
+            //Result := DateToStr(Value.AsExtended, fLocaleFormatSettings);
+            Result := DateToStr(Value.AsExtended);
+          end
+          else if Value.TypeInfo.Name = 'TDateTime' then
+          begin
+            //Result := DateTimeToStr(Value.AsExtended, fLocaleFormatSettings);
+            Result := DateTimeToStr(Value.AsExtended);
+          end
+          else
+          begin
+            //Result := FloatToStr(Value.AsExtended, fLocaleFormatSettings);
+            Result := FloatToStr(Value.AsExtended);
+          end;
+        end;
+        tkEnumeration: Result := Value.ToString.ToLower;
+        else
+          raise EWebStencilsException.Create('Unsupported type for variable "' + VarName + '"');
+      end;
+    end;
+  end;
+
+end;
+
+
 initialization
 
 gWSLock := TObject.Create;