Quick.YAML.pas 25 KB

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