use strict;
use warnings;

#use Smart::Comments;
use Test::More 'no_plan';

use Pugs::Compiler::Regex;

$Pugs::Compiler::Regex::NoCache = 1;

# Test the compile method:

# default values for the options
{
    my $regex = Pugs::Compiler::Regex->compile('a');
    is $regex->{grammar}, 'Pugs::Grammar::Base',
        "grammar => 'Pugs::Grammar::Base'";
    is $regex->{continue}, 0, "continue => 0";
    is $regex->{p}, undef, 'pos => undef';
    is $regex->{ratchet}, 0, 'ratchet => 0';
    is $regex->{ignorecase}, 0, 'ignorecase => 0';
    is $regex->{sigspace}, 0, 'sigspace => 0';
}

# test param handling
my $regex;
eval {
    $regex = Pugs::Compiler::Regex->compile(
        'a',
        { ratchet => 1, pos => 1, p => 1, sigspace => 1, s => 1,
        continue => 1, c => 1, ignorecase => 1, i => 1,
        grammar => 'abc' }
    );
};
is $@, '', 'params okay (1)';
ok $regex, 'regex ok (1)';
is $regex->{grammar}, 'abc',
    "grammar => 'abc'";
is $regex->{continue}, 1, "continue => 1";
is $regex->{p}, 1, 'pos => 1';
is $regex->{ratchet}, 1, 'ratchet => 1';
is $regex->{ignorecase}, 1, 'ignorecase => 1';
is $regex->{sigspace}, 1, 'sigspace => 1';

eval {
    $regex = Pugs::Compiler::Regex->compile(
        'a',
        { ratchet => 0, pos => 0, p => 0, sigspace => 0, s => 0,
        continue => 0, c => 0, ignorecase => 0, i => 0,
        grammar => '' }
    );
};
is $@, '', 'params okay (0)';
ok $regex, 'regex ok (0)';

eval {
    Pugs::Compiler::Regex->compile('a');
};
is $@, '', 'params are optional';
ok $regex, 'regex ok (null)';

# Test the code method
{
  $regex = Pugs::Compiler::Regex->compile('a|b', { ratchet => 1 });
  my $sub = $regex->code();
  my $match = $sub->('MyGrammar', 'aaa');
  is $match->(), 'a';
}

{
  package Foo;
  no strict;
  no warnings;

  my $regex = Pugs::Compiler::Regex->compile('a*');
  ### CODE: $regex->code
  *match = $regex->code();
  my $match = Foo->match('aaa');
  ### MATCH: $match
  ::is $match->(), 'aaa';
}

# Test the install method
{
  package Bar;
  Pugs::Compiler::Regex->install('match', 'a*', {ratchet => 1});
  my $match = Bar->match('aaa');
  ::is $match->(), 'aaa';
  eval {
    Pugs::Compiler::Regex->install('match', 'b*');
  };
  ::like $@, qr/Can't install regex 'match' as 'Bar::match' which already exists/, 'croak as expected';
}

# Test the reinstall method
{
  package Bar;
  Pugs::Compiler::Regex->reinstall('match', 'a*', {ratchet => 1});
  my $match = Bar->match('aaa');
  ::is $match->(), 'aaa';
  eval {
    Pugs::Compiler::Regex->reinstall('match', 'b*');
  };
  ::ok !$@, "shouldn't croak this time";
  $match = Bar->match('bbb');
  ::is $match->(), 'bbb', 'reinstall works';
}

# Test the continue option in ratchet mode
{
    package Foo;
    Pugs::Compiler::Regex->install(
        word => '\w+', { ratchet => 1, continue => 1 }
    );
    my $s = 'hello world';
    my @match;
    my $match = Foo->word($s);
    push @match, $match if $match;
    $match = Foo->word($s);
    push @match, $match if $match;
    $match = Foo->word($s);
    push @match, $match if $match;
    #while (my $match = Foo->word($s)) {
    #    push @match, $match->();
    #}
    ::is join(':', @match), 'hello:world';
}

{
    package Bar;
    Pugs::Compiler::Regex->install(
        digit => '\d', { ratchet => 1, c => 1 }
    );
    my $s = '56';
    my @match;
    my $match = Bar->digit($s);
    push @match, $match->() if $match;
    $match = Bar->digit($s);
    push @match, $match->() if $match;
    $match = Bar->digit($s);
    push @match, $match->() if $match;
    #while (my $match = Bar->digit($s)) {
    #    push @match, $match->();
    #}
    ::is join(':', @match), '5:6';
}

TODO: {
    local $TODO = ":c modifier doesn't work in non-ratchet mode";
    package Bar;
    Pugs::Compiler::Regex->reinstall(
        digit => '\d', { ratchet => 0, c => 1 }
    );
    my $s = '56';
    my @match;
    my $match = Bar->digit($s);
    push @match, $match->() if $match;
    $match = Bar->digit($s);
    push @match, $match->() if $match;
    $match = Bar->digit($s);
    push @match, $match->() if $match;
    #while (my $match = Bar->digit($s)) {
    #    push @match, $match->();
    #}
    package main;
    is join(':', @match), '5:6';
}

# Test match:
{
    my $regex = Pugs::Compiler::Regex->compile(
        'a*\w',
    );
    my $match = $regex->match('aaa');
    ok $match->bool, 'backtracking works';
    is $match->(), 'aaa';
    is "$match", 'aaa';
    is $match->from, 0;
    is $match->to, 3;
}

# Test the :pos modifier
#{
#}