view release on metacpan or  search on metacpan

lib/Chj/Serialize.pm  view on Meta::CPAN

#
# Copyright (c) 2015-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

Chj::Serialize

=head1 SYNOPSIS

=head1 DESCRIPTION


=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 Chj::Serialize;
use strict;
use warnings;
use warnings FATAL => 'uninitialized';
use Exporter "import";

our @EXPORT      = qw(new_Serialize_Closure);
our @EXPORT_OK   = qw();
our %EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]);

use Chj::TEST;

{

    package Chj::Serializable::Closure;
    use FP::Struct ["env", "code_id"], 'FP::Struct::Show', 'FP::Abstract::Pure';
    _END_
}

{

    package Chj::Serialize::Closure;

    use PadWalker qw(closed_over set_closed_over);
    use FP::Repl::WithRepl qw(WithRepl_eval);
    use B::Deparse;
    use FP::Predicates ":all";

    our $deparse = B::Deparse->new("-p", "-l", "-q");

    use FP::Struct [
        [\&is_hash,     "_closure_generator_code_to_id"],
        [\&is_hash,     "_id_to_closure_generator_code"],
        [\&is_hash,     "_id_to_closure_generator"],
        [\&is_natural0, "current_id"]
        ],
        'FP::Struct::Show';

    sub next_id {
        my ($self) = @_;
        $$self{current_id}++
    }

    sub id_to_closure_generator_code {
        my ($self, $id) = @_;
        $$self{_id_to_closure_generator_code}{$id} // die "unknown code_id $id";
    }

    sub id_to_closure_generator {
        my ($self, $id) = @_;
        $$self{_id_to_closure_generator}{$id}
            //= &WithRepl_eval($self->id_to_closure_generator_code($id))
            // die "eval error: $@";

        #XX oh, want a WithRepl_xeval ?
    }

    sub serializable {
        my ($self, $fn) = @_;

        my $env  = closed_over($fn);
        my $code = $deparse->coderef2text($fn);

        my $vars = [sort keys %$env];

        my $closure_generator_code
            = 'sub { my (' . join(",", @$vars) . ') = @_; sub ' . $code . ' }';

        # use this as key right now.

        my $id = $$self{_closure_generator_code_to_id}{$closure_generator_code}
            //= do {
            my $id = $self->next_id;
            $$self{_id_to_closure_generator_code}{$id}
                = $closure_generator_code;
            $id
            };

        # XX exclude web server handle (request) etc. [hw btw in schem? xhu]

        Chj::Serializable::Closure->new($env, $id);
    }

    sub executable {