unit Myc.Ast.Json.Schema; interface uses system.sysutils, system.classes, system.generics.collections, system.generics.defaults, system.rtti, system.json, Myc.Ast.Nodes, Myc.Ast.Attributes, Myc.Ast.Types, Myc.Ast; type { Generates JSON schema for Structured Output based on AST RTTI. } TAstSchema = class private class function GetJsonType(Kind: TFieldKind): TJSONObject; static; public { Generates a complete JSON schema for LLM structured output APIs. } class function GenerateFullSchema: TJSONObject; static; end; implementation { TAstSchema } class function TAstSchema.GetJsonType(Kind: TFieldKind): TJSONObject; {$region 'helpers'} function JRef(const APath: string): TJSONObject; begin Result := TJSONObject.Create; Result.AddPair('$ref', APath); end; function JDefRef(const ATag: string): TJSONObject; begin Result := JRef('#/$defs/' + ATag); end; function JType(const ATypeName: string): TJSONObject; begin Result := TJSONObject.Create; Result.AddPair('type', ATypeName); end; // Use enum for const strings as it's widely supported function JEnum(const AVal: string): TJSONObject; var arr: TJSONArray; begin Result := JType('string'); arr := TJSONArray.Create; arr.Add(AVal); Result.AddPair('enum', arr); end; // Tuple Array (Fixed items) function JTupleArray(const AItems: array of TJSONValue): TJSONObject; var arr: TJSONArray; item: TJSONValue; count: Integer; begin Result := JType('array'); // "items" as an array defines a Tuple schema in older drafts (supported by Gemini) arr := TJSONArray.Create; for item in AItems do arr.AddElement(item); count := arr.Count; Result.AddPair('items', arr); // Items as Array = Tuple Definition Result.AddPair('minItems', TJSONNumber.Create(count)); Result.AddPair('maxItems', TJSONNumber.Create(count)); Result.AddPair('additionalItems', TJSONBool.Create(False)); // No extra items allowed end; function JTuple(AItems: TJSONValue): TJSONObject; begin // ["Tuple", [...]] Result := JTupleArray([JEnum('Tuple'), AItems]); end; function JAnyOf(AOptions: array of TJSONValue): TJSONObject; var arr: TJSONArray; opt: TJSONValue; begin arr := TJSONArray.Create; for opt in AOptions do arr.AddElement(opt); Result := TJSONObject.Create; Result.AddPair('anyOf', arr); end; {$endregion} var pair, selTuple, entryNode: TJSONObject; begin case Kind of fkNode: Result := JDefRef('Node'); fkTuple: Result := JDefRef('Tuple'); fkKeyword: Result := JDefRef('Key'); fkLambda: Result := JDefRef('Fn'); fkIdentifier: Result := JDefRef('Id'); fkString: Result := JType('string'); fkValue: begin // number | string | boolean Result := JAnyOf([JType('number'), JType('string'), JType('boolean')]); end; fkNullableNode: begin // Node | null // Note: OpenAPI/Gemini often prefers 'nullable: true' over explicit null type, // but anyOf [Node, {type: null}] works in full JSON schema. Result := JAnyOf([JDefRef('Node'), JType('null')]); end; fkArrayOfNodes: begin // standard array of Nodes Result := JType('array'); Result.AddPair('items', JDefRef('Node')); end; fkArrayOfPairs: begin // [[Cond, Branch], ...] pair := JTupleArray([JDefRef('Node'), JDefRef('Node')]); Result := JType('array'); Result.AddPair('items', pair); end; fkPipeInputs: begin // 1. Selector Tuple: ["Tuple", [Key, ...]] // Note: This is an array of Keys inside the Tuple structure var keyArray := JType('array'); keyArray.AddPair('items', JDefRef('Key')); selTuple := JTuple(keyArray); // 2. Entry Node: ["Tuple", [Id, SelectorTuple]] entryNode := JTupleArray([JDefRef('Id'), selTuple]); // 3. Wrap in ["Tuple", [Array of EntryNodes]] var entriesArray := JType('array'); entriesArray.AddPair('items', entryNode); Result := JTuple(entriesArray); end; else Result := TJSONObject.Create; end; end; class function TAstSchema.GenerateFullSchema: TJSONObject; var ctx: TRttiContext; typ: TRttiType; attr: TCustomAttribute; defs, nodeDef, astNodeRef: TJSONObject; anyOfNodes: TJSONArray; tag: string; fields: TList; itemsArr: TJSONArray; // Properties Wrapper props, programProp: TJSONObject; reqArr: TJSONArray; begin ctx := TRttiContext.Create; Result := TJSONObject.Create; defs := TJSONObject.Create; anyOfNodes := TJSONArray.Create; try // 1. Scan all interfaces for typ in ctx.GetTypes do begin if typ.TypeKind <> tkInterface then continue; tag := ''; fields := TList.Create; try for attr in typ.GetAttributes do begin if attr is AstTagAttribute then tag := AstTagAttribute(attr).Tag; if attr is AstFieldAttribute then fields.Add(AstFieldAttribute(attr)); end; if tag = '' then continue; // Sort fields fields.Sort( TComparer .Construct(function(const L, R: AstFieldAttribute): Integer begin Result := L.Index - R.Index; end) ); // Construct Tuple Definition for this Tag: ["Tag", Arg1, Arg2] nodeDef := TJSONObject.Create; nodeDef.AddPair('type', 'array'); itemsArr := TJSONArray.Create; // Item 0: The Tag (as Const/Enum) var tagConst := TJSONObject.Create; tagConst.AddPair('type', 'string'); var enumArr := TJSONArray.Create; enumArr.Add(tag); tagConst.AddPair('enum', enumArr); itemsArr.AddElement(tagConst); // Items 1..N: The Fields for var f in fields do begin itemsArr.AddElement(GetJsonType(f.Kind)); end; nodeDef.AddPair('items', itemsArr); nodeDef.AddPair('minItems', TJSONNumber.Create(itemsArr.Count)); nodeDef.AddPair('maxItems', TJSONNumber.Create(itemsArr.Count)); nodeDef.AddPair('additionalItems', TJSONBool.Create(False)); // Add to defs defs.AddPair(tag, nodeDef); // Add to main Node Union astNodeRef := TJSONObject.Create; astNodeRef.AddPair('$ref', '#/$defs/' + tag); anyOfNodes.AddElement(astNodeRef); finally fields.Free; end; end; // 2. Define generic "Node" union var astNodeBase := TJSONObject.Create; // WICHTIG: Das fehlende "type": "array" hat den Fehler verursacht. astNodeBase.AddPair('type', 'array'); astNodeBase.AddPair('anyOf', anyOfNodes); defs.AddPair('Node', astNodeBase); // 3. ROOT OBJECT WRAPPER Result.AddPair('type', 'object'); props := TJSONObject.Create; programProp := TJSONObject.Create; programProp.AddPair('$ref', '#/$defs/Node'); props.AddPair('program', programProp); Result.AddPair('properties', props); reqArr := TJSONArray.Create; reqArr.Add('program'); Result.AddPair('required', reqArr); Result.AddPair('additionalProperties', TJSONBool.Create(False)); Result.AddPair('$defs', defs); finally ctx.Free; end; end; end.