#
# Copyright (c) 2014-2019 Christian Jaeger, copying@christianjaeger.ch
#
# This is free software, offered under either the same terms as perl 5
# or the terms of the Artistic License version 2 or the terms of the
# MIT License (Expat version). See the file COPYING.md that came
# bundled with this file.
#

=head1 NAME

FunctionalPerl::Htmlgen::Toc - building a table of contents

=head1 SYNOPSIS

=head1 DESCRIPTION

Expands this syntax in a PXML document:

<with_toc> <h2>..</h2> <h3>..</h3>.. <h2>..</h2> </with_toc>

into a table of contents and then the original contents but with
numbering added to the hX section headers.

=head1 SEE ALSO

This is a L<FunctionalPerl::Htmlgen::PXMLMapper>

=head1 NOTE

This is alpha software! Read the status section in the package README
or on the L<website|http://functional-perl.org/>.

=cut

package FunctionalPerl::Htmlgen::Toc;

use strict;
use warnings;
use warnings FATAL => 'uninitialized';
use experimental "signatures";

use Sub::Call::Tail;

use FP::StrictList;
use FP::List;
use Chj::TEST;
use PXML::XHTML ":all";
use FP::Stream qw(stream_mixed_state_fold_right);
use PXML ":all";
use FP::Predicates qw(is_natural);

sub rindices_numberstring($rindices) {
    is_null($rindices)
        ? ""
        : $rindices->reverse->map(sub($i) {"$i."})->strings_join("") . " "
}

TEST { rindices_numberstring(list()) } "";
TEST { rindices_numberstring(list(2, 1)) } "1.2. ";

package FunctionalPerl::Htmlgen::Toc::TocNodeBase {
    use FP::StrictList;
    use FP::Predicates;
    use FP::List;
    use PXML::XHTML ":all";

    use FP::Struct [[*is_strictlist, "subnodes"]];

    sub subnodes_length($self) {
        $self->subnodes->length
    }

    sub subnodes_add ($self, $node) {
        is_instance_of $node, "FunctionalPerl::Htmlgen::Toc::TocNode"
            or die "wrong type";

        # (^ XX so poor, neither do I have a TypedList yet, nor the
        # syntax to add it to the method declaration)
        $self->subnodes_update(sub($l) { cons $node, $l })
    }

    sub subnodes_head_update ($self, $fn) {
        my $ss = $self->subnodes;
        if (is_null $ss) {
            die "skipped level"    ## nicer message and all?
        } else {
            $self->subnodes_set(cons(&$fn($ss->first), $ss->rest))
        }
    }

    sub level_add ($self, $levelsdown, $node) {
        is_natural $levelsdown or die "wrong type: $levelsdown";
        if ($levelsdown > 1) {
            $self->subnodes_head_update(
                sub($subnode) {
                    $subnode->level_add($levelsdown - 1, $node)
                }
            )
        } else {
            $self->subnodes_add($node)
        }
    }

    # just for debugging? $indices is a list of 1-based indices
    sub ref ($self, $indices) {
        if (is_null $indices) {
            $self
        } else {
            my ($i, $indices1) = $indices->first_and_rest;
            my $subnodes = $self->subnodes;
            $subnodes->ref($subnodes->length - $i)->ref($indices1)
        }
    }

    # used during document mapping (while the toc is collected)
    sub numberstring($self) {
        my $ss  = $self->subnodes;
        my $len = $ss->length;

        # the first is the one that was added last
        $len ? $len . "." . $ss->first->numberstring : "";

        # (O(n^2) complexity)
    }

    # build the TOC html. Need to get the numberstring differently
    # now.
    sub html_with_parents ($self, $rindices) {
        my $maybe_name = $self->name;
        my $shown      = [
            FunctionalPerl::Htmlgen::Toc::rindices_numberstring($rindices),
            $self->header_pxml_for_toc
        ];
        DIR(
            { class => "toc" },
            (
                defined $maybe_name
                ? A({ href => "#" . $maybe_name }, $shown)
                : $shown
            ),
            $self->subnodes->array__reverse__map_with_length(
                sub ($node, $num) {
                    LI($node->html_with_parents(cons $num, $rindices))
                }
            )
        )
    }

    _END_
}

package FunctionalPerl::Htmlgen::Toc::TocNode {
    use FP::Predicates "is_string";
    use PXML "is_pxml_element";
    use FP::List;

    use FP::Struct [
        [*is_string,       "name"],    # as used in the <a name="">
                                       # already in the document
        [*is_pxml_element, "header"]
        ],
        "FunctionalPerl::Htmlgen::Toc::TocNodeBase";

    sub header_pxml_for_toc($self) {

        # XX keep some formatting?
        $self->header->text
    }

    _END_
}

package FunctionalPerl::Htmlgen::Toc::TocRootNode {
    use FP::List;
    use PXML::XHTML ":all";

    use FP::Struct ["header_pxml_for_toc"],
        "FunctionalPerl::Htmlgen::Toc::TocNodeBase";

    sub name($self) {undef}

    sub html($self) {
        DIV({ class => "toc_box" }, $self->html_with_parents(null))
    }

    _END__
}

our $empty_toc = FunctionalPerl::Htmlgen::Toc::TocRootNode->new(strictnull,
    H3({ class => "toc_title" }, "Contents"));

sub tocnode ($name, $header) {
    FunctionalPerl::Htmlgen::Toc::TocNode->new(strictnull, $name, $header);
}

our $ttoc;
TEST {
    my $t1  = $empty_toc->level_add(1, tocnode("a", H1("First")));
    my $t11 = $t1->level_add(2, tocnode("b", H2("Sub-First")));
    my $t2  = $t11->level_add(1, tocnode("c", H1("Second")));
    $ttoc = $t2;
    [map { $_->numberstring } $t11, $t2]
}
['1.1.', '2.'];

TEST {
    my $t_paths = list(list(1), list(2), list(1, 1));
    $t_paths->map (sub($path) { $ttoc->ref($path)->name })->array
}
[qw(a c b)];

TEST { $ttoc->html->string }
'<div class="toc_box">'
    . '<dir class="toc"><h3 class="toc_title">Contents</h3>'
    . '<li><dir class="toc"><a href="#a">1. First</a>'
    . '<li><dir class="toc"><a href="#b">1.1. Sub-First</a></dir></li>'
    . '</dir></li>'
    . '<li><dir class="toc"><a href="#c">2. Second</a></dir></li>'
    . '</dir></div>';

sub process__with_toc__body ($body, $first_level, $toc, $parents) {

    # -> (processed_body, toc)
    stream_mixed_state_fold_right(
        sub ($v, $toc, $rest) {
            if (is_pxml_element($v)) {
                if (my ($_level) = $v->name =~ /^[hH](\d+)$/s) {
                    my $level = $_level - $first_level + 1;
                    is_natural $level
                        or die "The given <with_toc> tag dictates that the "
                        . "top-most header level is '$first_level', but "
                        . "encountering <"
                        . $v->name . ">";

                    my $anchor = $parents->find(
                        sub($e) {
                            $e->name eq "a" and $e->maybe_attribute("name")
                        }
                    ) // die "bug, missing anchor element";

                    my $toc = $toc->level_add($level,
                        tocnode($anchor->maybe_attribute("name"), $v));

                    my ($tail, $toc2) = &$rest($toc);

                    (
                        cons(
                            $v->body_update(
                                sub($body) {
                                    cons($toc->numberstring . " ", $body)
                                }
                            ),
                            $tail
                        ),
                        $toc2
                    )
                } else {

                    # map $v's body
                    my ($body2, $toc2)
                        = process__with_toc__body($v->body, $first_level, $toc,
                        cons($v, $parents));

                    my ($tail, $toc3) = &$rest($toc2);

                    (cons($v->body_set($body2), $tail), $toc3)
                }
            } else {
                my ($tail, $toc2) = &$rest($toc);
                (cons($v, $tail), $toc2)
            }
        },
        sub($toc) {

            # return counter back up the chain
            (null, $toc)
        },
        $body
    )->($toc);
}

TEST {
    my ($body, $toc) = process__with_toc__body(["foo"], 1, $empty_toc, null);
    [$body->string, $toc->html->string]
}
[
    'foo',
    '<div class="toc_box"><dir class="toc"><h3 class="toc_title">Contents</h3></dir></div>'
];

TEST {
    HTML(
        (
            process__with_toc__body ["foo", A({ name => "a" }, H1("hed")),
                "bar"],
            1, $empty_toc, null
        )[0]
        )->string
}
'<html>foo<a name="a"><h1>1. hed</h1></a>bar</html>';

TEST {
    HTML(
        (
            process__with_toc__body ["foo", A({ name => "a" }, H1("hed")),
                P("bar")],
            1, $empty_toc, null
        )[0]
        )->string
}
'<html>foo<a name="a"><h1>1. hed</h1></a><p>bar</p></html>';

TEST {
    HTML(
        (
            process__with_toc__body [
                cons "foo",
                [
                    A({ name => "a" }, H1("hed")),
                    A({ name => "b" }, H2("hud")),
                    ["", P("bar")]
                ]
            ],
            1,
            $empty_toc,
            null
        )[0]
        )->string
}
'<html>foo<a name="a"><h1>1. hed</h1></a><a name="b"><h2>1.1. hud</h2></a><p>bar</p></html>';

TEST {
    HTML(
        (
            process__with_toc__body [" ", P("blabla"),
                A({ name => "a" }, H1("for one"))],
            1, $empty_toc, null
        )[0]
        )->string
}
'<html> <p>blabla</p><a name="a"><h1>1. for one</h1></a></html>';

# now the "EXPORT":

use FP::Struct [] => "FunctionalPerl::Htmlgen::PXMLMapper";

sub match_element_names($self) { ["with_toc"] }

sub map_element ($self, $e, $uplist) {
    my ($body, $toc)
        = process__with_toc__body($e->body, $e->maybe_attribute("level") // 2,
        $empty_toc, null);
    [$toc->html, $body]
}

_END_
