path: root/lib/Chart/Clicker/SQL/REPL.pm

package Chart::Clicker::SQL::REPL;
use Moose;
use 5.020;
use feature 'signatures', 'postderef';
no warnings 'experimental::signatures';
no warnings 'experimental::postderef';

use Browser::Open;
use File::HomeDir;
use File::Spec;
use File::Temp;
use List::Util;
use Module::Runtime;
use Path::Class;
use Scalar::Util;
use Term::ReadLine;
use Try::Tiny;

use Chart::Clicker::SQL;

has sql => (
    is        => 'rw',
    isa       => 'Chart::Clicker::SQL',
    predicate => 'initialized',
);

has history_file => (
    is      => 'ro',
    isa     => 'Str',
    default => sub {
        my $filename = File::Spec->catfile(
            File::HomeDir->my_data,
            '.ccsql_history'
        );
        file($filename)->touch;
        return $filename;
    },
);

has rl => (
    is      => 'ro',
    isa     => 'Term::ReadLine',
    lazy    => 1,
    default => sub ($self) {
        my $rl = Term::ReadLine->new(__PACKAGE__);
        for my $line (file($self->history_file)->slurp(chomp => 1)) {
            $rl->addhistory($line);
        }
        Scalar::Util::weaken(my $weakself = $self);
        $rl->Attribs->{completion_entry_function} = sub {
            ()
        };
        $rl->Attribs->{attempted_completion_function} = sub {
            $weakself->_attempt_completion(@_);
        };
        return $rl;
    },
);

has width => (
    is      => 'rw',
    isa     => 'Int',
    default => 1000,
);

has height => (
    is      => 'rw',
    isa     => 'Int',
    default => 600,
);

has last_query => (
    is        => 'rw',
    isa       => 'Str',
    predicate => 'has_last_query',
);

has domain_axis_class => (
    is      => 'rw',
    isa     => 'Str',
    default => 'Chart::Clicker::Axis',
);

has range_axis_class => (
    is      => 'rw',
    isa     => 'Str',
    default => 'Chart::Clicker::Axis',
);

has renderer_class => (
    is      => 'rw',
    isa     => 'Str',
    default => 'Chart::Clicker::Renderer::Line',
);

sub dsn ($self, $dsn) {
    $self->sql(Chart::Clicker::SQL->new(dsn => $dsn));
}

sub select ($self, $query) {
    $query = "select $query";
    $self->last_query($query);
}

sub timechart ($self, $args) {
    $self->domain_axis_class(
        $args eq 'on'
            ? "Chart::Clicker::Axis::DateTime"
            : "Chart::Clicker::Axis"
    )
}

for my $renderer (qw(Line StackedLine Bar StackedBar Area StackedArea Point)) {
    __PACKAGE__->meta->add_method(lc($renderer) => sub ($self, $args) {
        $self->renderer_class("Chart::Clicker::Renderer::$renderer");
    })
}

sub _draw ($self) {
    if (!$self->initialized) {
        warn "not initialized";
        return;
    }
    if (!$self->has_last_query) {
        warn "no active query";
        return;
    }
    my $chart = $self->sql->render($self->last_query);
    $self->_configure_chart($chart);
    my ($fh, $filename) = File::Temp::tempfile(SUFFIX => '.png', UNLINK => 1);
    $chart->draw;
    $fh->write($chart->rendered_data);
    $fh->flush;
    Browser::Open::open_browser("file://$filename");
}

sub _configure_chart ($self, $chart) {
    $chart->get_context('default')->domain_axis($self->_domain_axis);
    $chart->get_context('default')->range_axis($self->_range_axis);
    $chart->width($self->width);
    $chart->height($self->height);
    $chart->set_renderer($self->_renderer);
}

sub _domain_axis ($self) {
    Module::Runtime::require_module($self->domain_axis_class);
    return $self->domain_axis_class->new(
        orientation        => 'horizontal',
        position           => 'bottom',
        tick_division_type => 'LinearRounded',
    );
}

sub _range_axis ($self) {
    Module::Runtime::require_module($self->range_axis_class);
    return $self->range_axis_class->new(
        orientation        => 'vertical',
        position           => 'left',
        tick_division_type => 'LinearRounded',
    )
}

sub _renderer ($self) {
    Module::Runtime::require_module($self->renderer_class);
    return $self->renderer_class->new;
}

sub _can_draw ($self) {
    $self->initialized && $self->has_last_query
}

sub _attempt_completion ($self, $text, $line, $start, $end) {
    my ($initial_word) = $line =~ /^(\S+)\s+/;
    my @matches = $self->_get_completions($text, $initial_word);
    return $self->rl->completion_matches($text, sub ($text, $index) {
        return $matches[$index];
    });
}

sub _get_completions ($self, $text, $initial_word) {
    if ($initial_word) {
        my $completion_method = "_complete_$initial_word";
        return unless $self->can($completion_method);
        return $self->$completion_method($text);
    }
    else {
        my @keywords = grep {
            !/^_/
        } grep {
            !Moose::Object->can($_)
        } $self->meta->get_all_method_names;

        return $self->_keyword_complete($text, \@keywords);
    }
}

sub _complete_select ($self, $text) {
    $self->_keyword_complete(
        $text,
        [
            $self->_sql_keywords,
            $self->_sql_functions,
            $self->_sql_tables,
            $self->_sql_columns,
        ]
    )
}

sub _complete_timechart ($self, $text) {
    $self->_keyword_complete($text, [ qw(on off) ])
}

for my $method (qw(width height)) {
    __PACKAGE__->meta->add_method("_complete_$method" => sub ($self, $text) {
        $self->_default_complete($text, $method)
    })
}

sub _default_complete ($self, $text, $method) {
    $self->_keyword_complete($text, [ $self->$method ])
}

sub _keyword_complete ($self, $text, $keywords) {
    my ($prefix) = $text =~ /.*\b(\w+)$/;
    $prefix ||= '';
    my $capital = $prefix eq uc($prefix);
    return map {
        $prefix . substr($capital ? $_ : lc, length($prefix))
    } grep {
        /^\Q$prefix/i
    } $keywords->@*;
}

sub _sql_keywords ($self) {
    # just using sqlite keywords for now, but would be nice to switch this on
    # the backend engine in use based on the dsn at some point

    # https://www.sqlite.org/lang_keywords.html
    qw(
        ABORT ACTION ADD AFTER ALL ALTER ANALYZE AND AS ASC ATTACH
        AUTOINCREMENT BEFORE BEGIN BETWEEN BY CASCADE CASE CAST CHECK COLLATE
        COLUMN COMMIT CONFLICT CONSTRAINT CREATE CROSS CURRENT_DATE
        CURRENT_TIME CURRENT_TIMESTAMP DATABASE DEFAULT DEFERRABLE DEFERRED
        DELETE DESC DETACH DISTINCT DROP EACH ELSE END ESCAPE EXCEPT EXCLUSIVE
        EXISTS EXPLAIN FAIL FOR FOREIGN FROM FULL GLOB GROUP HAVING IF IGNORE
        IMMEDIATE IN INDEX INDEXED INITIALLY INNER INSERT INSTEAD INTERSECT
        INTO IS ISNULL JOIN KEY LEFT LIKE LIMIT MATCH NATURAL NO NOT NOTNULL
        NULL OF OFFSET ON OR ORDER OUTER PLAN PRAGMA PRIMARY QUERY RAISE
        RECURSIVE REFERENCES REGEXP REINDEX RELEASE RENAME REPLACE RESTRICT
        RIGHT ROLLBACK ROW SAVEPOINT SELECT SET TABLE TEMP TEMPORARY THEN TO
        TRANSACTION TRIGGER UNION UNIQUE UPDATE USING VACUUM VALUES VIEW
        VIRTUAL WHEN WHERE WITH WITHOUT
    )
}

sub _sql_functions ($self) {
    # just using sqlite functions for now, but would be nice to switch this on
    # the backend engine in use based on the dsn at some point

    my @functions = (
        # https://www.sqlite.org/lang_corefunc.html
        qw(
            abs changes char coalesce glob ifnull instr hex last_insert_rowid
            length like likelihood likely load_extension lower ltrim max min
            nullif printf quote random randomblob replace round rtrim soundex
            sqlite_compileoption_get sqlite_compileoption_used sqlite_source_id
            sqlite_version substr total_changes trim typeof unlikely unicode
            upper zeroblob
        ),
        # https://www.sqlite.org/lang_datefunc.html
        qw(
            date time datetime julianday strftime
        ),
        # https://www.sqlite.org/lang_aggfunc.html
        qw(
            avg count group_concat max min sum total
        ),
        # https://www.sqlite.org/json1.html
        qw(
            json json_array json_array_length json_extract json_insert
            json_object json_remove json_replace json_set json_type json_valid
            json_quote json_group_array json_group_object json_each json_tree
        ),
    );

    map { "$_(" } @functions
}

sub _sql_tables ($self) {
    return unless $self->initialized;
    my @tables = $self->sql->dbh->tables;
    my @table_components = map { split /\./ } @tables;
    my @all_tables = (@tables, @table_components);
    return (
        @all_tables,
        map { s/"//gr } @all_tables,
    );
}

sub _sql_columns ($self) {
    return unless $self->initialized;
    my $sth = $self->sql->dbh->column_info(undef, undef, undef, undef);
    my $rows = $sth->fetchall_arrayref;
    return List::Util::uniq map { $_->[3] } $rows->@*;
}

sub run ($self) {
    while (1) {
        my $prompt = "> ";
        if ($self->initialized) {
            $prompt = $self->sql->dsn . $prompt;
        }
        if (defined(my $input = $self->rl->readline($prompt))) {
            next unless length($input);
            chomp($input);
            last if $input eq 'exit';
            my ($command, $args) = split(' ', $input, 2);
            try {
                $self->$command($args);
                $self->_draw if $self->_can_draw
            }
            catch {
                warn $_;
            };
        }
        else {
            print "\n";
            last;
        }
    }
}

sub DEMOLISH ($self, $igd) {
    $self->rl->WriteHistory($self->history_file);
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;