2
0

Quick.YAML.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092
  1. { ***************************************************************************
  2. Copyright (c) 2015-2022 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 : 07/03/2022
  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. NUM_INDENT = 2;
  222. { TYamlAncestor }
  223. procedure TYamlAncestor.AddDescendant(const aDescendent: TYamlAncestor);
  224. begin
  225. raise EYAMLException.CreateFmt('Cannot add value %s to %s',[aDescendent.ClassName,ClassName]);
  226. end;
  227. constructor TYamlAncestor.Create;
  228. begin
  229. inherited Create;
  230. fOwned := True;
  231. end;
  232. function TYamlAncestor.IsNull: Boolean;
  233. begin
  234. Result := False;
  235. end;
  236. function TYamlAncestor.IsScalar: Boolean;
  237. begin
  238. Result := False;
  239. end;
  240. { TYamlObject }
  241. function TYamlObject.AddPair(const aPair: TYamlPair): TYamlObject;
  242. begin
  243. if aPair <> nil then AddDescendant(aPair);
  244. Result := Self;
  245. end;
  246. function TYamlObject.AddPair(const aName: string; const aValue: TYamlValue): TYamlObject;
  247. begin
  248. if (not aName.IsEmpty) and (aValue <> nil) then AddPair(TYamlPair.Create(aName,aValue));
  249. Result := Self;
  250. end;
  251. procedure TYamlObject.AddDescendant(const aDescendent: TYamlAncestor);
  252. begin
  253. if aDescendent <> nil then fMembers.Add(TYamlPair(aDescendent));
  254. end;
  255. function TYamlObject.AddPair(const aName, aValue: string): TYamlObject;
  256. begin
  257. if not aName.IsEmpty and (not aValue.IsEmpty) then AddPair(TYamlPair.Create(aName,aValue));
  258. Result := Self;
  259. end;
  260. function TYamlObject.AsString: string;
  261. begin
  262. Result := ToYaml;
  263. end;
  264. constructor TYamlObject.Create(const aData: string);
  265. begin
  266. inherited Create;
  267. ParseYaml(aData);
  268. end;
  269. constructor TYamlObject.Create;
  270. begin
  271. inherited Create;
  272. fMembers := TList<TYamlPair>.Create;
  273. end;
  274. destructor TYamlObject.Destroy;
  275. var
  276. member: TYamlAncestor;
  277. i: Integer;
  278. begin
  279. if Assigned(fMembers) then
  280. for i := 0 to fMembers.Count - 1 do
  281. begin
  282. {$IFNDEF FPC}
  283. member := fMembers.List[i];
  284. {$ELSE}
  285. member := fMembers.Items[i];
  286. {$ENDIF}
  287. if Assigned(member) and member.Owned then member.Free;
  288. end;
  289. FreeAndNil(fMembers);
  290. inherited;
  291. end;
  292. function TYamlObject.GetCount: Integer;
  293. begin
  294. Result := fMembers.Count;
  295. end;
  296. function TYamlObject.GetEnumerator: TEnumerator;
  297. begin
  298. Result := TEnumerator.Create(Self);
  299. end;
  300. class function TYamlObject.GetItemLevel(const aValue: string): Integer;
  301. var
  302. i : Integer;
  303. trimed : string;
  304. begin
  305. trimed := aValue.Trim;
  306. if trimed.IsEmpty or trimed.StartsWith('#') then Exit(99999);
  307. for i := Low(aValue) to aValue.Length do
  308. begin
  309. if aValue[i] <> ' ' then Exit(i);
  310. end;
  311. Result := Low(aValue);
  312. end;
  313. function TYamlObject.GetPair(const aIndex: Integer): TYamlPair;
  314. begin
  315. Result := fMembers[aIndex];
  316. end;
  317. function TYamlObject.GetPairByName(const aPairName: string): TYamlPair;
  318. var
  319. yamlpair : TYamlPair;
  320. I: Integer;
  321. begin
  322. for i := 0 to Count - 1 do
  323. begin
  324. {$IFNDEF FPC}
  325. yamlpair := fMembers.List[i];
  326. {$ELSE}
  327. yamlpair := fMembers.Items[i];
  328. {$ENDIF}
  329. if CompareText(yamlpair.Name,aPairName) = 0 then Exit(yamlpair);
  330. end;
  331. Result := nil;
  332. end;
  333. function TYamlObject.GetValue(const aName: string): TYamlValue;
  334. var
  335. ymlpair: TYamlPair;
  336. i: Integer;
  337. begin
  338. for i := 0 to Count - 1 do
  339. begin
  340. {$IFNDEF FPC}
  341. ymlpair := fMembers.List[i];
  342. {$ELSE}
  343. ymlpair := fMembers.Items[i];
  344. {$ENDIF}
  345. if CompareText(ymlpair.Name,aName) = 0 then Exit(ymlpair.Value);
  346. end;
  347. Result := nil;
  348. end;
  349. class function TYamlObject.ParseArrayValue(const aValue: string): TYamlValue;
  350. var
  351. nint : Int64;
  352. nfloat : Double;
  353. begin
  354. if TryStrToInt64(aValue,nint) then Result := TYamlInteger.Create(nint)
  355. else if TryStrToFloat(aValue,nfloat) then Result := TYamlFloat.Create(nfloat)
  356. else Result := TYamlString.Create(aValue);
  357. end;
  358. class function TYamlObject.ParsePairName(const aPair: string): string;
  359. begin
  360. Result := Copy(aPair,0,aPair.IndexOf(':'));
  361. end;
  362. class function TYamlObject.ParsePairValue(const aPair: string): string;
  363. begin
  364. Result := AnsiDequotedStr(Copy(aPair,aPair.IndexOf(':')+2,aPair.Length).Trim, '"');
  365. end;
  366. class function TYamlObject.ParseValue(yaml : TList<string>; var vIndex : Integer): TYamlAncestor;
  367. type
  368. TYamlType = (ytObject, ytArray, ytScalarArray, ytScalar);
  369. var
  370. name : string;
  371. value : string;
  372. yvalue : TYamlAncestor;
  373. level : Integer;
  374. nextlevel : Integer;
  375. aitem : string;
  376. yamlType : TYamlType;
  377. begin
  378. Result := nil;
  379. level := 0;
  380. while yaml.Count > vIndex do
  381. begin
  382. value := yaml[vIndex].Trim;
  383. name := ParsePairName(value);
  384. if (name.IsEmpty) or (value.IsEmpty) or (value.StartsWith('#')) or (value.StartsWith(#9)) then Exit(nil)
  385. //else if value.StartsWith('#') then Exit(TYamlComment.Create(value))
  386. else if value.StartsWith('-') then
  387. begin
  388. yaml[vIndex] := StringReplace(yaml[vIndex],'-','',[]).TrimLeft;
  389. yamlType := ytObject;
  390. Dec(vIndex);
  391. end
  392. else if value.EndsWith(':') then
  393. begin
  394. if yaml[vIndex + 1].TrimLeft.StartsWith('-') then yamlType := ytArray
  395. else yamlType := ytObject;
  396. end
  397. else if value.IndexOf(':') < value.Length then
  398. begin
  399. value := ParsePairValue(value);
  400. if (value.StartsWith('[')) and (value.EndsWith(']')) then yamlType := ytScalarArray
  401. else yamlType := ytScalar;
  402. end
  403. else yamlType := TYamlType.ytScalar;
  404. case yamlType of
  405. ytArray : //is array
  406. begin
  407. yvalue := TYamlArray.Create;
  408. level := GetItemLevel(yaml[vIndex + 1]);
  409. repeat
  410. Inc(vIndex);
  411. yvalue.AddDescendant(ParseValue(yaml,vIndex));
  412. until (yvalue = nil) or (vIndex >= yaml.Count - 1) or (GetItemLevel(yaml[vIndex + 1]) < level);
  413. Exit(TYamlPair.Create(name,TYamlValue(yvalue)));
  414. end;
  415. ytObject : //is object
  416. begin
  417. yvalue := TYamlObject.Create;
  418. repeat
  419. Inc(vIndex);
  420. nextlevel := GetItemLevel(yaml[vIndex]);
  421. if nextlevel <> 99999 then level := nextlevel;
  422. yvalue.AddDescendant(ParseValue(yaml,vIndex));
  423. //level := GetItemLevel(yaml[vIndex]);
  424. //var level2 := GetItemLevel(yaml[offset + 1]);
  425. until (yvalue = nil) or (vIndex >= yaml.Count - 1) or (GetItemLevel(yaml[vIndex + 1]) < level);
  426. Exit(TYamlPair.Create(name,TYamlValue(yvalue)));
  427. end;
  428. ytScalarArray : //is scalar array
  429. begin
  430. yvalue := TYamlArray.Create;
  431. value := StringReplace(Copy(value,2,Value.Length-2),', ',#9,[rfReplaceAll]);
  432. for aitem in value.Split([#9]) do
  433. begin
  434. yvalue.AddDescendant(ParseArrayValue(aitem));
  435. end;
  436. Exit(TYamlPair.Create(name,TYamlValue(yvalue)));
  437. end;
  438. else Exit(TYamlPair.Create(name,value)); //is scalar
  439. end;
  440. Inc(vIndex);
  441. end;
  442. end;
  443. procedure TYamlObject.ParseYaml(const aData: string);
  444. var
  445. yaml : TList<string>;
  446. line : string;
  447. data : string;
  448. yamlvalue : TYamlAncestor;
  449. vIndex : Integer;
  450. begin
  451. yaml := TList<string>.Create;
  452. try
  453. vIndex := 0;
  454. //normalize tabs
  455. data := StringReplace(aData,#9,Spaces(NUM_INDENT),[rfReplaceAll]);
  456. {$IFDEF MSWINDOWS}
  457. for line in data.Split([#13]) do yaml.Add(StringReplace(line,#10,'',[rfReplaceAll]));
  458. {$ELSE}
  459. for line in data.Split([#10]) do yaml.Add(StringReplace(line,#13,'',[rfReplaceAll]));
  460. {$ENDIF}
  461. while yaml.Count > vIndex do
  462. begin
  463. yamlvalue := ParseValue(yaml,vIndex);
  464. if yamlvalue <> nil then AddDescendant(yamlvalue);
  465. Inc(vIndex);
  466. end;
  467. finally
  468. yaml.Free;
  469. end;
  470. end;
  471. class function TYamlObject.ParseYamlValue(const aData : string) : TYamlAncestor;
  472. var
  473. yaml : TList<string>;
  474. line : string;
  475. data : string;
  476. yamlvalue : TYamlAncestor;
  477. vIndex : Integer;
  478. begin
  479. yaml := TList<string>.Create;
  480. try
  481. vIndex := 0;
  482. //normalize tabs
  483. data := StringReplace(aData,#9,Spaces(NUM_INDENT),[rfReplaceAll]);
  484. {$IFDEF MSWINDOWS}
  485. for line in data.Split([#13]) do yaml.Add(StringReplace(line,#10,'',[rfReplaceAll]));
  486. {$ELSE}
  487. for line in data.Split([#10]) do yaml.Add(StringReplace(line,#13,'',[rfReplaceAll]));
  488. {$ENDIF}
  489. if yaml[0].TrimLeft.StartsWith('- ') then Result := TYamlArray.Create
  490. else Result := TYamlObject.Create;
  491. while yaml.Count > vIndex do
  492. begin
  493. yamlvalue := ParseValue(yaml,vIndex);
  494. if yamlvalue <> nil then Result.AddDescendant(yamlvalue);
  495. Inc(vIndex);
  496. end;
  497. finally
  498. yaml.Free;
  499. end;
  500. end;
  501. function TYamlObject.RemovePair(const aPairName: string): TYamlPair;
  502. var
  503. yamlpair: TYamlPair;
  504. i: Integer;
  505. begin
  506. for i := 0 to Count - 1 do
  507. begin
  508. {$IFNDEF FPC}
  509. yamlpair := TYamlPair(FMembers.List[i]);
  510. {$ELSE}
  511. yamlpair := TYamlPair(fMembers.Items[i]);
  512. {$ENDIF}
  513. if CompareText(yamlpair.Name,aPairName) = 0 then
  514. begin
  515. fMembers.Remove(yamlpair);
  516. Exit(yamlpair);
  517. end;
  518. end;
  519. Result := nil;
  520. end;
  521. function TYamlObject.ToYaml: string;
  522. begin
  523. Result := ParseToYaml(0);
  524. end;
  525. function TYamlObject.ParseToYaml(aIndent : Integer) : string;
  526. const
  527. SPECIAL_CHARS: array[1..19] of Char = (':', '{', '}', '[', ']', ',', '&', '*', '#', '?', '|', '-', '<', '>', '=', '!', '%', '@', '\');
  528. var
  529. i : Integer;
  530. member : TYamlPair;
  531. yaml : TYamlWriter;
  532. yvalue : TYamlAncestor;
  533. indent : string;
  534. isscalar : Boolean;
  535. scalar : string;
  536. rarray : string;
  537. begin
  538. yaml := TYamlWriter.Create;
  539. try
  540. indent := StringOfChar(' ',aIndent);
  541. for i := 0 to fMembers.Count - 1 do
  542. begin
  543. member := fMembers[i];
  544. if member = nil then continue;
  545. yvalue := member.Value;
  546. if (yvalue.IsScalar) or (yvalue is TYamlNull) then
  547. begin
  548. if yvalue is TYamlComment then yaml.Writeln(Format('#%s%s',[indent,TYamlComment(member.Value).AsString]))
  549. else
  550. begin
  551. if yvalue is TYamlNull then scalar := 'null'
  552. else if (yvalue is TYamlFloat) or (yvalue is TYamlBoolean) then scalar := member.Value.AsString
  553. else scalar := member.Value.Value.AsString;
  554. if scalar.IsEmpty then scalar := '""';
  555. if scalar.IndexOfAny(SPECIAL_CHARS) > -1 then
  556. scalar := AnsiQuotedStr(scalar, '"');
  557. yaml.Writeln(Format('%s%s: %s',[indent,member.Name,scalar]));
  558. if (i < fMembers.Count - 1) and (fMembers[i+1].Value is TYamlComment) then yaml.Writeln('');
  559. end;
  560. end
  561. else if (yvalue is TYamlObject) then
  562. begin
  563. yaml.Writeln(Format('%s%s:',[indent,member.Name]));
  564. yaml.Write((yvalue as TYamlObject).ParseToYaml(aIndent + NUM_INDENT));
  565. if aIndent = 0 then yaml.Writeln('');
  566. end
  567. else if (yvalue is TYamlArray) then
  568. begin
  569. isscalar := False;
  570. rarray := (yvalue as TYamlArray).ParseToYaml(aIndent + NUM_INDENT,isscalar);
  571. if isscalar then yaml.Writeln(Format('%s%s: %s',[indent,member.Name,rarray]))
  572. else
  573. begin
  574. yaml.Writeln(Format('%s%s:',[indent,member.Name]));
  575. yaml.Write(rarray);
  576. end;
  577. end;
  578. end;
  579. Result := yaml.Text;
  580. finally
  581. yaml.Free;
  582. end;
  583. end;
  584. { TYamlString }
  585. constructor TYamlString.Create(const aValue: string);
  586. begin
  587. inherited Create;
  588. fValue := aValue;
  589. fIsNull := False;
  590. end;
  591. constructor TYamlString.Create;
  592. begin
  593. inherited Create;
  594. fIsNull := True;
  595. end;
  596. function TYamlString.IsNull: Boolean;
  597. begin
  598. Result := fIsNull;
  599. end;
  600. function TYamlString.IsScalar: Boolean;
  601. begin
  602. Result := True;
  603. end;
  604. function TYamlString.AsString: string;
  605. begin
  606. Result := fValue;
  607. end;
  608. function TYamlString.Value: TFlexValue;
  609. begin
  610. Result := fValue;
  611. end;
  612. { TYamlInteger }
  613. constructor TYamlInteger.Create(const aValue: Integer);
  614. begin
  615. inherited Create;
  616. fValue := aValue;
  617. fIsNull := False;
  618. end;
  619. constructor TYamlInteger.Create;
  620. begin
  621. inherited Create;
  622. fIsNull := True;
  623. end;
  624. function TYamlInteger.IsNull: Boolean;
  625. begin
  626. Result := fIsNull;
  627. end;
  628. function TYamlInteger.IsScalar: Boolean;
  629. begin
  630. Result := True;
  631. end;
  632. function TYamlInteger.AsString: string;
  633. begin
  634. Result := IntToStr(fValue);
  635. end;
  636. function TYamlInteger.Value: TFlexValue;
  637. begin
  638. Result := fValue;
  639. end;
  640. { TYamlFloat }
  641. constructor TYamlFloat.Create(const aValue: Double);
  642. begin
  643. inherited Create;
  644. fValue := aValue;
  645. fIsNull := False;
  646. end;
  647. constructor TYamlFloat.Create;
  648. begin
  649. inherited Create;
  650. fIsNull := True;
  651. end;
  652. function TYamlFloat.IsNull: Boolean;
  653. begin
  654. Result := fIsNull;
  655. end;
  656. function TYamlFloat.IsScalar: Boolean;
  657. begin
  658. Result := True;
  659. end;
  660. function TYamlFloat.AsString: string;
  661. begin
  662. Result := FloatToStr(fValue);
  663. end;
  664. function TYamlFloat.Value: TFlexValue;
  665. begin
  666. Result := fValue;
  667. end;
  668. { TYamlPair }
  669. constructor TYamlPair.Create(const aName: string; const aValue: TYamlValue);
  670. begin
  671. inherited Create;
  672. fName := aName;
  673. fValue := aValue;
  674. end;
  675. constructor TYamlPair.Create(const aName, aValue: string);
  676. begin
  677. inherited Create;
  678. fName := aName;
  679. fValue := TYamlString.Create(aValue);
  680. end;
  681. constructor TYamlPair.Create(const aName: string; const aValue: Double);
  682. begin
  683. inherited Create;
  684. fName := aName;
  685. fValue := TYamlFloat.Create(aValue);
  686. end;
  687. constructor TYamlPair.Create(const aName: string; const aValue: Integer);
  688. begin
  689. inherited Create;
  690. fName := aName;
  691. fValue := TYamlInteger.Create(aValue);
  692. end;
  693. destructor TYamlPair.Destroy;
  694. begin
  695. if (fValue <> nil) and fValue.Owned then FreeAndNil(fValue);
  696. inherited Destroy;
  697. end;
  698. function TYamlPair.ToYaml: string;
  699. var
  700. isscalar : Boolean;
  701. begin
  702. if fValue = nil then Exit('null');
  703. if fValue is TYamlObject then Result := TYamlObject(fValue).ToYaml
  704. else if fValue is TYamlArray then Result := TYamlArray(fValue).ParseToYaml(0,isscalar)
  705. else Result := Format('%s: %s',[fName,fValue.Value.AsString]);
  706. end;
  707. procedure TYamlPair.AddDescendant(const aDescendent: TYamlAncestor);
  708. begin
  709. if fName = '' then
  710. fName := TYamlString(aDescendent).Value
  711. else if fValue = nil then
  712. fValue:= TYamlValue(aDescendent)
  713. else inherited AddDescendant(aDescendent);
  714. end;
  715. { TYamlObject.TEnumerator }
  716. constructor TYamlObject.TEnumerator.Create(const aObject: TYamlObject);
  717. begin
  718. inherited Create;
  719. fIndex := -1;
  720. fObject := aObject;
  721. end;
  722. function TYamlObject.TEnumerator.GetCurrent: TYamlPair;
  723. begin
  724. {$IFNDEF FPC}
  725. Result := fObject.fMembers.List[fIndex];
  726. {$ELSE}
  727. Result := fObject.fMembers.Items[fIndex];
  728. {$ENDIF}
  729. end;
  730. function TYamlObject.TEnumerator.MoveNext: Boolean;
  731. begin
  732. Inc(fIndex);
  733. Result := fIndex < fObject.Count;
  734. end;
  735. { TYamlValue }
  736. function TYamlValue.Value: TFlexValue;
  737. begin
  738. Result := '';
  739. end;
  740. { TYamlArray.TEnumerator }
  741. constructor TYamlArray.TEnumerator.Create(const aArray: TYamlArray);
  742. begin
  743. inherited Create;
  744. fIndex := -1;
  745. fArray := aArray;
  746. end;
  747. function TYamlArray.TEnumerator.GetCurrent: TYamlValue;
  748. begin
  749. {$IFNDEF FPC}
  750. Result := fArray.fElements.List[fIndex];
  751. {$ELSE}
  752. Result := fArray.fElements.Items[fIndex];
  753. {$ENDIF}
  754. end;
  755. function TYamlArray.TEnumerator.MoveNext: Boolean;
  756. begin
  757. Inc(fIndex);
  758. Result := fIndex < fArray.Count;
  759. end;
  760. { TYamlArray }
  761. procedure TYamlArray.AddDescendant(const aDescendant: TYamlAncestor);
  762. begin
  763. fElements.Add(TYamlValue(aDescendant));
  764. end;
  765. constructor TYamlArray.Create;
  766. begin
  767. inherited Create;
  768. fElements := TList<TYamlValue>.Create;
  769. end;
  770. constructor TYamlArray.Create(const aFirstElem: TYamlValue);
  771. begin
  772. inherited Create;
  773. AddElement(aFirstElem);
  774. end;
  775. procedure TYamlArray.AddElement(const aElement: TYamlValue);
  776. begin
  777. if aElement <> nil then AddDescendant(aElement);
  778. end;
  779. function TYamlArray.AsString: string;
  780. var
  781. first : Boolean;
  782. element : TYamlValue;
  783. begin
  784. first := True;
  785. for element in fElements do
  786. begin
  787. if first then Result := Result + element.AsString
  788. else Result := Result + ',' + element.AsString;
  789. end;
  790. Result := Format('[%s]',[Result]);
  791. end;
  792. destructor TYamlArray.Destroy;
  793. var
  794. element: TYamlAncestor;
  795. i: Integer;
  796. begin
  797. if Assigned(fElements) then
  798. for i := 0 to fElements.Count - 1 do
  799. begin
  800. element := fElements[i];
  801. if Assigned(element) and (element.Owned) then element.Free;
  802. end;
  803. if Assigned(fElements) then FreeAndNil(fElements);
  804. inherited Destroy;
  805. end;
  806. function TYamlArray.GetCount: Integer;
  807. begin
  808. Result := fElements.Count;
  809. end;
  810. function TYamlArray.GetEnumerator: TEnumerator;
  811. begin
  812. Result := TEnumerator.Create(Self);
  813. end;
  814. function TYamlArray.GetValue(const aIndex: Integer): TYamlValue;
  815. begin
  816. Result := fElements[aIndex];
  817. end;
  818. function TYamlArray.ParseToYaml(aIndent : Integer; var vIsScalar : Boolean) : string;
  819. var
  820. element : TYamlValue;
  821. yaml : TYamlWriter;
  822. yvalue : TYamlAncestor;
  823. indent : string;
  824. isscalar : Boolean;
  825. begin
  826. Result := '';
  827. yvalue := nil;
  828. yaml := TYamlWriter.Create;
  829. try
  830. indent := StringOfChar(' ',aIndent);
  831. if fElements.Count = 0 then
  832. begin
  833. vIsScalar := True;
  834. Exit('[]');
  835. end;
  836. for element in fElements do
  837. begin
  838. yvalue := element;
  839. if yvalue is TYamlPair then yvalue := TYamlPair(yvalue).value;
  840. if yvalue.IsScalar then
  841. begin
  842. {$IFNDEF FPC}
  843. if Result = '' then Result := element.AsString
  844. else Result := Result + ', ' + element.AsString;
  845. {$ELSE}
  846. if Result = '' then Result := TYamlPair(element).Value.AsString
  847. else Result := Result + ', ' + TYamlPair(element).Value.AsString;
  848. {$ENDIF}
  849. end
  850. else if (yvalue is TYamlObject) then
  851. begin
  852. yaml.Write(indent + '- ' + (yvalue as TYamlObject).ParseToYaml(aIndent + NUM_INDENT).TrimLeft);
  853. end
  854. else if (yvalue is TYamlArray) then
  855. begin
  856. yaml.Write(Format('%s%s',[indent,(yvalue as TYamlArray).ParseToYaml(aIndent + NUM_INDENT,isscalar)]))
  857. end;
  858. yaml.Writeln('');
  859. end;
  860. if (yvalue <> nil) and (yvalue.IsScalar) then
  861. begin
  862. Result := '[' + Result + ']';
  863. vIsScalar := True;
  864. end
  865. else Result := yaml.Text;
  866. finally
  867. yaml.Free;
  868. end;
  869. end;
  870. { TYamlWriter }
  871. procedure TYamlWriter.Write(const aValue: string);
  872. begin
  873. fData := fData + aValue;
  874. end;
  875. procedure TYamlWriter.Writeln(const aValue: string);
  876. begin
  877. fData := fData + aValue + CRLF;
  878. end;
  879. constructor TYamlWriter.Create;
  880. begin
  881. fData := '';
  882. end;
  883. { TYamlNull }
  884. function TYamlNull.IsNull: Boolean;
  885. begin
  886. Result := True;
  887. end;
  888. function TYamlNull.AsString: string;
  889. begin
  890. Result := 'null';
  891. end;
  892. function TYamlNull.Value: TFlexValue;
  893. begin
  894. Result := nil;
  895. end;
  896. { TYamlBoolean }
  897. constructor TYamlBoolean.Create;
  898. begin
  899. inherited Create;
  900. fIsNull := True;
  901. end;
  902. constructor TYamlBoolean.Create(const aValue: Boolean);
  903. begin
  904. inherited Create;
  905. fIsNull := False;
  906. fValue := aValue;
  907. end;
  908. function TYamlBoolean.IsNull: Boolean;
  909. begin
  910. Result := fIsNull;
  911. end;
  912. function TYamlBoolean.IsScalar: Boolean;
  913. begin
  914. Result := True;
  915. end;
  916. function TYamlBoolean.AsString: string;
  917. begin
  918. Result := BoolToStr(fValue,True).ToLower;
  919. end;
  920. function TYamlBoolean.Value: TFlexValue;
  921. begin
  922. Result := fValue;
  923. end;
  924. { TYamlComment }
  925. function TYamlComment.AsString: string;
  926. begin
  927. Result := fValue;
  928. end;
  929. constructor TYamlComment.Create;
  930. begin
  931. inherited Create;
  932. fIsNull := True;
  933. end;
  934. constructor TYamlComment.Create(const aComment: string);
  935. begin
  936. inherited Create;
  937. fIsNull := False;
  938. fValue := aComment;
  939. end;
  940. function TYamlComment.IsNull: Boolean;
  941. begin
  942. Result := fIsNull;
  943. end;
  944. function TYamlComment.IsScalar: Boolean;
  945. begin
  946. Result := True;
  947. end;
  948. function TYamlComment.Value: TFlexValue;
  949. begin
  950. end;
  951. end.