### ----------------------------------------------------
### -- OO::Plugin
### -- Licenses: Artistic-2.0
### -- Authors: Vadim Belman <vrurg@cpan.org>
### -- File: lib/OO/Plugin/Manager.rakumod
### ----------------------------------------------------
### -- Chunk 2 of 2
: ", @collected.map: { self.short-name($_) };
                                    return ( @collected, %SEEN );
                                }
                                else {
                                    bad-dep; # Report back to the caller unless this is the top element.
                                }
                            }
                            else {
                                msg "NOT DEMANDING $sn -> $snp";
                            }

                            # It makes sense to retry the same dependency because otherwise we can miss it as a side
                            # effect of rolling back a circle.
                            # do { msg "⚛⚛ REDO DEPENDENCY $snp for $sn"; redo DEPENDENCY } unless %SEEN{ $p } ~~ tpsFinal;
                        }
                        default { .rethrow }
                    }
                }
            }
        }

        msg "+++ Adding ", self.short-name($fqn), " to collected";
        %SEEN{$fqn} = tpsFinal;
        @collected.push: $fqn;
        self!dbg: "<< RETURNING COLLECTED: ", @collected.map: { self.short-name($_) };
        return ( @collected, %SEEN );
    }
    # --- END walk-elem

    my %TPS-SEEN;
    for @mods -> $fqn {
        self!dbg: "SEEN ", self.short-name( $fqn ), ": ", %TPS-SEEN{$fqn};
        next if %TPS-SEEN{$fqn} or self.disabled( :$fqn );
        my $collected;
        ($collected, %TPS-SEEN) = walk-elem( $fqn, %TPS-SEEN );
        self!dbg: "*** SEEN: ", %TPS-SEEN.pairs.map( { self.short-name( $_.key ) ~ ":" ~ $_.value } ).join(", ");
        @sorted.append: @$collected if $collected;
    }

    @sorted
}

method !build-order {
    # Will later do sorting, etc. For now just get in any order skipping all disabled
    self!dbg: "build-order";
    my @mods = self!pre-sort;
    self!dbg: "PRE-SORT:", @mods.map({self.short-name: $_}).join(" → ");
    @!order = self!topo-sort( @mods ); # XXX Don't forget to change!
    self!dbg: "FINAL ORDER: ", @!order.join( " → " );
}

method !autogen-class-name ( Str:D $base ) {
    my $name;
    repeat {
        $name = $base ~ "_" ~ ( ('a'..'z', 'A'..'Z', '0'..'9').flat.pick(6).join );
    } while $!registry.has-autogen-class( $name ); # Be on the safe side, however small are the changes for generating same class name again
    $!registry.register-autogen-class( $name );
    $name
}

# Parameters: wrapped-type, original type
method !build-class-chain ( Mu:U \wtype, Mu:U \type --> Mu:U ) is raw {

    # Build list of plug-classes for this type
    my $type-name = type.^name;
    my %type-ext = $!registry.extended-classes{ $type-name } // {};

    my $last-class := type;

    if %type-ext {
        # Higher-priority plugins must have their classes first in MRO
        for @!order.reverse -> $fqn {
            # self!dbg: "??? TYPE EXT for $type-name of $fqn: ", %type-ext;
            with %type-ext{ $fqn } {
                for $_.list -> \plug-class {
                    self!dbg: "... Plugin $fqn extends $type-name with ", plug-class.^name, " // ", plug-class.HOW;
                    my $name = self!autogen-class-name( plug-class.^name );
                    my \pclass = Metamodel::ClassHOW.new_type( :$name );
                    pclass.^add_parent( $last-class );
                    pclass.^add_role( plug-class );

                    pclass.^compose;

                    $last-class := pclass;
                }
            }
        }
    }

    # The wrapper's class my-plugin will
    my &plugin-method = my submethod {
        my $caller;
        my $skip = True;
        for Backtrace.new.list {
            next unless .code.^can('package');
            $skip &&= .package !=== $?CLASS;
            next if $skip;
            ( $caller = $_ ) && last if .package !=== $?CLASS;
        }
        # TODO Return plugin object when wrapper class gets .plugin-manager attribute
        my \plugin = $caller.package.^plugin;
    };
    &plugin-method.set_name('plugin');
    wtype.HOW.add_parent( wtype, $last-class );
}

# build-class is supposed to be called for unprocessed classes only.
method !build-class ( Mu:U \type --> Mu:U ) is raw {

    my $type-name = type.^name;
    my %methods = $!registry.methods{ $type-name } // {};
    my $wrapper-name = self!autogen-class-name( $type-name );
    my \wtype = Metamodel::ClassHOW.new_type( name => $wrapper-name );

    my $plugin-manager = self;

    self!build-class-chain( wtype, type );

    for %methods.keys -> $mname {
        self!dbg: "-- GENERATING METHOD ", $mname;
        my %routines; # Ordered list of routines to be called for the methods. Keys are stages: before, around, after
        for @!order -> $plugin-fqn {
            self!dbg: "--- PLUGIN $plugin-fqn";
            with %methods{ $mname }{ $plugin-fqn } {
                for .keys -> $stage {
                    self!dbg: "---- STAGE $stage";

                    my &routine = $_{ $stage };
                    self!dbg: "---- SIGNATURE: ", &routine.signature.raku;
                    my $is-dispatcher = &routine.is_dispatcher;
                    my $params = &routine.signature.params;
                    my $param-last = $params.end;
                    # If proto doesn't have | in its signature then dummy named parameter %_ of type Mu is
                    # implicitly added to the end.
                    with $params[$param-last] {
                        $param-last-- if .type ~~ Mu and .slurpy and .named and .name eq '%_';
                    }

                    #self!dbg: "PARAM-LAST: ", $param-last, ", type: ", $params[$param-last].type,
                    #            ", name:", $params[$param-last].name,
                    #            ", optional:", $params[$param-last].optional,
                    #            ", slurpy:", $params[$param-last].slurpy,
                    #            ", named:", $params[$param-last].named,
                    #            ", name:", $params[$param-last].name,
                    #            "\n", $params[$param-last].raku;

                    my Bool $with-params = $param-last > 1;

                    self!dbg: "---- MUST USE PARAMS? ", $with-params;

                    %routines{ $stage }.push: %(
                        :&routine,
                        :$with-params,
                        :$plugin-fqn,
                        plugin-obj => %!objects{ $plugin-fqn },
                    );
                }
            }
        }

        my &orig-method = type.^find_method( $mname );
        # self!dbg: "Orig method signature: ", &orig-method.signature;
        # self!dbg: "Orig method mutli: ", &orig-method.candidates;

        # --- WRAPPING METHOD GENERATION BEGINS
        my &plug-method = my method ( |params ) {
            my &callee = nextcallee;
            # self!dbg: "Wrapper for method $mname on ", self.WHICH;
            my ( %by-plugin );

            my MethodHandlerMsg $msg .= new(
                :object(self),
                :params(params),
                :method($mname),
            );

            STAGE:
            for <before around after> -> $stage {

                my Bool $redo-stage = False;

                $msg.stage = $stage;
                $plugin-manager!dbg: "&&& AT STAGE $stage";

                if %routines{ $stage } {
                    my @routine-list = %routines{ $stage }.List;
                    @routine-list = @routine-list.reverse if $stage ~~ 'after';
                    for @routine-list -> $r {
                        # This is where we actually call plugs.
                        my $*CURRENT-PLUGIN = $r<plugin-obj>;

                        $msg.private = %by-plugin{ $r<plugin-fqn> };

                        my &routine = $r<routine>;

                        # Call multi-method
                        $plugin-manager!dbg: "&&& EXECUTE HANDLER ", $r<plugin-obj>.name, "::", &routine.name;

                        if $r<with-params> {
                            $r<plugin-obj>.&routine( $msg, |params );
                        }
                        else {
                            $r<plugin-obj>.&routine( $msg );
                        }

                        %by-plugin{ $r<plugin-fqn> } = $msg.private; # Remember what's been set by the plugin (if was)
                        $msg.private = Nil; # Just be on the safe side...

                        if $msg.has-rc and $stage ~~ 'before' {
                            warn "Plugin `$r<plugin-fqn>` set return value for method $mname at 'before' stage";
                            $msg.reset-rc;
                        }
                    }

                    CONTROL {
                        when CX::Plugin::Last {
                            $plugin-manager!dbg: "*** 'LAST' CONTROL RAISED BY ", $_.plugin.^name;
                            $msg.set-rc( $_.rc ) unless $stage ~~ 'before';
                        }
                        when CX::Plugin::Redo {
                            $plugin-manager!dbg: "*** 'REDO' CONTROL RAISED BY ", $_.plugin.^name;
                            $redo-stage = True;
                            .resume
                        }
                        default { $_.rethrow }
                    }
                }

                given $stage {
                    when 'around' {
                        # Only call the original method if no rc is set.
                        if !$msg.has-rc {
                            # self!dbg: "Refer to the original";
                            # self!dbg: "PARAMS: ", params;
                            $msg.set-rc( self.&callee( |$msg.params ) );
                        }
                    }
                }

                redo if $redo-stage;
            }

            $msg.rc
        };
        # --- WRAPPING METHOD GENERATION ENDS

        &plug-method.set_name( $mname );

        wtype.^add_method(
            $mname,
            &plug-method
        );
    }

    wtype.^compose
}

method !rebuild-short2fqn ( --> Nil ) {
    %!short2fqn = ();
    %!mod-info.kv.map: -> $fqn, %info {
        %!short2fqn{ %info<shortname> } ∪= $fqn;
        # ... because <shortname> might have source in plugin meta.
        %!short2fqn{ %info<type>.^shortname }      ∪= $fqn;
    };
}

method !reverse-deps-hash ( Str:D $key, :$strict? --> Hash:D ) {
    my %deps;
    for %!mod-info.keys -> $fqn {
        with self.meta( $fqn ){ $key } {
            %deps{ self.normalize-name( $_, :!strict ) } ∪= $fqn for .keys;
            CATCH {
                when X::OO::Plugin::NotFound {
                    # Ignore missing plugins for non-strict dependencies
                    self.disable( $fqn, "Required plugin " ~ .plugin ~ " not found" ) if ? $strict;
                }
                default { .rethrow }
            }
        }
    }
    %deps
}

method !rebuild-dependencies {
    %!demanded-by = self!reverse-deps-hash('demand', :strict);
    for %!mod-info.keys {
        my %pmeta = $!registry.plugin-meta( fqn => $_ );

        proto settify (|) {*}
        multi settify ( Any:U $ --> Setty:D ) { SetHash.new }
        multi settify ( Setty:D $val --> Setty:D ) {
            SetHash.new: $val.keys.map: { self.normalize-name( $_, :!strict ) };
        };

        %!dependencies{$_}<after>  = settify( %pmeta<after> );
        %!dependencies{$_}<demand> = settify( %pmeta<demand> );
        my %rbefore = self!reverse-deps-hash( <before> );
        %!dependencies{.key}<after> ∪= .value for %rbefore.pairs;
    }
}

# record-replay/replay pair allows to postpone a method execution for later by recording the parameters it was called
# with.
has @!replay-requests;
method !record-replay ( &method, Capture $params ) {
    @!replay-requests.push: { :&method, :$params };
}
method !replay {
    my @records = @!replay-requests;
    @!replay-requests = ();

    for @records -> % (:&method, :$params) {
        self.&method( |$params );
    }
}

method !plugins-cando ( Str:D $method-name, Capture:D \params ) {
    gather {
        for self.plugin-objects -> $pobj {
            my @mlist = $pobj.^can( $method-name ) || next;
            take $pobj if @mlist[0].cando( \( $pobj, |params ) );
        }
    }
}

method !dbg (*@msg) {
    note |@msg if $.debug;
}

method start(|c) {
    start |c
}

=begin pod

=head1 SEE ALSO

L<C<OO::Plugin::Manual>|Manual.md>,
L<C<OO::Plugin>|../Plugin.md>,
L<C<OO::Plugin::Class>|Class.md>
L<C<OO::Plugin::Registry>|Registry.md>,

=AUTHOR  Vadim Belman <vrurg@cpan.org>

=end pod


