package rejects::QnD;

use strict;
use warnings;

sub _curr_line :lvalue
{
    my $self = shift;

    return $self->_lines()->[$self->_curr_line_idx()];
}

sub _with_curr_line
{
    my ($self, $sub_ref) = @_;

    return $sub_ref->( $self->_curr_line_ref() );
}

# TODO : _parse_saying_first_para and _parse_saying_other_para are
# very similar - abstract them into one function.
sub _parse_saying_first_para
{
    my $self = shift;

    my ($sayer, $what);

    ($sayer) = $self->_with_curr_line(
        sub {
            my $l = shift;

            if ($$l !~ /\G([^:\n\+]+): /cgms)
            {
                Carp::confess("Cannot match addressing at line " . $self->_get_line_num());
            }
            my $sayer = $1;

            if ($sayer =~ m{[\[\]]})
            {
                Carp::confess("Tried to put an inner-desc inside an addressing at line " . $self->_get_line_num());
            }

            return ($sayer);
        }
    );

    $what = $self->_parse_inner_text();

    return
    +{
         character => $sayer,
         para => $self->_new_para($what),
    };
}

sub _parse_saying_other_para
{
    my $self = shift;

    $self->_skip_space();

    my $verdict = $self->_with_curr_line(
        sub {
            my $l = shift;

            if ($$l !~ /\G\++: /cgms)
            {
                return;
            }
            else
            {
                return 1;
            }
        }
    );

    if (!defined($verdict))
    {
        return;
    }

    my $what = $self->_parse_inner_text();

    return $self->_new_para($what);
}

sub _parse_speech_unit
{
    my $self = shift;

    my $first = $self->_parse_saying_first_para();

    my @others;
    while (defined(my $other_para = $self->_parse_saying_other_para()))
    {
        push @others, $other_para;
    }

    return
        $self->_new_node({
                t => "Saying",
                character => $first->{character},
                children =>
                    $self->_new_list([ $first->{para}, @others ]),
        });
}

sub _parse_desc_unit
{
    my $self = shift;

    my $start_line = $self->_curr_line_idx();

    # Skip the [
    $self->_with_curr_line(
        sub {
            my $l = shift;

            $$l =~ m{^\[}g;
        }
    );

    my @paragraphs;

    my $is_end = 1;
    my $para;
    PARAS_LOOP:
    while ($is_end && ($para = $self->_consume_paragraph()))
    {
        $self->_with_curr_line(
            sub {
                my $l = shift;

                if ($$l =~ m{\G\]}cg)
                {
                    $is_end = 0;
                }
            }
        );
        push @paragraphs, $para;
    }

    if ($is_end)
    {
        Carp::confess (
            qq{Description ("[ ... ]") that started on line }
            . ($start_line+1) .
            qq{does not terminate anywhere.}
        );
    }

    return $self->_new_node({
            t => "Description",
            children => $self->_new_list(
            [
                map {
                $self->_new_para($_),
                } @paragraphs
            ],),
    });
}

sub _parse_inner_tag
{
    my $self = shift;

    my $open = $self->_parse_opening_tag();

    if ($open->is_standalone())
    {
        $self->_skip_space();

        return $self->_create_elem($open);
    }

    my $inside = $self->_parse_inner_text();

    my $close = $self->_parse_closing_tag();

    if ($open->name() ne $close->name())
    {
        XML::Grammar::Fiction::Err::Parse::InnerTagsMismatch->throw(
            error => "Inline tags do not match",
            opening_tag => $open,
            closing_tag => $close,
        );
    }

    return $self->_create_elem($open);
}

sub _parse_inner_text
{
    my $self = shift;

    my @contents;

    my $start_line = $self->_curr_line_idx();

    my $curr_text = "";

    CONTENTS_LOOP:
    while ($self->_curr_line() ne "\n")
    {
        my ($which_tag, $text_to_append) = $self->_find_next_inner_text();

        $curr_text .= $text_to_append;

        push @contents, $curr_text;

        $curr_text = "";

        if (!defined($which_tag))
        {
            # Do nothing - a tag was not detected.
        }
        else
        {
            if ($which_tag eq "open_tag")
            {
                push @contents, $self->_parse_inner_tag();

                # Avoid skipping to the next line.
                # Gotta love teh Perl!
                redo CONTENTS_LOOP;
            }
            elsif ($which_tag eq "close")
            {
                last CONTENTS_LOOP;
            }
            elsif ($which_tag eq "entity")
            {
                my $l = $self->_curr_line_ref();

                if (my ($text) = ($$l =~ m{\G(\&\w+;)}g))
                {
                    push @contents, HTML::Entities::decode_entities($text);
                }
                else
                {
                    Carp::confess("Cannot match entity (e.g: \""\") at line " .
                        $self->_get_line_num()
                    );
                }

                redo CONTENTS_LOOP;
            }
        }
    }
    continue
    {
        if (!defined(${$self->_next_line_ref()}))
        {
            Carp::confess
            (
                "End of file in an addressing paragraph starting at "
                . ($start_line+1)
            );
        }
    }

    if (length($curr_text) > 0)
    {
        push @contents, $curr_text;
    }

    return \@contents;
}

sub _curr_line_matches
{
    my $self = shift;
    my $re = shift;

    my $l = $self->curr_line_ref();

    return ($$l =~ $re);
}

=begin Removed
    This was a removed part of _parse_text.

    # If it's whitespace - return an empty list.
    if ((scalar(@ret) == 1) && (ref($ret[0]) eq "") && ($ret[0] !~ m{\S}))
    {
        return $self->_new_empty_list();
    }

    return $self->_new_list(\@ret);

=end Removed

=cut

sub _find_next_inner_text
{
    my $self = shift;

    my $which_tag;
    my $text = "";

    my $l = $self->curr_line_ref();

    # Apparently, perl does not always returns true in this
    # case, so we need the defined($1) ? $1 : "" workaround.
    $$l =~ m{\G([^\<\[\]\&]*)}cgms;

    $text .= (defined($1) ? $1 : "");

    if ($$l =~ m{\G\&})
    {
        $which_tag = "entity";
    }
    elsif ($$l =~ m{\G(?:</|\])})
    {
        $which_tag = "close";
    }
    elsif ($$l =~ m{\G<})
    {
        $which_tag = "open_tag";
    }

    return ($which_tag, $text);
}