Quick.YAML.pas 26 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090
  1. { ***************************************************************************
  2. Copyright (c) 2015-2020 Kike Pérez
  3. Unit : Quick.YAML
  4. Description : YAML Object parser
  5. Author : Kike Pérez
  6. Version : 1.1
  7. Created : 17/04/2019
  8. Modified : 03/07/2020
  9. This file is part of QuickLib: https://github.com/exilon/QuickLib
  10. ***************************************************************************
  11. Licensed under the Apache License, Version 2.0 (the "License");
  12. you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at
  14. http://www.apache.org/licenses/LICENSE-2.0
  15. Unless required by applicable law or agreed to in writing, software
  16. distributed under the License is distributed on an "AS IS" BASIS,
  17. WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18. See the License for the specific language governing permissions and
  19. limitations under the License.
  20. *************************************************************************** }
  21. unit Quick.YAML;
  22. {$i QuickLib.inc}
  23. interface
  24. uses
  25. Classes,
  26. SysUtils,
  27. Quick.Commons,
  28. Generics.Collections,
  29. Quick.Value;
  30. type
  31. TYamlScalar = TFlexValue;
  32. TYamlAncestor = class abstract
  33. protected
  34. fOwned : Boolean;
  35. function IsNull : Boolean; virtual;
  36. procedure AddDescendant(const aDescendent: TYamlAncestor); virtual;
  37. public
  38. constructor Create;
  39. property Owned : Boolean read fOwned write fOwned;
  40. property Null : Boolean read IsNull;
  41. function IsScalar : Boolean; virtual;
  42. end;
  43. TYamlValue = class abstract(TYamlAncestor)
  44. public
  45. function Value : TFlexValue; virtual;
  46. function AsString : string; virtual; abstract;
  47. end;
  48. TYamlString = class(TYamlValue)
  49. private
  50. fValue : string;
  51. fIsNull : Boolean;
  52. protected
  53. function IsNull : Boolean; override;
  54. public
  55. constructor Create; overload;
  56. constructor Create(const aValue : string); overload;
  57. function Value : TFlexValue; override;
  58. function IsScalar : Boolean; override;
  59. function AsString : string; override;
  60. end;
  61. TYamlInteger = class(TYamlValue)
  62. private
  63. fValue : Integer;
  64. fIsNull : Boolean;
  65. protected
  66. function IsNull : Boolean; override;
  67. public
  68. constructor Create; overload;
  69. constructor Create(const aValue : Integer); overload;
  70. function Value : TFlexValue; override;
  71. function IsScalar : Boolean; override;
  72. function AsString : string; override;
  73. end;
  74. TYamlFloat = class(TYamlValue)
  75. private
  76. fValue : Double;
  77. fIsNull : Boolean;
  78. protected
  79. function IsNull : Boolean; override;
  80. public
  81. constructor Create; overload;
  82. constructor Create(const aValue : Double); overload;
  83. function Value : TFlexValue; override;
  84. function IsScalar : Boolean; override;
  85. function AsString : string; override;
  86. end;
  87. TYamlBoolean = class(TYamlValue)
  88. private
  89. fValue : Boolean;
  90. fIsNull : Boolean;
  91. protected
  92. function IsNull : Boolean; override;
  93. public
  94. constructor Create; overload;
  95. constructor Create(const aValue : Boolean); overload;
  96. function Value : TFlexValue; override;
  97. function IsScalar : Boolean; override;
  98. function AsString : string; override;
  99. end;
  100. TYamlNull = class(TYamlValue)
  101. protected
  102. function IsNull: Boolean; override;
  103. public
  104. function Value : TFlexValue; override;
  105. function AsString : string; override;
  106. end;
  107. TYamlComment = class(TYamlValue)
  108. private
  109. fValue : string;
  110. fIsNull : Boolean;
  111. protected
  112. function IsNull : Boolean; override;
  113. public
  114. constructor Create; overload;
  115. constructor Create(const aComment : string); overload;
  116. function Value : TFlexValue; override;
  117. function IsScalar : Boolean; override;
  118. function AsString : string; override;
  119. end;
  120. TYamlPair = class(TYamlAncestor)
  121. private
  122. fName : string;
  123. fValue : TYamlValue;
  124. protected
  125. procedure AddDescendant(const aDescendent: TYamlAncestor); override;
  126. public
  127. constructor Create(const aName : string; const aValue : TYamlValue); overload;
  128. constructor Create(const aName : string; const aValue : string); overload;
  129. constructor Create(const aName : string; const aValue : Integer); overload;
  130. constructor Create(const aName : string; const aValue : Double); overload;
  131. destructor Destroy; override;
  132. property Name : string read fName write fName;
  133. property Value : TYamlValue read fValue write fValue;
  134. function ToYaml : string;
  135. end;
  136. TYamlWriter = class
  137. private
  138. fData : string;
  139. public
  140. constructor Create;
  141. property Text : string read fData;
  142. procedure Write(const aValue : string);
  143. procedure Writeln(const aValue : string);
  144. end;
  145. TYamlObject = class(TYamlValue)
  146. public type
  147. TEnumerator = class
  148. private
  149. fIndex: Integer;
  150. fObject: TYamlObject;
  151. public
  152. constructor Create(const aObject: TYamlObject);
  153. function GetCurrent: TYamlPair; inline;
  154. function MoveNext: Boolean; inline;
  155. property Current: TYamlPair read GetCurrent;
  156. end;
  157. private
  158. fMembers : TList<TYamlPair>;
  159. function GetCount : Integer;
  160. class function ParseValue(yaml : TList<string>; var vIndex : Integer): TYamlAncestor;
  161. class function ParsePairName(const aPair : string) : string;
  162. class function ParsePairValue(const aPair : string) : string;
  163. class function ParseArrayValue(const aValue : string) : TYamlValue;
  164. class function GetItemLevel(const aValue : string) : Integer;
  165. function ParseToYaml(aIndent : Integer) : string;
  166. protected
  167. procedure AddDescendant(const aDescendent: TYamlAncestor); override;
  168. public
  169. constructor Create; overload;
  170. constructor Create(const aData : string); overload;
  171. destructor Destroy; override;
  172. function GetValue(const aName: string): TYamlValue;
  173. property Values[const aName: string] : TYamlValue read GetValue;
  174. procedure ParseYaml(const aData : string);
  175. property Count : Integer read GetCount;
  176. class function ParseYamlValue(const aData : string) : TYamlAncestor;
  177. function GetPair(const aIndex : Integer) : TYamlPair;
  178. function GetPairByName(const aPairName : string) : TYamlPair;
  179. function AddPair(const aPair : TYamlPair): TYamlObject; overload;
  180. function AddPair(const aName : string; const aValue : TYamlValue): TYamlObject; overload;
  181. function AddPair(const aName : string; const aValue : string): TYamlObject; overload;
  182. function RemovePair(const aPairName: string): TYamlPair;
  183. function GetEnumerator: TEnumerator; inline;
  184. property Pairs[const aIndex: Integer]: TYamlPair read GetPair;
  185. function ToYaml : string;
  186. function AsString : string; override;
  187. end;
  188. { TYamlArray }
  189. TYamlArray = class(TYamlValue)
  190. public type
  191. TEnumerator = class
  192. private
  193. fIndex : Integer;
  194. fArray : TYamlArray;
  195. public
  196. constructor Create(const aArray: TYamlArray);
  197. function GetCurrent: TYamlValue; inline;
  198. function MoveNext: Boolean; inline;
  199. property Current: TYamlValue read GetCurrent;
  200. end;
  201. private
  202. fElements: TList<TYamlValue>;
  203. function ParseToYaml(aIndent : Integer; var vIsScalar : Boolean) : string;
  204. protected
  205. procedure AddDescendant(const aDescendant: TYamlAncestor); override;
  206. function GetCount: Integer; inline;
  207. function GetValue(const aIndex: Integer): TYamlValue; overload; inline;
  208. public
  209. constructor Create; overload;
  210. constructor Create(const aFirstElem: TYamlValue); overload;
  211. destructor Destroy; override;
  212. property Count: Integer read GetCount;
  213. property Items[const aIndex: Integer]: TYamlValue read GetValue;
  214. procedure AddElement(const aElement: TYamlValue);
  215. function GetEnumerator: TEnumerator; inline;
  216. function AsString : string; override;
  217. end;
  218. EYAMLException = class(Exception);
  219. implementation
  220. const
  221. CRLF = #13#10;
  222. NUM_INDENT = 2;
  223. { TYamlAncestor }
  224. procedure TYamlAncestor.AddDescendant(const aDescendent: TYamlAncestor);
  225. begin
  226. raise EYAMLException.CreateFmt('Cannot add value %s to %s',[aDescendent.ClassName,ClassName]);
  227. end;
  228. constructor TYamlAncestor.Create;
  229. begin
  230. inherited Create;
  231. fOwned := True;
  232. end;
  233. function TYamlAncestor.IsNull: Boolean;
  234. begin
  235. Result := False;
  236. end;
  237. function TYamlAncestor.IsScalar: Boolean;
  238. begin
  239. Result := False;
  240. end;
  241. { TYamlObject }
  242. function TYamlObject.AddPair(const aPair: TYamlPair): TYamlObject;
  243. begin
  244. if aPair <> nil then AddDescendant(aPair);
  245. Result := Self;
  246. end;
  247. function TYamlObject.AddPair(const aName: string; const aValue: TYamlValue): TYamlObject;
  248. begin
  249. if (not aName.IsEmpty) and (aValue <> nil) then AddPair(TYamlPair.Create(aName,aValue));
  250. Result := Self;
  251. end;
  252. procedure TYamlObject.AddDescendant(const aDescendent: TYamlAncestor);
  253. begin
  254. if aDescendent <> nil then fMembers.Add(TYamlPair(aDescendent));
  255. end;
  256. function TYamlObject.AddPair(const aName, aValue: string): TYamlObject;
  257. begin
  258. if not aName.IsEmpty and (not aValue.IsEmpty) then AddPair(TYamlPair.Create(aName,aValue));
  259. Result := Self;
  260. end;
  261. function TYamlObject.AsString: string;
  262. begin
  263. Result := ToYaml;
  264. end;
  265. constructor TYamlObject.Create(const aData: string);
  266. begin
  267. inherited Create;
  268. ParseYaml(aData);
  269. end;
  270. constructor TYamlObject.Create;
  271. begin
  272. inherited Create;
  273. fMembers := TList<TYamlPair>.Create;
  274. end;
  275. destructor TYamlObject.Destroy;
  276. var
  277. member: TYamlAncestor;
  278. i: Integer;
  279. begin
  280. if Assigned(fMembers) then
  281. for i := 0 to fMembers.Count - 1 do
  282. begin
  283. {$IFNDEF FPC}
  284. member := fMembers.List[i];
  285. {$ELSE}
  286. member := fMembers.Items[i];
  287. {$ENDIF}
  288. if Assigned(member) and member.Owned then member.Free;
  289. end;
  290. FreeAndNil(fMembers);
  291. inherited;
  292. end;
  293. function TYamlObject.GetCount: Integer;
  294. begin
  295. Result := fMembers.Count;
  296. end;
  297. function TYamlObject.GetEnumerator: TEnumerator;
  298. begin
  299. Result := TEnumerator.Create(Self);
  300. end;
  301. class function TYamlObject.GetItemLevel(const aValue: string): Integer;
  302. var
  303. i : Integer;
  304. trimed : string;
  305. begin
  306. trimed := aValue.Trim;
  307. if trimed.IsEmpty or trimed.StartsWith('#') then Exit(99999);
  308. for i := Low(aValue) to aValue.Length do
  309. begin
  310. if aValue[i] <> ' ' then Exit(i);
  311. end;
  312. Result := Low(aValue);
  313. end;
  314. function TYamlObject.GetPair(const aIndex: Integer): TYamlPair;
  315. begin
  316. Result := fMembers[aIndex];
  317. end;
  318. function TYamlObject.GetPairByName(const aPairName: string): TYamlPair;
  319. var
  320. yamlpair : TYamlPair;
  321. I: Integer;
  322. begin
  323. for i := 0 to Count - 1 do
  324. begin
  325. {$IFNDEF FPC}
  326. yamlpair := fMembers.List[i];
  327. {$ELSE}
  328. yamlpair := fMembers.Items[i];
  329. {$ENDIF}
  330. if CompareText(yamlpair.Name,aPairName) = 0 then Exit(yamlpair);
  331. end;
  332. Result := nil;
  333. end;
  334. function TYamlObject.GetValue(const aName: string): TYamlValue;
  335. var
  336. ymlpair: TYamlPair;
  337. i: Integer;
  338. begin
  339. for i := 0 to Count - 1 do
  340. begin
  341. {$IFNDEF FPC}
  342. ymlpair := fMembers.List[i];
  343. {$ELSE}
  344. ymlpair := fMembers.Items[i];
  345. {$ENDIF}
  346. if CompareText(ymlpair.Name,aName) = 0 then Exit(ymlpair.Value);
  347. end;
  348. Result := nil;
  349. end;
  350. class function TYamlObject.ParseArrayValue(const aValue: string): TYamlValue;
  351. var
  352. nint : Int64;
  353. nfloat : Double;
  354. begin
  355. if TryStrToInt64(aValue,nint) then Result := TYamlInteger.Create(nint)
  356. else if TryStrToFloat(aValue,nfloat) then Result := TYamlFloat.Create(nfloat)
  357. else Result := TYamlString.Create(aValue);
  358. end;
  359. class function TYamlObject.ParsePairName(const aPair: string): string;
  360. begin
  361. Result := Copy(aPair,0,aPair.IndexOf(':'));
  362. end;
  363. class function TYamlObject.ParsePairValue(const aPair: string): string;
  364. begin
  365. Result := Copy(aPair,aPair.IndexOf(':')+2,aPair.Length).Trim;
  366. end;
  367. class function TYamlObject.ParseValue(yaml : TList<string>; var vIndex : Integer): TYamlAncestor;
  368. type
  369. TYamlType = (ytObject, ytArray, ytScalarArray, ytScalar);
  370. var
  371. name : string;
  372. value : string;
  373. yvalue : TYamlAncestor;
  374. level : Integer;
  375. nextlevel : Integer;
  376. aitem : string;
  377. yamlType : TYamlType;
  378. begin
  379. Result := nil;
  380. level := 0;
  381. while yaml.Count > vIndex do
  382. begin
  383. value := yaml[vIndex].Trim;
  384. name := ParsePairName(value);
  385. if (name.IsEmpty) or (value.IsEmpty) or (value.StartsWith('#')) or (value.StartsWith(#9)) then Exit(nil)
  386. //else if value.StartsWith('#') then Exit(TYamlComment.Create(value))
  387. else if value.StartsWith('-') then
  388. begin
  389. yaml[vIndex] := StringReplace(yaml[vIndex],'-','',[]).TrimLeft;
  390. yamlType := ytObject;
  391. Dec(vIndex);
  392. end
  393. else if value.EndsWith(':') then
  394. begin
  395. if yaml[vIndex + 1].TrimLeft.StartsWith('-') then yamlType := ytArray
  396. else yamlType := ytObject;
  397. end
  398. else if value.IndexOf(':') < value.Length then
  399. begin
  400. value := ParsePairValue(value);
  401. if (value.StartsWith('[')) and (value.EndsWith(']')) then yamlType := ytScalarArray
  402. else yamlType := ytScalar;
  403. end
  404. else yamlType := TYamlType.ytScalar;
  405. case yamlType of
  406. ytArray : //is array
  407. begin
  408. yvalue := TYamlArray.Create;
  409. level := GetItemLevel(yaml[vIndex + 1]);
  410. repeat
  411. Inc(vIndex);
  412. yvalue.AddDescendant(ParseValue(yaml,vIndex));
  413. until (yvalue = nil) or (vIndex >= yaml.Count - 1) or (GetItemLevel(yaml[vIndex + 1]) < level);
  414. Exit(TYamlPair.Create(name,TYamlValue(yvalue)));
  415. end;
  416. ytObject : //is object
  417. begin
  418. yvalue := TYamlObject.Create;
  419. repeat
  420. Inc(vIndex);
  421. nextlevel := GetItemLevel(yaml[vIndex]);
  422. if nextlevel <> 99999 then level := nextlevel;
  423. yvalue.AddDescendant(ParseValue(yaml,vIndex));
  424. //level := GetItemLevel(yaml[vIndex]);
  425. //var level2 := GetItemLevel(yaml[offset + 1]);
  426. until (yvalue = nil) or (vIndex >= yaml.Count - 1) or (GetItemLevel(yaml[vIndex + 1]) < level);
  427. Exit(TYamlPair.Create(name,TYamlValue(yvalue)));
  428. end;
  429. ytScalarArray : //is scalar array
  430. begin
  431. yvalue := TYamlArray.Create;
  432. value := StringReplace(Copy(value,2,Value.Length-2),', ',#9,[rfReplaceAll]);
  433. for aitem in value.Split([#9]) do
  434. begin
  435. yvalue.AddDescendant(ParseArrayValue(aitem));
  436. end;
  437. Exit(TYamlPair.Create(name,TYamlValue(yvalue)));
  438. end;
  439. else Exit(TYamlPair.Create(name,value)); //is scalar
  440. end;
  441. Inc(vIndex);
  442. end;
  443. end;
  444. procedure TYamlObject.ParseYaml(const aData: string);
  445. var
  446. yaml : TList<string>;
  447. line : string;
  448. data : string;
  449. yamlvalue : TYamlAncestor;
  450. vIndex : Integer;
  451. begin
  452. yaml := TList<string>.Create;
  453. try
  454. vIndex := 0;
  455. //normalize tabs
  456. data := StringReplace(aData,#9,Spaces(4),[rfReplaceAll]);
  457. {$IFNDEF LINUX}
  458. for line in data.Split([#13]) do yaml.Add(StringReplace(line,#10,'',[rfReplaceAll]));
  459. {$ELSE}
  460. for line in data.Split([#10]) do yaml.Add(StringReplace(line,#13,'',[rfReplaceAll]));
  461. {$ENDIF}
  462. while yaml.Count > vIndex do
  463. begin
  464. yamlvalue := ParseValue(yaml,vIndex);
  465. if yamlvalue <> nil then AddDescendant(yamlvalue);
  466. Inc(vIndex);
  467. end;
  468. finally
  469. yaml.Free;
  470. end;
  471. end;
  472. class function TYamlObject.ParseYamlValue(const aData : string) : TYamlAncestor;
  473. var
  474. yaml : TList<string>;
  475. line : string;
  476. data : string;
  477. yamlvalue : TYamlAncestor;
  478. vIndex : Integer;
  479. begin
  480. yaml := TList<string>.Create;
  481. try
  482. vIndex := 0;
  483. //normalize tabs
  484. data := StringReplace(aData,#9,Spaces(4),[rfReplaceAll]);
  485. {$IFNDEF LINUX}
  486. for line in data.Split([#13]) do yaml.Add(StringReplace(line,#10,'',[rfReplaceAll]));
  487. {$ELSE}
  488. for line in data.Split([#10]) do yaml.Add(StringReplace(line,#13,'',[rfReplaceAll]));
  489. {$ENDIF}
  490. if yaml[0].TrimLeft.StartsWith('- ') then Result := TYamlArray.Create
  491. else Result := TYamlObject.Create;
  492. while yaml.Count > vIndex do
  493. begin
  494. yamlvalue := ParseValue(yaml,vIndex);
  495. if yamlvalue <> nil then Result.AddDescendant(yamlvalue);
  496. Inc(vIndex);
  497. end;
  498. finally
  499. yaml.Free;
  500. end;
  501. end;
  502. function TYamlObject.RemovePair(const aPairName: string): TYamlPair;
  503. var
  504. yamlpair: TYamlPair;
  505. i: Integer;
  506. begin
  507. for i := 0 to Count - 1 do
  508. begin
  509. {$IFNDEF FPC}
  510. yamlpair := TYamlPair(FMembers.List[i]);
  511. {$ELSE}
  512. yamlpair := TYamlPair(fMembers.Items[i]);
  513. {$ENDIF}
  514. if CompareText(yamlpair.Name,aPairName) = 0 then
  515. begin
  516. fMembers.Remove(yamlpair);
  517. Exit(yamlpair);
  518. end;
  519. end;
  520. Result := nil;
  521. end;
  522. function TYamlObject.ToYaml: string;
  523. begin
  524. Result := ParseToYaml(0);
  525. end;
  526. function TYamlObject.ParseToYaml(aIndent : Integer) : string;
  527. var
  528. i : Integer;
  529. member : TYamlPair;
  530. yaml : TYamlWriter;
  531. yvalue : TYamlAncestor;
  532. indent : string;
  533. isscalar : Boolean;
  534. scalar : string;
  535. rarray : string;
  536. begin
  537. yaml := TYamlWriter.Create;
  538. try
  539. indent := StringOfChar(' ',aIndent);
  540. for i := 0 to fMembers.Count - 1 do
  541. begin
  542. member := fMembers[i];
  543. if member = nil then continue;
  544. yvalue := member.Value;
  545. if (yvalue.IsScalar) or (yvalue is TYamlNull) then
  546. begin
  547. if yvalue is TYamlComment then yaml.Writeln(Format('#%s%s',[indent,TYamlComment(member.Value).AsString]))
  548. else
  549. begin
  550. if yvalue is TYamlNull then scalar := 'null'
  551. else if (yvalue is TYamlFloat) or (yvalue is TYamlBoolean) then scalar := member.Value.AsString
  552. else scalar := member.Value.Value.AsString;
  553. if scalar.IsEmpty then scalar := '""';
  554. yaml.Writeln(Format('%s%s: %s',[indent,member.Name,scalar]));
  555. if (i < fMembers.Count - 1) and (fMembers[i+1].Value is TYamlComment) then yaml.Writeln('');
  556. end;
  557. end
  558. else if (yvalue is TYamlObject) then
  559. begin
  560. yaml.Writeln(Format('%s%s:',[indent,member.Name]));
  561. yaml.Write((yvalue as TYamlObject).ParseToYaml(aIndent + NUM_INDENT));
  562. if aIndent = 0 then yaml.Writeln('');
  563. end
  564. else if (yvalue is TYamlArray) then
  565. begin
  566. isscalar := False;
  567. rarray := (yvalue as TYamlArray).ParseToYaml(aIndent + NUM_INDENT,isscalar);
  568. if isscalar then yaml.Writeln(Format('%s%s: %s',[indent,member.Name,rarray]))
  569. else
  570. begin
  571. yaml.Writeln(Format('%s%s:',[indent,member.Name]));
  572. yaml.Write(rarray);
  573. end;
  574. end;
  575. end;
  576. Result := yaml.Text;
  577. finally
  578. yaml.Free;
  579. end;
  580. end;
  581. { TYamlString }
  582. constructor TYamlString.Create(const aValue: string);
  583. begin
  584. inherited Create;
  585. fValue := aValue;
  586. fIsNull := False;
  587. end;
  588. constructor TYamlString.Create;
  589. begin
  590. inherited Create;
  591. fIsNull := True;
  592. end;
  593. function TYamlString.IsNull: Boolean;
  594. begin
  595. Result := fIsNull;
  596. end;
  597. function TYamlString.IsScalar: Boolean;
  598. begin
  599. Result := True;
  600. end;
  601. function TYamlString.AsString: string;
  602. begin
  603. Result := fValue;
  604. end;
  605. function TYamlString.Value: TFlexValue;
  606. begin
  607. Result := fValue;
  608. end;
  609. { TYamlInteger }
  610. constructor TYamlInteger.Create(const aValue: Integer);
  611. begin
  612. inherited Create;
  613. fValue := aValue;
  614. fIsNull := False;
  615. end;
  616. constructor TYamlInteger.Create;
  617. begin
  618. inherited Create;
  619. fIsNull := True;
  620. end;
  621. function TYamlInteger.IsNull: Boolean;
  622. begin
  623. Result := fIsNull;
  624. end;
  625. function TYamlInteger.IsScalar: Boolean;
  626. begin
  627. Result := True;
  628. end;
  629. function TYamlInteger.AsString: string;
  630. begin
  631. Result := IntToStr(fValue);
  632. end;
  633. function TYamlInteger.Value: TFlexValue;
  634. begin
  635. Result := fValue;
  636. end;
  637. { TYamlFloat }
  638. constructor TYamlFloat.Create(const aValue: Double);
  639. begin
  640. inherited Create;
  641. fValue := aValue;
  642. fIsNull := False;
  643. end;
  644. constructor TYamlFloat.Create;
  645. begin
  646. inherited Create;
  647. fIsNull := True;
  648. end;
  649. function TYamlFloat.IsNull: Boolean;
  650. begin
  651. Result := fIsNull;
  652. end;
  653. function TYamlFloat.IsScalar: Boolean;
  654. begin
  655. Result := True;
  656. end;
  657. function TYamlFloat.AsString: string;
  658. begin
  659. Result := FloatToStr(fValue);
  660. end;
  661. function TYamlFloat.Value: TFlexValue;
  662. begin
  663. Result := fValue;
  664. end;
  665. { TYamlPair }
  666. constructor TYamlPair.Create(const aName: string; const aValue: TYamlValue);
  667. begin
  668. inherited Create;
  669. fName := aName;
  670. fValue := aValue;
  671. end;
  672. constructor TYamlPair.Create(const aName, aValue: string);
  673. begin
  674. inherited Create;
  675. fName := aName;
  676. fValue := TYamlString.Create(aValue);
  677. end;
  678. constructor TYamlPair.Create(const aName: string; const aValue: Double);
  679. begin
  680. inherited Create;
  681. fName := aName;
  682. fValue := TYamlFloat.Create(aValue);
  683. end;
  684. constructor TYamlPair.Create(const aName: string; const aValue: Integer);
  685. begin
  686. inherited Create;
  687. fName := aName;
  688. fValue := TYamlInteger.Create(aValue);
  689. end;
  690. destructor TYamlPair.Destroy;
  691. begin
  692. if (fValue <> nil) and fValue.Owned then FreeAndNil(fValue);
  693. inherited Destroy;
  694. end;
  695. function TYamlPair.ToYaml: string;
  696. var
  697. isscalar : Boolean;
  698. begin
  699. if fValue = nil then Exit('null');
  700. if fValue is TYamlObject then Result := TYamlObject(fValue).ToYaml
  701. else if fValue is TYamlArray then Result := TYamlArray(fValue).ParseToYaml(0,isscalar)
  702. else Result := Format('%s: %s',[fName,fValue.Value.AsString]);
  703. end;
  704. procedure TYamlPair.AddDescendant(const aDescendent: TYamlAncestor);
  705. begin
  706. if fName = '' then
  707. fName := TYamlString(aDescendent).Value
  708. else if fValue = nil then
  709. fValue:= TYamlValue(aDescendent)
  710. else inherited AddDescendant(aDescendent);
  711. end;
  712. { TYamlObject.TEnumerator }
  713. constructor TYamlObject.TEnumerator.Create(const aObject: TYamlObject);
  714. begin
  715. inherited Create;
  716. fIndex := -1;
  717. fObject := aObject;
  718. end;
  719. function TYamlObject.TEnumerator.GetCurrent: TYamlPair;
  720. begin
  721. {$IFNDEF FPC}
  722. Result := fObject.fMembers.List[fIndex];
  723. {$ELSE}
  724. Result := fObject.fMembers.Items[fIndex];
  725. {$ENDIF}
  726. end;
  727. function TYamlObject.TEnumerator.MoveNext: Boolean;
  728. begin
  729. Inc(fIndex);
  730. Result := fIndex < fObject.Count;
  731. end;
  732. { TYamlValue }
  733. function TYamlValue.Value: TFlexValue;
  734. begin
  735. Result := '';
  736. end;
  737. { TYamlArray.TEnumerator }
  738. constructor TYamlArray.TEnumerator.Create(const aArray: TYamlArray);
  739. begin
  740. inherited Create;
  741. fIndex := -1;
  742. fArray := aArray;
  743. end;
  744. function TYamlArray.TEnumerator.GetCurrent: TYamlValue;
  745. begin
  746. {$IFNDEF FPC}
  747. Result := fArray.fElements.List[fIndex];
  748. {$ELSE}
  749. Result := fArray.fElements.Items[fIndex];
  750. {$ENDIF}
  751. end;
  752. function TYamlArray.TEnumerator.MoveNext: Boolean;
  753. begin
  754. Inc(fIndex);
  755. Result := fIndex < fArray.Count;
  756. end;
  757. { TYamlArray }
  758. procedure TYamlArray.AddDescendant(const aDescendant: TYamlAncestor);
  759. begin
  760. fElements.Add(TYamlValue(aDescendant));
  761. end;
  762. constructor TYamlArray.Create;
  763. begin
  764. inherited Create;
  765. fElements := TList<TYamlValue>.Create;
  766. end;
  767. constructor TYamlArray.Create(const aFirstElem: TYamlValue);
  768. begin
  769. inherited Create;
  770. AddElement(aFirstElem);
  771. end;
  772. procedure TYamlArray.AddElement(const aElement: TYamlValue);
  773. begin
  774. if aElement <> nil then AddDescendant(aElement);
  775. end;
  776. function TYamlArray.AsString: string;
  777. var
  778. first : Boolean;
  779. element : TYamlValue;
  780. begin
  781. first := True;
  782. for element in fElements do
  783. begin
  784. if first then Result := Result + element.AsString
  785. else Result := Result + ',' + element.AsString;
  786. end;
  787. Result := Format('[%s]',[Result]);
  788. end;
  789. destructor TYamlArray.Destroy;
  790. var
  791. element: TYamlAncestor;
  792. i: Integer;
  793. begin
  794. if Assigned(fElements) then
  795. for i := 0 to fElements.Count - 1 do
  796. begin
  797. element := fElements[i];
  798. if Assigned(element) and (element.Owned) then element.Free;
  799. end;
  800. if Assigned(fElements) then FreeAndNil(fElements);
  801. inherited Destroy;
  802. end;
  803. function TYamlArray.GetCount: Integer;
  804. begin
  805. Result := fElements.Count;
  806. end;
  807. function TYamlArray.GetEnumerator: TEnumerator;
  808. begin
  809. Result := TEnumerator.Create(Self);
  810. end;
  811. function TYamlArray.GetValue(const aIndex: Integer): TYamlValue;
  812. begin
  813. Result := fElements[aIndex];
  814. end;
  815. function TYamlArray.ParseToYaml(aIndent : Integer; var vIsScalar : Boolean) : string;
  816. var
  817. element : TYamlValue;
  818. yaml : TYamlWriter;
  819. yvalue : TYamlAncestor;
  820. indent : string;
  821. isscalar : Boolean;
  822. begin
  823. Result := '';
  824. yvalue := nil;
  825. yaml := TYamlWriter.Create;
  826. try
  827. indent := StringOfChar(' ',aIndent);
  828. if fElements.Count = 0 then
  829. begin
  830. vIsScalar := True;
  831. Exit('[]');
  832. end;
  833. for element in fElements do
  834. begin
  835. yvalue := element;
  836. if yvalue is TYamlPair then yvalue := TYamlPair(yvalue).value;
  837. if yvalue.IsScalar then
  838. begin
  839. {$IFNDEF FPC}
  840. if Result = '' then Result := element.AsString
  841. else Result := Result + ', ' + element.AsString;
  842. {$ELSE}
  843. if Result = '' then Result := TYamlPair(element).Value.AsString
  844. else Result := Result + ', ' + TYamlPair(element).Value.AsString;
  845. {$ENDIF}
  846. end
  847. else if (yvalue is TYamlObject) then
  848. begin
  849. yaml.Write(indent + '- ' + (yvalue as TYamlObject).ParseToYaml(aIndent + NUM_INDENT).TrimLeft);
  850. end
  851. else if (yvalue is TYamlArray) then
  852. begin
  853. yaml.Write(Format('%s%s',[indent,(yvalue as TYamlArray).ParseToYaml(aIndent + NUM_INDENT,isscalar)]))
  854. end;
  855. yaml.Writeln('');
  856. end;
  857. if (yvalue <> nil) and (yvalue.IsScalar) then
  858. begin
  859. Result := '[' + Result + ']';
  860. vIsScalar := True;
  861. end
  862. else Result := yaml.Text;
  863. finally
  864. yaml.Free;
  865. end;
  866. end;
  867. { TYamlWriter }
  868. procedure TYamlWriter.Write(const aValue: string);
  869. begin
  870. fData := fData + aValue;
  871. end;
  872. procedure TYamlWriter.Writeln(const aValue: string);
  873. begin
  874. fData := fData + aValue + CRLF;
  875. end;
  876. constructor TYamlWriter.Create;
  877. begin
  878. fData := '';
  879. end;
  880. { TYamlNull }
  881. function TYamlNull.IsNull: Boolean;
  882. begin
  883. Result := True;
  884. end;
  885. function TYamlNull.AsString: string;
  886. begin
  887. Result := 'null';
  888. end;
  889. function TYamlNull.Value: TFlexValue;
  890. begin
  891. Result := nil;
  892. end;
  893. { TYamlBoolean }
  894. constructor TYamlBoolean.Create;
  895. begin
  896. inherited Create;
  897. fIsNull := True;
  898. end;
  899. constructor TYamlBoolean.Create(const aValue: Boolean);
  900. begin
  901. inherited Create;
  902. fIsNull := False;
  903. fValue := aValue;
  904. end;
  905. function TYamlBoolean.IsNull: Boolean;
  906. begin
  907. Result := fIsNull;
  908. end;
  909. function TYamlBoolean.IsScalar: Boolean;
  910. begin
  911. Result := True;
  912. end;
  913. function TYamlBoolean.AsString: string;
  914. begin
  915. Result := BoolToStr(fValue,True).ToLower;
  916. end;
  917. function TYamlBoolean.Value: TFlexValue;
  918. begin
  919. Result := fValue;
  920. end;
  921. { TYamlComment }
  922. function TYamlComment.AsString: string;
  923. begin
  924. Result := fValue;
  925. end;
  926. constructor TYamlComment.Create;
  927. begin
  928. inherited Create;
  929. fIsNull := True;
  930. end;
  931. constructor TYamlComment.Create(const aComment: string);
  932. begin
  933. inherited Create;
  934. fIsNull := False;
  935. fValue := aComment;
  936. end;
  937. function TYamlComment.IsNull: Boolean;
  938. begin
  939. Result := fIsNull;
  940. end;
  941. function TYamlComment.IsScalar: Boolean;
  942. begin
  943. Result := True;
  944. end;
  945. function TYamlComment.Value: TFlexValue;
  946. begin
  947. end;
  948. end.