MycLib/Src/AST/Myc.Ast.Json.Schema.pas

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<AstFieldAttribute>;
    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<AstFieldAttribute>.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<AstFieldAttribute>
                        .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.