view release on metacpan or  search on metacpan

lib/PXML/Util.pm  view on Meta::CPAN

sub pxml_deferred_map {
    @_ >= 2 and @_ <= 4 or fp_croak_arity "2-4";

    # Elementfn receives (element, up-list, inferior-map), where
    # up-list is a linked list to the parents and inferior-map is a
    # function of one argument that will do the same as the
    # pxml_deferred_map call (but keep the up-list).  Otherfn is
    # called for leafs (non-sequences) and receives (value, up-list).

    my ($v, $elementfn, $maybe_otherfn, $maybe_uplist) = @_;

    my $make_inferior_map = sub {
        my ($uplist) = @_;
        sub {
            pxml_deferred_map($_[0], $elementfn, $maybe_otherfn, $uplist)
        }
    };

    my $uplist = $maybe_uplist // null;

    if (my $r = ref $v) {
        my $uplist2 = cons $v, $uplist;
        if (blessed($v) and $v->isa("PXML::Element")) {

            # XX TCO?
            &$elementfn($v, $uplist, &$make_inferior_map($uplist2))
        } else {
            stream_map(&$make_inferior_map($uplist), stream_mixed_flatten($v))
        }
    } else {
        $maybe_otherfn ? &$maybe_otherfn($v, $uplist) : $v
    }
}

# 'Eager' mapping, meaning, the body is mapped already when $elementfn
# receives an element.

sub pxml_eager_map {
    @_ >= 2 and @_ <= 4 or fp_croak_arity "2-4";

    # The functions receive (value, up-list), where up-list is a
    # linked list to the parents
    my ($v, $elementfn, $maybe_otherfn, $maybe_uplist) = @_;

    pxml_deferred_map(
        $v,
        sub {
            my ($e, $uplist, $inferior_map) = @_;

            # XX TCO?
            &$elementfn($e->body_map($inferior_map), $uplist)
        },
        $maybe_otherfn,
        $maybe_uplist
    )
}

sub t_data {
    require PXML::XHTML;
    import PXML::XHTML qw(P B A CODE);
    P("foo", B("bar", undef, stream_iota(5)->take(4)))
}

TEST { t_data->string }
'<p>foo<b>bar5678</b></p>';

TEST {
    pxml_eager_map(
        t_data,
        sub {
            $_[0]->name_update(sub { $_[0] . "A" })
        },
        sub { ($_[0] // "-") . "." }
        )->string
}
'<pA>foo.<bA>bar.-.5.6.7.8.</bA></pA>';

use FP::Ops "the_method";

sub uplist_show {
    my ($uplist) = @_;
    "[" . $uplist->map (the_method("name"))->strings_join("|") . "]"
}

TEST {
    pxml_eager_map(
        t_data,
        sub {
            my ($e, $uplist) = @_;
            $e->body_update(
                sub {
                    cons(uplist_show($uplist), $_[0])
                }
            )
        },
        sub {
            my ($v, $uplist) = @_;
            uplist_show($uplist) . ($v // "-") . "."
        }
        )->string
}
'<p>[][p]foo.<b>[p][b|p]bar.[b|p]-.[b|p]5.[b|p]6.[b|p]7.[b|p]8.</b></p>';

TEST {
    pxml_deferred_map(
        t_data,
        sub {
            my ($e, $uplist, $inferior_map) = @_;
            $e->body_update(
                sub {
                    my ($body) = @_;
                    cons(
                        uplist_show($uplist),
                        $e->name eq "b"
                        ? do {
                            my $s = stream_mixed_flatten $body;
                            cons(&$inferior_map(car $s), cdr $s )
                            }
                        : &$inferior_map($body)
                    )