use v6.e.PREVIEW;
use Test;

plan 18;

my $ast;
my $deparsed;
my $raku;
my @type = <AST Str Raku>;
sub ast(RakuAST::Node:D $node --> Nil) {
    $ast      := $node;
    $deparsed := $node.DEPARSE;
    $raku     := 'use experimental :rakuast; ' ~ $node.raku;
    diag $deparsed.chomp;
}

subtest 'The do statement prefix works with a statement' => {
    # do 137
    ast RakuAST::StatementList.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::StatementPrefix::Do.new(
          RakuAST::IntLiteral.new(137)
        )
      )
    );

    is-deeply $deparsed, "do 137\n", 'deparse';
    is-deeply $_, 137, @type[$++]
      for EVAL($ast), EVAL($deparsed), EVAL(EVAL $raku);
}

subtest 'The do statement prefix works with a block' => {
    # do { 199 }
    ast RakuAST::StatementList.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::StatementPrefix::Do.new(
          RakuAST::Block.new(
            body => RakuAST::Blockoid.new(
              RakuAST::StatementList.new(
                RakuAST::Statement::Expression.new(
                  expression => RakuAST::IntLiteral.new(199)
                )
              )
            )
          )
        )
      )
    );

    is-deeply $deparsed, q:to/CODE/, 'deparse';
do {
    199
}
CODE

    is-deeply $_, 199, @type[$++]
      for EVAL($ast), EVAL($deparsed), EVAL(EVAL $raku);
}

subtest 'The quietly statement prefix works' => {
    my $warned;
    CONTROL {
        default {
            $warned = True;
            .resume;
        }
    }
    sub do-warning() {
        warn "oops";
        "survived"
    }

    # quietly do-warning()
    ast RakuAST::StatementList.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::StatementPrefix::Quietly.new(
          RakuAST::Call::Name.new(
            name => RakuAST::Name.from-identifier('do-warning')
          )
        )
      )
    );
    is-deeply $deparsed, "quietly do-warning()\n", 'deparse';

    for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL($raku) -> $type, $it {
        $warned = False;
        is-deeply EVAL($it), "survived", "$type: with a statement";
        nok $warned, "$type: the warning was suppressed";
    }

    # quietly { do-warning() }
    ast RakuAST::StatementList.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::StatementPrefix::Quietly.new(
          RakuAST::Block.new(
            body => RakuAST::Blockoid.new(
              RakuAST::StatementList.new(
                RakuAST::Statement::Expression.new(
                  expression => RakuAST::Call::Name.new(
                    name => RakuAST::Name.from-identifier('do-warning')
                  )
                )
              )
            )
          )
        )
      )
    );

    is-deeply $deparsed, q:to/CODE/, 'deparse';
quietly {
    do-warning()
}
CODE


    for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL($raku) -> $type, $it {
        $warned = False;
        is-deeply EVAL($it), "survived", "$type: with a block";
        nok $warned, "$type: the warning was suppressed";
    }
}

subtest 'The gather statement prefix works on a statement' => {
    my $done;
    sub do-takes() {
        $done = True;
        take 111;
        take 222;
    }

    # gather do-takes()
    ast RakuAST::StatementList.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::StatementPrefix::Gather.new(
          RakuAST::Call::Name.new(
            name => RakuAST::Name.from-identifier('do-takes')
          )
        )
      )
    );
    is-deeply $deparsed, "gather do-takes()\n", 'deparse';

    $done = False;
    for
      'AST', EVAL($ast),
      'Str', EVAL($deparsed),
      'Raku', EVAL(EVAL $raku)
    -> $type, \result {
        isa-ok result, Seq, "$type: Got a Seq back from gather (expression form)";
        is-deeply $done, False, 'The gather is lazy';
        my @elems = result;
        is-deeply $done, True, 'Gathered the takes';
        is-deeply @elems, [111, 222], 'Got correct result from the gather expression';
        $done = False;
    }
}

subtest 'The gather statement prefix works on a block' => {
    my $done;
    sub do-takes() {
        $done = True;
        take 333;
        take 444;
    }
    # gather { do-takes() }
    ast RakuAST::StatementList.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::StatementPrefix::Gather.new(
          RakuAST::Block.new(
            body => RakuAST::Blockoid.new(
              RakuAST::StatementList.new(
                RakuAST::Statement::Expression.new(
                  expression => RakuAST::Call::Name.new(
                    name => RakuAST::Name.from-identifier('do-takes')
                  )
                )
              )
            )
          )
        )
      )
    );

    is-deeply $deparsed, q:to/CODE/, 'deparse';
gather {
    do-takes()
}
CODE

    $done = False;
    for
      'AST', EVAL($ast),
      'Str', EVAL($deparsed),
      'Raku', EVAL(EVAL $raku)
    -> $type, \result {
        isa-ok result, Seq, "$type: Got a Seq back from gather (block form)";
        is-deeply $done, False, 'The gather is lazy';
        my @elems = result;
        is-deeply $done, True, 'Gathered the takes';
        is-deeply @elems, [333, 444], 'Got correct result from the gather expression';
        $done = False;
    }
}

subtest "The race / hyper / lazy / eager statement prefixes work" => {
    my class ContextMe {
        has @.called;
        method race()  { @!called.push('race');  'result' }
        method hyper() { @!called.push('hyper'); 'result' }
        method lazy()  { @!called.push('lazy');  'result' }
        method eager() { @!called.push('eager'); 'result' }
    }

    for <race hyper lazy eager> -> $context {
        my $c;
        my $result;

        # race|hyper|lazy|eager $c
        ast RakuAST::StatementList.new(
          RakuAST::Statement::Expression.new(
            expression => RakuAST::StatementPrefix::{tclc $context}.new(
              RakuAST::Var::Lexical.new('$c')
            )
          )
        );
        is-deeply $deparsed, $context ~ ' $c' ~ "\n", 'deparse';

        for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL($raku) -> $type, $it {
            $c = ContextMe.new;
            is-deeply EVAL($it), 'result', "$type: $context works with statement";
            is-deeply $c.called, [$context], "$type: context method was called";
        }
    }

    for <race hyper lazy eager> -> $context {
        my $c;
        my $result;

        # race|hyper|lazy|eager { $c }
        ast RakuAST::StatementList.new(
          RakuAST::Statement::Expression.new(
            expression => RakuAST::StatementPrefix::{tclc $context}.new(
              RakuAST::Block.new(
                body => RakuAST::Blockoid.new(
                  RakuAST::StatementList.new(
                    RakuAST::Statement::Expression.new(
                      expression => RakuAST::Var::Lexical.new('$c')
                    )
                  )
                )
              )
            )
          )
        );

        is-deeply $deparsed, qq:!c:to/CODE/, 'deparse';
$context {
    \$c
}
CODE

        for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL($raku) -> $type, $it {
            $c = ContextMe.new;
            is-deeply EVAL($it), 'result', "$type: $context works with block";
            is-deeply $c.called, [$context], "$type: context method was called";
        }
    }
}

subtest 'try statement prefix with expression producing value results' => {
    # try 99
    ast RakuAST::StatementPrefix::Try.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::IntLiteral.new(99)
      )
    );
    is-deeply $deparsed, 'try 99', 'deparse';

    for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL($raku) -> $type, $it {
        is-deeply EVAL($it), 99, "$type: correct result";
        todo "$type: string eval does not set $!, also in main"
          if $type eq 'Str';
        is-deeply $!, Nil, "$type: \$! is Nil when not exception";
    }
}

subtest 'try statement prefix with throwing expression handles the exception' => {
    # try die("hard")
    ast RakuAST::StatementPrefix::Try.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::Call::Name.new(
          name => RakuAST::Name.from-identifier('die'),
          args => RakuAST::ArgList.new(RakuAST::StrLiteral.new('hard'))
        )
      )
    );
    is-deeply $deparsed, 'try die("hard")', 'deparse';

    for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL($raku) -> $type, $it {
        $! = 42;
        is-deeply EVAL($it), Nil, "$type: did we get Nil";
        is-deeply $!.Str, 'hard', "$type: \$! is populated with exception";
    }
}

subtest 'try statement prefix with block producing value results' => {
    # try { 999 }
    ast RakuAST::StatementPrefix::Try.new(
      RakuAST::Block.new(
        body => RakuAST::Blockoid.new(
          RakuAST::StatementList.new(
            RakuAST::Statement::Expression.new(
              expression => RakuAST::IntLiteral.new(999)
            )
          )
        )
      )
    );

    is-deeply $deparsed, q:to/CODE/.chomp, 'deparse';
try {
    999
}
CODE

    for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL($raku) -> $type, $it {
        is-deeply EVAL($it), 999, "$type: correct result";
        todo "$type: string eval does not set \$!, also in main"
          if $type eq 'Str';
        is-deeply $!, Nil, "$type: \$! is Nil when not exception";
    }
}

subtest 'try statement prefix with throwing block handles the exception' => {
    # try { die("another day") }
    ast RakuAST::StatementPrefix::Try.new(
      RakuAST::Block.new(
        body => RakuAST::Blockoid.new(
          RakuAST::StatementList.new(
            RakuAST::Statement::Expression.new(
              expression => RakuAST::Call::Name.new(
                name => RakuAST::Name.from-identifier('die'),
                args => RakuAST::ArgList.new(RakuAST::StrLiteral.new('another day'))
              )
            )
          )
        )
      )
    );

    is-deeply $deparsed, q:to/CODE/.chomp, 'deparse';
try {
    die("another day")
}
CODE

    for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL($raku) -> $type, $it {
        $! = 42;
        is-deeply EVAL($ast), Nil, "$type: did we get Nil";
        is-deeply $!.Str, 'another day', "$type: \$! is populated with exception";
    }
}

subtest 'start statement prefix with expression evaluates to Promise' => {
    # start 111
    ast RakuAST::StatementPrefix::Start.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::IntLiteral.new(111)
      )
    );
    is-deeply $deparsed, 'start 111', 'deparse';

    for
      'AST', EVAL($ast),
      'Str', EVAL($deparsed),
      'Raku', EVAL(EVAL $raku)
    -> $type, $promise {
        isa-ok $promise, Promise, $type;
        is-deeply await($promise), 111, 'Correct result from Promise';
    }
}

subtest 'start statement prefix with block evaluates to Promise' => {
    # start { 137 }
    ast RakuAST::StatementPrefix::Start.new(
      RakuAST::Block.new(
        body => RakuAST::Blockoid.new(
          RakuAST::StatementList.new(
            RakuAST::Statement::Expression.new(
              expression => RakuAST::IntLiteral.new(137)
            )
          )
        )
      )
    );

    is-deeply $deparsed, q:to/CODE/.chomp, 'deparse';
start {
    137
}
CODE

    for
      'AST', EVAL($ast),
      'Str', EVAL($deparsed),
      'Raku', EVAL(EVAL $raku)
    -> $type, $promise {
        isa-ok $promise, Promise, $type;
        is-deeply await($promise), 137, 'Correct result from Promise';
    }
}

subtest 'A start has a fresh $/' => {
    # start $/
    ast RakuAST::StatementPrefix::Start.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::Var::Lexical.new('$/')
      )
    );
    is-deeply $deparsed, 'start $/', 'deparse';

    {
        my $/ = 42;
        nok await(EVAL($ast)) ~~ 42, 'AST: A start has a fresh $/';
    }

    {
        my $/ = 666;
        nok await(EVAL($deparsed)) ~~ 666, 'Str: A start has a fresh $/';
    }

    {
        my $/ = 137;
        nok await(EVAL(EVAL $raku)) ~~ 137, 'Raku: A start has a fresh $/';
    }
}

subtest 'A start has a fresh $!' => {
    # start $!
    ast RakuAST::StatementPrefix::Start.new(
      RakuAST::Statement::Expression.new(
        expression => RakuAST::Var::Lexical.new('$!')
      )
    );
    is-deeply $deparsed, 'start $!', 'deparse';

    {
        my $! = 42;
        nok await(EVAL($ast)) ~~ 42, 'AST: A start has a fresh $!';
    }

    {
        my $! = 666;
        nok await(EVAL($deparsed)) ~~ 666, 'Str: A start has a fresh $!';
    }

    {
        my $! = 137;
        nok await(EVAL(EVAL $raku)) ~~ 137, 'Raku: A start has a fresh $!';
    }
}

subtest 'supply statement prefix with expression evaluates to Supply' => {
    # supply whenever 42 { .emit }
    ast RakuAST::StatementPrefix::Supply.new(
      RakuAST::Statement::Whenever.new(
        trigger => RakuAST::IntLiteral.new(42),
        body    => RakuAST::Block.new(
          implicit-topic => True,
          required-topic => 1,
          body           => RakuAST::Blockoid.new(
            RakuAST::StatementList.new(
              RakuAST::Statement::Expression.new(
                expression => RakuAST::Term::TopicCall.new(
                  RakuAST::Call::Method.new(
                    name => RakuAST::Name.from-identifier("emit")
                  )
                )
              )
            )
          )
        )
      )
    );

    # must be this number of tests
    plan 7;

    is-deeply $deparsed, q:to/CODE/.chomp, 'deparse';
supply whenever 42 {
    .emit
}
CODE

    for
      'AST', EVAL($ast),
      'Str', EVAL($deparsed),
      'Raku', EVAL(EVAL $raku)
    -> $type, $supply {
        isa-ok $supply, Supply, $type;
        $supply.tap({ is $_, 42, 'emitted value ok' });
    }
}

subtest 'supply statement prefix with block evaluates to Supply' => {
    # supply { whenever 42 { .emit } }
    ast RakuAST::StatementPrefix::Supply.new(
      RakuAST::Block.new(
        body => RakuAST::Blockoid.new(
          RakuAST::StatementList.new(
            RakuAST::Statement::Whenever.new(
              trigger => RakuAST::IntLiteral.new(42),
              body    => RakuAST::Block.new(
                implicit-topic => True,
                required-topic => 1,
                body           => RakuAST::Blockoid.new(
                  RakuAST::StatementList.new(
                    RakuAST::Statement::Expression.new(
                      expression => RakuAST::Term::TopicCall.new(
                        RakuAST::Call::Method.new(
                          name => RakuAST::Name.from-identifier("emit")
                        )
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    );

    # must be this number of tests
    plan 7;

    is-deeply $deparsed, q:to/CODE/.chomp, 'deparse';
supply {
    whenever 42 {
        .emit
    }
}
CODE

    for
      'AST', EVAL($ast),
      'Str', EVAL($deparsed),
      'Raku', EVAL(EVAL $raku)
    -> $type, $supply {
        isa-ok $supply, Supply, $type;
        $supply.tap({ is $_, 42, 'emitted value ok' });
    }
}

subtest 'react statement prefix with expression evaluates to Nil' => {
    # react whenever 42 { $a = $_ }
    ast RakuAST::StatementPrefix::React.new(
      RakuAST::Statement::Whenever.new(
        trigger => RakuAST::IntLiteral.new(42),
        body    => RakuAST::Block.new(
          implicit-topic => True,
          required-topic => 1,
          body           => RakuAST::Blockoid.new(
            RakuAST::StatementList.new(
              RakuAST::Statement::Expression.new(
                expression => RakuAST::ApplyInfix.new(
                  left  => RakuAST::Var::Lexical.new("\$a"),
                  infix => RakuAST::Infix.new("="),
                  right => RakuAST::Var::Lexical.new("\$_")
                )
              )
            )
          )
        )
      )
    );

    is-deeply $deparsed, q:to/CODE/.chomp, 'deparse';
react whenever 42 {
    $a = $_
}
CODE

    for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL $raku -> $type, $it {
        my $a;
        is-deeply EVAL($it), Nil, "$type: is the result Nil";
        is-deeply $a, 42, "$type: did the code get run";
    }
}

subtest 'react statement block with expression evaluates to Nil' => {
    # react { whenever 42 { $a = $_ } }
    ast RakuAST::StatementPrefix::React.new(
      RakuAST::Block.new(
        body => RakuAST::Blockoid.new(
          RakuAST::StatementList.new(
            RakuAST::Statement::Whenever.new(
              trigger => RakuAST::IntLiteral.new(42),
              body    => RakuAST::Block.new(
                implicit-topic => True,
                required-topic => 1,
                body           => RakuAST::Blockoid.new(
                  RakuAST::StatementList.new(
                    RakuAST::Statement::Expression.new(
                      expression => RakuAST::ApplyInfix.new(
                        left  => RakuAST::Var::Lexical.new("\$a"),
                        infix => RakuAST::Infix.new("="),
                        right => RakuAST::Var::Lexical.new("\$_")
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    );

    is-deeply $deparsed, q:to/CODE/.chomp, 'deparse';
react {
    whenever 42 {
        $a = $_
    }
}
CODE

    for 'AST', $ast, 'Str', $deparsed, 'Raku', EVAL $raku -> $type, $it {
        my $a;
        is-deeply EVAL($it), Nil, "$type: is the result Nil";
        is-deeply $a, 42, "$type: did the code get run";
    }
}

# vim: expandtab shiftwidth=4