Quick.YAML.pas 26 KB

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