MycLib/Src/AST/Myc.Fmx.AstEditor.Controller.pas

unit Myc.Fmx.AstEditor.Controller;

interface

uses
    System.SysUtils,
    System.Classes,
    System.Types,
    System.Math.Vectors,
    System.Generics.Collections,
    FMX.Types,
    FMX.Controls,
    Myc.Ast,
    Myc.Ast.Nodes,
    Myc.Ast.Identities,
    Myc.Ast.Types,
    Myc.Ast.Visitor,
    Myc.Ast.Scope,
    Myc.Ast.Environment,
    Myc.Fmx.AstEditor,
    Myc.Fmx.AstEditor.Workspace;

type
    TAstEditorController = class
    private
        type
            TNodeMap = TDictionary<IAstIdentity, TAstViewNode>;
            TUndoStack = TStack<IAstNode>;

            TTypePropagator = class(TAstVisitor)
            private
                FMap: TNodeMap;
                procedure ApplyType(const Node: IAstNode);
            protected
                procedure Accept(const Node: IAstNode); override;
            public
                constructor Create(AMap: TNodeMap);
            end;

    private
        FEnv: TAstEnvironment;
        FWorkspace: TWorkspace;
        FNodeMap: TNodeMap;
        FRootViewNode: TAstViewNode;

        // State Tracking
        FCurrentAst: IAstNode;

        // Undo/Redo Stacks
        FUndoStack: TUndoStack;
        FRedoStack: TUndoStack;
        FIsUndoing: Boolean;

        procedure CollectNodes(Parent: TControl);
        procedure ClearVisuals;
        procedure ApplyErrors(const Log: ICompilerLog);
        procedure ApplyTypes(const TypedAst: IAstNode);
        procedure RootResized(Sender: TObject);

        procedure HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer);

        procedure CommitSnapshot;

    public
        constructor Create(const AEnv: TAstEnvironment; AWorkspace: TWorkspace);
        destructor Destroy; override;

        procedure ValidateAndShow;
        procedure SetRoot(const AstNode: IAstNode);

        procedure Undo;
        procedure Redo;
        function CanUndo: Boolean;
        function CanRedo: Boolean;

        // Expose current AST for external use (saving etc.)
        property CurrentAst: IAstNode read FCurrentAst;
    end;

implementation

uses
    Myc.Data.Value,
    Myc.Fmx.AstEditor.Visualizer;

{ TAstEditorController }

constructor TAstEditorController.Create(const AEnv: TAstEnvironment; AWorkspace: TWorkspace);
begin
    inherited Create;
    FEnv := AEnv;
    FWorkspace := AWorkspace;
    FWorkspace.OnNodeDragDrop := HandleNodeDragDrop;
    FNodeMap := TNodeMap.Create;

    FUndoStack := TUndoStack.Create;
    FRedoStack := TUndoStack.Create;
    FIsUndoing := False;
    FCurrentAst := nil;
end;

destructor TAstEditorController.Destroy;
begin
    // Cleaning up FCurrentAst is done by ARC automatically
    SetRoot(nil);
    FNodeMap.Free;
    FUndoStack.Free;
    FRedoStack.Free;
    inherited;
end;

procedure TAstEditorController.CommitSnapshot;
begin
    // Optimization: Push the already known AST instead of recreating it from UI.
    // Since AST nodes are immutable interfaces, storing the reference is safe.
    if Assigned(FCurrentAst) and (not FIsUndoing) then
    begin
        FUndoStack.Push(FCurrentAst);
        FRedoStack.Clear;
    end;
end;

procedure TAstEditorController.Undo;
var
    prevAst: IAstNode;
begin
    if FUndoStack.Count = 0 then
        exit;

    FIsUndoing := True;
    try
        // Capture current state for Redo
        if Assigned(FCurrentAst) then
            FRedoStack.Push(FCurrentAst);

        // Restore previous state
        prevAst := FUndoStack.Pop;
        SetRoot(prevAst);
    finally
        FIsUndoing := False;
    end;
end;

procedure TAstEditorController.Redo;
var
    nextAst: IAstNode;
begin
    if FRedoStack.Count = 0 then
        exit;

    FIsUndoing := True;
    try
        // Capture current state for Undo
        if Assigned(FCurrentAst) then
            FUndoStack.Push(FCurrentAst);

        // Restore next state
        nextAst := FRedoStack.Pop;
        SetRoot(nextAst);
    finally
        FIsUndoing := False;
    end;
end;

function TAstEditorController.CanUndo: Boolean;
begin
    Result := FUndoStack.Count > 0;
end;

function TAstEditorController.CanRedo: Boolean;
begin
    Result := FRedoStack.Count > 0;
end;

procedure TAstEditorController.HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer);
var
    SourceParent: TControl;
    ContainerOwner: TAstViewNode;
    Reorderable: IReorderable;
    SourceIdx, TargetIdx: Integer;
    NewAst: IAstNode;
begin
    if (ASource = nil) or (AIndex < 0) then
        exit;
    if not (ASource is TAstViewNode) then
        exit;

    if not (ASource.Parent is TControl) then
        exit;
    SourceParent := TControl(ASource.Parent);

    ContainerOwner := nil;

    // Logic to find the Reorderable container (same as before)
    if (SourceParent is TAstViewNode) then
    begin
        ContainerOwner := TAstViewNode(SourceParent);
        if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
            ContainerOwner := nil;
    end;

    if (ContainerOwner = nil) and (SourceParent.Parent is TAstViewNode) then
    begin
        ContainerOwner := TAstViewNode(SourceParent.Parent);
        if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
            ContainerOwner := nil;
    end;

    if (ContainerOwner <> nil) and (Reorderable <> nil) then
    begin
        if Reorderable.CanDrag(ASource) then
        begin
            SourceIdx := ASource.Index;
            TargetIdx := AIndex;

            if SourceIdx <> TargetIdx then
            begin
                // 1. Commit the CURRENT (clean) AST before visual changes
                CommitSnapshot;

                // 2. Perform Visual Change (Dirty State)
                Reorderable.MoveChild(SourceIdx, TargetIdx);

                // 3. Generate NEW AST from the modified visual tree
                NewAst := FRootViewNode.CreateAst;

                // 4. Update the system with the new AST (Updates FCurrentAst)
                SetRoot(NewAst);
            end;
        end;
    end;
end;

procedure TAstEditorController.SetRoot(const AstNode: IAstNode);
var
    Visualizer: IAstVisualizer;
begin
    // Update the "Truth"
    FCurrentAst := AstNode;

    if not FIsUndoing then
    begin
        FUndoStack.Clear;
        FRedoStack.Clear;
    end;

    FWorkspace.World.DeleteChildren;
    if Assigned(FRootViewNode) then
        FRootViewNode.OnResized := nil;
    FRootViewNode := nil;

    if not Assigned(AstNode) then
        exit;

    Visualizer := TAstVisualizer.Create(FWorkspace, FWorkspace.World, 0);
    FRootViewNode := Visualizer.CallAccept(AstNode);

    if Assigned(FRootViewNode) then
    begin
        FWorkspace.World.Size := FRootViewNode.Size;
        FRootViewNode.OnResized := RootResized;
        FRootViewNode.Position.Point := TPointF.Create(50, 50);
    end;

    if Assigned(FRootViewNode) then
        ValidateAndShow;
end;

// ... (Rest: CollectNodes, ClearVisuals, ApplyErrors, ApplyTypes, RootResized, TTypePropagator bleiben gleich)

procedure TAstEditorController.CollectNodes(Parent: TControl);
var
    i: Integer;
    child: TControl;
    viewNode: TAstViewNode;
begin
    for i := 0 to Parent.ChildrenCount - 1 do
    begin
        if Parent.Children[i] is TControl then
        begin
            child := TControl(Parent.Children[i]);

            if child is TAstViewNode then
            begin
                viewNode := TAstViewNode(child);
                if Assigned(viewNode.Node) and Assigned(viewNode.Node.Identity) then
                begin
                    FNodeMap.AddOrSetValue(viewNode.Node.Identity, viewNode);
                end;
            end;

            if child.ChildrenCount > 0 then
                CollectNodes(child);
        end;
    end;
end;

procedure TAstEditorController.ClearVisuals;
begin
    for var viewNode in FNodeMap.Values do
    begin
        viewNode.ErrorMessage := '';
        viewNode.TypeInfoText := '';
    end;
end;

procedure TAstEditorController.ApplyErrors(const Log: ICompilerLog);
var
    entry: TCompilerError;
    viewNode: TAstViewNode;
begin
    for entry in Log.GetEntries do
    begin
        if (entry.Level = elError) and Assigned(entry.Node) and Assigned(entry.Node.Identity) then
        begin
            if FNodeMap.TryGetValue(entry.Node.Identity, viewNode) then
            begin
                if viewNode.ErrorMessage = '' then
                    viewNode.ErrorMessage := entry.Message
                else
                    viewNode.ErrorMessage := viewNode.ErrorMessage + sLineBreak + entry.Message;
            end;
        end;
    end;
end;

procedure TAstEditorController.ApplyTypes(const TypedAst: IAstNode);
var
    propagator: TTypePropagator;
begin
    if not Assigned(TypedAst) then
        exit;

    propagator := TTypePropagator.Create(FNodeMap);
    try
        propagator.Accept(TypedAst);
    finally
        propagator.Free;
    end;
end;

procedure TAstEditorController.RootResized(Sender: TObject);
begin
    FWorkspace.World.Size := FRootViewNode.Size;
end;

procedure TAstEditorController.ValidateAndShow;
var
    logicalAst: IAstNode;
begin
    if not Assigned(FRootViewNode) then
        exit;

    // Note: We use FCurrentAst here if we trust it, or recreate for safety.
    // Since SetRoot sets FCurrentAst, and any UI manipulation (DragDrop) calls SetRoot afterwards,
    // FCurrentAst should be in sync.
    // However, strictly speaking, ValidateAndShow operates on the VISUAL tree to find Mapping.
    // But since we have FCurrentAst, we can use it directly for binding.

    // BUT: ValidateAndShow is responsible for mapping NodeMap.
    logicalAst := FRootViewNode.CreateAst;
    // ^ This is still needed to rebuild the Mapping if we haven't tracked ViewNodes perfectly.
    // Or we rely on FCurrentAst being the source of truth and we assume ViewNodes match.
    // For now, let's keep CreateAst here to be 100% sure the mapping corresponds to what is on screen.
    // The performance hit here is acceptable as it's part of the validation cycle, not the drag-start.

    FNodeMap.Clear;
    CollectNodes(FWorkspace.World);

    ClearVisuals;

    try
        var log := TCompilerLog.Create as ICompilerLog;

        var expanded := FEnv.ExpandMacros(logicalAst);
        var typedAst := FEnv.Bind(expanded, [], log);
        var specAst := FEnv.Specialize(typedAst);

        ApplyTypes(specAst);

        if specAst.Kind = akLambdaExpression then
            var compiled := FEnv.Link(specAst.AsLambdaExpression, log);

        ApplyErrors(log);
    except
        on E: ECompilationFailed do
        begin
            var tempLog := TCompilerLog.Create as ICompilerLog;
            for var err in E.Errors do
                tempLog.Add(err.Level, err.Message, err.Node);
            ApplyErrors(tempLog);
        end;
    end;

    FWorkspace.World.Repaint;
end;

{ TAstEditorController.TTypePropagator }

constructor TAstEditorController.TTypePropagator.Create(AMap: TNodeMap);
begin
    inherited Create;
    FMap := AMap;
end;

procedure TAstEditorController.TTypePropagator.ApplyType(const Node: IAstNode);
var
    viewNode: TAstViewNode;
begin
    if Assigned(Node) and Assigned(Node.Identity) then
    begin
        if FMap.TryGetValue(Node.Identity, viewNode) then
        begin
            if Node.IsTyped then
            begin
                var st := Node.AsTypedNode.StaticType;
                if Assigned(st) then
                    viewNode.TypeInfoText := st.ToString;
            end;
        end;
    end;
end;

procedure TAstEditorController.TTypePropagator.Accept(const Node: IAstNode);
begin
    if Node = nil then
        exit;
    ApplyType(Node);
    Node.Accept(Self);
end;

end.