package Perl::LanguageServer::Methods::DebugAdapterInterface ;

use Moose::Role ;

use Coro ;
use Coro::AIO ;
use Data::Dump qw{dump} ;
use Perl::LanguageServer::DevTool ;
use Perl::LanguageServer::DebuggerProcess ;

no warnings 'uninitialized' ;

our $reqseq = 1_000_000_000 ;

# ---------------------------------------------------------------------------

has 'debugger_process' =>
    (
    isa => 'Perl::LanguageServer::DebuggerProcess',
    is  => 'rw'
    ) ;

has 'debug_adapter' =>
    (
    isa => 'Perl::LanguageServer',
    is  => 'rw',
    weak_ref => 1,
    predicate => 'has_debug_adapter',
    ) ;

has 'cmd_queue' =>
    (
    is => 'ro',
    isa => 'Coro::Channel',
    default => sub { Coro::Channel -> new }
    ) ;

has 'cmd_in_progress' =>
    (
    is => 'rw',
    isa => 'Maybe[HashRef]',
    ) ;

has 'initialized' =>
    (
    is => 'rw',
    isa => 'Bool',
    default => 0
    ) ;

has 'responses' =>
    (
    isa => 'HashRef',
    is  => 'rw',
    default => sub { {} },
    ) ;

# ---------------------------------------------------------------------------

sub send_event
    {
    my ($self, $event, $body) = @_ ;

    $self -> debug_adapter -> send_event ($event, $body) ;
    }

# ---------------------------------------------------------------------------

sub send_request
    {
    my ($self) = @_ ;

    return if ($self -> cmd_in_progress) ;

    my $channel = $self -> cmd_queue ;
    return if ($channel -> size == 0) ;
    my $req = $channel -> get () ;
    $self -> cmd_in_progress ($req) ;
    $self -> send_notification ($req, $self, "<--- To debuggee: ") ;

    return  ;
    }

# ---------------------------------------------------------------------------

sub request
    {
    my ($self, $req) = @_ ;

    my $seq = $reqseq++ ;
    $req -> {seq} = $seq ;

    my $channels = $self -> responses ;
    local $channels -> {$seq} = Coro::Channel -> new ;

    my $channel = $self -> cmd_queue ;
    $channel -> put ($req) ;
    $self -> send_request () ;
    my $ret = $channels -> {$seq} -> get ;
    $self -> send_request () ;
    return $ret ;
    }

# ---------------------------------------------------------------------------

sub _dapreq_di_response
    {
    my ($self, $workspace, $req) = @_ ;

    my $seq = - $req -> id ;
    my $cmd = $self -> cmd_in_progress ;
    my $cmdseq = $cmd?$cmd -> {seq}:'<undef>' ;
    my $channels = $self -> responses ;
    $self -> logger ("di_response seq = $seq lastcmd seq = $cmdseq channels = ", dump([keys %$channels]), " queue size = ", $self -> cmd_queue -> size, "\n") ;
    return if (!exists $channels -> {$seq}) ;
    $channels -> {$seq} -> put ($req -> params) ;
    $self -> cmd_in_progress (undef) ;
    $self -> send_request () ;
    return ;
    }

# ---------------------------------------------------------------------------

sub _dapreq_di_break
    {
    my ($self, $workspace, $req) = @_ ;

    $self -> log_prefix ('DAI') ;
    $self -> log_req_txt ('---> From debuggee: ') ;

    my $debug_adapter = $Perl::LanguageServer::Methods::DebugAdapter::debug_adapters{$req -> params -> {session_id}} ;
    die "no debug_adapter for session " . $req -> params -> {session_id} if (!$debug_adapter) ;
    $debug_adapter -> running (0) ;

    $self -> logger ("session_id = " . $req -> params -> {session_id} . "\n") ;
    #$self -> logger ("debug_adapter = ", dump ($debug_adapter), "\n") ;

    $self -> debug_adapter ($debug_adapter) ;
    $self -> debugger_process ($debug_adapter -> debugger_process) ;
    $debug_adapter -> debug_adapter_interface ($self) ;

    my $initialized = $self -> initialized ;
    my $reason      = $req -> params -> {reason} ;
    $self -> logger ("_dapreq_di_break reason = $reason initialized = $initialized temp_break = ", $debug_adapter -> in_temp_break, " stop_on_entry = ", $self -> debugger_process -> stop_on_entry,"\n") ;
    return if ($reason eq 'pause' && $debug_adapter -> in_temp_break) ;
    $debug_adapter -> in_temp_break (0) ;

    $reason         ||= $initialized?'breakpoint':'entry' ;

    $debug_adapter -> clear_non_thread_ids ;

    if ($initialized || $self -> debugger_process -> stop_on_entry)
        {
        $self -> send_event ('stopped',
                        {
                        reason => $reason,
                        threadId => $debug_adapter -> getid (0, $req -> params -> {thread_ref}) || 1,
                        preserveFocusHint => JSON::false (),
                        allThreadsStopped => JSON::true (),
                        }) ;
        }

    if (!$initialized)
        {
        $self -> send_event ('initialized') ;
        }

    $self -> initialized (1) ;

    return ;
    }

# ---------------------------------------------------------------------------

sub _dapreq_di_loadedfile
    {
    my ($self, $workspace, $req) = @_ ;

    $self -> log_prefix ('DAI') ;

    if (!$self -> has_debug_adapter)
        {
        my $debug_adapter = $Perl::LanguageServer::Methods::DebugAdapter::debug_adapters{$req -> params -> {session_id}} ;
        die "no debug_adapter for session " . $req -> params -> {session_id} if (!$debug_adapter) ;

        $self -> logger ("session_id = " . $req -> params -> {session_id} . "\n") ;
        #$self -> logger ("debug_adapter = ", dump ($debug_adapter), "\n") ;

        $self -> debug_adapter ($debug_adapter) ;
        $self -> debugger_process ($debug_adapter -> debugger_process) ;
        $debug_adapter -> debug_adapter_interface ($self) ;
        }


    $self -> send_event ('loadedSource',
                        {
                        reason => $req -> params -> {reason},
                        source => $req -> params -> {source},
                        }) ;

    return ;
    }

# ---------------------------------------------------------------------------

sub _dapreq_di_breakpoints
    {
    my ($self, $workspace, $req) = @_ ;

    $self -> log_prefix ('DAI') ;

    if ($req -> params -> {real_filename})
        {
        $workspace -> add_path_mapping ($req -> params -> {real_filename}, $workspace -> file_server2client ($req -> params -> {req_filename}))
        }

    foreach my $bp (@{$req -> params -> {breakpoints}})
        {
        $self -> send_event ('breakpoint',
                        {
                        reason => 'changed',
                        breakpoint =>
                            {
                            verified => $bp -> [2]?JSON::true ():JSON::false (),
                            message  => $bp -> [3],
                            line     => $bp -> [4]+0,
                            id       => $bp -> [6]+0,
                            source   => { path => $workspace -> file_server2client ($bp -> [5]) },
                            }
                        }) ;
        }

    return ;
    }

# ---------------------------------------------------------------------------

1 ;
