[Quick.Options] Some improvements

- Validator refactorized
- Hidden options
- GetFileNameSections

Quick.Options.Serializer.Json.pas

@@ -1,13 +1,13 @@
 { ***************************************************************************
 
-  Copyright (c) 2015-2019 Kike Pérez
+  Copyright (c) 2015-2020 Kike Pérez
 
   Unit        : Quick.Options.Serializer.Json
   Description : Configuration groups Json Serializer
   Author      : Kike Pérez
   Version     : 1.0
   Created     : 18/10/2019
-  Modified    : 28/11/2019
+  Modified    : 07/02/2020
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -48,11 +48,13 @@ type
   TJsonOptionsSerializer = class(TOptionsSerializer)
   private
     fSerializer : TRTTIJson;
+    function ParseFile(const aFilename : string; out aJsonObj : TJsonObject) : Boolean;
   public
     constructor Create;
     destructor Destroy; override;
     function Load(const aFilename : string; aSections : TSectionList; aFailOnSectionNotExists : Boolean) : Boolean; override;
     procedure Save(const aFilename : string; aSections : TSectionList); override;
+    function GetFileSectionNames(const aFilename : string; out oSections : TArray<string>) : Boolean; override;
   end;
 
 implementation
@@ -70,6 +72,41 @@ begin
   inherited;
 end;
 
+function TJsonOptionsSerializer.GetFileSectionNames(const aFilename: string; out oSections: TArray<string>): Boolean;
+var
+  json : TJsonObject;
+  jpair : TJSONPair;
+  i : Integer;
+begin
+  Result := False;
+  json := nil;
+  if ParseFile(aFilename,json) then
+  begin
+    try
+      for i := 0 to json.Count - 1 do
+      begin
+        oSections := oSections + [json.Pairs[i].JsonString.Value];
+      end;
+      Result := True;
+    finally
+      json.Free;
+    end;
+  end;
+end;
+
+function TJsonOptionsSerializer.ParseFile(const aFilename : string; out aJsonObj : TJsonObject) : Boolean;
+var
+  fileoptions : string;
+begin
+  aJsonObj := nil;
+  if FileExists(aFilename) then
+  begin
+    fileoptions := TFile.ReadAllText(aFilename,TEncoding.UTF8);
+    aJsonObj := TJsonObject.ParseJSONValue(fileoptions) as TJsonObject;
+  end;
+  Result := aJsonObj <> nil;
+end;
+
 function TJsonOptionsSerializer.Load(const aFilename : string; aSections : TSectionList; aFailOnSectionNotExists : Boolean) : Boolean;
 var
   option : TOptions;
@@ -78,26 +115,28 @@ var
   jpair : TJSONPair;
 begin
   Result := False;
-  if FileExists(aFilename) then
+  if ParseFile(aFilename,json) then
   begin
-    //read option file
-    fileoptions := TFile.ReadAllText(aFilename,TEncoding.UTF8);
-    json := TJSONObject.ParseJSONValue(fileoptions) as TJSONObject;
-    for option in aSections do
-    begin
-      jpair := fSerializer.GetJsonPairByName(json,option.Name);
-      if jpair = nil then
-      begin
-        if aFailOnSectionNotExists then raise Exception.CreateFmt('Config section "%s" not found',[option.Name])
-          else Continue;
-      end;
-      if jpair.JsonValue <> nil then
+    try
+      for option in aSections do
       begin
-        //deserialize option
-        fSerializer.DeserializeObject(option,jpair.JsonValue as TJSONObject);
-        //validate loaded configuration
-        option.ValidateOptions;
+        jpair := fSerializer.GetJsonPairByName(json,option.Name);
+        if jpair = nil then
+        begin
+          if aFailOnSectionNotExists then raise Exception.CreateFmt('Config section "%s" not found',[option.Name])
+            else Continue;
+        end;
+        if jpair.JsonValue <> nil then
+        begin
+          //deserialize option
+          fSerializer.DeserializeObject(option,jpair.JsonValue as TJSONObject);
+          //validate loaded configuration
+          option.ValidateOptions;
+        end;
       end;
+      Result := True;
+    finally
+      json.Free;
     end;
   end;
 end;
@@ -113,14 +152,17 @@ begin
   try
     for option in aSections do
     begin
-      //validate configuration before save
-      option.ValidateOptions;
-      //serialize option
-      jpair := fSerializer.Serialize(option.Name,option);
-      json.AddPair(jpair);
+      if not option.HideOptions then
+      begin
+        //validate configuration before save
+        option.ValidateOptions;
+        //serialize option
+        jpair := fSerializer.Serialize(option.Name,option);
+        json.AddPair(jpair);
+      end;
     end;
     fileoptions := TJsonUtils.JsonFormat(json.ToJSON);
-    TFile.WriteAllText(aFilename,fileoptions);
+    if not fileoptions.IsEmpty then TFile.WriteAllText(aFilename,fileoptions);
   finally
     json.Free;
   end;

Quick.Options.Serializer.Yaml.pas

@@ -1,13 +1,13 @@
 { ***************************************************************************
 
-  Copyright (c) 2015-2019 Kike Pérez
+  Copyright (c) 2015-2020 Kike Pérez
 
   Unit        : Quick.Options.Serializer.Yaml
   Description : Configuration groups Yaml Serializer
   Author      : Kike Pérez
   Version     : 1.0
   Created     : 18/10/2019
-  Modified    : 28/11/2019
+  Modified    : 07/02/2020
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -47,11 +47,13 @@ type
   TYamlOptionsSerializer = class(TOptionsSerializer)
   private
     fSerializer : TRTTIYaml;
+    function ParseFile(const aFilename : string; out aYamlObj : TYamlObject) : Boolean;
   public
     constructor Create;
     destructor Destroy; override;
     function Load(const aFilename : string; aSections : TSectionList; aFailOnSectionNotExists : Boolean) : Boolean; override;
     procedure Save(const aFilename : string; aSections : TSectionList); override;
+    function GetFileSectionNames(const aFilename : string; out oSections : TArray<string>) : Boolean; override;
   end;
 
 implementation
@@ -69,6 +71,41 @@ begin
   inherited;
 end;
 
+function TYamlOptionsSerializer.GetFileSectionNames(const aFilename : string; out oSections : TArray<string>) : Boolean;
+var
+  yaml : TYamlObject;
+  ypair : TYamlPair;
+  i : Integer;
+begin
+  Result := False;
+  yaml := nil;
+  if ParseFile(aFilename,yaml) then
+  begin
+    try
+      for i := 0 to yaml.Count - 1 do
+      begin
+        oSections := oSections + [yaml.Pairs[i].Name];
+      end;
+      Result := True;
+    finally
+      yaml.Free;
+    end;
+  end;
+end;
+
+function TYamlOptionsSerializer.ParseFile(const aFilename : string; out aYamlObj : TYamlObject) : Boolean;
+var
+  fileoptions : string;
+begin
+  aYamlObj := nil;
+  if FileExists(aFilename) then
+  begin
+    fileoptions := TFile.ReadAllText(aFilename,TEncoding.UTF8);
+    aYamlObj := TYamlObject.ParseYAMLValue(fileoptions) as TYamlObject;
+  end;
+  Result := aYamlObj <> nil;
+end;
+
 function TYamlOptionsSerializer.Load(const aFilename : string; aSections : TSectionList; aFailOnSectionNotExists : Boolean) : Boolean;
 var
   option : TOptions;
@@ -77,26 +114,28 @@ var
   ypair : TYamlPair;
 begin
   Result := False;
-  if FileExists(aFilename) then
+  //read option file
+  if ParseFile(aFilename,yaml) then
   begin
-    //read option file
-    fileoptions := TFile.ReadAllText(aFilename,TEncoding.UTF8);
-    yaml := TYamlObject.ParseYAMLValue(fileoptions) as TYamlObject;
-    for option in aSections do
-    begin
-      ypair := fSerializer.GetYamlPairByName(yaml,option.Name);
-      if ypair = nil then
-      begin
-        if aFailOnSectionNotExists then raise Exception.CreateFmt('Config section "%s" not found',[option.Name])
-          else Continue;
-      end;
-      if ypair.Value <> nil then
+    try
+      for option in aSections do
       begin
-        //deserialize option
-        fSerializer.DeserializeObject(option,ypair.Value as TYamlObject);
-        //validate loaded configuration
-        option.ValidateOptions;
+        ypair := fSerializer.GetYamlPairByName(yaml,option.Name);
+        if ypair = nil then
+        begin
+          if aFailOnSectionNotExists then raise Exception.CreateFmt('Config section "%s" not found',[option.Name])
+            else Continue;
+        end;
+        if ypair.Value <> nil then
+        begin
+          //deserialize option
+          fSerializer.DeserializeObject(option,ypair.Value as TYamlObject);
+          //validate loaded configuration
+          option.ValidateOptions;
+        end;
       end;
+    finally
+      yaml.Free;
     end;
   end;
 end;
@@ -112,14 +151,17 @@ begin
   try
     for option in aSections do
     begin
-      //validate configuration before save
-      option.ValidateOptions;
-      //serialize option
-      jpair := fSerializer.Serialize(option.Name,option);
-      yaml.AddPair(jpair);
+      if not option.HideOptions then
+      begin
+        //validate configuration before save
+        option.ValidateOptions;
+        //serialize option
+        jpair := fSerializer.Serialize(option.Name,option);
+        yaml.AddPair(jpair);
+      end;
     end;
     fileoptions := yaml.ToYaml;
-    TFile.WriteAllText(aFilename,fileoptions);
+    if not fileoptions.IsEmpty then TFile.WriteAllText(aFilename,fileoptions);
   finally
     yaml.Free;
   end;

Quick.Options.pas

@@ -1,13 +1,13 @@
 { ***************************************************************************
 
-  Copyright (c) 2015-2019 Kike Pérez
+  Copyright (c) 2015-2020 Kike Pérez
 
   Unit        : Quick.Options
   Description : Configuration group settings
   Author      : Kike Pérez
   Version     : 1.0
   Created     : 18/10/2019
-  Modified    : 16/12/2019
+  Modified    : 07/02/2020
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -36,11 +36,10 @@ interface
 uses
   Classes,
   RTTI,
-  Quick.RTTI.Utils,
   System.TypInfo,
   System.SysUtils,
   System.Generics.Collections,
-  System.Json,
+  Quick.RTTI.Utils,
   Quick.Commons,
   Quick.FileMonitor;
 
@@ -82,28 +81,33 @@ type
     procedure ValidateOptions;
   end;
 
-  IOptionsConfigure<T> = interface
-  ['{49258BEB-A21D-4C64-BA71-767B8DBD4D92}']
-    //function ConfigureOptions(aOptionsFunc : TConfigureOptionsProc<T>) : IOptionsValidator;
-  end;
-
   TOptions = class(TInterfacedObject,IOptionsValidator)
   private
     fName : string;
-    procedure ValidateRequired(const aInstance : TObject; aProperty: TRttiProperty);
-    procedure ValidateStringLength(const aInstance : TObject; aProperty: TRttiProperty; aValidation : StringLength);
-    procedure ValidateRange(const aInstance : TObject; aProperty: TRttiProperty; aValidation : Range);
+    fHideOptions : Boolean;
     procedure DoValidateOptions; virtual;
-    procedure ValidateObject(aObj : TObject);
-    procedure ValidateArray(aValue : TValue);
   public
-    constructor Create;
+    constructor Create; virtual;
     property Name : string read fName write fName;
+    property HideOptions : Boolean read fHideOptions write fHideOptions;
     procedure DefaultValues; virtual;
     function ConfigureOptions<T : TOptions>(aOptionsFunc : TConfigureOptionsProc<T>) : IOptionsValidator;
     procedure ValidateOptions;
   end;
 
+  TOptionsValidator = class(TInterfacedObject,IOptionsValidator)
+  private
+    fOptions : TOptions;
+  public
+    constructor Create(aOptions : TOptions);
+    procedure ValidateRequired(const aInstance : TObject; aProperty: TRttiProperty);
+    procedure ValidateStringLength(const aInstance : TObject; aProperty: TRttiProperty; aValidation : StringLength);
+    procedure ValidateRange(const aInstance : TObject; aProperty: TRttiProperty; aValidation : Range);
+    procedure ValidateObject(aObj : TObject);
+    procedure ValidateArray(aValue : TValue);
+    procedure ValidateOptions;
+  end;
+
   TOptions<T : TOptions> = record
   private
     fOptions : T;
@@ -125,6 +129,7 @@ type
     function AddSection(aOption : TOptionsClass; const aOptionsName : string = '') : TOptions;
     function GetOptions(aOptionClass : TOptionsClass): TOptions;
     function GetSection(aOptionsSection : TOptionsClass; var vOptions : TOptions) : Boolean; overload;
+    procedure AddOption(aOption : TOptions);
   end;
 
   TSectionList = TObjectList<TOptions>;
@@ -133,12 +138,14 @@ type
   ['{7DECE203-4AAE-4C9D-86C8-B3D583DF7C8B}']
     function Load(const aFilename : string; aSections : TSectionList; aFailOnSectionNotExists : Boolean) : Boolean;
     procedure Save(const aFilename : string; aSections : TSectionList);
+    function GetFileSectionNames(const aFilename : string; out oSections : TArray<string>) : Boolean;
   end;
 
   TOptionsSerializer = class(TInterfacedObject,IOptionsSerializer)
   public
     function Load(const aFilename : string; aSections : TSectionList; aFailOnSectionNotExists : Boolean) : Boolean; virtual; abstract;
     procedure Save(const aFilename : string; aSections : TSectionList); virtual; abstract;
+    function GetFileSectionNames(const aFilename : string; out oSections : TArray<string>) : Boolean; virtual; abstract;
   end;
 
   TFileModifiedEvent = reference to procedure;
@@ -183,8 +190,10 @@ type
     property Items[aIndex : Integer] : TOptions read GetOptions; default;
     function AddSection(aOption : TOptionsClass; const aSectionName : string = '') : TOptions; overload;
     function AddSection<T : TOptions>(const aSectionName : string = '') : TOptions<T>; overload;
+    procedure AddOption(aOption : TOptions);
     function GetSectionInterface<T : TOptions> : IOptions<T>;
     function GetSection<T : TOptions>(const aSectionName : string = '') : T; overload;
+    function GetFileSectionNames(out oSections : TArray<string>) : Boolean;
     function Count : Integer;
     procedure Load(aFailOnSectionNotExists : Boolean = False);
     procedure Save;
@@ -215,7 +224,7 @@ implementation
 constructor TOptionsContainer.Create(const aFilename : string; aOptionsSerializer : IOptionsSerializer; aReloadIfFileChanged : Boolean = False);
 begin
   fSerializer := aOptionsSerializer;
-  fSections := TSectionList.Create(True);
+  fSections := TSectionList.Create(False);
   fFilename := aFilename;
   fLoaded := False;
   fReloadIfFileChanged := aReloadIfFileChanged;
@@ -233,9 +242,15 @@ begin
 end;
 
 destructor TOptionsContainer.Destroy;
+var
+  option : TOptions;
 begin
   if Assigned(fFileMonitor) then fFileMonitor.Free;
   fSerializer := nil;
+  for option in fSections do
+  begin
+    if option.RefCount = 0 then option.Free;
+  end;
   fSections.Free;
   inherited;
 end;
@@ -252,10 +267,19 @@ begin
   end;
 end;
 
+procedure TOptionsContainer.AddOption(aOption: TOptions);
+begin
+  if aOption.Name.IsEmpty then aOption.Name := Copy(aOption.ClassName,2,aOption.ClassName.Length);
+  fSections.Add(aOption);
+end;
+
 function TOptionsContainer.AddSection(aOption : TOptionsClass; const aSectionName : string = '') : TOptions;
 var
   option : TOptions;
 begin
+  //if section already exists, returns it
+  option := Self.GetOptions(aOption);
+  if option <> nil then Exit(option);
   option := aOption.Create;
   if aSectionName.IsEmpty then option.Name := Copy(aOption.ClassName,2,aOption.ClassName.Length)
     else option.Name := aSectionName;
@@ -267,6 +291,10 @@ function TOptionsContainer.AddSection<T>(const aSectionName: string): TOptions<T
 var
   option : TOptions;
 begin
+  //if section already exists, returns it
+  option := Self.GetSection<T>(aSectionName);
+  if option <> nil then Exit(TOptions<T>(option));
+  //new section
   option := TRTTI.CreateInstance<T>;
   if aSectionName.IsEmpty then option.Name := Copy(T.ClassName,2,T.ClassName.Length)
     else option.Name := aSectionName;
@@ -279,6 +307,11 @@ begin
   Result := fSections.Count;
 end;
 
+function TOptionsContainer.GetFileSectionNames(out oSections : TArray<string>) : Boolean;
+begin
+  Result := fSerializer.GetFileSectionNames(fFilename,oSections);
+end;
+
 function TOptionsContainer.GetOptions(aIndex: Integer): TOptions;
 begin
   Result := fSections[aIndex];
@@ -306,7 +339,7 @@ begin
   Result := nil;
   for option in fSections do
   begin
-    if option is TOptionsClass then Result := option as TOptionsClass;
+    if option is aOptionClass then Result := option as TOptionsClass;
   end;
 end;
 
@@ -314,6 +347,7 @@ function TOptionsContainer.GetSection<T>(const aSectionName : string = '') : T;
 var
   option : TOptions;
 begin
+  Result := nil;
   for option in fSections do
   begin
     if option is T then
@@ -360,15 +394,19 @@ var
   laststate : Boolean;
 begin
   //disable filemonitor to avoid detect manual save as a external file change
-  laststate := fFileMonitor.Enabled;
-  fFileMonitor.Enabled := False;
-  try
-    //save config file
-    fSerializer.Save(fFilename,fSections);
-  finally
-    //set last state
-    fFileMonitor.Enabled := laststate;
-  end;
+  if fReloadIfFileChanged then
+  begin
+    laststate := fFileMonitor.Enabled;
+    fFileMonitor.Enabled := False;
+    try
+      //save config file
+      fSerializer.Save(fFilename,fSections);
+    finally
+      //set last state
+      fFileMonitor.Enabled := laststate;
+    end;
+  end
+  else fSerializer.Save(fFilename,fSections);
 end;
 
 procedure TOptionsContainer.SetReloadIfFileChanged(const Value: Boolean);
@@ -385,7 +423,7 @@ function TOptions.ConfigureOptions<T>(aOptionsFunc: TConfigureOptionsProc<T>): I
 var
   value : TValue;
 begin
-  Result := Self;
+  Result := TOptionsValidator.Create(Self);
   if Assigned(aOptionsFunc) then
   begin
     value := Self;
@@ -396,6 +434,7 @@ end;
 constructor TOptions.Create;
 begin
   fName := '';
+  fHideOptions := False;
 end;
 
 procedure TOptions.DefaultValues;
@@ -404,11 +443,28 @@ begin
 end;
 
 procedure TOptions.DoValidateOptions;
+var
+  ivalidator : IOptionsValidator;
 begin
-  ValidateObject(Self);
+  ivalidator := TOptionsValidator.Create(Self);
+  ivalidator.ValidateOptions;
+end;
+
+procedure TOptions.ValidateOptions;
+begin
+  try
+    DoValidateOptions;
+  except
+    on E : Exception do
+    begin
+      raise EOptionConfigureError.CreateFmt('Validation Options Error : %s',[e.Message]);
+    end;
+  end;
 end;
 
-procedure TOptions.ValidateObject(aObj : TObject);
+{ TOptionsValidator }
+
+procedure TOptionsValidator.ValidateObject(aObj : TObject);
 var
   ctx : TRttiContext;
   rtype : TRttiType;
@@ -446,7 +502,17 @@ begin
   end;
 end;
 
-procedure TOptions.ValidateArray(aValue : TValue);
+constructor TOptionsValidator.Create(aOptions: TOptions);
+begin
+  fOptions := aOptions;
+end;
+
+procedure TOptionsValidator.ValidateOptions;
+begin
+  ValidateObject(fOptions);
+end;
+
+procedure TOptionsValidator.ValidateArray(aValue : TValue);
 type
   PPByte = ^PByte;
 var
@@ -474,19 +540,7 @@ begin
   end;
 end;
 
-procedure TOptions.ValidateOptions;
-begin
-  try
-    DoValidateOptions;
-  except
-    on E : Exception do
-    begin
-      raise EOptionConfigureError.CreateFmt('Validation Options Error : %s',[e.Message]);
-    end;
-  end;
-end;
-
-procedure TOptions.ValidateRange(const aInstance : TObject; aProperty: TRttiProperty; aValidation : Range);
+procedure TOptionsValidator.ValidateRange(const aInstance : TObject; aProperty: TRttiProperty; aValidation : Range);
 var
   value : TValue;
   msg : string;
@@ -498,7 +552,7 @@ begin
     begin
       if (value.AsExtended < aValidation.Min) or (value.AsExtended > aValidation.Max) then
       begin
-        if aValidation.ErrorMsg.IsEmpty then msg := Format('Option %s "%s.%s" exceeds predefined range (%2f - %2f)',[Self.Name,aInstance.ClassName,aProperty.Name,aValidation.Min,aValidation.Max])
+        if aValidation.ErrorMsg.IsEmpty then msg := Format('Option %s "%s.%s" exceeds predefined range (%2f - %2f)',[fOptions.Name,aInstance.ClassName,aProperty.Name,aValidation.Min,aValidation.Max])
           else msg := aValidation.ErrorMsg;
         raise EOptionValidationError.Create(msg);
       end;
@@ -507,7 +561,7 @@ begin
     begin
       if (value.AsInt64 < aValidation.Min) or (value.AsInt64 > aValidation.Max) then
       begin
-        if aValidation.ErrorMsg.IsEmpty then msg := Format('Option %s "%s.%s" exceeds predefined range (%d - %d)',[Self.Name,aInstance.ClassName,aProperty.Name,Round(aValidation.Min),Round(aValidation.Max)])
+        if aValidation.ErrorMsg.IsEmpty then msg := Format('Option %s "%s.%s" exceeds predefined range (%d - %d)',[fOptions.Name,aInstance.ClassName,aProperty.Name,Round(aValidation.Min),Round(aValidation.Max)])
           else msg := aValidation.ErrorMsg;
         raise EOptionValidationError.Create(msg);
       end;
@@ -515,12 +569,12 @@ begin
   end;
 end;
 
-procedure TOptions.ValidateRequired(const aInstance : TObject; aProperty: TRttiProperty);
+procedure TOptionsValidator.ValidateRequired(const aInstance : TObject; aProperty: TRttiProperty);
 begin
-  if aProperty.GetValue(aInstance).IsEmpty then raise EOptionValidationError.CreateFmt('Option %s "%s.%s" is required',[Self.Name,aInstance.ClassName,aProperty.Name]);
+  if aProperty.GetValue(aInstance).IsEmpty then raise EOptionValidationError.CreateFmt('Option %s "%s.%s" is required',[fOptions.Name,aInstance.ClassName,aProperty.Name]);
 end;
 
-procedure TOptions.ValidateStringLength(const aInstance : TObject; aProperty: TRttiProperty; aValidation : StringLength);
+procedure TOptionsValidator.ValidateStringLength(const aInstance : TObject; aProperty: TRttiProperty; aValidation : StringLength);
 var
   value : TValue;
   msg : string;
@@ -528,7 +582,7 @@ begin
   value := aProperty.GetValue(aInstance);
   if (not value.IsEmpty) and (value.AsString.Length > aValidation.MaxLength) then
   begin
-    if aValidation.ErrorMsg.IsEmpty then msg := Format('Option %s "%s.%s" exceeds max length (%d)',[Self.Name,aInstance.ClassName,aProperty.Name,aValidation.MaxLength])
+    if aValidation.ErrorMsg.IsEmpty then msg := Format('Option %s "%s.%s" exceeds max length (%d)',[fOptions.Name,aInstance.ClassName,aProperty.Name,aValidation.MaxLength])
       else msg := aValidation.ErrorMsg;
 
     raise EOptionValidationError.Create(msg);
@@ -577,8 +631,7 @@ end;
 function TOptions<T>.ConfigureOptions(aOptionsFunc: TConfigureOptionsProc<T>): IOptionsValidator;
 begin
   if Assigned(aOptionsFunc) then Result := fOptions.ConfigureOptions<T>(aOptionsFunc)
-    else Result := fOptions;
-  fOptions._AddRef;
+    else Result := TOptionsValidator.Create(fOptions);
 end;
 
 constructor TOptions<T>.Create(aOptions: T);