summaryrefslogtreecommitdiffstats
path: root/lib/App/REPL.pm
blob: 28837d47119a7206652d7492593c693eb7a8bc44 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
package App::REPL;
use strict;
use warnings;

use App::REPL::Plugin::Defaults;

use Module::Runtime qw(compose_module_name use_package_optimistically);
use Scalar::Util qw(blessed);
use Try::Tiny;

sub new {
    bless {
        plugins => [],
        _default_plugins => [
            App::REPL::Plugin::Defaults->new,
        ],
    }, shift;
}

sub load_plugin {
    my $self = shift;
    my ($plugin) = @_;

    if (!blessed($plugin)) {
        $plugin = compose_module_name("App::REPL::Plugin", $plugin);
        use_package_optimistically($plugin);
        die "$plugin is not a valid plugin"
            unless $plugin->isa("App::REPL::Plugin");
        $plugin = $plugin->new;
    }

    push @{ $self->{plugins} }, $plugin;
}

sub plugins {
    my $self = shift;

    return (
        @{ $self->{plugins} },
        @{ $self->{_default_plugins} },
    );
}

sub run {
    my $self = shift;

    while (defined(my $line = $self->_read)) {
        try {
            my @result = $self->_eval($line);
            $self->_print_result(@result);
        }
        catch {
            $self->_print_error($_);
        }
    }
    print "\n";
}

sub _read {
    my $self = shift;

    $self->_wrapped_plugin('display_prompt');
    my ($line) = $self->_wrapped_plugin('read_line');
    ($line) = $self->_chained_plugin('mangle_line', $line)
        if defined $line;

    return $line;
}

sub _eval {
    my $self = shift;
    my ($line) = @_;

    return $self->_wrapped_plugin('evaluate', $line);
}

sub _print_error {
    my $self = shift;
    my ($error) = @_;

    ($error) = $self->_chained_plugin('mangle_error', $error);
    $self->_wrapped_plugin('print_error', $error);
}

sub _print_result {
    my $self = shift;
    my (@result) = @_;

    @result = $self->_chained_plugin('mangle_result', @result);
    $self->_wrapped_plugin('print_result', @result);
}

sub _wrapped_plugin {
    my $self = shift;
    my @plugins = ref($_[0]) ? @{ shift() } : $self->plugins;
    my ($method, @args) = @_;

    @plugins = grep { $_->can($method) } @plugins;

    return @args unless @plugins;

    my $plugin = shift @plugins;
    my $next = sub { $self->_wrapped_plugin(\@plugins, $method, @_) };

    return $plugin->$method($next, @args);
}

sub _chained_plugin {
    my $self = shift;
    my @plugins = ref($_[0]) ? @{ shift() } : $self->plugins;
    my ($method, @args) = @_;

    @plugins = grep { $_->can($method) } @plugins;

    for my $plugin (@plugins) {
        @args = $plugin->$method(@args);
    }

    return @args;
}

1;