view release on metacpan or  search on metacpan

lib/FP/Trie.pm  view on Meta::CPAN

    use FP::Stream;
    use Scalar::Util qw(blessed);
    use FP::Carp;

    use FP::Struct ["sublevels"], "FP::Trie::Trie";

    sub perhaps_value { () }

    sub perhaps_skip {
        @_ == 2 or fp_croak_arity 2;
        my ($t,  $l)        = @_;
        my ($t2, $maybe_l2) = $t->skip($l);
        defined $maybe_l2 ? () : ($t2)
    }

    our $key_not_found_exception = FP::Trie::KeyNotFoundException->new;

    sub perhaps_ref {
        @_ == 2 or fp_croak_arity 2;
        my ($t, $l) = @_;
        if (my ($t2) = $t->perhaps_skip($l)) {
            $t2->perhaps_value
        } else {
            ()
        }
    }
    *maybe_ref = perhaps_to_maybe \&perhaps_ref;
    *ref_or    = perhaps_to_or \&perhaps_ref;
    *ref       = perhaps_to_x \&perhaps_ref, $key_not_found_exception;
    *exists    = perhaps_to_exists \&perhaps_ref;

    # returns ($ending_level, $maybe_keyremainder,
    # $maybe_lastvaluelevel, $maybe_keyremainder_lvl)
    sub skip {
        @_ == 2 or @_ == 4 or fp_croak_arity "2 or 4";
        my ($t, $l, $maybe_lastvaluelevel, $maybe_keyremainder_lvl) = @_;
        my ($maybe_lvl, $maybe_r_lvl)
            = (defined blessed $t)
            && $t->isa("FP::Trie::ValueLevel")
            ? ($t, $l)
            : ($maybe_lastvaluelevel, $maybe_keyremainder_lvl);
        if ($l->is_null) {

            # found the node, which is perhaps holding a value
            ($t, undef, $maybe_lvl, $maybe_r_lvl)
        } else {
            my ($a, $l2) = $l->first_and_rest;
            if (my ($t2) = hash_perhaps_ref($$t{sublevels}, $a)) {

                # XX TCO
                $t2->skip($l2, $maybe_lvl, $maybe_r_lvl)
            } else {

                # no value for the full key; $t is the last seen
                # level, $l the remainder of the key
                ($t, $l, $maybe_lvl, $maybe_r_lvl)
            }
        }
    }

    sub update {
        @_ == 3 or fp_croak_arity 3;
        my ($t, $l, $fn) = @_;
        if ($l->is_null) {
            FP::Trie::ValueLevel->new($$t{sublevels}, &$fn($t->perhaps_value))
        } else {
            my ($a, $l2) = $l->first_and_rest;
            $t->sublevels_update(
                sub {
                    hash_update $_[0], $a, sub {
                        do {
                            if (my ($t2) = @_) {
                                $t2
                            } else {
                                $FP::Trie::empty_trie
                            }
                            }
                            ->update($l2, $fn)
                    }
                }
            )
        }
    }

    sub xdelete {
        @_ == 2 or fp_croak_arity 2;
        my ($t, $l) = @_;
        if ($l->is_null) {
            if ((defined blessed $t) && $t->isa("FP::Trie::ValueLevel")) {
                if (keys %{ $$t{sublevels} }) {
                    FP::Trie::BareLevel->new($$t{sublevels})
                } else {

                    # equivalent but detectable to be empty from outer
                    # layers
                    $FP::Trie::empty_trie
                }
            } else {
                die $key_not_found_exception
            }
        } else {
            my ($a, $l2) = $l->first_and_rest;
            $t->sublevels_update(
                sub {
                    hash_update $_[0], $a, sub {
                        if (my ($t2) = @_) {
                            my $t3 = $t2->xdelete($l2);
                            $t3 eq $FP::Trie::empty_trie ? () : $t3
                        } else {

                            #()
                            # When does this happen? When the key goes
                            # past the existing tree.
                            die $key_not_found_exception
                        }
                    }
                }
            )
        }
    }