Quick.YAML.pas 24 KB

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