Quick.YAML.pas 25 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042
  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. {$IFNDEF LINUX}
  443. for line in aData.Split([#13]) do yaml.Add(StringReplace(line,#10,'',[rfReplaceAll]));
  444. {$ELSE}
  445. for line in aData.Split([#10]) do yaml.Add(StringReplace(line,#13,'',[rfReplaceAll]));
  446. {$ENDIF}
  447. while yaml.Count > vIndex do
  448. begin
  449. yamlvalue := ParseValue(yaml,vIndex);
  450. if yamlvalue <> nil then AddDescendant(yamlvalue);
  451. Inc(vIndex);
  452. end;
  453. finally
  454. yaml.Free;
  455. end;
  456. end;
  457. class function TYamlObject.ParseYamlValue(const aData : string) : TYamlAncestor;
  458. var
  459. yaml : TList<string>;
  460. line : string;
  461. yamlvalue : TYamlAncestor;
  462. vIndex : Integer;
  463. begin
  464. yaml := TList<string>.Create;
  465. try
  466. vIndex := 0;
  467. {$IFNDEF LINUX}
  468. for line in aData.Split([#13]) do yaml.Add(StringReplace(line,#10,'',[rfReplaceAll]));
  469. {$ELSE}
  470. for line in aData.Split([#10]) do yaml.Add(StringReplace(line,#13,'',[rfReplaceAll]));
  471. {$ENDIF}
  472. if yaml[0].TrimLeft.StartsWith('- ') then Result := TYamlArray.Create
  473. else Result := TYamlObject.Create;
  474. while yaml.Count > vIndex do
  475. begin
  476. yamlvalue := ParseValue(yaml,vIndex);
  477. if yamlvalue <> nil then Result.AddDescendant(yamlvalue);
  478. Inc(vIndex);
  479. end;
  480. finally
  481. yaml.Free;
  482. end;
  483. end;
  484. function TYamlObject.RemovePair(const aPairName: string): TYamlPair;
  485. var
  486. yamlpair: TYamlPair;
  487. i: Integer;
  488. begin
  489. for i := 0 to Count - 1 do
  490. begin
  491. {$IFNDEF FPC}
  492. yamlpair := TYamlPair(FMembers.List[i]);
  493. {$ELSE}
  494. yamlpair := TYamlPair(fMembers.Items[i]);
  495. {$ENDIF}
  496. if CompareText(yamlpair.Name,aPairName) = 0 then
  497. begin
  498. fMembers.Remove(yamlpair);
  499. Exit(yamlpair);
  500. end;
  501. end;
  502. Result := nil;
  503. end;
  504. function TYamlObject.ToYaml: string;
  505. begin
  506. Result := ParseToYaml(0);
  507. end;
  508. function TYamlObject.ParseToYaml(aIndent : Integer) : string;
  509. var
  510. member : TYamlPair;
  511. yaml : TYamlWriter;
  512. yvalue : TYamlAncestor;
  513. indent : string;
  514. isscalar : Boolean;
  515. rarray : string;
  516. begin
  517. yaml := TYamlWriter.Create;
  518. try
  519. indent := StringOfChar(' ',aIndent);
  520. for member in fMembers do
  521. begin
  522. if member = nil then continue;
  523. yvalue := member.Value;
  524. if yvalue.IsScalar then
  525. begin
  526. if yvalue is TYamlComment then yaml.Writeln(Format('#%s%s',[indent,TYamlComment(member.Value).AsString]))
  527. else yaml.Writeln(Format('%s%s: %s',[indent,member.Name,member.Value.Value.AsString]));
  528. end
  529. else if (yvalue is TYamlObject) then
  530. begin
  531. yaml.Writeln(Format('%s%s:',[indent,member.Name]));
  532. yaml.Write((yvalue as TYamlObject).ParseToYaml(aIndent + 2));
  533. end
  534. else if (yvalue is TYamlArray) then
  535. begin
  536. isscalar := False;
  537. rarray := (yvalue as TYamlArray).ParseToYaml(aIndent + 2,isscalar);
  538. if isscalar then yaml.Writeln(Format('%s%s: %s',[indent,member.Name,rarray]))
  539. else
  540. begin
  541. yaml.Writeln(Format('%s%s:',[indent,member.Name]));
  542. yaml.Write(rarray);
  543. end;
  544. end;
  545. end;
  546. Result := yaml.Text;
  547. finally
  548. yaml.Free;
  549. end;
  550. end;
  551. { TYamlString }
  552. constructor TYamlString.Create(const aValue: string);
  553. begin
  554. inherited Create;
  555. fValue := aValue;
  556. fIsNull := False;
  557. end;
  558. constructor TYamlString.Create;
  559. begin
  560. inherited Create;
  561. fIsNull := True;
  562. end;
  563. function TYamlString.IsNull: Boolean;
  564. begin
  565. Result := fIsNull;
  566. end;
  567. function TYamlString.IsScalar: Boolean;
  568. begin
  569. Result := True;
  570. end;
  571. function TYamlString.AsString: string;
  572. begin
  573. Result := fValue;
  574. end;
  575. function TYamlString.Value: TFlexValue;
  576. begin
  577. Result := fValue;
  578. end;
  579. { TYamlInteger }
  580. constructor TYamlInteger.Create(const aValue: Integer);
  581. begin
  582. inherited Create;
  583. fValue := aValue;
  584. fIsNull := False;
  585. end;
  586. constructor TYamlInteger.Create;
  587. begin
  588. inherited Create;
  589. fIsNull := True;
  590. end;
  591. function TYamlInteger.IsNull: Boolean;
  592. begin
  593. Result := fIsNull;
  594. end;
  595. function TYamlInteger.IsScalar: Boolean;
  596. begin
  597. Result := True;
  598. end;
  599. function TYamlInteger.AsString: string;
  600. begin
  601. Result := IntToStr(fValue);
  602. end;
  603. function TYamlInteger.Value: TFlexValue;
  604. begin
  605. Result := fValue;
  606. end;
  607. { TYamlFloat }
  608. constructor TYamlFloat.Create(const aValue: Double);
  609. begin
  610. inherited Create;
  611. fValue := aValue;
  612. fIsNull := False;
  613. end;
  614. constructor TYamlFloat.Create;
  615. begin
  616. inherited Create;
  617. fIsNull := True;
  618. end;
  619. function TYamlFloat.IsNull: Boolean;
  620. begin
  621. Result := fIsNull;
  622. end;
  623. function TYamlFloat.IsScalar: Boolean;
  624. begin
  625. Result := True;
  626. end;
  627. function TYamlFloat.AsString: string;
  628. begin
  629. Result := FloatToStr(fValue);
  630. end;
  631. function TYamlFloat.Value: TFlexValue;
  632. begin
  633. Result := fValue;
  634. end;
  635. { TYamlPair }
  636. constructor TYamlPair.Create(const aName: string; const aValue: TYamlValue);
  637. begin
  638. inherited Create;
  639. fName := aName;
  640. fValue := aValue;
  641. end;
  642. constructor TYamlPair.Create(const aName, aValue: string);
  643. begin
  644. inherited Create;
  645. fName := aName;
  646. fValue := TYamlString.Create(aValue);
  647. end;
  648. constructor TYamlPair.Create(const aName: string; const aValue: Double);
  649. begin
  650. inherited Create;
  651. fName := aName;
  652. fValue := TYamlFloat.Create(aValue);
  653. end;
  654. constructor TYamlPair.Create(const aName: string; const aValue: Integer);
  655. begin
  656. inherited Create;
  657. fName := aName;
  658. fValue := TYamlInteger.Create(aValue);
  659. end;
  660. destructor TYamlPair.Destroy;
  661. begin
  662. if (fValue <> nil) and fValue.Owned then FreeAndNil(fValue);
  663. inherited Destroy;
  664. end;
  665. function TYamlPair.ToYaml: string;
  666. var
  667. isscalar : Boolean;
  668. begin
  669. if fValue = nil then Exit('null');
  670. if fValue is TYamlObject then Result := TYamlObject(fValue).ToYaml
  671. else if fValue is TYamlArray then Result := TYamlArray(fValue).ParseToYaml(0,isscalar)
  672. else Result := Format('%s: %s',[fName,fValue.Value.AsString]);
  673. end;
  674. procedure TYamlPair.AddDescendant(const aDescendent: TYamlAncestor);
  675. begin
  676. if fName = '' then
  677. fName := TYamlString(aDescendent).Value
  678. else if fValue = nil then
  679. fValue:= TYamlValue(aDescendent)
  680. else inherited AddDescendant(aDescendent);
  681. end;
  682. { TYamlObject.TEnumerator }
  683. constructor TYamlObject.TEnumerator.Create(const aObject: TYamlObject);
  684. begin
  685. inherited Create;
  686. fIndex := -1;
  687. fObject := aObject;
  688. end;
  689. function TYamlObject.TEnumerator.GetCurrent: TYamlPair;
  690. begin
  691. {$IFNDEF FPC}
  692. Result := fObject.fMembers.List[fIndex];
  693. {$ELSE}
  694. Result := fObject.fMembers.Items[fIndex];
  695. {$ENDIF}
  696. end;
  697. function TYamlObject.TEnumerator.MoveNext: Boolean;
  698. begin
  699. Inc(fIndex);
  700. Result := fIndex < fObject.Count;
  701. end;
  702. { TYamlValue }
  703. function TYamlValue.Value: TFlexValue;
  704. begin
  705. Result := '';
  706. end;
  707. { TYamlArray.TEnumerator }
  708. constructor TYamlArray.TEnumerator.Create(const aArray: TYamlArray);
  709. begin
  710. inherited Create;
  711. fIndex := -1;
  712. fArray := aArray;
  713. end;
  714. function TYamlArray.TEnumerator.GetCurrent: TYamlValue;
  715. begin
  716. {$IFNDEF FPC}
  717. Result := fArray.fElements.List[fIndex];
  718. {$ELSE}
  719. Result := fArray.fElements.Items[fIndex];
  720. {$ENDIF}
  721. end;
  722. function TYamlArray.TEnumerator.MoveNext: Boolean;
  723. begin
  724. Inc(fIndex);
  725. Result := fIndex < fArray.Count;
  726. end;
  727. { TYamlArray }
  728. procedure TYamlArray.AddDescendant(const aDescendant: TYamlAncestor);
  729. begin
  730. fElements.Add(TYamlValue(aDescendant));
  731. end;
  732. constructor TYamlArray.Create;
  733. begin
  734. inherited Create;
  735. fElements := TList<TYamlValue>.Create;
  736. end;
  737. constructor TYamlArray.Create(const aFirstElem: TYamlValue);
  738. begin
  739. inherited Create;
  740. AddElement(aFirstElem);
  741. end;
  742. procedure TYamlArray.AddElement(const aElement: TYamlValue);
  743. begin
  744. AddDescendant(aElement);
  745. end;
  746. destructor TYamlArray.Destroy;
  747. var
  748. element: TYamlAncestor;
  749. i: Integer;
  750. begin
  751. if Assigned(fElements) then
  752. for i := 0 to fElements.Count - 1 do
  753. begin
  754. element := fElements[i];
  755. if Assigned(element) and (element.Owned) then element.Free;
  756. end;
  757. if Assigned(fElements) then FreeAndNil(fElements);
  758. inherited Destroy;
  759. end;
  760. function TYamlArray.GetCount: Integer;
  761. begin
  762. Result := fElements.Count;
  763. end;
  764. function TYamlArray.GetEnumerator: TEnumerator;
  765. begin
  766. Result := TEnumerator.Create(Self);
  767. end;
  768. function TYamlArray.GetValue(const aIndex: Integer): TYamlValue;
  769. begin
  770. Result := fElements[aIndex];
  771. end;
  772. function TYamlArray.ParseToYaml(aIndent : Integer; var vIsScalar : Boolean) : string;
  773. var
  774. element : TYamlValue;
  775. yaml : TYamlWriter;
  776. yvalue : TYamlAncestor;
  777. indent : string;
  778. isscalar : Boolean;
  779. begin
  780. Result := '';
  781. yaml := TYamlWriter.Create;
  782. try
  783. indent := StringOfChar(' ',aIndent);
  784. if fElements.Count = 0 then
  785. begin
  786. vIsScalar := True;
  787. Exit('[]');
  788. end;
  789. for element in fElements do
  790. begin
  791. yvalue := element;
  792. if yvalue is TYamlPair then yvalue := TYamlPair(yvalue).value;
  793. if yvalue.IsScalar then
  794. begin
  795. {$IFNDEF FPC}
  796. if Result = '' then Result := element.AsString
  797. else Result := Result + ', ' + element.AsString;
  798. {$ELSE}
  799. if Result = '' then Result := TYamlPair(element).Value.AsString
  800. else Result := Result + ', ' + TYamlPair(element).Value.AsString;
  801. {$ENDIF}
  802. end
  803. else if (yvalue is TYamlObject) then
  804. begin
  805. yaml.Write(indent + '- ' + (yvalue as TYamlObject).ParseToYaml(aIndent + 2).TrimLeft);
  806. end
  807. else if (yvalue is TYamlArray) then
  808. begin
  809. yaml.Write(Format('%s%s',[indent,(yvalue as TYamlArray).ParseToYaml(aIndent + 2,isscalar)]))
  810. end;
  811. end;
  812. if yvalue.IsScalar then
  813. begin
  814. Result := '[' + Result + ']';
  815. vIsScalar := True;
  816. end
  817. else Result := yaml.Text;
  818. finally
  819. yaml.Free;
  820. end;
  821. end;
  822. { TYamlWriter }
  823. procedure TYamlWriter.Write(const aValue: string);
  824. begin
  825. fData := fData + aValue;
  826. end;
  827. procedure TYamlWriter.Writeln(const aValue: string);
  828. begin
  829. fData := fData + aValue + CRLF;
  830. end;
  831. constructor TYamlWriter.Create;
  832. begin
  833. fData := '';
  834. end;
  835. { TYamlNull }
  836. function TYamlNull.IsNull: Boolean;
  837. begin
  838. Result := True;
  839. end;
  840. function TYamlNull.AsString: string;
  841. begin
  842. Result := 'null';
  843. end;
  844. function TYamlNull.Value: TFlexValue;
  845. begin
  846. Result := nil;
  847. end;
  848. { TYamlBoolean }
  849. constructor TYamlBoolean.Create;
  850. begin
  851. inherited Create;
  852. fIsNull := True;
  853. end;
  854. constructor TYamlBoolean.Create(const aValue: Boolean);
  855. begin
  856. inherited Create;
  857. fIsNull := False;
  858. fValue := aValue;
  859. end;
  860. function TYamlBoolean.IsNull: Boolean;
  861. begin
  862. Result := fIsNull;
  863. end;
  864. function TYamlBoolean.IsScalar: Boolean;
  865. begin
  866. Result := True;
  867. end;
  868. function TYamlBoolean.AsString: string;
  869. begin
  870. Result := fValue.ToString(True);
  871. end;
  872. function TYamlBoolean.Value: TFlexValue;
  873. begin
  874. Result := fValue;
  875. end;
  876. { TYamlComment }
  877. function TYamlComment.AsString: string;
  878. begin
  879. Result := fValue;
  880. end;
  881. constructor TYamlComment.Create;
  882. begin
  883. inherited Create;
  884. fIsNull := True;
  885. end;
  886. constructor TYamlComment.Create(const aComment: string);
  887. begin
  888. inherited Create;
  889. fIsNull := False;
  890. fValue := aComment;
  891. end;
  892. function TYamlComment.IsNull: Boolean;
  893. begin
  894. Result := fIsNull;
  895. end;
  896. function TYamlComment.IsScalar: Boolean;
  897. begin
  898. Result := True;
  899. end;
  900. function TYamlComment.Value: TFlexValue;
  901. begin
  902. end;
  903. end.